This graph shows which files directly or indirectly include this file:

Macros
#define	Linux 1

#define	IRIX 2

#define	IRIX64 3

#define	HP 4

#define	NNEW(a, b, c) a=(b *)u_calloc((c),sizeof(b),__FILE__,__LINE__,#a)

#define	RENEW(a, b, c) a=(b )u_realloc((b )(a),(c)*sizeof(b),__FILE__,__LINE__,#a)

#define	SFREE(a) u_free(a,__FILE__,__LINE__,#a)

#define	DMEMSET(a, b, c, d) for(im=b;im<c;im++)a[im]=d

#define	ITG int

#define	ITGFORMAT "d"

Functions
void	FORTRAN (actideacti,(char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, char objectset, ITG ipkon, ITG ibject, ITG *ne))

void	FORTRAN (actideactistr,(char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, char objectset, ITG ipkon, ITG iobject, ITG ne, ITG neinset, ITG iponoel, ITG inoel, ITG *nepar))

void	FORTRAN (addimdnodecload,(ITG nodeforc, ITG i, ITG imdnode, ITG nmdnode, double xforc, ITG ikmpc, ITG ilmpc, ITG ipompc, ITG nodempc, ITG nmpc, ITG imddof, ITG nmddof, ITG nactdof, ITG mi, ITG imdmpc, ITG nmdmpc, ITG imdboun, ITG nmdboun, ITG ikboun, ITG nboun, ITG ilboun, ITG ithermal))

void	FORTRAN (addimdnodedload,(ITG nelemload, char sideload, ITG ipkon, ITG kon, char lakon, ITG i, ITG imdnode, ITG nmdnode, ITG ikmpc, ITG ilmpc, ITG ipompc, ITG nodempc, ITG nmpc, ITG imddof, ITG nmddof, ITG nactdof, ITG mi, ITG imdmpc, ITG nmdmpc, ITG imdboun, ITG nmdboun, ITG ikboun, ITG nboun, ITG ilboun, ITG *ithermal))

void	FORTRAN (addizdofcload,(ITG nodeforc, ITG ndirforc, ITG nactdof, ITG mi, ITG izdof, ITG nzdof, ITG i, ITG iznode, ITG nznode, ITG nk, ITG imdnode, ITG nmdnode, double *xforc))

void	FORTRAN (addizdofdload,(ITG nelemload, char sideload, ITG ipkon, ITG kon, char lakon, ITG nactdof, ITG izdof, ITG nzdof, ITG mi, ITG i, ITG iznode, ITG nznode, ITG nk, ITG imdnode, ITG *nmdnode))

void	FORTRAN (adjustcontactnodes,(char tieset, ITG ntie, ITG itietri, double cg, double straight, double co, double vold, double xo, double yo, double zo, double x, double y, double z, ITG nx, ITG ny, ITG nz, ITG istep, ITG iinc, ITG iit, ITG mi, ITG imastop, ITG nslavnode, ITG islavnode, char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, double tietol, double clearini, double clearslavnode, ITG itiefac, ITG ipkon, ITG kon, char lakon, ITG islavsurf))

void	FORTRAN (allocation,(ITG nload_, ITG nforc_, ITG nboun_, ITG nk_, ITG ne_, ITG nmpc_, ITG nset_, ITG nalset_, ITG nmat_, ITG ntmat_, ITG npmat_, ITG norien_, ITG nam_, ITG nprint_, ITG mi, ITG ntrans_, char set, ITG meminset, ITG rmeminset, ITG ncs_, ITG namtot_, ITG ncmat_, ITG memmpc_, ITG ne1d, ITG ne2d, ITG nflow, char jobnamec, ITG irstrt, ITG ithermal, ITG nener, ITG nstate_, ITG istep, char inpc, ITG ipoinp, ITG inp, ITG ntie_, ITG nbody_, ITG nprop_, ITG ipoinpc, ITG nevdamp, ITG npt_, ITG nslavsm, ITG nkon_, ITG mcs, ITG mortar, ITG ifacecount, ITG nintpoint, ITG infree, ITG nheading_, ITG nobject_, ITG *iuel))

void	FORTRAN (allocont,(ITG ncont, ITG ntie, char tieset, ITG nset, char set, ITG istartset, ITG iendset, ITG ialset, char lakon, ITG ncone, double tietol, ITG ismallsliding, char kind1, char kind2, ITG mortar, ITG istep))

void	FORTRAN (applyboun,(ITG ifaext, ITG nfaext, ITG ielfa, ITG ikboun, ITG ilboun, ITG nboun, char typeboun, ITG nelemload, ITG nload, char sideload, ITG isolidsurf, ITG nsolidsurf, ITG ifabou, ITG nfabou, ITG nface, ITG nodeboun, ITG ndirboun, ITG ikmpc, ITG ilmpc, char labmpc, ITG nmpc, ITG nactdohinv, ITG compressible, ITG iatleastonepressurebc, ITG ipkonf, ITG kon, ITG konf, ITG nblk))

void	FORTRAN (applympc,(ITG nface, ITG ielfa, ITG is, ITG ie, ITG ifabou, ITG ipompc, double vfa, double coefmpc, ITG nodempc, ITG ipnei, ITG neifa, char labmpc, double xbounact, ITG nactdoh, ITG ifaext, ITG nfaext))

void	FORTRAN (applympc_hfa,(ITG nface, ITG ielfa, ITG is, ITG ie, ITG ifabou, ITG ipompc, double hfa, double coefmpc, ITG nodempc, ITG ipnei, ITG neifa, char labmpc, double xbounact, ITG nactdoh))

void	arpack (double co, ITG nk, ITG konp, ITG ipkonp, char *lakonp, ITG ne, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, char labmpc, ITG nmpc, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemload, char sideload, double xload, ITG nload, ITG nactdof, ITG icol, ITG jq, ITG *irowp, ITG neq, ITG nzl, ITG nmethod, ITG ikmpc, ITG ilmpc, ITG ikboun, ITG ilboun, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double shcon, ITG nshcon, double cocon, ITG ncocon, double alcon, ITG nalcon, double alzero, ITG ielmatp, ITG ielorienp, ITG norien, double orab, ITG ntmat_, double t0, double t1, double t1old, ITG ithermal, double prestr, ITG iprestr, double vold, ITG iperturb, double sti, ITG nzs, ITG kode, ITG mei, double fei, char filab, double eme, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double *xstatep, ITG npmat_, char matname, ITG mi, ITG ncmat_, ITG nstate_, double *enerp, char jobnamec, char output, char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, ITG nprint, char prlab, char prset, ITG nener, ITG isolver, double trab, ITG inotr, ITG ntrans, double ttime, double fmpc, char cbody, ITG ibody, double xbody, ITG nbody, double thicke, ITG nslavs, double tietol, ITG nkon, ITG mpcinfo, ITG ntie, ITG istep, ITG mcs, ITG ics, char tieset, double cs, ITG nintpoint, ITG mortar, ITG ifacecount, ITG islavsurfp, double pslavsurfp, double *clearinip, ITG nmat, char typeboun, ITG ielprop, double prop, char orname)

void	arpackbu (double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, char labmpc, ITG nmpc, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemload, char sideload, double xload, ITG nload, ITG nactdof, ITG icol, ITG jq, ITG irow, ITG neq, ITG nzl, ITG nmethod, ITG ikmpc, ITG ilmpc, ITG ikboun, ITG ilboun, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, double t1old, ITG ithermal, double prestr, ITG iprestr, double vold, ITG iperturb, double sti, ITG nzs, ITG kode, ITG mei, double fei, char filab, double eme, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstate, ITG npmat_, char matname, ITG mi, ITG ncmat_, ITG nstate_, double ener, char output, char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, ITG nprint, char prlab, char prset, ITG nener, ITG isolver, double trab, ITG inotr, ITG ntrans, double ttime, double fmpc, char cbody, ITG ibody, double xbody, ITG nbody, double thicke, char jobnamec, ITG nmat, ITG ielprop, double prop, char *orname)

void	arpackcs (double co, ITG nk, ITG konp, ITG ipkonp, char *lakonp, ITG ne, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, char labmpc, ITG nmpc, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemload, char sideload, double xload, ITG nload, ITG nactdof, ITG icol, ITG jq, ITG *irowp, ITG neq, ITG nzl, ITG nmethod, ITG ikmpc, ITG ilmpc, ITG ikboun, ITG ilboun, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmatp, ITG ielorienp, ITG norien, double orab, ITG ntmat_, double t0, double t1, double t1old, ITG ithermal, double prestr, ITG iprestr, double vold, ITG iperturb, double sti, ITG nzs, ITG kode, ITG mei, double fei, char filab, double eme, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double *xstatep, ITG npmat_, char matname, ITG mi, ITG ics, double cs, ITG mpcend, ITG ncmat_, ITG nstate_, ITG mcs, ITG nkon, double enerp, char jobnamec, char output, char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, ITG nprint, char prlab, char prset, ITG nener, ITG isolver, double trab, ITG inotr, ITG ntrans, double ttime, double fmpc, char cbody, ITG ibody, double xbody, ITG nbody, ITG nevtot, double thicke, ITG nslavs, double tietol, ITG mpcinfo, ITG ntie, ITG istep, char tieset, ITG nintpoint, ITG mortar, ITG ifacecount, ITG islavsurfp, double pslavsurfp, double clearinip, ITG nmat, char typeboun, ITG ielprop, double prop, char orname)

void	FORTRAN (assigndomtonodes,(ITG ne, char lakon, ITG ipkon, ITG kon, ITG ielmat, ITG inomat, double elcon, ITG ncmat_, ITG ntmat_, ITG mi, ITG *ne2))

void	FORTRAN (autocovmatrix,(double co, double ad, double au, ITG jqs, ITG irows, ITG ndesi, ITG nodedesi, double physcon))

void	FORTRAN (basis,(double x, double y, double z, double xo, double yo, double zo, ITG nx, ITG ny, ITG nz, double planfa, ITG ifatet, ITG nktet, ITG netet, double field, ITG nfield, double cotet, ITG kontyp, ITG ipkon, ITG kon, ITG iparent, double xp, double yp, double zp, double value, double ratio, ITG iselect, ITG nselect, ITG istartset, ITG iendset, ITG ialset, ITG imastset, ITG ielemnr, ITG nterms, ITG konl))

void	biosav (ITG ipkon, ITG kon, char lakon, ITG ne, double co, double qfx, double h0, ITG mi, ITG inomat, ITG nk)

void	FORTRAN (biotsavart,(ITG ipkon, ITG kon, char lakon, ITG ne, double co, double qfx, double h0, ITG mi, ITG nka, ITG nkb))

void *	biotsavartmt (ITG *i)

void	FORTRAN (blockanalysis,(char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, ITG nblk, ITG ipkon, ITG kon, ITG ielfa, ITG nodface, ITG neiel, ITG neij, ITG neifa, ITG ipoface, ITG ipnei, ITG konf, ITG istartblk, ITG iendblk, ITG nactdoh, ITG nblket, ITG nblkze, ITG nef, ITG ielblk, ITG nk, ITG *nactdohinv))

void	FORTRAN (bodyforce,(char cbody, ITG ibody, ITG ipobody, ITG nbody, char set, ITG istartset, ITG iendset, ITG ialset, ITG inewton, ITG nset, ITG ifreebody, ITG k))

void	FORTRAN (calcbody,(ITG nef, double body, ITG ipobody, ITG ibody, double xbody, double coel, double vel, char lakon, ITG *nactdohinv))

void	FORTRAN (calcguesstincf,(ITG nface, double dmin, double vfa, double umfa, double cvfa, double hcfa, ITG ithermal, double tincfguess, ITG *compressible))

void	FORTRAN (calcinitialflux,(double area, double vfa, double xxn, ITG ipnei, ITG nef, ITG neifa, char lakonf, double flux))

void	FORTRAN (calccvel,(ITG nef, double vel, double shcon, ITG nshcon, ITG ielmatf, ITG ntmat_, ITG mi, double cvel, double *physcon))

void	FORTRAN (calccvelcomp,(ITG nef, double vel, double shcon, ITG nshcon, ITG ielmatf, ITG ntmat_, ITG mi, double cvel, double *physcon))

void	FORTRAN (calccvfa,(ITG nface, double vfa, double shcon, ITG nshcon, ITG ielmatf, ITG ntmat_, ITG mi, ITG ielfa, double cvfa, double physcon))

void	FORTRAN (calccvfacomp,(ITG nface, double vfa, double shcon, ITG nshcon, ITG ielmatf, ITG ntmat_, ITG mi, ITG ielfa, double cvfa, double physcon))

void	FORTRAN (calcgamma,(ITG nface, ITG ielfa, double vel, double gradvel, double gamma, double xlet, double xxn, double xxj, ITG ipnei, double betam, ITG nef, double flux))

void	FORTRAN (calcgammak,(ITG nface, ITG ielfa, double vel, double gradkel, double gamma, double xlet, double xxn, double xxj, ITG ipnei, double betam, ITG nef, double flux))

void	FORTRAN (calcgammao,(ITG nface, ITG ielfa, double vel, double gradoel, double gamma, double xlet, double xxn, double xxj, ITG ipnei, double betam, ITG nef, double flux))

void	FORTRAN (calcgammap,(ITG nface, ITG ielfa, double vel, double gradpel, double gamma, double xlet, double xxn, double xxj, ITG ipnei, double betam, ITG nef, double flux))

void	FORTRAN (calcgammat,(ITG nface, ITG ielfa, double vel, double gradtel, double gamma, double xlet, double xxn, double xxj, ITG ipnei, double betam, ITG nef, double flux))

void	FORTRAN (calcgradkel,(ITG ne, char lakon, ITG ipnei, double vfa, double area, double xxn, double gradkel, ITG neifa, double *volume))

void	FORTRAN (calcgradoel,(ITG ne, char lakon, ITG ipnei, double vfa, double area, double xxn, double gradoel, ITG neifa, double *volume))

void	FORTRAN (calcgradpel,(ITG ne, char lakon, ITG ipnei, double vfa, double area, double xxn, double gradpel, ITG neifa, double *volume))

void	FORTRAN (calcgradtel,(ITG ne, char lakon, ITG ipnei, double vfa, double area, double xxn, double gradtel, ITG neifa, double *volume))

void	FORTRAN (calcgradvel,(ITG ne, char lakon, ITG ipnei, double vfa, double area, double xxn, double gradv, ITG neifa, double *volume))

void	FORTRAN (calchcel,(double vel, double cocon, ITG ncocon, ITG ielmatf, ITG ntmat_, ITG mi, double hcel, ITG nef))

void	FORTRAN (calchcfa,(ITG nface, double vfa, double cocon, ITG ncocon, ITG ielmatf, ITG ntmat_, ITG mi, ITG ielfa, double *hcfa))

void	FORTRAN (calch0interface,(ITG nmpc, ITG ipompc, ITG nodempc, double coefmpc, double *h0))

void	FORTRAN (calcmac,(ITG neq, double z, double zz, ITG nev, double mac, double maccpx, ITG istartnmd, ITG iendnmd, ITG nmd, ITG cyclicsymmetry, ITG neqact, double bett, double *betm))

void	FORTRAN (calcmass,(ITG ipkon, char lakon, ITG kon, double co, ITG mi, ITG nelem, ITG ne, double thicke, ITG ielmat, ITG nope, double t0, double t1, double rhcon, ITG nrhcon, ITG ntmat_, ITG ithermal, double csmass, ITG ielprop, double *prop))

void	FORTRAN (calcmatwavspeed,(ITG ne0, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double orab, ITG ntmat_, ITG ithermal, double alzero, double plicon, ITG nplicon, double plkcon, ITG nplkcon, ITG npmat_, ITG mi, double dtime, double xstiff, ITG ncmat_, double vold, ITG ielmat, double t0, double t1, char matname, char lakon, double xmatwavespeed, ITG nmat, ITG *ipkon))

void	FORTRAN (calcpel,(ITG ne, ITG nactdoh, double vel, double b, ITG *nef))

void	calcresidual (ITG nmethod, ITG neq, double b, double fext, double f, ITG iexpl, ITG nactdof, double aux2, double vold, double vini, double dtime, double accold, ITG nk, double adb, double aub, ITG icol, ITG irow, ITG nzl, double alpha, double fextini, double fini, ITG islavnode, ITG nslavnode, ITG mortar, ITG ntie, double f_cm, double f_cs, ITG mi, ITG nzs, ITG nasym, ITG idamping, double veold, double adc, double auc, double cvini, double cv)

void	calcresidual_em (ITG nmethod, ITG neq, double b, double fext, double f, ITG iexpl, ITG nactdof, double aux1, double aux2, double vold, double vini, double dtime, double accold, ITG nk, double adb, double aub, ITG icol, ITG irow, ITG nzl, double alpha, double fextini, double fini, ITG islavnode, ITG nslavnode, ITG mortar, ITG ntie, double f_cm, double f_cs, ITG mi, ITG nzs, ITG nasym, ITG ithermal)

void	FORTRAN (calcrhoel,(ITG nef, double vel, double rhcon, ITG nrhcon, ITG ielmatf, ITG ntmat_, ITG ithermal, ITG mi))

void	FORTRAN (calcrhoelcomp,(ITG nef, double vel, double shcon, ITG ielmatf, ITG ntmat_, ITG mi))

void	FORTRAN (calcrhofa,(ITG nface, double vfa, double rhcon, ITG nrhcon, ITG ielmatf, ITG ntmat_, ITG ithermal, ITG mi, ITG *ielfa))

void	FORTRAN (calcrhofacomp,(ITG nface, double vfa, double shcon, ITG ielmatf, ITG ntmat_, ITG mi, ITG ielfa, ITG ipnei, double vel, ITG nef, double flux, double gradpel, double gradtel, double xxj, double betam, double xlet))

void	FORTRAN (calcstabletimeinccont,(ITG ne, char lakon, ITG kon, ITG ipkon, ITG mi, ITG ielmat, double elcon, ITG mortar, double adb, double alpha, ITG nactdof, double springarea, ITG ne0, ITG ntmat_, ITG ncmat_, double dtcont))

void	FORTRAN (calcstabletimeincvol,(ITG ne0, char lakon, double co, ITG kon, ITG ipkon, ITG mi, ITG ielmat, double dtvol, double alpha, double xmatwavespeed))

void	FORTRAN (calcstressheatflux,(double sti, double umel, double gradvel, double qfx, double hcel, double gradtel, ITG nef, ITG isti, ITG iqfx, ITG mi))

void	FORTRAN (calctel,(ITG ne, ITG nactdoh, double vel, double b, ITG *nef))

void	FORTRAN (calcumel,(ITG nef, double vel, double shcon, ITG nshcon, ITG ielmatf, ITG ntmat_, ITG ithermal, ITG mi, double *umel))

void	FORTRAN (calcumfa,(ITG nface, double vfa, double shcon, ITG nshcon, ITG ielmatf, ITG ntmat_, ITG ithermal, ITG mi, ITG ielfa, double umfa))

void	FORTRAN (calcvel,(ITG ne, ITG nactdoh, double vel, double b, ITG neq, ITG nef))

void	FORTRAN (calcview,(char sideload, double vold, double co, double pmid, double e1, double e2, double e3, ITG kontri, ITG nloadtr, double adview, double auview, double dist, ITG idist, double area, ITG ntrit, ITG mi, ITG jqrad, ITG irowrad, ITG nzsrad, double sidemean, ITG ntria, ITG ntrib, char covered, ITG ng))

void *	calcviewmt (ITG *i)

void	FORTRAN (calinput,(double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG nkon, ITG ne, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, ITG nmpc_, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nforc_, ITG nelemload, char sideload, double xload, ITG nload, ITG nload_, ITG nprint, char prlab, char prset, ITG mpcfree, ITG nboun_, ITG mei, char set, ITG istartset, ITG iendset, ITG ialset, ITG nset, ITG nalset, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, double t0, double t1, char matname, ITG ielmat, char orname, double orab, ITG ielorien, char amname, double amta, ITG namta, ITG nam, ITG nmethod, ITG iamforc, ITG iamload, ITG iamt1, ITG ithermal, ITG iperturb, ITG istat, ITG istep, ITG nmat, ITG ntmat_, ITG norien, double prestr, ITG iprestr, ITG isolver, double fei, double veold, double timepar, double xmodal, char filab, ITG jout, ITG nlabel, ITG idrct, ITG jmax, ITG iexpl, double alpha, ITG iamboun, double plicon, ITG nplicon, double plkcon, ITG nplkcon, ITG iplas, ITG npmat_, ITG mi, ITG nk_, double trab, ITG inotr, ITG ntrans, ITG ikboun, ITG ilboun, ITG ikmpc, ITG ilmpc, ITG ics, double dcs, ITG ncs_, ITG namtot_, double cs, ITG nstate_, ITG ncmat_, ITG iumat, ITG mcs, char labmpc, ITG iponor, double xnor, ITG knor, double thickn, double thicke, ITG ikforc, ITG ilforc, double offset, ITG iponoel, ITG inoel, ITG rig, ITG infree, ITG nshcon, double shcon, double cocon, ITG ncocon, double physcon, ITG nflow, double ctrl, ITG maxlenmpc, ITG ne1d, ITG ne2d, ITG nener, double vold, ITG nodebounold, ITG ndirbounold, double xbounold, double xforcold, double xloadold, double t1old, double eme, double sti, double ener, double xstate, char jobnamec, ITG irstrt, double ttime, double qaold, char output, char typeboun, char inpc, ITG ipoinp, ITG inp, char tieset, double tietol, ITG ntie, double fmpc, char cbody, ITG ibody, double xbody, ITG nbody, ITG nbody_, double xbodyold, ITG nam_, ITG ielprop, ITG nprop, ITG nprop_, double prop, ITG itpamp, ITG iviewfile, ITG ipoinpc, ITG cfd, ITG nslavs, double t0g, double t1g, ITG network, ITG cyclicsymmetry, ITG idefforc, ITG idefload, ITG idefbody, ITG mortar, ITG ifacecount, ITG islavsurf, double pslavsurf, double clearini, char heading, ITG iaxial, ITG nobject, char objectset, ITG nprint_, ITG iuel, ITG nuel_, ITG nodempcref, double coefmpcref, ITG ikmpcref, ITG memmpcref_, ITG mpcfreeref, ITG maxlenmpcref, ITG memmpc_))

void	cascade (ITG ipompc, double coefmpcp, ITG nodempcp, ITG nmpc, ITG mpcfree, ITG nodeboun, ITG ndirboun, ITG nboun, ITG ikmpc, ITG ilmpc, ITG ikboun, ITG ilboun, ITG mpcend, char labmpc, ITG nk, ITG memmpc_, ITG icascade, ITG maxlenmpc, ITG callfrommain, ITG iperturb, ITG *ithermal)

void	FORTRAN (cataloguenodes,(ITG iponofa, ITG inofa, ITG ifreefa, ITG ielfa, ITG ifaboun, ITG ipkon, ITG kon, char lakon, ITG nface, ITG ne))

ITG	cgsolver (double A, double x, double b, ITG neq, ITG len, ITG ia, ITG iz, double eps, ITG *niter, ITG precFlg)

void	checkconvergence (double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, double stn, ITG nmethod, ITG kode, char filab, double een, double t1act, double time, double epn, ITG ielmat, char matname, double enern, double xstaten, ITG nstate_, ITG istep, ITG iinc, ITG iperturb, double ener, ITG mi, char output, ITG ithermal, double qfn, ITG mode, ITG noddiam, double trab, ITG inotr, ITG ntrans, double orab, ITG ielorien, ITG norien, char description, double sti, ITG icutb, ITG iit, double dtime, double qa, double vold, double qam, double ram1, double ram2, double ram, double cam, double uam, ITG ntg, double ttime, ITG icntrl, double theta, double dtheta, double veold, double vini, ITG idrct, double tper, ITG istab, double tmax, ITG nactdof, double b, double tmin, double ctrl, double amta, ITG namta, ITG itpamp, ITG inext, double dthetaref, ITG itp, ITG jprint, ITG jout, ITG uncoupled, double t1, ITG iitterm, ITG nelemload, ITG nload, ITG nodeboun, ITG nboun, ITG itg, ITG ndirboun, double deltmx, ITG iflagact, char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, double emn, double thicke, char jobnamec, ITG mortar, ITG nmat, ITG ielprop, double prop, ITG ialeatoric, ITG kscale, double energy, double allwk, double energyref, double emax, double enres, double enetoll, double energyini, double allwkini, double temax, double reswk, ITG ne0, ITG neini, double dampwk, double dampwkini, double *energystartstep)

void	checkconvnet (ITG icutb, ITG iin, double cam1t, double cam1f, double cam1p, double cam2t, double cam2f, double cam2p, double camt, double camf, double camp, ITG icntrl, double dtheta, double ctrl, double cam1a, double cam2a, double cama, double vamt, double vamf, double vamp, double vama, double qa, double qamt, double qamf, double ramt, double ramf, double ramp, ITG iplausi)

void	FORTRAN (checkconstraint,(ITG nobject, char objectset, double g0, ITG nactive, ITG nnlconst, ITG ipoacti, ITG ndesi, double dgdxglob, ITG nk, ITG nodedesi))

void	checkdivergence (double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, double stn, ITG nmethod, ITG kode, char filab, double een, double t1act, double time, double epn, ITG ielmat, char matname, double enern, double xstaten, ITG nstate_, ITG istep, ITG iinc, ITG iperturb, double ener, ITG mi, char output, ITG ithermal, double qfn, ITG mode, ITG noddiam, double trab, ITG inotr, ITG ntrans, double orab, ITG ielorien, ITG norien, char description, double sti, ITG icutb, ITG iit, double dtime, double qa, double vold, double qam, double ram1, double ram2, double ram, double cam, double uam, ITG ntg, double ttime, ITG icntrl, double theta, double dtheta, double veold, double vini, ITG idrct, double tper, ITG istab, double tmax, ITG nactdof, double b, double tmin, double ctrl, double amta, ITG namta, ITG itpamp, ITG inext, double dthetaref, ITG itp, ITG jprint, ITG jout, ITG uncoupled, double t1, ITG iitterm, ITG nelemload, ITG nload, ITG nodeboun, ITG nboun, ITG itg, ITG ndirboun, double deltmx, ITG iflagact, char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, double emn, double thicke, char jobnamec, ITG mortar, ITG nmat, ITG ielprop, double prop, ITG ialeatoric, ITG kscale, double energy, double allwk, double energyref, double emax, double enres, double enetoll, double energyini, double allwkini, double temax, double reswk, ITG ne0, ITG neini, double dampwk, double dampwkini, double *energystartstep)

void	checkinclength (double time, double ttime, double theta, double dtheta, ITG idrct, double tper, double tmax, double tmin, double ctrl, double amta, ITG namta, ITG itpamp, ITG inext, double dthetaref, ITG itp, ITG jprint, ITG *jout)

void	FORTRAN (checkimpacts,(ITG ne, ITG neini, double temax, double sizemaxinc, double energyref, double tmin, double tper, ITG idivergence, ITG idirinctime, ITG istab, double dtheta, double enres, double energy, double energyini, double allwk, double allwkini, double dampwk, double dampwkini, double emax, ITG mortar, double maxdecay, double enetoll))

void	FORTRAN (checkinputvaluesnet,(ITG ieg, ITG nflow, double prop, ITG ielprop, char *lakon))

void	FORTRAN (checktime,(ITG itpamp, ITG namta, double tinc, double ttime, double amta, double tmin, ITG inext, ITG itp, ITG istep, double tper))

void	FORTRAN (checktruecontact,(ITG ntie, char tieset, double tietol, double elcon, ITG itruecontact, ITG ncmat_, ITG *ntmat_))

void	FORTRAN (closefile,())

void	FORTRAN (closefilefluid,())

void	compfluid (double *cop, ITG nk, ITG *ipkonp, ITG konf, char lakonp, char sideface, ITG ifreestream, ITG nfreestream, ITG isolidsurf, ITG neighsolidsurf, ITG nsolidsurf, ITG nshcon, double shcon, ITG nrhcon, double rhcon, double voldp, ITG ntmat_, ITG nodeboun, ITG ndirboun, ITG nboun, ITG ipompc, ITG nodempc, ITG nmpc, ITG ikmpc, ITG ilmpc, ITG ithermal, ITG ikboun, ITG ilboun, ITG turbulent, ITG isolver, ITG iexpl, double ttime, double time, double dtime, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemload, char sideload, double xload, ITG nload, double xbody, ITG ipobody, ITG nbody, ITG ielmatf, char matname, ITG mi, ITG ncmat_, double physcon, ITG istep, ITG iinc, ITG ibody, double xloadold, double xboun, double coefmpc, ITG nmethod, double xforcold, double xforcact, ITG iamforc, ITG iamload, double xbodyold, double xbodyact, double t1old, double t1, double t1act, ITG iamt1, double amta, ITG namta, ITG nam, double ampli, double xbounold, double xbounact, ITG iamboun, ITG itg, ITG ntg, char amname, double t0, ITG nelemface, ITG nface, double cocon, ITG ncocon, double xloadact, double tper, ITG jmax, ITG jout, char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, char prset, char prlab, ITG nprint, double trab, ITG inotr, ITG ntrans, char filab, char labmpc, double sti, ITG norien, double orab, char jobnamef, char tieset, ITG ntie, ITG mcs, ITG ics, double cs, ITG nkon, ITG mpcfree, ITG memmpc_, double fmpc, ITG nef, ITG inomat, double qfx, ITG neifa, ITG neiel, ITG ielfa, ITG ifaext, double vfa, double vel, ITG ipnei, ITG nflnei, ITG nfaext, char typeboun, ITG neij, double tincf, ITG nactdoh, ITG nactdohinv, ITG ielorien, char jobnamec, ITG ifatie, ITG nstate_, double xstate, char orname, ITG nblk, ITG ielblk, ITG istartblk, ITG iendblk, ITG nblket, ITG nblkze, ITG *kon)

void	FORTRAN (complete_hel,(ITG neq, double b, double hel, double ad, double au, ITG jq, ITG irow, ITG nzs))

void	FORTRAN (complete_hel_blk,(double vel, double hel, double auv6, ITG ipnei, ITG neiel, ITG nef, ITG *nactdohinv))

void	FORTRAN (complete_hel_cyclic,(ITG neq, double b, double hel, double ad, double au, ITG jq, ITG irow, ITG ipnei, ITG neiel, ITG ifatie, double c, char lakonf, ITG neifa, ITG nzs))

void	FORTRAN (complete_hel_cyclic_blk,(double vel, double hel, double auv6, double c, ITG ipnei, ITG neiel, ITG neifa, ITG ifatie, ITG *nef))

void	complete_hel_blk_main (double vel, double hel, double auv6, double c, ITG ipnei, ITG neiel, ITG neifa, ITG ifatie, ITG *nef)

void	complexfreq (double *cop, ITG nk, ITG konp, ITG ipkonp, char *lakonp, ITG ne, ITG nodebounp, ITG ndirbounp, double *xbounp, ITG nboun, ITG ipompcp, ITG nodempcp, double coefmpcp, char labmpcp, ITG nmpc, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemload, char sideload, double xload, ITG nload, ITG nactdofp, ITG neq, ITG nzl, ITG icol, ITG irow, ITG nmethod, ITG ikmpcp, ITG ilmpcp, ITG ikbounp, ITG ilbounp, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double cocon, ITG ncocon, double alcon, ITG nalcon, double alzero, ITG ielmatp, ITG ielorienp, ITG norien, double orab, ITG ntmat_, double t0p, double t1p, ITG ithermal, double prestr, ITG iprestr, double voldp, ITG iperturb, double *stip, ITG nzs, double timepar, double xmodal, double *veoldp, char amname, double amta, ITG namta, ITG nam, ITG iamforc, ITG iamload, ITG iamt1p, ITG jout, ITG kode, char filab, double *emep, double xforcold, double xloadold, double t1oldp, ITG iambounp, double xbounoldp, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstate, ITG npmat_, char matname, ITG mi, ITG ncmat_, ITG nstate_, double *enerp, char jobnamec, double ttime, char set, ITG nset, ITG istartset, ITG iendset, ITG ialsetp, ITG nprint, char prlab, char prset, ITG nener, double trab, ITG *inotrp, ITG ntrans, double *fmpcp, char cbody, ITG ibody, double xbody, ITG nbody, double xbodyold, ITG istep, ITG isolver, ITG jq, char output, ITG mcs, ITG nkon, ITG mpcend, ITG ics, double cs, ITG ntie, char tieset, ITG idrct, ITG jmax, double ctrl, ITG itpamp, double tietol, ITG nalset, ITG ikforc, ITG ilforc, double thicke, char jobnamef, ITG mei, ITG nmat, ITG ielprop, double prop, char orname)

void	contact (ITG ncont, ITG ntie, char tieset, ITG nset, char set, ITG istartset, ITG iendset, ITG ialset, ITG itietri, char lakon, ITG ipkon, ITG kon, ITG koncont, ITG ne, double cg, double straight, ITG ifree, double co, double vold, ITG ielmat, double cs, double elcon, ITG istep, ITG iinc, ITG iit, ITG ncmat_, ITG ntmat_, ITG ne0, double vini, ITG nmethod, ITG iperturb, ITG ikboun, ITG nboun, ITG mi, ITG imastop, ITG nslavnode, ITG islavnode, ITG islavsurf, ITG itiefac, double areaslav, ITG iponoels, ITG inoels, double springarea, double tietol, double reltime, ITG imastnode, ITG nmastnode, double xmastnor, char filab, ITG mcs, ITG ics, ITG nasym, double xnoels, ITG mortar, double pslavsurf, double pmastsurf, double clearini, double theta, double xstateini, double xstate, ITG nstate_, ITG icutb, ITG ialeatoric, char jobnamef)

void	FORTRAN (convert2slapcol,(double au, double ad, ITG jq, ITG nzs, ITG nef, double aua))

void	FORTRAN (coriolissolve,(double cc, ITG nev, double aa, double bb, double xx, double eiga, double eigb, double eigxx, ITG iter, double d, double *temp))

void	FORTRAN (correctvel,(double hel, double adv, double vfa, ITG ipnei, double area, double bv, double xxn, ITG neifa, char lakon, ITG ne, ITG *neq))

void	FORTRAN (correctvfa,(ITG nface, ITG ielfa, double area, double vfa, double ap, double bp, double xxn, ITG ifabou, ITG ipnei, ITG nef, ITG neifa, double hfa, double vel, double xboun, char lakonf, double flux))

void	FORTRAN (createfint,(ITG ne, ITG ipkon, char lakon, ITG kon, ITG nactdof, ITG mi, double fn0, double fint))

void	FORTRAN (createialdesi,(ITG ndesi, ITG nodedesi, ITG iponoel, ITG inoel, ITG istartdesi, ITG ialdesi, char lakon, ITG ipkon, ITG kon, ITG nodedesiinv, ITG icoordinate, ITG noregion))

void	FORTRAN (createialelem,(ITG ne, ITG istartelem, ITG ialelem, ITG ipoeldi, ITG *ieldi))

void	FORTRAN (createinterfacempcs,(ITG imastnode, double xmastnor, ITG nmastnode, ITG ikmpc, ITG ilmpc, ITG nmpc, ITG ipompc, ITG nodempc, double coefmpc, char labmpc, ITG mpcfree, ITG ikboun, ITG *nboun))

void	FORTRAN (createinum,(ITG ipkon, ITG inum, ITG kon, char lakon, ITG nk, ITG ne, char cflag, ITG nelemload, ITG nload, ITG nodeboun, ITG nboun, ITG ndirboun, ITG ithermal, double co, double vold, ITG mi, ITG *ielmat))

void	FORTRAN (createmddof,(ITG imddof, ITG nmddof, ITG istartset, ITG iendset, ITG ialset, ITG nactdof, ITG ithermal, ITG mi, ITG imdnode, ITG nmdnode, ITG ikmpc, ITG ilmpc, ITG ipompc, ITG nodempc, ITG nmpc, ITG imdmpc, ITG nmdmpc, ITG imdboun, ITG nmdboun, ITG ikboun, ITG nboun, ITG nset, ITG ntie, char tieset, char set, char lakon, ITG kon, ITG ipkon, char labmpc, ITG ilboun, char filab, char prlab, char prset, ITG nprint, ITG ne, ITG cyclicsymmetry))

void	FORTRAN (createmdelem,(ITG imdnode, ITG nmdnode, double xforc, ITG ikmpc, ITG ilmpc, ITG ipompc, ITG nodempc, ITG nmpc, ITG imddof, ITG nmddof, ITG nactdof, ITG mi, ITG imdmpc, ITG nmdmpc, ITG imdboun, ITG nmdboun, ITG ikboun, ITG nboun, ITG ilboun, ITG ithermal, ITG imdelem, ITG nmdelem, ITG iponoel, ITG inoel, char prlab, char prset, ITG nprint, char lakon, char set, ITG nset, ITG ialset, ITG ipkon, ITG kon, ITG istartset, ITG iendset, ITG nforc, ITG ikforc, ITG ilforc))

void	FORTRAN (createtiedsurfs,(ITG nodface, ITG ipoface, char set, ITG istartset, ITG iendset, ITG ialset, char tieset, ITG inomat, ITG ne, ITG ipkon, char lakon, ITG kon, ITG ntie, double tietol, ITG nalset, ITG nk, ITG nset, ITG iactive))

void	FORTRAN (create_iau6,(ITG nef, ITG ipnei, ITG neiel, ITG jq, ITG irow, ITG nzs, ITG iau6, char lakonf))

void	FORTRAN (dattime,(char date, char clock))

void	CEE (ddotc,(ITG n, double dx, ITG incx, double dy, ITG incy, double funcddot))

void *	ddotc1mt (ITG *i)

void	FORTRAN (desiperelem,(ITG ndesi, ITG istartdesi, ITG ialdesi, ITG ipoeldi, ITG ieldi, ITG ne))

void	dfdbj (double bcont, double dbcontp, ITG neq, ITG nope, ITG konl, ITG nactdof, double s, double z, ITG ikmpc, ITG ilmpc, ITG ipompc, ITG nodempc, ITG nmpc, double coefmpc, double fnl, ITG nev, ITG ikactcontp, ITG ilactcontp, ITG nactcont, ITG nactcont_, ITG mi, ITG cyclicsymmetry, ITG izdof, ITG *nzdof)

void	FORTRAN (dgesv,(ITG nteq, ITG nhrs, double ac, ITG lda, ITG ipiv, double bc, ITG ldb, ITG info))

void	FORTRAN (dgetrs,(char trans, ITG nteq, ITG nrhs, double ac, ITG lda, ITG ipiv, double bc, ITG ldb, ITG *info))

void	FORTRAN (drfftf,(ITG ndata, double r, double wsave, ITG isave))

void	FORTRAN (drffti,(ITG ndata, double wsave, ITG *isave))

void	FORTRAN (dnaupd,(ITG ido, char bmat, ITG n, char which, ITG nev, double tol, double resid, ITG ncv, double z, ITG ldz, ITG iparam, ITG ipntr, double workd, double workl, ITG lworkl, ITG info))

void	FORTRAN (dsaupd,(ITG ido, char bmat, ITG n, char which, ITG nev, double tol, double resid, ITG ncv, double z, ITG ldz, ITG iparam, ITG ipntr, double workd, double workl, ITG lworkl, ITG info))

void	FORTRAN (dneupd,(ITG rvec, char howmny, ITG select, double d, double di, double z, ITG ldz, double sigma, double sigmai, double workev, char bmat, ITG neq, char which, ITG nev, double tol, double resid, ITG ncv, double v, ITG ldv, ITG iparam, ITG ipntr, double workd, double workl, ITG lworkl, ITG *info))

void	FORTRAN (dseupd,(ITG rvec, char howmny, ITG select, double d, double z, ITG ldz, double sigma, char bmat, ITG neq, char which, ITG nev, double tol, double resid, ITG ncv, double v, ITG ldv, ITG iparam, ITG ipntr, double workd, double workl, ITG lworkl, ITG info))

void	FORTRAN (dsort,(double dx, ITG iy, ITG n, ITG kflag))

void	dyna (double *cop, ITG nk, ITG konp, ITG ipkonp, char *lakonp, ITG ne, ITG nodebounp, ITG ndirbounp, double *xbounp, ITG nboun, ITG ipompcp, ITG nodempcp, double coefmpcp, char labmpcp, ITG nmpc, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemload, char sideload, double xload, ITG nload, ITG nactdofp, ITG neq, ITG nzl, ITG icol, ITG irow, ITG nmethod, ITG ikmpcp, ITG ilmpcp, ITG ikbounp, ITG ilbounp, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double cocon, ITG ncocon, double alcon, ITG nalcon, double alzero, ITG ielmatp, ITG ielorienp, ITG norien, double orab, ITG ntmat_, double t0p, double t1p, ITG ithermal, double prestr, ITG iprestr, double voldp, ITG iperturb, double *stip, ITG nzs, double timepar, double xmodal, double *veoldp, char amname, double amta, ITG namta, ITG nam, ITG iamforc, ITG iamload, ITG iamt1p, ITG jout, ITG kode, char filab, double *emep, double xforcold, double xloadold, double t1oldp, ITG iambounp, double xbounoldp, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double *xstatep, ITG npmat_, char matname, ITG mi, ITG ncmat_, ITG nstate_, double *enerp, char jobnamec, double ttime, char set, ITG nset, ITG istartset, ITG iendset, ITG ialsetp, ITG nprint, char prlab, char prset, ITG nener, double trab, ITG *inotrp, ITG ntrans, double *fmpcp, char cbody, ITG ibody, double xbody, ITG nbody, double xbodyold, ITG istep, ITG isolver, ITG jq, char output, ITG mcs, ITG nkon, ITG mpcend, ITG ics, double cs, ITG ntie, char tieset, ITG idrct, ITG jmax, double ctrl, ITG itpamp, double tietol, ITG nalset, ITG ikforc, ITG ilforc, double thicke, ITG nslavs, ITG nmat, char typeboun, ITG ielprop, double prop, char orname)

void	dynacont (double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, char labmpc, ITG nmpc, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemload, char sideload, double xload, ITG nload, ITG nactdof, ITG neq, ITG nzl, ITG icol, ITG irow, ITG nmethod, ITG ikmpc, ITG ilmpc, ITG ikboun, ITG ilboun, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double cocon, ITG ncocon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, double prestr, ITG iprestr, double vold, ITG iperturb, double sti, ITG nzs, double tinc, double tper, double xmodal, double veold, char amname, double amta, ITG namta, ITG nam, ITG iamforc, ITG iamload, ITG iamt1, ITG jout, char filab, double eme, double xforcold, double xloadold, double t1old, ITG iamboun, double xbounold, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstate, ITG npmat_, char matname, ITG mi, ITG ncmat_, ITG nstate_, double ener, char jobnamec, double ttime, char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, ITG nprint, char prlab, char prset, ITG nener, double trab, ITG inotr, ITG ntrans, double fmpc, char cbody, ITG ibody, double xbody, ITG nbody, double xbodyold, ITG istep, ITG isolver, ITG jq, char output, ITG mcs, ITG nkon, ITG mpcend, ITG ics, double cs, ITG ntie, char tieset, ITG idrct, ITG jmax, double tmin, double tmax, double ctrl, ITG itpamp, double tietol, ITG iit, ITG ncont, ITG ne0, double reltime, double dtime, double bcontini, double bj, double aux, ITG iaux, double bcont, ITG nev, double v, ITG nkon0, double deltmx, double dtheta, double theta, ITG iprescribedboundary, ITG mpcfree, ITG memmpc_, ITG itietri, ITG koncont, double cg, double straight, ITG iinc, double vini, double aa, double bb, double aanew, double d, double z, double zeta, double b, double time0, double time1, ITG ipobody, double xforcact, double xloadact, double t1act, double xbounact, double xbodyact, double cd, double cv, double ampli, double dthetaref, double bjp, double bp, double cstr, ITG imddof, ITG nmddof, ITG *ikactcontp, ITG nactcont, ITG nactcont_, double aamech, double bprev, ITG iprev, ITG inonlinmpc, ITG ikactmechp, ITG nactmech, ITG imdnode, ITG nmdnode, ITG imdboun, ITG nmdboun, ITG imdmpc, ITG nmdmpc, ITG itp, ITG inext, ITG imastop, ITG nslavnode, ITG islavnode, ITG islavsurf, ITG itiefac, double areaslav, ITG iponoels, ITG inoels, double springarea, ITG izdof, ITG nzdof, double fn, ITG imastnode, ITG nmastnode, double xmastnor, double xstateini, ITG nslavs, ITG cyclicsymmetry, double xnoels, ITG ielas, ITG ielprop, double prop)

void	dynboun (double amta, ITG namta, ITG nam, double ampli, double time, double ttime, double dtime, double xbounold, double xboun, double xbounact, ITG iamboun, ITG nboun, ITG nodeboun, ITG ndirboun, double ad, double au, double adb, double aub, ITG icol, ITG irow, ITG neq, ITG nzs, double sigma, double b, ITG isolver, double alpham, double betam, ITG nzl, ITG init, double bact, double bmin, ITG jq, char amname, double bv, double bprev, double bdiff, ITG nactmech, ITG icorrect, ITG *iprev)

void	FORTRAN (dynresults,(ITG nk, double v, ITG ithermal, ITG nactdof, double vold, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, char labmpc, ITG nmpc, double b, double bp, double veold, double dtime, ITG mi, ITG imdnode, ITG nmdnode, ITG imdboun, ITG nmdboun, ITG imdmpc, ITG nmdmpc, ITG nmethod, double *time))

void	FORTRAN (effectivemodalmass,(ITG neq, ITG nactdof, ITG mi, double adb, double aub, ITG jq, ITG irow, ITG nev, double z, double co, ITG *nk))

void	electromagnetics (double *co, ITG nk, ITG konp, ITG ipkonp, char *lakonp, ITG ne, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompcp, ITG nodempcp, double coefmpcp, char labmpcp, ITG nmpc, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemloadp, char sideloadp, double xload, ITG nload, ITG nactdof, ITG *icolp, ITG jq, ITG *irowp, ITG neq, ITG nzl, ITG nmethod, ITG ikmpcp, ITG ilmpcp, ITG ikboun, ITG ilboun, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmatp, ITG ielorienp, ITG norien, double orab, ITG ntmat_, double t0, double t1, double t1old, ITG ithermal, double prestr, ITG iprestr, double *vold, ITG iperturb, double sti, ITG nzs, ITG kode, char filab, ITG idrct, ITG jmax, ITG jout, double timepar, double eme, double xbounold, double xforcold, double xloadold, double veold, double accold, char amname, double amta, ITG namta, ITG nam, ITG iamforc, ITG iamloadp, ITG iamt1, double alpha, ITG iexpl, ITG iamboun, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstatep, ITG npmat_, ITG istep, double ttime, char matname, double qaold, ITG mi, ITG isolver, ITG ncmat_, ITG nstate_, ITG iumat, double cs, ITG mcs, ITG nkon, double *ener, ITG mpcinfo, char output, double shcon, ITG nshcon, double cocon, ITG ncocon, double physcon, ITG nflow, double ctrl, char *setp, ITG nset, ITG istartsetp, ITG iendsetp, ITG *ialsetp, ITG nprint, char prlab, char prset, ITG nener, ITG ikforc, ITG ilforc, double trab, ITG inotr, ITG ntrans, double *fmpcp, char cbody, ITG ibody, double xbody, ITG nbody, double xbodyold, ITG ielprop, double prop, ITG ntie, char tiesetp, ITG itpamp, ITG iviewfile, char jobnamec, double *tietolp, ITG nslavs, double thicke, ITG ics, ITG nalset, ITG nmpc_, ITG nmat, char typeboun, ITG iaxial, ITG nload_, ITG nprop, ITG network, char *orname)

void	FORTRAN (elementpernode,(ITG iponoel, ITG inoel, char lakon, ITG ipkon, ITG kon, ITG ne, ITG *inoelsize))

void	FORTRAN (elementperorien,(ITG ipoorel, ITG iorel, ITG ielorien, ITG ne, ITG *mi))

void	FORTRAN (envtemp,(ITG itg, ITG ieg, ITG ntg, ITG ntr, char sideload, ITG nelemload, ITG ipkon, ITG kon, char lakon, ITG ielmat, ITG ne, ITG nload, ITG kontri, ITG ntri, ITG nloadtr, ITG nflow, ITG ndirboun, ITG nactdog, ITG nodeboun, ITG nacteq, ITG nboun, ITG ielprop, double prop, ITG nteq, double v, ITG network, double physcon, double shcon, ITG ntmat_, double co, double vold, char set, ITG nshcon, double rhcon, ITG nrhcon, ITG mi, ITG nmpc, ITG nodempc, ITG ipompc, char labmpc, ITG ikboun, ITG nasym, double ttime, double time, ITG *iaxial))

void	FORTRAN (equationcheck,(double ac, ITG nteq, ITG nactdog, ITG itg, ITG ntg, ITG nacteq, ITG *network))

void	FORTRAN (errorestimator,(double yi, double yn, ITG ipkon, ITG kon, char lakon, ITG nk, ITG ne, ITG mi, ITG ielmat, ITG nterms, ITG inum, double co, double vold, char cflag))

void	FORTRAN (rotationvector,(double a, double euler))

void	FORTRAN (rotationvectorinv,(double a, double euler))

void	expand (double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, char labmpc, ITG nmpc, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemload, char sideload, double xload, ITG nload, ITG nactdof, ITG neq, ITG nmethod, ITG ikmpc, ITG ilmpc, ITG ikboun, ITG ilboun, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, ITG ithermal, double prestr, ITG iprestr, double vold, ITG iperturb, double sti, ITG nzs, double adb, double aub, char filab, double eme, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstate, ITG npmat_, char matname, ITG mi, ITG ics, double cs, ITG mpcend, ITG ncmat_, ITG nstate_, ITG mcs, ITG nkon, double ener, char jobnamec, char output, char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, ITG nprint, char prlab, char prset, ITG nener, double trab, ITG inotr, ITG ntrans, double ttime, double fmpc, ITG nev, double z, ITG iamboun, double xbounold, ITG nsectors, ITG nm, ITG icol, ITG irow, ITG nzl, ITG nam, ITG ipompcold, ITG nodempcold, double coefmpcold, char labmpcold, ITG nmpcold, double xloadold, ITG iamload, double t1old, double t1, ITG iamt1, double xstiff, ITG icolep, ITG jqep, ITG *irowep, ITG isolver, ITG nzse, double adbep, double aubep, ITG iexpl, ITG ibody, double xbody, ITG nbody, double cocon, ITG ncocon, char tieset, ITG ntie, ITG imddof, ITG nmddof, ITG imdnode, ITG nmdnode, ITG imdboun, ITG nmdboun, ITG imdmpc, ITG nmdmpc, ITG izdofp, ITG nzdof, ITG nherm, double xmr, double xmi, char typeboun, ITG ielprop, double prop, char *orname)

void	FORTRAN (extrapolate,(double sti, double stn, ITG ipkon, ITG inum, ITG kon, char lakon, ITG nfield, ITG nk, ITG ne, ITG mi, ITG ndim, double orab, ITG ielorien, double co, ITG iorienglob, char cflag, double vold, ITG force, ITG ielmat, double thicke, ITG ielprop, double prop))

void	FORTRAN (extrapolate_ad_h,(ITG nface, ITG ielfa, double xrlfa, double ad, double adfa, double hel, double hfa, ITG icyclic, double c, ITG ifatie))

void	FORTRAN (extrapolate_ad_h_comp,(ITG nface, ITG ielfa, double xrlfa, double ad, double adfa, double hel, double hfa, ITG icyclic, double c, ITG ifatie))

void	FORTRAN (extrapolatefluid,(ITG nk, ITG iponofa, ITG inofa, ITG inum, double vfa, double v, ITG ielfa, ITG ithermal, ITG imach, ITG ikappa, double xmach, double xkappa, double shcon, ITG nshcon, ITG ntmat_, ITG ielmatf, double physcon, ITG mi, ITG iturb, double xturb))

void	FORTRAN (extrapolate_gradkel,(ITG nface, ITG ielfa, double xrlfa, double gradkel, double gradkfa, ITG icyclic, double c, ITG ifatie))

void	FORTRAN (extrapolate_gradoel,(ITG nface, ITG ielfa, double xrlfa, double gradoel, double gradofa, ITG icyclic, double c, ITG ifatie))

void	FORTRAN (extrapolate_gradtel,(ITG nface, ITG ielfa, double xrlfa, double gradtel, double gradtfa, ITG icyclic, double c, ITG ifatie))

void	FORTRAN (extrapolate_gradvel,(ITG nface, ITG ielfa, double xrlfa, double gradv, double gradvfa, ITG icyclic, double c, ITG ifatie))

void	FORTRAN (extrapolate_kel,(ITG nface, ITG ielfa, double xrlfa, double vel, double vfa, ITG ifabou, double xboun, ITG ipnei, ITG nef, double physcon, double *umfa))

void	FORTRAN (extrapolate_oel,(ITG nface, ITG ielfa, double xrlfa, double vel, double vfa, ITG ifabou, double xboun, ITG ipnei, ITG nef, double physcon, double umfa, double dy))

void	FORTRAN (extrapolate_pel,(ITG nface, ITG ielfa, double xrlfa, double vel, double vfa, ITG ifabou, double xboun, ITG nef))

void	FORTRAN (extrapolate_tel,(ITG nface, ITG ielfa, double xrlfa, double vel, double vfa, ITG ifabou, double xboun, ITG ipnei, ITG *nef))

void	FORTRAN (extrapolate_vel,(ITG nface, ITG ielfa, double xrlfa, double vel, double vfa, ITG ifabou, double xboun, ITG ipnei, ITG nef, ITG icyclic, double c, ITG ifatie, double *xxn))

void	FORTRAN (extrapol_kel,(ITG nface, ITG ielfa, double xrlfa, double vel, double vfa, ITG ifabou, double xbounact, ITG nef, double gradtel, double gradtfa, ITG neifa, double rf, double area, double volume, double xle, double xxi, ITG icyclic, double xxn, ITG ipnei, ITG ifatie, double xlet, double xxj, double coefmpc, ITG nmpc, char labmpc, ITG ipompc, ITG nodempc, ITG ifaext, ITG nfaext, ITG nactdoh, double umfa, double physcon))

void	FORTRAN (extrapol_oel,(ITG nface, ITG ielfa, double xrlfa, double vel, double vfa, ITG ifabou, double xbounact, ITG nef, double gradtel, double gradtfa, ITG neifa, double rf, double area, double volume, double xle, double xxi, ITG icyclic, double xxn, ITG ipnei, ITG ifatie, double xlet, double xxj, double coefmpc, ITG nmpc, char labmpc, ITG ipompc, ITG nodempc, ITG ifaext, ITG nfaext, ITG nactdoh, double umfa, double physcon, double *dy))

void	FORTRAN (extrapol_pel,(ITG nface, ITG ielfa, double xrlfa, double vel, double vfa, ITG ifabou, double xbounact, ITG nef, double gradpel, double gradpfa, ITG neifa, double rf, double area, double volume, double xle, double xxi, ITG icyclic, double xxn, ITG ipnei, ITG ifatie, double coefmpc, ITG nmpc, char labmpc, ITG ipompc, ITG nodempc, ITG ifaext, ITG nfaext, ITG nactdoh))

void	FORTRAN (extrapol_tel,(ITG nface, ITG ielfa, double xrlfa, double vel, double vfa, ITG ifabou, double xbounact, ITG nef, double gradtel, double gradtfa, ITG neifa, double rf, double area, double volume, double xle, double xxi, ITG icyclic, double xxn, ITG ipnei, ITG ifatie, double xload, double xlet, double xxj, double coefmpc, ITG nmpc, char labmpc, ITG ipompc, ITG nodempc, ITG ifaext, ITG nfaext, ITG *nactdoh))

void	FORTRAN (extrapol_vel,(ITG nface, ITG ielfa, double xrlfa, double vel, double vfa, ITG ifabou, double xbounact, ITG ipnei, ITG nef, ITG icyclic, double c, ITG ifatie, double xxn, double gradvel, double gradvfa, ITG neifa, double rf, double area, double volume, double xle, double xxi, double xxj, double xlet, double coefmpc, ITG nmpc, char labmpc, ITG ipompc, ITG nodempc, ITG ifaext, ITG nfaext, ITG *nactdoh))

void	FORTRAN (facepernode,(ITG iponoelfa, ITG inoelfa, char lakonfa, ITG ipkonfa, ITG konfa, ITG nsurfs, ITG *inoelsize))

void	FORTRAN (fcrit,(double time, double tend, double aai, double bbi, double zetaj, double dj, double ddj, double h1, double h2, double h3, double h4, double func, double *funcp))

void	FORTRAN (fill_neiel,(ITG nef, ITG ipnei, ITG neiel, ITG neielcp))

void	FORTRAN (filter,(double dgdxglob, ITG nobject, ITG nk, ITG nodedesi, ITG ndesi, char objectset, double xo, double yo, double zo, double x, double y, double z, ITG nx, ITG ny, ITG nz, ITG neighbor, double r, ITG ndesia, ITG *ndesib))

void	filtermain (double co, double dgdxglob, ITG nobject, ITG nk, ITG nodedesi, ITG ndesi, char *objectset)

void *	filtermt (ITG *i)

void	FORTRAN (findsurface,(ITG ipoface, ITG nodface, ITG ne, ITG ipkon, ITG kon, char lakon, ITG ntie, char tieset))

void	FORTRAN (findsurface_se,(ITG nodface, ITG ipoface, ITG ne, ITG ipkon, char lakon, ITG kon, ITG konfa, ITG ipkonfa, ITG nk, char lakonfa, ITG *nsurfs))

void	FORTRAN (flowoutput,(ITG itg, ITG ieg, ITG ntg, ITG nteq, double bc, char lakon, ITG ntmat_, double v, double shcon, ITG nshcon, ITG ipkon, ITG kon, double co, ITG nflow, double dtime, double ttime, double time, ITG ielmat, double prop, ITG ielprop, ITG nactdog, ITG nacteq, ITG iin, double physcon, double camt, double camf, double camp, double rhcon, ITG nrhcon, double vold, char jobnamef, char set, ITG istartset, ITG iendset, ITG ialset, ITG nset, ITG mi, ITG iaxial, ITG istep, ITG iit))

void	FORTRAN (flowresult,(ITG ntg, ITG itg, double cam, double vold, double v, ITG nload, char sideload, ITG nelemload, double xloadact, ITG nactdog, ITG network, ITG mi, ITG ne, ITG ipkon, char lakon, ITG kon))

void	FORTRAN (forcesolve,(double zc, ITG nev, double aa, double bb, double xx, double eiga, double eigb, double eigxx, ITG iter, double d, ITG neq, double z, ITG istartnmd, ITG iendnmd, ITG nmd, ITG cyclicsymmetry, ITG neqact, ITG igeneralizedforce))

void	FORTRAN (formgradient,(ITG istartdesi, ITG ialdesi, ITG ipkon, char lakon, ITG ipoface, ITG ndesi, ITG nodedesi, ITG nodface, ITG kon, double co, double dgdx, ITG nobject, double weightformgrad, ITG nodedesiinv, ITG noregion, char objectset, double dgdxglob, ITG nk))

void	FORTRAN (formgradinterpol,(ITG ipkon, char lakon, ITG kon, ITG nobject, double dgdxglob, double xinterpol, ITG nnodes, ITG ne, ITG nk, ITG nodedesiinv, char *objectset))

void	frd (double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne0, double v, double stn, ITG inum, ITG nmethod, ITG kode, char filab, double een, double t1, double fn, double time, double epn, ITG ielmat, char matname, double enern, double xstaten, ITG nstate_, ITG istep, ITG iinc, ITG ithermal, double qfn, ITG mode, ITG noddiam, double trab, ITG inotr, ITG ntrans, double orab, ITG ielorien, ITG norien, char description, ITG ipneigh, ITG neigh, ITG mi, double stx, double vr, double vi, double stnr, double stni, double vmax, double stnmax, ITG ngraph, double veold, double ener, ITG ne, double cs, char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, double eenmax, double fnr, double fni, double emn, double thicke, char jobnamec, char output, double qfx, double cdn, ITG mortar, double cdnr, double cdni, ITG nmat)

void	frdcyc (double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, double v, double stn, ITG inum, ITG nmethod, ITG kode, char filab, double een, double t1, double fn, double time, double epn, ITG ielmat, char matname, double cs, ITG mcs, ITG nkon, double enern, double xstaten, ITG nstate_, ITG istep, ITG iinc, ITG iperturb, double ener, ITG mi, char output, ITG ithermal, double qfn, ITG ialset, ITG istartset, ITG iendset, double trab, ITG inotr, ITG ntrans, double orab, ITG ielorien, ITG norien, double sti, double veold, ITG noddiam, char set, ITG nset, double emn, double thicke, char jobnamec, ITG ne0, double cdn, ITG mortar, ITG nmat, double *qfx)

void	frd_norm_se (double co, ITG nk, double stn, ITG inum, ITG nmethod, ITG kode, char filab, double fn, double time, ITG nstate_, ITG istep, ITG iinc, ITG mode, ITG noddiam, char description, ITG mi, ITG ngraph, ITG ne, double cs, char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, double thicke, char jobnamec, char output, double dgdxtotglob, ITG numobject, char objectset, double extnor, ITG ntrans, double trab, ITG inotr)

void	frd_sen (double co, ITG nk, double dstn, ITG inum, ITG nmethod, ITG kode, char filab, double time, ITG nstate_, ITG istep, ITG iinc, ITG mode, ITG noddiam, char description, ITG mi, ITG ngraph, ITG ne, double cs, char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, char jobnamec, char output, double v, ITG iobject, char objectset, ITG ntrans, ITG inotr, double trab, ITG idesvar, char orname, ITG icoordinate, ITG inorm, ITG irand)

void	frd_sen_se (double co, ITG nk, double stn, ITG inum, ITG nmethod, ITG kode, char filab, double fn, double time, ITG nstate_, ITG istep, ITG iinc, ITG mode, ITG noddiam, char description, ITG mi, ITG ngraph, ITG ne, double cs, char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, double thicke, char jobnamec, char output, double dgdxglob, ITG iobject, char objectset)

void	frd_orien_se (double co, ITG nk, double stn, ITG inum, ITG nmethod, ITG kode, char filab, double fn, double time, ITG nstate_, ITG istep, ITG iinc, ITG mode, ITG noddiam, char description, ITG mi, ITG ngraph, ITG ne, double cs, char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, double thicke, char jobnamec, char output, double dgdxtotglob, ITG numobject, char objectset, ITG ntrans, ITG inotr, double trab, ITG idesvar, char *orname)

void	FORTRAN (frdfluid,(double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, double v, ITG kode, double time, ITG ielmatf, char matname, char filab, ITG inum, ITG ntrans, ITG inotr, double trab, ITG mi, ITG istep, double stn, double qfn, ITG nactdofinv, double xmach, double xkappa, double physcon, double *xturb))

void	frdgeneralvector (double v, ITG iset, ITG ntrans, char filabl, ITG nkcoords, ITG inum, char m1, ITG inotr, double trab, double co, ITG istartset, ITG iendset, ITG ialset, ITG mi, ITG ngraph, FILE f1, char output, char m3)

void	frdheader (ITG icounter, double oner, double time, double pi, ITG noddiam, double cs, ITG null, ITG mode, ITG noutloc, char description, ITG kode, ITG nmethod, FILE f1, char output, ITG istep, ITG iinc)

void	FORTRAN (frditeration,(double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, double v, double time, ITG ielmat, char matname, ITG mi, ITG istep, ITG iinc, ITG ithermal))

void	frdselect (double field1, double field2, ITG iset, ITG nkcoords, ITG inum, char m1, ITG istartset, ITG iendset, ITG ialset, ITG ngraph, ITG ncomp, ITG ifield, ITG icomp, ITG nfield, ITG iselect, char m2, FILE f1, char output, char *m3)

void	frdset (char filabl, char set, ITG iset, ITG istartset, ITG iendset, ITG ialset, ITG inum, ITG noutloc, ITG nout, ITG nset, ITG noutmin, ITG noutplus, ITG iselect, ITG ngraph)

void	frdvector (double v, ITG iset, ITG ntrans, char filabl, ITG nkcoords, ITG inum, char m1, ITG inotr, double trab, double co, ITG istartset, ITG iendset, ITG ialset, ITG mi, ITG ngraph, FILE f1, char output, char m3)

void	FORTRAN (frictionheating,(ITG ne0, ITG ne, ITG ipkon, char lakon, ITG ielmat, ITG mi, double elcon, ITG ncmat_, ITG ntmat_, ITG kon, ITG islavsurf, double pmastsurf, double springarea, double co, double vold, double veold, double pslavsurf, double xload, ITG nload, ITG nload_, ITG nelemload, ITG iamload, ITG idefload, char sideload, double stx, ITG nam))

void	FORTRAN (fsub,(double time, double tend, double aai, double bbi, double ddj, double h1, double h2, double h3, double h4, double func, double *funcp))

void	FORTRAN (fsuper,(double time, double tend, double aai, double bbi, double h1, double h2, double h3, double h4, double h5, double h6, double func, double funcp))

void	FORTRAN (gasmechbc,(double vold, ITG nload, char sideload, ITG nelemload, double xload, ITG mi))

void	FORTRAN (genadvecelem,(ITG inodesd, ITG ipkon, ITG ne, char lakon, ITG kon, ITG nload, char sideload, ITG nelemload, ITG nkon, ITG network))

void	FORTRAN (gencontelem_f2f,(char tieset, ITG ntie, ITG itietri, ITG ne, ITG ipkon, ITG kon, char lakon, double cg, double straight, ITG ifree, ITG koncont, double co, double vold, double xo, double yo, double zo, double x, double y, double z, ITG nx, ITG ny, ITG nz, ITG ielmat, double elcon, ITG istep, ITG iinc, ITG iit, ITG ncmat_, ITG ntmat_, ITG mi, ITG imastop, ITG islavsurf, ITG itiefac, double springarea, double tietol, double reltime, char filab, ITG nasym, double pslavsurf, double pmastsurf, double clearini, double theta, double xstateini, double xstate, ITG nstate_, ITG ne0, ITG icutb, ITG ialeatoric, ITG nmethod, char jobnamef))

void	FORTRAN (gencontelem_n2f,(char tieset, ITG ntie, ITG itietri, ITG ne, ITG ipkon, ITG kon, char lakon, double cg, double straight, ITG ifree, ITG koncont, double co, double vold, double xo, double yo, double zo, double x, double y, double z, ITG nx, ITG ny, ITG nz, ITG ielmat, double elcon, ITG istep, ITG iinc, ITG iit, ITG ncmat_, ITG ntmat_, ITG nmethod, ITG mi, ITG imastop, ITG nslavnode, ITG islavnode, ITG islavsurf, ITG itiefac, double areaslav, ITG iponoels, ITG inoels, double springarea, char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, double tietol, double reltime, char filab, ITG nasym, double xnoels, ITG icutb, ITG ne0, char *jobnamef))

void	FORTRAN (generateeminterfaces,(ITG istartset, ITG iendset, ITG ialset, ITG iactive, ITG ipkon, char lakon, ITG kon, ITG ikmpc, ITG nmpc, ITG nafaces))

void	FORTRAN (generatetet,(ITG kontet, ITG ifatet, ITG netet, ITG inodfa, ITG ifreefa, double planfa, ITG ipofa, ITG nodes, double *cotet))

void	FORTRAN (gennactdofinv,(ITG nactdof, ITG nactdofinv, ITG nk, ITG mi, ITG nodorig, ITG ipkon, char lakon, ITG kon, ITG *ne))

void	FORTRAN (gentiedmpc,(char tieset, ITG ntie, ITG itietri, ITG ipkon, ITG kon, char lakon, char set, ITG istartset, ITG iendset, ITG ialset, double cg, double straight, ITG koncont, double co, double xo, double yo, double zo, double x, double y, double z, ITG nx, ITG ny, ITG nz, ITG nset, ITG ifaceslave, ITG istartfield, ITG iendfield, ITG ifield, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, ITG nmpc_, ITG mpcfree, ITG ikmpc, ITG ilmpc, char labmpc, ITG ithermal, double tietol, ITG icfd, ITG ncont, ITG imastop, ITG ikboun, ITG nboun, char *kind))

void	FORTRAN (geomview,(double vold, double co, double pmid, double e1, double e2, double e3, ITG kontri, double area, double cs, ITG mcs, ITG inocs, ITG ntrit, ITG nk, ITG mi, double *sidemean))

void	FORTRAN (getdesiinfo,(char set, ITG istartset, ITG iendset, ITG ialset, ITG nset, ITG mi, ITG nactdof, ITG ndesi, ITG nodedesi, ITG ntie, char tieset, ITG itmp, ITG nmpc, ITG nodempc, ITG ipompc, ITG nodedesiinv, ITG iponoel, ITG inoel, char lakon, ITG ipkon, ITG kon, ITG noregion, ITG ipoface, ITG nodface, ITG *nk))

void	getglobalresults (char jobnamec, ITG integerglobp, double doubleglobp, ITG nboun, ITG iamboun, double xboun, ITG nload, char sideload, ITG iamload, ITG iglob, ITG nforc, ITG iamforc, double xforc, ITG ithermal, ITG nk, double t1, ITG *iamt1)

ITG	getSystemCPUs ()

void	FORTRAN (identamta,(double amta, double reftime, ITG istart, ITG iend, ITG *id))

void	FORTRAN (identifytiedface,(char tieset, ITG ntie, char set, ITG nset, ITG faceslave, char kind))

void	FORTRAN (includefilename,(char buff, char includefn, ITG *lincludefn))

void	FORTRAN (inicalcbody,(ITG nef, double body, ITG ipobody, ITG ibody, double xbody, double coel, double vel, char lakon, ITG nactdohinv, ITG icent))

void	inicont (ITG nk, ITG ncont, ITG ntie, char tieset, ITG nset, char set, ITG istartset, ITG iendset, ITG ialset, ITG itietrip, char lakon, ITG ipkon, ITG kon, ITG *koncontp, ITG ncone, double tietol, ITG ismallsliding, ITG itiefacp, ITG islavsurfp, ITG islavnodep, ITG imastnodep, ITG nslavnodep, ITG nmastnodep, ITG mortar, ITG imastopp, ITG nkon, ITG iponoels, ITG inoelsp, ITG ipep, ITG imep, ITG ne, ITG ifacecount, ITG iperturb, ITG ikboun, ITG nboun, double co, ITG istep, double *xnoelsp)

void	FORTRAN (init,(ITG nktet, ITG inodfa, ITG ipofa, ITG netet_))

void	FORTRAN (initialcfd,(ITG ne, ITG ipkon, ITG kon, char lakon, double co, double coel, double cofa, ITG nface, ITG ielfa, double area, ITG ipnei, ITG neiel, double xxn, double xxi, double xle, double xlen, double xlet, double xrlfa, double cosa, double volume, ITG neifa, double xxj, double cosb, double dmin, ITG ifatie, double cs, char tieset, ITG icyclic, double c, ITG neij, double physcon, ITG isolidsurf, ITG nsolidsurf, double dy, double xxni, double xxnj, double xxicn, ITG nflnei, ITG iturbulent, double rf))

void	FORTRAN (initialchannel,(ITG itg, ITG ieg, ITG ntg, double ac, double bc, char lakon, double v, ITG ipkon, ITG kon, ITG nflow, ITG ikboun, ITG nboun, double prop, ITG ielprop, ITG nactdog, ITG ndirboun, ITG nodeboun, double xbounact, ITG ielmat, ITG ntmat_, double shcon, ITG nshcon, double physcon, ITG ipiv, ITG nteq, double rhcon, ITG nrhcon, ITG ipobody, ITG ibody, double xbody, double co, ITG nbody, ITG network, ITG iin_abs, double vold, char set, ITG istep, ITG iit, ITG mi, ITG ineighe, ITG ilboun, double ttime, double time, ITG iaxial))

void	FORTRAN (initialnet,(ITG itg, ITG ieg, ITG ntg, double ac, double bc, char lakon, double v, ITG ipkon, ITG kon, ITG nflow, ITG ikboun, ITG nboun, double prop, ITG ielprop, ITG nactdog, ITG ndirboun, ITG nodeboun, double xbounact, ITG ielmat, ITG ntmat_, double shcon, ITG nshcon, double physcon, ITG ipiv, ITG nteq, double rhcon, ITG nrhcon, ITG ipobody, ITG ibody, double xbody, double co, ITG nbody, ITG network, ITG iin_abs, double vold, char set, ITG istep, ITG iit, ITG mi, ITG ineighe, ITG ilboun, ITG channel, ITG iaxial, ITG nmpc, char labmpc, ITG ipompc, ITG nodempc, double coefmpc, double ttime, double time, ITG iponoel, ITG inoel))

void	insert (ITG ipointer, ITG mast1p, ITG mast2p, ITG i1, ITG i2, ITG ifree, ITG *nzs_)

void	insertfreq (ITG ipointer, ITG mast1p, ITG nextp, ITG i1, ITG i2, ITG ifree, ITG *nzs_)

void	insertrad (ITG ipointer, ITG mast1p, ITG mast2p, ITG i1, ITG i2, ITG ifree, ITG *nzs_)

void	FORTRAN (integral_boundary,(double sumfix, double sumfree, ITG ifaext, ITG nfaext, ITG ielfa, ITG ifabou, double vfa, ITG ipnei, double *xxn))

void	FORTRAN (interpolatestate,(ITG ne, ITG ipkon, ITG kon, char lakon, ITG ne0, ITG mi, double xstate, double pslavsurf, ITG nstate_, double xstateini, ITG islavsurf, ITG islavsurfold, double pslavsurfold, char tieset, ITG ntie, ITG itiefac))

void	FORTRAN (islavactive,(char tieset, ITG ntie, ITG itietri, double cg, double straight, double co, double vold, double xo, double yo, double zo, double x, double y, double z, ITG nx, ITG ny, ITG nz, ITG mi, ITG imastop, ITG nslavnode, ITG islavnode, ITG *islavact))

void	FORTRAN (isortid,(ITG ix, double dy, ITG n, ITG kflag))

void	FORTRAN (isortii,(ITG ix, ITG iy, ITG n, ITG kflag))

void	FORTRAN (isortiid,(ITG ix, ITG iy, double dy, ITG n, ITG *kflag))

void	FORTRAN (isortiddc,(ITG ix, double dy1, double dy2, char cy, ITG n, ITG kflag))

void	FORTRAN (isortiiddc,(ITG ix1, ITG ix2, double dy1, double dy2, char cy, ITG n, ITG *kflag))

void	FORTRAN (jouleheating,(ITG ipkon, char lakon, ITG kon, double co, double elcon, ITG nelcon, ITG mi, ITG ne, double sti, ITG ielmat, ITG nelemload, char sideload, double xload, ITG nload, ITG nload_, ITG iamload, ITG nam, ITG idefload, ITG ncmat_, ITG ntmat_, double alcon, ITG nalcon, ITG ithermal, double vold, double *t1))

void	FORTRAN (keystart,(ITG ifreeinp, ITG ipoinp, ITG inp, char name, ITG iline, ITG ikey))

void	linstatic (double co, ITG nk, ITG konp, ITG ipkonp, char *lakonp, ITG ne, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, char labmpc, ITG nmpc, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemload, char sideload, double xload, ITG nload, ITG nactdof, ITG *icolp, ITG jq, ITG *irowp, ITG neq, ITG nzl, ITG nmethod, ITG ikmpc, ITG ilmpc, ITG ikboun, ITG ilboun, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmatp, ITG ielorienp, ITG norien, double orab, ITG ntmat_, double t0, double t1, double t1old, ITG ithermal, double prestr, ITG iprestr, double vold, ITG iperturb, double sti, ITG nzs, ITG kode, char filab, double eme, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double *xstatep, ITG npmat_, char matname, ITG isolver, ITG mi, ITG ncmat_, ITG nstate_, double cs, ITG mcs, ITG nkon, double *enerp, double xbounold, double xforcold, double xloadold, char amname, double amta, ITG namta, ITG nam, ITG iamforc, ITG iamload, ITG iamt1, ITG iamboun, double ttime, char output, char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, ITG nprint, char prlab, char prset, ITG nener, double trab, ITG inotr, ITG ntrans, double fmpc, char cbody, ITG ibody, double xbody, ITG nbody, double xbodyold, double timepar, double thicke, char jobnamec, char tieset, ITG ntie, ITG istep, ITG nmat, ITG ielprop, double prop, char typeboun, ITG mortar, ITG mpcinfo, double tietol, ITG ics, ITG icontact, char orname)

void	FORTRAN (mafillcorio,(double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemload, char sideload, double xload, ITG nload, double xbody, ITG ipobody, ITG nbody, double cgr, double ad, double au, ITG nactdof, ITG icol, ITG jq, ITG irow, ITG neq, ITG nzl, ITG nmethod, ITG ikmpc, ITG ilmpc, ITG ikboun, ITG ilboun, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, double prestr, ITG iprestr, double vold, ITG iperturb, double sti, ITG nzs, double stx, double adb, double aub, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstiff, ITG npmat_, double dtime, char matname, ITG mi, ITG ncmat_, double ttime, double time, ITG istep, ITG kinc, ITG ibody, ITG ielprop, double *prop))

void	FORTRAN (mafilldm,(double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemload, char sideload, double xload, ITG nload, double xbody, ITG ipobody, ITG nbody, double cgr, double ad, double au, ITG nactdof, ITG icol, ITG jq, ITG irow, ITG neq, ITG nzl, ITG nmethod, ITG ikmpc, ITG ilmpc, ITG ikboun, ITG ilboun, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, double prestr, ITG iprestr, double vold, ITG iperturb, double sti, ITG nzs, double stx, double adb, double aub, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstiff, ITG npmat_, double dtime, char matname, ITG mi, ITG ncmat_, double ttime, double time, ITG istep, ITG kinc, ITG ibody, double clearini, ITG mortar, double springarea, double pslavsurf, double pmastsurf, double reltime, ITG nasym))

void	FORTRAN (mafillem,(double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemload, char sideload, double xload, ITG nload, double xbody, ITG ipobody, ITG nbody, double cgr, double ad, double au, double bb, ITG nactdof, ITG icol, ITG jq, ITG irow, ITG neq, ITG nzl, ITG nmethod, ITG ikmpc, ITG ilmpc, ITG ikboun, ITG ilboun, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, double prestr, ITG iprestr, double vold, ITG iperturb, double sti, ITG nzs, double stx, double adb, double aub, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstiff, ITG npmat_, double dtime, char matname, ITG mi, ITG ncmat_, ITG mass, ITG stiffness, ITG buckling, ITG rhs, ITG intscheme, double physcon, double shcon, ITG nshcon, double cocon, ITG ncocon, double ttime, double time, ITG istep, ITG kinc, ITG coriolis, ITG ibody, double xloadold, double reltime, double veold, double springarea, ITG nstate_, double xstateini, double xstate, double thicke, ITG integerglob, double doubleglob, char tieset, ITG istartset, ITG iendset, ITG ialset, ITG ntie, ITG nasym, ITG iactive, double h0, double pslavsurf, double pmastsurf, ITG mortar, double clearini, ITG ielprop, double prop, ITG iponoel, ITG inoel, ITG network))

void	FORTRAN (mafillk,(ITG nef, ITG ipnei, ITG neifa, ITG neiel, double vfa, double xxn, double area, double au, double ad, ITG jq, ITG irow, ITG nzs, double b, double vel, double umfa, double xlet, double xle, double gradkfa, double xxi, double body, double volume, ITG ielfa, char lakonf, ITG ifabou, ITG nbody, ITG neq, double dtimef, double velo, double veloo, double cpfa, double hcfa, double cvel, double gradvel, double xload, double gammat, double xrlfa, double xxj, ITG nactdohinv, double a1, double a2, double a3, double flux, ITG nefa, ITG nefb, ITG iau6, double xxni, double xxnj, ITG iturbulent))

void	mafillkmain (ITG nef, ITG ipnei, ITG neifa, ITG neiel, double vfa, double xxn, double area, double au, double ad, ITG jq, ITG irow, ITG nzs, double b, double vel, double umel, double xlet, double xle, double gradkfa, double xxi, double body, double volume, ITG ielfa, char lakonf, ITG ifabou, ITG nbody, ITG neq, double dtimef, double velo, double veloo, double cpfa, double hcfa, double cvel, double gradvel, double xload, double gammat, double xrlfa, double xxj, ITG nactdohinv, double a1, double a2, double a3, double flux, ITG iau6, double xxni, double xxnj, ITG iturbulent)

void *	mafillkmt (ITG *i)

void	FORTRAN (mafillnet,(ITG itg, ITG ieg, ITG ntg, double ac, ITG nload, char sideload, ITG nelemload, double xloadact, char lakon, ITG ntmat_, double v, double shcon, ITG nshcon, ITG ipkon, ITG kon, double co, ITG nflow, ITG iinc, ITG istep, double dtime, double ttime, double time, ITG ielmat, ITG nteq, double prop, ITG ielprop, ITG nactdog, ITG nacteq, double physcon, double rhcon, ITG nrhcon, ITG ipobody, ITG ibody, double xbody, ITG nbody, double vold, double xloadold, double reltime, ITG nmethod, char set, ITG mi, ITG nmpc, ITG nodempc, ITG ipompc, double coefmpc, char labmpc, ITG iaxial, double cocon, ITG ncocon, ITG iponoel, ITG *inoel))

void	FORTRAN (mafillo,(ITG nef, ITG ipnei, ITG neifa, ITG neiel, double vfa, double xxn, double area, double au, double ad, ITG jq, ITG irow, ITG nzs, double b, double vel, double umfa, double xlet, double xle, double gradofa, double xxi, double body, double volume, ITG ielfa, char lakonf, ITG ifabou, ITG nbody, ITG neq, double dtimef, double velo, double veloo, double cpfa, double hcfa, double cvel, double gradvel, double xload, double gammat, double xrlfa, double xxj, ITG nactdohinv, double a1, double a2, double a3, double flux, ITG nefa, ITG nefb, ITG iau6, double xxni, double xxnj, ITG iturbulent, double gradkel, double gradoel))

void	mafillomain (ITG nef, ITG ipnei, ITG neifa, ITG neiel, double vfa, double xxn, double area, double au, double ad, ITG jq, ITG irow, ITG nzs, double b, double vel, double umel, double xlet, double xle, double gradofa, double xxi, double body, double volume, ITG ielfa, char lakonf, ITG ifabou, ITG nbody, ITG neq, double dtimef, double velo, double veloo, double cpfa, double hcfa, double cvel, double gradvel, double xload, double gammat, double xrlfa, double xxj, ITG nactdohinv, double a1, double a2, double a3, double flux, ITG iau6, double xxni, double xxnj, ITG iturbulent, double gradkel, double gradoel)

void *	mafillomt (ITG *i)

void	FORTRAN (mafillp,(ITG ne, char lakonf, ITG ipnei, ITG neifa, ITG neiel, double vfa, double area, double adfa, double xlet, double cosa, double volume, double au, double ad, ITG jq, ITG irow, double ap, ITG ielfa, ITG ifabou, double xle, double b, double xxn, ITG neq, ITG nzs, double hfa, double gradpel, double bp, double xxi, ITG neij, double xlen, double cosb, ITG nefa, ITG nefb, ITG iau6, double xxicn))

void	FORTRAN (mafillpbc,(ITG nef, double au, double ad, ITG jq, ITG irow, double b, ITG iatleastonepressurebc, ITG nzs))

void	FORTRAN (mafillpcomp,(ITG ne, char lakonf, ITG ipnei, ITG neifa, ITG neiel, double vfa, double area, double adfa, double xlet, double cosa, double volume, double au, double ad, ITG jq, ITG irow, double ap, ITG ielfa, ITG ifabou, double xle, double b, double xxn, ITG neq, ITG nzs, double hfa, double gradpel, double bp, double xxi, ITG neij, double xlen, double cosb, ITG ielmatf, ITG mi, double a1, double a2, double a3, double velo, double veloo, double dtimef, double shcon, ITG ntmat_, double vel, ITG nactdohinv, double xrlfa, double flux, ITG nefa, ITG nefb, ITG iau6, double xxicn, double *gamma))

void	mafillpcompmain (ITG ne, char lakonf, ITG ipnei, ITG neifa, ITG neiel, double vfa, double area, double adfa, double xlet, double cosa, double volume, double au, double ad, ITG jq, ITG irow, double ap, ITG ielfa, ITG ifabou, double xle, double b, double xxn, ITG neq, ITG nzs, double hfa, double gradpel, double bp, double xxi, ITG neij, double xlen, double cosb, ITG ielmatf, ITG mi, double a1, double a2, double a3, double velo, double veloo, double dtimef, double shcon, ITG ntmat_, double vel, ITG nactdohinv, double xrlfa, double flux, ITG iau6, double xxicn, double *gamma)

void *	mafillpcompmt (ITG *i)

void	mafillpmain (ITG ne, char lakonf, ITG ipnei, ITG neifa, ITG neiel, double vfa, double area, double adfa, double xlet, double cosa, double volume, double au, double ad, ITG jq, ITG irow, double ap, ITG ielfa, ITG ifabou, double xle, double b, double xxn, ITG neq, ITG nzs, double hfa, double gradpel, double bp, double xxi, ITG neij, double xlen, double cosb, ITG iatleastonepressurebc, ITG iau6, double *xxicn)

void *	mafillpmt (ITG *i)

void	FORTRAN (mafillsm,(double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemload, char sideload, double xload, ITG nload, double xbody, ITG ipobody, ITG nbody, double cgr, double ad, double au, double bb, ITG nactdof, ITG icol, ITG jq, ITG irow, ITG neq, ITG nzl, ITG nmethod, ITG ikmpc, ITG ilmpc, ITG ikboun, ITG ilboun, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, double prestr, ITG iprestr, double vold, ITG iperturb, double sti, ITG nzs, double stx, double adb, double aub, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstiff, ITG npmat_, double dtime, char matname, ITG mi, ITG ncmat_, ITG mass, ITG stiffness, ITG buckling, ITG rhs, ITG intscheme, double physcon, double shcon, ITG nshcon, double cocon, ITG ncocon, double ttime, double time, ITG istep, ITG kinc, ITG coriolis, ITG ibody, double xloadold, double reltime, double veold, double springarea, ITG nstate_, double xstateini, double xstate, double thicke, ITG integerglob, double doubleglob, char tieset, ITG istartset, ITG iendset, ITG ialset, ITG ntie, ITG nasym, double pslavsurf, double pmastsurf, ITG mortar, double clearini, ITG ielprop, double prop, ITG ne0, double fnext, ITG nea, ITG neb, ITG kscale, ITG iponoel, ITG inoel, ITG *network))

void	FORTRAN (mafillsmcsse,(double co, ITG kon, ITG ipkon, char lakon, ITG ne, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, ITG nelemload, char sideload, double xload, ITG nload, double xbody, ITG ipobody, ITG nbody, double cgr, ITG nactdof, ITG neq, ITG nmethod, ITG ikmpc, ITG ilmpc, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, ITG iprestr, double vold, ITG iperturb, double sti, double stx, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstiff, ITG npmat_, double dtime, char matname, ITG mi, ITG ncmat_, ITG mass, ITG stiffness, ITG buckling, ITG rhs, ITG intscheme, double physcon, double ttime, double time, ITG istep, ITG iinc, ITG coriolis, ITG ibody, double xloadold, double reltime, double veold, double springarea, ITG nstate_, double xstateini, double xstate, double thicke, ITG integerglob, double doubleglob, char tieset, ITG istartset, ITG iendset, ITG ialset, ITG ntie, ITG nasym, double pslavsurf, double pmastsurf, ITG mortar, double clearini, ITG ielprop, double prop, ITG ne0, ITG nea, ITG neb, double distmin, ITG ndesi, ITG nodedesi, double df, ITG jqs, ITG irows, double dfminds, ITG icoordinate, double dxstiff, double xdesi, ITG istartelem, ITG ialelem, double v, double sigma, char labmpc, ITG ics, double cs, ITG mcs, ITG nk, ITG nzss))

void	FORTRAN (mafillsmse,(double co, ITG kon, ITG ipkon, char lakon, ITG ne, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, ITG nelemload, char sideload, double xload, ITG nload, double xbody, ITG ipobody, ITG nbody, double cgr, ITG nactdof, ITG neq, ITG nmethod, ITG ikmpc, ITG ilmpc, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, ITG iprestr, double vold, ITG iperturb, double sti, double stx, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstiff, ITG npmat_, double dtime, char matname, ITG mi, ITG ncmat_, ITG mass, ITG stiffness, ITG buckling, ITG rhs, ITG intscheme, double physcon, double ttime, double time, ITG istep, ITG iinc, ITG coriolis, ITG ibody, double xloadold, double reltime, double veold, double springarea, ITG nstate_, double xstateini, double xstate, double thicke, ITG integerglob, double doubleglob, char tieset, ITG istartset, ITG iendset, ITG ialset, ITG ntie, ITG nasym, double pslavsurf, double pmastsurf, ITG mortar, double clearini, ITG ielprop, double prop, ITG ne0, ITG nea, ITG neb, double distmin, ITG ndesi, ITG nodedesi, double df, ITG jqs, ITG irows, double dfminds, ITG icoordinate, double dxstiff, double xdesi, ITG istartelem, ITG ialelem, double v, double sigma, ITG *ieigenfrequency))

void *	mafillsmmt (ITG *i)

void *	mafillsmsemt (ITG *i)

void	mafillsmmain (double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemload, char sideload, double xload, ITG nload, double xbody, ITG ipobody, ITG nbody, double cgr, double ad, double au, double bb, ITG nactdof, ITG icol, ITG jq, ITG irow, ITG neq, ITG nzl, ITG nmethod, ITG ikmpc, ITG ilmpc, ITG ikboun, ITG ilboun, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, double prestr, ITG iprestr, double vold, ITG iperturb, double sti, ITG nzs, double stx, double adb, double aub, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstiff, ITG npmat_, double dtime, char matname, ITG mi, ITG ncmat_, ITG mass, ITG stiffness, ITG buckling, ITG rhs, ITG intscheme, double physcon, double shcon, ITG nshcon, double cocon, ITG ncocon, double ttime, double time, ITG istep, ITG kinc, ITG coriolis, ITG ibody, double xloadold, double reltime, double veold, double springarea, ITG nstate_, double xstateini, double xstate, double thicke, ITG integerglob, double doubleglob, char tieset, ITG istartset, ITG iendset, ITG ialset, ITG ntie, ITG nasym, double pslavsurf, double pmastsurf, ITG mortar, double clearini, ITG ielprop, double prop, ITG ne0, double fnext, ITG kscale, ITG iponoel, ITG inoel, ITG *network)

void	mafillsmmain_se (double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemload, char sideload, double xload, ITG nload, double xbody, ITG ipobody, ITG nbody, double cgr, ITG nactdof, ITG neq, ITG nmethod, ITG ikmpc, ITG ilmpc, ITG ikboun, ITG ilboun, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, double prestr, ITG iprestr, double vold, ITG iperturb, double sti, double stx, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstiff, ITG npmat_, double dtime, char matname, ITG mi, ITG ncmat_, ITG mass, ITG stiffness, ITG buckling, ITG rhs, ITG intscheme, double physcon, double shcon, ITG nshcon, double cocon, ITG ncocon, double ttime, double time, ITG istep, ITG kinc, ITG coriolis, ITG ibody, double xloadold, double reltime, double veold, double springarea, ITG nstate_, double xstateini, double xstate, double thicke, ITG integerglob, double doubleglob, char tieset, ITG istartset, ITG iendset, ITG ialset, ITG ntie, ITG nasym, double pslavsurf, double pmastsurf, ITG mortar, double clearini, ITG ielprop, double prop, ITG ne0, double fnext, double distmin, ITG ndesi, ITG nodedesi, double df, ITG nzss, ITG jqs, ITG irows, ITG icoordinate, double dxstiff, double xdesi, ITG istartelem, ITG ialelem, double v, double sigma, ITG cyclicsymmetry, char labmpc, ITG ics, double cs, ITG mcs, ITG *ieigenfrequency)

void	FORTRAN (mafillsmas,(double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemload, char sideload, double xload, ITG nload, double xbody, ITG ipobody, ITG nbody, double cgr, double ad, double au, double bb, ITG nactdof, ITG icol, ITG jq, ITG irow, ITG neq, ITG nzl, ITG nmethod, ITG ikmpc, ITG ilmpc, ITG ikboun, ITG ilboun, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, double prestr, ITG iprestr, double vold, ITG iperturb, double sti, ITG nzs, double stx, double adb, double aub, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstiff, ITG npmat_, double dtime, char matname, ITG mi, ITG ncmat_, ITG mass, ITG stiffness, ITG buckling, ITG rhs, ITG intscheme, double physcon, double shcon, ITG nshcon, double cocon, ITG ncocon, double ttime, double time, ITG istep, ITG kinc, ITG coriolis, ITG ibody, double xloadold, double reltime, double veold, double springarea, ITG nstate_, double xstateini, double xstate, double thicke, ITG integerglob, double doubleglob, char tieset, ITG istartset, ITG iendset, ITG ialset, ITG ntie, ITG nasym, double pslavsurf, double pmastsurf, ITG mortar, double clearini, ITG ielprop, double prop, ITG ne0, ITG kscale, ITG iponoel, ITG inoel, ITG network))

void	FORTRAN (mafillsmas1,(double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemload, char sideload, double xload, ITG nload, double xbody, ITG ipobody, ITG nbody, double cgr, double ad, double au, double bb, ITG nactdof, ITG icol, ITG jq, ITG irow, ITG neq, ITG nzl, ITG nmethod, ITG ikmpc, ITG ilmpc, ITG ikboun, ITG ilboun, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, double prestr, ITG iprestr, double vold, ITG iperturb, double sti, ITG nzs, double stx, double adb, double aub, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstiff, ITG npmat_, double dtime, char matname, ITG mi, ITG ncmat_, ITG mass, ITG stiffness, ITG buckling, ITG rhs, ITG intscheme, double physcon, double shcon, ITG nshcon, double cocon, ITG ncocon, double ttime, double time, ITG istep, ITG kinc, ITG coriolis, ITG ibody, double xloadold, double reltime, double veold, double springarea, ITG nstate_, double xstateini, double xstate, double thicke, ITG integerglob, double doubleglob, char tieset, ITG istartset, ITG iendset, ITG ialset, ITG ntie, ITG nasym, double pslavsurf, double pmastsurf, ITG mortar, double clearini, ITG ielprop, double prop, ITG ne0, ITG nea, ITG neb, ITG *kscale))

void	mafillsmasmain (double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemload, char sideload, double xload, ITG nload, double xbody, ITG ipobody, ITG nbody, double cgr, double ad, double au, double bb, ITG nactdof, ITG icol, ITG jq, ITG irow, ITG neq, ITG nzl, ITG nmethod, ITG ikmpc, ITG ilmpc, ITG ikboun, ITG ilboun, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, double prestr, ITG iprestr, double vold, ITG iperturb, double sti, ITG nzs, double stx, double adb, double aub, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstiff, ITG npmat_, double dtime, char matname, ITG mi, ITG ncmat_, ITG mass, ITG stiffness, ITG buckling, ITG rhs, ITG intscheme, double physcon, double shcon, ITG nshcon, double cocon, ITG ncocon, double ttime, double time, ITG istep, ITG kinc, ITG coriolis, ITG ibody, double xloadold, double reltime, double veold, double springarea, ITG nstate_, double xstateini, double xstate, double thicke, ITG integerglob, double doubleglob, char tieset, ITG istartset, ITG iendset, ITG ialset, ITG ntie, ITG nasym, double pslavsurf, double pmastsurf, ITG mortar, double clearini, ITG ielprop, double prop, ITG ne0, ITG *kscale)

void *	mafillsmasmt (ITG *i)

void	FORTRAN (mafillsmcs,(double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemload, char sideload, double xload, ITG nload, double xbody, ITG ipobody, ITG nbody, double cgr, double ad, double au, double bb, ITG nactdof, ITG icol, ITG jq, ITG irow, ITG neq, ITG nzl, ITG nmethod, ITG ikmpc, ITG ilmpc, ITG ikboun, ITG ilboun, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, double prestr, ITG iprestr, double vold, ITG iperturb, double sti, ITG nzs, double stx, double adb, double aub, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstiff, ITG npmat_, double dtime, char matname, ITG mi, ITG ics, double cs, ITG nm, ITG ncmat_, char labmpc, ITG mass, ITG stiffness, ITG buckling, ITG rhs, ITG intscheme, ITG mcs, ITG coriolis, ITG ibody, double xloadold, double reltime, ITG ielcs, double veold, double springarea, double thicke, ITG integerglob, double doubleglob, char tieset, ITG istartset, ITG iendset, ITG ialset, ITG ntie, ITG nasym, double pslavsurf, double pmastsurf, ITG mortar, double clearini, ITG ielprop, double prop, ITG ne0, ITG kscale, double xstateini, double xstate, ITG nstate_))

void	FORTRAN (mafillsmcsas,(double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemload, char sideload, double xload, ITG nload, double xbody, ITG ipobody, ITG nbody, double cgr, double ad, double au, double bb, ITG nactdof, ITG icol, ITG jq, ITG irow, ITG neq, ITG nzl, ITG nmethod, ITG ikmpc, ITG ilmpc, ITG ikboun, ITG ilboun, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, double prestr, ITG iprestr, double vold, ITG iperturb, double sti, ITG nzs, double stx, double adb, double aub, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstiff, ITG npmat_, double dtime, char matname, ITG mi, ITG ics, double cs, ITG nm, ITG ncmat_, char labmpc, ITG mass, ITG stiffness, ITG buckling, ITG rhs, ITG intscheme, ITG mcs, ITG coriolis, ITG ibody, double xloadold, double reltime, ITG ielcs, double veold, double springarea, double thicke, ITG integerglob, double doubleglob, char tieset, ITG istartset, ITG iendset, ITG ialset, ITG ntie, ITG nasym, ITG nstate_, double xstateini, double xstate, double pslavsurf, double pmastsurf, ITG mortar, double clearini, ITG ielprop, double prop, ITG ne0, ITG kscale))

void	FORTRAN (mafillsmforc,(ITG nforc, ITG ndirforc, ITG nodeforc, double xforc, ITG nactdof, double fext, ITG nmpc, ITG ipompc, ITG nodempc, ITG ikmpc, ITG ilmpc, double coefmpc, ITG mi, ITG rhsi, double fnext, ITG nmethod))

void	FORTRAN (mafillsm_company,(double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemload, char sideload, double xload, ITG nload, double xbody, ITG ipobody, ITG nbody, double cgr, double ad, double au, double bb, ITG nactdof, ITG icol, ITG jq, ITG irow, ITG neq, ITG nzl, ITG nmethod, ITG ikmpc, ITG ilmpc, ITG ikboun, ITG ilboun, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, double prestr, ITG iprestr, double vold, ITG iperturb, double sti, ITG nzs, double stx, double adb, double aub, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstiff, ITG npmat_, double dtime, char matname, ITG mi, ITG ncmat_, ITG mass, ITG stiffness, ITG buckling, ITG rhs, ITG intscheme, double physcon, double shcon, ITG nshcon, double cocon, ITG ncocon, double ttime, double time, ITG istep, ITG kinc, ITG coriolis, ITG ibody, double xloadold, double reltime, double veold, double springarea, ITG nstate_, double xstateini, double xstate, double thicke, ITG integerglob, double doubleglob, char tieset, ITG istartset, ITG iendset, ITG ialset, ITG ntie, ITG nasym, double pslavsurf, double pmastsurf, ITG mortar, double clearini, ITG ielprop, double prop, ITG ne0, double fnext, ITG kscale, ITG iponoel, ITG inoel, ITG *network))

void	FORTRAN (mafillt,(ITG nef, ITG ipnei, ITG neifa, ITG neiel, double vfa, double xxn, double area, double au, double ad, ITG jq, ITG irow, ITG nzs, double b, double vel, double umel, double xlet, double xle, double gradtfa, double xxi, double body, double volume, ITG ielfa, char lakonf, ITG ifabou, ITG nbody, ITG neq, double dtimef, double velo, double veloo, double cpfa, double hcfa, double cvel, double gradvel, double xload, double gammat, double xrlfa, double xxj, ITG nactdohinv, double a1, double a2, double a3, double flux, ITG nefa, ITG nefb, ITG iau6, double xxni, double xxnj, ITG iturbulent))

void	FORTRAN (mafilltcomp,(ITG nef, ITG ipnei, ITG neifa, ITG neiel, double vfa, double xxn, double area, double au, double ad, ITG jq, ITG irow, ITG nzs, double b, double vel, double umel, double xlet, double xle, double gradtfa, double xxi, double body, double volume, ITG ielfa, char lakonf, ITG ifabou, ITG nbody, ITG neq, double dtimef, double velo, double veloo, double cpfa, double hcfa, double cvel, double gradvel, double xload, double gammat, double xrlfa, double xxj, ITG nactdohinv, double a1, double a2, double a3, double flux, ITG nefa, ITG nefb, ITG iau6, double xxni, double *xxnj))

void	mafilltcompmain (ITG nef, ITG ipnei, ITG neifa, ITG neiel, double vfa, double xxn, double area, double au, double ad, ITG jq, ITG irow, ITG nzs, double b, double vel, double umel, double xlet, double xle, double gradtfa, double xxi, double body, double volume, ITG ielfa, char lakonf, ITG ifabou, ITG nbody, ITG neq, double dtimef, double velo, double veloo, double cpfa, double hcfa, double cvel, double gradvel, double xload, double gammat, double xrlfa, double xxj, ITG nactdohinv, double a1, double a2, double a3, double flux, ITG iau6, double xxni, double *xxnj)

void *	mafilltcompmt (ITG *i)

void	mafilltmain (ITG nef, ITG ipnei, ITG neifa, ITG neiel, double vfa, double xxn, double area, double au, double ad, ITG jq, ITG irow, ITG nzs, double b, double vel, double umel, double xlet, double xle, double gradtfa, double xxi, double body, double volume, ITG ielfa, char lakonf, ITG ifabou, ITG nbody, ITG neq, double dtimef, double velo, double veloo, double cpfa, double hcfa, double cvel, double gradvel, double xload, double gammat, double xrlfa, double xxj, ITG nactdohinv, double a1, double a2, double a3, double flux, ITG iau6, double xxni, double xxnj, ITG iturbulent)

void *	mafilltmt (ITG *i)

void	FORTRAN (mafillv,(ITG nef, ITG ipnei, ITG neifa, ITG neiel, double vfa, double xxn, double area, double au, double ad, ITG jq, ITG irow, ITG nzs, double b, double vel, double cosa, double umfa, double xlet, double xle, double gradvfa, double xxi, double body, double volume, ITG ielfa, char lakonf, ITG ifabou, ITG nbody, double dtimef, double velo, double veloo, double sel, double xrlfa, double gamma, double xxj, ITG nactdohinv, double a1, double a2, double a3, double flux, ITG nefa, ITG nefb, ITG icyclic, double c, ITG ifatie, ITG iau6, double xxni, double xxnj, ITG iturbulent, double gradvel))

void	FORTRAN (mafillvcomp,(ITG nef, ITG ipnei, ITG neifa, ITG neiel, double vfa, double xxn, double area, double au, double ad, ITG jq, ITG irow, ITG nzs, double b, double vel, double cosa, double umfa, double xlet, double xle, double gradvfa, double xxi, double body, double volume, ITG ielfa, char lakonf, ITG ifabou, ITG nbody, double dtimef, double velo, double veloo, double sel, double xrlfa, double gamma, double xxj, ITG nactdohinv, double a1, double a2, double a3, double flux, ITG nefa, ITG nefb, ITG icyclic, double c, ITG ifatie, ITG iau6, double xxni, double xxnj))

void	mafillvcompmain (ITG nef, ITG ipnei, ITG neifa, ITG neiel, double vfa, double xxn, double area, double au, double ad, ITG jq, ITG irow, ITG nzs, double b, double vel, double cosa, double umfa, double xlet, double xle, double gradvfa, double xxi, double body, double volume, ITG ielfa, char lakonf, ITG ifabou, ITG nbody, double dtimef, double velo, double veloo, double sel, double xrlfa, double gamma, double xxj, ITG nactdohinv, double a1, double a2, double a3, double flux, ITG icyclic, double c, ITG ifatie, ITG iau6, double xxni, double xxnj)

void *	mafillvcompmt (ITG *i)

void	mafillvmain (ITG nef, ITG ipnei, ITG neifa, ITG neiel, double vfa, double xxn, double area, double au, double ad, ITG jq, ITG irow, ITG nzs, double b, double vel, double cosa, double umfa, double xlet, double xle, double gradvfa, double xxi, double body, double volume, ITG ielfa, char lakonf, ITG ifabou, ITG nbody, double dtimef, double velo, double veloo, double sel, double xrlfa, double gamma, double xxj, ITG nactdohinv, double a1, double a2, double a3, double flux, ITG icyclic, double c, ITG ifatie, ITG iau6, double xxni, double xxnj, ITG iturbulent, double gradvel)

void *	mafillvmt (ITG *i)

void *	mafillv0mt (ITG *i)

void *	mafillv1mt (ITG *i)

void *	mafillv2mt (ITG *i)

void *	mafillv3mt (ITG *i)

void	mastruct (ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, ITG nodeboun, ITG ndirboun, ITG nboun, ITG ipompc, ITG nodempc, ITG nmpc, ITG nactdof, ITG icol, ITG jq, ITG mast1p, ITG irowp, ITG isolver, ITG neq, ITG ikmpc, ITG ilmpc, ITG ipointer, ITG nzs, ITG nmethod, ITG ithermal, ITG ikboun, ITG ilboun, ITG iperturb, ITG mi, ITG mortar, char typeboun, char labmpc, ITG iit, ITG icascade, ITG network)

void	mastructcs (ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, ITG nodeboun, ITG ndirboun, ITG nboun, ITG ipompc, ITG nodempc, ITG nmpc, ITG nactdof, ITG icol, ITG jq, ITG mast1p, ITG irowp, ITG isolver, ITG neq, ITG ikmpc, ITG ilmpc, ITG ipointer, ITG nzs, ITG nmethod, ITG ics, double cs, char labmpc, ITG mcs, ITG mi, ITG *mortar)

void	mastructem (ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, ITG nodeboun, ITG ndirboun, ITG nboun, ITG ipompc, ITG nodempc, ITG nmpc, ITG nactdof, ITG icol, ITG jq, ITG mast1p, ITG irowp, ITG isolver, ITG neq, ITG ikmpc, ITG ilmpc, ITG ipointer, ITG nzs, ITG ithermal, ITG mi, ITG ielmat, double elcon, ITG ncmat_, ITG ntmat_, ITG inomat, ITG network)

void	mastructf (ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, ITG icol, ITG jq, ITG mast1p, ITG irowp, ITG isolver, ITG ipointer, ITG nzs, ITG ipnei, ITG ineiel, ITG *mi)

void	mastructrad (ITG ntr, ITG nloadtr, char sideload, ITG ipointerrad, ITG mast1radp, ITG irowradp, ITG nzsrad, ITG jqrad, ITG *icolrad)

void	mastructrand (ITG icols, ITG jqs, ITG mast1p, ITG irowsp, ITG ipointer, ITG nzss, ITG ndesi, double physcon, double xo, double yo, double zo, double x, double y, double z, ITG nx, ITG ny, ITG *nz)

void	mastructse (ITG kon, ITG ipkon, char lakon, ITG ne, ITG ipompc, ITG nodempc, ITG nmpc, ITG nactdof, ITG icols, ITG jqs, ITG mast1p, ITG irowsp, ITG ipointer, ITG nzss, ITG mi, ITG mortar, ITG nodedesi, ITG ndesi, ITG icoordinate, ITG ielorien, ITG istartdesi, ITG ialdesi)

void	FORTRAN (materialdata_cfd,(ITG nef, double vel, double shcon, ITG nshcon, ITG ielmat, ITG ntmat_, ITG mi, double cvel, double vfa, double cocon, ITG ncocon, double physcon, double cvfa, ITG ithermal, ITG nface, double umel, double umfa, ITG ielfa, double hcfa, double rhcon, ITG *nrhcon))

void	FORTRAN (materialdata_cfd_comp,(ITG nef, double vel, double shcon, ITG nshcon, ITG ielmat, ITG ntmat_, ITG mi, double cvel, double vfa, double cocon, ITG ncocon, double physcon, double cvfa, ITG ithermal, ITG nface, double umel, double umfa, ITG ielfa, double *hcfa))

void	FORTRAN (meannode,(ITG nk, ITG inum, double *v))

void	FORTRAN (mpcrem,(ITG i, ITG mpcfree, ITG nodempc, ITG nmpc, ITG ikmpc, ITG ilmpc, char labmpc, double coefmpc, ITG *ipompc))

void	FORTRAN (mult,(double matrix, double trans, ITG *n))

void	FORTRAN (negativepressure,(ITG ne0, ITG ne, ITG mi, double stx, double *pressureratio))

void	FORTRAN (networkelementpernode,(ITG iponoel, ITG inoel, char lakon, ITG ipkon, ITG kon, ITG inoelsize, ITG nflow, ITG ieg, ITG ne, ITG network))

void	FORTRAN (networkinum,(ITG ipkon, ITG inum, ITG kon, char lakon, ITG ne, ITG itg, ITG *ntg))

void	FORTRAN (nident,(ITG x, ITG px, ITG n, ITG id))

void	FORTRAN (nidentll,(long long x, long long px, ITG n, ITG id))

void	FORTRAN (nodestiedface,(char tieset, ITG ntie, ITG ipkon, ITG kon, char lakon, char set, ITG istartset, ITG iendset, ITG ialset, ITG nset, ITG faceslave, ITG istartfield, ITG iendfield, ITG ifield, ITG nconf, ITG ncone, char *kind))

void	nonlingeo (double *co, ITG nk, ITG konp, ITG ipkonp, char *lakonp, ITG ne, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompcp, ITG nodempcp, double coefmpcp, char labmpcp, ITG nmpc, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemloadp, char sideloadp, double xload, ITG nload, ITG nactdof, ITG *icolp, ITG jq, ITG *irowp, ITG neq, ITG nzl, ITG nmethod, ITG ikmpcp, ITG ilmpcp, ITG ikboun, ITG ilboun, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmatp, ITG ielorienp, ITG norien, double orab, ITG ntmat_, double t0, double t1, double t1old, ITG ithermal, double prestr, ITG iprestr, double *vold, ITG iperturb, double sti, ITG nzs, ITG kode, char filab, ITG idrct, ITG jmax, ITG jout, double timepar, double eme, double xbounold, double xforcold, double xloadold, double veold, double accold, char amname, double amta, ITG namta, ITG nam, ITG iamforc, ITG iamloadp, ITG iamt1, double alpha, ITG iexpl, ITG iamboun, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstatep, ITG npmat_, ITG istep, double ttime, char matname, double qaold, ITG mi, ITG isolver, ITG ncmat_, ITG nstate_, ITG iumat, double cs, ITG mcs, ITG nkon, double *ener, ITG mpcinfo, char output, double shcon, ITG nshcon, double cocon, ITG ncocon, double physcon, ITG nflow, double ctrl, char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, ITG nprint, char prlab, char prset, ITG nener, ITG ikforc, ITG ilforc, double trab, ITG inotr, ITG ntrans, double *fmpcp, char cbody, ITG ibody, double xbody, ITG nbody, double xbodyold, ITG ielprop, double prop, ITG ntie, char tieset, ITG itpamp, ITG iviewfile, char jobnamec, double tietol, ITG nslavs, double thicke, ITG ics, ITG nintpoint, ITG mortar, ITG ifacecount, char typeboun, ITG islavsurfp, double pslavsurfp, double clearinip, ITG nmat, double xmodal, ITG iaxial, ITG inext, ITG nprop, ITG network, char orname)

void	FORTRAN (nonlinmpc,(double co, double vold, ITG ipompc, ITG nodempc, double coefmpc, char labmpc, ITG nmpc, ITG ikboun, ITG ilboun, ITG nboun, double xbounact, double aux, ITG iaux, ITG maxlenmpc, ITG ikmpc, ITG ilmpc, ITG icascade, ITG kon, ITG ipkon, char lakon, ITG ne, double reltime, ITG newstep, double xboun, double fmpc, ITG newinc, ITG idiscon, ITG ncont, double trab, ITG ntrans, ITG ithermal, ITG mi))

void	FORTRAN (norm,(double vel, double velnorm, ITG *nef))

void	FORTRAN (normalsforequ_se,(ITG nk, double co, ITG iponoelfa, ITG inoelfa, ITG konfa, ITG ipkonfa, char lakonfa, ITG ne, ITG ipnor, double xnor, ITG nodedesiinv, char jobnamef))

void	FORTRAN (normalsoninterface,(ITG istartset, ITG iendset, ITG ialset, ITG imast, ITG ipkon, ITG kon, char lakon, ITG imastnode, ITG nmastnode, double xmastnor, double *co))

void	FORTRAN (normalsonsurface_se,(ITG ipkon, ITG kon, char lakon, double extnor, double co, ITG nk, ITG ipoface, ITG nodface, ITG nactdof, ITG mi, ITG nodedesiinv, ITG noregion))

void	objectivemain_se (double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, double v, double stn, ITG inum, double stx, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, double prestr, ITG iprestr, char filab, double eme, double emn, double een, ITG iperturb, double f, double fn, ITG nactdof, ITG iout, double qa, double vold, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, char labmpc, ITG nmpc, ITG nmethod, double cam, ITG neq, double veold, double accold, double bet, double gam, double dtime, double time, double ttime, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstateini, double xstiff, double xstate, ITG npmat_, double epn, char matname, ITG mi, ITG ielas, ITG icmd, ITG ncmat_, ITG nstate_, double stiini, double vini, ITG ikboun, ITG ilboun, double ener, double enern, double emeini, double xstaten, double eei, double enerini, double cocon, ITG ncocon, char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, ITG nprint, char prlab, char prset, double qfx, double qfn, double trab, ITG inotr, ITG ntrans, double fmpc, ITG nelemload, ITG nload, ITG ikmpc, ITG ilmpc, ITG istep, ITG iinc, double springarea, double reltime, ITG ne0, double xforc, ITG nforc, double thicke, double shcon, ITG nshcon, char sideload, double xload, double xloadold, ITG icfd, ITG inomat, double pslavsurf, double pmastsurf, ITG mortar, ITG islavact, double cdn, ITG islavnode, ITG nslavnode, ITG ntie, double clearini, ITG islavsurf, ITG ielprop, double prop, double energyini, double energy, double distmin, ITG ndesi, ITG nodedesi, ITG nobject, char objectset, double g0, double dgdx, double sti, double df, ITG nactdofinv, ITG jqs, ITG irows, ITG idisplacement, ITG nzs, char jobnamec, ITG isolver, ITG icol, ITG irow, ITG jq, ITG kode, double cs, char output, ITG istartdesi, ITG ialdesi, double xdesi, char orname, ITG icoordinate, ITG iev, double d, double z, double au, double ad, double aub, double adb, ITG cyclicsymmetry, ITG nzss, ITG nev, ITG ishapeenergy, double fint, ITG nlabel, ITG igreen, ITG nasym, ITG iponoel, ITG inoel, ITG nodedesiinv, double *dgdxglob)

void *	objectivemt_shapeener_dx (ITG *i)

void *	objectivemt_mass_dx (ITG *i)

void	FORTRAN (objective_disp,(ITG nodeset, ITG istartset, ITG iendset, ITG ialset, ITG nk, ITG idesvar, ITG iobject, ITG mi, double g0, ITG nobject, double *vold))

void	FORTRAN (objective_disp_dx,(ITG nodeset, ITG istartset, ITG iendset, ITG ialset, ITG nk, ITG idesvar, ITG iobject, ITG mi, ITG nactdof, double dgdx, ITG ndesi, ITG nobject, double vold, double b))

void	FORTRAN (objective_freq,(double dgdx, double df, double vold, ITG ndesi, ITG iobject, ITG mi, ITG nactdofinv, ITG jqs, ITG *irows))

void	FORTRAN (objective_freq_cs,(double dgdx, double df, double vold, ITG ndesi, ITG iobject, ITG mi, ITG nactdofinv, ITG jqs, ITG irows, ITG nk, ITG *nzss))

void	FORTRAN (objective_mass_dx,(double co1, ITG kon1, ITG ipkon1, char lakon1, ITG nelcon1, double rhcon1, ITG ielmat1, ITG ielorien1, ITG norien1, ITG ntmat1_, char matname1, ITG mi1, double thicke1, ITG mortar1, ITG nea, ITG neb, ITG ielprop1, double prop1, double distmin1, ITG ndesi1, ITG nodedesi1, ITG nobject1, double g01, double dgdx1, ITG iobject1, double xmass1, ITG istartdesi1, ITG ialdesi1, double xdesi1, ITG idesvar))

void	FORTRAN (objective_shapeener_dx,(double co1, ITG kon1, ITG ipkon1, char lakon1, ITG ne1, double stx1, double elcon1, ITG nelcon1, double rhcon1, ITG nrhcon1, double alcon1, ITG nalcon1, double alzero1, ITG ielmat1, ITG ielorien1, ITG norien1, double orab1, ITG ntmat1_, double t01, double t11, ITG ithermal1, double prestr1, ITG iprestr1, ITG iperturb1, ITG iout1, double vold1, ITG nmethod1, double veold1, double dtime1, double time1, double ttime1, double plicon1, ITG nplicon1, double plkcon1, ITG nplkcon1, double xstateini1, double xstiff1, double xstate1, ITG npmat1_, char matname1, ITG mi1, ITG ielas1, ITG icmd1, ITG ncmat1_, ITG nstate1_, double stiini1, double vini1, double ener1, double enerini1, ITG istep1, ITG iinc1, double springarea1, double reltime1, ITG calcul_qa1, ITG iener1, ITG ikin1, ITG ne01, double thicke1, double emeini1, double pslavsurf1, double pmastsurf1, ITG mortar1, double clearini1, ITG nea, ITG neb, ITG ielprop1, double prop1, double distmin1, ITG ndesi1, ITG nodedesi1, ITG nobject1, double g01, double dgdx1, ITG iobject1, double sti1, double xener1, ITG istartdesi1, ITG ialdesi1, double xdesi1, ITG idesvar))

void	FORTRAN (objective_shapeener_tot,(ITG ne, ITG kon, ITG ipkon, char lakon, double fint, double vold, ITG iperturb, ITG mi, ITG nactdof, double dgdx, double df, ITG ndesi, ITG iobject, ITG jqs, ITG irows, double vec))

void	FORTRAN (objective_stress,(ITG nodeset, ITG istartset, ITG iendset, ITG ialset, ITG nk, ITG idesvar, ITG iobject, ITG mi, double g0, ITG nobject, double stn, char objectset))

void	FORTRAN (objective_stress_dx,(ITG nodeset, ITG istartset, ITG iendset, ITG ialset, ITG nk, ITG idesvar, ITG iobject, double dgdx, ITG ndesi, ITG nobject, double stn, double dstn, char objectset, double g0))

void	FORTRAN (op,(ITG n, double x, double y, double ad, double au, ITG jq, ITG *irow))

void	FORTRAN (opas,(ITG n, double x, double y, double ad, double au, ITG jq, ITG irow, ITG nzs))

void	FORTRAN (op_corio,(ITG n, double x, double y, double ad, double au, ITG jq, ITG *irow))

void	FORTRAN (openfile,(char jobname, char output))

void	FORTRAN (openfilefluid,(char *jobname))

void	FORTRAN (posttransition,(double dgdxglob, ITG nobject, ITG nk, ITG nodedesi, ITG ndesi, char objectset))

void	FORTRAN (postview,(ITG ntr, char sideload, ITG nelemload, ITG kontri, ITG ntri, ITG nloadtr, double tenv, double adview, double auview, double area, double fenv, ITG jqrad, ITG irowrad, ITG nzsrad))

void	FORTRAN (precfd,(ITG ne, ITG ipkon, ITG kon, char lakon, ITG ipnei, ITG neifa, ITG neiel, ITG ipoface, ITG nodface, ITG ielfa, ITG nkonnei, ITG nface, ITG ifaext, ITG nfaext, ITG isolidsurf, ITG nsolidsurf, char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, double vel, double vold, ITG mi, ITG neij, ITG nef, ITG nactdoh, ITG ipkonf, char lakonf, ITG ielmatf, ITG ielmat, ITG ielorienf, ITG ielorien, ITG norien, double cs, ITG mcs, char tieset, double x, double y, double z, double xo, double yo, double zo, ITG nx, ITG ny, ITG nz, double co, ITG ifatei))

void	precontact (ITG ncont, ITG ntie, char tieset, ITG nset, char set, ITG istartset, ITG iendset, ITG ialset, ITG itietri, char lakon, ITG ipkon, ITG kon, ITG koncont, ITG ne, double cg, double straight, double co, double vold, ITG istep, ITG iinc, ITG iit, ITG itiefac, ITG islavsurf, ITG islavnode, ITG imastnode, ITG nslavnode, ITG nmastnode, ITG imastop, ITG mi, ITG ipe, ITG ime, double tietol, ITG iflagact, ITG nintpoint, double *pslavsurfp, double xmastnor, double cs, ITG mcs, ITG ics, double clearini, ITG *nslavs)

void	FORTRAN (preconvert2slapcol,(ITG irow, ITG ia, ITG jq, ITG ja, ITG nzs, ITG nef))

void	FORTRAN (predgmres,(ITG n, double b, double x, ITG nelt, ITG ia, ITG ja, double a, ITG isym, ITG itol, double tol, ITG itmax, ITG iter, double err, ITG ierr, ITG iunit, double sb, double sx, double rgwk, ITG lrgw, ITG igwk, ITG ligw, double rwork, ITG *iwork))

void	prediction (double uam, ITG nmethod, double bet, double gam, double dtime, ITG ithermal, ITG nk, double veold, double accold, double v, ITG iinc, ITG idiscon, double vold, ITG nactdof, ITG *mi)

void	prediction_em (double uam, ITG nmethod, double bet, double gam, double dtime, ITG ithermal, ITG nk, double veold, double v, ITG iinc, ITG idiscon, double vold, ITG nactdof, ITG mi)

void	FORTRAN (prefilter,(double co, ITG nodedesi, ITG ndesi, double xo, double yo, double zo, double x, double y, double z, ITG nx, ITG ny, ITG nz))

void	preiter (double ad, double aup, double b, ITG icolp, ITG irowp, ITG neq, ITG nzs, ITG isolver, ITG iperturb)

void	FORTRAN (prethickness,(double co, double xo, double yo, double zo, double x, double y, double z, ITG nx, ITG ny, ITG nz, ITG ifree, ITG nodedesiinv, ITG ndesiboun, ITG nodedesiboun, char set, ITG nset, char objectset, ITG iobject, ITG istartset, ITG iendset, ITG *ialset))

void	FORTRAN (pretransition,(ITG ipkon, ITG kon, char lakon, double co, ITG nk, ITG ipoface, ITG nodface, ITG nodedesiinv, double xo, double yo, double zo, double x, double y, double z, ITG nx, ITG ny, ITG nz, ITG ifree))

void	FORTRAN (printoutfluid,(char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, ITG nprint, char prlab, char prset, ITG ipkon, char lakon, double stx, double eei, double xstate, double ener, ITG mi, ITG nstate_, double co, ITG kon, double qfx, double ttime, double trab, ITG inotr, ITG ntrans, double orab, ITG ielorien, ITG norien, double vold, ITG ielmatf, double thicke, double eme, double vcontu, double physcon, ITG nactdoh, ITG ielpropf, double prop, double xkappa, double xmach, ITG ithermal, char *orname))

void	FORTRAN (printoutface,(double co, double rhcon, ITG nrhcon, ITG ntmat_, double vold, double shcon, ITG nshcon, double cocon, ITG ncocon, ITG icompressible, ITG istartset, ITG iendset, ITG ipkon, char lakon, ITG kon, ITG ialset, char prset, double timef, ITG nset, char set, ITG nprint, char prlab, ITG ielmat, ITG mi, ITG ithermal, ITG nactdoh, ITG icfd, double time, double *stn))

void	projectgradmain (ITG nobject, char objectset, double dgdxglob, double g0, ITG ndesi, ITG nodedesi, ITG nk, ITG isolver, ITG nactive, ITG nnlconst, ITG *ipoacti)

void	FORTRAN (propertynet,(ITG ieg, ITG nflow, double prop, ITG ielprop, char lakon, ITG iin, double prop_store, double ttime, double time, ITG nam, char amname, ITG namta, double *amta))

int	pthread_create (pthread_t thread_id, const pthread_attr_t attributes, void (thread_function)(void ), void arguments)

int	pthread_join (pthread_t thread, void **status_ptr)

void	radcyc (ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, double cs, ITG mcs, ITG nkon, ITG ialset, ITG istartset, ITG iendset, ITG kontrip, ITG ntri, double cop, double voldp, ITG ntrit, ITG inocs, ITG *mi)

void	radflowload (ITG itg, ITG ieg, ITG ntg, ITG ntr, double adrad, double aurad, double bcr, ITG ipivr, double ac, double bc, ITG nload, char sideload, ITG nelemload, double xloadact, char lakon, ITG ipiv, ITG ntmat_, double vold, double shcon, ITG nshcon, ITG ipkon, ITG kon, double co, ITG kontri, ITG ntri, ITG nloadtr, double tarea, double tenv, double physcon, double erad, double adviewp, double auviewp, ITG nflow, ITG ikboun, double xboun, ITG nboun, ITG ithermal, ITG iinc, ITG iit, double cs, ITG mcs, ITG inocs, ITG ntrit, ITG nk, double fenv, ITG istep, double dtime, double ttime, double time, ITG ilboun, ITG ikforc, ITG ilforc, double xforc, ITG nforc, double cam, ITG ielmat, ITG nteq, double prop, ITG ielprop, ITG nactdog, ITG nacteq, ITG nodeboun, ITG ndirboun, ITG network, double rhcon, ITG nrhcon, ITG ipobody, ITG ibody, double xbody, ITG nbody, ITG iviewfile, char jobnamef, double ctrl, double xloadold, double reltime, ITG nmethod, char set, ITG mi, ITG istartset, ITG iendset, ITG ialset, ITG nset, ITG ineighe, ITG nmpc, ITG nodempc, ITG ipompc, double coefmpc, char labmpc, ITG iemchange, ITG nam, ITG iamload, ITG jqrad, ITG irowrad, ITG nzsrad, ITG icolrad, ITG ne, ITG iaxial, double qa, double cocon, ITG ncocon, ITG iponoel, ITG inoel, ITG nprop, char amname, ITG namta, double amta)

void	FORTRAN (radmatrix,(ITG ntr, double adrad, double aurad, double bcr, char sideload, ITG nelemload, double xloadact, char lakon, double vold, ITG ipkon, ITG kon, double co, ITG nloadtr, double tarea, double tenv, double physcon, double erad, double adview, double auview, ITG ithermal, ITG iinc, ITG iit, double fenv, ITG istep, double dtime, double ttime, double time, ITG iviewfile, double xloadold, double reltime, ITG nmethod, ITG mi, ITG iemchange, ITG nam, ITG iamload, ITG jqrad, ITG irowrad, ITG nzsrad))

void	FORTRAN (radresult,(ITG ntr, double xloadact, double bcr, ITG nloadtr, double tarea, double tenv, double physcon, double erad, double auview, double fenv, ITG irowrad, ITG jqrad, ITG nzsrad, double q))

void	randomfieldmain (ITG kon, ITG ipkon, char lakon, ITG ne, ITG nmpc, ITG nactdof, ITG mi, ITG nodedesi, ITG ndesi, ITG istartdesi, ITG ialdesi, double co, double physcon, ITG isolver, ITG ntrans, ITG nk, ITG inotr, double trab, char jobnamec, ITG nboun, double cs, ITG mcs, ITG inum, ITG nmethod, ITG kode, char filab, ITG nstate_, ITG istep, char description, char set, ITG nset, ITG iendset, char output, ITG istartset, ITG ialset, double extnor)

void	FORTRAN (randomval,(double randval, ITG nev))

void	FORTRAN (readforce,(double zc, ITG neq, ITG nev, ITG nactdof, ITG ikmpc, ITG nmpc, ITG ipompc, ITG nodempc, ITG mi, double coefmpc, char jobnamec, double aa, ITG *igeneralizedforce))

void	readinput (char jobnamec, char inpcp, ITG nline, ITG nset, ITG ipoinp, ITG inpp, ITG ipoinpcp, ITG ithermal, ITG nuel_)

void	FORTRAN (readview,(ITG ntr, double adview, double auview, double fenv, ITG nzsrad, ITG ithermal, char *jobnamef))

void	FORTRAN (rearrange,(double au, ITG irow, ITG icol, ITG ndim, ITG *neq))

void	FORTRAN (rectcyl,(double co, double v, double fn, double stn, double qfn, double een, double cs, ITG nk, ITG icntrl, double t, char filab, ITG imag, ITG mi, double emn))

void	FORTRAN (rectcylexp,(double co, double v, double fn, double stn, double qfn, double een, double cs, ITG nkt, ITG icntrl, double t, char filab, ITG imag, ITG mi, ITG iznode, ITG nznode, ITG nsectors, ITG nk, double emn))

void	FORTRAN (rectcyltrfm,(ITG node, double co, double cs, ITG cntrl, double fin, double fout))

void	FORTRAN (rectcylvi,(double co, double v, double fn, double stn, double qfn, double een, double cs, ITG nk, ITG icntrl, double t, char filab, ITG imag, ITG mi, double emn))

void	remastruct (ITG ipompc, double coefmpcp, ITG nodempcp, ITG nmpc, ITG mpcfree, ITG nodeboun, ITG ndirboun, ITG nboun, ITG ikmpc, ITG ilmpc, ITG ikboun, ITG ilboun, char labmpc, ITG nk, ITG memmpc_, ITG icascade, ITG maxlenmpc, ITG kon, ITG ipkon, char lakon, ITG ne, ITG nactdof, ITG icol, ITG jq, ITG *irowp, ITG isolver, ITG neq, ITG nzs, ITG nmethod, double fp, double fextp, double bp, double aux2p, double finip, double fextinip, double adbp, double aubp, ITG ithermal, ITG iperturb, ITG mass, ITG mi, ITG iexpl, ITG mortar, char typeboun, double cvp, double cvinip, ITG iit, ITG network)

void	remastructar (ITG ipompc, double coefmpcp, ITG nodempcp, ITG nmpc, ITG mpcfree, ITG nodeboun, ITG ndirboun, ITG nboun, ITG ikmpc, ITG ilmpc, ITG ikboun, ITG ilboun, char labmpc, ITG nk, ITG memmpc_, ITG icascade, ITG maxlenmpc, ITG kon, ITG ipkon, char lakon, ITG ne, ITG nactdof, ITG icol, ITG jq, ITG *irowp, ITG isolver, ITG neq, ITG nzs, ITG nmethod, ITG ithermal, ITG iperturb, ITG mass, ITG mi, ITG ics, double cs, ITG mcs, ITG mortar, char typeboun, ITG iit, ITG network)

void	remastructem (ITG ipompc, double coefmpcp, ITG nodempcp, ITG nmpc, ITG mpcfree, ITG nodeboun, ITG ndirboun, ITG nboun, ITG ikmpc, ITG ilmpc, ITG ikboun, ITG ilboun, char labmpc, ITG nk, ITG memmpc_, ITG icascade, ITG maxlenmpc, ITG kon, ITG ipkon, char lakon, ITG ne, ITG nactdof, ITG icol, ITG jq, ITG *irowp, ITG isolver, ITG neq, ITG nzs, ITG nmethod, double fp, double fextp, double bp, double aux2p, double finip, double fextinip, double adbp, double aubp, ITG ithermal, ITG iperturb, ITG mass, ITG mi, ITG ielmat, double elcon, ITG ncmat_, ITG ntmat_, ITG inomat, ITG *network)

void	FORTRAN (restartshort,(ITG nset, ITG nload, ITG nbody, ITG nforc, ITG nboun, ITG nk, ITG ne, ITG nmpc, ITG nalset, ITG nmat, ITG ntmat, ITG npmat, ITG norien, ITG nam, ITG nprint, ITG mint, ITG ntrans, ITG ncs, ITG namtot, ITG ncmat, ITG memmpc, ITG ne1d, ITG ne2d, ITG nflow, char set, ITG meminset, ITG rmeminset, char jobnamec, ITG irestartstep, ITG icntrl, ITG ithermal, ITG nener, ITG nstate_, ITG ntie, ITG nslavs, ITG nkon, ITG mcs, ITG nprop, ITG mortar, ITG ifacecount, ITG nintpoint, ITG infree))

void	FORTRAN (restartwrite,(ITG istep, ITG nset, ITG nload, ITG nforc, ITG nboun, ITG nk, ITG ne, ITG nmpc, ITG nalset, ITG nmat, ITG ntmat_, ITG npmat_, ITG norien, ITG nam, ITG nprint, ITG mi, ITG ntrans, ITG ncs_, ITG namtot_, ITG ncmat_, ITG mpcend, ITG maxlenmpc, ITG ne1d, ITG ne2d, ITG nflow, ITG nlabel, ITG iplas, ITG nkon, ITG ithermal, ITG nmethod, ITG iperturb, ITG nstate_, ITG nener, char set, ITG istartset, ITG iendset, ITG ialset, double co, ITG kon, ITG ipkon, char lakon, ITG nodeboun, ITG ndirboun, ITG iamboun, double xboun, ITG ikboun, ITG ilboun, ITG ipompc, ITG nodempc, double coefmpc, char labmpc, ITG ikmpc, ITG ilmpc, ITG nodeforc, ITG ndirforc, ITG iamforc, double xforc, ITG ikforc, ITG ilforc, ITG nelemload, ITG iamload, char sideload, double xload, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, double plicon, ITG nplicon, double plkcon, ITG nplkcon, char orname, double orab, ITG ielorien, double trab, ITG inotr, char amname, double amta, ITG namta, double t0, double t1, ITG iamt1, double veold, ITG ielmat, char matname, char prlab, char prset, char filab, double vold, ITG nodebounold, ITG ndirbounold, double xbounold, double xforcold, double xloadold, double t1old, double eme, ITG iponor, double xnor, ITG knor, double thicke, double offset, ITG iponoel, ITG inoel, ITG rig, double shcon, ITG nshcon, double cocon, ITG ncocon, ITG ics, double sti, double ener, double xstate, char jobnamec, ITG infree, double prestr, ITG iprestr, char cbody, ITG ibody, double xbody, ITG nbody, double xbodyold, double ttime, double qaold, double cs, ITG mcs, char output, double physcon, double ctrl, char typeboun, double fmpc, char tieset, ITG ntie, double tietol, ITG nslavs, double t0g, double t1g, ITG nprop, ITG ielprop, double prop, ITG mortar, ITG nintpoint, ITG ifacecount, ITG islavsurf, double pslavsurf, double clearini))

void	FORTRAN (resultnet,(ITG itg, ITG ieg, ITG ntg, double bc, ITG nload, char sideload, ITG nelemload, double xloadact, char lakon, ITG ntmat_, double v, double shcon, ITG nshcon, ITG ipkon, ITG kon, double co, ITG nflow, ITG iinc, ITG istep, double dtime, double ttime, double time, ITG ikforc, ITG ilforc, double xforcact, ITG nforc, ITG ielmat, ITG nteq, double prop, ITG ielprop, ITG nactdog, ITG nacteq, ITG iin, double physcon, double camt, double camf, double camp, double rhcon, ITG nrhcon, ITG ipobody, ITG ibody, double xbody, ITG nbody, double dtheta, double vold, double xloadold, double reltime, ITG nmethod, char set, ITG mi, ITG ineighe, double cama, double vamt, double vamf, double vamp, double vama, ITG nmpc, ITG nodempc, ITG ipompc, double coefmpc, char labmpc, ITG iaxial, double qat, double qaf, double ramt, double ramf, double ramp, double cocon, ITG ncocon, ITG iponoel, ITG inoel, ITG iplausi))

void	results (double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, double v, double stn, ITG inum, double stx, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, double prestr, ITG iprestr, char filab, double eme, double emn, double een, ITG iperturb, double f, double fn, ITG nactdof, ITG iout, double qa, double vold, double b, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, char labmpc, ITG nmpc, ITG nmethod, double vmax, ITG neq, double veold, double accold, double beta, double gamma, double dtime, double time, double ttime, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstateini, double xstiff, double xstate, ITG npmat_, double epl, char matname, ITG mi, ITG ielas, ITG icmd, ITG ncmat_, ITG nstate_, double stiini, double vini, ITG ikboun, ITG ilboun, double ener, double enern, double emeini, double xstaten, double eei, double enerini, double cocon, ITG ncocon, char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, ITG nprint, char prlab, char prset, double qfx, double qfn, double trab, ITG inotr, ITG ntrans, double fmpc, ITG nelemload, ITG nload, ITG ikmpc, ITG ilmpc, ITG istep, ITG iinc, double springarea, double reltime, ITG ne0, double xforc, ITG nforc, double thicke, double shcon, ITG nshcon, char sideload, double xload, double xloadold, ITG icfd, ITG inomat, double pslavsurf, double pmastsurf, ITG mortar, ITG islavact, double cdn, ITG islavnode, ITG nslavnode, ITG ntie, double clearini, ITG islavsurf, ITG ielprop, double prop, double energyini, double energy, ITG kscale, ITG iponoel, ITG inoel, ITG nener, char orname, ITG network, ITG ipobody, double xbodyact, ITG *ibody)

void	FORTRAN (resultsem,(double co, ITG kon, ITG ipkon, char lakon, double v, double elcon, ITG nelcon, ITG ielmat, ITG ntmat_, double vold, double dtime, char matname, ITG mi, ITG ncmat_, ITG nea, ITG neb, double sti, double alcon, ITG nalcon, double h0, ITG istartset, ITG iendset, ITG ialset, ITG iactive, double *fn))

void *	resultsemmt (ITG *i)

void	FORTRAN (resultsforc,(ITG nk, double f, double fn, ITG nactdof, ITG ipompc, ITG nodempc, double coefmpc, char labmpc, ITG nmpc, ITG mi, double fmpc, ITG calcul_fn, ITG *calcul_f))

void	FORTRAN (resultsforc_em,(ITG nk, double f, double fn, ITG nactdof, ITG ipompc, ITG nodempc, double coefmpc, char labmpc, ITG nmpc, ITG mi, double fmpc, ITG calcul_fn, ITG calcul_f, ITG inomat))

void	FORTRAN (resultsforc_se,(ITG nk, double dfn, ITG nactdof, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, ITG mi, double fmpc, ITG calcul_fn, ITG calcul_f, ITG idesvar, double df, ITG jqs, ITG irows, double distmin))

void	FORTRAN (resultsini,(ITG nk, double v, ITG ithermal, char filab, ITG iperturb, double f, double fn, ITG nactdof, ITG iout, double qa, double vold, double b, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, char labmpc, ITG nmpc, ITG nmethod, double cam, ITG neq, double veold, double accold, double bet, double gam, double dtime, ITG mi, double vini, ITG nprint, char prlab, ITG intpointvar, ITG calcul_fn, ITG calcul_f, ITG calcul_qa, ITG calcul_cauchy, ITG iener, ITG ikin, ITG intpointvart, double xforc, ITG *nforc))

void	FORTRAN (resultsini_em,(ITG nk, double v, ITG ithermal, char filab, ITG iperturb, double f, double fn, ITG nactdof, ITG iout, double qa, double b, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, char labmpc, ITG nmpc, ITG nmethod, double cam, ITG neq, double veold, double dtime, ITG mi, double vini, ITG nprint, char prlab, ITG intpointvar, ITG calcul_fn, ITG calcul_f, ITG calcul_qa, ITG calcul_cauchy, ITG iener, ITG ikin, ITG intpointvart, double xforc, ITG *nforc))

void	FORTRAN (resultsmech,(double co, ITG kon, ITG ipkon, char lakon, ITG ne, double v, double stx, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, double prestr, ITG iprestr, double eme, ITG iperturb, double fn, ITG iout, double qa, double vold, ITG nmethod, double veold, double dtime, double time, double ttime, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstateini, double xstiff, double xstate, ITG npmat_, char matname, ITG mi, ITG ielas, ITG icmd, ITG ncmat_, ITG nstate_, double stiini, double vini, double ener, double eei, double enerini, ITG istep, ITG iinc, double springarea, double reltime, ITG calcul_fn, ITG calcul_qa, ITG calcul_cauchy, ITG iener, ITG ikin, ITG nal, ITG ne0, double thicke, double emeini, double pslavsurf, double pmastsurf, ITG mortar, double clearini, ITG nea, ITG neb, ITG ielprop, double prop, ITG kscale))

void *	resultsmechmt (ITG *i)

void *	resultsmechmtstr (ITG *i)

void *	resultsmechmt_se (ITG *i)

void	FORTRAN (resultsmech_se,(double co, ITG kon, ITG ipkon, char lakon, ITG ne, double v, double stx, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, double prestr, ITG iprestr, double eme, ITG iperturb, double fn, ITG iout, double vold, ITG nmethod, double veold, double dtime, double time, double ttime, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstateini, double xstiff, double xstate, ITG npmat_, char matname, ITG mi, ITG ielas, ITG icmd, ITG ncmat_, ITG nstate_, double stiini, double vini, double ener, double eei, double enerini, ITG istep, ITG iinc, double springarea, double reltime, ITG calcul_fn, ITG calcul_cauchy, ITG iener, ITG ikin, ITG ne0, double thicke, double emeini, double pslavsurf, double pmastsurf, ITG mortar, double clearini, ITG nea, ITG neb, ITG ielprop, double prop, double dfn, ITG idesvar, ITG nodedesi, double fn0, double sti, ITG icoordinate, double dxstiff, ITG ialdesi, double *xdesi))

void	FORTRAN (resultsnoddir,(ITG nk, double v, ITG nactdof, double b, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, ITG *mi))

void	FORTRAN (resultsprint,(double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, double v, double stn, ITG inum, double stx, ITG ielorien, ITG norien, double orab, double t1, ITG ithermal, char filab, double een, ITG iperturb, double fn, ITG nactdof, ITG iout, double vold, ITG nodeboun, ITG ndirboun, ITG nboun, ITG nmethod, double ttime, double xstate, double epn, ITG mi, ITG nstate_, double ener, double enern, double xstaten, double eei, char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, ITG nprint, char prlab, char prset, double qfx, double qfn, double trab, ITG inotr, ITG ntrans, ITG nelemload, ITG nload, ITG ikin, ITG ielmat, double thicke, double eme, double emn, double rhcon, ITG nrhcon, double shcon, ITG nshcon, double cocon, ITG ncocon, ITG ntmat_, char sideload, ITG icfd, ITG inomat, double pslavsurf, ITG islavact, double cdn, ITG mortar, ITG islavnode, ITG nslavnode, ITG ntie, ITG islavsurf, double time, ITG ielprop, double prop, double veold, ITG ne0, ITG nmpc, ITG ipompc, ITG nodempc, char labmpc, double energyini, double energy, char orname, double xload))

void	resultsstr (double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, double v, double stn, ITG inum, double stx, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, double prestr, ITG iprestr, char filab, double eme, double emn, double een, ITG iperturb, double f, double fn, ITG nactdof, ITG iout, double qa, double vold, double b, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, char labmpc, ITG nmpc, ITG nmethod, double vmax, ITG neq, double veold, double accold, double beta, double gamma, double dtime, double time, double ttime, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstateini, double xstiff, double xstate, ITG npmat_, double epl, char matname, ITG mi, ITG ielas, ITG icmd, ITG ncmat_, ITG nstate_, double stiini, double vini, ITG ikboun, ITG ilboun, double ener, double enern, double emeini, double xstaten, double eei, double enerini, double cocon, ITG ncocon, char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, ITG nprint, char prlab, char prset, double qfx, double qfn, double trab, ITG inotr, ITG ntrans, double fmpc, ITG nelemload, ITG nload, ITG ikmpc, ITG ilmpc, ITG istep, ITG iinc, double springarea, double reltime, ITG ne0, double xforc, ITG nforc, double thicke, double shcon, ITG nshcon, char sideload, double xload, double xloadold, ITG icfd, ITG inomat, double pslavsurf, double pmastsurf, ITG mortar, ITG islavact, double cdn, ITG islavnode, ITG nslavnode, ITG ntie, double clearini, ITG islavsurf, ITG ielprop, double prop, double energyini, double energy, ITG kscale, ITG nener, char orname, ITG network, ITG neapar, ITG nebpar)

void	results_se (double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, double v, double stn, ITG inum, double stx, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, double prestr, ITG iprestr, char filab, double eme, double emn, double een, ITG iperturb, double f, double fn, ITG nactdof, ITG iout, double qa, double vold, double b, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, char labmpc, ITG nmpc, ITG nmethod, double vmax, ITG neq, double veold, double accold, double beta, double gamma, double dtime, double time, double ttime, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstateini, double xstiff, double xstate, ITG npmat_, double epl, char matname, ITG mi, ITG ielas, ITG icmd, ITG ncmat_, ITG nstate_, double stiini, double vini, ITG ikboun, ITG ilboun, double ener, double enern, double emeini, double xstaten, double eei, double enerini, double cocon, ITG ncocon, char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, ITG nprint, char prlab, char prset, double qfx, double qfn, double trab, ITG inotr, ITG ntrans, double fmpc, ITG nelemload, ITG nload, ITG ikmpc, ITG ilmpc, ITG istep, ITG iinc, double springarea, double reltime, ITG ne0, double xforc, ITG nforc, double thicke, double shcon, ITG nshcon, char sideload, double xload, double xloadold, ITG icfd, ITG inomat, double pslavsurf, double pmastsurf, ITG mortar, ITG islavact, double cdn, ITG islavnode, ITG nslavnode, ITG ntie, double clearini, ITG islavsurf, ITG ielprop, double prop, double energyini, double energy, double df, double distmin, ITG ndesi, ITG nodedesi, double sti, ITG nkon, ITG jqs, ITG irows, ITG nactdofinv, ITG icoordinate, double dxstiff, ITG istartdesi, ITG ialdesi, double xdesi, ITG ieigenfrequency, double fint, ITG *ishapeenergy)

void	FORTRAN (resultstherm,(double co, ITG kon, ITG ipkon, char lakon, double v, double elcon, ITG nelcon, double rhcon, ITG nrhcon, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, ITG iperturb, double fn, double shcon, ITG nshcon, ITG iout, double qa, double vold, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, double dtime, double time, double ttime, double plkcon, ITG nplkcon, double xstateini, double xstiff, double xstate, ITG npmat_, char matname, ITG mi, ITG ncmat_, ITG nstate_, double cocon, ITG ncocon, double qfx, ITG ikmpc, ITG ilmpc, ITG istep, ITG iinc, double springarea, ITG calcul_fn, ITG calcul_qa, ITG nal, ITG nea, ITG neb, ITG ithermal, ITG nelemload, ITG nload, ITG nmethod, double reltime, char sideload, double xload, double xloadold, double pslavsurf, double pmastsurf, ITG mortar, double clearini, double plicon, ITG nplicon, ITG ielprop, double prop, ITG iponoel, ITG inoel, ITG network, ITG ipobody, double xbodyact, ITG ibody))

void *	resultsthermemmt (ITG *i)

void *	resultsthermmt (ITG *i)

void *	resultsthermmt_se (ITG *i)

void	resultsinduction (double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, double v, double stn, ITG inum, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, double prestr, ITG iprestr, char filab, double eme, double emn, double een, ITG iperturb, double f, double fn, ITG nactdof, ITG iout, double qa, double vold, double b, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, char labmpc, ITG nmpc, ITG nmethod, double vmax, ITG neq, double veold, double accold, double beta, double gamma, double dtime, double time, double ttime, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstateini, double xstiff, double xstate, ITG npmat_, double epl, char matname, ITG mi, ITG ielas, ITG icmd, ITG ncmat_, ITG nstate_, double sti, double vini, ITG ikboun, ITG ilboun, double ener, double enern, double emeini, double xstaten, double eei, double enerini, double cocon, ITG ncocon, char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, ITG nprint, char prlab, char prset, double qfx, double qfn, double trab, ITG inotr, ITG ntrans, double fmpc, ITG nelemload, ITG nload, ITG ikmpc, ITG ilmpc, ITG istep, ITG iinc, double springarea, double reltime, ITG ne0, double xforc, ITG nforc, double thicke, double shcon, ITG nshcon, char sideload, double xload, double xloadold, ITG icfd, ITG inomat, double h0, ITG islavnode, ITG nslavnode, ITG ntie, ITG ielprop, double prop, ITG iactive, double energyini, double energy, ITG iponoel, ITG inoel, char orname, ITG network, ITG ipobody, double xbody, ITG *ibody)

void	FORTRAN (rhs,(double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemload, char sideload, double xload, ITG nload, double xbody, ITG ipobody, ITG nbody, double cgr, double bb, ITG nactdof, ITG neq, ITG nmethod, ITG ikmpc, ITG ilmpc, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, ITG iprestr, double vold, ITG iperturb, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, ITG npmat_, double ttime, double time, ITG istep, ITG iinc, double dtime, double physcon, ITG ibody, double xbodyold, double reltime, double veold, char matname, ITG mi, ITG ikactmech, ITG nactmech, ITG ielprop, double prop, double sti, double xstateini, double xstate, ITG nstate_))

void	FORTRAN (rhsp,(ITG ne, char lakon, ITG ipnei, ITG neifa, ITG neiel, double vfa, double area, double adfa, double xlet, double cosa, double volume, double au, double ad, ITG jq, ITG irow, double ap, ITG ielfa, ITG ifabou, double xle, double b, double xxn, ITG neq, ITG nzs, double hfa, double gradpel, double bp, double xxi, ITG neij, double xlen, ITG nefa, ITG nefb, double xxicn))

void	rhspmain (ITG ne, char lakon, ITG ipnei, ITG neifa, ITG neiel, double vfa, double area, double adfa, double xlet, double cosa, double volume, double au, double ad, ITG jq, ITG irow, double ap, ITG ielfa, ITG ifabou, double xle, double b, double xxn, ITG neq, ITG nzs, double hfa, double gradpel, double bp, double xxi, ITG neij, double xlen, ITG iatleastonepressurebc, double *xxicn)

void *	rhspmt (ITG *i)

void	sensitivity (double co, ITG nk, ITG konp, ITG ipkonp, char *lakonp, ITG ne, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, char labmpc, ITG nmpc, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemload, char sideload, double xload, ITG nload, ITG nactdof, ITG icol, ITG jq, ITG *irowp, ITG neq, ITG nzl, ITG nmethod, ITG ikmpc, ITG ilmpc, ITG ikboun, ITG ilboun, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmatp, ITG ielorienp, ITG norien, double orab, ITG ntmat_, double t0, double t1, double t1old, ITG ithermal, double prestr, ITG iprestr, double vold, ITG iperturb, double sti, ITG nzs, ITG kode, char filab, double eme, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double *xstatep, ITG npmat_, char matname, ITG isolver, ITG mi, ITG ncmat_, ITG nstate_, double cs, ITG mcs, ITG nkon, double *enerp, double xbounold, double xforcold, double xloadold, char amname, double amta, ITG namta, ITG nam, ITG iamforc, ITG iamload, ITG iamt1, ITG iamboun, double ttime, char output, char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, ITG nprint, char prlab, char prset, ITG nener, double trab, ITG inotr, ITG ntrans, double fmpc, char cbody, ITG ibody, double xbody, ITG nbody, double xbodyold, double timepar, double thicke, char jobnamec, char tieset, ITG ntie, ITG istep, ITG nmat, ITG ielprop, double prop, char typeboun, ITG mortar, ITG mpcinfo, double tietol, ITG ics, ITG icontact, ITG nobject, char *objectsetp, ITG istat, char orname, ITG nzsfreq, ITG nlabel, double physcon, char *jobnamef)

void	FORTRAN (sensitivity_glob,(double dgdxtot, double dgdxtotglob, ITG nobject, ITG ndesi, ITG nodedesi, ITG nk))

void	sensitivity_out (char jobnamec, double dgdxtotglob, ITG neq, ITG nobject, double *g0)

void	FORTRAN (shape3tri,(double xi, double et, double xl, double xsj, double xs, double shp, ITG *iflag))

void	FORTRAN (shape4q,(double xi, double et, double xl, double xsj, double xs, double shp, ITG *iflag))

void	FORTRAN (shape4tet,(double xi, double et, double ze, double xl, double xsj, double shp, ITG *iflag))

void	FORTRAN (shape6tri,(double xi, double et, double xl, double xsj, double xs, double shp, ITG *iflag))

void	FORTRAN (shape6w,(double xi, double et, double ze, double xl, double xsj, double shp, ITG *iflag))

void	FORTRAN (shape8h,(double xi, double et, double ze, double xl, double xsj, double shp, ITG *iflag))

void	FORTRAN (shape8q,(double xi, double et, double xl, double xsj, double xs, double shp, ITG *iflag))

void	FORTRAN (shape10tet,(double xi, double et, double ze, double xl, double xsj, double shp, ITG *iflag))

void	FORTRAN (shape15w,(double xi, double et, double ze, double xl, double xsj, double shp, ITG *iflag))

void	FORTRAN (shape20h,(double xi, double et, double ze, double xl, double xsj, double shp, ITG *iflag))

void	FORTRAN (slavintpoints,(ITG ntie, ITG itietri, ITG ipkon, ITG kon, char lakon, double straight, ITG nintpoint, ITG koncont, double co, double vold, double xo, double yo, double zo, double x, double y, double z, ITG nx, ITG ny, ITG nz, ITG islavsurf, ITG islavnode, ITG nslavnode, ITG imastop, ITG mi, ITG ncont, ITG ipe, ITG ime, double pslavsurf, ITG i, ITG l, ITG *ntri))

void	FORTRAN (smalldist,(double co, double distmin, char lakon, ITG ipkon, ITG kon, ITG ne))

void	FORTRAN (sortev,(ITG nev, ITG nmd, double eigxx, ITG cyclicsymmetry, double xx, double eigxr, ITG pev, ITG istartnmd, ITG iendnmd, double aa, double *bb))

void	FORTRAN (spcmatch,(double xboun, ITG nodeboun, ITG ndirboun, ITG nboun, double xbounold, ITG nodebounold, ITG ndirbounold, ITG nbounold, ITG ikboun, ITG ilboun, double vold, double reorder, ITG nreorder, ITG mi))

void	FORTRAN (splitline,(char text, char textpart, ITG *n))

void	spooles (double ad, double au, double adb, double aub, double sigma, double b, ITG icol, ITG irow, ITG neq, ITG nzs, ITG symmtryflag, ITG inputformat, ITG *nzs3)

void	FORTRAN (springforc_n2f,(double xl, ITG konl, double vl, ITG imat, double elcon, ITG nelcon, double elas, double fnl, ITG ncmat_, ITG ntmat_, ITG nope, char lakonl, double t1l, ITG kode, double elconloc, double plicon, ITG nplicon, ITG npmat_, double senergy, ITG iener, double cstr, ITG mi, double springarea, ITG nmethod, ITG ne0, ITG nstate_, double xstateini, double xstate, double reltime, ITG ielas, double venergy, ITG ielorien, double orab, ITG norien, ITG *nelem))

void	FORTRAN (springstiff_n2f,(double xl, double elas, ITG konl, double voldl, double s, ITG imat, double elcon, ITG nelcon, ITG ncmat_, ITG ntmat_, ITG nope, char lakonl, double t1l, ITG kode, double elconloc, double plicon, ITG nplicon, ITG npmat_, ITG iperturb, double springarea, ITG nmethod, ITG mi, ITG ne0, ITG nstate_, double xstateini, double xstate, double reltime, ITG nasym, ITG ielorien, double orab, ITG norien, ITG nelem))

void	steadystate (double *co, ITG nk, ITG kon, ITG ipkon, char *lakon, ITG ne, ITG nodeboun, ITG ndirboun, double *xboun, ITG nboun, ITG ipompcp, ITG nodempcp, double coefmpcp, char labmpcp, ITG nmpc, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemload, char sideload, double xload, ITG nload, ITG nactdof, ITG neq, ITG nzl, ITG icol, ITG irow, ITG nmethod, ITG ikmpcp, ITG ilmpcp, ITG ikboun, ITG ilboun, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double cocon, ITG ncocon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, double prestr, ITG iprestr, double voldp, ITG iperturb, double sti, ITG nzs, double timepar, double xmodal, double *veoldp, char amname, double amta, ITG namta, ITG nam, ITG iamforc, ITG iamload, ITG iamt1, ITG jout, ITG kode, char filab, double *emep, double xforcold, double xloadold, double t1old, ITG iamboun, double xbounold, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstate, ITG npmat_, char matname, ITG mi, ITG ncmat_, ITG nstate_, double *enerp, char jobnamec, double ttime, char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, ITG nprint, char prlab, char prset, ITG nener, double trab, ITG inotr, ITG ntrans, double *fmpcp, char cbody, ITG ibody, double xbody, ITG nbody, double xbodyold, ITG istep, ITG isolver, ITG jq, char output, ITG mcs, ITG nkon, ITG ics, double cs, ITG mpcend, double ctrl, ITG ikforc, ITG ilforc, double thicke, ITG nmat, char typeboun, ITG ielprop, double prop, char orname)

void	FORTRAN (stop,())

void	storecontactdof (ITG nope, ITG nactdof, ITG mt, ITG konl, ITG *ikactcontp, ITG nactcont, ITG nactcont_, double bcont, double fnl, ITG ikmpc, ITG nmpc, ITG ilmpc, ITG ipompc, ITG nodempc, double *coefmpc)

void	FORTRAN (storeresidual,(ITG nactdof, double b, double fn, char filab, ITG ithermal, ITG nk, double sti, double stn, ITG ipkon, ITG inum, ITG kon, char lakon, ITG ne, ITG mi, double orab, ITG ielorien, double co, ITG itg, ITG ntg, double vold, ITG ielmat, double thicke, ITG ielprop, double prop))

void	FORTRAN (storecontactprop,(ITG ne, ITG ne0, char lakon, ITG kon, ITG ipkon, ITG mi, ITG ielmat, double elcon, ITG mortar, double adb, ITG nactdof, double springarea, ITG ncmat_, ITG ntmat_, double stx, double temax))

ITG	strcmp1 (const char s1, const char s2)

ITG	strcmp2 (const char s1, const char s2, ITG length)

ITG	strcpy1 (char s1, const char s2, ITG length)

void	stress_sen (double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, double stn, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, double prestr, ITG iprestr, char filab, double emn, double een, ITG iperturb, double f, ITG nactdof, double vold, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, char labmpc, ITG nmpc, ITG nmethod, double cam, ITG neq, double veold, double accold, double bet, double gam, double dtime, double time, double ttime, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstateini, double xstate, ITG npmat_, double epn, char matname, ITG mi, ITG ielas, ITG ncmat_, ITG nstate_, double stiini, double vini, ITG ikboun, ITG ilboun, double enern, double emeini, double xstaten, double enerini, double cocon, ITG ncocon, char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, ITG nprint, char prlab, char prset, double qfx, double qfn, double trab, ITG inotr, ITG ntrans, double fmpc, ITG nelemload, ITG nload, ITG ikmpc, ITG ilmpc, ITG istep, ITG iinc, double springarea, double reltime, ITG ne0, double xforc, ITG nforc, double thicke, double shcon, ITG nshcon, char sideload, double xload, double xloadold, ITG icfd, ITG inomat, double pslavsurf, double pmastsurf, ITG mortar, ITG islavact, double cdn, ITG islavnode, ITG nslavnode, ITG ntie, double clearini, ITG islavsurf, ITG ielprop, double prop, double energyini, double energy, ITG kscale, char orname, ITG network, ITG nestart, ITG neend, ITG jqs, ITG irows, ITG nodedesi, double xdesi, ITG ndesi, ITG iobject, ITG nobject, char objectset, double g0, double dgdx, ITG idesvara, ITG idesvarb, ITG nasym, ITG isolver, double distmin, ITG nodeset, double b)

void *	stress_senmt (ITG *i)

void	FORTRAN (subspace,(double d, double aa, double bb, double cc, double alpham, double betam, ITG nev, double xini, double cd, double cv, double time, double rwork, ITG lrw, ITG k, ITG jout, double rpar, double bj, ITG iwork, ITG liw, ITG iddebdf, double *bjp))

void	FORTRAN (tempload,(double xforcold, double xforc, double xforcact, ITG iamforc, ITG nforc, double xloadold, double xload, double xloadact, ITG iamload, ITG nload, ITG ibody, double xbody, ITG nbody, double xbodyold, double xbodyact, double t1old, double t1, double t1act, ITG iamt1, ITG nk, double amta, ITG namta, ITG nam, double ampli, double time, double reltime, double ttime, double dtime, ITG ithermal, ITG nmethod, double xbounold, double xboun, double xbounact, ITG iamboun, ITG nboun, ITG nodeboun, ITG ndirboun, ITG nodeforc, ITG ndirforc, ITG istep, ITG iint, double co, double vold, ITG itg, ITG ntg, char amname, ITG ikboun, ITG ilboun, ITG nelemload, char sideload, ITG mi, ITG ntrans, double trab, ITG inotr, double veold, ITG integerglob, double doubleglob, char tieset, ITG istartset, ITG iendset, ITG ialset, ITG ntie, ITG nmpc, ITG ipompc, ITG ikmpc, ITG ilmpc, ITG nodempc, double coefmpc, ITG ipobody, ITG iponoel, ITG *inoel))

void	FORTRAN (tempload_em,(double xforcold, double xforc, double xforcact, ITG iamforc, ITG nforc, double xloadold, double xload, double xloadact, ITG iamload, ITG nload, ITG ibody, double xbody, ITG nbody, double xbodyold, double xbodyact, double t1old, double t1, double t1act, ITG iamt1, ITG nk, double amta, ITG namta, ITG nam, double ampli, double time, double reltime, double ttime, double dtime, ITG ithermal, ITG nmethod, double xbounold, double xboun, double xbounact, ITG iamboun, ITG nboun, ITG nodeboun, ITG ndirboun, ITG nodeforc, ITG ndirforc, ITG istep, ITG iint, double co, double vold, ITG itg, ITG ntg, char amname, ITG ikboun, ITG ilboun, ITG nelemload, char sideload, ITG mi, ITG ntrans, double trab, ITG inotr, double veold, ITG integerglob, double doubleglob, char tieset, ITG istartset, ITG iendset, ITG ialset, ITG ntie, ITG nmpc, ITG ipompc, ITG ikmpc, ITG ilmpc, ITG nodempc, double coefmpc, double h0scale, ITG inomat, ITG ipobody, ITG iponoel, ITG *inoel))

void	FORTRAN (temploaddiff,(double xforcold, double xforc, double xforcact, ITG iamforc, ITG nforc, double xloadold, double xload, double xloadact, ITG iamload, ITG nload, ITG ibody, double xbody, ITG nbody, double xbodyold, double xbodyact, double t1old, double t1, double t1act, ITG iamt1, ITG nk, double amta, ITG namta, ITG nam, double ampli, double time, double reltime, double ttime, double dtime, ITG ithermal, ITG nmethod, double xbounold, double xboun, double xbounact, ITG iamboun, ITG nboun, ITG nodeboun, ITG ndirboun, ITG nodeforc, ITG ndirforc, ITG istep, ITG iint, double co, double vold, ITG itg, ITG ntg, char amname, ITG ikboun, ITG ilboun, ITG nelemload, char sideload, ITG mi, double xforcdiff, double xloaddiff, double xbodydiff, double t1diff, double xboundiff, ITG icorrect, ITG iprescribedboundary, ITG ntrans, double trab, ITG inotr, double veold, ITG nactdof, double bcont, double fn, ITG ipobody, ITG iponoel, ITG inoel))

void	FORTRAN (temploadmodal,(double amta, ITG namta, ITG nam, double ampli, double timemin, double ttimemin, double dtime, double xbounold, double xboun, double xbounmin, ITG iamboun, ITG nboun, ITG nodeboun, ITG ndirboun, char *amname))

void *	thicknessmt (ITG *i)

void	FORTRAN (tiefaccont,(char lakon, ITG ipkon, ITG kon, ITG ntie, char tieset, ITG nset, char set, ITG istartset, ITG iendset, ITG ialset, ITG itiefac, ITG islavsurf, ITG islavnode, ITG imastnode, ITG nslavnode, ITG nmastnode, ITG nslavs, ITG nmasts, ITG ifacecount, ITG iponoels, ITG inoels, ITG ifreenoels, ITG mortar, ITG ipoface, ITG nodface, ITG nk, double *xnoels))

void	tiedcontact (ITG ntie, char tieset, ITG nset, char set, ITG istartset, ITG iendset, ITG ialset, char lakon, ITG ipkon, ITG kon, double tietol, ITG nmpc, ITG mpcfree, ITG memmpc_, ITG ipompcp, char labmpcp, ITG ikmpcp, ITG ilmpcp, double fmpcp, ITG nodempcp, double *coefmpcp, ITG ithermal, double co, double vold, ITG cfd, ITG nmpc_, ITG mi, ITG nk, ITG istep, ITG ikboun, ITG nboun, char kind1, char *kind2)

void	FORTRAN (transformatrix,(double xab, double p, double *a))

void	FORTRAN (transition,(double dgdxglob, ITG nobject, ITG nk, ITG nodedesi, ITG ndesi, char objectset, double xo, double yo, double zo, double x, double y, double z, ITG nx, ITG ny, ITG nz, double co, ITG ifree, ITG ndesia, ITG *ndesib))

void	transitionmain (double co, double dgdxglob, ITG nobject, ITG nk, ITG nodedesi, ITG ndesi, char objectset, ITG ipkon, ITG kon, char lakon, ITG ipoface, ITG nodface, ITG *nodedesiinv)

void *	transitionmt (ITG *i)

void	FORTRAN (trianeighbor,(ITG ipe, ITG ime, ITG imastop, ITG ncont, ITG koncont, ITG ifreeme))

void	FORTRAN (triangucont,(ITG ncont, ITG ntie, char tieset, ITG nset, char set, ITG istartset, ITG iendset, ITG ialset, ITG itietri, char lakon, ITG ipkon, ITG kon, ITG koncont, char kind1, char kind2, double co, ITG *nk))

void	FORTRAN (tridiagonal_nrhs,(double a, double b, ITG n, ITG m, ITG *nrhs))

void	FORTRAN (ufaceload,(double co, ITG ipkon, ITG kon, char lakon, ITG nboun, ITG nodeboun, ITG nelemload, char sideload, ITG nload, ITG ne, ITG *nk))

void	FORTRAN (uinit,())

void	FORTRAN (uiter,(ITG *iit))

void	FORTRAN (uout,(double v, ITG mi, ITG ithermal, char filab))

void	FORTRAN (updatecont,(ITG koncont, ITG ncont, double co, double vold, double cg, double straight, ITG *mi))

void	FORTRAN (updatecontpen,(ITG koncont, ITG ncont, double co, double vold, double cg, double straight, ITG mi, ITG imastnode, ITG nmastnode, double xmastnor, ITG ntie, char tieset, ITG nset, char set, ITG istartset, ITG iendset, ITG ialset, ITG ipkon, char lakon, ITG kon, double cs, ITG mcs, ITG *ics))

void *	u_calloc (size_t num, size_t size, const char file, const int line, const char ptr_name)

void *	u_free (void num, const char file, const int line, const char *ptr_name)

void *	u_realloc (void num, size_t size, const char file, const int line, const char *ptr_name)

void	writeBasisParameter (FILE f, ITG istep, ITG *iinc)

void	FORTRAN (writeboun,(ITG nodeboun, ITG ndirboun, double xboun, char typeboun, ITG *nboun))

void	FORTRAN (writebv,(double , ITG ))

void	FORTRAN (writecvg,(ITG itep, ITG iinc, ITG icutb, ITG iit, ITG ne, ITG ne0, double ram, double qam, double cam, double uam, ITG *ithermal))

void	FORTRAN (writedeigdx,(ITG iev, double d, ITG ndesi, char orname, double *dgdx))

void	FORTRAN (writedesi,(ITG norien, char orname))

void	FORTRAN (writeev,(double , ITG , double , double ))

void	FORTRAN (writeevcomplex,(double eigxx, ITG nev, double fmin, double fmax))

void	FORTRAN (writeevcs,(double , ITG , ITG , double , double *))

void	FORTRAN (writeevcscomplex,(double eigxx, ITG nev, ITG nm, double fmin, double *fmax))

void	FORTRAN (writehe,(ITG *))

void	writeheading (char jobnamec, char heading, ITG *nheading)

void	FORTRAN (writeim,())

void	FORTRAN (writeinput,(char inpc, ITG ipoinp, ITG inp, ITG nline, ITG ninp, ITG ipoinpc))

void	FORTRAN (writemac,(double mac, ITG nev))

void	FORTRAN (writemaccs,(double mac, ITG nev, ITG *nm))

void	FORTRAN (writempc,(ITG , ITG , double , char , ITG *))

void	FORTRAN (writeobj,(char objectset, ITG iobject, double *g0))

void	FORTRAN (writepf,(double d, double bjr, double bji, double freq, ITG nev, ITG mode, ITG *nherm))

void	FORTRAN (writerandomfield,(double d, ITG nev, double abserr, double relerr))

void	FORTRAN (writere,())

void	FORTRAN (writesubmatrix,(double submatrix, ITG noderetain, ITG ndirretain, ITG nretain, char *jobnamec))

void	FORTRAN (writesummary,(ITG istep, ITG j, ITG icutb, ITG l, double ttime, double time, double *dtime))

void	FORTRAN (writesummarydiv,(ITG istep, ITG j, ITG icutb, ITG l, double ttime, double time, double *dtime))

void	FORTRAN (writetetmesh,(ITG kontet, ITG netet_, double cotet, ITG nktet, double field, ITG nfield))

void	FORTRAN (writeview,(ITG ntr, double adview, double auview, double fenv, ITG nzsrad, char jobnamef))

void	FORTRAN (zienzhu,(double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, double stn, ITG ipneigh, ITG neigh, double sti, ITG *mi))

void	FORTRAN (znaupd,(ITG ido, char bmat, ITG n, char which, ITG nev, double tol, double resid, ITG ncv, double z, ITG ldz, ITG iparam, ITG ipntr, double workd, double workl, ITG lworkl, double rwork, ITG *info))

void	FORTRAN (zneupd,(ITG rvec, char howmny, ITG select, double d, double z, ITG ldz, double sigma, double workev, char bmat, ITG neq, char which, ITG nev, double tol, double resid, ITG ncv, double v, ITG ldv, ITG iparam, ITG ipntr, double workd, double workl, ITG lworkl, double rwork, ITG info))

Macro Definition Documentation

◆ DMEMSET

#define DMEMSET	(	a,
		b,
		c,
		d
	)	for(im=b;im<c;im++)a[im]=d

◆ HP

#define HP 4

◆ IRIX

#define IRIX 2

◆ IRIX64

#define IRIX64 3

◆ ITG

#define ITG int

◆ ITGFORMAT

#define ITGFORMAT "d"

◆ Linux

#define Linux 1

◆ NNEW

#define NNEW	(	a,
		b,
		c
	)	a=(b *)u_calloc((c),sizeof(b),__FILE__,__LINE__,#a)

◆ RENEW

#define RENEW	(	a,
		b,
		c
	)	a=(b )u_realloc((b )(a),(c)*sizeof(b),__FILE__,__LINE__,#a)

◆ SFREE

#define SFREE ( a ) u_free(a,__FILE__,__LINE__,#a)

Function Documentation

◆ arpack()

void arpack	(	double *	co,
		ITG *	nk,
		ITG **	konp,
		ITG **	ipkonp,
		char **	lakonp,
		ITG *	ne,
		ITG *	nodeboun,
		ITG *	ndirboun,
		double *	xboun,
		ITG *	nboun,
		ITG *	ipompc,
		ITG *	nodempc,
		double *	coefmpc,
		char *	labmpc,
		ITG *	nmpc,
		ITG *	nodeforc,
		ITG *	ndirforc,
		double *	xforc,
		ITG *	nforc,
		ITG *	nelemload,
		char *	sideload,
		double *	xload,
		ITG *	nload,
		ITG *	nactdof,
		ITG *	icol,
		ITG *	jq,
		ITG **	irowp,
		ITG *	neq,
		ITG *	nzl,
		ITG *	nmethod,
		ITG *	ikmpc,
		ITG *	ilmpc,
		ITG *	ikboun,
		ITG *	ilboun,
		double *	elcon,
		ITG *	nelcon,
		double *	rhcon,
		ITG *	nrhcon,
		double *	shcon,
		ITG *	nshcon,
		double *	cocon,
		ITG *	ncocon,
		double *	alcon,
		ITG *	nalcon,
		double *	alzero,
		ITG **	ielmatp,
		ITG **	ielorienp,
		ITG *	norien,
		double *	orab,
		ITG *	ntmat_,
		double *	t0,
		double *	t1,
		double *	t1old,
		ITG *	ithermal,
		double *	prestr,
		ITG *	iprestr,
		double *	vold,
		ITG *	iperturb,
		double *	sti,
		ITG *	nzs,
		ITG *	kode,
		ITG *	mei,
		double *	fei,
		char *	filab,
		double *	eme,
		ITG *	iexpl,
		double *	plicon,
		ITG *	nplicon,
		double *	plkcon,
		ITG *	nplkcon,
		double **	xstatep,
		ITG *	npmat_,
		char *	matname,
		ITG *	mi,
		ITG *	ncmat_,
		ITG *	nstate_,
		double **	enerp,
		char *	jobnamec,
		char *	output,
		char *	set,
		ITG *	nset,
		ITG *	istartset,
		ITG *	iendset,
		ITG *	ialset,
		ITG *	nprint,
		char *	prlab,
		char *	prset,
		ITG *	nener,
		ITG *	isolver,
		double *	trab,
		ITG *	inotr,
		ITG *	ntrans,
		double *	ttime,
		double *	fmpc,
		char *	cbody,
		ITG *	ibody,
		double *	xbody,
		ITG *	nbody,
		double *	thicke,
		ITG *	nslavs,
		double *	tietol,
		ITG *	nkon,
		ITG *	mpcinfo,
		ITG *	ntie,
		ITG *	istep,
		ITG *	mcs,
		ITG *	ics,
		char *	tieset,
		double *	cs,
		ITG *	nintpoint,
		ITG *	mortar,
		ITG *	ifacecount,
		ITG **	islavsurfp,
		double **	pslavsurfp,
		double **	clearinip,
		ITG *	nmat,
		char *	typeboun,
		ITG *	ielprop,
		double *	prop,
		char *	orname
	)

◆ arpackbu()

void arpackbu	(	double *	co,
		ITG *	nk,
		ITG *	kon,
		ITG *	ipkon,
		char *	lakon,
		ITG *	ne,
		ITG *	nodeboun,
		ITG *	ndirboun,
		double *	xboun,
		ITG *	nboun,
		ITG *	ipompc,
		ITG *	nodempc,
		double *	coefmpc,
		char *	labmpc,
		ITG *	nmpc,
		ITG *	nodeforc,
		ITG *	ndirforc,
		double *	xforc,
		ITG *	nforc,
		ITG *	nelemload,
		char *	sideload,
		double *	xload,
		ITG *	nload,
		ITG *	nactdof,
		ITG *	icol,
		ITG *	jq,
		ITG *	irow,
		ITG *	neq,
		ITG *	nzl,
		ITG *	nmethod,
		ITG *	ikmpc,
		ITG *	ilmpc,
		ITG *	ikboun,
		ITG *	ilboun,
		double *	elcon,
		ITG *	nelcon,
		double *	rhcon,
		ITG *	nrhcon,
		double *	alcon,
		ITG *	nalcon,
		double *	alzero,
		ITG *	ielmat,
		ITG *	ielorien,
		ITG *	norien,
		double *	orab,
		ITG *	ntmat_,
		double *	t0,
		double *	t1,
		double *	t1old,
		ITG *	ithermal,
		double *	prestr,
		ITG *	iprestr,
		double *	vold,
		ITG *	iperturb,
		double *	sti,
		ITG *	nzs,
		ITG *	kode,
		ITG *	mei,
		double *	fei,
		char *	filab,
		double *	eme,
		ITG *	iexpl,
		double *	plicon,
		ITG *	nplicon,
		double *	plkcon,
		ITG *	nplkcon,
		double *	xstate,
		ITG *	npmat_,
		char *	matname,
		ITG *	mi,
		ITG *	ncmat_,
		ITG *	nstate_,
		double *	ener,
		char *	output,
		char *	set,
		ITG *	nset,
		ITG *	istartset,
		ITG *	iendset,
		ITG *	ialset,
		ITG *	nprint,
		char *	prlab,
		char *	prset,
		ITG *	nener,
		ITG *	isolver,
		double *	trab,
		ITG *	inotr,
		ITG *	ntrans,
		double *	ttime,
		double *	fmpc,
		char *	cbody,
		ITG *	ibody,
		double *	xbody,
		ITG *	nbody,
		double *	thicke,
		char *	jobnamec,
		ITG *	nmat,
		ITG *	ielprop,
		double *	prop,
		char *	orname
	)

◆ arpackcs()

void arpackcs	(	double *	co,
		ITG *	nk,
		ITG **	konp,
		ITG **	ipkonp,
		char **	lakonp,
		ITG *	ne,
		ITG *	nodeboun,
		ITG *	ndirboun,
		double *	xboun,
		ITG *	nboun,
		ITG *	ipompc,
		ITG *	nodempc,
		double *	coefmpc,
		char *	labmpc,
		ITG *	nmpc,
		ITG *	nodeforc,
		ITG *	ndirforc,
		double *	xforc,
		ITG *	nforc,
		ITG *	nelemload,
		char *	sideload,
		double *	xload,
		ITG *	nload,
		ITG *	nactdof,
		ITG *	icol,
		ITG *	jq,
		ITG **	irowp,
		ITG *	neq,
		ITG *	nzl,
		ITG *	nmethod,
		ITG *	ikmpc,
		ITG *	ilmpc,
		ITG *	ikboun,
		ITG *	ilboun,
		double *	elcon,
		ITG *	nelcon,
		double *	rhcon,
		ITG *	nrhcon,
		double *	alcon,
		ITG *	nalcon,
		double *	alzero,
		ITG **	ielmatp,
		ITG **	ielorienp,
		ITG *	norien,
		double *	orab,
		ITG *	ntmat_,
		double *	t0,
		double *	t1,
		double *	t1old,
		ITG *	ithermal,
		double *	prestr,
		ITG *	iprestr,
		double *	vold,
		ITG *	iperturb,
		double *	sti,
		ITG *	nzs,
		ITG *	kode,
		ITG *	mei,
		double *	fei,
		char *	filab,
		double *	eme,
		ITG *	iexpl,
		double *	plicon,
		ITG *	nplicon,
		double *	plkcon,
		ITG *	nplkcon,
		double **	xstatep,
		ITG *	npmat_,
		char *	matname,
		ITG *	mi,
		ITG *	ics,
		double *	cs,
		ITG *	mpcend,
		ITG *	ncmat_,
		ITG *	nstate_,
		ITG *	mcs,
		ITG *	nkon,
		double **	enerp,
		char *	jobnamec,
		char *	output,
		char *	set,
		ITG *	nset,
		ITG *	istartset,
		ITG *	iendset,
		ITG *	ialset,
		ITG *	nprint,
		char *	prlab,
		char *	prset,
		ITG *	nener,
		ITG *	isolver,
		double *	trab,
		ITG *	inotr,
		ITG *	ntrans,
		double *	ttime,
		double *	fmpc,
		char *	cbody,
		ITG *	ibody,
		double *	xbody,
		ITG *	nbody,
		ITG *	nevtot,
		double *	thicke,
		ITG *	nslavs,
		double *	tietol,
		ITG *	mpcinfo,
		ITG *	ntie,
		ITG *	istep,
		char *	tieset,
		ITG *	nintpoint,
		ITG *	mortar,
		ITG *	ifacecount,
		ITG **	islavsurfp,
		double **	pslavsurfp,
		double **	clearinip,
		ITG *	nmat,
		char *	typeboun,
		ITG *	ielprop,
		double *	prop,
		char *	orname
	)

◆ biosav()

void biosav	(	ITG *	ipkon,
		ITG *	kon,
		char *	lakon,
		ITG *	ne,
		double *	co,
		double *	qfx,
		double *	h0,
		ITG *	mi,
		ITG *	inomat,
		ITG *	nk
	)

                                                                    {
 
     ITG i,j,*ithread=NULL,nkphi,idelta,isum;
 
     /* calculates the magnetic intensity due to currents in the phi-
        domain of an electromagnetic calculation */
       
     /* variables for multithreading procedure */
     
     ITG sys_cpus;
     char *env,*envloc,*envsys;
     
     num_cpus = 0;
     sys_cpus=0;
 
     /* explicit user declaration prevails */
 
     envsys=getenv("NUMBER_OF_CPUS");
     if(envsys){
     sys_cpus=atoi(envsys);
     if(sys_cpus<0) sys_cpus=0;
     }
 
     /* automatic detection of available number of processors */
 
     if(sys_cpus==0){
     sys_cpus = getSystemCPUs();
     if(sys_cpus<1) sys_cpus=1;
     }
 
     /* local declaration prevails, if strictly positive */
 
     envloc = getenv("CCX_NPROC_BIOTSAVART");
     if(envloc){
     num_cpus=atoi(envloc);
     if(num_cpus<0){
         num_cpus=0;
     }else if(num_cpus>sys_cpus){
         num_cpus=sys_cpus;
     }
     }
 
     /* else global declaration, if any, applies */
 
     env = getenv("OMP_NUM_THREADS");
     if(num_cpus==0){
     if (env)
         num_cpus = atoi(env);
     if (num_cpus < 1) {
         num_cpus=1;
     }else if(num_cpus>sys_cpus){
         num_cpus=sys_cpus;
     }
     }
     
     /* determining the nodal bounds in each thread */
 
     NNEW(nkapar,ITG,num_cpus);
     NNEW(nkepar,ITG,num_cpus);
 
     /* n1 is the number of nodes in the phi(magnetostatic)-domain in
        an electromagnetic calculation */
 
     nkphi=0;
     for(i=0;i<*nk;i++){
     if(inomat[i]==1) nkphi++;
     }
     if(nkphi<num_cpus) num_cpus=nkphi;
 
     idelta=nkphi/num_cpus;
     
     /* dividing the range from 1 to the number of phi-nodes */
 
     isum=0;
     for(i=0;i<num_cpus;i++){
     nkapar[i]=isum;
     if(i!=num_cpus-1){
         isum+=idelta;
     }else{
         isum=nkphi;
     }
     nkepar[i]=isum-1;
     }
     
     /* translating the bounds of the ranges to real node numbers */
 
 //    i=0;
     i=-1;
     j=0;
     nkphi=-1;
 
     do{
     if(j==num_cpus) break;
     do{
         if(nkapar[j]==nkphi){
         nkapar[j]=i;
         break;
         }else{
         do{
             i++;
             if(inomat[i]==1){
             nkphi++;
             break;
             }
         }while(1);
         }
     }while(1);
 
     do{
         if(nkepar[j]==nkphi){
         nkepar[j]=i;
         j++;
         break;
         }else{
         do{
             i++;
             if(inomat[i]==1){
             nkphi++;
             break;
             }
         }while(1);
         }
     }while(1);
     }while(1);
 
     ipkon1=ipkon;kon1=kon;lakon1=lakon;ne1=ne;co1=co;qfx1=qfx;
     h01=h0;mi1=mi;
     
     printf(" Using up to %" ITGFORMAT " cpu(s) for the Biot-Savart calculation.\n\n", num_cpus);
     
     /* create threads and wait */
     
     pthread_t tid[num_cpus];
     
     NNEW(ithread,ITG,num_cpus);
     for(i=0;i<num_cpus;i++){
     ithread[i]=i;
     pthread_create(&tid[i],NULL,(void *)biotsavartmt,(void *)&ithread[i]);
     }
     for(i=0;i<num_cpus;i++)pthread_join(tid[i], NULL);
     
     SFREE(ithread);SFREE(nkapar);SFREE(nkepar);
     
     return;
     
 }

◆ biotsavartmt()

void* biotsavartmt ( ITG * i )

                           {
 
     ITG nka,nkb;
 
     nka=nkapar[*i]+1;
     nkb=nkepar[*i]+1;
 
     FORTRAN(biotsavart,(ipkon1,kon1,lakon1,ne1,co1,qfx1,h01,mi1,&nka,
             &nkb));
 
     return NULL;
 }

◆ calcresidual()

void calcresidual	(	ITG *	nmethod,
		ITG *	neq,
		double *	b,
		double *	fext,
		double *	f,
		ITG *	iexpl,
		ITG *	nactdof,
		double *	aux2,
		double *	vold,
		double *	vini,
		double *	dtime,
		double *	accold,
		ITG *	nk,
		double *	adb,
		double *	aub,
		ITG *	icol,
		ITG *	irow,
		ITG *	nzl,
		double *	alpha,
		double *	fextini,
		double *	fini,
		ITG *	islavnode,
		ITG *	nslavnode,
		ITG *	mortar,
		ITG *	ntie,
		double *	f_cm,
		double *	f_cs,
		ITG *	mi,
		ITG *	nzs,
		ITG *	nasym,
		ITG *	idamping,
		double *	veold,
		double *	adc,
		double *	auc,
		double *	cvini,
		double *	cv
	)

                                                                        {
 
     ITG j,k,mt=mi[1]+1;
     double scal1;
       
     /* residual for a static analysis */
       
     if(*nmethod!=4){
     for(k=0;k<neq[1];++k){
         b[k]=fext[k]-f[k];
     }
     }
       
     /* residual for implicit dynamics */
       
     else if(*iexpl<=1){
     for(k=0;k<*nk;++k){
         if(nactdof[mt*k]>0){
         aux2[nactdof[mt*k]-1]=(vold[mt*k]-vini[mt*k])/(*dtime);}
         for(j=1;j<mt;++j){
         if(nactdof[mt*k+j]>0){aux2[nactdof[mt*k+j]-1]=accold[mt*k+j];}
         }
     }
     if(*nasym==0){
         FORTRAN(op,(&neq[1],aux2,b,adb,aub,jq,irow)); 
     }else{
         FORTRAN(opas,(&neq[1],aux2,b,adb,aub,jq,irow,nzs)); 
     }
     scal1=1.+*alpha;
     for(k=0;k<neq[0];++k){
         b[k]=scal1*(fext[k]-f[k])-*alpha*(fextini[k]-fini[k])-b[k];
     } 
     for(k=neq[0];k<neq[1];++k){
         b[k]=fext[k]-f[k]-b[k];
     } 
 
     /* correction for damping */
 
     if(*idamping==1){
         for(k=0;k<*nk;++k){
         if(nactdof[mt*k]>0){aux2[nactdof[mt*k]-1]=0.;}
         for(j=1;j<mt;++j){
             if(nactdof[mt*k+j]>0){
             aux2[nactdof[mt*k+j]-1]=veold[mt*k+j];}
         }
         }
         if(*nasym==0){
         FORTRAN(op,(&neq[1],aux2,cv,adc,auc,jq,irow));
         }else{
         FORTRAN(opas,(&neq[1],aux2,cv,adc,auc,jq,irow,nzs)); 
         }
         for(k=0;k<neq[0];++k){
         b[k]-=scal1*cv[k]-*alpha*cvini[k];
         }
     }
     }
 
     /* residual for explicit dynamics */
     
     else{
     for(k=0;k<*nk;++k){
         if(nactdof[mt*k]>0){
         aux2[nactdof[mt*k]-1]=(vold[mt*k]-vini[mt*k])/(*dtime);}
         for(j=1;j<mt;++j){
         if(nactdof[mt*k+j]>0){aux2[nactdof[mt*k+j]-1]=accold[mt*k+j];}
         }
     }
     scal1=1.+*alpha;
     for(k=0;k<neq[0];++k){
         b[k]=scal1*(fext[k]-f[k])-*alpha*(fextini[k]-fini[k])
         -adb[k]*aux2[k];
     } 
     for(k=neq[0];k<neq[1];++k){
         b[k]=fext[k]-f[k]-adb[k]*aux2[k];
     } 
     }
 
     return;
 }

◆ calcresidual_em()

void calcresidual_em	(	ITG *	nmethod,
		ITG *	neq,
		double *	b,
		double *	fext,
		double *	f,
		ITG *	iexpl,
		ITG *	nactdof,
		double *	aux1,
		double *	aux2,
		double *	vold,
		double *	vini,
		double *	dtime,
		double *	accold,
		ITG *	nk,
		double *	adb,
		double *	aub,
		ITG *	icol,
		ITG *	irow,
		ITG *	nzl,
		double *	alpha,
		double *	fextini,
		double *	fini,
		ITG *	islavnode,
		ITG *	nslavnode,
		ITG *	mortar,
		ITG *	ntie,
		double *	f_cm,
		double *	f_cs,
		ITG *	mi,
		ITG *	nzs,
		ITG *	nasym,
		ITG *	ithermal
	)

                                                             {
 
     ITG j,k,mt=mi[1]+1,jstart;
       
     /* residual for a static analysis */
       
     if(*nmethod!=4){
     for(k=0;k<neq[1];++k){
         b[k]=fext[k]-f[k];
     }
     }
       
     /* residual for implicit dynamics */
       
     else{
 
     if(*ithermal<2){
         jstart=1;
     }else{
         jstart=0;
     }
 
         /* calculating a pseudo-velocity */
 
 /*  for(k=0;k<*nk;++k){
         for(j=jstart;j<mt;++j){
         if(nactdof[mt*k+j]>0){aux2[nactdof[mt*k+j]-1]=(vold[mt*k+j]-vini[mt*k+j])/(*dtime);}
         }
         }*/
 
     for(k=0;k<*nk;++k){
         for(j=jstart;j<1;++j){
         if(nactdof[mt*k+j]>0){aux2[nactdof[mt*k+j]-1]=(vold[mt*k+j]-vini[mt*k+j])/(*dtime);}
         }
     }
 
     for(k=0;k<*nk;++k){
         for(j=1;j<mt;++j){
         if(nactdof[mt*k+j]>0){aux2[nactdof[mt*k+j]-1]=(-vini[mt*k+j])/(*dtime);}
         }
     }
 
         /* calculating "capacity"-matrix times pseudo-velocity */
 
     if(*nasym==0){
         FORTRAN(op,(&neq[1],aux2,b,adb,aub,jq,irow)); 
     }else{
         FORTRAN(opas,(&neq[1],aux2,b,adb,aub,jq,irow,nzs)); 
     }
 
     for(k=0;k<neq[1];++k){
         b[k]=fext[k]-f[k]-b[k];
     } 
     }
 
     return;
 }

◆ calcviewmt()

void* calcviewmt ( ITG * i )

                         {
 
     ITG indexad,indexau,indexdi,ntria,ntrib,nedelta,indexcovered;
 
     indexad=*i**ntr1;
     indexau=*i*2**nzsrad1;
     indexdi=*i**ntrit1;
     indexcovered=*i*ng1*ng1;
     
     nedelta=(ITG)ceil(*ntri1/(double)num_cpus);
     ntria=*i*nedelta+1;
     ntrib=(*i+1)*nedelta;
     if(ntrib>*ntri1) ntrib=*ntri1;
 
 //    printf("i=%" ITGFORMAT ",ntria=%" ITGFORMAT ",ntrib=%" ITGFORMAT "\n",i,ntria,ntrib);
 //    printf("indexad=%" ITGFORMAT ",indexau=%" ITGFORMAT ",indexdi=%" ITGFORMAT "\n",indexad,indexau,indexdi);
 
     FORTRAN(calcview,(sideload1,vold1,co1,pmid1,e11,e21,e31,
                       kontri1,nloadtr1,&adview[indexad],
                       &auview[indexau],&dist[indexdi],&idist[indexdi],area1,
               ntrit1,mi1,jqrad1,irowrad1,nzsrad1,&sidemean1,
                       &ntria,&ntrib,&covered1[indexcovered],&ng1));
 
     return NULL;
 }

◆ cascade()

void cascade	(	ITG *	ipompc,
		double **	coefmpcp,
		ITG **	nodempcp,
		ITG *	nmpc,
		ITG *	mpcfree,
		ITG *	nodeboun,
		ITG *	ndirboun,
		ITG *	nboun,
		ITG *	ikmpc,
		ITG *	ilmpc,
		ITG *	ikboun,
		ITG *	ilboun,
		ITG *	mpcend,
		char *	labmpc,
		ITG *	nk,
		ITG *	memmpc_,
		ITG *	icascade,
		ITG *	maxlenmpc,
		ITG *	callfrommain,
		ITG *	iperturb,
		ITG *	ithermal
	)

                                                    {
 
  /*   detects cascaded mpc's and decascades them; checks multiple
      occurrence of the same dependent DOF's in different mpc/spc's
 
      data structure of ipompc,coefmpc,nodempc:
        for each mpc, e.g. i, 
          -the nodes are stored in nodempc(1,ipompc(i)),
           nodempc(1,nodempc(3,ipompc(i))),
           nodempc(1,nodempc(3,nodempc(3,ipompc(i))))... till
           nodempc(3,nodempc(3,nodempc(3,.......))))))=0;
          -the corresponding directions in nodempc(2,ipompc(i)),
           nodempc(2,nodempc(3,ipompc(i))),.....
          -the corresponding coefficient in coefmpc(ipompc(i)),
           coefmpc(nodempc(3,ipompc(i))),.....
        the mpc is written as a(1)u(i1,j1)+a(2)u(i2,j2)+...
        +....a(k)u(ik,jk)=0, the first term is the dependent term,
        the others are independent, at least after execution of the
        present routine. The mpc's must be homogeneous, otherwise a
        error message is generated and the program stops. */
 
     ITG i,j,index,id,idof,nterm,idepend,*nodempc=NULL,
     ispooles,iexpand,ichange,indexold,ifluidmpc,
         mpc,indexnew,index1,index2,index1old,index2old,*jmpc=NULL,nl;
 
     double coef,*coefmpc=NULL;
 
 #ifdef SPOOLES
 
     ITG irow,icolumn,node,idir,irownl,icolnl,*ipointer=NULL,*icoef=NULL,
     ifree,*indepdof=NULL,nindep;
 
     double *xcoef=NULL,b;
 
     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 ;
     ITG             jrhs, msglvl=0, nedges,error,
                     nent, neqns, nrhs, pivotingflag=1, seed=389,
                     symmetryflag=2, type=1,maxdomainsize,maxzeros,maxsize;
     ITG             *oldToNew ;
     ITG             stats[20] ;
     IV              *newToOldIV, *oldToNewIV ;
     IVL             *adjIVL, *symbfacIVL ;
 #endif
 
     nodempc=*nodempcp;
     coefmpc=*coefmpcp;
     
     /*       for(i=0;i<*nmpc;i++){
     j=i+1;
     FORTRAN(writempc,(ipompc,nodempc,coefmpc,labmpc,&j));
     }*/
 
     NNEW(jmpc,ITG,*nmpc);
     idepend=0;
 
 /*        check whether a node is used as a dependent node in a MPC
       and in a SPC */
 
     for(i=0;i<*nmpc;i++){
     if(*nboun>0){
         FORTRAN(nident,(ikboun,&ikmpc[i],nboun,&id));}
     else{id=0;}
     if(id>0){
         if(ikboun[id-1]==ikmpc[i]){
         if(strcmp1(&labmpc[20*i],"FLUID")!=0){
             printf("*ERROR in cascade: the DOF corresponding to \n node %" ITGFORMAT " in direction %" ITGFORMAT " is detected on the \n dependent side of a MPC and a SPC\n",
                (ikmpc[i])/8+1,ikmpc[i]-8*((ikmpc[i])/8));
         }else{
             printf("*ERROR in cascade: the DOF corresponding to \n face %" ITGFORMAT " in direction %" ITGFORMAT " is detected on the \n dependent side of a MPC and a SPC\n",
                (-ikmpc[i])/8+1,-ikmpc[i]-8*((-ikmpc[i])/8));
         }
         FORTRAN(stop,());
         }
     }
     }
 
 /*     check whether there are user mpc's: in user MPC's the
        dependent DOF can change, however, the number of terms
        cannot change   */
 
     for(i=0;i<*nmpc;i++){
 
         /* linear mpc */
 
         /* because of the next line the size of field labmpc
            has to be defined as 20*nmpc+1: without "+1" an
            undefined field is accessed */
 
     if((strcmp1(&labmpc[20*i],"                    ")==0) ||
        (strcmp1(&labmpc[20*i],"CYCLIC")==0) ||
        (strcmp1(&labmpc[20*i],"SUBCYCLIC")==0)||
        (strcmp1(&labmpc[20*i],"PRETENSION")==0)||
        (strcmp1(&labmpc[20*i],"THERMALPRET")==0)||
 //     (strcmp1(&labmpc[20*i],"CONTACT")==0)||
        (strcmp1(&labmpc[20*i],"FLUID")==0)||
            (*iperturb<2)) jmpc[i]=0;
 
         /* nonlinear mpc */
 
     else if((strcmp1(&labmpc[20*i],"RIGID")==0) ||
        (strcmp1(&labmpc[20*i],"KNOT")==0) ||
        (strcmp1(&labmpc[20*i],"PLANE")==0) ||
        (strcmp1(&labmpc[20*i],"BEAM")==0) ||
        (strcmp1(&labmpc[20*i],"STRAIGHT")==0)) jmpc[i]=1;
 
         /* user mpc */
 
     else{
         jmpc[i]=1;
         if(*icascade==0) *icascade=1;
     }
     }
     
 /*     decascading */
 
     ispooles=0;
 
     /* decascading using simple substitution */
 
     do{
         ichange=0;
         for(i=0;i<*nmpc;i++){
 
         if(strcmp1(&labmpc[20*i],"FLUID")!=0){
         ifluidmpc=0;
         }else{
         ifluidmpc=1;
         }
 
         if(jmpc[i]==1) nl=1;
         else nl=0;
         iexpand=0;
         index=nodempc[3*ipompc[i]-1];
         if(index==0) continue;
         do{
         if(ifluidmpc==0){
             /* MPC on node */
             idof=(nodempc[3*index-3]-1)*8+nodempc[3*index-2];
         }else{
             if(nodempc[3*index-3]>0){
             /* MPC on face */
             idof=-((nodempc[3*index-3]-1)*8+nodempc[3*index-2]);
             }else{
             /* MPC on node 
                            SPC number: -nodempc[3*index-3]
                            node: nodeboun[-nodempc[3*index-3]-1] */
 
             idof=(nodeboun[-nodempc[3*index-3]-1]-1)*8+nodempc[3*index-2];
             }
         }
         
         FORTRAN(nident,(ikmpc,&idof,nmpc,&id));
         if((id>0)&&(ikmpc[id-1]==idof)){
             
             /* a term on the independent side of the MPC is
                detected as dependent node in another MPC */
 
             indexold=nodempc[3*index-1];
             coef=coefmpc[index-1];
             mpc=ilmpc[id-1];
 
                     /* no expansion if there is a dependence of a
                        nonlinear MPC on another linear or nonlinear MPC
                        and the call is from main */ 
 
             if((jmpc[mpc-1]==1)||(nl==1)){
             *icascade=2;
             if(idepend==0){
                 printf("*INFO in cascade: linear MPCs and\n");
                 printf("       nonlinear MPCs depend on each other\n");
                 printf("       common node: %" ITGFORMAT " in direction %" ITGFORMAT "\n\n",nodempc[3*index-3],nodempc[3*index-2]);
                 idepend=1;}
             if(*callfrommain==1){
                 index=nodempc[3*index-1];
                 if(index!=0) continue;
                 else break;}
             }
 
 /*          printf("*INFO in cascade: DOF %" ITGFORMAT " of node %" ITGFORMAT " is expanded\n",
             nodempc[3*index-2],nodempc[3*index-3]);*/
 
             /* collecting terms corresponding to the same DOF */
             
             index1=ipompc[i];
             do{
             index2old=index1;
             index2=nodempc[3*index1-1];
             if(index2==0) break;
             do{
                 if((nodempc[3*index1-3]==nodempc[3*index2-3])&&
                    (nodempc[3*index1-2]==nodempc[3*index2-2])){
                 coefmpc[index1-1]+=coefmpc[index2-1];
                 nodempc[3*index2old-1]=nodempc[3*index2-1];
                 nodempc[3*index2-1]=*mpcfree;
                 *mpcfree=index2;
                 index2=nodempc[3*index2old-1];
                 if(index2==0) break;
                 }
                 else{
                 index2old=index2;
                 index2=nodempc[3*index2-1];
                 if(index2==0) break;
                 }
             }while(1);
             index1=nodempc[3*index1-1];
             if(index1==0) break;
             }while(1);
             
             /* check for zero coefficients on the dependent side */
             
                     index1=ipompc[i];
             if(fabs(coefmpc[index1-1])<1.e-10){
                 printf("*ERROR in cascade: zero coefficient on the\n");
                 printf("       dependent side of an equation\n");
                 printf("       dependent node: %" ITGFORMAT "",nodempc[3*index1-3]);
                 printf("       direction: %" ITGFORMAT "",nodempc[3*index1-2]);
                 FORTRAN(stop,());
                 }
             
             ichange=1;iexpand=1;
             if((strcmp1(&labmpc[20*i],"                    ")==0)&&
                (strcmp1(&labmpc[20*(mpc-1)],"CYCLIC")==0))
             strcpy1(&labmpc[20*i],"SUBCYCLIC",9);
             indexnew=ipompc[mpc-1];
             coef=-coef/coefmpc[indexnew-1];
             indexnew=nodempc[3*indexnew-1];
             if(indexnew!=0){
             do{
                 coefmpc[index-1]=coef*coefmpc[indexnew-1];
                 nodempc[3*index-3]=nodempc[3*indexnew-3];
                 nodempc[3*index-2]=nodempc[3*indexnew-2];
                 indexnew=nodempc[3*indexnew-1];
                 if(indexnew!=0){
                 nodempc[3*index-1]=*mpcfree;
                 index=*mpcfree;
                 *mpcfree=nodempc[3**mpcfree-1];
                 if(*mpcfree==0){
                     *mpcfree=*memmpc_+1;
                     nodempc[3*index-1]=*mpcfree;
                     *memmpc_=(ITG)(1.1**memmpc_);
                     printf("*INFO in cascade: reallocating nodempc; new size = %" ITGFORMAT "\n\n",*memmpc_);
                     RENEW(nodempc,ITG,3**memmpc_);
                     RENEW(coefmpc,double,*memmpc_);
                     for(j=*mpcfree;j<*memmpc_;j++){
                     nodempc[3*j-1]=j+1;
                     }
                     nodempc[3**memmpc_-1]=0;
                 }
                 continue;
                 }
                 else{
                 nodempc[3*index-1]=indexold;
                 break;
                 }
             }while(1);
             }else{
             coefmpc[index-1]=0.;
             }
             break;
         }
         else{
             index=nodempc[3*index-1];
             if(index!=0) continue;
             else break;
         }
         }while(1);
         if(iexpand==0) continue;
         
         /* one term of the mpc was expanded 
            collecting terms corresponding to the same DOF */
         
         index1=ipompc[i];
         do{
         index2old=index1;
         index2=nodempc[3*index1-1];
         if(index2==0) break;
         do{
             if((nodempc[3*index1-3]==nodempc[3*index2-3])&&
                (nodempc[3*index1-2]==nodempc[3*index2-2])){
             coefmpc[index1-1]+=coefmpc[index2-1];
             nodempc[3*index2old-1]=nodempc[3*index2-1];
             nodempc[3*index2-1]=*mpcfree;
             *mpcfree=index2;
             index2=nodempc[3*index2old-1];
             if(index2==0) break;
             }
             else{
             index2old=index2;
             index2=nodempc[3*index2-1];
             if(index2==0) break;
             }
         }while(1);
         index1=nodempc[3*index1-1];
         if(index1==0) break;
         }while(1);
         
         /* check for zero coefficients on the dependent and
            independent side */
         
         index1=ipompc[i];
         index1old=0;
         do {
         if(fabs(coefmpc[index1-1])<1.e-10){
             if(index1old==0){
             printf("*ERROR in cascade: zero coefficient on the\n");
             printf("       dependent side of an equation\n");
             printf("       dependent node: %" ITGFORMAT "",nodempc[3*index1-3]);
             printf("       direction: %" ITGFORMAT "",nodempc[3*index1-2]);
             FORTRAN(stop,());
             }
             else{
             nodempc[3*index1old-1]=nodempc[3*index1-1];
             nodempc[3*index1-1]=*mpcfree;
             *mpcfree=index1;
             index1=nodempc[3*index1old-1];
             }
         }
         else{
             index1old=index1;
             index1=nodempc[3*index1-1];
         }
         if(index1==0) break;
         }while(1);
         }
         if(ichange==0) break;
     }while(1);
     
     /* decascading using spooles */
     
 #ifdef SPOOLES
     if((*icascade==1)&&(ispooles==1)){
     if ( (msgFile = fopen("spooles.out", "a")) == NULL ) {
         fprintf(stderr, "\n fatal error in spooles.c"
             "\n unable to open file spooles.out\n") ;
     }
     NNEW(ipointer,ITG,7**nk);
     NNEW(indepdof,ITG,7**nk);
     NNEW(icoef,ITG,2**memmpc_);
     NNEW(xcoef,double,*memmpc_);
     ifree=0;
     nindep=0;
 
     for(i=*nmpc-1;i>-1;i--){
         index=ipompc[i];
         while(1){
         idof=8*(nodempc[3*index-3]-1)+nodempc[3*index-2]-1;
 
 /* check whether idof is a independent dof which has not yet been
    stored in indepdof */
 
         FORTRAN(nident,(ikmpc,&idof,nmpc,&id));
         if((id==0)||(ikmpc[id-1]!=idof)){
             FORTRAN(nident,(indepdof,&idof,&nindep,&id));
             if((id==0)||(indepdof[id-1]!=idof)){
             for(j=nindep;j>id;j--){
                 indepdof[j]=indepdof[j-1];
             }
             indepdof[id]=idof;
             nindep++;
             }
         }
 
         icoef[2*ifree]=i+1;
         icoef[2*ifree+1]=ipointer[idof];
         xcoef[ifree]=coefmpc[index-1];
         ipointer[idof]=++ifree;
         index=nodempc[3*index-1];
         if(index==0) break;
         }
     }
 
 /*     filling the left hand side */
 
     nent=*memmpc_;
     neqns=*nmpc;
     mtxA = InpMtx_new() ;
     InpMtx_init(mtxA, INPMTX_BY_ROWS, type, nent, neqns) ;
     
     for(i=0;i<*nmpc;i++){
         idof=ikmpc[i];
         icolumn=ilmpc[i]-1;
         if(strcmp1(&labmpc[20*icolumn],"RIGID")==0) icolnl=1;
         else icolnl=0;
         index=ipointer[idof-1];
         while(1){
         irow=icoef[2*index-2]-1;
         if(irow!=icolumn){
             if(strcmp1(&labmpc[20*irow],"RIGID")==0)irownl=1;
             else irownl=0;
             if((irownl==1)||(icolnl==1)){
             *icascade=2;
             InpMtx_free(mtxA);
             printf("*ERROR in cascade: linear and nonlinear MPCs depend on each other");
             FORTRAN(stop,());
             }
         }
         if((strcmp1(&labmpc[20*irow],"                    ")==0)&&
            (strcmp1(&labmpc[20*icolumn],"CYCLIC")==0)){
             strcpy1(&labmpc[20*irow],"SUBCYCLIC",9);}
         coef=xcoef[index-1];
         InpMtx_inputRealEntry(mtxA,irow,icolumn,coef);
         index=icoef[2*index-1];
         if(index==0) break;
         }
         ipointer[idof-1]=0;
     }
 
     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=800;maxzeros=1000;maxsize=64;
     /*maxdomainsize=neqns/100;*/
     /*frontETree = orderViaMMD(graph, seed, msglvl, msgFile) ;*/
     /*frontETree = orderViaND(graph,maxdomainsize,seed,msglvl,msgFile); */
     /*frontETree = orderViaMS(graph,maxdomainsize,seed,msglvl,msgFile);*/
     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) ;
     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 %" ITGFORMAT "",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) ;
     }
 
 /* reinitialize nodempc */
 
     *mpcfree=1;
     for(j=0;j<*nmpc;j++){
         ipompc[j]=0;}
 
 /* filling the RHS */
 
     jrhs=0;
     nrhs=1;
     mtxB=DenseMtx_new();
     mtxX=DenseMtx_new();
 
     for(i=nindep;i>0;i--){
         idof=indepdof[i-1];
         if(ipointer[idof]>0){
         
 /*          new RHS column */
 
         DenseMtx_init(mtxB, type, 0, 0, neqns, nrhs, 1, neqns) ;
         DenseMtx_zero(mtxB) ;
 
         index=ipointer[idof];
         while(1){
             irow=icoef[2*index-2]-1;
             coef=xcoef[index-1];
             DenseMtx_setRealEntry(mtxB,irow,jrhs,coef);
             index=icoef[2*index-1];
             if(index==0) break;
         }
 
         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
   -------------------------------
 */
         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) ;
         if ( msglvl > 1 ) {
             fprintf(msgFile, "\n\n solution matrix in original ordering") ;
             DenseMtx_writeForHumanEye(mtxX, msgFile) ;
             fflush(msgFile) ;
         }
        
 
         for(j=0;j<*nmpc;j++){
             b=DenseMtx_entries(mtxX)[j];
             if(fabs(b)>1.e-10){
             nodempc[3**mpcfree-1]=ipompc[j];
             node=(ITG)((idof+8)/8);
             idir=idof+1-8*(node-1);
             nodempc[3**mpcfree-3]=node;
             nodempc[3**mpcfree-2]=idir;
             coefmpc[*mpcfree-1]=b;
             ipompc[j]=(*mpcfree)++;
             if(*mpcfree>*memmpc_){
                 *memmpc_=(ITG)(1.1**memmpc_);
                 RENEW(nodempc,ITG,3**memmpc_);
                 RENEW(coefmpc,double,*memmpc_);
             }
             }
         }
         }
     }
 /*--------------------------------------------------------------------*/
 /*
    -----------
    free memory
    -----------
 */
     FrontMtx_free(frontmtx) ;
     DenseMtx_free(mtxB) ;
     DenseMtx_free(mtxX) ;
     IV_free(newToOldIV) ;
     IV_free(oldToNewIV) ;
     InpMtx_free(mtxA) ;
     ETree_free(frontETree) ;
     IVL_free(symbfacIVL) ;
     SubMtxManager_free(mtxmanager) ;
     Graph_free(graph) ;
 
 /* diagonal terms */
 
     for(i=0;i<*nmpc;i++){
         j=ilmpc[i]-1;
         idof=ikmpc[i];
         node=(ITG)((idof+7)/8);
         idir=idof-8*(node-1);
         nodempc[3**mpcfree-1]=ipompc[j];
         nodempc[3**mpcfree-3]=node;
         nodempc[3**mpcfree-2]=idir;
         coefmpc[*mpcfree-1]=1.;
         ipompc[j]=(*mpcfree)++;
         if(*mpcfree>*memmpc_){
         *memmpc_=(ITG)(1.1**memmpc_);
         RENEW(nodempc,ITG,3**memmpc_);
         RENEW(coefmpc,double,*memmpc_);
         }
     }
     
     SFREE(ipointer);SFREE(indepdof);SFREE(icoef);SFREE(xcoef);
 
     fclose(msgFile);
 
     }
 #endif
 
 /*     determining the effective size of nodempc and coefmpc for
        the reallocation*/
 
     *mpcend=0;
     *maxlenmpc=0;
     for(i=0;i<*nmpc;i++){
     index=ipompc[i];
     *mpcend=max(*mpcend,index);
     nterm=1;
     while(1){
         index=nodempc[3*index-1];
         if(index==0){
         *maxlenmpc=max(*maxlenmpc,nterm);
         break;
         }
         *mpcend=max(*mpcend,index);
         nterm++;
     }
     }
 
     SFREE(jmpc);
 
     *nodempcp=nodempc;
     *coefmpcp=coefmpc;
     
     /*          for(i=0;i<*nmpc;i++){
     j=i+1;
     FORTRAN(writempc,(ipompc,nodempc,coefmpc,labmpc,&j));
     }*/
     
     return;
 }

◆ CEE()

void CEE	(	ddotc	,
		(ITG n, double dx, ITG incx, double dy, ITG incy, double funcddot)
	)

◆ cgsolver()

ITG cgsolver	(	double *	A,
		double *	x,
		double *	b,
		ITG	neq,
		ITG	len,
		ITG *	ia,
		ITG *	iz,
		double *	eps,
		ITG *	niter,
		ITG	precFlg
	)

 {
   ITG i=0;
   double *Factor=NULL,*r=NULL,*p=NULL,*z=NULL,*C=NULL,*g=NULL,*rho=NULL;
 
   /*  reduce row and column indices by 1 (FORTRAN->C)   */
 
   for (i=0; i<neq; i++) --iz[i];
   for (i=0; i<len; i++) --ia[i];
 
   /*  Scaling the equation system A x + b = 0  */
 
   NNEW(Factor,double,neq);
   Scaling(A,b,neq,ia,iz,Factor);
 
   /*  SOLVER/PRECONDITIONING TYPE  */
 
   /*  Conjugate gradient solver without preconditioning  */
 
   if (!precFlg)
     {
       NNEW(r,double,neq);
       NNEW(p,double,neq);
       NNEW(z,double,neq);
       CG(A,x,b,neq,len,ia,iz,eps,niter,r,p,z);
       SFREE(r);SFREE(p);SFREE(z);
     }
   
   /* Conjugate gradient solver with incomplete Cholesky preconditioning on
      full matrix */
   
   else if (precFlg==3)
     {
       NNEW(rho,double,neq);
       NNEW(r,double,neq);
       NNEW(g,double,neq);
       NNEW(C,double,len);
       NNEW(z,double,neq);
       PCG(A,x,b,neq,len,ia,iz,eps,niter,precFlg,rho,r,g,C,z);
       SFREE(rho);SFREE(r);SFREE(g);SFREE(C);SFREE(z);
     }
   
   /*  Backscaling of the solution vector  */
   
   for (i=0; i<neq; i++) x[i] *= Factor[i];
   
   /*  That's it  */
   
   SFREE(Factor);
   return GOOD;
 }

◆ checkconvergence()

void checkconvergence	(	double *	co,
		ITG *	nk,
		ITG *	kon,
		ITG *	ipkon,
		char *	lakon,
		ITG *	ne,
		double *	stn,
		ITG *	nmethod,
		ITG *	kode,
		char *	filab,
		double *	een,
		double *	t1act,
		double *	time,
		double *	epn,
		ITG *	ielmat,
		char *	matname,
		double *	enern,
		double *	xstaten,
		ITG *	nstate_,
		ITG *	istep,
		ITG *	iinc,
		ITG *	iperturb,
		double *	ener,
		ITG *	mi,
		char *	output,
		ITG *	ithermal,
		double *	qfn,
		ITG *	mode,
		ITG *	noddiam,
		double *	trab,
		ITG *	inotr,
		ITG *	ntrans,
		double *	orab,
		ITG *	ielorien,
		ITG *	norien,
		char *	description,
		double *	sti,
		ITG *	icutb,
		ITG *	iit,
		double *	dtime,
		double *	qa,
		double *	vold,
		double *	qam,
		double *	ram1,
		double *	ram2,
		double *	ram,
		double *	cam,
		double *	uam,
		ITG *	ntg,
		double *	ttime,
		ITG *	icntrl,
		double *	theta,
		double *	dtheta,
		double *	veold,
		double *	vini,
		ITG *	idrct,
		double *	tper,
		ITG *	istab,
		double *	tmax,
		ITG *	nactdof,
		double *	b,
		double *	tmin,
		double *	ctrl,
		double *	amta,
		ITG *	namta,
		ITG *	itpamp,
		ITG *	inext,
		double *	dthetaref,
		ITG *	itp,
		ITG *	jprint,
		ITG *	jout,
		ITG *	uncoupled,
		double *	t1,
		ITG *	iitterm,
		ITG *	nelemload,
		ITG *	nload,
		ITG *	nodeboun,
		ITG *	nboun,
		ITG *	itg,
		ITG *	ndirboun,
		double *	deltmx,
		ITG *	iflagact,
		char *	set,
		ITG *	nset,
		ITG *	istartset,
		ITG *	iendset,
		ITG *	ialset,
		double *	emn,
		double *	thicke,
		char *	jobnamec,
		ITG *	mortar,
		ITG *	nmat,
		ITG *	ielprop,
		double *	prop,
		ITG *	ialeatoric,
		ITG *	kscale,
		double *	energy,
		double *	allwk,
		double *	energyref,
		double *	emax,
		double *	enres,
		double *	enetoll,
		double *	energyini,
		double *	allwkini,
		double *	temax,
		double *	reswk,
		ITG *	ne0,
		ITG *	neini,
		double *	dampwk,
		double *	dampwkini,
		double *	energystartstep
	)

                                                                   {
 
     ITG i0,ir,ip,ic,il,ig,ia,iest,iest1=0,iest2=0,iconvergence,idivergence,
     ngraph=1,k,*ipneigh=NULL,*neigh=NULL,*inum=NULL,id,istart,iend,inew,
         i,j,mt=mi[1]+1,iexceed,
         iforceincsize=0;
 
     double df,dc,db,dd,ran,can,rap,ea,cae,ral,da,*vr=NULL,*vi=NULL,*stnr=NULL,
     *stni=NULL,*vmax=NULL,*stnmax=NULL,*cs=NULL,c1[2],c2[2],reftime,
         *fn=NULL,*eenmax=NULL,*fnr=NULL,*fni=NULL,*qfx=NULL,*cdn=NULL,
         *cdnr=NULL,*cdni=NULL,tmp, maxdecay=0.0, r_rel,cetol;
 
     /* reset ialeatoric to zero */
 
     *ialeatoric=0;
 
     cetol=ctrl[39];
 
     /* next lines are active if the number of contact elements was
        changed in the present increment */
 
     if ((*iflagact==1)&&(*mortar!=1)){
     if(ctrl[0]<*iit+4)ctrl[0]=*iit+4;
     if(ctrl[1]<*iit+8)ctrl[1]=*iit+8;
     ctrl[3]+=1;
     }
     
     i0=ctrl[0];ir=ctrl[1];ip=ctrl[2];ic=ctrl[3];il=ctrl[4];ig=ctrl[5];
     ia=ctrl[7];df=ctrl[10];dc=ctrl[11];db=ctrl[12];da=ctrl[13];dd=ctrl[16];
     ran=ctrl[18];can=ctrl[19];rap=ctrl[22];
     ea=ctrl[23];cae=ctrl[24];ral=ctrl[25];
 
     /* for face-to-face penalty contact: increase the number of iterations
        in two subsequent increments in order to increase the increment size */
 
     if(*mortar==1){ig+=12;il+=12;}
 
     /* if iconvergence=0 the increment did not yet converge, iterations are
                          continued
        if idivergence=1 the increment diverged and has to be reiterated
                         with a smaller size */
 
     idivergence=0;
 
     /* check for forced divergence (due to divergence of a user material
        routine */
 
     if(qa[2]>0.){idivergence=1;}
 
     if(*ithermal!=2){
     if(qa[0]>ea*qam[0]){
         if(*iit<=ip){c1[0]=ran;}
         else{c1[0]=rap;}
         c2[0]=can;
     }
     else{
         c1[0]=ea;
         c2[0]=cae;
     }
     if(ram1[0]<ram2[0]){ram2[0]=ram1[0];}
     }
     if(*ithermal>1){
     if(qa[1]>ea*qam[1]){
         if(*iit<=ip){c1[1]=ran;}
         else{c1[1]=rap;}
         c2[1]=can;
     }
     else{
         c1[1]=ea;
         c2[1]=cae;
     }
     if(ram1[1]<ram2[1]){ram2[1]=ram1[1];}
     }
 
     iconvergence=0; 
  
     /* mechanical */
 
     if(*ithermal<2){
     if((*iit>1)&&(ram[0]<=c1[0]*qam[0])&&(*iflagact==0)&&
            ((*nmethod!=-1)||(qa[3]<=cetol))&&
        ((cam[0]<=c2[0]*uam[0])||
         (((ram[0]*cam[0]<c2[0]*uam[0]*ram2[0])||(ram[0]<=ral*qam[0])||
           (qa[0]<=ea*qam[0]))&&(*ntg==0))||
         (cam[0]<1.e-8))) iconvergence=1;
     }
 
     /* thermal */
 
     if(*ithermal==2){
     if((ram[1]<=c1[1]*qam[1])&&
            (cam[2]<*deltmx)&&
        ((cam[1]<=c2[1]*uam[1])||
         (((ram[1]*cam[1]<c2[1]*uam[1]*ram2[1])||(ram[1]<=ral*qam[1])||
           (qa[1]<=ea*qam[1]))&&(*ntg==0))||
         (cam[1]<1.e-8)))iconvergence=1;
     }
 
     /* thermomechanical */
 
     if(*ithermal==3){
     if(((*iit>1)&&(ram[0]<=c1[0]*qam[0])&&
             ((*nmethod!=-1)||(qa[3]<=cetol))&&
         ((cam[0]<=c2[0]*uam[0])||
          (((ram[0]*cam[0]<c2[0]*uam[0]*ram2[0])||(ram[0]<=ral*qam[0])||
            (qa[0]<=ea*qam[0]))&&(*ntg==0))||
          (cam[0]<1.e-8)))&&
        ((ram[1]<=c1[1]*qam[1])&&
             (cam[2]<*deltmx)&&
         ((cam[1]<=c2[1]*uam[1])||
          (((ram[1]*cam[1]<c2[1]*uam[1]*ram2[1])||(ram[1]<=ral*qam[1])||
            (qa[1]<=ea*qam[1]))&&(*ntg==0))||
          (cam[1]<1.e-8))))iconvergence=1;
     }
 
     /* reset kscale */
 
     if(iconvergence==1){
     if(*kscale>1){
         *kscale=1;
         iconvergence=0;
         printf("\n restoring the elastic contact stifnesses to their original values \n\n");
     }
     }
 
 // # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
 //    MPADD start
     /* 
          Energy conservation convergence: only for implicit dynamic calculations 
     (convergence is not checked in explicit dynamics)
 
          Main variables and meaning
          
          r_rel     : modified energy conservation criterion
          emax      : maximum value of the energy over the time history
          r     : energy residual (Eint + K + Econt - Wext - Wdamp -Eref)
          enetoll   : energy conservation tolerance
          tmp       : auxiliary temporary variable
          maxdecay  : \hat(r)^{max}(\theta) -> value of the decay boundary 
                        for r_hat. 
          
          Proposed by Matteo Pacher */
 
     if((*nmethod==4)&&(*ithermal<2)&&(*uncoupled==0)&&(iconvergence==1)&&(*ne==*ne0)&&(*neini==*ne0)&&(*idrct==0)) {
     
     /* Update the value of the maximum energy of the system emax
        (contact energy is not taken into account because small) */
 
     *emax=max(*emax,fabs(energy[0]-energystartstep[0]));
     *emax=max(*emax,fabs(energy[1]));
     *emax=max(*emax,fabs(*allwk));
     
     // energy residual (only calculated in the absence of contact); 
         // if <=0: loss of energy 
 
     *r_abs=energy[0]+energy[1]+energy[2]+energy[3]-*energyref-*allwk-*dampwk;
     
     // Absolute tolerance check (when the error is really small --> beginning of simulation)
 
     if(fabs(*r_abs)>=*enetoll/4) {
 
         // Normal strategy: Relative error
         
         /* Compute admissible decay*/
 
         maxdecay=*enetoll/2*(1+sqrt(*theta));
         
         /* modified r_hat criterion */
 
         r_rel=*r_abs/(*emax);
         if(r_rel<=-maxdecay) {
         idivergence=1;
         }else{
         
         /* Check if the residual is too close to the boundary */
 
         if(r_rel<=-0.9*maxdecay) {
             *istab=0; // keep the increment size
         }
         }
     }
     }
     
     /* Contact Strategy: limit jumps and time increment during contact based
        on the natural frequency of oscillation of contact elements 
        Implicit dynamic calculations only */
 
     if((*nmethod==4)&&(*ithermal<2)&&(*uncoupled==0)&&(iconvergence==1)&&((*ne!=*ne0)||(*neini!=*ne0))){
 
     /* store temporarly the value of emax: in case of forced divergence 
        emax has to be reset. */
 
     tmp=*emax;
     
     /* Update the value of the maximum energy of the system emax
       (contact energy is not taken into account because small) */
 
     *emax=max(*emax,fabs(energy[0]-energystartstep[0]));
     *emax=max(*emax,fabs(energy[1]));
     *emax=max(*emax,fabs(*allwk));
     
     /* maximum decay boundary */
 
     maxdecay=*enetoll/2*(1+sqrt(*theta));
     
     FORTRAN(checkimpacts,(ne,neini,temax,sizemaxinc,energyref,
                   tmin,tper,&idivergence,
                   &iforceincsize,istab,dtheta,r_abs,energy,energyini,
                   allwk,allwkini,dampwk,dampwkini,emax,mortar,
                   &maxdecay,enetoll));
 
     /* reset emax in case of forced divergence */
 
     if(idivergence==1){
         *emax=tmp;
     }
     
     /* Adaption of the energy tolerance in case of violation due to 
        contact jumps (rebounds). 
        The user is aware of it via the output string. */
 
     if((*ne==*ne0)&&(*neini>*ne0)&&(idivergence==0)){
         *r_abs=fabs(energy[0]+energy[1]+energy[2]+energy[3]-*energyref-*allwk-*dampwk);
         tmp=1.3*(2.0*(*r_abs)/(*emax))/(1.0+sqrt(*theta));
         *enetoll=max(*enetoll,tmp);
         printf("\n Adaption of the max-decay boundary, enetoll = %f \n",*enetoll);
     }
     
     /*
       Adaption of the energy residual during long periods of persistent contact.
       Take care of the general (increasing) trend of the residual to avoid code stucks.
     */
 
     if((iconvergence==1)&&(*ne<=*neini)){
         tmp=energy[0]+energy[1]+energy[2]+energy[3]-*energyref-*allwk-*dampwk;
         if(tmp>*r_abs){
         *r_abs=tmp;
         printf("\n Adaption of the energy residual in persistent contact, \n");
         printf("   an increasing trend has been detected.\n");
         }
     }
     } else {
     *sizemaxinc=*tmax;
     }
 //    MPADD end
 // # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
     
     /* increment convergence reached */
     
     if((iconvergence==1)&&(idivergence==0)){
 
     FORTRAN(writesummary,(istep,iinc,icutb,iit,ttime,time,dtime));
     if(*uncoupled){
         if(*ithermal==2){
             *iitterm=*iit;
         *ithermal=1;
         for(k=0;k<*nk;++k){t1[k]=vold[mt*k];}
         *iit=1;
         (ctrl[0])*=4;
         printf(" thermal convergence\n\n");
         *iflagact=0;
         return;
         }else{
         *ithermal=3;
         *iit=*iitterm;
         (ctrl[0])/=4;
         }
     }
     
     *icntrl=1;
     *icutb=0;
     *theta=*theta+*dtheta;
     
     /* defining a mean "velocity" for static calculations: is used to
        extrapolate the present results for next increment */
     
     if(*nmethod != 4){
         for(i=0;i<*nk;i++){
         for(j=1;j<mt;j++){
             veold[mt*i+j]=(vold[mt*i+j]-vini[mt*i+j])/(*dtime);
         }
         }
     }
 
         /* check whether size is to be set to a fixed value */
 
     if(iforceincsize==1){
         *dtheta=*sizemaxinc;
         *dthetaref=*sizemaxinc;
         printf(" convergence; new increment size is forced to %e\n\n",*dtheta**tper);
     }
     
     /* check whether next increment size must be decreased */
     
     else if((*iit>il)&&(*idrct==0)){
         if(*mortar==0){
         *dtheta=*dthetaref*db;
         *dthetaref=*dtheta;
         printf(" convergence; the increment size is decreased to %e\n\n",*dtheta**tper);
         if(*dtheta<*tmin){
             printf("\n *ERROR: increment size smaller than minimum\n");
             printf(" best solution and residuals are in the frd file\n\n");
             NNEW(fn,double,mt**nk);
             NNEW(inum,ITG,*nk);for(k=0;k<*nk;k++) inum[k]=1;
             FORTRAN(storeresidual,(nactdof,b,fn,filab,ithermal,
                       nk,sti,stn,ipkon,inum,kon,lakon,ne,mi,orab,
               ielorien,co,itg,ntg,vold,ielmat,thicke,ielprop,prop));
             ++*kode;
 
             (*ttime)+=(*time);
             frd(co,nk,kon,ipkon,lakon,ne,vold,stn,inum,nmethod,
             kode,filab,een,t1act,fn,ttime,epn,ielmat,matname,enern,
                         xstaten,nstate_,istep,iinc,ithermal,qfn,mode,noddiam,
                         trab,inotr,ntrans,orab,ielorien,norien,description,
                         ipneigh,neigh,mi,sti,vr,vi,stnr,stni,vmax,stnmax,
                         &ngraph,veold,ener,ne,cs,set,nset,istartset,iendset,
                         ialset,eenmax,fnr,fni,emn,thicke,jobnamec,output,qfx,
                         cdn,mortar,cdnr,cdni,nmat);
 
             FORTRAN(stop,());
         }
         }
         else{
         printf("convergence\n\n");}
     }
     
     /* check whether next increment size can be increased */
     
     else if(*iit<=ig){
         if((*istab==1)&&(*idrct==0)){
         *dtheta=*dthetaref*dd;
         *dthetaref=*dtheta;
         printf(" convergence; the increment size is increased to %e\n\n",*dtheta**tper);
         }
         else{
         *istab=1;
         printf(" convergence\n\n");
         *dtheta=*dthetaref;
         }
     }
     else{
         *istab=0;
         printf(" convergence\n\n");
         *dtheta=*dthetaref;
     }
     
     /* check whether new increment size exceeds maximum increment
            size allowed (by the user) */
 
     if((*dtheta>*sizemaxinc)&&(*idrct==0)){
         *dtheta=*sizemaxinc;
         *dthetaref=*dtheta;
         printf(" the increment size exceeds thetamax and is decreased to %e\n\n",*dtheta**tper);
     }
 
         /* check whether new time point exceeds end of step */
 
     if(*dtheta>=1.-*theta){
         if(*dtheta>1.-*theta){iexceed=1;}else{iexceed=0;}
         *dtheta=1.-*theta;
         *dthetaref=*dtheta;
         if(iexceed==1)
         printf(" the increment size exceeds the remainder of the step and is decreased to %e\n\n",*dtheta**tper);
     }
 
         /* check whether the end of the new increment exceeds a time point;
            if itp=1 the increment just finished ends at a time point */
 
     if((*itpamp>0)&&(*idrct==0)){
         if(*itp==1){
         *jprint=*jout;
         }else{
         *jprint=*jout+1;
         }
         if(namta[3**itpamp-1]<0){
         reftime=*ttime+*time+*dtheta**tper;
         }else{
         reftime=*time+*dtheta**tper;
         }
         istart=namta[3**itpamp-3];
         iend=namta[3**itpamp-2];
         FORTRAN(identamta,(amta,&reftime,&istart,&iend,&id));
         if(id<istart){
         inew=istart;
         }else{
         inew=id+1;
         }
 
             /* if the end of the new increment is less than a time
                point by less than 1.e-6 (theta-value) dtheta is
                enlarged up to this time point */
 
         if((*inext==inew)&&(inew<=iend)){
         if(amta[2*inew-2]-reftime<1.e-6**tper){inew++;}
         }
 
             /* inew: smallest time point exceeding time+dtheta*tper
                inext: smallest time point exceeding time */
 
         if(*inext<inew){
         if(namta[3**itpamp-1]<0){
             *dtheta=(amta[2**inext-2]-*ttime-*time)/(*tper);
         }else{
             *dtheta=(amta[2**inext-2]-*time)/(*tper);
         }
         (*inext)++;
         *itp=1;
         printf(" the increment size exceeds a time point and is decreased to %e\n\n",*dtheta**tper);
         }else{*itp=0;}
     }
     }
     else{
 
         /* no convergence */
     
     /* check for the amount of iterations */
     
     if(((*iit>ic)&&(*mortar==0))||((*mortar>1)&&(*iit>200))){
         printf("\n *ERROR: too many iterations needed\n");
         printf(" best solution and residuals are in the frd file\n\n");
 
         FORTRAN(writesummarydiv,(istep,iinc,icutb,iit,ttime,time,dtime));
 
         NNEW(fn,double,mt**nk);
         NNEW(inum,ITG,*nk);for(k=0;k<*nk;k++) inum[k]=1;
         FORTRAN(storeresidual,(nactdof,b,fn,filab,ithermal,nk,sti,stn,
         ipkon,inum,kon,lakon,ne,mi,orab,ielorien,co,itg,ntg,vold,
                 ielmat,thicke,ielprop,prop));
         ++*kode;
 
         (*ttime)+=(*time);
         frd(co,nk,kon,ipkon,lakon,ne,vold,stn,inum,nmethod,
             kode,filab,een,t1act,fn,ttime,epn,ielmat,matname,enern,
                         xstaten,nstate_,istep,iinc,ithermal,qfn,mode,noddiam,
                         trab,inotr,ntrans,orab,ielorien,norien,description,
                         ipneigh,neigh,mi,sti,vr,vi,stnr,stni,vmax,stnmax,
                         &ngraph,veold,ener,ne,cs,set,nset,istartset,iendset,
                 ialset,eenmax,fnr,fni,emn,thicke,jobnamec,output,qfx,cdn,
                         mortar,cdnr,cdni,nmat);
 
         FORTRAN(stop,());
     }   
     
     /* check for diverging residuals */
 
         /* if the user has not defined deltmx on the *HEAT
      TRANSFER card it is set to a large value (1.e30,
      cf. CalculiX.c); therefore, a comparison of cam[2]
      with deltmx only makes sense for cam[2]<1.e30 */
       
     if((*iit>=i0)||(fabs(ram[0])>1.e20)||(fabs(cam[0])>1.e20)||
                    (fabs(ram[1])>1.e20)||(fabs(cam[1])>1.e20)||
        ((cam[2]<1.e30)&&(cam[2]>*deltmx))||(idivergence==1)||
                    (iforceincsize==1)){
         if((*ithermal!=2)&&(*mortar!=1)){
         if((ram1[0]>ram2[0])&&(ram[0]>ram2[0])&&(ram[0]>c1[0]*qam[0]))
             idivergence=1;
         }
 
         if((*ithermal!=2)&&(*mortar==1)){
 
         if(ram[0]>1.e9){
             printf("divergence allowed: residual force too large\n");
             if((ram1[0]>ram2[0])&&(ram[0]>ram2[0])&&(ram[0]>c1[0]*qam[0]))
             idivergence=1;
         }
 
                 /* number of contact elements does not change */
 
         if(*iflagact==0){
             printf("divergence allowed: number of contact elements stabilized\n");
             if((ram1[0]>ram2[0])&&(ram[0]>ram2[0])&&(ram[0]>c1[0]*qam[0])){
             if(cam[0]<=c2[0]*uam[0]){
                 *ialeatoric=1;
             }
             }
         }
         
                 /* rate of number of contact elements is increasing */
 
         if(((ITG)ram[6]*(ITG)ram1[6]<0)&&((ITG)ram1[6]*(ITG)ram2[6]<0)){
             
             if(((ram[4]>0.98*ram1[4])&&(ram[4]<1.02*ram1[4]))&&
                ((ram[4]>0.98*ram2[4])&&(ram[4]<1.02*ram2[4]))){
             printf("divergence allowed: repetitive pattern detected\n");
             if((ram1[0]>ram2[0])&&(ram[0]>ram2[0])&&(ram[0]>c1[0]*qam[0]))
                 idivergence=1;
             }
         }
         }
 
             /* check whether in a viscous step the allowable increase in viscous
                strain has been exceeded */
 
         if((idivergence==0)&&((*nmethod==-1)&&(qa[3]>cetol))) idivergence=2;
 
 
             /* for thermal calculations the maximum temperature change
                is checked as well */
 
             if(*ithermal>1){
             if((ram1[1]>ram2[1])&&(ram[1]>ram2[1])&&(ram[1]>c1[1]*qam[1]))
             idivergence=1;
 
         /* if the user has not defined deltmx on the *HEAT
                    TRANSFER card it is set to a large value (1.e30,
                    cf. CalculiX.c); therefore, a comparison of cam[2]
                    with deltmx only makes sense for cam[2]<1.e30 */
 
         if((cam[2]<1.e30)&&(cam[2]>*deltmx)) idivergence=2;
         }
 
         if(idivergence>0){
         if(*idrct==1){
             if((*mortar<=1)||((*mortar>1)&&(*iit>200))) {
             
             /* fixed time increments */
             
             printf("\n *ERROR: solution seems to diverge; please try \n");
             printf(" automatic incrementation; program stops\n");
             printf(" best solution and residuals are in the frd file\n\n");
             
             FORTRAN(writesummarydiv,(istep,iinc,icutb,iit,ttime,time,
                          dtime));
             
             NNEW(fn,double,mt**nk);
             NNEW(inum,ITG,*nk);for(k=0;k<*nk;k++) inum[k]=1;
             FORTRAN(storeresidual,(nactdof,b,fn,filab,ithermal,nk,
                            sti,stn,ipkon,inum,kon,lakon,ne,mi,orab,
                            ielorien,co,itg,ntg,vold,ielmat,thicke,ielprop,prop));
             ++*kode;
             
             (*ttime)+=(*time);
             frd(co,nk,kon,ipkon,lakon,ne,vold,stn,inum,nmethod,
                 kode,filab,een,t1act,fn,ttime,epn,ielmat,matname,enern,
                 xstaten,nstate_,istep,iinc,ithermal,qfn,mode,noddiam,
                 trab,inotr,ntrans,orab,ielorien,norien,description,
                 ipneigh,neigh,mi,sti,vr,vi,stnr,stni,vmax,stnmax,
                 &ngraph,veold,ener,ne,cs,set,nset,istartset,iendset,
                 ialset,eenmax,fnr,fni,emn,thicke,jobnamec,output,qfx,cdn,
                 mortar,cdnr,cdni,nmat);
             
             FORTRAN(stop,());
             }
         }
         else {
 
                     /* variable time increments */
 
             if(qa[2]>0.){
             *dtheta=*dtheta*qa[2];
             printf("increment size decrease requested by a material user routine (through pnewdt)\n\n");
             }else{
             if(idivergence==1){
                 if((*mortar!=1)||(*icutb!=0)){              // MPADD
                               if(iforceincsize != 1){                   // MPADD
                                 *dtheta=*dtheta*df;                     // MPADD
                               }else{                                    // MPADD
                                 *dtheta=*sizemaxinc;                    // MPADD
                               }                                         // MPADD
                             }                                           // MPADD
             }else{
                 if(*nmethod==-1){
                 *dtheta=*dtheta*cetol/qa[3]*da;
                 }else{
                 *dtheta=*dtheta**deltmx/cam[2]*da;
                 }
             }
             }
             *dthetaref=*dtheta;
             printf(" divergence; the increment size is decreased to %e\n",*dtheta**tper);
             printf(" the increment is reattempted\n\n");
 
             FORTRAN(writesummarydiv,(istep,iinc,icutb,iit,ttime,time,
                          dtime));
 
             *istab=0;
             if(*itp==1){
               *itp=0;
               (*inext)--;
             }
 
                     /* check whether new increment size is smaller than minimum */
 
             if(*dtheta<*tmin){
             printf("\n *ERROR: increment size smaller than minimum\n");
             printf(" best solution and residuals are in the frd file\n\n");
             NNEW(fn,double,mt**nk);
             NNEW(inum,ITG,*nk);for(k=0;k<*nk;k++) inum[k]=1;
             FORTRAN(storeresidual,(nactdof,b,fn,filab,ithermal,
                            nk,sti,stn,ipkon,inum,kon,lakon,ne,mi,orab,
                ielorien,co,itg,ntg,vold,ielmat,thicke,ielprop,prop));
             ++*kode;
 
             (*ttime)+=(*time);
             frd(co,nk,kon,ipkon,lakon,ne,vold,stn,inum,nmethod,
             kode,filab,een,t1act,fn,ttime,epn,ielmat,matname,enern,
                         xstaten,nstate_,istep,iinc,ithermal,qfn,mode,noddiam,
                         trab,inotr,ntrans,orab,ielorien,norien,description,
                         ipneigh,neigh,mi,sti,vr,vi,stnr,stni,vmax,stnmax,
                         &ngraph,veold,ener,ne,cs,set,nset,istartset,iendset,
                         ialset,eenmax,fnr,fni,emn,thicke,jobnamec,output,qfx,cdn,
                         mortar,cdnr,cdni,nmat);
 
             FORTRAN(stop,());
             }
             *icntrl=1;
             (*icutb)++;
             if(*mortar==1){
             *kscale=100;
             printf("\n reducing the constant stiffnesses by a factor of 100 \n\n");
             }
 
                     /* check whether too many cutbacks */
 
             if(*icutb>ia){
             printf("\n *ERROR: too many cutbacks\n");
             printf(" best solution and residuals are in the frd file\n\n");
             NNEW(fn,double,mt**nk);
             NNEW(inum,ITG,*nk);for(k=0;k<*nk;k++) inum[k]=1;
             FORTRAN(storeresidual,(nactdof,b,fn,filab,ithermal,
                            nk,sti,stn,ipkon,inum,kon,lakon,ne,mi,orab,
                ielorien,co,itg,ntg,vold,ielmat,thicke,ielprop,prop));
             ++*kode;
 
             (*ttime)+=(*time);
             frd(co,nk,kon,ipkon,lakon,ne,vold,stn,inum,nmethod,
             kode,filab,een,t1act,fn,ttime,epn,ielmat,matname,enern,
                         xstaten,nstate_,istep,iinc,ithermal,qfn,mode,noddiam,
                         trab,inotr,ntrans,orab,ielorien,norien,description,
                         ipneigh,neigh,mi,sti,vr,vi,stnr,stni,vmax,stnmax,
                         &ngraph,veold,ener,ne,cs,set,nset,istartset,iendset,
                         ialset,eenmax,fnr,fni,emn,thicke,jobnamec,output,qfx,cdn,
                         mortar,cdnr,cdni,nmat);
 
             FORTRAN(stop,());
             }
             if(*uncoupled){
               if(*ithermal==1){
             (ctrl[0])/=4;
               }
               *ithermal=3;
             }
 
                     /* default value for qa[2] */
 
             qa[2]=-1.;
 
             *iflagact=0;
             return;
         }
         }
     }
     
     /* check for too slow convergence */
     
     if(*iit>=ir){
         if(*ithermal!=2){
         iest1=(ITG)ceil(*iit+log(ran*qam[0]/(ram[0]))/
                 log(ram[0]/(ram1[0])));
         }
         if(*ithermal>1){
         iest2=(ITG)ceil(*iit+log(ran*qam[1]/(ram[1]))/
                 log(ram[1]/(ram1[1])));
         }
         if(iest1>iest2){iest=iest1;}else{iest=iest2;}
         if((iest>0)&&(*mortar!=1)){
         printf(" estimated number of iterations till convergence = %" ITGFORMAT "\n",
            iest);
         }
         if((((iest>ic)||(*iit==ic))&&(*mortar!=1))||((*mortar==1)&&(*iit==60))){
         
         if(*idrct!=1){
             if((*mortar!=1)||(*icutb!=0)) *dtheta=*dtheta*dc;
             *dthetaref=*dtheta;
             printf(" too slow convergence; the increment size is decreased to %e\n",*dtheta**tper);
             printf(" the increment is reattempted\n\n");
 
             FORTRAN(writesummarydiv,(istep,iinc,icutb,iit,ttime,
                          time,dtime));
             *istab=0;
             if(*itp==1){
               *itp=0;
               (*inext)--;
             }
 
                     /* check whether new increment size is smaller than minimum */
 
             if(*dtheta<*tmin){
             printf("\n *ERROR: increment size smaller than minimum\n");
             printf(" best solution and residuals are in the frd file\n\n");
             NNEW(fn,double,mt**nk);
             NNEW(inum,ITG,*nk);for(k=0;k<*nk;k++) inum[k]=1;
             FORTRAN(storeresidual,(nactdof,b,fn,filab,ithermal,
                            nk,sti,stn,ipkon,inum,kon,lakon,ne,mi,orab,
                ielorien,co,itg,ntg,vold,ielmat,thicke,ielprop,prop));
             ++*kode;
 
             (*ttime)+=(*time);
             frd(co,nk,kon,ipkon,lakon,ne,vold,stn,inum,nmethod,
             kode,filab,een,t1act,fn,ttime,epn,ielmat,matname,enern,
                         xstaten,nstate_,istep,iinc,ithermal,qfn,mode,noddiam,
                         trab,inotr,ntrans,orab,ielorien,norien,description,
                         ipneigh,neigh,mi,sti,vr,vi,stnr,stni,vmax,stnmax,
                         &ngraph,veold,ener,ne,cs,set,nset,istartset,iendset,
                         ialset,eenmax,fnr,fni,emn,thicke,jobnamec,output,qfx,cdn,
                         mortar,cdnr,cdni,nmat);
 
             FORTRAN(stop,());
             }
             *icntrl=1;
             (*icutb)++;
             if(*mortar==1){
             *kscale=100;
             printf("\n reducing the constant stiffnesses by a factor of 100 \n\n");
             }
 //          if(*mortar==1) *kscale=100;
 
             if(*icutb>ia){
             printf("\n *ERROR: too many cutbacks\n");
             printf(" best solution and residuals are in the frd file\n\n");
             NNEW(fn,double,mt**nk);
             NNEW(inum,ITG,*nk);for(k=0;k<*nk;k++) inum[k]=1;
             FORTRAN(storeresidual,(nactdof,b,fn,filab,ithermal,
                            nk,sti,stn,ipkon,inum,kon,lakon,ne,mi,orab,
                ielorien,co,itg,ntg,vold,ielmat,thicke,ielprop,prop));
             ++*kode;
 
             (*ttime)+=(*time);
             frd(co,nk,kon,ipkon,lakon,ne,vold,stn,inum,nmethod,
             kode,filab,een,t1act,fn,ttime,epn,ielmat,matname,enern,
                         xstaten,nstate_,istep,iinc,ithermal,qfn,mode,noddiam,
                         trab,inotr,ntrans,orab,ielorien,norien,description,
                         ipneigh,neigh,mi,sti,vr,vi,stnr,stni,vmax,stnmax,
                         &ngraph,veold,ener,ne,cs,set,nset,istartset,iendset,
                         ialset,eenmax,fnr,fni,emn,thicke,jobnamec,output,qfx,cdn,
                         mortar,cdnr,cdni,nmat);
 
             FORTRAN(stop,());
             }
             if(*uncoupled){
               if(*ithermal==1){
             (ctrl[0])/=4;
               }
               *ithermal=3;
             }
 
                     /* default value for qa[2] */
 
             qa[2]=-1.;
 
             *iflagact=0;
             return;
         }
         }
     }
     
     printf(" no convergence\n\n");
     
     (*iit)++;
     
     }
 
     *iflagact=0;
     return;
 }

◆ checkconvnet()

void checkconvnet	(	ITG *	icutb,
		ITG *	iin,
		double *	cam1t,
		double *	cam1f,
		double *	cam1p,
		double *	cam2t,
		double *	cam2f,
		double *	cam2p,
		double *	camt,
		double *	camf,
		double *	camp,
		ITG *	icntrl,
		double *	dtheta,
		double *	ctrl,
		double *	cam1a,
		double *	cam2a,
		double *	cama,
		double *	vamt,
		double *	vamf,
		double *	vamp,
		double *	vama,
		double *	qa,
		double *	qamt,
		double *	qamf,
		double *	ramt,
		double *	ramf,
		double *	ramp,
		ITG *	iplausi
	)

                                                                          {
   
   ITG i0,ir,ip,ic,il,ig,ia,idivergence;
   
   double c2t,c2f,c2p,c2a,c1t,c1f,c1p,qamp=1.,
          df,dc,db,dd,ran,can,rap,ea,cae,ral;
 
   i0=ctrl[0];ir=ctrl[1];ip=ctrl[2];ic=ctrl[3];il=ctrl[4];ig=ctrl[5];ia=ctrl[7];
   df=ctrl[10];dc=ctrl[11];db=ctrl[12];dd=ctrl[16];ran=ctrl[18];can=ctrl[19];
   rap=ctrl[22];ea=ctrl[23];cae=ctrl[24];ral=ctrl[25];c1t=ctrl[32];c1f=ctrl[33];
   c1p=ctrl[34];c2t=ctrl[35];c2f=ctrl[36];c2p=ctrl[37];c2a=ctrl[38];
   
   /* temperature */
   
   if(*iin<=ip){c2t=0.0001*ran;}
   else{c2t=0.0001*rap;}
   
   if(*iin<=ip){c1t=0.0001*ran;}
   else{c1t=0.0001*rap;}
   
   /* mass flow */
   
   if(*iin<=ip){c2f=0.0001*ran;}
   else{c2f=0.0001*rap;}
   
   if(*iin<=ip){c1f=0.0001*ran;}
   else{c1f=0.0001*rap;}
   
   /* pressure */
   
   if(*iin<=ip){c2p=0.0001*ran;}
   else{c2p=0.0001*rap;}
   
   if(*iin<=ip){c1p=0.0001*ran;}
   else{c1p=0.0001*rap;}
   
   /* geometry */
   
   if(*iin<=ip){c2a=0.0001*ran;}
   else{c2a=0.0001*rap;}
   
   if(*cam1t<*cam2t) {*cam2t=*cam1t;}
   if(*cam1f<*cam2f) {*cam2f=*cam1f;}
   if(*cam1p<*cam2p) {*cam2p=*cam1p;}
   if(*cam1a<*cam2a) {*cam2a=*cam1a;}
   
   /* check for convergence or divergence; 
      the convergence check consists of 
      - a comparison of the correction in
        the latest network iteration with the change since the 
        start of the network calculations 
      - a comparison of the residual in the latest network
        iteration with mean typical values of the equation terms */
 
   *ramt=0.;*ramf=0.;*ramp=0.;
   if((*camt<=c2t**vamt)&&(*ramt<c1t**qamt)&&
      (*camf<=c2f**vamf)&&(*ramf<c1f**qamf)&&
      (*camp<=c2p**vamp)&&(*ramp<c1p*qamp)&&
      (*cama<=c2a**vama)&&
 //     (*cama<=c2a**vama)&&(*iplausi==1)&&
      (*iin>3)){
       
       /* increment convergence reached */
       
       printf("      flow network: convergence in gas iteration %" ITGFORMAT " \n\n",*iin);
       *icntrl=1;
       *icutb=0;
   }
   
   else {
 
       idivergence=0;
 
       /* divergence based on temperatures */
       
       if((*iin>=20*i0)||(fabs(*camt)>1.e20)){
       if((*cam1t>=*cam2t)&&(*camt>=*cam2t)&&(*camt>c2t**vamt)){
           idivergence=1;
       }
       }
 
       /* divergence based on the mass flux */
       
       if((*iin>=20*i0)||(fabs(*camf)>1.e20)){
       if((*cam1f>=*cam2f)&&(*camf>=*cam2f)&&(*camf>c2f**vamf)){
           idivergence=1;
       }
       }
 
       /* divergence based on pressures */
       
       if((*iin>=20*i0)||(fabs(*camp)>1.e20)){
       if((*cam1p>=*cam2p)&&(*camp>=*cam2p)&&(*camp>c2p**vamp)){
           idivergence=1;
       }
       }
 
       /* divergence based on geometry */
       
       if((*iin>=20*i0)||(fabs(*cama)>1.e20)){
       if((*cam1a>=*cam2a)&&(*cama>=*cam2a)&&(*cama>c2a**vama)){
           idivergence=1;
       }
       }
 
       /* divergence based on the number of iterations */
 
       if(*iin>20*ic) idivergence=1;
 
       /* divergence based on singular matrix or negative pressures */
 
       if(*iin==0) idivergence=1;
       
       if(idivergence==1){
       *dtheta=*dtheta*df;
       printf("\n network divergence; the under-relaxation parameter is decreased to %e\n",*dtheta);
       printf(" the network iteration for the increment is reattempted\n\n");
       *iin=0;
       (*icutb)++;
       if(*icutb>ia){
           qa[2]=0.25;
           *icntrl=1;
 //      printf("\n *ERROR: too many cutbacks\n");
 //      FORTRAN(stop,());
       }
       }else{
           printf("      no convergence\n\n"); 
       }
   }
   return;
 }

◆ checkdivergence()

void checkdivergence	(	double *	co,
		ITG *	nk,
		ITG *	kon,
		ITG *	ipkon,
		char *	lakon,
		ITG *	ne,
		double *	stn,
		ITG *	nmethod,
		ITG *	kode,
		char *	filab,
		double *	een,
		double *	t1act,
		double *	time,
		double *	epn,
		ITG *	ielmat,
		char *	matname,
		double *	enern,
		double *	xstaten,
		ITG *	nstate_,
		ITG *	istep,
		ITG *	iinc,
		ITG *	iperturb,
		double *	ener,
		ITG *	mi,
		char *	output,
		ITG *	ithermal,
		double *	qfn,
		ITG *	mode,
		ITG *	noddiam,
		double *	trab,
		ITG *	inotr,
		ITG *	ntrans,
		double *	orab,
		ITG *	ielorien,
		ITG *	norien,
		char *	description,
		double *	sti,
		ITG *	icutb,
		ITG *	iit,
		double *	dtime,
		double *	qa,
		double *	vold,
		double *	qam,
		double *	ram1,
		double *	ram2,
		double *	ram,
		double *	cam,
		double *	uam,
		ITG *	ntg,
		double *	ttime,
		ITG *	icntrl,
		double *	theta,
		double *	dtheta,
		double *	veold,
		double *	vini,
		ITG *	idrct,
		double *	tper,
		ITG *	istab,
		double *	tmax,
		ITG *	nactdof,
		double *	b,
		double *	tmin,
		double *	ctrl,
		double *	amta,
		ITG *	namta,
		ITG *	itpamp,
		ITG *	inext,
		double *	dthetaref,
		ITG *	itp,
		ITG *	jprint,
		ITG *	jout,
		ITG *	uncoupled,
		double *	t1,
		ITG *	iitterm,
		ITG *	nelemload,
		ITG *	nload,
		ITG *	nodeboun,
		ITG *	nboun,
		ITG *	itg,
		ITG *	ndirboun,
		double *	deltmx,
		ITG *	iflagact,
		char *	set,
		ITG *	nset,
		ITG *	istartset,
		ITG *	iendset,
		ITG *	ialset,
		double *	emn,
		double *	thicke,
		char *	jobnamec,
		ITG *	mortar,
		ITG *	nmat,
		ITG *	ielprop,
		double *	prop,
		ITG *	ialeatoric,
		ITG *	kscale,
		double *	energy,
		double *	allwk,
		double *	energyref,
		double *	emax,
		double *	enres,
		double *	enetoll,
		double *	energyini,
		double *	allwkini,
		double *	temax,
		double *	reswk,
		ITG *	ne0,
		ITG *	neini,
		double *	dampwk,
		double *	dampwkini,
		double *	energystartstep
	)

                                                                   {
 
     ITG ia,ngraph=1,k,*ipneigh=NULL,*neigh=NULL,*inum=NULL,mt=mi[1]+1;
 
     double *vr=NULL,*vi=NULL,*stnr=NULL,
     *stni=NULL,*vmax=NULL,*stnmax=NULL,*cs=NULL,
         *fn=NULL,*eenmax=NULL,*fnr=NULL,*fni=NULL,*qfx=NULL,*cdn=NULL,
         *cdnr=NULL,*cdni=NULL;
 
     ia=ctrl[7];
 
     /* check whether divergence was signaled in radflowload.c
        => repeat the increment with a smaller size */
 
     *dtheta=*dtheta*qa[2];
     printf("increment size decrease requested by the network\n\n");
     *dthetaref=*dtheta;
     printf(" divergence; the increment size is decreased to %e\n",*dtheta**tper);
     printf(" the increment is reattempted\n\n");
     
     FORTRAN(writesummarydiv,(istep,iinc,icutb,iit,ttime,time,
                  dtime));
     
     *istab=0;
     if(*itp==1){
         *itp=0;
         (*inext)--;
     }
     
     /* check whether new increment size is smaller than minimum */
     
     if(*dtheta<*tmin){
         printf("\n *ERROR: increment size smaller than minimum\n");
         printf(" best solution and residuals are in the frd file\n\n");
         NNEW(fn,double,mt**nk);
         NNEW(inum,ITG,*nk);for(k=0;k<*nk;k++) inum[k]=1;
         FORTRAN(storeresidual,(nactdof,b,fn,filab,ithermal,
                    nk,sti,stn,ipkon,inum,kon,lakon,ne,mi,orab,
                    ielorien,co,itg,ntg,vold,ielmat,thicke,ielprop,prop));
         ++*kode;
         
         (*ttime)+=(*time);
         frd(co,nk,kon,ipkon,lakon,ne,vold,stn,inum,nmethod,
         kode,filab,een,t1act,fn,ttime,epn,ielmat,matname,enern,
         xstaten,nstate_,istep,iinc,ithermal,qfn,mode,noddiam,
         trab,inotr,ntrans,orab,ielorien,norien,description,
         ipneigh,neigh,mi,sti,vr,vi,stnr,stni,vmax,stnmax,
         &ngraph,veold,ener,ne,cs,set,nset,istartset,iendset,
         ialset,eenmax,fnr,fni,emn,thicke,jobnamec,output,qfx,cdn,
         mortar,cdnr,cdni,nmat);
         
         FORTRAN(stop,());
     }
     *icntrl=1;
     (*icutb)++;
     if(*mortar==1){
         *kscale=100;
         printf("\n reducing the constant stiffnesses by a factor of 100 \n\n");
     }
     
     /* check whether too many cutbacks */
     
     if(*icutb>ia){
         printf("\n *ERROR: too many cutbacks\n");
         printf(" best solution and residuals are in the frd file\n\n");
         NNEW(fn,double,mt**nk);
         NNEW(inum,ITG,*nk);for(k=0;k<*nk;k++) inum[k]=1;
         FORTRAN(storeresidual,(nactdof,b,fn,filab,ithermal,
                    nk,sti,stn,ipkon,inum,kon,lakon,ne,mi,orab,
                    ielorien,co,itg,ntg,vold,ielmat,thicke,ielprop,prop));
         ++*kode;
         
         (*ttime)+=(*time);
         frd(co,nk,kon,ipkon,lakon,ne,vold,stn,inum,nmethod,
         kode,filab,een,t1act,fn,ttime,epn,ielmat,matname,enern,
         xstaten,nstate_,istep,iinc,ithermal,qfn,mode,noddiam,
         trab,inotr,ntrans,orab,ielorien,norien,description,
         ipneigh,neigh,mi,sti,vr,vi,stnr,stni,vmax,stnmax,
         &ngraph,veold,ener,ne,cs,set,nset,istartset,iendset,
         ialset,eenmax,fnr,fni,emn,thicke,jobnamec,output,qfx,cdn,
         mortar,cdnr,cdni,nmat);
         
         FORTRAN(stop,());
     }
     if(*uncoupled){
         if(*ithermal==1){
         (ctrl[0])/=4;
         }
         *ithermal=3;
     }
     
     /* default value for qa[2] */
     
     qa[2]=-1.;
     
     *iflagact=0;
 
 return;
 }

◆ checkinclength()

void checkinclength	(	double *	time,
		double *	ttime,
		double *	theta,
		double *	dtheta,
		ITG *	idrct,
		double *	tper,
		double *	tmax,
		double *	tmin,
		double *	ctrl,
		double *	amta,
		ITG *	namta,
		ITG *	itpamp,
		ITG *	inext,
		double *	dthetaref,
		ITG *	itp,
		ITG *	jprint,
		ITG *	jout
	)

                                           {
 
     ITG id,istart,iend,inew,ireduceincrement;
     double reftime;
 
     ITG i0,ir,ip,ic,il,ig,ia;
     double df,dc,db,dd,ran,can,rap,ea,cae,ral,da;
     i0=ctrl[0];ir=ctrl[1];ip=ctrl[2];ic=ctrl[3];il=ctrl[4];ig=ctrl[5];ia=ctrl[7];
     df=ctrl[10];dc=ctrl[11];db=ctrl[12];da=ctrl[13];dd=ctrl[16];
     ran=ctrl[18];can=ctrl[19];rap=ctrl[22];
     ea=ctrl[23];cae=ctrl[24];ral=ctrl[25];
 
     /* check whether the new increment size is not too big */
     
     if(*dtheta>*tmax){
     *dtheta=*tmax;
 //  printf(" the increment size exceeds thetamax and is decreased to %e\n\n",*dtheta**tper);
     } 
     
     /* if itp=1 the increment just finished ends at a time point */
     
     if((*itpamp>0)&&(*idrct==0)){
     if(namta[3**itpamp-1]<0){
         reftime=*ttime+*time+(*dtheta)**tper;
     }else{
         reftime=*time+(*dtheta)**tper;
     }
     istart=namta[3**itpamp-3];
     iend=namta[3**itpamp-2];
     FORTRAN(identamta,(amta,&reftime,&istart,&iend,&id));
     if(id<istart){
         inew=istart;
     }else{
         inew=id+1;
     }
 //  printf("istart=%" ITGFORMAT ",iend=%" ITGFORMAT ",inext=%" ITGFORMAT ",inew=%" ITGFORMAT "\n",istart,iend,*inext,inew);
 
             /* inew: smallest time point exceeding time+dtheta*tper
                inext: smallest time point exceeding time */
 
     /* the check with *tmin
            was introduced to circumvent the following problem: if the new data point is
            smaller than the next data point, but the distance is very small, the next *dheta
            calculated a few lines below may be zero due to the subtraction of two nearly equal
            numbers; a zero *dtheta leads to a fatal error */
 
     ireduceincrement=0;
     if(*inext<iend){
         if(fabs((amta[2**inext-2]-reftime)/(*tper))<*tmin){
         ireduceincrement=1;
         }
     }
 
     if((*inext<inew)||(ireduceincrement==1)){
 //  if((*inext<inew)||(fabs((amta[2**inext-2]-reftime)/(*tper))<*tmin)){
       //    if((*inext<inew)||(fabs((amta[2**inext-2]-reftime))<1.e-10)){
       
         if(namta[3**itpamp-1]<0){
         *dtheta=(amta[2**inext-2]-*ttime-*time)/(*tper);
         }else{
         *dtheta=(amta[2**inext-2]-*time)/(*tper);
         }
         (*inext)++;
         *itp=1;
 //      printf(" the increment size exceeds a time point and is decreased to %e\n\n",*dtheta**tper);
     }else{*itp=0;}
     }
 
     /* check whether the step length is not exceeded */
 
     if(*dtheta>1.-*theta){
     *dtheta=1.-*theta;
     *dthetaref=*dtheta;
     printf(" the increment size exceeds the remainder of the step and is decreased to %e\n\n",*dtheta**tper);
 //  if(*dtheta<=1.e-6){(*ttime)+=(*dtheta**tper);}
     }
     
     return;
 }

◆ compfluid()

void compfluid	(	double **	cop,
		ITG *	nk,
		ITG **	ipkonp,
		ITG *	konf,
		char **	lakonp,
		char **	sideface,
		ITG *	ifreestream,
		ITG *	nfreestream,
		ITG *	isolidsurf,
		ITG *	neighsolidsurf,
		ITG *	nsolidsurf,
		ITG *	nshcon,
		double *	shcon,
		ITG *	nrhcon,
		double *	rhcon,
		double **	voldp,
		ITG *	ntmat_,
		ITG *	nodeboun,
		ITG *	ndirboun,
		ITG *	nboun,
		ITG *	ipompc,
		ITG *	nodempc,
		ITG *	nmpc,
		ITG *	ikmpc,
		ITG *	ilmpc,
		ITG *	ithermal,
		ITG *	ikboun,
		ITG *	ilboun,
		ITG *	turbulent,
		ITG *	isolver,
		ITG *	iexpl,
		double *	ttime,
		double *	time,
		double *	dtime,
		ITG *	nodeforc,
		ITG *	ndirforc,
		double *	xforc,
		ITG *	nforc,
		ITG *	nelemload,
		char *	sideload,
		double *	xload,
		ITG *	nload,
		double *	xbody,
		ITG *	ipobody,
		ITG *	nbody,
		ITG *	ielmatf,
		char *	matname,
		ITG *	mi,
		ITG *	ncmat_,
		double *	physcon,
		ITG *	istep,
		ITG *	iinc,
		ITG *	ibody,
		double *	xloadold,
		double *	xboun,
		double *	coefmpc,
		ITG *	nmethod,
		double *	xforcold,
		double *	xforcact,
		ITG *	iamforc,
		ITG *	iamload,
		double *	xbodyold,
		double *	xbodyact,
		double *	t1old,
		double *	t1,
		double *	t1act,
		ITG *	iamt1,
		double *	amta,
		ITG *	namta,
		ITG *	nam,
		double *	ampli,
		double *	xbounold,
		double *	xbounact,
		ITG *	iamboun,
		ITG *	itg,
		ITG *	ntg,
		char *	amname,
		double *	t0,
		ITG **	nelemface,
		ITG *	nface,
		double *	cocon,
		ITG *	ncocon,
		double *	xloadact,
		double *	tper,
		ITG *	jmax,
		ITG *	jout,
		char *	set,
		ITG *	nset,
		ITG *	istartset,
		ITG *	iendset,
		ITG *	ialset,
		char *	prset,
		char *	prlab,
		ITG *	nprint,
		double *	trab,
		ITG *	inotr,
		ITG *	ntrans,
		char *	filab,
		char *	labmpc,
		double *	sti,
		ITG *	norien,
		double *	orab,
		char *	jobnamef,
		char *	tieset,
		ITG *	ntie,
		ITG *	mcs,
		ITG *	ics,
		double *	cs,
		ITG *	nkon,
		ITG *	mpcfree,
		ITG *	memmpc_,
		double *	fmpc,
		ITG *	nef,
		ITG **	inomat,
		double *	qfx,
		ITG *	neifa,
		ITG *	neiel,
		ITG *	ielfa,
		ITG *	ifaext,
		double *	vfa,
		double *	vel,
		ITG *	ipnei,
		ITG *	nflnei,
		ITG *	nfaext,
		char *	typeboun,
		ITG *	neij,
		double *	tincf,
		ITG *	nactdoh,
		ITG *	nactdohinv,
		ITG *	ielorien,
		char *	jobnamec,
		ITG *	ifatie,
		ITG *	nstate_,
		double *	xstate,
		char *	orname,
		ITG *	nblk,
		ITG *	ielblk,
		ITG *	istartblk,
		ITG *	iendblk,
		ITG *	nblket,
		ITG *	nblkze,
		ITG *	kon
	)

              {
 
     /* main computational fluid dynamics routine */
   
     char cflag[1],*lakonf=NULL,*sideface=NULL,fncvg[132]="";
 
   ITG *ipointer=NULL,*mast1=NULL,*irow=NULL,*icol=NULL,*jq=NULL,
       nzs=20000000,kode,compressible,*ifabou=NULL,*ja=NULL,
       nfabou,im,
       *ipkonf=NULL,*nelemface=NULL,last=0,icyclic,*iau6=NULL,
       *inomat=NULL,ithermalref,*integerglob=NULL,iincf,
       iconvergence=0,i,*inum=NULL,iitf,ifreefa,*neielcp=NULL,
       *iponofa=NULL,*inofa=NULL,is,ie,*ia=NULL,*ielpropf=NULL,
       icent=0,isti=0,iqfx=0,nfield,ndim,iorienglob,force=0,icfd=1,
       imach=0,ikappa=0,iit,jit,iatleastonepressurebc,iturb=0,
       *inoel=NULL,*iponoel=NULL;
 
   ITG nelt,isym,itol,itmax,iunit,lrgw,*igwk=NULL,ligw,ierr,*iwork=NULL,iter,
       nsave,lenw,leniw;
 
   double *umfa=NULL,reltime,*doubleglob=NULL,
       *co=NULL,*vold=NULL,*coel=NULL,*cosa=NULL,*gradvel=NULL,*gradvfa=NULL,
       *xxn=NULL,*xxi=NULL,*xle=NULL,*xlen=NULL,*xlet=NULL,timef,dtimef,
       *cofa=NULL,*area=NULL,*xrlfa=NULL,reltimef,ttimef,*hcfa=NULL,*cvel=NULL,
       *au=NULL,*ad=NULL,*b=NULL,*volume=NULL,*body=NULL,*dy=NULL,
       *advfa=NULL,*ap=NULL,*bp=NULL,*xxj=NULL,*gradkel=NULL,*gradoel=NULL,
       *v=NULL,*velo=NULL,*veloo=NULL,*cosb=NULL,dmin,tincfguess,
       *hel=NULL,*hfa=NULL,*auv=NULL,*adv=NULL,*bv=NULL,*sel=NULL,*gamma=NULL,
       *gradtfa=NULL,*gradtel=NULL,*umel=NULL,*cvfa=NULL,*gradpel=NULL,
       *eei=NULL,*ener=NULL,*thicke=NULL,*eme=NULL,c[9],*gradkfa=NULL,
       ptimef,*stn=NULL,*qfn=NULL,*hcel=NULL,*aua=NULL,a1,a2,a3,beta,
       *prop=NULL,*dp=NULL,*xxni=NULL,*xxnj=NULL,*xxicn=NULL,*xturb=NULL,
       *xmach=NULL,*xkappa=NULL,urelax,*flux=NULL,velnormo[5],velnorm[5],
       relnormt,relnormv,relnormp,relnormmax=1.e30,*temp=NULL,*auv6=NULL,
       *adv6=NULL,*auv3=NULL,*bv3=NULL,*vela=NULL,*velaa=NULL,
       *gradofa=NULL,betam=0.1,*gradpfa=NULL;
 
   double tol,*rgwk=NULL,err,*sb=NULL,*sx=NULL,*rwork=NULL,*rf=NULL;
 
   FILE *f1;
 
   co=*cop;
   ipkonf=*ipkonfp;lakonf=*lakonfp;
   nelemface=*nelemfacep;sideface=*sidefacep;
   vold=*voldp;inomat=*inomatp;
 
 #ifdef SGI
   ITG token;
 #endif
       
   strcpy(fncvg,jobnamec);
   strcat(fncvg,"f.cvg");
 
   if((f1=fopen(fncvg,"w"))==NULL){
 //  if((f1=fopen("fluidconvergence","w"))==NULL){
       printf("*ERROR in compfluid: cannot open cvg file for writing...");
       exit(0);
   }
   fprintf(f1,"temperature    velocity    pressure\n\n");
 
   urelax=.2;
 
   /* relative time at the end of the mechanical increment */
 
   reltime=(*time)/(*tper);
 
   /* open frd-file for fluids */
 
   FORTRAN(openfilefluid,(jobnamef));
 
   /* variables for multithreading procedure */
 
   ITG sys_cpus;
   char *env,*envloc,*envsys;
       
   num_cpus = 0;
   sys_cpus=0;
   
   /* explicit user declaration prevails */
   
   envsys=getenv("NUMBER_OF_CPUS");
   if(envsys){
       sys_cpus=atoi(envsys);
       if(sys_cpus<0) sys_cpus=0;
   }
   
   /* automatic detection of available number of processors */
   
   if(sys_cpus==0){
       sys_cpus = getSystemCPUs();
       if(sys_cpus<1) sys_cpus=1;
   }
   
   /* local declaration prevails, if strictly positive */
   
   envloc = getenv("CCX_NPROC_CFD");
   if(envloc){
       num_cpus=atoi(envloc);
       if(num_cpus<0){
       num_cpus=0;
       }else if(num_cpus>sys_cpus){
       num_cpus=sys_cpus;
       }
   }
   
   /* else global declaration, if any, applies */
   
   env = getenv("OMP_NUM_THREADS");
   if(num_cpus==0){
       if (env)
       num_cpus = atoi(env);
       if (num_cpus < 1) {
       num_cpus=1;
       }else if(num_cpus>sys_cpus){
       num_cpus=sys_cpus;
       }
   }
   
 // next line is to be inserted in a similar way for all other paralell parts
   
   if(*nef<num_cpus) num_cpus=*nef;
   
   printf(" Using up to %" ITGFORMAT " cpu(s) for CFD.\n", num_cpus);
   
   pthread_t tid[num_cpus];
 
   
   kode=0;
   
   /*  *iexpl==0:  structure:implicit, fluid:incompressible
       *iexpl==1:  structure:implicit, fluid:compressible
       *iexpl==2:  structure:explicit, fluid:incompressible
       *iexpl==3:  structure:explicit, fluid:compressible */
 
   if((*iexpl==1)||(*iexpl==3)){
       compressible=1;
   }else{
       compressible=0;
   }
 
   /* if initial conditions are specified for the temperature, 
      it is assumed that the temperature is an unknown */
 
   ithermalref=*ithermal;
   if(*ithermal==1){
     *ithermal=2;
   }
 
   /* determining the matrix structure */
   
   NNEW(ipointer,ITG,*nef);
   NNEW(mast1,ITG,nzs);
   NNEW(irow,ITG,nzs);
   NNEW(icol,ITG,*nef);
   NNEW(jq,ITG,*nef+1);
 
   mastructf(nk,konf,ipkonf,lakonf,nef,icol,jq,&mast1,&irow,
         isolver,ipointer,&nzs,ipnei,neiel,mi);
 
   SFREE(ipointer);SFREE(mast1);
  
   NNEW(iau6,ITG,6**nef);
   FORTRAN(create_iau6,(nef,ipnei,neiel,jq,irow,&nzs,iau6,lakonf));
 
   NNEW(neielcp,ITG,*nflnei);
   FORTRAN(fill_neiel,(nef,ipnei,neiel,neielcp));
           
   if(compressible!=1){
       NNEW(ia,ITG,nzs+*nef);
       NNEW(ja,ITG,*nef+1);
       NNEW(aua,double,nzs+*nef);
       FORTRAN(preconvert2slapcol,(irow,ia,jq,ja,&nzs,nef));
   }
 
   /* calculation geometric data */
 
   NNEW(coel,double,3**nef);
   NNEW(volume,double,*nef);
   NNEW(cosa,double,*nflnei);
   NNEW(cosb,double,*nflnei);
   NNEW(xxn,double,3**nflnei);
   NNEW(xxi,double,3**nflnei);
   NNEW(xxj,double,3**nflnei);
   NNEW(xxni,double,3**nflnei);
   NNEW(xxicn,double,3**nflnei);
   NNEW(xxnj,double,3**nflnei);
   NNEW(xle,double,*nflnei);
   NNEW(xlen,double,*nflnei);
   NNEW(xlet,double,*nflnei);
   NNEW(cofa,double,3**nface);
   NNEW(area,double,*nface);
   NNEW(xrlfa,double,3**nface);
   NNEW(rf,double,3**nface);
   if(*iturbulent>0) NNEW(dy,double,*nsolidsurf);
 
   FORTRAN(initialcfd,(nef,ipkonf,konf,lakonf,co,coel,cofa,nface,
       ielfa,area,ipnei,neiel,xxn,xxi,xle,xlen,xlet,xrlfa,cosa,
       volume,neifa,xxj,cosb,&dmin,ifatie,cs,tieset,&icyclic,c,
       neij,physcon,isolidsurf,nsolidsurf,dy,xxni,xxnj,xxicn,
       nflnei,iturbulent,rf));
 
 //  SFREE(xxj);
 
   /* storing pointers to the boundary conditions in ielfa */
 
   NNEW(ifabou,ITG,7**nfaext);
   FORTRAN(applyboun,(ifaext,nfaext,ielfa,ikboun,ilboun,
        nboun,typeboun,nelemload,nload,sideload,isolidsurf,nsolidsurf,
        ifabou,&nfabou,nface,nodeboun,ndirboun,ikmpc,ilmpc,labmpc,nmpc,
        nactdohinv,&compressible,&iatleastonepressurebc,ipkonf,kon,konf,
        nblk));
   RENEW(ifabou,ITG,nfabou);
 
   /* catalogueing the nodes for output purposes (interpolation at
      the nodes */
   
   NNEW(iponofa,ITG,*nk);
   NNEW(inofa,ITG,2**nface*4);
 
   FORTRAN(cataloguenodes,(iponofa,inofa,&ifreefa,ielfa,ifabou,ipkonf,
               konf,lakonf,nface,nk));
 
   RENEW(inofa,ITG,2*ifreefa);
 
   /* material properties for athermal calculations 
      = calculation for which no initial thermal conditions
      were defined */
 
   NNEW(umfa,double,*nface);
   NNEW(umel,double,*nef);
   
   if(*ithermal==0){
       
       /* athermal incompressible calculations */
 
       /* calculating the dynamic viscosity at the element centers */
       
       FORTRAN(calcumel,(nef,vel,shcon,nshcon,ielmatf,ntmat_,
                 ithermal,mi,umel));
 
   }
 
 
   if(*ithermal!=0){
       NNEW(hcfa,double,*nface);
       NNEW(cvel,double,*nef);
       NNEW(cvfa,double,*nface);
   }
 
   if(*nbody>0) NNEW(body,double,4**nef);
 
   /* v is a auxiliary field: set to zero for the calls to
      tempload */
 
   NNEW(v,double,5**nk);
 
   /* next section is for stationary calculations */
   
   if(*nmethod==1){
       
       /* boundary conditions at the end of the mechanical
      increment */
       
       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,v,itg,ntg,amname,ikboun,ilboun,nelemload,sideload,mi,
          ntrans,trab,inotr,vold,integerglob,doubleglob,tieset,istartset,
              iendset,ialset,ntie,nmpc,ipompc,ikmpc,ilmpc,nodempc,coefmpc,
              ipobody,iponoel,inoel));
 
       /* body forces (gravity, centrifugal and Coriolis forces */
 
       if(*nbody>0){
       FORTRAN(inicalcbody,(nef,body,ipobody,ibody,xbody,coel,vel,lakonf,
                             nactdohinv,&icent));
       }
   }
 
   /* extrapolating the velocity from the elements centers to the face
      centers, thereby taking the boundary conditions into account */
 
   NNEW(gradvel,double,9**nef);
   NNEW(gradvfa,double,9**nface);
 
   FORTRAN(extrapol_vel,(nface,ielfa,xrlfa,vel,vfa,
        ifabou,xbounact,ipnei,nef,&icyclic,c,ifatie,xxn,gradvel,
        gradvfa,neifa,rf,area,volume,xle,xxi,xxj,xlet,
        coefmpc,nmpc,labmpc,ipompc,nodempc,ifaext,nfaext,nactdoh));
 
   /* extrapolation of the pressure at the element centers
      to the face centers */
 
   NNEW(gradpel,double,3**nef);
   NNEW(gradpfa,double,3**nface);
 
   FORTRAN(extrapol_pel,(nface,ielfa,xrlfa,vel,vfa,
        ifabou,xbounact,nef,gradpel,gradpfa,neifa,rf,area,volume,
        xle,xxi,&icyclic,xxn,ipnei,ifatie,
        coefmpc,nmpc,labmpc,ipompc,nodempc,ifaext,nfaext,nactdoh));
 
   /* extrapolation of the temperature at the element centers
      to the face centers */
 
   if(*ithermal>0){
 
       NNEW(gradtel,double,3**nef);
       NNEW(gradtfa,double,3**nface);
 
       FORTRAN(extrapol_tel,(nface,ielfa,xrlfa,vel,vfa,
        ifabou,xbounact,nef,gradtel,gradtfa,neifa,rf,area,volume,
        xle,xxi,&icyclic,xxn,ipnei,ifatie,xload,xlet,xxj,
        coefmpc,nmpc,labmpc,ipompc,nodempc,ifaext,nfaext,nactdoh));
       
       /* calculating the heat conduction at the face centers */
       
       FORTRAN(calchcfa,(nface,vfa,cocon,ncocon,ielmatf,ntmat_,
             mi,ielfa,hcfa));
 
       if(compressible!=1){
       
       /* calculating the specific heat at constant volume at the 
          face centers (secant value) */
       
       FORTRAN(calccvfa,(nface,vfa,shcon,nshcon,ielmatf,ntmat_,
                 mi,ielfa,cvfa,physcon));
       }else{
 
       /* calculating the specific heat at constant volume at the 
          face centers (secant value) */
       
       FORTRAN(calccvfacomp,(nface,vfa,shcon,nshcon,ielmatf,ntmat_,
                 mi,ielfa,cvfa,physcon));
       }
   }
 
   NNEW(flux,double,6**nef);
       
   if(compressible!=1){
 
       /* calculating the density at the element centers */
       
       FORTRAN(calcrhoel,(nef,vel,rhcon,nrhcon,ielmatf,ntmat_,
              ithermal,mi));
       
       /* calculating the density at the face centers */
       
       FORTRAN(calcrhofa,(nface,vfa,rhcon,nrhcon,ielmatf,ntmat_,
              ithermal,mi,ielfa));
 
   }else{
 
       /* calculating the density at the element centers */
       
       FORTRAN(calcrhoelcomp,(nef,vel,shcon,ielmatf,ntmat_,
                  mi));
       
       /* calculating the density at the face centers */
       
       FORTRAN(calcrhofacomp,(nface,vfa,shcon,ielmatf,ntmat_,
           mi,ielfa,ipnei,vel,nef,flux,gradpel,gradtel,xxj,
           &betam,xlet));
 
   }
   
   /* calculating the initial mass flux */
 
   FORTRAN(calcinitialflux,(area,vfa,xxn,ipnei,nef,neifa,lakonf,flux));
 
   /* calculating the dynamic viscosity at the face centers */
   
   FORTRAN(calcumfa,(nface,vfa,shcon,nshcon,ielmatf,ntmat_,
             ithermal,mi,ielfa,umfa));
 
   /* extrapolation of the turbulence variables at the element centers
      to the face centers */
 
   if(*iturbulent>0){
 
       NNEW(gradkel,double,3**nef);
       NNEW(gradkfa,double,3**nface);
       NNEW(gradoel,double,3**nef);
       NNEW(gradofa,double,3**nface);
 
       DMEMSET(vel,7**nef,8**nef,1.);
 
       FORTRAN(extrapol_kel,(nface,ielfa,xrlfa,vel,vfa,
        ifabou,xbounact,nef,gradkel,gradkfa,neifa,rf,area,volume,
        xle,xxi,&icyclic,xxn,ipnei,ifatie,xlet,xxj,
        coefmpc,nmpc,labmpc,ipompc,nodempc,ifaext,nfaext,nactdoh,
        umfa,physcon));
 
       FORTRAN(extrapol_oel,(nface,ielfa,xrlfa,vel,vfa,
        ifabou,xbounact,nef,gradoel,gradofa,neifa,rf,area,volume,
        xle,xxi,&icyclic,xxn,ipnei,ifatie,xlet,xxj,
        coefmpc,nmpc,labmpc,ipompc,nodempc,ifaext,nfaext,nactdoh,
        umfa,physcon,dy));
 
   }
 
   /* calculating the time increment */
 
   FORTRAN(calcguesstincf,(nface,&dmin,vfa,umfa,cvfa,hcfa,ithermal,&tincfguess,
                           &compressible));
 
   /* start of the major loop */
 
   NNEW(advfa,double,*nface);
   NNEW(hfa,double,3**nface);
 
   NNEW(ap,double,*nface);
   NNEW(bp,double,*nface);
 
   NNEW(au,double,*nflnei+*nef);
   NNEW(ad,double,*nef);
   NNEW(b,double,*nef);
 
   if(*nblk!=0){
       NNEW(auv6,double,6**nef);
       NNEW(adv6,double,6**nef);
       NNEW(auv3,double,3**nef);
       NNEW(bv3,double,3**nef);
       NNEW(vela,double,8**nef);
       NNEW(velaa,double,8**nef);
   }else{
       NNEW(auv,double,*nflnei+*nef);
   }
 
   NNEW(bv,double,3**nef);
   NNEW(hel,double,3**nef);
   NNEW(sel,double,3**nef);
 
   NNEW(rwork,double,*nef);
 
   NNEW(inum,ITG,*nk);
 
   NNEW(velo,double,8**nef);
   if((compressible==0)&&(*nblk==0)) NNEW(veloo,double,8**nef);
 
   /* initializing velo and veloo */
 
   if((compressible==0)&&(*nblk==0)) memcpy(&veloo[0],&vel[0],sizeof(double)*8**nef);
   memcpy(&velo[0],&vel[0],sizeof(double)*8**nef);
 
   /* check output requests */
 
   if((strcmp1(&filab[1914],"MACH")==0)||
      (strcmp1(&filab[3132],"PTF")==0)||
      (strcmp1(&filab[3219],"TTF")==0)){
       imach=1;
   }
   
   if((strcmp1(&filab[3132],"PTF")==0)||
      (strcmp1(&filab[3219],"TTF")==0)){
       ikappa=1;
   }
   
   if(strcmp1(&filab[2088],"TURB")==0){
       iturb=1;
   }
   
   for(i=0;i<*nprint;i++){
       if(imach==0){
       if((strcmp1(&prlab[6*i],"MACH")==0)||
          (strcmp1(&prlab[6*i],"PTF")==0)||
          (strcmp1(&prlab[6*i],"TTF")==0)){
           imach=1;
       }
       }
       if(ikappa==0){
       if((strcmp1(&prlab[6*i],"PTF")==0)||
          (strcmp1(&prlab[6*i],"TTF")==0)){
           ikappa=1;
       }
       }
       if(iturb==0){
       if(strcmp1(&prlab[6*i],"TURB")==0){
           iturb=1;
       }
       }
   }
 
   iincf=0;
 
   if(*tincf<=0.) *tincf=tincfguess;
   printf("time increment for the CFD-calculations = %e\n\n",*tincf);
 
   ttimef=*ttime;
   timef=*time-*dtime;
   dtimef=*tincf;
 
   if(*nblk==0){
       a1=1.5/dtimef;
       a2=-2./dtimef;
       a3=0.5/dtimef;
   }else{
       a1=1./dtimef;
       a2=-a1;
   }
 
   NNEW(temp,double,6**nef);
   NNEW(gamma,double,*nface);
 
   do{
 
       iincf++;
 
       printf("fluid increment = %d\n",iincf);
 
       timef+=dtimef;
       if((*time<timef)&&(*nmethod==4)){
       dtimef-=(timef-*time);
       timef=*time;
       last=1;
       beta=dtimef/(*tincf);
       a1=(2.+beta)/(1.+beta);
       a2=-(1.+beta)/beta;
       a3=1./(beta*(1.+beta));
       }
 
       /* starting iterations till convergence of the fluid increment */
 
       iit=0;
       for(i=0;i<5;i++){velnormo[i]=0;}
       FORTRAN(norm,(vel,velnormo,nef));
       
       do{
       iit++;
 
       printf("      iteration = %d\n",iit);
 
       /* conditions for transient calculations */
      
       if(*nmethod==4){
 
           /* boundary conditions at end of fluid increment */
 
       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,&timef,&reltimef,&ttimef,&dtimef,ithermal,nmethod,
              xbounold,xboun,xbounact,iamboun,nboun,
              nodeboun,ndirboun,nodeforc,ndirforc,istep,iinc,
          co,v,itg,ntg,amname,ikboun,ilboun,nelemload,sideload,mi,
              ntrans,trab,inotr,vold,integerglob,doubleglob,tieset,istartset,
              iendset,ialset,ntie,nmpc,ipompc,ikmpc,ilmpc,nodempc,coefmpc,
              ipobody,iponoel,inoel));
 
       /* body forces (gravity, centrifugal and Coriolis forces) */
       
       if(*nbody>0){
           FORTRAN(calcbody,(nef,body,ipobody,ibody,xbody,coel,vel,lakonf,
                 nactdohinv));
       }
 
       }else if(icent==1){
       
       /* body forces (gravity, centrifugal and Coriolis forces;
              only if centrifugal forces are active => the ensuing
              Coriolis forces depend on the actual velocity) */
       
       FORTRAN(calcbody,(nef,body,ipobody,ibody,xbody,coel,vel,lakonf,
                 nactdohinv));
       }
 
       /* updating of the material properties */
 
       if(*ithermal>0){
       
 
       if(compressible!=1){
 
           /* calculating material data 
          density (elements+faces)
          heat capacity at constant volume (elements+faces)
          dynamic viscosity (elements+faces)
          heat conduction (faces) */
 
           FORTRAN(materialdata_cfd,(nef,vel,shcon,nshcon,ielmatf,
               ntmat_,mi,cvel,vfa,cocon,ncocon,physcon,cvfa,
               ithermal,nface,umel,umfa,ielfa,hcfa,rhcon,nrhcon));
 
       }else{
 
           /* calculating material data 
          heat capacity at constant volume (elements+faces)
          dynamic viscosity (elements+faces)
          heat conduction (faces) */
 
           FORTRAN(materialdata_cfd_comp,(nef,vel,shcon,nshcon,ielmatf,
               ntmat_,mi,cvel,vfa,cocon,ncocon,physcon,cvfa,
                       ithermal,nface,umel,umfa,ielfa,hcfa));
       }
 
       }
 
       if(*nblk==0){
 
       /* filling the lhs and rhs's for the balance of momentum
      equations */
       
       DMEMSET(auv,0,*nflnei+*nef,0.);
       DMEMSET(bv,0,3**nef,0.);
       
       if(compressible==0){
       
               /* calculate gamma (Ph.D. Thesis Jasak) */
 
           FORTRAN(calcgamma,(nface,ielfa,vel,gradvel,gamma,xlet,xxn,xxj,
           ipnei,&betam,nef,flux));
           
           mafillvmain(nef,ipnei,neifa,neiel,vfa,xxn,area,
                auv,&auv[*nflnei],jq,irow,&nzs,bv,vel,cosa,umfa,
                xlet,xle,gradvfa,xxi,
                body,volume,ielfa,lakonf,ifabou,nbody,
                &dtimef,velo,veloo,sel,xrlfa,gamma,xxj,nactdohinv,&a1,
                &a2,&a3,flux,&icyclic,c,ifatie,iau6,xxni,xxnj,
               iturbulent,gradvel);
           
       }else{
       
               /* calculate gamma (Ph.D. Thesis Jasak) */
 
 //        FORTRAN(calcgamma,(nface,ielfa,vel,gradvel,gamma,xlet,xxn,xxj,
 //               ipnei,&betam,nef,flux));
           
           mafillvcompmain(nef,ipnei,neifa,neiel,vfa,xxn,area,
                auv,&auv[*nflnei],jq,irow,&nzs,bv,vel,cosa,umfa,
                        xlet,xle,gradvfa,xxi,
                body,volume,ielfa,lakonf,ifabou,nbody,
                &dtimef,velo,veloo,sel,xrlfa,gamma,xxj,nactdohinv,&a1,
                &a2,&a3,flux,&icyclic,c,ifatie,iau6,xxni,xxnj);
       }
 
       isym=0;
       nelt=*nflnei+*nef;
       lrgw=131+16**nef;
       NNEW(rgwk,double,lrgw);
       NNEW(igwk,ITG,20);
       for(i=0;i<*nef;i++){rwork[i]=1./auv[*nflnei+i];}
 
 //      if(compressible==0) memcpy(&temp[*nef],&vel[*nef],sizeof(double)*3**nef);
       memcpy(&temp[*nef],&vel[*nef],sizeof(double)*3**nef);
 
       /* estimate of new solution */
 
       FORTRAN(predgmres,(nef,&bv[0],&vel[*nef],&nelt,neielcp,ipnei,auv,
               &isym,&itol,&tol,&itmax,&iter,
                       &err,&ierr,&iunit,sb,sx,rgwk,&lrgw,igwk,
                       &ligw,rwork,iwork));
       if(ierr>0){
           printf("*WARNING in compfluid: error message from predgmres (v_x)=%d\n",ierr);
       }
       FORTRAN(predgmres,(nef,&bv[*nef],&vel[2**nef],&nelt,neielcp,ipnei,auv,
               &isym,&itol,&tol,&itmax,&iter,
                       &err,&ierr,&iunit,sb,sx,rgwk,&lrgw,igwk,
                       &ligw,rwork,iwork));
       if(ierr>0){
           printf("*WARNING in compfluid: error message from predgmres (v_y)=%d\n",ierr);
       }
       FORTRAN(predgmres,(nef,&bv[2**nef],&vel[3**nef],&nelt,neielcp,ipnei,auv,
               &isym,&itol,&tol,&itmax,&iter,
                       &err,&ierr,&iunit,sb,sx,rgwk,&lrgw,igwk,
                       &ligw,rwork,iwork));
       if(ierr>0){
           printf("*WARNING in compfluid: error message from predgmres (v_z)=%d\n",ierr);
       }
       SFREE(rgwk);SFREE(igwk);
 
 //      if(compressible==0)for(i=*nef;i<4**nef;i++){vel[i]=0.8*vel[i]+0.2*temp[i];}
       for(i=*nef;i<4**nef;i++){vel[i]=0.8*vel[i]+0.2*temp[i];}
 
       }else{
 
           /* BLOCK structure */
 
       }
 
       /* calculating the pressure gradient at the element
          centers */
       
       if(compressible==1){
 //    jit=100;
       jit=4;
       }else{
 //    jit=1;
       jit=2;
       }
 
       for(iitf=0;iitf<jit;iitf++){
 
       memcpy(&hel[0],&sel[0],sizeof(double)*(3**nef));
       
           /* completing hel with the neighboring velocity contributions */
 
       if(*nblk==0){
           if(icyclic==0){
           FORTRAN(complete_hel,(nef,&vel[*nef],hel,&auv[*nflnei],auv,ipnei,neiel,&nzs));
           }else{
           FORTRAN(complete_hel_cyclic,(nef,&vel[*nef],hel,&auv[*nflnei],auv,jq,
               irow,ipnei,neiel,ifatie,c,lakonf,neifa,&nzs));
           }
       }else{
           if(icyclic==0){
           FORTRAN(complete_hel_blk,(vel,hel,auv6,ipnei,neiel,nef,nactdohinv));
           }else{
           FORTRAN(complete_hel_cyclic_blk,(vel,hel,auv6,c,ipnei,neiel,
                            neifa,ifatie,nef));
           }
       }
       
       /* generating ad and h at the face centers (advfa and hfa) */
       
       if(compressible!=1){
           FORTRAN(extrapolate_ad_h,(nface,ielfa,xrlfa,&auv[*nflnei],advfa,hel,hfa,
                                         &icyclic,c,ifatie));
       }else{
           FORTRAN(extrapolate_ad_h_comp,(nface,ielfa,xrlfa,&auv[*nflnei],advfa,hel,
                          hfa,&icyclic,c,ifatie));
       }
       
       /* calculating the lhs and rhs of the equation system to determine
          p (balance of mass) */
       
       DMEMSET(b,0,*nef,0.);
 
       if(compressible!=1){
 
           /* incompressible media */
 
           if(iitf==0){
           
           /* first iteration: calculating both lhs and rhs */
           
           DMEMSET(ad,0,*nef,0.);
           DMEMSET(au,0,nzs,0.);
           
           mafillpmain(nef,lakonf,ipnei,neifa,neiel,vfa,area,
                    advfa,xlet,cosa,volume,au,ad,jq,irow,ap,
                    ielfa,ifabou,xle,b,xxn,nef,
                    &nzs,hfa,gradpel,bp,xxi,neij,xlen,cosb,
                        &iatleastonepressurebc,iau6,xxicn);
 
           FORTRAN(convert2slapcol,(au,ad,jq,&nzs,nef,aua));
           
           }else{
           
           /* second, third.. iteration: calculate the rhs only */
           
           rhspmain(nef,lakonf,ipnei,neifa,neiel,vfa,area,
                advfa,xlet,cosa,volume,au,ad,jq,irow,ap,ielfa,ifabou,xle,
                b,xxn,nef,&nzs,hfa,gradpel,bp,xxi,neij,xlen,
                &iatleastonepressurebc,xxicn);
           
           }
 
           
           nelt=nzs+*nef;
           isym=1;
 
           /* next line was changed from 10 to 3 on 22.12.2016 */
 
           nsave=3;
           itol=0;
           tol=1.e-6;
 
           /* next line was changed from 110 to 10 on 22.12.2016 */
 
           itmax=10;
           iunit=0;
           lenw=131+17**nef+2*nelt;
           NNEW(rgwk,double,lenw);
           leniw=32+4**nef+2*nelt;
           NNEW(igwk,ITG,leniw);
 
           memcpy(&temp[4**nef],&vel[4**nef],sizeof(double)**nef);
       
           FORTRAN(dslugm,(nef,&b[0],&vel[4**nef],&nelt,ia,ja,aua,
                   &isym,&nsave,&itol,&tol,&itmax,&iter,
                   &err,&ierr,&iunit,rgwk,&lenw,igwk,&leniw));
                   SFREE(rgwk);SFREE(igwk);
 
           for(i=4**nef;i<5**nef;i++){vel[i]=0.3*vel[i]+0.7*temp[i];}
           
           /* extrapolation of the pressure at the element centers
          to the face centers */
           
       }else{
           
           /* compressible media */
           
           DMEMSET(au,0,*nflnei+*nef,0.);
       
           /* calculate gamma (Ph.D. Thesis Jasak) */
           
 //        FORTRAN(calcgammap,(nface,ielfa,vel,gradtel,gamma,xlet,xxn,xxj,
 //                ipnei,&betam,nef,flux));
           
           mafillpcompmain(nef,lakonf,ipnei,neifa,neiel,vfa,area,
               advfa,xlet,cosa,volume,au,&au[*nflnei],jq,irow,ap,
               ielfa,ifabou,xle,b,xxn,nef,
               &nzs,hfa,gradpel,bp,xxi,neij,xlen,cosb,
               ielmatf,mi,&a1,&a2,&a3,velo,veloo,&dtimef,shcon,
               ntmat_,vel,nactdohinv,xrlfa,flux,iau6,xxicn,
                           gamma);
           
           isym=0;
           nelt=*nflnei+*nef;
           lrgw=131+16**nef;
           NNEW(rgwk,double,lrgw);
           NNEW(igwk,ITG,20);
           for(i=0;i<*nef;i++){rwork[i]=1./au[*nflnei+i];}
 
           NNEW(dp,double,*nef);
           FORTRAN(predgmres,(nef,&b[0],dp,&nelt,neielcp,ipnei,au,
                  &isym,&itol,&tol,&itmax,&iter,
                  &err,&ierr,&iunit,sb,sx,rgwk,&lrgw,igwk,
                  &ligw,rwork,iwork));
           
           for(i=0;i<*nef;i++){
 //        vel[4**nef+i]+=0.2*dp[i];
           vel[4**nef+i]+=0.3*dp[i];
           }
           SFREE(dp);
 
           SFREE(rgwk);SFREE(igwk);
           if(ierr>0){
           printf("*WARNING in compfluid: error message from predgmres (p)=%d\n",ierr);
           }
           
       }
 
           FORTRAN(extrapol_pel,(nface,ielfa,xrlfa,vel,vfa,
                   ifabou,xbounact,nef,gradpel,gradpfa,neifa,rf,area,volume,
                   xle,xxi,&icyclic,xxn,ipnei,ifatie,
                   coefmpc,nmpc,labmpc,ipompc,nodempc,ifaext,nfaext,nactdoh));
       
       /* correction of the velocity at the element centers due
              to the pressure change */
 
       FORTRAN(correctvel,(hel,&auv[*nflnei],vfa,ipnei,area,&vel[*nef],xxn,neifa,
                   lakonf,nef,nef));
 
       if(compressible!=0){
           if((iitf<jit-1)&&((relnormmax>=1.e-5)||(iitf<1))){
           
           FORTRAN(correctvfa,(nface,ielfa,area,vfa,ap,bp,xxn,
                       ifabou,ipnei,nef,neifa,hfa,vel,xbounact,lakonf,
                       flux));
           
           /* calculating the lhs and rhs of the energy equation */
           
           DMEMSET(au,0,*nflnei+*nef,0.);
           DMEMSET(b,0,*nef,0.);
       
           /* calculate gamma (Ph.D. Thesis Jasak) */
 
 //        FORTRAN(calcgammat,(nface,ielfa,vel,gradtel,gamma,xlet,xxn,xxj,
 //                ipnei,&betam,nef,flux));
           
           mafilltcompmain(nef,ipnei,neifa,neiel,vfa,xxn,area,
                   au,&au[*nflnei],jq,irow,&nzs,b,vel,umel,xlet,
                                   xle,gradtfa,xxi,
                   body,volume,ielfa,lakonf,ifabou,nbody,nef,
                   &dtimef,velo,veloo,cvfa,hcfa,cvel,gradvel,
                                   xload,gamma,
                   xrlfa,xxj,nactdohinv,&a1,&a2,&a3,flux,iau6,
                                   xxni,xxnj);
           
           nelt=*nflnei+*nef;
           isym=0;
           lrgw=131+16**nef;
           NNEW(rgwk,double,lrgw);
           NNEW(igwk,ITG,20);
           for(i=0;i<*nef;i++){rwork[i]=1./au[*nflnei+i];}
           FORTRAN(predgmres,(nef,&b[0],&vel[0],&nelt,neielcp,ipnei,au,
                      &isym,&itol,&tol,&itmax,&iter,
                      &err,&ierr,&iunit,sb,sx,rgwk,&lrgw,igwk,
                      &ligw,rwork,iwork));
           SFREE(rgwk);SFREE(igwk);
           if(ierr>0){
               printf("*WARNING in compfluid: error message from predgmres (T)=%d\n",ierr);
           }
 
           FORTRAN(extrapol_tel,(nface,ielfa,xrlfa,vel,vfa,
               ifabou,xbounact,nef,gradtel,gradtfa,neifa,rf,area,volume,
               xle,xxi,&icyclic,xxn,ipnei,ifatie,xload,xlet,xxj,
               coefmpc,nmpc,labmpc,ipompc,nodempc,ifaext,nfaext,nactdoh));
           
           /* calculating the density at the element centers */
           
           FORTRAN(calcrhoelcomp,(nef,vel,shcon,ielmatf,ntmat_,
                      mi));
 
           /* calculating the density at the face centers
                      (gamma method) */
           
           FORTRAN(calcrhofacomp,(nface,vfa,shcon,ielmatf,ntmat_,
               mi,ielfa,ipnei,vel,nef,flux,gradpel,gradtel,xxj,
               &betam,xlet));
           
           for(i=0;i<5;i++){velnorm[i]=0;}
           FORTRAN(norm,(vel,velnorm,nef));
           
           relnormt=0.;
           relnormv=0.;
           relnormp=0.;
           relnormmax=0.;
           
           if(*ithermal!=0){
               if(velnorm[0]/(*nef)>1.e-10){
               relnormt=fabs(velnorm[0]-velnormo[0])/(velnormo[0]);
               if(relnormt>relnormmax) relnormmax=relnormt;
               }
           }
           if((velnorm[1]+velnorm[2]+velnorm[3])/(*nef)>1.e-10){
               relnormv=fabs(velnorm[1]+velnorm[2]+velnorm[3]-velnormo[1]-velnormo[2]-velnormo[3])/(velnormo[1]+velnormo[2]+velnormo[3]);
               if(relnormv>relnormmax) relnormmax=relnormv;
           }
           if(velnorm[4]/(*nef)>1.e-10){
               relnormp=fabs(velnorm[4]-velnormo[4])/(velnormo[4]);
               if(relnormp>relnormmax) relnormmax=relnormp;
           }
           printf("%d %11.4e %11.4e %11.4e\n",iitf,relnormt,relnormv,relnormp);
           
           memcpy(velnormo,velnorm,sizeof(double)*5);
           
           }
           else{break;}
       }
       
       }
 
       /* adding the velocity correction at the face centers
      due to the balance of mass =>
      the resulting mass flux is correct,
      the face velocity vectors are not necessarily
      needed for energy balance, balance of momentum and
          the turbulence equations
       */
       
       FORTRAN(correctvfa,(nface,ielfa,area,vfa,ap,bp,xxn,
               ifabou,ipnei,nef,neifa,hfa,vel,xbounact,lakonf,
               flux));
       
       if(*ithermal>0){
 
           /* calculating the lhs and rhs of the energy equation */
 
       DMEMSET(ad,0,*nef,0.);
       DMEMSET(au,0,*nflnei+*nef,0.);
       DMEMSET(b,0,*nef,0.);
 
       if(compressible==0){
       
              /* calculate gamma (Ph.D. Thesis Jasak) */
 
           FORTRAN(calcgammat,(nface,ielfa,vel,gradtel,gamma,xlet,xxn,xxj,
                   ipnei,&betam,nef,flux));
 
           mafilltmain(nef,ipnei,neifa,neiel,vfa,xxn,area,
            au,&au[*nflnei],jq,irow,&nzs,b,vel,umel,xlet,xle,gradtfa,xxi,
            body,volume,ielfa,lakonf,ifabou,nbody,nef,
            &dtimef,velo,veloo,cvfa,hcfa,cvel,gradvel,xload,gamma,
            xrlfa,xxj,nactdohinv,&a1,&a2,&a3,flux,iau6,xxni,xxnj,
                iturbulent);
 
       }else{
       
              /* calculate gamma (Ph.D. Thesis Jasak) */
 
 //        FORTRAN(calcgammat,(nface,ielfa,vel,gradtel,gamma,xlet,xxn,xxj,
 //                ipnei,&betam,nef,flux));
 
           mafilltcompmain(nef,ipnei,neifa,neiel,vfa,xxn,area,
            au,&au[*nflnei],jq,irow,&nzs,b,vel,umel,xlet,xle,gradtfa,xxi,
            body,volume,ielfa,lakonf,ifabou,nbody,nef,
            &dtimef,velo,veloo,cvfa,hcfa,cvel,gradvel,xload,gamma,
            xrlfa,xxj,nactdohinv,&a1,&a2,&a3,flux,iau6,xxni,xxnj);
       }
 
       isym=0;
       nelt=*nflnei+*nef;
       lrgw=131+16**nef;
       NNEW(rgwk,double,lrgw);
       NNEW(igwk,ITG,20);
       for(i=0;i<*nef;i++){rwork[i]=1./au[*nflnei+i];}
       FORTRAN(predgmres,(nef,&b[0],&vel[0],&nelt,neielcp,ipnei,au,
                  &isym,&itol,&tol,&itmax,&iter,
                  &err,&ierr,&iunit,sb,sx,rgwk,&lrgw,igwk,
                  &ligw,rwork,iwork));
       SFREE(rgwk);SFREE(igwk);
       if(ierr>0){
           printf("*WARNING in compfluid: error message from predgmres (T)=%d\n",ierr);
       }
 
       /* extrapolation of the temperature at the element centers
          to the face centers */
 
       FORTRAN(extrapol_tel,(nface,ielfa,xrlfa,vel,vfa,
           ifabou,xbounact,nef,gradtel,gradtfa,neifa,rf,area,volume,
           xle,xxi,&icyclic,xxn,ipnei,ifatie,xload,xlet,xxj,
           coefmpc,nmpc,labmpc,ipompc,nodempc,ifaext,nfaext,nactdoh));
 
           /* recalculating the density for compressible materials */
 
       if(compressible!=0){
           
           /* calculating the density at the element centers */
       
           FORTRAN(calcrhoelcomp,(nef,vel,shcon,ielmatf,ntmat_,
                  mi));
       
           /* calculating the density at the face centers 
                  (gamma method) */
       
           FORTRAN(calcrhofacomp,(nface,vfa,shcon,ielmatf,ntmat_,
           mi,ielfa,ipnei,vel,nef,flux,gradpel,gradtel,xxj,
           &betam,xlet));
 
       }
 
       }
       
       if(*iturbulent>0){
 
           /* calculating the lhs and rhs of the k-equation */
 
       DMEMSET(au,0,*nflnei+*nef,0.);
       DMEMSET(b,0,*nef,0.);
       
           /* calculate gamma (Ph.D. Thesis Jasak) */
 
       FORTRAN(calcgammak,(nface,ielfa,vel,gradkel,gamma,xlet,xxn,xxj,
                   ipnei,&betam,nef,flux));
 
       if(compressible==0){
           mafillkmain(nef,ipnei,neifa,neiel,vfa,xxn,area,
            au,&au[*nflnei],jq,irow,&nzs,b,vel,umfa,xlet,xle,gradkfa,xxi,
            body,volume,ielfa,lakonf,ifabou,nbody,nef,
            &dtimef,velo,veloo,cvfa,hcfa,cvel,gradvel,xload,gamma,
            xrlfa,xxj,nactdohinv,&a1,&a2,&a3,flux,iau6,xxni,xxnj,
                iturbulent);
       }else{
           mafilltcompmain(nef,ipnei,neifa,neiel,vfa,xxn,area,
            au,&au[*nflnei],jq,irow,&nzs,b,vel,umel,xlet,xle,gradtfa,xxi,
            body,volume,ielfa,lakonf,ifabou,nbody,nef,
            &dtimef,velo,veloo,cvfa,hcfa,cvel,gradvel,xload,gamma,
            xrlfa,xxj,nactdohinv,&a1,&a2,&a3,flux,iau6,xxni,xxnj);
       }
 
       isym=0;
       nelt=*nflnei+*nef;
       lrgw=131+16**nef;
       NNEW(rgwk,double,lrgw);
       NNEW(igwk,ITG,20);
       for(i=0;i<*nef;i++){rwork[i]=1./au[*nflnei+i];}
       memcpy(&temp[0],&vel[6**nef],sizeof(double)**nef);
       FORTRAN(predgmres,(nef,&b[0],&temp[0],&nelt,neielcp,ipnei,au,
                  &isym,&itol,&tol,&itmax,&iter,
                  &err,&ierr,&iunit,sb,sx,rgwk,&lrgw,igwk,
                  &ligw,rwork,iwork));
       SFREE(rgwk);SFREE(igwk);
       if(ierr>0){
           printf("*WARNING in compfluid: error message from predgmres (k)=%d\n",ierr);
       }
 
           /* calculating the lhs and rhs of the omega-equation */
 
       DMEMSET(au,0,*nflnei+*nef,0.);
       DMEMSET(b,0,*nef,0.);
       
           /* calculate gamma (Ph.D. Thesis Jasak) */
 
       FORTRAN(calcgammao,(nface,ielfa,vel,gradoel,gamma,xlet,xxn,xxj,
                   ipnei,&betam,nef,flux));
 
       if(compressible==0){
           mafillomain(nef,ipnei,neifa,neiel,vfa,xxn,area,
            au,&au[*nflnei],jq,irow,&nzs,b,vel,umfa,xlet,xle,gradofa,xxi,
            body,volume,ielfa,lakonf,ifabou,nbody,nef,
            &dtimef,velo,veloo,cvfa,hcfa,cvel,gradvel,xload,gamma,
            xrlfa,xxj,nactdohinv,&a1,&a2,&a3,flux,iau6,xxni,xxnj,
            iturbulent,gradkel,gradoel);
       }else{
           mafilltcompmain(nef,ipnei,neifa,neiel,vfa,xxn,area,
            au,&au[*nflnei],jq,irow,&nzs,b,vel,umel,xlet,xle,gradtfa,xxi,
            body,volume,ielfa,lakonf,ifabou,nbody,nef,
            &dtimef,velo,veloo,cvfa,hcfa,cvel,gradvel,xload,gamma,
            xrlfa,xxj,nactdohinv,&a1,&a2,&a3,flux,iau6,xxni,xxnj);
       }
 
       isym=0;
       nelt=*nflnei+*nef;
       lrgw=131+16**nef;
       NNEW(rgwk,double,lrgw);
       NNEW(igwk,ITG,20);
       for(i=0;i<*nef;i++){rwork[i]=1./au[*nflnei+i];}
       FORTRAN(predgmres,(nef,&b[0],&vel[7**nef],&nelt,neielcp,ipnei,au,
                  &isym,&itol,&tol,&itmax,&iter,
                  &err,&ierr,&iunit,sb,sx,rgwk,&lrgw,igwk,
                  &ligw,rwork,iwork));
       SFREE(rgwk);SFREE(igwk);
       if(ierr>0){
           printf("*WARNING in compfluid: error message from predgmres (om)=%d\n",ierr);
       }
 
           /* storing the updated k-values into vel */
 
       memcpy(&vel[6**nef],&temp[0],sizeof(double)**nef);
 
       /* extrapolation of the turbulence variables at the element centers
          to the face centers */
 
       FORTRAN(extrapol_kel,(nface,ielfa,xrlfa,vel,vfa,
           ifabou,xbounact,nef,gradkel,gradkfa,neifa,rf,area,volume,
                   xle,xxi,&icyclic,xxn,ipnei,ifatie,xlet,xxj,
                   coefmpc,nmpc,labmpc,ipompc,nodempc,ifaext,nfaext,nactdoh,
                   umfa,physcon));
 
       FORTRAN(extrapol_oel,(nface,ielfa,xrlfa,vel,vfa,
                   ifabou,xbounact,nef,gradoel,gradofa,neifa,rf,area,volume,
                   xle,xxi,&icyclic,xxn,ipnei,ifatie,xlet,xxj,
                   coefmpc,nmpc,labmpc,ipompc,nodempc,ifaext,nfaext,nactdoh,
           umfa,physcon,dy));
 
       }
 
       /* extrapolating the velocity from the elements centers to the face
      centers, thereby taking the boundary conditions into account */
 
       FORTRAN(extrapol_vel,(nface,ielfa,xrlfa,vel,vfa,
               ifabou,xbounact,ipnei,nef,&icyclic,c,ifatie,xxn,gradvel,
               gradvfa,neifa,rf,area,volume,xle,xxi,xxj,xlet,
               coefmpc,nmpc,labmpc,ipompc,nodempc,ifaext,nfaext,nactdoh));
 
 //      FORTRAN(writevfa,(vfa,nface,nactdohinv,ielfa));
 
       /* end subiterations */
       
       for(i=0;i<5;i++){velnorm[i]=0;}
       FORTRAN(norm,(vel,velnorm,nef));
 
       relnormt=0.;
       relnormv=0.;
       relnormp=0.;
       relnormmax=0.;
 
       if(*ithermal!=0){
       if(velnorm[0]/(*nef)>1.e-10){
           relnormt=fabs(velnorm[0]-velnormo[0])/(velnormo[0]);
           if(relnormt>relnormmax) relnormmax=relnormt;
       }
       }
       if((velnorm[1]+velnorm[2]+velnorm[3])/(*nef)>1.e-10){
       relnormv=fabs(velnorm[1]+velnorm[2]+velnorm[3]-velnormo[1]-velnormo[2]-velnormo[3])/(velnormo[1]+velnormo[2]+velnormo[3]);
       if(relnormv>relnormmax) relnormmax=relnormv;
       }
       if(velnorm[4]/(*nef)>1.e-10){
       relnormp=fabs(velnorm[4]-velnormo[4])/(velnormo[4]);
       if(relnormp>relnormmax) relnormmax=relnormp;
       }
       if(iit==1){
       fprintf(f1,"%11.4e %11.4e %11.4e\n",relnormt,relnormv,relnormp);
       }
 
       memcpy(velnormo,velnorm,sizeof(double)*5);
 
       if((*nmethod==1)&&(compressible!=1)){
 
           /* steady state incompressible flow:
          calculate the velocity only once in each increment */
 
       if(relnormmax<1.e-10) iconvergence=1;
 //    if(relnormmax<1.e-5) iconvergence=1;
       break;
       }else{
 
           /* compressible flow: 
              calculate the velocity only once in each increment */
 
       if((compressible==1)&&(iit==1))break;
 
           /* incompressible transient flow:
              calculate the velocity repeatedly in each increment */
 
       if(relnormmax<1.e-3)break;
       }
 
       }while(1);
       
       if(((iincf/jout[1])*jout[1]==iincf)||(iconvergence==1)||
      (iincf==jmax[1])){
 
       /* calculating the stress and the heat flow at the
              integration points, if requested */
 
       if((strcmp1(&filab[3306],"SF  ")==0)||
              (strcmp1(&filab[3480],"SVF ")==0))isti=1;
           if(strcmp1(&filab[3393],"HFLF")==0)iqfx=1;
       for(i=0;i<*nprint;i++){
           if(strcmp1(&prlab[6*i],"SVF")==0) isti=1;
           if(strcmp1(&prlab[6*i],"HFLF")==0)iqfx=1;
       }
 
           /* calculating the heat conduction at the element centers */
 
       if(iqfx==1){
           NNEW(hcel,double,*nef);
           FORTRAN(calchcel,(vel,cocon,ncocon,ielmatf,ntmat_,mi,
                    hcel,nef));
       }
 
       /* calculating the stress and/or the heat flux at the
              element centers */
 
       if((isti==1)||(iqfx==1)){
           FORTRAN(calcstressheatflux,(sti,umel,gradvel,qfx,hcel,
                       gradtel,nef,&isti,&iqfx,mi));
           if(iqfx==1)SFREE(hcel);
       }
  
           /* extrapolating the stresses */
 
       if((strcmp1(&filab[3306],"SF  ")==0)||
              (strcmp1(&filab[3480],"SVF ")==0)){
           nfield=6;
           ndim=6;
           if((*norien>0)&&
                  ((strcmp1(&filab[3311],"L")==0)||(strcmp1(&filab[3485],"L")==0))){
           iorienglob=1;
           }else{
           iorienglob=0;
           }
           strcpy1(&cflag[0],&filab[2962],1);
           NNEW(stn,double,6**nk);
           FORTRAN(extrapolate,(sti,stn,ipkonf,inum,konf,lakonf,
               &nfield,nk,nef,mi,&ndim,orab,ielorienf,co,&iorienglob,
               cflag,vold,&force,ielmatf,thicke,ielpropf,prop));
       }
 
       /* extrapolating the heat flow */
 
       
       if(strcmp1(&filab[3393],"HFLF")==0){
           nfield=3;
           ndim=3;
           if((*norien>0)&&(strcmp1(&filab[3398],"L")==0)){
           iorienglob=1;
           }else{
           iorienglob=0;
           }
           strcpy1(&cflag[0],&filab[3049],1);
           NNEW(qfn,double,3**nk);
           FORTRAN(extrapolate,(qfx,qfn,ipkonf,inum,konf,lakonf,
               &nfield,nk,nef,mi,&ndim,orab,ielorienf,co,&iorienglob,
               cflag,vold,&force,ielmatf,thicke,ielpropf,prop));
       }
       
       /* extrapolating the facial values of the static temperature 
              and/or the velocity and/or the static pressure to the nodes */
 
       if(imach){NNEW(xmach,double,*nk);}
       if(ikappa){NNEW(xkappa,double,*nk);}
       if(iturb){NNEW(xturb,double,2**nk);}
 
       FORTRAN(extrapolatefluid,(nk,iponofa,inofa,inum,vfa,vold,ielfa,
                   ithermal,&imach,&ikappa,xmach,xkappa,shcon,nshcon,ntmat_,
           ielmatf,physcon,mi,&iturb,xturb));
 
           /* storing the results in dat-format */
 
       ptimef=ttimef+timef;
       FORTRAN(printoutfluid,(set,nset,istartset,iendset,ialset,nprint,
                  prlab,prset,ipkonf,lakonf,sti,eei,
                                  xstate,ener,mi,nstate_,co,konf,qfx,
                                  &ptimef,trab,inotr,ntrans,orab,ielorienf,
                                  norien,vold,ielmatf,
                                  thicke,eme,xturb,physcon,nactdoh,
                                  ielpropf,prop,xkappa,xmach,ithermal,
                                  orname));
 
           /* thermal flux and drag: storage in dat-format */
 
       FORTRAN(printoutface,(co,rhcon,nrhcon,ntmat_,vold,shcon,nshcon,
           cocon,ncocon,&compressible,istartset,iendset,ipkonf,
           lakonf,konf,
           ialset,prset,&ptimef,nset,set,nprint,prlab,ielmatf,mi,
           ithermal,nactdoh,&icfd,time,stn));
       
       /* storing the results in frd-format */
       
       FORTRAN(frdfluid,(co,nk,konf,ipkonf,lakonf,nef,vold,&kode,&timef,ielmatf,
                 matname,filab,inum,ntrans,inotr,trab,mi,istep,
                             stn,qfn,nactdohinv,xmach,xkappa,physcon,xturb));
 
 //    FORTRAN(writevfa,(vfa,nface,nactdohinv,ielfa));
 
       if((strcmp1(&filab[3306],"SF  ")==0)||
              (strcmp1(&filab[3480],"SVF ")==0)){SFREE(stn);}
       if(strcmp1(&filab[3393],"HFLF")==0){SFREE(qfn);}
 
       if(imach){SFREE(xmach);}
       if(ikappa){SFREE(xkappa);}
       if(iturb){SFREE(xturb);}
 
       }
       
       if(iincf==jmax[1]){
       printf("*INFO: maximum number of fluid increments reached\n\n");
       fclose(f1);
       FORTRAN(stop,());
       }
       if(last==1){
       printf("*INFO: mechanical time increment reached: time=%e\n\n",*dtime);
       fclose(f1);
       FORTRAN(stop,());
       }
       if(iconvergence==1){
       printf("*INFO: steady state reached\n\n");
       fclose(f1);
       FORTRAN(stop,());
       }
       
       
       if((compressible==0)&&(*nblk==0)) memcpy(&veloo[0],&velo[0],sizeof(double)*8**nef);
       memcpy(&velo[0],&vel[0],sizeof(double)*8**nef);
       
   }while(1);
   
   FORTRAN(closefilefluid,());
 
   SFREE(flux);
 
   if(compressible!=1){SFREE(ia);SFREE(ja);SFREE(aua);}
 
   SFREE(irow);SFREE(icol);SFREE(jq);SFREE(iau6);SFREE(neielcp);
   
   SFREE(coel);SFREE(cosa);SFREE(xxn);SFREE(xxi);SFREE(xle);SFREE(xlen);
   SFREE(xlet);SFREE(cofa);SFREE(area);SFREE(xrlfa);SFREE(volume);
   SFREE(cosb);SFREE(xxni);SFREE(xxnj);SFREE(xxicn);SFREE(xxj);
   SFREE(rf);
   if(*iturbulent>0) SFREE(dy);
 
   SFREE(ifabou);SFREE(umfa);SFREE(umel);
 
   SFREE(gradvel);SFREE(gradvfa);SFREE(au);SFREE(ad);SFREE(b);SFREE(advfa);
   SFREE(ap);SFREE(bp);SFREE(gradpel);SFREE(rwork);
   SFREE(hfa);SFREE(hel);SFREE(adv);SFREE(bv);SFREE(sel);
   if(*nblk!=0){
       SFREE(auv6);SFREE(adv6);SFREE(auv3);SFREE(bv3);
       SFREE(vela);SFREE(velaa);
   }else{
       SFREE(auv);
   }
 
   if(*ithermal>0){
       SFREE(gradtel);SFREE(gradtfa);SFREE(hcfa);SFREE(cvel);SFREE(cvfa);
   }
 
   if(*iturbulent>0){
       SFREE(gradkel);SFREE(gradkfa);SFREE(gradoel);SFREE(gradofa);
   }
 
   SFREE(inum);SFREE(v);SFREE(velo);
   if((compressible==0)&&(*nblk==0)) SFREE(veloo);
 
   SFREE(iponofa);SFREE(inofa);
 
   if(*nbody>0) SFREE(body);
 
   *ithermal=ithermalref;
 
   SFREE(temp);SFREE(gamma);
 
   SFREE(gradpfa);
 
   return;
   
 } 

◆ complete_hel_blk_main()

void complete_hel_blk_main	(	double *	vel,
		double *	hel,
		double *	auv6,
		double *	c,
		ITG *	ipnei,
		ITG *	neiel,
		ITG *	neifa,
		ITG *	ifatie,
		ITG *	nef
	)

◆ complexfreq()

void complexfreq	(	double **	cop,
		ITG *	nk,
		ITG **	konp,
		ITG **	ipkonp,
		char **	lakonp,
		ITG *	ne,
		ITG **	nodebounp,
		ITG **	ndirbounp,
		double **	xbounp,
		ITG *	nboun,
		ITG **	ipompcp,
		ITG **	nodempcp,
		double **	coefmpcp,
		char **	labmpcp,
		ITG *	nmpc,
		ITG *	nodeforc,
		ITG *	ndirforc,
		double *	xforc,
		ITG *	nforc,
		ITG *	nelemload,
		char *	sideload,
		double *	xload,
		ITG *	nload,
		ITG **	nactdofp,
		ITG *	neq,
		ITG *	nzl,
		ITG *	icol,
		ITG *	irow,
		ITG *	nmethod,
		ITG **	ikmpcp,
		ITG **	ilmpcp,
		ITG **	ikbounp,
		ITG **	ilbounp,
		double *	elcon,
		ITG *	nelcon,
		double *	rhcon,
		ITG *	nrhcon,
		double *	cocon,
		ITG *	ncocon,
		double *	alcon,
		ITG *	nalcon,
		double *	alzero,
		ITG **	ielmatp,
		ITG **	ielorienp,
		ITG *	norien,
		double *	orab,
		ITG *	ntmat_,
		double **	t0p,
		double **	t1p,
		ITG *	ithermal,
		double *	prestr,
		ITG *	iprestr,
		double **	voldp,
		ITG *	iperturb,
		double **	stip,
		ITG *	nzs,
		double *	timepar,
		double *	xmodal,
		double **	veoldp,
		char *	amname,
		double *	amta,
		ITG *	namta,
		ITG *	nam,
		ITG *	iamforc,
		ITG *	iamload,
		ITG **	iamt1p,
		ITG *	jout,
		ITG *	kode,
		char *	filab,
		double **	emep,
		double *	xforcold,
		double *	xloadold,
		double **	t1oldp,
		ITG **	iambounp,
		double **	xbounoldp,
		ITG *	iexpl,
		double *	plicon,
		ITG *	nplicon,
		double *	plkcon,
		ITG *	nplkcon,
		double *	xstate,
		ITG *	npmat_,
		char *	matname,
		ITG *	mi,
		ITG *	ncmat_,
		ITG *	nstate_,
		double **	enerp,
		char *	jobnamec,
		double *	ttime,
		char *	set,
		ITG *	nset,
		ITG *	istartset,
		ITG *	iendset,
		ITG **	ialsetp,
		ITG *	nprint,
		char *	prlab,
		char *	prset,
		ITG *	nener,
		double *	trab,
		ITG **	inotrp,
		ITG *	ntrans,
		double **	fmpcp,
		char *	cbody,
		ITG *	ibody,
		double *	xbody,
		ITG *	nbody,
		double *	xbodyold,
		ITG *	istep,
		ITG *	isolver,
		ITG *	jq,
		char *	output,
		ITG *	mcs,
		ITG *	nkon,
		ITG *	mpcend,
		ITG *	ics,
		double *	cs,
		ITG *	ntie,
		char *	tieset,
		ITG *	idrct,
		ITG *	jmax,
		double *	ctrl,
		ITG *	itpamp,
		double *	tietol,
		ITG *	nalset,
		ITG *	ikforc,
		ITG *	ilforc,
		double *	thicke,
		char *	jobnamef,
		ITG *	mei,
		ITG *	nmat,
		ITG *	ielprop,
		double *	prop,
		char *	orname
	)

                             {
 
   char fneig[132]="",description[13]="            ",*lakon=NULL,*labmpc=NULL,
     *lakont=NULL;
 
   ITG nev,i,j,k,idof,*inum=NULL,*ipobody=NULL,inewton=0,id,
     iinc=0,l,iout=1,ielas,icmd=3,ifreebody,mode,m,nherm,
     *kon=NULL,*ipkon=NULL,*ielmat=NULL,*ielorien=NULL,*islavact=NULL,
     *inotr=NULL,*nodeboun=NULL,*ndirboun=NULL,*iamboun=NULL,*ikboun=NULL,
     *ilboun=NULL,*nactdof=NULL,*ipompc=NULL,*nodempc=NULL,*ikmpc=NULL,
     *ilmpc=NULL,nsectors,nmd,nevd,*nm=NULL,*iamt1=NULL,*islavnode=NULL,
     ngraph=1,nkg,neg,ne0,ij,lprev,nope,indexe,ilength,*nslavnode=NULL,
     *ipneigh=NULL,*neigh=NULL,index,im,cyclicsymmetry,inode,
     *ialset=*ialsetp,mt=mi[1]+1,kmin,kmax,i1,iit=-1,network=0,
     *iter=NULL,lint,lfin,kk,kkv,kk6,kkx,icomplex,igeneralizedforce,
     idir,*inumt=NULL,icntrl,imag,jj,is,l1,*inocs=NULL,ml1,l2,nkt,net,
     *ipkont=NULL,*ielmatt=NULL,*inotrt=NULL,*kont=NULL,node,iel,*ielcs=NULL,
     ielset,*istartnmd=NULL,*iendnmd=NULL,inmd,neqact,*nshcon=NULL,
     *ipev=NULL,icfd=0,*inomat=NULL,mortar=0,*islavsurf=NULL,
     *iponoel=NULL,*inoel=NULL;
 
   long long i2;
 
   double *d=NULL, *z=NULL,*stiini=NULL,*cc=NULL,*v=NULL,*zz=NULL,*emn=NULL,
     *stn=NULL, *stx=NULL, *een=NULL, *adb=NULL,*xstiff=NULL,*cdn=NULL,
     *aub=NULL,*f=NULL, *fn=NULL,*epn=NULL,*xstateini=NULL,
     *enern=NULL,*xstaten=NULL,*eei=NULL,*enerini=NULL,*qfn=NULL,
     *qfx=NULL, *cgr=NULL, *au=NULL,dtime,reltime,*t0=NULL,*t1=NULL,*t1old=NULL,
     sum,qa[4],cam[5],accold[1],bet,gam,*ad=NULL,alpham,betam,
     *co=NULL,*xboun=NULL,*xbounold=NULL,*vold=NULL,*emeini=NULL,
     *eme=NULL,*ener=NULL,*coefmpc=NULL,*fmpc=NULL,*veold=NULL,
     *adc=NULL,*auc=NULL,*zc=NULL,*fnr=NULL,*fni=NULL,setnull,deltmx,dd,
     theta,*vini=NULL,*vr=NULL,*vi=NULL,*stnr=NULL,*stni=NULL,*vmax=NULL,
     *stnmax=NULL,*cstr=NULL,*sti=*stip,time0=0.0,time=0.0,zero=0.0,
     *springarea=NULL,*eenmax=NULL,*aa=NULL,*bb=NULL,*xx=NULL,
     *eiga=NULL,*eigb=NULL,*eigxx=NULL,*temp=NULL,*coefmpcnew=NULL,xreal,
     ximag,t[3],*vt=NULL,*t1t=NULL,*stnt=NULL,*eent=NULL,*fnt=NULL,*enernt=NULL,
     *stxt=NULL,pi,ctl,stl,*cot=NULL,*qfnt=NULL,vreal,vimag,constant,stnreal,
     stnimag,freq,*emnt=NULL,*shcon=NULL,*eig=NULL,*clearini=NULL,
     *eigxr=NULL,*eigxi=NULL,*xmac=NULL,*bett=NULL,*betm=NULL,*xmaccpx=NULL,
     fmin=0.,fmax=1.e30,*xmr=NULL,*xmi=NULL,*zi=NULL,*eigx=NULL,
     *pslavsurf=NULL,*pmastsurf=NULL,*cdnr=NULL,*cdni=NULL,*tinc,*tper,
     *tmin,*tmax,*energyini=NULL,*energy=NULL;
 
   FILE *f1;
 
 #ifdef SGI
   ITG token;
 #endif
 
   pi=4.*atan(1.);
   constant=180./pi;
 
   co=*cop;kon=*konp;ipkon=*ipkonp;lakon=*lakonp;ielmat=*ielmatp;
   ielorien=*ielorienp;inotr=*inotrp;nodeboun=*nodebounp;
   ndirboun=*ndirbounp;iamboun=*iambounp;xboun=*xbounp;
   xbounold=*xbounoldp;ikboun=*ikbounp;ilboun=*ilbounp;nactdof=*nactdofp;
   vold=*voldp;eme=*emep;ener=*enerp;ipompc=*ipompcp;nodempc=*nodempcp;
   coefmpc=*coefmpcp;labmpc=*labmpcp;ikmpc=*ikmpcp;ilmpc=*ilmpcp;
   fmpc=*fmpcp;veold=*veoldp;iamt1=*iamt1p;t0=*t0p;t1=*t1p;t1old=*t1oldp;
 
   tinc=&timepar[0];
   tper=&timepar[1];
   tmin=&timepar[2];
   tmax=&timepar[3];
 
   if(ithermal[0]<=1){
       kmin=1;kmax=3;
   }else if(ithermal[0]==2){
       kmin=0;kmax=mi[1];if(kmax>2)kmax=2;
   }else{
       kmin=0;kmax=3;
   }
 
   NNEW(xstiff,double,(long long)27*mi[0]**ne);
 
   dtime=*tinc;
 
   alpham=xmodal[0];
   betam=xmodal[1];
 
   dd=ctrl[16];deltmx=ctrl[26];
 
   /* determining nzl */
 
   *nzl=0;
   for(i=neq[1];i>0;i--){
       if(icol[i-1]>0){
       *nzl=i;
       break;
       }
   }
 
   /* opening the eigenvalue file and checking for cyclic symmetry */
 
   strcpy(fneig,jobnamec);
   strcat(fneig,".eig");
 
   if((f1=fopen(fneig,"rb"))==NULL){
     printf("*ERROR in complexfreq: cannot open eigenvalue file for reading");
     exit(0);
   }
 
   printf(" *INFO  in complexfreq: if there are problems reading the .eig file this may be due to:\n");
   printf("        1) the nonexistence of the .eig file\n");
   printf("        2) other boundary conditions than in the input deck\n");
   printf("           which created the .eig file\n\n");
 
   if(fread(&cyclicsymmetry,sizeof(ITG),1,f1)!=1){
       printf("*ERROR in complexfreq reading the cyclic symmetry flag in the eigenvalue file");
       exit(0);
   }
 
   if(fread(&nherm,sizeof(ITG),1,f1)!=1){
       printf("*ERROR in complexfreq reading the Hermitian flag in the eigenvalue file");
       exit(0);
   }
 
   if(nherm!=1){
       printf("*ERROR in complexfreq: the eigenvectors in the .eig-file result\n");
       printf("       from a non-Hermitian eigenvalue problem. The complex\n");
       printf("       frequency procedure cannot handle that yet\n\n");
       FORTRAN(stop,());
   }
 
   nsectors=1;
 
   if(!cyclicsymmetry){
 
       nkg=*nk;
       neg=*ne;
 
       if(fread(&nev,sizeof(ITG),1,f1)!=1){
       printf("*ERROR in complexfreq reading the number of eigenvalues in the eigenvalue file...");
       exit(0);
       }
       
 
       if(nherm==1){
       NNEW(d,double,nev);
       if(fread(d,sizeof(double),nev,f1)!=nev){
           printf("*ERROR in complexfreq reading the eigenvalues in the eigenvalue file...");
           exit(0);
       }
       }else{
       NNEW(d,double,2*nev);
       if(fread(d,sizeof(double),2*nev,f1)!=2*nev){
           printf("*ERROR in complexfreq reading the eigenvalues in the eigenvalue file...");
           exit(0);
       }
       }
       
       NNEW(ad,double,neq[1]);
       NNEW(adb,double,neq[1]);
       NNEW(au,double,nzs[2]);
       NNEW(aub,double,nzs[1]);
       
       /* reading the stiffness matrix */
 
       if(fread(ad,sizeof(double),neq[1],f1)!=neq[1]){
       printf("*ERROR in complexfreq reading the diagonal of the stiffness matrix in the eigenvalue file...");
       exit(0);
       }
       
       if(fread(au,sizeof(double),nzs[2],f1)!=nzs[2]){
       printf("*ERROR in complexfreq reading the off-diagonal terms of the stiffness matrix in the eigenvalue file...");
       exit(0);
       }
       
       /* reading the mass matrix */
 
       if(fread(adb,sizeof(double),neq[1],f1)!=neq[1]){
       printf("*ERROR in complexfreq reading the diagonal of the mass matrix in eigenvalue file...");
       exit(0);
       }
       
       if(fread(aub,sizeof(double),nzs[1],f1)!=nzs[1]){
       printf("*ERROR in complexfreq reading the off-diagonals of the mass matrix in the eigenvalue file...");
       exit(0);
       }
       
       /* reading the eigenvectors */
 
       if(nherm==1){
       NNEW(z,double,neq[1]*nev);
       if(fread(z,sizeof(double),neq[1]*nev,f1)!=neq[1]*nev){
           printf("*ERROR in complexfreq reading the eigenvectors in the eigenvalue file...");
           exit(0);
       }
       }else{
       NNEW(z,double,2*neq[1]*nev);
       if(fread(z,sizeof(double),2*neq[1]*nev,f1)!=2*neq[1]*nev){
           printf("*ERROR in complexfreq reading the eigenvectors in the eigenvalue file...");
           exit(0);
       }
       }
 
       NNEW(nm,ITG,nev);
       for(i=0;i<nev;i++){nm[i]=-1;}
   }
   else{
 
       if(*nmethod==6){
         printf("*ERROR in complexfreq: Coriolis forces cannot\n");
         printf("       be combined with cyclic symmetry\n\n");
         FORTRAN(stop,());
       }
 
       nev=0;
       do{
       if(fread(&nmd,sizeof(ITG),1,f1)!=1){
           break;
       }
       if(fread(&nevd,sizeof(ITG),1,f1)!=1){
           printf("*ERROR in complexfreq reading the number of eigenvalues in the eigenvalue file...");
           exit(0);
           }
       if(nev==0){
           if(nherm==1){NNEW(d,double,nevd);
           }else{NNEW(d,double,2*nevd);}
           NNEW(nm,ITG,nevd);
       }else{
           printf("*ERROR in complexfreq: flutter forces cannot\n");
           printf("       be combined with multiple modal diameters\n");
           printf("       in cyclic symmetry calculations\n\n");
           FORTRAN(stop,());
       }
       
       if(nherm==1){
           if(fread(&d[nev],sizeof(double),nevd,f1)!=nevd){
           printf("*ERROR in complexfreq reading the eigenvalues in the eigenvalue file...");
           exit(0);
           }
       }else{
           if(fread(&d[nev],sizeof(double),2*nevd,f1)!=2*nevd){
           printf("*ERROR in complexfreq reading the eigenvalues in the eigenvalue file...");
           exit(0);
           }
       }
       for(i=nev;i<nev+nevd;i++){nm[i]=nmd;}
       
       if(nev==0){
           NNEW(adb,double,neq[1]);
           NNEW(aub,double,nzs[1]);
 
           if(fread(adb,sizeof(double),neq[1],f1)!=neq[1]){
           printf("*ERROR in complexfreq reading the diagonal of the mass matrix in the eigenvalue file...");
           exit(0);
           }
           
           if(fread(aub,sizeof(double),nzs[1],f1)!=nzs[1]){
           printf("*ERROR in complexfreq reading the off-diagonals of the mass matrix in the eigenvalue file...");
           exit(0);
           }
       }
       
       if(nev==0){
           NNEW(z,double,neq[1]*nevd);
       }else{
           RENEW(z,double,(long long)neq[1]*(nev+nevd));
       }
       
       if(fread(&z[neq[1]*nev],sizeof(double),neq[1]*nevd,f1)!=neq[1]*nevd){
           printf("*ERROR in complexfreq reading eigenvectors in the eigenvalue file...");
           exit(0);
       }
       nev+=nevd;
       }while(1);
 
       /* removing double eigenmodes */
 
       j=-1;
       for(i=0;i<nev;i++){
       if((i/2)*2==i){
           j++;
           if(nherm==1){
           d[j]=d[i];
           }else{
           d[2*j]=d[2*i];d[2*j+1]=d[2*i+1];
           }
           nm[j]=nm[i];
           for(k=0;k<neq[1];k++){
           z[j*neq[1]+k]=z[i*neq[1]+k];
           }
       }
       }
       nev=j+1;
       if(nherm==1){RENEW(d,double,nev);}else{RENEW(d,double,2*nev);}
       RENEW(nm,ITG,nev);
       RENEW(z,double,neq[1]*nev);
 
       /* determining the maximum amount of segments */
 
       for(i=0;i<*mcs;i++){
       if(cs[17*i]>nsectors) nsectors=(ITG)(cs[17*i]+0.5);
       }
 
         /* determining the maximum number of sectors to be plotted */
 
       for(j=0;j<*mcs;j++){
       if(cs[17*j+4]>ngraph) ngraph=(ITG)cs[17*j+4];
       }
       nkg=*nk*ngraph;
       neg=*ne*ngraph;
 
   }
 
   fclose(f1);
 
   /* assigning nodes and elements to sectors */
 
   if(cyclicsymmetry){
     NNEW(inocs,ITG,*nk);
     NNEW(ielcs,ITG,*ne);
     ielset=cs[12];
     if((*mcs!=1)||(ielset!=0)){
       for(i=0;i<*nk;i++) inocs[i]=-1;
       for(i=0;i<*ne;i++) ielcs[i]=-1;
     }
     
     for(i=0;i<*mcs;i++){
       is=cs[17*i+4];
       if((is==1)&&(*mcs==1)) continue;
       ielset=cs[17*i+12];
       if(ielset==0) continue;
       for(i1=istartset[ielset-1]-1;i1<iendset[ielset-1];i1++){
     if(ialset[i1]>0){
       iel=ialset[i1]-1;
       if(ipkon[iel]<0) continue;
       ielcs[iel]=i;
       indexe=ipkon[iel];
       if(strcmp1(&lakon[8*iel+3],"2")==0)nope=20;
       else if (strcmp1(&lakon[8*iel+3],"8")==0)nope=8;
       else if (strcmp1(&lakon[8*iel+3],"10")==0)nope=10;
       else if (strcmp1(&lakon[8*iel+3],"4")==0)nope=4;
       else if (strcmp1(&lakon[8*iel+3],"15")==0)nope=15;
       else {nope=6;}
       for(i2=0;i2<nope;++i2){
         node=kon[indexe+i2]-1;
         inocs[node]=i;
       }
     }
     else{
       iel=ialset[i1-2]-1;
       do{
         iel=iel-ialset[i1];
         if(iel>=ialset[i1-1]-1) break;
         if(ipkon[iel]<0) continue;
         ielcs[iel]=i;
         indexe=ipkon[iel];
         if(strcmp1(&lakon[8*iel+3],"2")==0)nope=20;
         else if (strcmp1(&lakon[8*iel+3],"8")==0)nope=8;
         else if (strcmp1(&lakon[8*iel+3],"10")==0)nope=10;
         else if (strcmp1(&lakon[8*iel+3],"4")==0)nope=4;
         else if (strcmp1(&lakon[8*iel+3],"15")==0)nope=15;
         else {nope=6;}
         for(i2=0;i2<nope;++i2){
           node=kon[indexe+i2]-1;
           inocs[node]=i;
         }
       }while(1);
     }
       } 
     }
   }
   
   /* check for rigid body modes 
      if there is a jump of 1.e4 in two subsequent eigenvalues
      all eigenvalues preceding the jump are considered to
      be rigid body modes and their frequency is set to zero */
 
   if(nherm==1){
       setnull=1.;
       for(i=nev-2;i>-1;i--){
       if(fabs(d[i])<0.0001*fabs(d[i+1])) setnull=0.;
       d[i]*=setnull;
       }
   }else{
       setnull=1.;
       for(i=nev-2;i>-1;i--){
       if(sqrt(d[2*i]*d[2*i]+d[2*i+1]*d[2*i+1])<
                  0.0001*sqrt(d[2*i+2]*d[2*i+2]+d[2*i+3]*d[2*i+3])) setnull=0.;
       d[2*i]*=setnull;
       d[2*i+1]*=setnull;
       }
   }
 
   /* determining the frequency ranges corresponding to one
      and the same nodal diameter */
 
   if(cyclicsymmetry){
       NNEW(istartnmd,ITG,nev);
       NNEW(iendnmd,ITG,nev);
       nmd=0;
       inmd=nm[0];
       istartnmd[0]=1;
       for(i=1;i<nev;i++){
       if(nm[i]==inmd) continue;
       iendnmd[nmd]=i;
       nmd++;
       istartnmd[nmd]=i+1;
       inmd=nm[i];
       }
       iendnmd[nmd]=nev;
       nmd++;
       RENEW(istartnmd,ITG,nmd);
       RENEW(iendnmd,ITG,nmd);
   }
 
   if(*nmethod==6){
 
       /* Coriolis */
 
       neqact=neq[1];
 
   /* assigning the body forces to the elements */ 
 
       ifreebody=*ne+1;
       NNEW(ipobody,ITG,2**ne);
       for(k=1;k<=*nbody;k++){
       FORTRAN(bodyforce,(cbody,ibody,ipobody,nbody,set,istartset,
                  iendset,ialset,&inewton,nset,&ifreebody,&k));
       RENEW(ipobody,ITG,2*(*ne+ifreebody));
       }
       RENEW(ipobody,ITG,2*(ifreebody-1));
       
       if(cyclicsymmetry){
       printf("*ERROR in complexfreq: dashpots are not allowed in combination with cyclic symmetry\n");
       FORTRAN(stop,());
       }
 
       NNEW(adc,double,neq[1]);
       NNEW(auc,double,nzs[1]);
       FORTRAN(mafillcorio,(co,nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,
               xboun,nboun,
           ipompc,nodempc,coefmpc,nmpc,nodeforc,ndirforc,xforc,
           nforc,nelemload,sideload,xload,nload,xbody,ipobody,nbody,cgr,
           adc,auc,nactdof,icol,jq,irow,neq,nzl,nmethod,
           ikmpc,ilmpc,ikboun,ilboun,
           elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat,
           ielorien,norien,orab,ntmat_,
           t0,t0,ithermal,prestr,iprestr,vold,iperturb,sti,
           nzs,stx,adb,aub,iexpl,plicon,nplicon,plkcon,nplkcon,
           xstiff,npmat_,&dtime,matname,mi,ncmat_,
           ttime,&time0,istep,&iinc,ibody,ielprop,prop));
 
       /*  zc = damping matrix * eigenmodes */
 
       NNEW(zc,double,neq[1]*nev);
       for(i=0;i<nev;i++){
       FORTRAN(op_corio,(&neq[1],&z[i*neq[1]],&zc[i*neq[1]],adc,auc,
       jq,irow));
       }
       SFREE(adc);SFREE(auc);
 
       /* cc is the reduced damping matrix (damping matrix mapped onto
          space spanned by eigenmodes) */
 
       NNEW(cc,double,nev*nev);
       for(i=0;i<nev;i++){
       for(j=0;j<=i;j++){
           for(k=0;k<neq[1];k++){
           cc[i*nev+j]+=z[j*neq[1]+k]*zc[i*neq[1]+k];
           }
       }
       }
 
       /* symmetric part of cc matrix */
 
       for(i=0;i<nev;i++){
       for(j=i+1;j<nev;j++){
           cc[i*nev+j]=-cc[j*nev+i];
       }
       }
       SFREE(zc);
 
       /* solving for the complex eigenvalues */
 
       NNEW(aa,double,4*nev*nev);
       NNEW(bb,double,4*nev*nev);
       NNEW(xx,double,4*nev*nev);
       NNEW(temp,double,4*nev*nev);
       NNEW(eiga,double,2*nev);
       NNEW(eigb,double,2*nev);
       NNEW(eigxx,double,2*nev);
       NNEW(iter,ITG,nev);
 
       FORTRAN(coriolissolve,(cc,&nev,aa,bb,xx,eiga,eigb,eigxx,
               iter,d,temp));
       
       SFREE(aa);SFREE(bb);SFREE(temp);SFREE(eiga);SFREE(eigb);SFREE(iter);SFREE(cc);
 
   }else{
 
       /* flutter */
 
       /* complex force is being read (e.g. due to fluid flow) */
 
       if(cyclicsymmetry){
       neqact=neq[1]/2;
       }else{
       neqact=neq[1];
       }
       NNEW(zc,double,2*neqact*nev);
       NNEW(aa,double,4*nev*nev);
 
       FORTRAN(readforce,(zc,&neqact,&nev,nactdof,ikmpc,nmpc,
              ipompc,nodempc,mi,coefmpc,jobnamef,
                          aa,&igeneralizedforce));
 
       NNEW(bb,double,4*nev*nev);
       NNEW(xx,double,4*nev*nev);
       NNEW(eiga,double,2*nev);
       NNEW(eigb,double,2*nev);
       NNEW(eigxx,double,2*nev);
       NNEW(iter,ITG,nev);
       FORTRAN(forcesolve,(zc,&nev,aa,bb,xx,eiga,eigb,eigxx,iter,d,
             &neq[1],z,istartnmd,iendnmd,&nmd,&cyclicsymmetry,
         &neqact,&igeneralizedforce));
       SFREE(aa);SFREE(bb);SFREE(eiga);SFREE(eigb);SFREE(iter);SFREE(zc);
       
  }
 
 /* sorting the eigenvalues and eigenmodes according to the size of the
    eigenvalues */
       
   NNEW(ipev,ITG,nev);
   NNEW(eigxr,double,nev);
   NNEW(aa,double,2*nev);
   NNEW(bb,double,4*nev*nev);
   
   FORTRAN(sortev,(&nev,&nmd,eigxx,&cyclicsymmetry,xx,
           eigxr,ipev,istartnmd,iendnmd,aa,bb));
   
   SFREE(ipev);SFREE(eigxr);SFREE(aa);SFREE(bb);
 
   /* storing the eigenvalues in the .dat file */
 
   if(cyclicsymmetry){
       FORTRAN(writeevcscomplex,(eigxx,&nev,nm,&fmin,&fmax));
   }else{
       FORTRAN(writeevcomplex,(eigxx,&nev,&fmin,&fmax));
   }
 
   /* storing the participation factors */
 
   NNEW(eigxr,double,nev);
   NNEW(eigxi,double,nev);
   if(nherm==1){
       NNEW(eig,double,nev);
       for(l=0;l<nev;l++){
       if(d[l]<0.){
           eig[l]=0.;
       }else{
           eig[l]=sqrt(d[l]);
       }
       }
   }else{
 
       NNEW(eig,double,2*nev);
       for(l=0;l<nev;l++){
       eig[2*l]=sqrt(sqrt(d[2*l]*d[2*l]+d[2*l+1]*d[2*l+1])+d[2*l])/sqrt(2.);
       eig[2*l+1]=sqrt(sqrt(d[2*l]*d[2*l]+d[2*l+1]*d[2*l+1])-d[2*l])/sqrt(2.);
       if(d[2*l+1]<0.) eig[2*l+1]=-eig[2*l+1];
       }
   }
   for(l=0;l<nev;l++){
       mode=l+1;
       for(k=0;k<nev;k++){
       eigxr[k]=xx[2*l*nev+2*k];
       eigxi[k]=xx[2*l*nev+2*k+1];
       }
       FORTRAN(writepf,(eig,eigxr,eigxi,&zero,&nev,&mode,&nherm));
   }
   SFREE(eigxr);SFREE(eigxi);SFREE(eig);SFREE(d);
 
   if(cyclicsymmetry){
       
        /* assembling the new eigenmodes */
 
       /* storage in zz: per eigenmode first the complete real part of
          the eigenvector, then the complete imaginary part */
       
       NNEW(zz,double,(long long)2*nev*neqact);
       for(l=0;l<nev;l++){
       for(i=0;i<neqact;i++){
           for(k=0;k<nev;k++){
 
                   /* real part */
 
           zz[(long long)2*l*neqact+i]+=
               (xx[2*l*nev+2*k]*z[(long long)2*k*neqact+i]
                -xx[2*l*nev+2*k+1]*z[(long long)(2*k+1)*neqact+i]);
 
           /* imaginary part */
 
           zz[(long long)(2*l+1)*neqact+i]+=
               (xx[2*l*nev+2*k]*z[(long long)(2*k+1)*neqact+i]
                +xx[2*l*nev+2*k+1]*z[(long long)2*k*neqact+i]);
           }
       }
       }
 
       /* calculating the scalar product of all old eigenmodes with
          all new eigenmodes => nev x nev matrix */
 
       NNEW(xmac,double,nev*nev);
       NNEW(xmaccpx,double,4*nev*nev);
       NNEW(bett,double,nev);
       NNEW(betm,double,nev);
       FORTRAN(calcmac,(&neq[1],z,zz,&nev,xmac,xmaccpx,istartnmd,
                    iendnmd,&nmd,&cyclicsymmetry,&neqact,bett,betm));
       FORTRAN(writemaccs,(xmac,&nev,nm));
 
       SFREE(xmac);SFREE(bett);SFREE(betm);SFREE(xmaccpx);
       SFREE(z);
       
       /* normalizing the eigenmodes */
       
       NNEW(z,double,neq[1]);
       for(l=0;l<nev;l++){
       sum=0.;
       DMEMSET(z,0,neq[1],0.);
       FORTRAN(op,(&neq[1],&zz[l*neq[1]],z,adb,aub,jq,irow));
       for(k=0;k<neq[1];k++){
           sum+=zz[l*neq[1]+k]*z[k];
       }
       
       sum=sqrt(sum);
       for(k=0;k<neq[1];k++){
           zz[l*neq[1]+k]/=sum;
       }
       }
       SFREE(z);
 
       /* calculating the mass-weighted internal products (eigenvectors are not 
          necessarily orthogonal, since the matrix of the eigenvalue problem is
          not necessarily Hermitian)
          = orthogonality matrices */
 
       if(mei[3]==1){
       
       NNEW(xmr,double,nev*nev);
       NNEW(xmi,double,nev*nev);
       NNEW(z,double,neq[1]);
       NNEW(zi,double,neq[1]);
       
       for(l=0;l<nev;l++){
           DMEMSET(z,0,neq[1],0.);
           FORTRAN(op,(&neq[1],&zz[l*neq[1]],z,adb,aub,jq,irow));
           for(m=l;m<nev;m++){
           for(k=0;k<neq[1];k++){
               xmr[l*nev+m]+=zz[m*neq[1]+k]*z[k];
           }
           }
           
           memcpy(&zi[0],&zz[(2*l+1)*neqact],sizeof(double)*neqact);
           for(k=0;k<neqact;k++){zi[neqact+k]=-zz[2*l*neqact+k];}
           DMEMSET(z,0,neq[1],0.);
           FORTRAN(op,(&neq[1],zi,z,adb,aub,jq,irow));
           for(m=l;m<nev;m++){
           for(k=0;k<neq[1];k++){
               xmi[l*nev+m]+=zz[m*neq[1]+k]*z[k];
           }
           }
       }
       
       /* Hermitian part of the matrix */
       
       for(l=0;l<nev;l++){
           for(m=0;m<l;m++){
           xmr[l*nev+m]=xmr[m*nev+l];
           xmi[l*nev+m]=-xmi[m*nev+l];
           }
       }
       
       for(l=0;l<nev;l++){
           for(m=0;m<nev;m++){
           printf(" %f",xmr[m*nev+l]);
       }
           printf("\n");
       }
       printf("\n");
       for(l=0;l<nev;l++){
           for(m=0;m<nev;m++){
           printf(" %f",xmi[m*nev+l]);
           }
           printf("\n");
       }
       SFREE(z);SFREE(zi);
       }
 
   }else{
       
       /* no cyclic symmmetry */
       
       /* assembling the new eigenmodes */
       
       NNEW(zz,double,2*nev*neq[1]);
       for(l=0;l<nev;l++){
       for(j=0;j<2;j++){
           for(i=0;i<neq[1];i++){
           for(k=0;k<nev;k++){
               zz[(2*l+j)*neq[1]+i]+=xx[2*l*nev+2*k+j]*
                             z[(long long)k*neq[1]+i];
           }
           }
       }
       }
 
       /* calculating the scalar product of all old eigenmodes with
          all new eigenmodes => nev x nev matrix */
 
       NNEW(xmac,double,nev*nev);
       NNEW(xmaccpx,double,4*nev*nev);
       NNEW(bett,double,nev);
       NNEW(betm,double,nev);
       FORTRAN(calcmac,(&neq[1],z,zz,&nev,xmac,xmaccpx,istartnmd,
                  iendnmd,&nmd,&cyclicsymmetry,&neqact,bett,betm));
       FORTRAN(writemac,(xmac,&nev));
       SFREE(xmac);SFREE(bett);SFREE(betm);SFREE(xmaccpx);
 
       SFREE(z);
       
       /* normalizing the eigenmodes */
       
       NNEW(z,double,neq[1]);
       for(l=0;l<nev;l++){
       sum=0.;
       
       /* Ureal^T*M*Ureal */
       
       DMEMSET(z,0,neq[1],0.);
       FORTRAN(op,(&neq[1],&zz[2*l*neq[1]],z,adb,aub,jq,irow));
       for(k=0;k<neq[1];k++){
           sum+=zz[2*l*neq[1]+k]*z[k];
       }
       
       /* Uimag^T*M*Uimag */
       
       DMEMSET(z,0,neq[1],0.);
       FORTRAN(op,(&neq[1],&zz[(2*l+1)*neq[1]],z,adb,aub,jq,irow));
       for(k=0;k<neq[1];k++){
           sum+=zz[(2*l+1)*neq[1]+k]*z[k];
       }
       
       sum=sqrt(sum);
       for(k=0;k<2*neq[1];k++){
           zz[2*l*neq[1]+k]/=sum;
       }
       }
       SFREE(z);
 
       /* calculating the mass-weighted internal products (eigenvectors are not 
          necessarily orthogonal, since the matrix of the eigenvalue problem is
          not necessarily symmetric)
          = orthogonality matrices */
 
       if(mei[3]==1){
       
       NNEW(xmr,double,nev*nev);
       NNEW(xmi,double,nev*nev);
       NNEW(z,double,neq[1]);
       
       for(l=0;l<nev;l++){
           sum=0.;
           
           /* M*Ureal */
           
           DMEMSET(z,0,neq[1],0.);
           FORTRAN(op,(&neq[1],&zz[2*l*neq[1]],z,adb,aub,jq,irow));
           
           /* Ureal^T*M*Ureal and Uimag^T*M*Ureal */
           
           for(m=l;m<nev;m++){
           for(k=0;k<neq[1];k++){
               xmr[l*nev+m]+=zz[2*m*neq[1]+k]*z[k];
           }
           for(k=0;k<neq[1];k++){
               xmi[l*nev+m]-=zz[(2*m+1)*neq[1]+k]*z[k];
           }
           }
           
           /* M*Uimag */
           
           DMEMSET(z,0,neq[1],0.);
           FORTRAN(op,(&neq[1],&zz[(2*l+1)*neq[1]],z,adb,aub,jq,irow));
           
           /* Ureal^T*M*Uimag and Uimag^T*M*Uimag */
           
           for(m=l;m<nev;m++){
           for(k=0;k<neq[1];k++){
               xmr[l*nev+m]+=zz[(2*m+1)*neq[1]+k]*z[k];
           }
           for(k=0;k<neq[1];k++){
               xmi[l*nev+m]+=zz[2*m*neq[1]+k]*z[k];
           }
           }
       }
       
       /* Hermitian part of the matrix */
       
       for(l=0;l<nev;l++){
           for(m=0;m<l;m++){
           xmr[l*nev+m]=xmr[m*nev+l];
           xmi[l*nev+m]=-xmi[m*nev+l];
           }
       }
       
       for(l=0;l<nev;l++){
           for(m=0;m<nev;m++){
           printf(" %f",xmr[m*nev+l]);
           }
           printf("\n");
       }
       printf("\n");
       for(l=0;l<nev;l++){
           for(m=0;m<nev;m++){
           printf(" %f",xmi[m*nev+l]);
           }
           printf("\n");
       }
       SFREE(z);
       }
 
   }
 
  /*storing new eigenmodes and eigenvalues to *.eig-file for later use in 
  steady states dynamic analysis*/
 
   if(mei[3]==1){
 
       nherm=0;
       
       if(!cyclicsymmetry){
       if((f1=fopen(fneig,"wb"))==NULL){
           printf("*ERROR in complexfreq: cannot open eigenvalue file for writing...");
           exit(0);
       }
       
       /* storing a zero as indication that this was not a
          cyclic symmetry calculation */
       
       if(fwrite(&cyclicsymmetry,sizeof(ITG),1,f1)!=1){
           printf("*ERROR in complexfreq saving the cyclic symmetry flag to the eigenvalue file...");
           exit(0);
       }
       
       /* not Hermitian */
       
       if(fwrite(&nherm,sizeof(ITG),1,f1)!=1){
           printf("*ERROR in complexfreq saving the Hermitian flag to the eigenvalue file...");
           exit(0);
       }
       
       /* storing the number of eigenvalues */
       
       if(fwrite(&nev,sizeof(ITG),1,f1)!=1){
           printf("*ERROR in complexfreq saving the number of eigenfrequencies to the eigenvalue file...");
           exit(0);
       }
       
       /* the eigenfrequencies are stored as (radians/time)**2
          squaring the complexe eigenvalues first */
       
       NNEW(eigx,double,2*nev);
       for(i=0;i<nev;i++){
           eigx[2*i]=eigxx[2*i]*eigxx[2*i]-eigxx[2*i+1]*eigxx[2*i+1];
           eigx[2*i+1]=2.*eigxx[2*i]*eigxx[2*i+1];
       }
       
       if(fwrite(eigx,sizeof(double),2*nev,f1)!=2*nev){
           printf("*ERROR in complexfreq saving the eigenfrequencies to the eigenvalue file...");
           exit(0);
       }
       
       SFREE(eigx);
       
       /* storing the stiffness matrix */
       
       if(fwrite(ad,sizeof(double),neq[1],f1)!=neq[1]){
           printf("*ERROR in complexfreq saving the diagonal of the stiffness matrix to the eigenvalue file...");
           exit(0);
       }
       if(fwrite(au,sizeof(double),nzs[2],f1)!=nzs[2]){
           printf("*ERROR in complexfreq saving the off-diagonal entries of the stiffness matrix to the eigenvalue file...");
           exit(0);
       }
       
       /* storing the mass matrix */
       
       if(fwrite(adb,sizeof(double),neq[1],f1)!=neq[1]){
           printf("*ERROR in complexfreq saving the diagonal of the mass matrix to the eigenvalue file...");
           exit(0);
       }
       if(fwrite(aub,sizeof(double),nzs[1],f1)!=nzs[1]){
           printf("*ERROR in complexfreq saving the off-diagonal entries of the mass matrix to the eigenvalue file...");
           exit(0);
       }
       
       /* storing the eigenvectors */
       
       lfin=0;
       lint=0;
       for(j=0;j<nev;++j){
           lint=lfin;
           lfin=lfin+2*neq[1];
           if(fwrite(&zz[lint],sizeof(double),2*neq[1],f1)!=2*neq[1]){
           printf("*ERROR in complexfreq saving the eigenvectors to the eigenvalue file...");
           exit(0);
           }
       }
       
       /* storing the orthogonality matrices */
       
       if(fwrite(xmr,sizeof(double),nev*nev,f1)!=nev*nev){
           printf("*ERROR in complexfreq saving the real orthogonality matrix to the eigenvalue file...");
           exit(0);
       }
       
       if(fwrite(xmi,sizeof(double),nev*nev,f1)!=nev*nev){
           printf("*ERROR in complexfreq saving the imaginary orthogonality matrix to the eigenvalue file...");
           exit(0);
       }
       
       }else{
       
       /* opening .eig file for writing */
       
       if((f1=fopen(fneig,"wb"))==NULL){
           printf("*ERROR in complexfreq: cannot open eigenvalue file for writing...");
           exit(0);
       }
       /* storing a one as indication that this was a
          cyclic symmetry calculation */
       
       if(fwrite(&cyclicsymmetry,sizeof(ITG),1,f1)!=1){
           printf("*ERROR in complexfreq saving the cyclic symmetry flag to the eigenvalue file...");
           exit(0);
       }
       
       /* not Hermitian */
       
       if(fwrite(&nherm,sizeof(ITG),1,f1)!=1){
           printf("*ERROR in complexfreq saving the Hermitian flag to the eigenvalue file...");
           exit(0);
       }
       
       if(fwrite(&nm[0],sizeof(ITG),1,f1)!=1){
           printf("*ERROR in complexfreq saving the nodal diameter to the eigenvalue file...");
           exit(0);
       }
       if(fwrite(&nev,sizeof(ITG),1,f1)!=1){
           printf("*ERROR in complexfreq saving the number of eigenvalues to the eigenvalue file...");
           exit(0);
       }
       
       /* the eigenfrequencies are stored as (radians/time)**2
          squaring the complexe eigenvalues first */
       
       NNEW(eigx,double,2*nev);
       for(i=0;i<nev;i++){
           eigx[2*i]=eigxx[2*i]*eigxx[2*i]-eigxx[2*i+1]*eigxx[2*i+1];
           eigx[2*i+1]=2.*eigxx[2*i]*eigxx[2*i+1];
       }
       
       if(fwrite(eigx,sizeof(double),2*nev,f1)!=2*nev){
           printf("*ERROR in complexfreq saving the eigenfrequencies to the eigenvalue file...");
           exit(0);
       }
       
       SFREE(eigx);
       
       /* storing the mass matrix */
       
       if(fwrite(adb,sizeof(double),*neq,f1)!=*neq){
           printf("*ERROR in complexfreq saving the diagonal of the mass matrix to the eigenvalue file...");
           exit(0);
       }
       if(fwrite(aub,sizeof(double),*nzs,f1)!=*nzs){
           printf("*ERROR in complexfreq saving the off-diagonal terms of the mass matrix to the eigenvalue file...");
           exit(0);
       }
       
       /* storing the eigenvectors */
       
       lfin=0;
       for(j=0;j<nev;++j){
           lint=lfin;
           lfin=lfin+neq[1];
           if(fwrite(&zz[lint],sizeof(double),neq[1],f1)!=neq[1]){
           printf("*ERROR in complexfreq saving the eigenvectors to the eigenvalue file...");
           exit(0);
           }
       }
       
       /* storing the orthogonality matrices */
       
       if(fwrite(xmr,sizeof(double),nev*nev,f1)!=nev*nev){
           printf("*ERROR in complexfreq saving the real orthogonality matrix to the eigenvalue file...");
           exit(0);
       }
       
       if(fwrite(xmi,sizeof(double),nev*nev,f1)!=nev*nev){
           printf("*ERROR in complexfreq saving the imaginary orthogonality matrix to the eigenvalue file...");
           exit(0);
       }
       }
       SFREE(xmr);SFREE(xmi);
       
       fclose(f1);
   }
 
   SFREE(adb);SFREE(aub);
   if(!cyclicsymmetry){SFREE(ad);SFREE(au);}
 
   /* calculating the displacements and the stresses and storing */
   /* the results in frd format for each valid eigenmode */
 
   NNEW(v,double,2*mt**nk);
   NNEW(fn,double,2*mt**nk);
   if((strcmp1(&filab[174],"S   ")==0)||(strcmp1(&filab[1653],"MAXS")==0)|| 
      (strcmp1(&filab[1479],"PHS ")==0)||(strcmp1(&filab[1044],"ZZS ")==0)||
      (strcmp1(&filab[1044],"ERR ")==0)) 
       NNEW(stn,double,12**nk);
 
   if((strcmp1(&filab[261],"E   ")==0)||(strcmp1(&filab[2523],"MAXE")==0)) 
       NNEW(een,double,12**nk);
   if(strcmp1(&filab[522],"ENER")==0) NNEW(enern,double,2**nk);
   if(strcmp1(&filab[2697],"ME  ")==0) NNEW(emn,double,12**nk);
 
   NNEW(inum,ITG,*nk);
   NNEW(stx,double,2*6*mi[0]**ne);
   
   NNEW(coefmpcnew,double,*mpcend);
 
   NNEW(cot,double,3**nk*ngraph);
   if(*ntrans>0){NNEW(inotrt,ITG,2**nk*ngraph);}
   if((strcmp1(&filab[0],"U  ")==0)||(strcmp1(&filab[870],"PU  ")==0))
 
 // real and imaginary part of the displacements
 
     NNEW(vt,double,2*mt**nk*ngraph);
   if(strcmp1(&filab[87],"NT  ")==0)
     NNEW(t1t,double,*nk*ngraph);
   if((strcmp1(&filab[174],"S   ")==0)||(strcmp1(&filab[1479],"PHS ")==0)||
      (strcmp1(&filab[1044],"ZZS ")==0)||(strcmp1(&filab[1044],"ERR ")==0))
 
 // real and imaginary part of the stresses
 
     NNEW(stnt,double,2*6**nk*ngraph);
   if(strcmp1(&filab[261],"E   ")==0) 
       NNEW(eent,double,2*6**nk*ngraph);
   if((strcmp1(&filab[348],"RF  ")==0)||(strcmp1(&filab[2610],"PRF ")==0))
 
 // real and imaginary part of the forces
 
     NNEW(fnt,double,2*mt**nk*ngraph);
   if(strcmp1(&filab[522],"ENER")==0)
     NNEW(enernt,double,*nk*ngraph);
   if((strcmp1(&filab[1044],"ZZS ")==0)||(strcmp1(&filab[1044],"ERR ")==0))
     NNEW(stxt,double,2*6*mi[0]**ne*ngraph);
   if(strcmp1(&filab[2697],"ME  ")==0) 
       NNEW(emnt,double,2*6**nk*ngraph);
 
   NNEW(kont,ITG,*nkon*ngraph);
   NNEW(ipkont,ITG,*ne*ngraph);
   for(l=0;l<*ne*ngraph;l++)ipkont[l]=-1;
   NNEW(lakont,char,8**ne*ngraph);
   NNEW(inumt,ITG,*nk*ngraph);
   NNEW(ielmatt,ITG,mi[2]**ne*ngraph);
 
   nkt=ngraph**nk;
   net=ngraph**ne;
 
   /* copying the coordinates of the first sector */
 
   for(l=0;l<3**nk;l++){cot[l]=co[l];}
   if(*ntrans>0){for(l=0;l<*nk;l++){inotrt[2*l]=inotr[2*l];}}
   for(l=0;l<*nkon;l++){kont[l]=kon[l];}
   for(l=0;l<*ne;l++){ipkont[l]=ipkon[l];}
   for(l=0;l<8**ne;l++){lakont[l]=lakon[l];}
   for(l=0;l<*ne;l++){ielmatt[mi[2]*l]=ielmat[mi[2]*l];}
 
   /* generating the coordinates for the other sectors */
 
   if(cyclicsymmetry){
 
     icntrl=1;
     
     FORTRAN(rectcyl,(cot,v,fn,stn,qfn,een,cs,nk,&icntrl,t,filab,&imag,mi,emn));
     
     for(jj=0;jj<*mcs;jj++){
       is=cs[17*jj+4];
       for(i=1;i<is;i++){
     
     theta=i*2.*pi/cs[17*jj];
     
     for(l=0;l<*nk;l++){
       if(inocs[l]==jj){
         cot[3*l+i*3**nk]=cot[3*l];
         cot[1+3*l+i*3**nk]=cot[1+3*l]+theta;
         cot[2+3*l+i*3**nk]=cot[2+3*l];
         if(*ntrans>0){inotrt[2*l+i*2**nk]=inotrt[2*l];}
       }
     }
     for(l=0;l<*nkon;l++){kont[l+i**nkon]=kon[l]+i**nk;}
     for(l=0;l<*ne;l++){
       if(ielcs[l]==jj){
         if(ipkon[l]>=0){
           ipkont[l+i**ne]=ipkon[l]+i**nkon;
           ielmatt[mi[2]*(l+i**ne)]=ielmat[mi[2]*l];
           for(l1=0;l1<8;l1++){
         l2=8*l+l1;
         lakont[l2+i*8**ne]=lakon[l2];
           }
         }
       }
     }
       }
     }
     
     icntrl=-1;
     
     FORTRAN(rectcyl,(cot,vt,fnt,stnt,qfnt,eent,cs,&nkt,&icntrl,t,filab,
              &imag,mi,emnt));
   }
 
   /* check that the tensor fields which are extrapolated from the
      integration points are requested in global coordinates */
 
   if(strcmp1(&filab[174],"S   ")==0){
       if((strcmp1(&filab[179],"L")==0)&&(*norien>0)){
       printf("\n*WARNING in complexfreq: element fields in cyclic symmetry calculations\n cannot be requested in local orientations;\n the global orientation will be used \n\n");
       strcpy1(&filab[179],"G",1);
     }
   }
 
   if(strcmp1(&filab[261],"E   ")==0){
       if((strcmp1(&filab[266],"L")==0)&&(*norien>0)){
       printf("\n*WARNING in complexfreq: element fields in cyclic symmetry calculation\n cannot be requested in local orientations;\n the global orientation will be used \n\n");
       strcpy1(&filab[266],"G",1);
     }
   }
 
   if(strcmp1(&filab[1479],"PHS ")==0){
       if((strcmp1(&filab[1484],"L")==0)&&(*norien>0)){
       printf("\n*WARNING in complexfreq: element fields in cyclic symmetry calculation\n cannot be requested in local orientations;\n the global orientation will be used \n\n");
       strcpy1(&filab[1484],"G",1);
     }
   }
 
   if(strcmp1(&filab[1653],"MAXS")==0){
       if((strcmp1(&filab[1658],"L")==0)&&(*norien>0)){
       printf("\n*WARNING in complexfreq: element fields in cyclic symmetry calculation\n cannot be requested in local orientations;\n the global orientation will be used \n\n");
       strcpy1(&filab[1658],"G",1);
     }
   }   
 
   if(strcmp1(&filab[2523],"MAXE")==0){
       if((strcmp1(&filab[2528],"L")==0)&&(*norien>0)){
       printf("\n*WARNING in complexfreq: element fields in cyclic symmetry calculation\n cannot be requested in local orientations;\n the global orientation will be used \n\n");
       strcpy1(&filab[1658],"G",1);
     }
   }   
 
   /* allocating fields for magnitude and phase information of
      displacements and stresses */
 
   if(strcmp1(&filab[870],"PU")==0){
     NNEW(vr,double,mt*nkt);
     NNEW(vi,double,mt*nkt);
   }
 
   if(strcmp1(&filab[1479],"PHS")==0){
     NNEW(stnr,double,6*nkt);
     NNEW(stni,double,6*nkt);
   }
 
   if(strcmp1(&filab[1566],"MAXU")==0){
     NNEW(vmax,double,4*nkt);
   }
 
   if(strcmp1(&filab[1653],"MAXS")==0){
     NNEW(stnmax,double,7*nkt);
   }
 
   if(strcmp1(&filab[2523],"MAXE")==0){
     NNEW(eenmax,double,7*nkt);
   }
 
   /* storing the results */
 
   if(!cyclicsymmetry) (neq[1])*=2;
 
   lfin=0;
   for(j=0;j<nev;++j){
     lint=lfin;
     lfin=lfin+neq[1];
 
     /* calculating the cosine and sine */
 
     for(k=0;k<*mcs;k++){
     theta=nm[j]*2.*pi/cs[17*k];
     cs[17*k+14]=cos(theta);
     cs[17*k+15]=sin(theta);
     }
 
     if(*nprint>0)FORTRAN(writehe,(&j));
 
     NNEW(eei,double,6*mi[0]**ne);
     if(*nener==1){
     NNEW(stiini,double,6*mi[0]**ne);
     NNEW(emeini,double,6*mi[0]**ne);
     NNEW(enerini,double,mi[0]**ne);}
 
     DMEMSET(v,0,2*mt**nk,0.);
 
     for(k=0;k<neq[1];k+=neq[1]/2){
 
       for(i=0;i<6*mi[0]**ne;i++){eme[i]=0.;}
 
       if(k==0) {kk=0;kkv=0;kk6=0;kkx=0;if(*nprint>0)FORTRAN(writere,());}
       else {kk=*nk;kkv=mt**nk;kk6=6**nk;kkx=6*mi[0]**ne;
             if(*nprint>0)FORTRAN(writeim,());}
 
     /* generating the cyclic MPC's (needed for nodal diameters
        different from 0 */
 
       for(i=0;i<*nmpc;i++){
     index=ipompc[i]-1;
         /* check whether thermal mpc */
     if(nodempc[3*index+1]==0) continue;
     coefmpcnew[index]=coefmpc[index];
     while(1){
       index=nodempc[3*index+2];
       if(index==0) break;
       index--;
 
       icomplex=0;
       inode=nodempc[3*index];
       if(strcmp1(&labmpc[20*i],"CYCLIC")==0){
             icomplex=atoi(&labmpc[20*i+6]);}
       else if(strcmp1(&labmpc[20*i],"SUBCYCLIC")==0){
             for(ij=0;ij<*mcs;ij++){
               lprev=cs[ij*17+13];
               ilength=cs[ij*17+3];
               FORTRAN(nident,(&ics[lprev],&inode,&ilength,&id));
               if(id!=0){
                 if(ics[lprev+id-1]==inode){icomplex=ij+1;break;}
               }
             }
       }
 
           if(icomplex!=0){
         idir=nodempc[3*index+1];
         idof=nactdof[mt*(inode-1)+idir]-1;
             if(idof<=-1){xreal=1.;ximag=1.;}
             else{xreal=zz[lint+idof];ximag=zz[lint+idof+neq[1]/2];}
             if(k==0) {
               if(fabs(xreal)<1.e-30)xreal=1.e-30;
           coefmpcnew[index]=coefmpc[index]*
         (cs[17*(icomplex-1)+14]+ximag/xreal*cs[17*(icomplex-1)+15]);}
         else {
               if(fabs(ximag)<1.e-30)ximag=1.e-30;
               coefmpcnew[index]=coefmpc[index]*
         (cs[17*(icomplex-1)+14]-xreal/ximag*cs[17*(icomplex-1)+15]);}
           }
       else{coefmpcnew[index]=coefmpc[index];}
     }
       }
 
       if(*iperturb==0){
     results(co,nk,kon,ipkon,lakon,ne,&v[kkv],&stn[kk6],inum,
             &stx[kkx],elcon,
         nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat,ielorien,
         norien,orab,ntmat_,t0,t0,ithermal,
         prestr,iprestr,filab,eme,&emn[kk6],&een[kk6],iperturb,
         f,&fn[kkv],nactdof,&iout,qa,vold,&zz[lint+k],
         nodeboun,ndirboun,xboun,nboun,ipompc,
         nodempc,coefmpcnew,labmpc,nmpc,nmethod,cam,&neq[1],veold,accold,
             &bet,&gam,&dtime,&time,ttime,plicon,nplicon,plkcon,nplkcon,
         xstateini,xstiff,xstate,npmat_,epn,matname,mi,&ielas,&icmd,
         ncmat_,nstate_,stiini,vini,ikboun,ilboun,ener,&enern[kk],emeini,
             xstaten,eei,enerini,cocon,ncocon,set,nset,istartset,iendset,
             ialset,nprint,prlab,prset,qfx,qfn,trab,inotr,ntrans,fmpc,
         nelemload,nload,ikmpc,ilmpc,istep,&iinc,springarea,&reltime,
             &ne0,xforc,nforc,thicke,shcon,nshcon,
             sideload,xload,xloadold,&icfd,inomat,pslavsurf,pmastsurf,
         &mortar,islavact,cdn,islavnode,nslavnode,ntie,clearini,
         islavsurf,ielprop,prop,energyini,energy,&iit,iponoel,
         inoel,nener,orname,&network,ipobody,xbody,ibody);}
       else{
     results(co,nk,kon,ipkon,lakon,ne,&v[kkv],&stn[kk6],inum,
             &stx[kkx],elcon,
         nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat,ielorien,
         norien,orab,ntmat_,t0,t1old,ithermal,
         prestr,iprestr,filab,eme,&emn[kk6],&een[kk6],iperturb,
             f,&fn[kkv],nactdof,&iout,qa,vold,&zz[lint+k],
         nodeboun,ndirboun,xboun,nboun,ipompc,
         nodempc,coefmpcnew,labmpc,nmpc,nmethod,cam,&neq[1],veold,accold,
             &bet,&gam,&dtime,&time,ttime,plicon,nplicon,plkcon,nplkcon,
         xstateini,xstiff,xstate,npmat_,epn,matname,mi,&ielas,&icmd,
         ncmat_,nstate_,stiini,vini,ikboun,ilboun,ener,&enern[kk],emeini,
             xstaten,eei,enerini,cocon,ncocon,set,nset,istartset,iendset,
             ialset,nprint,prlab,prset,qfx,qfn,trab,inotr,ntrans,fmpc,
         nelemload,nload,ikmpc,ilmpc,istep,&iinc,springarea,&reltime,
             &ne0,xforc,nforc,thicke,shcon,nshcon,
             sideload,xload,xloadold,&icfd,inomat,pslavsurf,pmastsurf,
         &mortar,islavact,cdn,islavnode,nslavnode,ntie,clearini,
         islavsurf,ielprop,prop,energyini,energy,&iit,iponoel,
         inoel,nener,orname,&network,ipobody,xbody,ibody);
       }
 
     }
     SFREE(eei);
     if(*nener==1){SFREE(stiini);SFREE(emeini);SFREE(enerini);}
    
     /* changing the basic results into cylindrical coordinates
        (only for cyclic symmetry structures */
 
     for(l=0;l<*nk;l++){inumt[l]=inum[l];}
 
     if(cyclicsymmetry){
       icntrl=2;imag=1;      
       FORTRAN(rectcyl,(co,v,fn,stn,qfn,een,cs,nk,&icntrl,t,filab,&imag,mi,emn));
     }
 
     /* copying the basis results (real and imaginary) into
        a new field */
 
     if((strcmp1(&filab[0],"U  ")==0)||(strcmp1(&filab[870],"PU  ")==0)){
       for(l=0;l<mt**nk;l++){vt[l]=v[l];}
       for(l=0;l<mt**nk;l++){vt[l+mt**nk*ngraph]=v[l+mt**nk];}}
     if(strcmp1(&filab[87],"NT  ")==0)
       for(l=0;l<*nk;l++){t1t[l]=t1[l];};
     if((strcmp1(&filab[174],"S   ")==0)||(strcmp1(&filab[1479],"PHS ")==0)){
     for(l=0;l<6**nk;l++){stnt[l]=stn[l];}
     for(l=0;l<6**nk;l++){stnt[l+6**nk*ngraph]=stn[l+6**nk];}}
     if(strcmp1(&filab[261],"E   ")==0){
     for(l=0;l<6**nk;l++){eent[l]=een[l];};
     for(l=0;l<6**nk;l++){eent[l+6**nk*ngraph]=een[l+6**nk];}}
     if((strcmp1(&filab[348],"RF  ")==0)||(strcmp1(&filab[2610],"PRF ")==0)){
       for(l=0;l<mt**nk;l++){fnt[l]=fn[l];}
       for(l=0;l<mt**nk;l++){fnt[l+mt**nk*ngraph]=fn[l+mt**nk];}}
     if(strcmp1(&filab[522],"ENER")==0)
       for(l=0;l<*nk;l++){enernt[l]=enern[l];};
     if((strcmp1(&filab[1044],"ZZS ")==0)||(strcmp1(&filab[1044],"ERR ")==0)){
       for(l=0;l<6*mi[0]**ne;l++){stxt[l]=stx[l];}
       for(l=0;l<6*mi[0]**ne;l++){stxt[l+6*mi[0]**ne*ngraph]=stx[l+6*mi[0]**ne];}}
     if(strcmp1(&filab[2697],"ME  ")==0){
     for(l=0;l<6**nk;l++){emnt[l]=emn[l];};
     for(l=0;l<6**nk;l++){emnt[l+6**nk*ngraph]=emn[l+6**nk];}}
     
     /* mapping the results to the other sectors
        (only for cyclic symmetric structures */
 
     if(cyclicsymmetry){
 
       for(jj=0;jj<*mcs;jj++){
     ilength=cs[17*jj+3];
     is=cs[17*jj+4];
     lprev=cs[17*jj+13];
     for(i=1;i<is;i++){
       
       for(l=0;l<*nk;l++){inumt[l+i**nk]=inum[l];}
       
       theta=i*nm[j]*2.*pi/cs[17*jj];
       ctl=cos(theta);
       stl=sin(theta);
       
       if((strcmp1(&filab[0],"U  ")==0)||(strcmp1(&filab[870],"PU  ")==0)){
         for(l1=0;l1<*nk;l1++){
           if(inocs[l1]==jj){
         
         /* check whether node lies on axis */
         
         ml1=-l1-1;
         FORTRAN(nident,(&ics[lprev],&ml1,&ilength,&id));
         if(id!=0){
           if(ics[lprev+id-1]==ml1){
             for(l2=0;l2<4;l2++){
               l=mt*l1+l2;
               vt[l+mt**nk*i]=v[l];
             }
             continue;
           }
         }
         for(l2=0;l2<4;l2++){
           l=mt*l1+l2;
           vt[l+mt**nk*i]=ctl*v[l]-stl*v[l+mt**nk];
         }
         
           }
         }
       }
       
       /* imaginary part of the displacements in cylindrical
          coordinates */
       
       if((strcmp1(&filab[0],"U  ")==0)||(strcmp1(&filab[870],"PU  ")==0)){
         for(l1=0;l1<*nk;l1++){
           if(inocs[l1]==jj){
         
         /* check whether node lies on axis */
         
         ml1=-l1-1;
         FORTRAN(nident,(&ics[lprev],&ml1,&ilength,&id));
         if(id!=0){
           if(ics[lprev+id-1]==ml1){
             for(l2=0;l2<4;l2++){
               l=mt*l1+l2;
               vt[l+mt**nk*(i+ngraph)]=v[l+mt**nk];
             }
             continue;
           }
         }
         for(l2=0;l2<4;l2++){
           l=mt*l1+l2;
           vt[l+mt**nk*(i+ngraph)]=stl*v[l]+ctl*v[l+mt**nk];
         }
           }
         }
       }
       
       if(strcmp1(&filab[87],"NT  ")==0){
         for(l=0;l<*nk;l++){
           if(inocs[l]==jj) t1t[l+*nk*i]=t1[l];
         }
       }
       
       if((strcmp1(&filab[174],"S   ")==0)||(strcmp1(&filab[1479],"PHS ")==0)){
         for(l1=0;l1<*nk;l1++){
           if(inocs[l1]==jj){
         
         /* check whether node lies on axis */
         
         ml1=-l1-1;
         FORTRAN(nident,(&ics[lprev],&ml1,&ilength,&id));
         if(id!=0){
           if(ics[lprev+id-1]==ml1){
             for(l2=0;l2<6;l2++){
               l=6*l1+l2;
               stnt[l+6**nk*i]=stn[l];
             }
             continue;
           }
         }
         for(l2=0;l2<6;l2++){
           l=6*l1+l2;
           stnt[l+6**nk*i]=ctl*stn[l]-stl*stn[l+6**nk];
         }
           }
         }
       }
       
       /* imaginary part of the stresses in cylindrical
          coordinates */
       
       if((strcmp1(&filab[174],"S   ")==0)||(strcmp1(&filab[1479],"PHS ")==0)){
         for(l1=0;l1<*nk;l1++){
           if(inocs[l1]==jj){
         
         /* check whether node lies on axis */
         
         ml1=-l1-1;
         FORTRAN(nident,(&ics[lprev],&ml1,&ilength,&id));
         if(id!=0){
           if(ics[lprev+id-1]==ml1){
             for(l2=0;l2<6;l2++){
               l=6*l1+l2;
               stnt[l+6**nk*(i+ngraph)]=stn[l+6**nk];
             }
             continue;
           }
         }
         for(l2=0;l2<6;l2++){
           l=6*l1+l2;
           stnt[l+6**nk*(i+ngraph)]=stl*stn[l]+ctl*stn[l+6**nk];
         }
           }
         }
       }
       
       if(strcmp1(&filab[261],"E   ")==0){
         for(l1=0;l1<*nk;l1++){
           if(inocs[l1]==jj){
         
         /* check whether node lies on axis */
         
         ml1=-l1-1;
         FORTRAN(nident,(&ics[lprev],&ml1,&ilength,&id));
         if(id!=0){
           if(ics[lprev+id-1]==ml1){
             for(l2=0;l2<6;l2++){
               l=6*l1+l2;
               eent[l+6**nk*i]=een[l];
             }
             continue;
           }
         }
         for(l2=0;l2<6;l2++){
           l=6*l1+l2;
           eent[l+6**nk*i]=ctl*een[l]-stl*een[l+6**nk];
         }
           }
         }
       }
         
         /* imaginary part of the strains in cylindrical
            coordinates */
         
       if(strcmp1(&filab[261],"E   ")==0){
           for(l1=0;l1<*nk;l1++){
           if(inocs[l1]==jj){
               
               /* check whether node lies on axis */
               
               ml1=-l1-1;
               FORTRAN(nident,(&ics[lprev],&ml1,&ilength,&id));
               if(id!=0){
               if(ics[lprev+id-1]==ml1){
                   for(l2=0;l2<6;l2++){
                   l=6*l1+l2;
                   eent[l+6**nk*(i+ngraph)]=een[l+6**nk];
                   }
                   continue;
               }
               }
               for(l2=0;l2<6;l2++){
               l=6*l1+l2;
               eent[l+6**nk*(i+ngraph)]=stl*een[l]+ctl*een[l+6**nk];
               }
           }
           }
       }
       
       if(strcmp1(&filab[2697],"ME  ")==0){
         for(l1=0;l1<*nk;l1++){
           if(inocs[l1]==jj){
         
         /* check whether node lies on axis */
         
         ml1=-l1-1;
         FORTRAN(nident,(&ics[lprev],&ml1,&ilength,&id));
         if(id!=0){
           if(ics[lprev+id-1]==ml1){
             for(l2=0;l2<6;l2++){
               l=6*l1+l2;
               emnt[l+6**nk*i]=emn[l];
             }
             continue;
           }
         }
         for(l2=0;l2<6;l2++){
           l=6*l1+l2;
           emnt[l+6**nk*i]=ctl*emn[l]-stl*emn[l+6**nk];
         }
           }
         }
       }
         
         /* imaginary part of the mechanical strains in cylindrical
            coordinates */
         
       if(strcmp1(&filab[2697],"ME  ")==0){
           for(l1=0;l1<*nk;l1++){
           if(inocs[l1]==jj){
               
               /* check whether node lies on axis */
               
               ml1=-l1-1;
               FORTRAN(nident,(&ics[lprev],&ml1,&ilength,&id));
               if(id!=0){
               if(ics[lprev+id-1]==ml1){
                   for(l2=0;l2<6;l2++){
                   l=6*l1+l2;
                   emnt[l+6**nk*(i+ngraph)]=emn[l+6**nk];
                   }
                   continue;
               }
               }
               for(l2=0;l2<6;l2++){
               l=6*l1+l2;
               emnt[l+6**nk*(i+ngraph)]=stl*emn[l]+ctl*emn[l+6**nk];
               }
           }
           }
       }
       
       if((strcmp1(&filab[348],"RF  ")==0)||(strcmp1(&filab[2610],"PRF ")==0)){
         for(l1=0;l1<*nk;l1++){
           if(inocs[l1]==jj){
         
         /* check whether node lies on axis */
         
         ml1=-l1-1;
         FORTRAN(nident,(&ics[lprev],&ml1,&ilength,&id));
         if(id!=0){
           if(ics[lprev+id-1]==ml1){
             for(l2=0;l2<4;l2++){
               l=mt*l1+l2;
               fnt[l+mt**nk*i]=fn[l];
             }
             continue;
           }
         }
         for(l2=0;l2<4;l2++){
           l=mt*l1+l2;
           fnt[l+mt**nk*i]=ctl*fn[l]-stl*fn[l+mt**nk];
         }
           }
         }
       }
         
         /* imaginary part of the forces in cylindrical
            coordinates */
 
       if((strcmp1(&filab[348],"RF  ")==0)||(strcmp1(&filab[2610],"PRF ")==0)){
           for(l1=0;l1<*nk;l1++){
           if(inocs[l1]==jj){
               
               /* check whether node lies on axis */
               
               ml1=-l1-1;
               FORTRAN(nident,(&ics[lprev],&ml1,&ilength,&id));
               if(id!=0){
               if(ics[lprev+id-1]==ml1){
                   for(l2=0;l2<4;l2++){
                   l=mt*l1+l2;
                   fnt[l+mt**nk*(i+ngraph)]=fn[l+mt**nk];
                   }
                   continue;
               }
               }
               for(l2=0;l2<4;l2++){
               l=mt*l1+l2;
               fnt[l+mt**nk*(i+ngraph)]=stl*fn[l]+ctl*fn[l+mt**nk];
               }
           }
           }
       }
       
       if(strcmp1(&filab[522],"ENER")==0){
         for(l=0;l<*nk;l++){
           if(inocs[l]==jj) enernt[l+*nk*i]=0.;
         }
       }
     }
       }
       
       icntrl=-2;imag=0;
       
       FORTRAN(rectcyl,(cot,vt,fnt,stnt,qfnt,eent,cs,&nkt,&icntrl,t,filab,
                &imag,mi,emnt));
       
       FORTRAN(rectcylvi,(cot,&vt[mt**nk*ngraph],&fnt[mt**nk*ngraph],
                          &stnt[6**nk*ngraph],qfnt,&eent[6**nk*ngraph],
                          cs,&nkt,&icntrl,t,filab,&imag,mi,&emnt[6**nk*ngraph]));
       
     }
 
     /* determining magnitude and phase angle for the displacements */
 
     if(strcmp1(&filab[870],"PU")==0){
       for(l1=0;l1<nkt;l1++){
     for(l2=0;l2<4;l2++){
       l=mt*l1+l2;
       vreal=vt[l];
       vimag=vt[l+mt**nk*ngraph];
       vr[l]=sqrt(vreal*vreal+vimag*vimag);
       if(fabs(vreal)<1.e-10){
         if(vimag>0){vi[l]=90.;}
         else{vi[l]=-90.;}
       }
       else{
         vi[l]=atan(vimag/vreal)*constant;
         if(vreal<0) vi[l]+=180.;
       }
     }
       }
     }
 
     /* determining magnitude and phase for the stress */
 
     if(strcmp1(&filab[1479],"PHS")==0){
       for(l1=0;l1<nkt;l1++){
     for(l2=0;l2<6;l2++){
       l=6*l1+l2;
       stnreal=stnt[l];
       stnimag=stnt[l+6**nk*ngraph];
       stnr[l]=sqrt(stnreal*stnreal+stnimag*stnimag);
       if(fabs(stnreal)<1.e-10){
         if(stnimag>0){stni[l]=90.;}
         else{stni[l]=-90.;}
       }
       else{
         stni[l]=atan(stnimag/stnreal)*constant;
         if(stnreal<0) stni[l]+=180.;
       }
     }
       }
     }
 
     ++*kode;
 
     /* storing the real part of the eigenfrequencies in freq */
 
     freq=eigxx[2*j]/6.283185308;
     if(strcmp1(&filab[1044],"ZZS")==0){
     NNEW(neigh,ITG,40*net);
     NNEW(ipneigh,ITG,nkt);
     }
     frd(cot,&nkt,kont,ipkont,lakont,&net,vt,stnt,inumt,nmethod,
         kode,filab,eent,t1t,fnt,&freq,epn,ielmatt,matname,enernt,xstaten,
         nstate_,istep,&iinc,ithermal,qfn,&j,&nm[j],trab,inotrt,
         ntrans,orab,ielorien,norien,description,ipneigh,neigh,
         mi,stxt,vr,vi,stnr,stni,vmax,stnmax,&ngraph,veold,ener,&net,
         cs,set,nset,istartset,iendset,ialset,eenmax,fnr,fni,emnt,
         thicke,jobnamec,output,qfx,cdn,&mortar,cdnr,cdni,nmat);
     if(strcmp1(&filab[1044],"ZZS")==0){SFREE(ipneigh);SFREE(neigh);}
   }
 
   SFREE(xstiff);if(*nbody>0) SFREE(ipobody);
   SFREE(cstr);SFREE(zz);SFREE(eigxx);SFREE(xx);
 
   if(cyclicsymmetry){
       SFREE(istartnmd);SFREE(iendnmd);
   }else{
       (neq[1])/=2;
   }
 
   SFREE(nm);SFREE(coefmpcnew);
 
   if((strcmp1(&filab[174],"S   ")==0)||(strcmp1(&filab[1653],"MAXS")==0)|| 
      (strcmp1(&filab[1479],"PHS ")==0)||(strcmp1(&filab[1044],"ZZS ")==0)||
      (strcmp1(&filab[1044],"ERR ")==0)) 
      SFREE(stn);
 
   SFREE(v);SFREE(fn);SFREE(inum);SFREE(stx);
 
   if((strcmp1(&filab[261],"E   ")==0)||(strcmp1(&filab[2523],"MAXE")==0)) SFREE(een);
   if(strcmp1(&filab[522],"ENER")==0) SFREE(enern);
   if(strcmp1(&filab[2697],"ME  ")==0) SFREE(emn);
 
   if((strcmp1(&filab[0],"U  ")==0)||(strcmp1(&filab[870],"PU  ")==0)) SFREE(vt);
   if(strcmp1(&filab[87],"NT  ")==0) SFREE(t1t);
   if((strcmp1(&filab[174],"S   ")==0)||(strcmp1(&filab[1479],"PHS ")==0)||
      (strcmp1(&filab[1044],"ZZS ")==0)||(strcmp1(&filab[1044],"ERR ")==0)) SFREE(stnt);
   if(strcmp1(&filab[261],"E   ")==0) SFREE(eent);
   if((strcmp1(&filab[348],"RF  ")==0)||(strcmp1(&filab[2610],"PRF ")==0)) SFREE(fnt);
   if(strcmp1(&filab[522],"ENER")==0) SFREE(enernt);
   if((strcmp1(&filab[1044],"ZZS ")==0)||(strcmp1(&filab[1044],"ERR ")==0)) SFREE(stxt);
   if(strcmp1(&filab[2697],"ME  ")==0) SFREE(emnt);
 
   SFREE(cot);SFREE(kont);SFREE(ipkont);SFREE(lakont);SFREE(inumt);SFREE(ielmatt);
   if(*ntrans>0){SFREE(inotrt);}
 
   *ialsetp=ialset;
   *cop=co;*konp=kon;*ipkonp=ipkon;*lakonp=lakon;*ielmatp=ielmat;
   *ielorienp=ielorien;*inotrp=inotr;*nodebounp=nodeboun;
   *ndirbounp=ndirboun;*iambounp=iamboun;*xbounp=xboun;
   *xbounoldp=xbounold;*ikbounp=ikboun;*ilbounp=ilboun;*nactdofp=nactdof;
   *voldp=vold;*emep=eme;*enerp=ener;*ipompcp=ipompc;*nodempcp=nodempc;
   *coefmpcp=coefmpc;*labmpcp=labmpc;*ikmpcp=ikmpc;*ilmpcp=ilmpc;
   *fmpcp=fmpc;*veoldp=veold;*iamt1p=iamt1;*t0p=t0;*t1oldp=t1old;*t1p=t1;
   *stip=sti;
 
   return;
 }

◆ contact()

void contact	(	ITG *	ncont,
		ITG *	ntie,
		char *	tieset,
		ITG *	nset,
		char *	set,
		ITG *	istartset,
		ITG *	iendset,
		ITG *	ialset,
		ITG *	itietri,
		char *	lakon,
		ITG *	ipkon,
		ITG *	kon,
		ITG *	koncont,
		ITG *	ne,
		double *	cg,
		double *	straight,
		ITG *	ifree,
		double *	co,
		double *	vold,
		ITG *	ielmat,
		double *	cs,
		double *	elcon,
		ITG *	istep,
		ITG *	iinc,
		ITG *	iit,
		ITG *	ncmat_,
		ITG *	ntmat_,
		ITG *	ne0,
		double *	vini,
		ITG *	nmethod,
		ITG *	iperturb,
		ITG *	ikboun,
		ITG *	nboun,
		ITG *	mi,
		ITG *	imastop,
		ITG *	nslavnode,
		ITG *	islavnode,
		ITG *	islavsurf,
		ITG *	itiefac,
		double *	areaslav,
		ITG *	iponoels,
		ITG *	inoels,
		double *	springarea,
		double *	tietol,
		double *	reltime,
		ITG *	imastnode,
		ITG *	nmastnode,
		double *	xmastnor,
		char *	filab,
		ITG *	mcs,
		ITG *	ics,
		ITG *	nasym,
		double *	xnoels,
		ITG *	mortar,
		double *	pslavsurf,
		double *	pmastsurf,
		double *	clearini,
		double *	theta,
		double *	xstateini,
		double *	xstate,
		ITG *	nstate_,
		ITG *	icutb,
		ITG *	ialeatoric,
		char *	jobnamef
	)

                                             {
 
     ITG i,ntrimax,*nx=NULL,*ny=NULL,*nz=NULL,im;
     
     double *xo=NULL,*yo=NULL,*zo=NULL,*x=NULL,*y=NULL,*z=NULL;
 
     /* next call is only for node-to-face penalty contact
        setting up bordering planes for the master triangles;
        these planes are common between neighboring traingles */
 
     if(*mortar==0){
 
     DMEMSET(xmastnor,0,3*nmastnode[*ntie],0.);
     
     FORTRAN(updatecontpen,(koncont,ncont,co,vold,
             cg,straight,mi,imastnode,nmastnode,xmastnor,
             ntie,tieset,nset,set,istartset,
             iendset,ialset,ipkon,lakon,kon,cs,mcs,ics));
     }
     
     /* determining the size of the auxiliary fields */
     
     ntrimax=0;
     for(i=0;i<*ntie;i++){
     if(itietri[2*i+1]-itietri[2*i]+1>ntrimax)
         ntrimax=itietri[2*i+1]-itietri[2*i]+1;
     }
     NNEW(xo,double,ntrimax);
     NNEW(yo,double,ntrimax);
     NNEW(zo,double,ntrimax);
     NNEW(x,double,ntrimax);
     NNEW(y,double,ntrimax);
     NNEW(z,double,ntrimax);
     NNEW(nx,ITG,ntrimax);
     NNEW(ny,ITG,ntrimax);
     NNEW(nz,ITG,ntrimax);
     
     if(*mortar==0){
     
     FORTRAN(gencontelem_n2f,(tieset,ntie,itietri,ne,ipkon,kon,lakon,
       cg,straight,ifree,koncont,
           co,vold,xo,yo,zo,x,y,z,nx,ny,nz,ielmat,elcon,istep,
           iinc,iit,ncmat_,ntmat_,nmethod,mi,
           imastop,nslavnode,islavnode,islavsurf,itiefac,areaslav,iponoels,
           inoels,springarea,
           set,nset,istartset,iendset,ialset,tietol,reltime,
       filab,nasym,xnoels,icutb,ne0,jobnamef));
 
     }else if(*mortar==1){
 
     FORTRAN(gencontelem_f2f,(tieset,ntie,itietri,ne,ipkon,kon,
       lakon,cg,straight,ifree,koncont,co,vold,xo,yo,zo,x,y,z,nx,ny,nz,
           ielmat,elcon,istep,iinc,iit,ncmat_,ntmat_,mi,imastop,islavsurf,
       itiefac,springarea,tietol,reltime,filab,nasym,pslavsurf,pmastsurf,
       clearini,theta,xstateini,xstate,nstate_,ne0,icutb,ialeatoric,
       nmethod,jobnamef));
 
     }
 
     SFREE(xo);SFREE(yo);SFREE(zo);SFREE(x);SFREE(y);SFREE(z);SFREE(nx);
     SFREE(ny);SFREE(nz);
   
     return;
 }

◆ ddotc1mt()

void* ddotc1mt ( ITG * i )

◆ dfdbj()

void dfdbj	(	double *	bcont,
		double **	dbcontp,
		ITG *	neq,
		ITG *	nope,
		ITG *	konl,
		ITG *	nactdof,
		double *	s,
		double *	z,
		ITG *	ikmpc,
		ITG *	ilmpc,
		ITG *	ipompc,
		ITG *	nodempc,
		ITG *	nmpc,
		double *	coefmpc,
		double *	fnl,
		ITG *	nev,
		ITG **	ikactcontp,
		ITG **	ilactcontp,
		ITG *	nactcont,
		ITG *	nactcont_,
		ITG *	mi,
		ITG *	cyclicsymmetry,
		ITG *	izdof,
		ITG *	nzdof
	)

                                   {
 
   ITG j,j1,jdof,kdof,k,k1,l,id,index,ist,id1,ist1,index1,id2,ist2,index2,
       jdbcontcol,i1,i3,i4,mt=mi[1]+1,im,*ikactcont=*ikactcontp,
       *ilactcont=*ilactcontp,kdofm1;
 
   double d1,sl,*dbcont=*dbcontp;
   
   for(j=0; j<*nope; j++){
       i1=mt*(konl[j]-1)+1;
       for(j1=0; j1<3; j1++){
       jdof=nactdof[i1+j1];
       if(jdof>0){
           jdof--;
           FORTRAN(nident,(ikactcont,&jdof,nactcont,&id));
           do{
           if(id>0){
               if(ikactcont[id-1]==jdof){
               jdbcontcol=ilactcont[id-1];
               break;
               }
           }
           (*nactcont)++;
           if(*nactcont>*nactcont_){
               *nactcont_=(ITG)(1.1**nactcont_);
               RENEW(ikactcont,ITG,*nactcont_);
               RENEW(ilactcont,ITG,*nactcont_);
               RENEW(dbcont,double,*nev**nactcont_);
           }
           k=*nactcont-1;
           l=k-1;
           while(k>id){
               ikactcont[k]=ikactcont[l];
               ilactcont[k--]=ilactcont[l--];
           }
           jdbcontcol=*nactcont;
           ikactcont[id]=jdof;
           ilactcont[id]=*nactcont;
 //        memset(&dbcont[(*nactcont-1)**nev],0,sizeof(double)**nev);
           DMEMSET(dbcont,(*nactcont-1)**nev,*nactcont**nev,0.);
           break;
           }while(1);
           bcont[jdof]-=fnl[j*3+j1];
           i4=(jdbcontcol-1)**nev;
           i3=(3*j+j1);
           for(k=0; k<*nope; k++){
           for(k1=0; k1<3; k1++){
               sl=s[(3*k+k1)*60+i3];
               kdof=nactdof[mt*(konl[k]-1)+k1+1];
               if(kdof>0){
               if(!(*cyclicsymmetry)){
               for(l=0; l<*nev; l++){
                   dbcont[i4+l]-=sl*z[(long long)l**neq+kdof-1];
               }
             }else{
               kdofm1=kdof-1;
               FORTRAN(nident,(izdof,&kdofm1,nzdof,&id));
               if(id!=0){
                 if(izdof[id-1]==kdofm1){
                   for(l=0; l<*nev; l++){
                 dbcont[i4+l]-=sl*z[l**nzdof+id-1];
                   }
                 }else{printf("*ERROR in dfdbj\n");FORTRAN(stop,());}
               }else{printf("*ERROR in dfdbj\n");FORTRAN(stop,());}
             }
               }
               else{
               kdof=8*(konl[k]-1)+k1+1;
               FORTRAN(nident,(ikmpc,&kdof,nmpc,&id));
               if(id>0){
                   id--;
                   if(ikmpc[id]==kdof){
                   id=ilmpc[id];
                   ist=ipompc[id-1];
                   ist--;
                   index=nodempc[ist*3+2];
                   if(index==0) continue;
                   index--;
                   do{
                       kdof=nactdof[mt*(nodempc[index*3]-1)+nodempc[index*3+1]];
                       d1=sl*coefmpc[index]/coefmpc[ist];
                       if(kdof>0){
                       if(!(*cyclicsymmetry)){
                       for(l=0; l<*nev; l++){
                         dbcont[i4+l]+=d1*z[(long long)l**neq+kdof-1];
                       }
                     }
                       }else{
                     kdofm1=kdof-1;
                     FORTRAN(nident,(izdof,&kdofm1,nzdof,&id));
                     if(id!=0){
                       if(izdof[id-1]==kdofm1){
                         for(l=0; l<*nev; l++){
                           dbcont[i4+l]+=d1*z[l**nzdof+id-1];
                         }
                       }else{printf("*ERROR in dfdbj\n");FORTRAN(stop,());}
                     }else{printf("*ERROR in dfdbj\n");FORTRAN(stop,());}
                       }
                       index=nodempc[index*3+2];
                       if(index==0) break;
                       index--;
                   }while(1);
                   }
               }
               }
           }
           }
       }
       else{
           jdof=8*(konl[j]-1)+j1+1;
           FORTRAN(nident,(ikmpc,&jdof,nmpc,&id1));
           if(id1>0){
           id1--;
           if(ikmpc[id1]==jdof){
               id1=ilmpc[id1];
               ist1=ipompc[id1-1];
               ist1--;
               index1=nodempc[ist1*3+2];
               if(index1==0) continue;
               index1--;
               do{
               jdof=nactdof[mt*(nodempc[index1*3]-1)+nodempc[index1*3+1]];
               if(jdof>0){
                   jdof--;
                   FORTRAN(nident,(ikactcont,&jdof,nactcont,&id));
                   do{
                   if(id>0){
                       if(ikactcont[id-1]==jdof){
                       jdbcontcol=ilactcont[id-1];
                       }
                   }
                   (*nactcont)++;
                   if(*nactcont>*nactcont_){
                       *nactcont_=(ITG)(1.1**nactcont_);
                       RENEW(ikactcont,ITG,*nactcont_);
                       RENEW(ilactcont,ITG,*nactcont_);
                       RENEW(dbcont,double,*nev**nactcont_);
                   }
                   k=*nactcont-1;
                   l=k-1;
                   do{
                       ikactcont[k]=ikactcont[l];
                       ilactcont[k--]=ilactcont[l--];
                   }while(k>id);
                   jdbcontcol=*nactcont;
                   ikactcont[id]=jdof;
                   ilactcont[id]=*nactcont;
 //                memset(&dbcont[(*nactcont-1)**nev],0,sizeof(double)**nev);          
                   DMEMSET(dbcont,(*nactcont-1)**nev,*nactcont**nev,0.);
                   break;
                   }while(1);
                   bcont[jdof]+=coefmpc[index1]*fnl[j*3+j1]/coefmpc[ist1];
                   i4=(jdbcontcol-1)**nev;
                   i3=(3*j+j1);
                   for(k=0; k<*nope; k++){
                   for(k1=0; k1<3; k1++){
                       sl=s[(3*k+k1)*60+i3];
                       kdof=nactdof[mt*(konl[k]-1)+k1+1];
                       if(kdof>0){
                       d1=sl*coefmpc[index1]/coefmpc[ist1];
                       if(!(*cyclicsymmetry)){
                         for(l=0; l<*nev; l++){
                           dbcont[i4+l]+=d1*z[(long long)l**neq+kdof-1];
                         }
                       }else{
                         kdofm1=kdof-1;
                         FORTRAN(nident,(izdof,&kdofm1,nzdof,&id));
                         if(id!=0){
                           if(izdof[id-1]==kdofm1){
                         for(l=0; l<*nev; l++){
                           dbcont[i4+l]+=d1*z[l**nzdof+id-1];
                         }
                           }else{printf("*ERROR in dfdbj\n");FORTRAN(stop,());}
                         }else{printf("*ERROR in dfdbj\n");FORTRAN(stop,());}
                       }
                       }
                       else{
                       kdof=8*(konl[k]-1)+k1+1;
                       FORTRAN(nident,(ikmpc,&kdof,nmpc,&id2));
                       if(id2>0){
                           id2--;
                           if(ikmpc[id2]==kdof){
                           id2=ilmpc[id2];
                           ist2=ipompc[id2-1];
                           ist2--;
                           index2=nodempc[ist2*3+2];
                           if(index2==0) continue;
                           index2--;
                           do{
                               kdof=nactdof[mt*(nodempc[index2*3]-1)+nodempc[index2*3+1]];
                               if(kdof>0){
                               d1=sl*coefmpc[index1]*coefmpc[index2]/(coefmpc[ist1]*coefmpc[ist2]);
                               if(!(*cyclicsymmetry)){
                                 for(l=0; l<*nev; l++){
                                   dbcont[i4+l]-=d1*z[(long long)l**neq+kdof-1];
                                 }
                               }else{
                                 kdofm1=kdof-1;
                                 FORTRAN(nident,(izdof,&kdofm1,nzdof,&id));
                                 if(id!=0){
                                   if(izdof[id-1]==kdofm1){
                                 for(l=0; l<*nev; l++){
                                   dbcont[i4+l]-=d1*z[l**nzdof+id-1];
                                 }
                                   }else{printf("*ERROR in dfdbj\n");FORTRAN(stop,());}
                                 }else{printf("*ERROR in dfdbj\n");FORTRAN(stop,());}
                               }
                               }
                               index2=nodempc[index2*3+2];
                               if(index2==0) break;
                               index2--;
                           }while(1);
                           }
                       }
                       }
                   }
                   }
               }
               index1=nodempc[index1*3+2];
               if(index1==0) break;
               index1--;
               }while(1);
           }
           }
       }
       }
   }
   *dbcontp=dbcont;
   *ikactcontp=ikactcont;
   *ilactcontp=ilactcont;
 }

◆ dyna()

void dyna	(	double **	cop,
		ITG *	nk,
		ITG **	konp,
		ITG **	ipkonp,
		char **	lakonp,
		ITG *	ne,
		ITG **	nodebounp,
		ITG **	ndirbounp,
		double **	xbounp,
		ITG *	nboun,
		ITG **	ipompcp,
		ITG **	nodempcp,
		double **	coefmpcp,
		char **	labmpcp,
		ITG *	nmpc,
		ITG *	nodeforc,
		ITG *	ndirforc,
		double *	xforc,
		ITG *	nforc,
		ITG *	nelemload,
		char *	sideload,
		double *	xload,
		ITG *	nload,
		ITG **	nactdofp,
		ITG *	neq,
		ITG *	nzl,
		ITG *	icol,
		ITG *	irow,
		ITG *	nmethod,
		ITG **	ikmpcp,
		ITG **	ilmpcp,
		ITG **	ikbounp,
		ITG **	ilbounp,
		double *	elcon,
		ITG *	nelcon,
		double *	rhcon,
		ITG *	nrhcon,
		double *	cocon,
		ITG *	ncocon,
		double *	alcon,
		ITG *	nalcon,
		double *	alzero,
		ITG **	ielmatp,
		ITG **	ielorienp,
		ITG *	norien,
		double *	orab,
		ITG *	ntmat_,
		double **	t0p,
		double **	t1p,
		ITG *	ithermal,
		double *	prestr,
		ITG *	iprestr,
		double **	voldp,
		ITG *	iperturb,
		double **	stip,
		ITG *	nzs,
		double *	timepar,
		double *	xmodal,
		double **	veoldp,
		char *	amname,
		double *	amta,
		ITG *	namta,
		ITG *	nam,
		ITG *	iamforc,
		ITG *	iamload,
		ITG **	iamt1p,
		ITG *	jout,
		ITG *	kode,
		char *	filab,
		double **	emep,
		double *	xforcold,
		double *	xloadold,
		double **	t1oldp,
		ITG **	iambounp,
		double **	xbounoldp,
		ITG *	iexpl,
		double *	plicon,
		ITG *	nplicon,
		double *	plkcon,
		ITG *	nplkcon,
		double **	xstatep,
		ITG *	npmat_,
		char *	matname,
		ITG *	mi,
		ITG *	ncmat_,
		ITG *	nstate_,
		double **	enerp,
		char *	jobnamec,
		double *	ttime,
		char *	set,
		ITG *	nset,
		ITG *	istartset,
		ITG *	iendset,
		ITG **	ialsetp,
		ITG *	nprint,
		char *	prlab,
		char *	prset,
		ITG *	nener,
		double *	trab,
		ITG **	inotrp,
		ITG *	ntrans,
		double **	fmpcp,
		char *	cbody,
		ITG *	ibody,
		double *	xbody,
		ITG *	nbody,
		double *	xbodyold,
		ITG *	istep,
		ITG *	isolver,
		ITG *	jq,
		char *	output,
		ITG *	mcs,
		ITG *	nkon,
		ITG *	mpcend,
		ITG *	ics,
		double *	cs,
		ITG *	ntie,
		char *	tieset,
		ITG *	idrct,
		ITG *	jmax,
		double *	ctrl,
		ITG *	itpamp,
		double *	tietol,
		ITG *	nalset,
		ITG *	ikforc,
		ITG *	ilforc,
		double *	thicke,
		ITG *	nslavs,
		ITG *	nmat,
		char *	typeboun,
		ITG *	ielprop,
		double *	prop,
		char *	orname
	)

                                                                  {
 
   char fneig[132]="",description[13]="            ",*lakon=NULL,*labmpc=NULL,
     *labmpcold=NULL,lakonl[9]="        \0",*tchar1=NULL,*tchar2=NULL,
     *tchar3=NULL,cflag[1]=" ",jobnamef[396]="";
 
   ITG nev,i,j,k,idof,*inum=NULL,*ipobody=NULL,inewton=0,id,
     iinc=0,jprint=0,l,iout,ielas=0,icmd=3,iprescribedboundary,init,ifreebody,
     mode=-1,noddiam=-1,*kon=NULL,*ipkon=NULL,*ielmat=NULL,*ielorien=NULL,
     *inotr=NULL,*nodeboun=NULL,*ndirboun=NULL,*iamboun=NULL,*ikboun=NULL,
     *ilboun=NULL,*nactdof=NULL,*ipompc=NULL,*nodempc=NULL,*ikmpc=NULL,
     *ilmpc=NULL,nsectors,nmpcold,mpcendold,*ipompcold=NULL,*nodempcold=NULL,
     *ikmpcold=NULL,*ilmpcold=NULL,kflag=2,nmd,nevd,*nm=NULL,*iamt1=NULL,
     *itg=NULL,ntg=0,symmetryflag=0,inputformat=0,dashpot,lrw,liw,iddebdf=0,
     *iwork=NULL,ngraph=1,nkg,neg,ncont,ne0,nkon0, *itietri=NULL,
     *koncont=NULL,konl[20],imat,nope,kodem,indexe,j1,jdof,icutb=0,
     *ipneigh=NULL,*neigh=NULL,inext,itp=0,*islavact=NULL,
     ismallsliding=0,isteadystate,mpcfree,im,cyclicsymmetry,
     memmpc_,imax,*icole=NULL,*irowe=NULL,*jqe=NULL,nzse[3],
     nalset_=*nalset,*ialset=*ialsetp,*istartset_=NULL,*iendset_=NULL,
     *itiefac=NULL,*islavsurf=NULL,*islavnode=NULL,mt=mi[1]+1,
     *imastnode=NULL,*nslavnode=NULL,*nmastnode=NULL,mortar=0,*imastop=NULL,
     *iponoels=NULL,*inoels=NULL,*imddof=NULL,nmddof,inoelsize,
     *ikactcont=NULL,nactcont,nactcont_=100,*ikactmech=NULL,nactmech,
     iabsload=0,*ipe=NULL,*ime=NULL,iprev=1,inonlinmpc=0,ielem,
     *imdnode=NULL,nmdnode,*imdboun=NULL,nmdboun,*imdmpc=NULL,
     nmdmpc,intpointvar,kmin,kmax,i1,ifacecount,*izdof=NULL,
     nzdof,iload,iforc,*iponoel=NULL,*inoel=NULL,*imdelem=NULL,nmdelem,
     irenewxstate,nasym=0,*nshcon=NULL,nherm,icfd=0,*inomat=NULL,
     ialeatoric=0,network=0;
 
   long long i2;
 
   double *d=NULL, *z=NULL, *b=NULL, *zeta=NULL,*stiini=NULL,
     *cd=NULL, *cv=NULL, *xforcact=NULL, *xloadact=NULL,*cc=NULL,
     *t1act=NULL, *ampli=NULL, *aa=NULL, *bb=NULL, *aanew=NULL, *bj=NULL, 
     *v=NULL,*aamech=NULL,*emn=NULL,*cdn=NULL,ptime,
     *stn=NULL, *stx=NULL, *een=NULL, *adb=NULL,*xstiff=NULL,*bjp=NULL,
     *aub=NULL, *temp_array1=NULL, *temp_array2=NULL, *aux=NULL,
     *f=NULL, *fn=NULL, *xbounact=NULL,*epn=NULL,*xstateini=NULL,
     *enern=NULL,*xstaten=NULL,*eei=NULL,*enerini=NULL,*qfn=NULL,
     *qfx=NULL, *xbodyact=NULL, *cgr=NULL, *au=NULL, *vbounact=NULL,
     *abounact=NULL,dtime,reltime,*t0=NULL,*t1=NULL,*t1old=NULL,
     physcon[1],zetaj,dj,ddj,h1,h2,h3,h4,h5,h6,sum,aai,bbi,tstart,tend,
     qa[4],cam[5],accold[1],bet,gam,*ad=NULL,sigma=0.,alpham,betam,
     *bact=NULL,*bmin=NULL,*co=NULL,*xboun=NULL,*xbounold=NULL,*vold=NULL,
     *eme=NULL,*ener=NULL,*coefmpc=NULL,*fmpc=NULL,*coefmpcold,*veold=NULL,
     *xini=NULL,*rwork=NULL,*adc=NULL,*auc=NULL,*zc=NULL, *rpar=NULL,
     *cg=NULL,*straight=NULL,xl[27],voldl[mt*9],elas[21],fnl[27],t0l,t1l,
     elconloc[21],veoldl[mt*9],setnull,deltmx,bbmax,dd,dtheta,dthetaref,
     theta,*vini=NULL,dthetaold,*bcont=NULL,*vr=NULL,*vi=NULL,*bcontini=NULL,
     *stnr=NULL,*stni=NULL,*vmax=NULL,*stnmax=NULL,precision,resultmaxprev,
     resultmax,func,funcp,fexp,fexm,fcos,fsin,sump,*bp=NULL,h14,senergy=0.0,
     *bv=NULL,*cstr=NULL,*aube=NULL,*adbe=NULL,*sti=*stip,time0=0.0,
     time=0.0,*xforcdiff=NULL,*xloaddiff=NULL,*xbodydiff=NULL,*t1diff=NULL,
     *xboundiff=NULL,*bprev=NULL,*bdiff=NULL,*areaslav=NULL,venergy=0.0,
     *springarea=NULL, *bold=NULL,*eenmax=NULL,*fnr=NULL,*fni=NULL,
     *xmastnor=NULL,*emeini=NULL,*xstate=NULL,*clearini=NULL,
     *shcon=NULL,*xmr=NULL,*xmi=NULL,*xnoels=NULL,*pslavsurf=NULL,
     *pmastsurf=NULL,*cdnr=NULL,*cdni=NULL,*tinc,*tper,*tmin,*tmax,
     *energyini=NULL,*energy=NULL;
 
   FILE *f1;
 
   /* dummy variables for nonlinmpc */
 
   ITG *iaux=NULL,maxlenmpc,icascade=0,newstep=0,iit=-1,idiscon;
 
 #ifdef SGI
   ITG token;
 #endif
 
   /*    if iabsload=0: aamech is modified by the present incremental 
                        contribution of b
            iabsload=1: the last incremental contribution is
                        subtracted before the new one is added to b;
                        this latter incremental contribution is used
                        to update aamech
            iabsload=2: aamech is determined by the absolute
                    contribution of b (no incremental procedure
                        for the load; this is necessary if
                        - nonlinear MPC's are applied or
                        - user dloads are applied */
 
   co=*cop;kon=*konp;ipkon=*ipkonp;lakon=*lakonp;ielmat=*ielmatp;
   ielorien=*ielorienp;inotr=*inotrp;nodeboun=*nodebounp;
   ndirboun=*ndirbounp;iamboun=*iambounp;xboun=*xbounp;xstate=*xstatep;
   xbounold=*xbounoldp;ikboun=*ikbounp;ilboun=*ilbounp;nactdof=*nactdofp;
   vold=*voldp;eme=*emep;ener=*enerp;ipompc=*ipompcp;nodempc=*nodempcp;
   coefmpc=*coefmpcp;labmpc=*labmpcp;ikmpc=*ikmpcp;ilmpc=*ilmpcp;
   fmpc=*fmpcp;veold=*veoldp;iamt1=*iamt1p;t0=*t0p;t1=*t1p;t1old=*t1oldp;
   
   for(k=0;k<3;k++){
       strcpy1(&jobnamef[k*132],&jobnamec[k*132],132);
   }
 
   tinc=&timepar[0];
   tper=&timepar[1];
   tmin=&timepar[2];
   tmax=&timepar[3];
 
   if(ithermal[0]<=1){
       kmin=1;kmax=3;
   }else if(ithermal[0]==2){
       kmin=0;kmax=mi[1];if(kmax>2)kmax=2;
   }else{
       kmin=0;kmax=3;
   }
 
 //NNEW(xstiff,double,(long long)27*mi[0]**ne);
 
   dtime=*tinc;
 
   alpham=xmodal[0];
   betam=xmodal[1];
 
   dd=ctrl[16];deltmx=ctrl[26];
 
   /* determining nzl */
 
   *nzl=0;
   for(i=neq[1];i>0;i--){
       if(icol[i-1]>0){
       *nzl=i;
       break;
       }
   }
 
   /* opening the eigenvalue file and checking for cyclic symmetry */
 
   strcpy(fneig,jobnamec);
   strcat(fneig,".eig");
 
   if((f1=fopen(fneig,"rb"))==NULL){
     printf(" *ERROR in dyna: cannot open eigenvalue file for reading");
     printf(" *INFO  in dyna: if there are problems reading the .eig file this may be due to:\n");
     printf("        1) the nonexistence of the .eig file\n");
     printf("        2) other boundary conditions than in the input deck\n");
     printf("           which created the .eig file\n\n");
     exit(0);
   }
 
   if(fread(&cyclicsymmetry,sizeof(ITG),1,f1)!=1){
       printf(" *ERROR in dyna reading the cyclic symmetry flag in the eigenvalue file");
       printf(" *INFO  in dyna: if there are problems reading the .eig file this may be due to:\n");
       printf("        1) the nonexistence of the .eig file\n");
       printf("        2) other boundary conditions than in the input deck\n");
       printf("           which created the .eig file\n\n");
       exit(0);
   }
 
   if(fread(&nherm,sizeof(ITG),1,f1)!=1){
       printf(" *ERROR in dyna reading the Hermitian flag in the eigenvalue file");
       printf(" *INFO  in dyna: if there are problems reading the .eig file this may be due to:\n");
       printf("        1) the nonexistence of the .eig file\n");
       printf("        2) other boundary conditions than in the input deck\n");
       printf("           which created the .eig file\n\n");
       exit(0);
   }
 
   if(nherm!=1){
       printf(" *ERROR in dyna: the eigenvectors in the .eig-file result\n");
       printf("       from a non-Hermitian eigenvalue problem. The modal\n");
       printf("       dynamic procedure cannot handle that yet\n\n");
       FORTRAN(stop,());
   }
 
   /* creating imddof containing the degrees of freedom
      retained by the user and imdnode containing the nodes */
 
   nmddof=0;nmdnode=0;nmdboun=0;nmdmpc=0;nmdelem=0;
 
   NNEW(imddof,ITG,*nk*3);
   NNEW(imdnode,ITG,*nk);
   NNEW(imdboun,ITG,*nboun);
   NNEW(imdmpc,ITG,*nmpc);
   FORTRAN(createmddof,(imddof,&nmddof,istartset,iendset,
                ialset,nactdof,ithermal,mi,imdnode,&nmdnode,
                ikmpc,ilmpc,ipompc,nodempc,nmpc,
                imdmpc,&nmdmpc,imdboun,&nmdboun,ikboun,
                nboun,nset,ntie,tieset,set,lakon,kon,ipkon,labmpc,
                ilboun,filab,prlab,prset,nprint,ne,&cyclicsymmetry));
 
   /* if results are requested in too many nodes, it is faster to 
      calculate the results in all nodes */
 
   if((nmdnode>*nk/2)&&(!cyclicsymmetry)){
       nmdnode=0;nmddof=0;nmdboun=0;nmdmpc=0;
   }
 
   if(nmdnode!=0){
       if(!cyclicsymmetry){
       for(i=0;i<*nload;i++){
           iload=i+1;
           FORTRAN(addimdnodedload,(nelemload,sideload,ipkon,kon,lakon,
               &iload,imdnode,&nmdnode,ikmpc,ilmpc,ipompc,nodempc,nmpc,
                       imddof,&nmddof,nactdof,mi,imdmpc,&nmdmpc,imdboun,&nmdboun,
               ikboun,nboun,ilboun,ithermal));
       }
       for(i=0;i<*nforc;i++){
           iforc=i+1;
           FORTRAN(addimdnodecload,(nodeforc,&iforc,imdnode,&nmdnode,xforc,
                    ikmpc,ilmpc,ipompc,nodempc,nmpc,imddof,&nmddof,
                    nactdof,mi,imdmpc,&nmdmpc,imdboun,&nmdboun,
            ikboun,nboun,ilboun,ithermal));
       }
       }
       
       /* determining the elements belonging to a given node */
       
       NNEW(iponoel,ITG,*nk);
       NNEW(inoel,ITG,2**nkon);
       FORTRAN(elementpernode,(iponoel,inoel,lakon,ipkon,kon,ne,&inoelsize));
       NNEW(imdelem,ITG,*ne);
 
       /* storing the elements in which integration point results
          are needed; storing the nodes which are needed to
          calculate these results */
 
       FORTRAN(createmdelem,(imdnode,&nmdnode,xforc,
                    ikmpc,ilmpc,ipompc,nodempc,nmpc,imddof,&nmddof,
                    nactdof,mi,imdmpc,&nmdmpc,imdboun,&nmdboun,
                    ikboun,nboun,ilboun,ithermal,imdelem,&nmdelem,
                    iponoel,inoel,prlab,prset,nprint,lakon,set,nset,
                    ialset,ipkon,kon,istartset,iendset,nforc,
            ikforc,ilforc));
 
       RENEW(imdelem,ITG,nmdelem);
       SFREE(iponoel);SFREE(inoel);
   }
 
   /* if results are requested in too many nodes, it is faster to 
      calculate the results in all nodes */
 
   if((nmdnode>*nk/2)&&(!cyclicsymmetry)){
       nmdnode=0;nmddof=0;nmdboun=0;nmdmpc=0;
   }
   
   /* subtracting 1 to comply with the C-convention */
 
   for(i=0;i<nmddof;i++){imddof[i]-=1;}
   RENEW(imddof,ITG,nmddof);
   RENEW(imdnode,ITG,nmdnode);
   RENEW(imdboun,ITG,nmdboun);
   RENEW(imdmpc,ITG,nmdmpc);
 
   nsectors=1;
 
   /* reading the eigenvalues / eigenmodes */
 
   if(!cyclicsymmetry){
 
       nkg=*nk;
       neg=*ne;
 
       if(fread(&nev,sizeof(ITG),1,f1)!=1){
       printf(" *ERROR in dyna reading the number of eigenvalues in the eigenvalue file");
       printf(" *INFO  in dyna: if there are problems reading the .eig file this may be due to:\n");
       printf("        1) the nonexistence of the .eig file\n");
       printf("        2) other boundary conditions than in the input deck\n");
       printf("           which created the .eig file\n\n");
       exit(0);
       }
       
       NNEW(d,double,nev);
       
       if(fread(d,sizeof(double),nev,f1)!=nev){
       printf(" *ERROR in dyna reading the eigenvalues in the eigenvalue file");
       printf(" *INFO  in dyna: if there are problems reading the .eig file this may be due to:\n");
       printf("        1) the nonexistence of the .eig file\n");
       printf("        2) other boundary conditions than in the input deck\n");
       printf("           which created the .eig file\n\n");
       exit(0);
       }
 
       for(i=0;i<nev;i++){
       if(d[i]>0){d[i]=sqrt(d[i]);}else{d[i]=0.;}
       }
       
       NNEW(ad,double,neq[1]);
       NNEW(adb,double,neq[1]);
       NNEW(au,double,nzs[2]);
       NNEW(aub,double,nzs[1]);
       
       if(fread(ad,sizeof(double),neq[1],f1)!=neq[1]){
       printf(" *ERROR in dyna reading the diagonal of the stiffness matrix in the eigenvalue file");
       printf(" *INFO  in dyna: if there are problems reading the .eig file this may be due to:\n");
       printf("        1) the nonexistence of the .eig file\n");
       printf("        2) other boundary conditions than in the input deck\n");
       printf("           which created the .eig file\n\n");
       exit(0);
       }
       
       if(fread(au,sizeof(double),nzs[2],f1)!=nzs[2]){
       printf(" *ERROR in dyna reading the off-diagonals of the stiffness matrix in the eigenvalue file");
       printf(" *INFO  in dyna: if there are problems reading the .eig file this may be due to:\n");
       printf("        1) the nonexistence of the .eig file\n");
       printf("        2) other boundary conditions than in the input deck\n");
       printf("           which created the .eig file\n\n");
       exit(0);
       }
       
       if(fread(adb,sizeof(double),neq[1],f1)!=neq[1]){
       printf(" *ERROR in dyna reading the diagonal of the mass matrix in the eigenvalue file");
       printf(" *INFO  in dyna: if there are problems reading the .eig file this may be due to:\n");
       printf("        1) the nonexistence of the .eig file\n");
       printf("        2) other boundary conditions than in the input deck\n");
       printf("           which created the .eig file\n\n");
       exit(0);
       }
       
       if(fread(aub,sizeof(double),nzs[1],f1)!=nzs[1]){
       printf(" *ERROR in dyna reading the off-diagonals of the mass matrix in the  eigenvalue file");
       printf(" *INFO  in dyna: if there are problems reading the .eig file this may be due to:\n");
       printf("        1) the nonexistence of the .eig file\n");
       printf("        2) other boundary conditions than in the input deck\n");
       printf("           which created the .eig file\n\n");
       exit(0);
       }
       
       NNEW(z,double,neq[1]*nev);
       
       if(fread(z,sizeof(double),neq[1]*nev,f1)!=neq[1]*nev){
       printf(" *ERROR in dyna reading the eigenvectors in the eigenvalue file");
       printf(" *INFO  in dyna: if there are problems reading the .eig file this may be due to:\n");
       printf("        1) the nonexistence of the .eig file\n");
       printf("        2) other boundary conditions than in the input deck\n");
       printf("           which created the .eig file\n\n");
       exit(0);
       }
   }
   else{
       nev=0;
       do{
       if(fread(&nmd,sizeof(ITG),1,f1)!=1){
           break;
       }
       if(fread(&nevd,sizeof(ITG),1,f1)!=1){
           printf(" *ERROR in dyna reading the number of eigenvalues for nodal diameter %" ITGFORMAT " in the eigenvalue file",nmd);
           printf(" *INFO  in dyna: if there are problems reading the .eig file this may be due to:\n");
           printf("        1) the nonexistence of the .eig file\n");
           printf("        2) other boundary conditions than in the input deck\n");
           printf("           which created the .eig file\n\n");
           exit(0);
       }
       if(nev==0){
           NNEW(d,double,nevd);
           NNEW(nm,ITG,nevd);
       }else{
           RENEW(d,double,nev+nevd);
           RENEW(nm,ITG,nev+nevd);
       }
       
       if(fread(&d[nev],sizeof(double),nevd,f1)!=nevd){
           printf(" *ERROR in dyna reading the eigenvalues for nodal diameter %" ITGFORMAT " in the eigenvalue file",nmd);
           printf(" *INFO  in dyna: if there are problems reading the .eig file this may be due to:\n");
           printf("        1) the nonexistence of the .eig file\n");
           printf("        2) other boundary conditions than in the input deck\n");
           printf("           which created the .eig file\n\n");
           exit(0);
       }
 
       for(i=nev;i<nev+nevd;i++){
           if(d[i]>0){d[i]=sqrt(d[i]);}else{d[i]=0.;}
       }
 
       for(i=nev;i<nev+nevd;i++){nm[i]=nmd;}
       
       if(nev==0){
           NNEW(adb,double,neq[1]);
           NNEW(aub,double,nzs[1]);
 
           if(fread(adb,sizeof(double),neq[1],f1)!=neq[1]){
           printf(" *ERROR in dyna reading the diagonal of the mass matrix in the eigenvalue file");
           printf(" *INFO  in dyna: if there are problems reading the .eig file this may be due to:\n");
           printf("        1) the nonexistence of the .eig file\n");
           printf("        2) other boundary conditions than in the input deck\n");
           printf("           which created the .eig file\n\n");
           exit(0);
           }
           
           if(fread(aub,sizeof(double),nzs[1],f1)!=nzs[1]){
           printf(" *ERROR in dyna reading the off-diagonals of the mass matrix in the eigenvalue file");
           printf(" *INFO  in dyna: if there are problems reading the .eig file this may be due to:\n");
           printf("        1) the nonexistence of the .eig file\n");
           printf("        2) other boundary conditions than in the input deck\n");
           printf("           which created the .eig file\n\n");
           exit(0);
           }
       }
       
       if(nev==0){
           NNEW(z,double,neq[1]*nevd);
       }else{
           RENEW(z,double,(long long)neq[1]*(nev+nevd));
       }
       
       if(fread(&z[(long long)neq[1]*nev],sizeof(double),neq[1]*nevd,f1)!=neq[1]*nevd){
           printf(" *ERROR in dyna reading the eigenvectors for nodal diameter %" ITGFORMAT " in the eigenvalue file",nmd);
           printf(" *INFO  in dyna: if there are problems reading the .eig file this may be due to:\n");
           printf("        1) the nonexistence of the .eig file\n");
           printf("        2) other boundary conditions than in the input deck\n");
           printf("           which created the .eig file\n\n");
           exit(0);
       }
       nev+=nevd;
       }while(1);
 
       /* determining the maximum amount of segments */
 
       for(i=0;i<*mcs;i++){
 //    if(cs[17*i]>nsectors) nsectors=cs[17*i];
       if(cs[17*i]>nsectors) nsectors=(ITG)(cs[17*i]+0.5);
       }
 
         /* determining the maximum number of sectors to be plotted */
 
       for(j=0;j<*mcs;j++){
       if(cs[17*j+4]>ngraph) ngraph=(ITG)cs[17*j+4];
       }
       nkg=*nk*ngraph;
       neg=*ne*ngraph;
 
       /* allocating field for the expanded structure */
 
       RENEW(co,double,3**nk*nsectors);
 
       /* next line is necessary for multiple cyclic symmetry
          conditions */
 
       for(i=3**nk;i<3**nk*nsectors;i++){co[i]=0.;}
       if(*ithermal!=0){
       RENEW(t0,double,*nk*nsectors);
       RENEW(t1old,double,*nk*nsectors);
       RENEW(t1,double,*nk*nsectors);
       if(*nam>0) RENEW(iamt1,ITG,*nk*nsectors);
       }
       RENEW(nactdof,ITG,mt**nk*nsectors);
       if(*ntrans>0) RENEW(inotr,ITG,2**nk*nsectors);
       RENEW(kon,ITG,*nkon*nsectors);
       RENEW(ipkon,ITG,*ne*nsectors);
       for(i=*ne;i<*ne*nsectors;i++){ipkon[i]=-1;}
       RENEW(lakon,char,8**ne*nsectors);
       RENEW(ielmat,ITG,mi[2]**ne*nsectors);
       if(*norien>0) RENEW(ielorien,ITG,mi[2]**ne*nsectors);
 //      RENEW(z,double,(long long)neq[1]*nev*nsectors/2);
 
       RENEW(nodeboun,ITG,*nboun*nsectors);
       RENEW(ndirboun,ITG,*nboun*nsectors);
       if(*nam>0) RENEW(iamboun,ITG,*nboun*nsectors);
       RENEW(xboun,double,*nboun*nsectors);
       RENEW(xbounold,double,*nboun*nsectors);
       RENEW(ikboun,ITG,*nboun*nsectors);
       RENEW(ilboun,ITG,*nboun*nsectors);
 
       NNEW(ipompcold,ITG,*nmpc);
       NNEW(nodempcold,ITG,3**mpcend);
       NNEW(coefmpcold,double,*mpcend);
       NNEW(labmpcold,char,20**nmpc);
       NNEW(ikmpcold,ITG,*nmpc);
       NNEW(ilmpcold,ITG,*nmpc);
 
       for(i=0;i<*nmpc;i++){ipompcold[i]=ipompc[i];}
       for(i=0;i<3**mpcend;i++){nodempcold[i]=nodempc[i];}
       for(i=0;i<*mpcend;i++){coefmpcold[i]=coefmpc[i];}
       for(i=0;i<20**nmpc;i++){labmpcold[i]=labmpc[i];}
       for(i=0;i<*nmpc;i++){ikmpcold[i]=ikmpc[i];}
       for(i=0;i<*nmpc;i++){ilmpcold[i]=ilmpc[i];}
       nmpcold=*nmpc;
       mpcendold=*mpcend;
 
       RENEW(ipompc,ITG,*nmpc*nsectors);
       RENEW(nodempc,ITG,3**mpcend*nsectors);
       RENEW(coefmpc,double,*mpcend*nsectors);
       RENEW(labmpc,char,20**nmpc*nsectors+1);
       RENEW(ikmpc,ITG,*nmpc*nsectors);
       RENEW(ilmpc,ITG,*nmpc*nsectors);
       RENEW(fmpc,double,*nmpc*nsectors);
 
       /* determining the space needed to expand the
          contact surfaces */
 
       NNEW(tchar1,char,81);
       NNEW(tchar2,char,81);
       NNEW(tchar3,char,81);
       for(i=0; i<*ntie; i++){
     if(tieset[i*(81*3)+80]=='C'){
 
       //a contact constraint was found, so increase nalset
 
       memcpy(tchar2,&tieset[i*(81*3)+81],81);
       tchar2[80]='\0';
       memcpy(tchar3,&tieset[i*(81*3)+81+81],81);
       tchar3[80]='\0';
       for(j=0; j<*nset; j++){
         memcpy(tchar1,&set[j*81],81);
         tchar1[80]='\0';
         if(strcmp(tchar1,tchar2)==0){
 
           //dependent nodal surface was found
 
           (*nalset)+=(iendset[j]-istartset[j]+1)*(nsectors);
         }
         else if(strcmp(tchar1,tchar3)==0){
 
           //independent element face surface was found
 
           (*nalset)+=(iendset[j]-istartset[j]+1)*(nsectors);
         }
       }
     }
       }
       SFREE(tchar1);
       SFREE(tchar2);
       SFREE(tchar3);
 
       RENEW(ialset,ITG,*nalset);
 
       /* save the information in istarset and isendset */
 
       NNEW(istartset_,ITG,*nset);
       NNEW(iendset_,ITG,*nset);
       for(j=0; j<*nset; j++){
     istartset_[j]=istartset[j];
     iendset_[j]=iendset[j];
       }
 
       /* reallocating the fields for the nodes in which the
          solution has to be calculated */
 
       RENEW(imddof,ITG,neq[1]/2*nsectors);
       RENEW(imdnode,ITG,*nk*nsectors);
       RENEW(imdboun,ITG,*nboun*nsectors);
       RENEW(imdmpc,ITG,*nmpc*nsectors);
 
 //izdofNNEW(//      izdof,ITG,1);
       
       expand(co,nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,xboun,nboun,
     ipompc,nodempc,coefmpc,labmpc,nmpc,nodeforc,ndirforc,xforc,
         nforc,nelemload,sideload,xload,nload,nactdof,neq,
     nmethod,ikmpc,ilmpc,ikboun,ilboun,elcon,nelcon,rhcon,nrhcon,
     alcon,nalcon,alzero,ielmat,ielorien,norien,orab,ntmat_,
     t0,ithermal,prestr,iprestr,vold,iperturb,sti,nzs,
     adb,aub,filab,eme,plicon,nplicon,plkcon,nplkcon,
         xstate,npmat_,matname,mi,ics,cs,mpcend,ncmat_,
         nstate_,mcs,nkon,ener,jobnamec,output,set,nset,istartset,
         iendset,ialset,nprint,prlab,prset,nener,trab,
         inotr,ntrans,ttime,fmpc,&nev,&z,iamboun,xbounold,
     &nsectors,nm,icol,irow,nzl,nam,ipompcold,nodempcold,coefmpcold,
         labmpcold,&nmpcold,xloadold,iamload,t1old,t1,iamt1,xstiff,
         &icole,&jqe,&irowe,isolver,nzse,&adbe,&aube,iexpl,
     ibody,xbody,nbody,cocon,ncocon,tieset,ntie,imddof,&nmddof,
     imdnode,&nmdnode,imdboun,&nmdboun,imdmpc,&nmdmpc,&izdof,&nzdof,
     &nherm,xmr,xmi,typeboun,ielprop,prop,orname);
 
       RENEW(imddof,ITG,nmddof);
       RENEW(imdnode,ITG,nmdnode);
       RENEW(imdboun,ITG,nmdboun);
       RENEW(imdmpc,ITG,nmdmpc);
 
       SFREE(vold);
       NNEW(vold,double,mt**nk);
       SFREE(veold);
       NNEW(veold,double,mt**nk);
       RENEW(eme,double,6*mi[0]**ne);
       RENEW(sti,double,6*mi[0]**ne);
 
 //      RENEW(xstiff,double,(long long)27*mi[0]**ne);
       if(*nener==1) RENEW(ener,double,mi[0]**ne*2);
   }
 
   fclose(f1);
       
   /* checking for steadystate calculations */
 
   if(*tper<0){
       precision=-*tper;
       *tper=1.e10;
       isteadystate=1;
   }else{
       isteadystate=0;
   }
 
   /* checking for nonlinear MPC's */
 
   for(i=0;i<*nmpc;i++){
       if((strcmp1(&labmpc[20*i]," ")!=0)&&
 //         (strcmp1(&labmpc[20*i],"CONTACT")!=0)&&
          (strcmp1(&labmpc[20*i],"CYCLIC")!=0)&&
          (strcmp1(&labmpc[20*i],"SUBCYCLIC")!=0)){
       inonlinmpc=1;
       iabsload=2;
       break;
       }
   }
 
 
   /* normalizing the time */
 
   FORTRAN(checktime,(itpamp,namta,tinc,ttime,amta,tmin,&inext,&itp,istep,tper));
   dtheta=(*tinc)/(*tper);
   dthetaref=dtheta;
   dthetaold=dtheta;
 
   *tmin=*tmin/(*tper);
   *tmax=*tmax/(*tper);
   theta=0.;
 
   /* check for rigid body modes 
      if there is a jump of 1.e4 in two subsequent eigenvalues
      all eigenvalues preceding the jump are considered to
      be rigid body modes and their frequency is set to zero */
 
   setnull=1.;
   for(i=nev-2;i>-1;i--){
       if(fabs(d[i])<0.0001*fabs(d[i+1])) setnull=0.;
       d[i]*=setnull;
   }
 
   /* check whether there are dashpot elements */
 
   dashpot=0;
   for(i=0;i<*ne;i++){
       if(ipkon[i]<0) continue;
       if(strcmp1(&lakon[i*8],"ED")==0){
       dashpot=1;break;}
   }
 
   if(dashpot){
 
       if(cyclicsymmetry){
       printf(" *ERROR in dyna: dashpots are not allowed in combination with cyclic symmetry\n");
       FORTRAN(stop,());
       }
 
       liw=51;
       NNEW(iwork,ITG,liw);
       lrw=130+42*nev;
       NNEW(rwork,double,lrw);
       NNEW(xini,double,2*nev);
       NNEW(adc,double,neq[1]);
       NNEW(auc,double,nzs[1]);
       FORTRAN(mafilldm,(co,nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,xboun,nboun,
           ipompc,nodempc,coefmpc,nmpc,nodeforc,ndirforc,xforc,
           nforc,nelemload,sideload,xload,nload,xbody,ipobody,nbody,cgr,
           adc,auc,nactdof,icol,jq,irow,neq,nzl,nmethod,
           ikmpc,ilmpc,ikboun,ilboun,
           elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat,
           ielorien,norien,orab,ntmat_,
           t0,t0,ithermal,prestr,iprestr,vold,iperturb,sti,
           nzs,stx,adb,aub,iexpl,plicon,nplicon,plkcon,nplkcon,
           xstiff,npmat_,&dtime,matname,mi,ncmat_,
           ttime,&time0,istep,&iinc,ibody,clearini,&mortar,springarea,
               pslavsurf,pmastsurf,&reltime,&nasym));
 
       /*  zc = damping matrix * eigenmodes */
 
       NNEW(zc,double,neq[1]*nev);
       for(i=0;i<nev;i++){
       FORTRAN(op,(&neq[1],&z[i*neq[1]],&zc[i*neq[1]],adc,auc,
       jq,irow));
       }
 
       /* cc is the reduced damping matrix (damping matrix mapped onto
          space spanned by eigenmodes) */
 
       NNEW(cc,double,nev*nev);
       for(i=0;i<nev;i++){
       for(j=0;j<=i;j++){
           for(k=0;k<neq[1];k++){
           cc[i*nev+j]+=z[j*neq[1]+k]*zc[i*neq[1]+k];
           }
       }
       }
 
       /* symmetric part of cc matrix */
 
       for(i=0;i<nev;i++){
       for(j=i;j<nev;j++){
           cc[i*nev+j]=cc[j*nev+i];
       }
       }
       SFREE(zc);
   }
 
   /* contact conditions */
 
   if(*nslavs==0){irenewxstate=1;}else{irenewxstate=0;}
   inicont(nk,&ncont,ntie,tieset,nset,set,istartset,iendset,ialset,&itietri,
       lakon,ipkon,kon,&koncont,nslavs,tietol,&ismallsliding,&itiefac,
           &islavsurf,&islavnode,&imastnode,&nslavnode,&nmastnode,
           &mortar,&imastop,nkon,&iponoels,&inoels,&ipe,&ime,ne,&ifacecount,
       iperturb,ikboun,nboun,co,istep,&xnoels);
 
   if(ncont!=0){
 
       if(mortar>0){
       printf(" *ERROR in dyna: modal dynamics cannot be combined with\n");
       printf("        face-to-face penalty contact\n\n");
       FORTRAN(stop,());
       }
       
       if(dashpot){
       printf(" *ERROR in dyna: contact is not allowed in combination with dashpots\n");
       FORTRAN(stop,());
       }
       RENEW(ipkon,ITG,*ne+*nslavs);
       RENEW(lakon,char,8*(*ne+*nslavs));
       if(*nener==1){
     RENEW(ener,double,mi[0]*(*ne+*nslavs)*2);
       }
 
       /* 11 instead of 10: last position is reserved for how
          many dependent nodes are paired to this face */
     
       RENEW(kon,ITG,*nkon+11**nslavs);
       if(*norien>0){
       RENEW(ielorien,ITG,mi[2]*(*ne+*nslavs));
       for(k=mi[2]**ne;k<mi[2]*(*ne+*nslavs);k++) ielorien[k]=0;
       }
       RENEW(ielmat,ITG,mi[2]*(*ne+*nslavs));
       for(k=mi[2]**ne;k<mi[2]*(*ne+*nslavs);k++) ielmat[k]=1;
       NNEW(cg,double,3*ncont);
       NNEW(straight,double,16*ncont);
 
       /* internal state variables for contact */
 
       if((irenewxstate==1)&&(*nslavs!=0)&&(*nstate_>0)){
       RENEW(xstate,double,*nstate_*mi[0]*(*ne+*nslavs));
       for(k=*nstate_*mi[0]**ne;k<*nstate_*mi[0]*(*ne+*nslavs);k++){
           xstate[k]=0.;
       }
       }
       if(*nstate_>0){
       NNEW(xstateini,double,*nstate_*mi[0]*(*ne+*nslavs));
       for(k=0;k<*nstate_*mi[0]*(*ne+*nslavs);++k){
           xstateini[k]=xstate[k];
       }
       }
 
       NNEW(xmastnor,double,3*nmastnode[*ntie]);
       NNEW(areaslav,double,ifacecount);
       NNEW(springarea,double,2**nslavs);
       NNEW(vini,double,mt**nk);
       NNEW(bcontini,double,neq[1]);
       NNEW(bcont,double,neq[1]);
       NNEW(ikactcont,ITG,nactcont_);
   }
 
   /* storing the element and topology information before introducing 
      contact elements */
 
   ne0=*ne;nkon0=*nkon;
 
   NNEW(zeta,double,nev);
   NNEW(cstr,double,6);
 
   /* calculating the damping coefficients*/
 
   if(xmodal[10]<0){
       for(i=0;i<nev;i++){
     if(fabs(d[i])>(1.e-10)){
       zeta[i]=(alpham+betam*d[i]*d[i])/(2.*d[i]);
     }
     else {
       printf("*WARNING in dyna: one of the frequencies is zero\n");
       printf("         no Rayleigh mass damping allowed\n");
       zeta[i]=0.;
     }
 
         /* if the nodal diameter exceeds half the number of sectors
            the sign of the damping has to be reversed (omega is negative) */
 
 /*  if(cyclicsymmetry){
         if(nm[i]>nsectors/2) zeta[i]*=-1.;
         }*/
       }
   }
   else{
 
     /*copy the damping coefficients for every eigenfrequency from xmodal[11....] */
 
     if(nev<(ITG)xmodal[10]){
       imax=nev;
       printf("*WARNING in dyna: too many modal damping coefficients applied\n");
       printf("         damping coefficients corresponding to nonexisting eigenvalues are ignored\n");
     }
     else{
       imax=(ITG)xmodal[10];
     }
     for(i=0; i<imax; i++){
       zeta[i]=xmodal[11+i];     
 
       /* if the nodal diameter exceeds half the number of sectors
            the sign of the damping has to be reversed (omega is negative) */
 
       /*   if(cyclicsymmetry){
       if(nm[i]>nsectors/2) zeta[i]*=-1.;
       }*/
     }
     
   }
 
   /* modal decomposition of the initial conditions */
   /* for cyclic symmetric structures the initial conditions
      are assumed to be zero */
   
   NNEW(cd,double,nev);
   NNEW(cv,double,nev);
 
   if(!cyclicsymmetry){
     NNEW(temp_array1,double,neq[1]);
     NNEW(temp_array2,double,neq[1]);
     for(i=0;i<neq[1];i++){temp_array1[i]=0;temp_array2[i]=0;}
     
     /* displacement initial conditions */
     
     for(i=0;i<*nk;i++){
       for(j=0;j<mt;j++){
     if(nactdof[mt*i+j]>0){
       idof=nactdof[mt*i+j]-1;
       temp_array1[idof]=vold[mt*i+j];
     }
       }
     }
     
     FORTRAN(op,(&neq[1],temp_array1,temp_array2,adb,aub,jq,irow));
     
     for(i=0;i<neq[1];i++){
       for(k=0;k<nev;k++){
     cd[k]+=z[k*neq[1]+i]*temp_array2[i];
       }
     }
     
     /* velocity initial conditions */
     
     for(i=0;i<neq[1];i++){temp_array1[i]=0;temp_array2[i]=0;}
     for(i=0;i<*nk;i++){
       for(j=0;j<mt;j++){
     if(nactdof[mt*i+j]>0){
       idof=nactdof[mt*i+j]-1;
       temp_array1[idof]=veold[mt*i+j];
     }
       }
     }
     
     FORTRAN(op,(&neq[1],temp_array1,temp_array2,adb,aub,jq,irow));
     
     for(i=0;i<neq[1];i++){
       for(k=0;k<nev;k++){
     cv[k]+=z[k*neq[1]+i]*temp_array2[i];
       }
     }
     
     SFREE(temp_array1);SFREE(temp_array2);
               
   }
   NNEW(xforcact,double,*nforc);
   NNEW(xforcdiff,double,*nforc);
   NNEW(xloadact,double,2**nload);
   NNEW(xloaddiff,double,2**nload);
   NNEW(xbodyact,double,7**nbody);
   NNEW(xbodydiff,double,7**nbody);
 
   /* copying the rotation axis and/or acceleration vector */
 
   for(k=0;k<7**nbody;k++){xbodyact[k]=xbody[k];}
   for(k=0;k<7**nbody;k++){xbodydiff[k]=xbody[k];}
   NNEW(xbounact,double,*nboun);
   NNEW(xboundiff,double,*nboun);
   if(*ithermal==1) {NNEW(t1act,double,*nk);
       NNEW(t1diff,double,*nk);}
   
   /* assigning the body forces to the elements */ 
 
   if(*nbody>0){
       ifreebody=*ne+1;
       NNEW(ipobody,ITG,2**ne);
       for(k=1;k<=*nbody;k++){
       FORTRAN(bodyforce,(cbody,ibody,ipobody,nbody,set,istartset,
                  iendset,ialset,&inewton,nset,&ifreebody,&k));
       RENEW(ipobody,ITG,2*(*ne+ifreebody));
       }
       RENEW(ipobody,ITG,2*(ifreebody-1));
   }
            
   NNEW(b,double,neq[1]); /* load rhs vector and displacement solution vector */
   NNEW(bp,double,neq[1]); /* velocity solution vector */
   NNEW(bj,double,nev); /* response modal decomposition */
   NNEW(bjp,double,nev); /* derivative of the response modal decomposition */
   NNEW(ampli,double,*nam); /* instantaneous amplitude */
 
   /* constant coefficient of the linear amplitude function */
 
   NNEW(aa,double,nev); 
   NNEW(aanew,double,nev);
   NNEW(aamech,double,nev);
 
   /* linear coefficient of the linear amplitude function */
 
   NNEW(bb,double,nev);
   
   NNEW(v,double,mt**nk);
   NNEW(fn,double,mt**nk);
   NNEW(stn,double,6**nk);
   NNEW(inum,ITG,*nk);
   strcpy1(&cflag[0],&filab[4],1);
   FORTRAN(createinum,(ipkon,inum,kon,lakon,nk,ne,&cflag[0],nelemload,
       nload,nodeboun,nboun,ndirboun,ithermal,co,vold,mi,ielmat));
 
   if(*ithermal>1) {NNEW(qfn,double,3**nk);
       NNEW(qfx,double,3*mi[0]**ne);}
 
   if(strcmp1(&filab[261],"E   ")==0) NNEW(een,double,6**nk);
   if(strcmp1(&filab[522],"ENER")==0) NNEW(enern,double,*nk);
   if(strcmp1(&filab[609],"SDV ")==0) NNEW(xstaten,double,*nstate_**nk);
   if(strcmp1(&filab[2697],"ME  ")==0) NNEW(emn,double,6**nk);
 
   NNEW(eei,double,6*mi[0]**ne);
   if(*nener==1){
     NNEW(stiini,double,6*mi[0]**ne);
     NNEW(emeini,double,6*mi[0]**ne);
     NNEW(enerini,double,mi[0]**ne);}
 
   /*  check for nonzero SPC's */
 
   iprescribedboundary=0;
   for(i=0;i<*nboun;i++){
       if(fabs(xboun[i])>1.e-10){
       iprescribedboundary=1;
       nmdnode=0;nmddof=0;nmdboun=0;nmdmpc=0;
       break;
       }
   }
 
 /*     calculating the instantaneous loads (forces, surface loading, 
        centrifugal and gravity loading or temperature) at time 0 
        setting iabsload to 2 if user subroutine dload is used */
 
 /*  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,&time0,&reltime,ttime,&dtime,ithermal,nmethod,
      xbounold,xboun,xbounact,iamboun,nboun,
      nodeboun,ndirboun,nodeforc,ndirforc,istep,&iinc,
      co,vold,itg,&ntg,amname,ikboun,ilboun,nelemload,sideload,mi));*/
       
   FORTRAN(temploaddiff,(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,itg,&ntg,amname,ikboun,ilboun,
           nelemload,sideload,mi,
           xforcdiff,xloaddiff,xbodydiff,t1diff,xboundiff,&iabsload,
           &iprescribedboundary,ntrans,trab,inotr,veold,nactdof,bcont,
               fn,ipobody,iponoel,inoel));
 
       if(iabsload==2) NNEW(bold,double,neq[1]);
 
   /*  calculating the instantaneous loading vector at time 0 */
 
   NNEW(ikactmech,ITG,neq[1]);
   nactmech=0;
   FORTRAN(rhs,(co,nk,kon,ipkon,lakon,ne,
        ipompc,nodempc,coefmpc,nmpc,nodeforc,ndirforc,xforcact,
        nforc,nelemload,sideload,xloadact,nload,xbodyact,ipobody,nbody,
        cgr,b,nactdof,&neq[1],nmethod,
        ikmpc,ilmpc,elcon,nelcon,rhcon,nrhcon,alcon,
        nalcon,alzero,ielmat,ielorien,norien,orab,ntmat_,t0,t1act,
        ithermal,iprestr,vold,iperturb,iexpl,plicon,
        nplicon,plkcon,nplkcon,npmat_,ttime,&time0,istep,&iinc,&dtime,
        physcon,ibody,xbodyold,&reltime,veold,matname,mi,ikactmech,
        &nactmech,ielprop,prop,sti,xstateini,xstate,nstate_));
   
   /*  correction for nonzero SPC's */
   
   if(iprescribedboundary){
 
       if(cyclicsymmetry){
       printf(" *ERROR in dyna: prescribed boundaries are not allowed in combination with cyclic symmetry\n");
       FORTRAN(stop,());
       }
 
       if(*idrct!=1){
       printf(" *ERROR in dyna: variable increment length is not allwed in combination with prescribed boundaries\n");
       FORTRAN(stop,());
       }
       
       /* LU decomposition of the stiffness matrix */
       
       if(*isolver==0){
 #ifdef SPOOLES
       spooles_factor(ad,au,adb,aub,&sigma,icol,irow,&neq[1],&nzs[1],
                          &symmetryflag,&inputformat,&nzs[2]);
 #else
       printf(" *ERROR in dyna: the SPOOLES library is not linked\n\n");
       FORTRAN(stop,());
 #endif
       }
       else if(*isolver==4){
 #ifdef SGI
       token=1;
       sgi_factor(ad,au,adb,aub,&sigma,icol,irow,&neq[1],&nzs[1],token);
 #else
       printf(" *ERROR in dyna: the SGI library is not linked\n\n");
       FORTRAN(stop,());
 #endif
       }
       else if(*isolver==5){
 #ifdef TAUCS
       tau_factor(ad,&au,adb,aub,&sigma,icol,&irow,&neq[1],&nzs[1]);
 #else
       printf(" *ERROR in dyna: the TAUCS library is not linked\n\n");
       FORTRAN(stop,());
 #endif
       }
       else if(*isolver==7){
 #ifdef PARDISO
       pardiso_factor(ad,au,adb,aub,&sigma,icol,irow,&neq[1],&nzs[1],
                          &symmetryflag,&inputformat,jq,&nzs[2]);
 #else
       printf(" *ERROR in dyna: the PARDISO library is not linked\n\n");
       FORTRAN(stop,());
 #endif
       }
 
       NNEW(bact,double,neq[1]);
       NNEW(bmin,double,neq[1]);
       NNEW(bv,double,neq[1]);
       NNEW(bprev,double,neq[1]);
       NNEW(bdiff,double,neq[1]);
 
       init=1;
       dynboun(amta,namta,nam,ampli,&time0,ttime,&dtime,xbounold,xboun,
           xbounact,iamboun,nboun,nodeboun,ndirboun,ad,au,adb,
           aub,icol,irow,neq,nzs,&sigma,b,isolver,
           &alpham,&betam,nzl,&init,bact,bmin,jq,amname,bv,
           bprev,bdiff,&nactmech,&iabsload,&iprev);
       init=0;
   }
 
 /* creating contact elements and calculating the contact forces
    (normal and shear) */
 
   if(ncont!=0){
       DMEMSET(bcont,0,neq[1],0.);
       contact(&ncont,ntie,tieset,nset,set,istartset,iendset,
           ialset,itietri,lakon,ipkon,kon,koncont,ne,cg,straight,nkon,
           co,vold,ielmat,cs,elcon,istep,&iinc,&iit,ncmat_,ntmat_,
               &ne0,vini,nmethod,iperturb,
               ikboun,nboun,mi,imastop,nslavnode,islavnode,islavsurf,
               itiefac,areaslav,iponoels,inoels,springarea,tietol,&reltime,
           imastnode,nmastnode,xmastnor,filab,mcs,ics,
               &nasym,xnoels,&mortar,pslavsurf,pmastsurf,clearini,&theta,
           xstateini,xstate,nstate_,&icutb,&ialeatoric,jobnamef);
 
       RENEW(ikactcont,ITG,nactcont_);
       DMEMSET(ikactcont,0,nactcont_,0.);
       nactcont=0;
      
       for(i=ne0;i<*ne;i++){
       indexe=ipkon[i];
       imat=ielmat[mi[2]*i];
       kodem=nelcon[2*imat-2];
       for(j=0;j<8;j++){lakonl[j]=lakon[8*i+j];}
       nope=atoi(&lakonl[7])+1;
       for(j=0;j<nope;j++){
           konl[j]=kon[indexe+j];
           for(j1=0;j1<3;j1++){
           xl[j*3+j1]=co[3*(konl[j]-1)+j1];
           voldl[mt*j+j1+1]=vold[mt*(konl[j]-1)+j1+1];
           veoldl[mt*j+j1+1]=veold[mt*(konl[j]-1)+j1+1];
           }
       }
       konl[nope]=kon[indexe+nope];
 
       FORTRAN(springforc_n2f,(xl,konl,voldl,&imat,elcon,nelcon,elas,
           fnl,ncmat_,ntmat_,&nope,lakonl,&t1l,&kodem,elconloc,
           plicon,nplicon,npmat_,&senergy,nener,cstr,mi,
           &springarea[2*(konl[nope]-1)],nmethod,&ne0,nstate_,
           xstateini,xstate,&reltime,&ielas,&venergy,ielorien,orab,
               norien,&i));
 
       storecontactdof(&nope,nactdof,&mt,konl,&ikactcont,&nactcont,
               &nactcont_,bcont,fnl,ikmpc,nmpc,ilmpc,ipompc,nodempc, 
               coefmpc);
 
       }
       if(nactcont>100){nactcont_=nactcont;}else{nactcont_=100;}
       RENEW(ikactcont,ITG,nactcont_);
 
   }
 
   iit=1;
 
   /* load at the start of a new step:
      mechanical loading without contact */
 
   if(!cyclicsymmetry){
       for(i=0;i<nev;i++){
       i2=(long long)i*neq[1];
       aamech[i]=0.;
       if(nactmech<neq[1]/2){
           for(j=0;j<nactmech;j++){
           aamech[i]+=z[i2+ikactmech[j]]*b[ikactmech[j]];
           }
       }else{
           for(j=0;j<neq[1];j++){
           aamech[i]+=z[i2+j]*b[j];
           }
       }
       aanew[i]=aamech[i];
       if(ncont!=0){
           for(j=0;j<nactcont;j++){
           aanew[i]+=z[i2+ikactcont[j]]*bcont[ikactcont[j]];
           }
       }
       }
   }else{
       for(i=0;i<nev;i++){aamech[i]=0.;}
       for(j=0;j<nactmech;j++){
       FORTRAN(nident,(izdof,&ikactmech[j],&nzdof,&id));
       if(id!=0){
           if(izdof[id-1]==ikactmech[j]){
           for(i=0;i<nev;i++){
               aamech[i]+=z[(long long)i*nzdof+id-1]*b[ikactmech[j]];
           }
           }else{printf(" *ERROR in dyna\n");FORTRAN(stop,());}
       }else{printf(" *ERROR in dyna\n");FORTRAN(stop,());}
       }
       memcpy(&aanew[0],&aamech[0],sizeof(double)*nev);
       if(ncont!=0){
       for(j=0;j<nactcont;j++){
           FORTRAN(nident,(izdof,&ikactcont[j],&nzdof,&id));
           if(id!=0){
           if(izdof[id-1]==ikactcont[j]){
               for(i=0;i<nev;i++){
               aanew[i]+=z[(long long)i*nzdof+id-1]*bcont[ikactcont[j]];
               }
           }else{printf(" *ERROR in dyna\n");FORTRAN(stop,());}
           }else{printf(" *ERROR in dyna\n");FORTRAN(stop,());}
       }
       }
   }
 
   /* check whether integration point values are requested; if not,
      the stress fields do not have to be allocated */
 
   intpointvar=0;
   if(*ithermal<=1){
 
       /* mechanical */
 
       if((strcmp1(&filab[174],"S")==0)||
      (strcmp1(&filab[261],"E")==0)||
      (strcmp1(&filab[348],"RF")==0)||
      (strcmp1(&filab[435],"PEEQ")==0)||
      (strcmp1(&filab[522],"ENER")==0)||
      (strcmp1(&filab[609],"SDV")==0)||
      (strcmp1(&filab[1044],"ZZS")==0)||
      (strcmp1(&filab[1044],"ERR")==0)||
      (strcmp1(&filab[1479],"PHS")==0)||
      (strcmp1(&filab[1653],"MAXS")==0)||
      (strcmp1(&filab[2175],"CONT")==0)||
      (strcmp1(&filab[2262],"CELS")==0)) intpointvar=1;
       for(i=0;i<*nprint;i++){
       if((strcmp1(&prlab[6*i],"S")==0)||
          (strcmp1(&prlab[6*i],"E")==0)||
          (strcmp1(&prlab[6*i],"PEEQ")==0)||
          (strcmp1(&prlab[6*i],"ENER")==0)||
          (strcmp1(&prlab[6*i],"SDV")==0)||
          (strcmp1(&prlab[6*i],"CDIS")==0)||
          (strcmp1(&prlab[6*i],"CSTR")==0)||
          (strcmp1(&prlab[6*i],"CELS")==0)||
          (strcmp1(&prlab[6*i],"RF")==0)) {intpointvar=1;break;}
       }
   }else{
 
       /* thermal */
 
       if((strcmp1(&filab[696],"HFL")==0)||
      (strcmp1(&filab[783],"RFL")==0)) intpointvar=1;
       for(i=0;i<*nprint;i++){
       if((strcmp1(&prlab[6*i],"HFL")==0)||
          (strcmp1(&prlab[6*i],"RFL")==0)) {intpointvar=1;break;}
       }
   }
 
   if((intpointvar==1)) NNEW(stx,double,6*mi[0]**ne);
 
   /* major loop */
 
   resultmaxprev=0.;
   resultmax=0.;
 
   while(1.-theta>1.e-6){
     
     time0=time;
     
 //    printf("\nnew increment\n");
     
     if(*nener==1){
       memcpy(&enerini[0],&ener[0],sizeof(double)*mi[0]*ne0);
       if(*ithermal!=2){
       memcpy(&stiini[0],&sti[0],sizeof(double)*6*mi[0]*ne0);
       memcpy(&emeini[0],&eme[0],sizeof(double)*6*mi[0]*ne0);
       }
     }
 
     if(ncont!=0){
     if(nmdnode!=0){
         for(i=0;i<nmdnode;i++){
         i1=mt*(imdnode[i]-1);
         for(j=kmin;j<=kmax;j++){
             vini[i1+j]=vold[i1+j];
         }
         }
     }else{
         memcpy(&vini[0],&vold[0],sizeof(double)*mt**nk);
     }
     if(*nstate_>0){
         for(k=0;k<*nstate_*mi[0]*(ne0+*nslavs);++k){
         xstateini[k]=xstate[k];
         }
     }   
     }
     iinc++;
     jprint++;
 
     if(dashpot)RENEW(rpar,double,4+nev*(3+nev));
       
     /* check for max. # of increments */
     
     if(iinc>*jmax){
       printf(" *ERROR in dyna: max. # of increments reached\n\n");
       FORTRAN(stop,());
     }
     
       if(iinc>1){
       memcpy(&cd[0],&bj[0],sizeof(double)*nev);
       memcpy(&cv[0],&bjp[0],sizeof(double)*nev);
       }
 
       
       if((*idrct!=1)&&(iinc!=1)){
     
     /* increasing the increment size */
     
         dthetaold=dtheta;
         dtheta=dthetaref*dd;
     
     /* check increment length whether
        - it does not exceed tmax
        - the step length is not exceeded
        - a time point is not exceeded  */
     
     dthetaref=dtheta;
     checkinclength(&time0,ttime,&theta,&dtheta,idrct,tper,tmax,
                tmin,ctrl, amta,namta,itpamp,&inext,&dthetaref,&itp,
                &jprint,jout);
     }
       
       reltime=theta+dtheta;
       time=reltime**tper;
       dtime=dtheta**tper;
       
       /* calculating the instantaneous loads (forces, surface loading, 
      centrifugal and gravity loading or temperature) */
       
       FORTRAN(temploaddiff,(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,itg,&ntg,amname,ikboun,ilboun,
           nelemload,sideload,mi,
           xforcdiff,xloaddiff,xbodydiff,t1diff,xboundiff,&iabsload,
           &iprescribedboundary,ntrans,trab,inotr,veold,nactdof,bcont,
               fn,ipobody,iponoel,inoel));
           
       /* calculating the instantaneous loading vector */
           
       if(iabsload!=2){
       FORTRAN(rhs,(co,nk,kon,ipkon,lakon,ne,
             ipompc,nodempc,coefmpc,nmpc,nodeforc,ndirforc,xforcdiff,
             nforc,nelemload,sideload,xloaddiff,nload,xbodydiff,
             ipobody,nbody,cgr,b,nactdof,&neq[1],nmethod,
             ikmpc,ilmpc,elcon,nelcon,rhcon,nrhcon,
             alcon,nalcon,alzero,ielmat,ielorien,norien,orab,ntmat_,
             t0,t1diff,ithermal,iprestr,vold,iperturb,iexpl,plicon,
             nplicon,plkcon,nplkcon,
             npmat_,ttime,&time,istep,&iinc,&dtime,physcon,ibody,
             xbodyold,&reltime,veold,matname,mi,ikactmech,&nactmech,
                     ielprop,prop,sti,xstateini,xstate,nstate_));
       }else{
       FORTRAN(rhs,(co,nk,kon,ipkon,lakon,ne,
             ipompc,nodempc,coefmpc,nmpc,nodeforc,ndirforc,xforcact,
             nforc,nelemload,sideload,xloadact,nload,xbodyact,
             ipobody,nbody,cgr,b,nactdof,&neq[1],nmethod,
             ikmpc,ilmpc,elcon,nelcon,rhcon,nrhcon,
             alcon,nalcon,alzero,ielmat,ielorien,norien,orab,ntmat_,
             t0,t1act,ithermal,iprestr,vold,iperturb,iexpl,plicon,
             nplicon,plkcon,nplkcon,
             npmat_,ttime,&time,istep,&iinc,&dtime,physcon,ibody,
             xbodyold,&reltime,veold,matname,mi,ikactmech,&nactmech,
                     ielprop,prop,sti,xstateini,xstate,nstate_));
       }
           
       /* correction for nonzero SPC's */
       
       if(iprescribedboundary){
       dynboun(amta,namta,nam,ampli,&time,ttime,&dtime,
                       xbounold,xboun,
               xbounact,iamboun,nboun,nodeboun,ndirboun,ad,au,adb,
               aub,icol,irow,neq,nzs,&sigma,b,isolver,
               &alpham,&betam,nzl,&init,bact,bmin,jq,amname,bv,
               bprev,bdiff,&nactmech,&iabsload,&iprev);
       }
 
       if(*idrct==0){
       bbmax=0.;
       if(iabsload!=2){
           if(nactmech<neq[1]/2){
           for(i=0;i<nactmech;i++){
               if(fabs(b[ikactmech[i]])>bbmax) bbmax=fabs(b[ikactmech[i]]);
           }
           }else{
           for(i=0;i<neq[1];i++){
               if(fabs(b[i])>bbmax) bbmax=fabs(b[i]);
           }
           }
       }else{
 
           /* bbmax is to be calculated from the difference of b and bold */
 
           if(nactmech<neq[1]/2){
           for(i=0;i<nactmech;i++){
               if(fabs(b[ikactmech[i]]-bold[ikactmech[i]])>bbmax) 
               bbmax=fabs(b[ikactmech[i]]-bold[ikactmech[i]]);
           }
           }else{
           for(i=0;i<neq[1];i++){
               if(fabs(b[i])>bbmax) bbmax=fabs(b[i]-bold[i]);
           }
           }
           
           /* copy b into bold */
 
           if(nactmech<neq[1]/2){
           for(i=0;i<nactmech;i++){
               bold[ikactmech[i]]=b[ikactmech[i]];
           }
           }else{
           memcpy(&bold[0],&b[0],sizeof(double)*neq[1]);
           }
       }
 
       /* check for size of mechanical force */
 
       if((bbmax>deltmx)&&(((itp==1)&&(dtheta>*tmin))||(itp==0))){
 
           /* force increase too big: increment size is decreased */
 
           if(iabsload==0) iabsload=1;
           dtheta=dtheta*deltmx/bbmax;
           dthetaref=dtheta;
           if(itp==1){
           inext--;
           itp=0;
           }
           
           /* check whether the new increment size is not too small */
           
           if(dtheta<*tmin){
           dtheta=*tmin;
           }
 
           reltime=theta+dtheta;
           time=reltime**tper;
           dtime=dtheta**tper;
           
           /* calculating the instantaneous loads (forces, surface loading, 
          centrifugal and gravity loading or temperature) */
           
           FORTRAN(temploaddiff,(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,itg,&ntg,amname,ikboun,ilboun,
         nelemload,sideload,mi,
         xforcdiff,xloaddiff,xbodydiff,t1diff,xboundiff,&iabsload,
         &iprescribedboundary,ntrans,trab,inotr,veold,nactdof,bcont,
                 fn,ipobody,iponoel,inoel));
           
           /* calculating the instantaneous loading vector */
           
           if(iabsload!=2){
           FORTRAN(rhs,(co,nk,kon,ipkon,lakon,ne,
             ipompc,nodempc,coefmpc,nmpc,nodeforc,ndirforc,xforcdiff,
             nforc,nelemload,sideload,xloaddiff,nload,xbodydiff,
             ipobody,nbody,cgr,b,nactdof,&neq[1],nmethod,
             ikmpc,ilmpc,elcon,nelcon,rhcon,nrhcon,
             alcon,nalcon,alzero,ielmat,ielorien,norien,orab,ntmat_,
             t0,t1diff,ithermal,iprestr,vold,iperturb,iexpl,plicon,
             nplicon,plkcon,nplkcon,
             npmat_,ttime,&time,istep,&iinc,&dtime,physcon,ibody,
             xbodyold,&reltime,veold,matname,mi,ikactmech,&nactmech,
                     ielprop,prop,sti,xstateini,xstate,nstate_));
           }else{
           FORTRAN(rhs,(co,nk,kon,ipkon,lakon,ne,
             ipompc,nodempc,coefmpc,nmpc,nodeforc,ndirforc,xforcact,
             nforc,nelemload,sideload,xloadact,nload,xbodyact,
             ipobody,nbody,cgr,b,nactdof,&neq[1],nmethod,
             ikmpc,ilmpc,elcon,nelcon,rhcon,nrhcon,
             alcon,nalcon,alzero,ielmat,ielorien,norien,orab,ntmat_,
             t0,t1act,ithermal,iprestr,vold,iperturb,iexpl,plicon,
             nplicon,plkcon,nplkcon,
             npmat_,ttime,&time,istep,&iinc,&dtime,physcon,ibody,
             xbodyold,&reltime,veold,matname,mi,ikactmech,&nactmech,
                     ielprop,prop,sti,xstateini,xstate,nstate_));
           }
           
           /* correction for nonzero SPC's */
           
           if(iprescribedboundary){
           dynboun(amta,namta,nam,ampli,&time,ttime,&dtime,
                       xbounold,xboun,
               xbounact,iamboun,nboun,nodeboun,ndirboun,ad,au,adb,
               aub,icol,irow,neq,nzs,&sigma,b,isolver,
               &alpham,&betam,nzl,&init,bact,bmin,jq,amname,bv,
                   bprev,bdiff,&nactmech,&iabsload,&iprev);
           }
           if(iabsload==1) iabsload=0;
       }
       
       if(ncont!=0){
           for(i=0;i<nactcont;i++){
           jdof=ikactcont[i];
           bcontini[jdof]=bcont[jdof];
           }
       }
 
       }
 
       /* step length is OK for mechanical load
      calculating equation for linearized loading */
 
       /* load: actual mechanical load +
                contact from last increment */
 
       if(!cyclicsymmetry){
       for(i=0;i<nev;i++){
           i2=(long long)i*neq[1];
           aa[i]=aanew[i];
           if(iabsload==2){aamech[i]=0.;}
           if(nactmech<neq[1]/2){
           for(j=0;j<nactmech;j++){
               aamech[i]+=z[i2+ikactmech[j]]*b[ikactmech[j]];
           }
           }else{
           for(j=0;j<neq[1];j++){
               aamech[i]+=z[i2+j]*b[j];
           }
           }
           
           aanew[i]=aamech[i];
           if(ncont!=0){
           for(j=0;j<nactcont;j++){
               aanew[i]+=z[i2+ikactcont[j]]*bcont[ikactcont[j]];
           }
           }
           
           bb[i]=(aanew[i]-aa[i])/dtime;
           aa[i]=aanew[i]-bb[i]*time;
       }
       }else{
       for(i=0;i<nev;i++){
           memcpy(&aa[0],&aanew[0],sizeof(double)*nev);
           if(iabsload==2){aamech[i]=0.;}
       }
       for(j=0;j<nactmech;j++){
           FORTRAN(nident,(izdof,&ikactmech[j],&nzdof,&id));
           if(id!=0){
           if(izdof[id-1]==ikactmech[j]){
               for(i=0;i<nev;i++){
               aamech[i]+=z[(long long)i*nzdof+id-1]*b[ikactmech[j]];
               }
           }else{printf(" *ERROR in dyna\n");FORTRAN(stop,());}
           }else{printf(" *ERROR in dyna\n");FORTRAN(stop,());}
       }
       memcpy(&aanew[0],&aamech[0],sizeof(double)*nev);
       if(ncont!=0){
           for(j=0;j<nactcont;j++){
           FORTRAN(nident,(izdof,&ikactcont[j],&nzdof,&id));
           if(id!=0){
               if(izdof[id-1]==ikactcont[j]){
               for(i=0;i<nev;i++){
                   aanew[i]+=z[(long long)i*nzdof+id-1]*bcont[ikactcont[j]];
               }
               }else{printf(" *ERROR in dyna\n");FORTRAN(stop,());}
           }else{printf(" *ERROR in dyna\n");FORTRAN(stop,());}
           }
       }
       for(i=0;i<nev;i++){
             bb[i]=(aanew[i]-aa[i])/(dtime);
         aa[i]=aanew[i]-bb[i]*time;
       } 
       }
       
       /* calculating the response due to unchanged contact force during
          the increment */
 
       if(dashpot){
       FORTRAN(subspace,(d,aa,bb,cc,&alpham,&betam,&nev,xini,
                 cd,cv,&time,rwork,&lrw,&iinc,jout,rpar,bj,
                 iwork,&liw,&iddebdf,bjp));
       if(iddebdf==2){
           liw=56+2*nev;
           RENEW(iwork,ITG,liw);
           for(i=0;i<liw;i++){iwork[i]=0;}
           lrw=250+20*nev+4*nev*nev;
           RENEW(rwork,double,lrw);
           for(i=0;i<lrw;i++){rwork[i]=0.;}
           iddebdf=1;
           FORTRAN(subspace,(d,aa,bb,cc,&alpham,&betam,&nev,xini,
                 cd,cv,&time,rwork,&lrw,&iinc,jout,rpar,bj,
                 iwork,&liw,&iddebdf,bjp));
       }
       }
       else{
       for(l=0;l<nev;l++){
           zetaj=zeta[l];
           dj=d[l];
           
           /* zero eigenfrequency: rigid body mode */
           
           if(fabs(d[l])<=1.e-10){
           aai=aa[l];
           bbi=bb[l];
           tstart=time0;
           tend=time;
           sum=tend*(aai*time+
                 tend*((bbi*time-aai)/2.-bbi*tend/3.))-
               tstart*(aai*time+
                   tstart*((bbi*time-aai)/2.-bbi*tstart/3.));
           sump=tend*(aai+bbi*tend/2.)-tstart*(aai+bbi*tstart/2.);
           bj[l]=sum+cd[l]+dtime*cv[l];
           bjp[l]=sump+cv[l];
           }
           
           /*   subcritical damping */
           
           else if(zetaj<1.-1.e-6){
           ddj=dj*sqrt(1.-zetaj*zetaj);
           h1=zetaj*dj;
           h2=h1*h1+ddj*ddj;
           h3=h1*h1-ddj*ddj;
           h4=2.*h1*ddj/h2;
           h14=h1/ddj;
           tstart=0.;              
           FORTRAN(fsub,(&time,&dtime,&aa[l],&bb[l],&ddj,
                 &h1,&h2,&h3,&h4,&func,&funcp));
           sum=func;sump=funcp;
           FORTRAN(fsub,(&time,&tstart,&aa[l],&bb[l],&ddj,
                 &h1,&h2,&h3,&h4,&func,&funcp));
           sum-=func;sump-=funcp;
           fexp=exp(-h1*dtime);
           fsin=sin(ddj*dtime);
           fcos=cos(ddj*dtime);
 
           bj[l]=sum/ddj+fexp*(fcos+zetaj/sqrt(1.-zetaj*zetaj)*fsin)*cd[l]+
               fexp*fsin*cv[l]/ddj;
           bjp[l]=sump/ddj+fexp*((-h1+ddj*h14)*fcos+(-ddj-h1*h14)*fsin)*cd[l]
             +fexp*(-h1*fsin+ddj*fcos)*cv[l]/ddj;
 
           }
           
           /*      supercritical damping */
           
           else if(zetaj>1.+1.e-6){
           ddj=dj*sqrt(zetaj*zetaj-1.);
           h1=ddj-zetaj*dj;
           h2=ddj+zetaj*dj;
           h3=1./h1;
           h4=1./h2;
           h5=h3*h3;
           h6=h4*h4;
           tstart=0.;              
           FORTRAN(fsuper,(&time,&dtime,&aa[l],&bb[l],
                   &h1,&h2,&h3,&h4,&h5,&h6,&func,&funcp));
           sum=func;sump=funcp;
           FORTRAN(fsuper,(&time,&tstart,&aa[l],&bb[l],
                   &h1,&h2,&h3,&h4,&h5,&h6,&func,&funcp));
           sum-=func;sump-=funcp;
           
           fexm=exp(h1*dtime);
           fexp=exp(-h2*dtime);
           h14=zetaj*dj/ddj;
           bj[l]=sum/(2.*ddj)+(fexm+fexp)*cd[l]/2.+zetaj*(fexm-fexp)/(2.*
               sqrt(zetaj*zetaj-1.))*cd[l]+(fexm-fexp)*cv[l]/(2.*ddj);
           bjp[l]=sump/(2.*ddj)+(h1*fexm-h2*fexp)*cd[l]/2.
             +(h14*cd[l]+cv[l]/ddj)*(h1*fexm+h2*fexp)/2.;
           }
           
           /* critical damping */
           
           else{
           h1=zetaj*dj;
           h2=1./h1;
           h3=h2*h2;
           h4=h2*h3;
           tstart=0.;
           FORTRAN(fcrit,(&time,&dtime,&aa[l],&bb[l],&zetaj,&dj,
                  &ddj,&h1,&h2,&h3,&h4,&func,&funcp));
           sum=func;sump=funcp;
           FORTRAN(fcrit,(&time,&tstart,&aa[l],&bb[l],&zetaj,&dj,
                  &ddj,&h1,&h2,&h3,&h4,&func,&funcp));
           sum-=func;sump-=funcp;
           fexp=exp(-h1*dtime);
           bj[l]=sum+fexp*((1.+h1*dtime)*cd[l]+dtime*cv[l]);
           bjp[l]=sump+fexp*(-h1*h1*dtime*cd[l]+
                                     (1.-h1*dtime)*cv[l]);
           }
       }
       }
       
       /* composing the response */
       
       if(iprescribedboundary){
       if(nmdnode==0){
           memcpy(&b[0],&bmin[0],sizeof(double)*neq[1]);
           memcpy(&bp[0],&bv[0],sizeof(double)*neq[1]);
       }else{
           for(i=0;i<nmddof;i++){
           b[imddof[i]]=bmin[imddof[i]];
           bp[imddof[i]]=bv[imddof[i]];
           }
       }
       }
       else{
       if(nmdnode==0){
           DMEMSET(b,0,neq[1],0.);
           DMEMSET(bp,0,neq[1],0.);
       }else{
           for(i=0;i<nmddof;i++){
           b[imddof[i]]=0.;
           bp[imddof[i]]=0.;
           }
       }
       }
       
       if(!cyclicsymmetry){
       if(nmdnode==0){
           for(i=0;i<neq[1];i++){
           for(j=0;j<nev;j++){
               b[i]+=bj[j]*z[(long long)j*neq[1]+i];
               bp[i]+=bjp[j]*z[(long long)j*neq[1]+i];
           }
           }
       }else{
           for(i=0;i<nmddof;i++){
           for(j=0;j<nev;j++){
               b[imddof[i]]+=bj[j]*z[(long long)j*neq[1]+imddof[i]];
               bp[imddof[i]]+=bjp[j]*z[(long long)j*neq[1]+imddof[i]];
           }
           }
       }
       }else{
       for(i=0;i<nmddof;i++){
           FORTRAN(nident,(izdof,&imddof[i],&nzdof,&id));
           if(id!=0){
           if(izdof[id-1]==imddof[i]){
               for(j=0;j<nev;j++){
               b[imddof[i]]+=bj[j]*z[(long long)j*nzdof+id-1];
               bp[imddof[i]]+=bjp[j]*z[(long long)j*nzdof+id-1];
               }
           }else{printf(" *ERROR in dyna\n");FORTRAN(stop,());}
           }else{printf(" *ERROR in dyna\n");FORTRAN(stop,());}
       }
       }
       
       /* update nonlinear MPC-coefficients (e.g. for rigid
      body MPC's */
 
       if(inonlinmpc==1){
       FORTRAN(nonlinmpc,(co,vold,ipompc,nodempc,coefmpc,labmpc,
              nmpc,ikboun,ilboun,nboun,xbounact,aux,iaux,
              &maxlenmpc,ikmpc,ilmpc,&icascade,
              kon,ipkon,lakon,ne,&reltime,&newstep,xboun,fmpc,
              &iit,&idiscon,&ncont,trab,ntrans,ithermal,mi));
       }
       
       /* calculating displacements/temperatures */
       
       FORTRAN(dynresults,(nk,v,ithermal,nactdof,vold,nodeboun,
           ndirboun,xbounact,nboun,ipompc,nodempc,coefmpc,labmpc,nmpc,
           b,bp,veold,&dtime,mi,imdnode,&nmdnode,imdboun,&nmdboun,
           imdmpc,&nmdmpc,nmethod,&time));
       
       /* creating contact elements and calculating the contact forces
      based on the displacements at the end of the present increment */
       
       if(ncont!=0){
       dynacont(co,nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,xboun,nboun,
           ipompc,nodempc,coefmpc,labmpc,nmpc,nodeforc,ndirforc,xforc,
           nforc,nelemload,sideload,xload,nload,nactdof,neq,nzl,icol,
               irow,
           nmethod,ikmpc,ilmpc,ikboun,ilboun,elcon,nelcon,rhcon,
           nrhcon,cocon,ncocon,alcon,nalcon,alzero,ielmat,ielorien,
               norien,orab,ntmat_,t0,t1,ithermal,prestr,iprestr,
           vold,iperturb,sti,nzs,tinc,tper,xmodal,veold,amname,amta,
           namta,nam,iamforc,iamload,iamt1,jout,filab,eme,xforcold,
           xloadold,t1old,iamboun,xbounold,iexpl,plicon,nplicon,plkcon,
               nplkcon,xstate,npmat_,matname,mi,ncmat_,nstate_,ener,jobnamec,
           ttime,set,nset,istartset,iendset,ialset,nprint,prlab,
           prset,nener,trab,inotr,ntrans,fmpc,cbody,ibody,xbody,nbody,
               xbodyold,istep,isolver,jq,output,mcs,nkon,mpcend,ics,cs,ntie,
               tieset,idrct,jmax,tmin,tmax,ctrl,itpamp,tietol,&iit,
           &ncont,&ne0,&reltime,&dtime,bcontini,bj,aux,iaux,bcont,
           &nev,v,&nkon0,&deltmx,&dtheta,&theta,&iprescribedboundary,
           &mpcfree,&memmpc_,itietri,koncont,cg,straight,&iinc,
           vini,aa,bb,aanew,d,z,zeta,b,&time0,&time,ipobody,
           xforcact,xloadact,t1act,xbounact,xbodyact,cd,cv,ampli,
           &dthetaref,bjp,bp,cstr,imddof,&nmddof, 
           &ikactcont,&nactcont,&nactcont_,aamech,bprev,&iprev,&inonlinmpc,
           &ikactmech,&nactmech,imdnode,&nmdnode,imdboun,&nmdboun,
           imdmpc,&nmdmpc,&itp,&inext,imastop,
               nslavnode,islavnode,islavsurf,itiefac,areaslav,iponoels,
           inoels,springarea,izdof,&nzdof,fn,imastnode,nmastnode,xmastnor,
           xstateini,nslavs,&cyclicsymmetry,xnoels,&ielas,ielprop,prop);
       }   
       
       theta+=dtheta;
 //      (*ttime)+=dtime;
       
       /* check whether a time point was reached */
       
       if((*itpamp>0)&&(*idrct==0)){
       if(itp==1){
           jprint=*jout;
       }else{
           jprint=*jout+1;
       }
       }
       
       /* check whether output is needed */
       
       if((*jout==jprint)||(1.-theta<=1.e-6)){
       iout=2;
       jprint=0;
       }else if((*nener==1)){
       iout=-2;
       }else{
       iout=0;
       }
       
       if((iout==2)||(iout==-2)){
 
         /* deactivating the elements for which the stresses are not
            needed */
 
     if(nmdnode>0){
         if((intpointvar==1)){
         for(k=0;k<ne0;k++){
             if(ipkon[k]<-1){
             printf(" *ERROR in dyna: contact remeshing of quadratic elements is not allowed\n\n");
             FORTRAN(stop,());
             }else if(ipkon[k]!=-1){
             ipkon[k]=-ipkon[k]-2;
             }
         }
         for(k=0;k<nmdelem;k++){
             ielem=imdelem[k]-1;
             ipkon[ielem]=-2-ipkon[ielem];
         }
         }
     }
 
     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,emn,een,
         iperturb,f,fn,nactdof,&iout,qa,
         vold,b,nodeboun,ndirboun,xbounact,nboun,
         ipompc,nodempc,coefmpc,labmpc,nmpc,nmethod,cam,&neq[1],
         veold,accold,&bet,&gam,&dtime,&time,ttime,
         plicon,nplicon,plkcon,nplkcon,
         xstateini,xstiff,xstate,npmat_,epn,matname,mi,&ielas,
         &icmd,ncmat_,nstate_,stiini,vini,ikboun,ilboun,ener,
         enern,emeini,xstaten,eei,enerini,cocon,ncocon,
         set,nset,istartset,iendset,ialset,nprint,prlab,prset,
         qfx,qfn,trab,inotr,ntrans,fmpc,nelemload,nload,ikmpc,
         ilmpc,istep,&iinc,springarea,&reltime,&ne0,xforc,nforc,
         thicke,shcon,nshcon,
         sideload,xload,xloadold,&icfd,inomat,pslavsurf,pmastsurf,
         &mortar,islavact,cdn,islavnode,nslavnode,ntie,clearini,
                 islavsurf,ielprop,prop,energyini,energy,&iit,iponoel,
                 inoel,nener,orname,&network,ipobody,xbodyact,ibody);
 
     /* restoring */
 
     if(nmdnode>0){
         if((intpointvar==1)){
         for(k=0;k<ne0;k++){
             if(ipkon[k]<-1){ipkon[k]=-2-ipkon[k];}
         }
         }
     }
     
     if((*ithermal!=2)&&(intpointvar==1)){
       for(k=0;k<6*mi[0]*ne0;++k){
         sti[k]=stx[k];
       }
     }
       }
       if(iout==2){
         (*kode)++;
     if(strcmp1(&filab[1044],"ZZS")==0){
         NNEW(neigh,ITG,40**ne);
         NNEW(ipneigh,ITG,*nk);
     }
 
     ptime=*ttime+time;
     frd(co,&nkg,kon,ipkon,lakon,&neg,v,stn,inum,nmethod,
         kode,filab,een,t1,fn,&ptime,epn,ielmat,matname,enern,xstaten,
         nstate_,istep,&iinc,ithermal,qfn,&mode,&noddiam,trab,inotr,
         ntrans,orab,ielorien,norien,description,ipneigh,neigh,
         mi,stx,vr,vi,stnr,stni,vmax,stnmax,&ngraph,veold,ener,ne,
         cs,set,nset,istartset,iendset,ialset,eenmax,fnr,fni,emn,
         thicke,jobnamec,output,qfx,cdn,&mortar,cdnr,cdni,nmat);
     
     if(strcmp1(&filab[1044],"ZZS")==0){SFREE(ipneigh);SFREE(neigh);}
       }
       
       if(isteadystate==1){
       
       /* calculate maximum displacement/temperature */
       
       resultmax=0.;
       if(*ithermal<2){
           for(i=1;i<mt**nk;i=i+mt){
           if(fabs(v[i])>resultmax) resultmax=fabs(v[i]);}
           for(i=2;i<mt**nk;i=i+mt){
           if(fabs(v[i])>resultmax) resultmax=fabs(v[i]);}
           for(i=3;i<mt**nk;i=i+mt){
           if(fabs(v[i])>resultmax) resultmax=fabs(v[i]);}
       }else if(*ithermal==2){
           for(i=0;i<mt**nk;i=i+mt){
           if(fabs(v[i])>resultmax) resultmax=fabs(v[i]);}
       }else{
           printf(" *ERROR in dyna: coupled temperature-displacement calculations are not allowed\n");
       }
       if(fabs((resultmax-resultmaxprev)/resultmax)<precision){
           break;
       }else{resultmaxprev=resultmax;}
       }
      
   }
       
   if((intpointvar==1)) SFREE(stx);
 
   /* calculating the displacements and velocities in all nodes as 
      initial condition for the next step; only needed if
      - nonzero initial conditions are allowed (-> no cyclic symmetry)
      - the output was restricted (-> nmdnode nonzero) */
 
   if((nmdnode!=0)&&(!cyclicsymmetry)){
 
       /* determining the solution in the independent nodes */
 
       DMEMSET(b,0,neq[1],0.);
       DMEMSET(bp,0,neq[1],0.);
 
       for(i=0;i<neq[1];i++){
       for(j=0;j<nev;j++){
           b[i]+=bj[j]*z[(long long)j*neq[1]+i];
           bp[i]+=bjp[j]*z[(long long)j*neq[1]+i];
       }
       }
       
       /* update nonlinear MPC-coefficients (e.g. for rigid
      body MPC's */
 
       if(inonlinmpc==1){
       FORTRAN(nonlinmpc,(co,vold,ipompc,nodempc,coefmpc,labmpc,
              nmpc,ikboun,ilboun,nboun,xbounact,aux,iaux,
              &maxlenmpc,ikmpc,ilmpc,&icascade,
              kon,ipkon,lakon,ne,&reltime,&newstep,xboun,fmpc,
              &iit,&idiscon,&ncont,trab,ntrans,ithermal,mi));
       }
       
       /* calculating displacements/temperatures */
       
       nmdnode=0;
       FORTRAN(dynresults,(nk,v,ithermal,nactdof,vold,nodeboun,
           ndirboun,xbounact,nboun,ipompc,nodempc,coefmpc,labmpc,nmpc,
           b,bp,veold,&dtime,mi,imdnode,&nmdnode,imdboun,&nmdboun,
           imdmpc,&nmdmpc,nmethod,&time));
   }
   
   SFREE(eei);
   SFREE(vbounact);
   SFREE(abounact);
 
   if(*nener==1){SFREE(stiini);SFREE(emeini);SFREE(enerini);}
 
   if(strcmp1(&filab[261],"E   ")==0) SFREE(een);
   if(strcmp1(&filab[522],"ENER")==0) SFREE(enern);
   if(strcmp1(&filab[609],"SDV ")==0) SFREE(xstaten);
   if(strcmp1(&filab[2697],"ME  ")==0) SFREE(emn);
   if(*ithermal>1) {SFREE(qfn);SFREE(qfx);}
 
   /* 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){xboun[k]=xbounact[k];}
   for(k=0;k<*nforc;++k){xforc[k]=xforcact[k];}
   for(k=0;k<2**nload;++k){xload[k]=xloadact[k];}
   for(k=0;k<7**nbody;k=k+7){xbody[k]=xbodyact[k];}
   if(*ithermal==1){
     for(k=0;k<*nk;++k){t1[k]=t1act[k];}
   }
   
   SFREE(v);SFREE(fn);SFREE(stn);SFREE(inum);SFREE(adb);SFREE(d);
   SFREE(aub);SFREE(z);SFREE(b);SFREE(zeta);SFREE(bj);SFREE(cd);SFREE(cv);
   SFREE(xforcact);SFREE(xloadact);SFREE(xbounact);SFREE(aa);SFREE(bb);SFREE(aanew);
   SFREE(ampli);SFREE(xbodyact);SFREE(bjp);SFREE(bp);SFREE(aamech);SFREE(ikactmech);
   SFREE(xforcdiff);SFREE(xloaddiff);SFREE(xboundiff),SFREE(xbodydiff);
 
   if(*ithermal==1) {SFREE(t1act);SFREE(t1diff);}
 
   if(iprescribedboundary){
       if(*isolver==0){
 #ifdef SPOOLES
       spooles_cleanup();
 #endif
       }
       else if(*isolver==4){
 #ifdef SGI
       sgi_cleanup(token);
 #endif
       }
       else if(*isolver==5){
 #ifdef TAUCS
       tau_cleanup();
 #endif
       }
       else if(*isolver==7){
 #ifdef PARDISO
       pardiso_cleanup(&neq[1],&symmetryflag);
 #endif
       }
       SFREE(bact);SFREE(bmin);SFREE(bv);SFREE(bprev);SFREE(bdiff);
   }
 
   /* deleting the contact information */
 
 //  *ne=ne0; *nkon=nkon0;
   if(ncont!=0){
       *ne=ne0; *nkon=nkon0;
       if(*nener==1){
     RENEW(ener,double,mi[0]**ne*2);
       }
       RENEW(ipkon,ITG,*ne);
       RENEW(lakon,char,8**ne);
       RENEW(kon,ITG,*nkon);
       if(*norien>0){
       RENEW(ielorien,ITG,mi[2]**ne);
       }
       RENEW(ielmat,ITG,mi[2]**ne);
       SFREE(cg);SFREE(straight);
 
       SFREE(vini);SFREE(bcont);SFREE(bcontini);SFREE(ikactcont);
 
       SFREE(imastop);SFREE(itiefac);SFREE(islavsurf);SFREE(islavnode);
       SFREE(nslavnode);SFREE(iponoels);SFREE(inoels);SFREE(imastnode);
       SFREE(nmastnode);SFREE(itietri);SFREE(koncont);SFREE(xnoels);
       SFREE(springarea);SFREE(xmastnor);
 
       SFREE(areaslav);
 
       if(*nstate_>0){SFREE(xstateini);}
 
   }
 
   if(!cyclicsymmetry){
       SFREE(ad);SFREE(au);
   }else{
       SFREE(adbe); SFREE(aube);SFREE(icole); SFREE(irowe); SFREE(jqe);SFREE(izdof);
       SFREE(nm);
 
       *nk/=nsectors;
       *ne/=nsectors;
       *nkon/=nsectors;
       *nboun/=nsectors;
       neq[1]=neq[1]*2/nsectors;
 
       RENEW(ialset,ITG,nalset_);
 
       /* restore the infomration in istartset and iendset */
 
       for(j=0; j<*nset; j++){
     istartset[j]=istartset_[j];
     iendset[j]=iendset_[j];
       }
       SFREE(istartset_);
       SFREE(iendset_);
 
       RENEW(co,double,3**nk);
       if((*ithermal!=0)&&(*nam>0)) RENEW(iamt1,ITG,*nk);
       RENEW(nactdof,ITG,mt**nk);
       if(*ntrans>0) RENEW(inotr,ITG,2**nk);
       RENEW(kon,ITG,*nkon);
       RENEW(ipkon,ITG,*ne);
       RENEW(lakon,char,8**ne);
       RENEW(ielmat,ITG,mi[2]**ne);
       if(*norien>0) RENEW(ielorien,ITG,mi[2]**ne);
       RENEW(nodeboun,ITG,*nboun);
       RENEW(ndirboun,ITG,*nboun);
       if(*nam>0) RENEW(iamboun,ITG,*nboun);
       RENEW(xboun,double,*nboun);
       RENEW(xbounold,double,*nboun);
       RENEW(ikboun,ITG,*nboun);
       RENEW(ilboun,ITG,*nboun);
 
       /* recovering the original multiple point constraints */
 
       RENEW(ipompc,ITG,*nmpc);
       RENEW(nodempc,ITG,3**mpcend);
       RENEW(coefmpc,double,*mpcend);
       RENEW(labmpc,char,20**nmpc+1);
       RENEW(ikmpc,ITG,*nmpc);
       RENEW(ilmpc,ITG,*nmpc);
       RENEW(fmpc,double,*nmpc);
 
       *nmpc=nmpcold;
       *mpcend=mpcendold;
       for(i=0;i<*nmpc;i++){ipompc[i]=ipompcold[i];}
       for(i=0;i<3**mpcend;i++){nodempc[i]=nodempcold[i];}
       for(i=0;i<*mpcend;i++){coefmpc[i]=coefmpcold[i];}
       for(i=0;i<20**nmpc;i++){labmpc[i]=labmpcold[i];}
       for(i=0;i<*nmpc;i++){ikmpc[i]=ikmpcold[i];}
       for(i=0;i<*nmpc;i++){ilmpc[i]=ilmpcold[i];}
       SFREE(ipompcold);SFREE(nodempcold);SFREE(coefmpcold);
       SFREE(labmpcold);SFREE(ikmpcold);SFREE(ilmpcold);
 
       RENEW(vold,double,mt**nk);
       RENEW(veold,double,mt**nk);
       RENEW(eme,double,6*mi[0]**ne);
       RENEW(sti,double,6*mi[0]**ne);
       if(*nener==1)RENEW(ener,double,mi[0]**ne*2);
 
 /* distributed loads */
 
       for(i=0;i<*nload;i++){
       if(nelemload[2*i+1]<nsectors){
           nelemload[2*i]-=*ne*nelemload[2*i+1];
       }else{
           nelemload[2*i]-=*ne*(nelemload[2*i+1]-nsectors);
       }
       }
 
   /*  sorting the elements with distributed loads */
 
       if(*nload>0){
       if(*nam>0){
           FORTRAN(isortiiddc,(nelemload,iamload,xload,xloadold,sideload,nload,&kflag));
       }else{
           FORTRAN(isortiddc,(nelemload,xload,xloadold,sideload,nload,&kflag));
       }
       }
       
 /* point loads */
       
       for(i=0;i<*nforc;i++){
       if(nodeforc[2*i+1]<nsectors){
           nodeforc[2*i]-=*nk*nodeforc[2*i+1];
       }else{
           nodeforc[2*i]-=*nk*(nodeforc[2*i+1]-nsectors);
       }
       }
   }
 
 //  SFREE(xstiff);
   if(*nbody>0) SFREE(ipobody);
 
   if(dashpot){
       SFREE(xini);SFREE(rwork);SFREE(adc);SFREE(auc);SFREE(cc);
       SFREE(rpar);SFREE(iwork);}
 
   SFREE(cstr);
 
   SFREE(imddof);SFREE(imdnode);SFREE(imdboun);SFREE(imdmpc);SFREE(imdelem);
 
   if(iabsload==2) SFREE(bold);
 
   *ialsetp=ialset;
   *cop=co;*konp=kon;*ipkonp=ipkon;*lakonp=lakon;*ielmatp=ielmat;
   *ielorienp=ielorien;*inotrp=inotr;*nodebounp=nodeboun;
   *ndirbounp=ndirboun;*iambounp=iamboun;*xbounp=xboun;
   *xbounoldp=xbounold;*ikbounp=ikboun;*ilbounp=ilboun;*nactdofp=nactdof;
   *voldp=vold;*emep=eme;*enerp=ener;*ipompcp=ipompc;*nodempcp=nodempc;
   *coefmpcp=coefmpc;*labmpcp=labmpc;*ikmpcp=ikmpc;*ilmpcp=ilmpc;
   *fmpcp=fmpc;*veoldp=veold;*iamt1p=iamt1;*t0p=t0;*t1oldp=t1old;*t1p=t1;
   *stip=sti;*xstatep=xstate;
 
   (*ttime)+=(*tper);
 
   return;
 }

◆ dynacont()

void dynacont	(	double *	co,
		ITG *	nk,
		ITG *	kon,
		ITG *	ipkon,
		char *	lakon,
		ITG *	ne,
		ITG *	nodeboun,
		ITG *	ndirboun,
		double *	xboun,
		ITG *	nboun,
		ITG *	ipompc,
		ITG *	nodempc,
		double *	coefmpc,
		char *	labmpc,
		ITG *	nmpc,
		ITG *	nodeforc,
		ITG *	ndirforc,
		double *	xforc,
		ITG *	nforc,
		ITG *	nelemload,
		char *	sideload,
		double *	xload,
		ITG *	nload,
		ITG *	nactdof,
		ITG *	neq,
		ITG *	nzl,
		ITG *	icol,
		ITG *	irow,
		ITG *	nmethod,
		ITG *	ikmpc,
		ITG *	ilmpc,
		ITG *	ikboun,
		ITG *	ilboun,
		double *	elcon,
		ITG *	nelcon,
		double *	rhcon,
		ITG *	nrhcon,
		double *	cocon,
		ITG *	ncocon,
		double *	alcon,
		ITG *	nalcon,
		double *	alzero,
		ITG *	ielmat,
		ITG *	ielorien,
		ITG *	norien,
		double *	orab,
		ITG *	ntmat_,
		double *	t0,
		double *	t1,
		ITG *	ithermal,
		double *	prestr,
		ITG *	iprestr,
		double *	vold,
		ITG *	iperturb,
		double *	sti,
		ITG *	nzs,
		double *	tinc,
		double *	tper,
		double *	xmodal,
		double *	veold,
		char *	amname,
		double *	amta,
		ITG *	namta,
		ITG *	nam,
		ITG *	iamforc,
		ITG *	iamload,
		ITG *	iamt1,
		ITG *	jout,
		char *	filab,
		double *	eme,
		double *	xforcold,
		double *	xloadold,
		double *	t1old,
		ITG *	iamboun,
		double *	xbounold,
		ITG *	iexpl,
		double *	plicon,
		ITG *	nplicon,
		double *	plkcon,
		ITG *	nplkcon,
		double *	xstate,
		ITG *	npmat_,
		char *	matname,
		ITG *	mi,
		ITG *	ncmat_,
		ITG *	nstate_,
		double *	ener,
		char *	jobnamec,
		double *	ttime,
		char *	set,
		ITG *	nset,
		ITG *	istartset,
		ITG *	iendset,
		ITG *	ialset,
		ITG *	nprint,
		char *	prlab,
		char *	prset,
		ITG *	nener,
		double *	trab,
		ITG *	inotr,
		ITG *	ntrans,
		double *	fmpc,
		char *	cbody,
		ITG *	ibody,
		double *	xbody,
		ITG *	nbody,
		double *	xbodyold,
		ITG *	istep,
		ITG *	isolver,
		ITG *	jq,
		char *	output,
		ITG *	mcs,
		ITG *	nkon,
		ITG *	mpcend,
		ITG *	ics,
		double *	cs,
		ITG *	ntie,
		char *	tieset,
		ITG *	idrct,
		ITG *	jmax,
		double *	tmin,
		double *	tmax,
		double *	ctrl,
		ITG *	itpamp,
		double *	tietol,
		ITG *	iit,
		ITG *	ncont,
		ITG *	ne0,
		double *	reltime,
		double *	dtime,
		double *	bcontini,
		double *	bj,
		double *	aux,
		ITG *	iaux,
		double *	bcont,
		ITG *	nev,
		double *	v,
		ITG *	nkon0,
		double *	deltmx,
		double *	dtheta,
		double *	theta,
		ITG *	iprescribedboundary,
		ITG *	mpcfree,
		ITG *	memmpc_,
		ITG *	itietri,
		ITG *	koncont,
		double *	cg,
		double *	straight,
		ITG *	iinc,
		double *	vini,
		double *	aa,
		double *	bb,
		double *	aanew,
		double *	d,
		double *	z,
		double *	zeta,
		double *	b,
		double *	time0,
		double *	time1,
		ITG *	ipobody,
		double *	xforcact,
		double *	xloadact,
		double *	t1act,
		double *	xbounact,
		double *	xbodyact,
		double *	cd,
		double *	cv,
		double *	ampli,
		double *	dthetaref,
		double *	bjp,
		double *	bp,
		double *	cstr,
		ITG *	imddof,
		ITG *	nmddof,
		ITG **	ikactcontp,
		ITG *	nactcont,
		ITG *	nactcont_,
		double *	aamech,
		double *	bprev,
		ITG *	iprev,
		ITG *	inonlinmpc,
		ITG **	ikactmechp,
		ITG *	nactmech,
		ITG *	imdnode,
		ITG *	nmdnode,
		ITG *	imdboun,
		ITG *	nmdboun,
		ITG *	imdmpc,
		ITG *	nmdmpc,
		ITG *	itp,
		ITG *	inext,
		ITG *	imastop,
		ITG *	nslavnode,
		ITG *	islavnode,
		ITG *	islavsurf,
		ITG *	itiefac,
		double *	areaslav,
		ITG *	iponoels,
		ITG *	inoels,
		double *	springarea,
		ITG *	izdof,
		ITG *	nzdof,
		double *	fn,
		ITG *	imastnode,
		ITG *	nmastnode,
		double *	xmastnor,
		double *	xstateini,
		ITG *	nslavs,
		ITG *	cyclicsymmetry,
		double *	xnoels,
		ITG *	ielas,
		ITG *	ielprop,
		double *	prop
	)

                            {
     
   char lakonl[9]="        \0",jobnamef[396]="";
 
   ITG i,j,k,l,init,*itg=NULL,ntg=0,maxlenmpc,icascade=0,loop,
       konl[20],imat,nope,kodem,indexe,j1,jdof,kmin,kmax,
       id,newstep=0,idiscon,*ipiv=NULL,info,nrhs=1,kode,
       *ikactcont=NULL,*ilactcont=NULL,*ikactcont1=NULL,nactcont1=0,
       i1,icutb=0,iconvergence=0,idivergence=0,mt=mi[1]+1,
       nactcont1_=100,*ikactmech=NULL,iabsload=0,im,nasym=0,mortar=0,
       ialeatoric=0,*iponoel=NULL,*inoel=NULL;
 
   long long i2;
 
   double *adb=NULL,*aub=NULL,*cgr=NULL, *au=NULL,fexp,fcos,fsin,fexm,
       physcon[1],zetaj,dj,ddj,h1,h2,h3,h4,h5,h6,sum,aai,bbi,tstart,tend,
       *ad=NULL,sigma=0.,alpham,betam,*bact=NULL,*bmin=NULL,*bv=NULL,
       xl[27],voldl[mt*9],elas[21],fnl[27],t1l,elconloc[21],veoldl[mt*9],
       bbmax,s[3600],*aaa=NULL,*bbb=NULL,func,funcp,*bjbasp=NULL,
       *bjbas=NULL, *bjinc=NULL, *dbj=NULL, *lhs=NULL,dbjmax,bjmax,
       *bjincp=NULL,sump,h14,*dbjp=NULL,senergy=0.0,*xforcdiff=NULL,
       df,i0,ic,ia,dbjmaxOLD1,dbjmaxOLD2,*xloaddiff=NULL,*dbcont=NULL,
       zl=0.0,*xbodydiff=NULL,*t1diff=NULL,*xboundiff=NULL,*bdiff=NULL,
       *pslavsurf=NULL,*pmastsurf=NULL,*clearini=NULL,venergy=0.0;
 
   ikactcont=*ikactcontp;ikactmech=*ikactmechp;
   
   for(k=0;k<3;k++){
       strcpy1(&jobnamef[k*132],&jobnamec[k*132],132);
   }
 
   if(*inonlinmpc==1) iabsload=2;
 
   if(ithermal[0]<=1){
       kmin=1;kmax=3;
   }else if(ithermal[0]==2){
       kmin=0;kmax=mi[1];if(kmax>2)kmax=2;
   }else{
       kmin=0;kmax=3;
   }
 
   NNEW(xforcdiff,double,*nforc);
   NNEW(xloaddiff,double,2**nload);
   NNEW(xbodydiff,double,7**nbody);
 
   /* copying the rotation axis and/or acceleration vector */
 
   for(k=0;k<7**nbody;k++){xbodydiff[k]=xbody[k];}
   NNEW(xboundiff,double,*nboun);
   if(*ithermal==1) NNEW(t1diff,double,*nk);
 
   /* load the convergence constants from ctrl*/
 
   i0=ctrl[0];ic=ctrl[3];ia=ctrl[7];df=ctrl[10];
 
   /* set the convergence parameters*/
 
   dbjmaxOLD1=0.0;
   dbjmaxOLD2=0.0;
 
   /* calculating the contact forces */
     
   for(j=0;j<*nactcont;j++){bcont[ikactcont[j]]=0.;}
   
   *ne=*ne0;*nkon=*nkon0;
   
   contact(ncont,ntie,tieset,nset,set,istartset,iendset,
       ialset,itietri,lakon,ipkon,kon,koncont,ne,cg,
       straight,nkon,co,vold,ielmat,cs,elcon,istep,
       iinc,iit,ncmat_,ntmat_,ne0,
       vini,nmethod,
           iperturb,ikboun,nboun,mi,imastop,nslavnode,islavnode,islavsurf,
           itiefac,areaslav,iponoels,inoels,springarea,tietol,reltime,
       imastnode,nmastnode,xmastnor,filab,mcs,ics,&nasym,
           xnoels,&mortar,pslavsurf,pmastsurf,clearini,theta,
       xstateini,xstate,nstate_,&icutb,&ialeatoric,jobnamef);
 
   NNEW(ikactcont1,ITG,nactcont1_);
 
   for(i=*ne0;i<*ne;i++){
       indexe=ipkon[i];
       imat=ielmat[mi[2]*i];
       kodem=nelcon[2*imat-2];
       for(j=0;j<8;j++){lakonl[j]=lakon[8*i+j];}
       nope=atoi(&lakonl[7])+1;
       for(j=0;j<nope;j++){
       konl[j]=kon[indexe+j];
       for(j1=0;j1<3;j1++){
           xl[j*3+j1]=co[3*(konl[j]-1)+j1];
           voldl[mt*j+j1+1]=vold[mt*(konl[j]-1)+j1+1];
           veoldl[mt*j+j1+1]=veold[mt*(konl[j]-1)+j1+1];
       }
       }
       konl[nope]=kon[indexe+nope];
 
       FORTRAN(springforc_n2f,(xl,konl,voldl,&imat,elcon,nelcon,elas,
               fnl,ncmat_,ntmat_,&nope,lakonl,
               &t1l,&kodem,elconloc,plicon,nplicon,npmat_,
               &senergy,nener,cstr,mi,
                           &springarea[2*(konl[nope]-1)],nmethod,ne0,
               nstate_,xstateini,xstate,reltime,ielas,
               &venergy,ielorien,orab,norien,&i));
 
       storecontactdof(&nope,nactdof,&mt,konl,&ikactcont1,&nactcont1,
               &nactcont1_,bcont,fnl,ikmpc,nmpc,ilmpc,ipompc,nodempc, 
               coefmpc);
 
   }
   RENEW(ikactcont1,ITG,nactcont1);
 
   /* merging ikactcont with ikactcont1; the result ist
      stored in ikactcont */
 
   for(i=0;i<nactcont1;i++){
       jdof=ikactcont1[i];
       FORTRAN(nident,(ikactcont,&jdof,nactcont,&id));
       do{
       if(id>0){
           if(ikactcont[id-1]==jdof){
           break;
           }
       }
       (*nactcont)++;
       if(*nactcont>*nactcont_){
           *nactcont_=(ITG)(1.1**nactcont_);
           RENEW(ikactcont,ITG,*nactcont_);
       }
       k=*nactcont-1;
       l=k-1;
       while(k>id){
           ikactcont[k--]=ikactcont[l--];
       }
       ikactcont[id]=jdof;
       break;
       }while(1);
   }
     
     /* calculate the change in contact force */
     
   bbmax=0.;
   if(icutb==0){
       for(i=0;i<*nactcont;i++){
       jdof=ikactcont[i];
       if(fabs(bcont[jdof]-bcontini[jdof])>bbmax){
           bbmax=fabs(bcont[jdof]-bcontini[jdof]);
       }
       }
   }
 
   /* removing entries in bcont */
 
   for(j=0;j<nactcont1;j++){bcont[ikactcont1[j]]=0.;}
   SFREE(ikactcont1);
   *nactcont=0;
   
   /* major loop to calculate the correction of bj due to contact */
 
   NNEW(ilactcont,ITG,*nactcont_);
   NNEW(dbcont,double,*nactcont_**nev);
 
   icutb=0;
 
   do{
 
       /* restoring initial values */
 
       if(*nmdnode>0){
       for(i=0;i<*nmdnode;i++){
           i1=mt*(imdnode[i]-1);
           for(j=kmin;j<=kmax;j++){
           vold[i1+j]=vini[i1+j];
           }
       }
       }else{
       memcpy(&vold[0],&vini[0],sizeof(double)*mt**nk);
       }
 
       if(*nstate_!=0){
     for(k=0;k<*nstate_*mi[0]*(*ne0+*nslavs);++k){
       xstate[k]=xstateini[k];
     }   
       }
     
     /* restoring aa[(iinc-1)*nev+i] (before change of *dtime) */
 
     for(i=0;i<*nev;i++){
       aa[i]+=bb[i]*(*time-*dtime);
     }
     
     /* increment size is reduced if:
             - the contact force change is too large (only in first iteration)
             - or the increment did not converge  */
     
     if((bbmax>*deltmx || icutb>0)&&(((*itp==1)&&(*dtheta>*tmin))||(*itp==0))){
       
       /* force increase too big: increment size is decreased */
 
       if(icutb>0){
     *dtheta=*dtheta*df;
       }
       else{
     *dtheta=*dtheta**deltmx/bbmax;
       }
       *dthetaref=*dtheta;
       if(*itp==1){
       (*inext)--;
       *itp=0;
       }
       
       /* check whether the new increment size is not too small */
       
       if(*dtheta<*tmin){
       *dtheta=*tmin;
       *dthetaref=*dtheta;
       }
       
       *reltime=*theta+(*dtheta);
       *time=*reltime**tper;
       *dtime=*dtheta**tper;
       
       /* calculating the instantaneous loads (forces, surface loading, 
      centrifugal and gravity loading or temperature) */
       
       FORTRAN(temploaddiff,(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,itg,&ntg,amname,ikboun,ilboun,
         nelemload,sideload,mi,
         xforcdiff,xloaddiff,xbodydiff,t1diff,xboundiff,&iabsload,
         iprescribedboundary,ntrans,trab,inotr,veold,nactdof,bcont,
                 fn,ipobody,iponoel,inoel));
           
       /* calculating the instantaneous loading vector */
       
       if(iabsload!=2){
       FORTRAN(rhs,(co,nk,kon,ipkon,lakon,ne,
            ipompc,nodempc,coefmpc,nmpc,nodeforc,ndirforc,xforcdiff,
            nforc,nelemload,sideload,xloaddiff,nload,xbodydiff,
            ipobody,nbody,cgr,b,nactdof,&neq[1],nmethod,
            ikmpc,ilmpc,elcon,nelcon,rhcon,nrhcon,
            alcon,nalcon,alzero,ielmat,ielorien,norien,orab,ntmat_,
            t0,t1diff,ithermal,iprestr,vold,iperturb,iexpl,plicon,
            nplicon,plkcon,nplkcon,
            npmat_,ttime,time,istep,iinc,dtime,physcon,ibody,
            xbodyold,reltime,veold,matname,mi,ikactmech,nactmech,
                    ielprop,prop,sti,xstateini,xstate,nstate_));
       }else{
       FORTRAN(rhs,(co,nk,kon,ipkon,lakon,ne,
            ipompc,nodempc,coefmpc,nmpc,nodeforc,ndirforc,xforcact,
            nforc,nelemload,sideload,xloadact,nload,xbodyact,
            ipobody,nbody,cgr,b,nactdof,&neq[1],nmethod,
            ikmpc,ilmpc,elcon,nelcon,rhcon,nrhcon,
            alcon,nalcon,alzero,ielmat,ielorien,norien,orab,ntmat_,
            t0,t1act,ithermal,iprestr,vold,iperturb,iexpl,plicon,
            nplicon,plkcon,nplkcon,
            npmat_,ttime,time,istep,iinc,dtime,physcon,ibody,
            xbodyold,reltime,veold,matname,mi,ikactmech,nactmech,
                    ielprop,prop,sti,xstateini,xstate,nstate_));
       }
       
       /* correction for nonzero SPC's */
       
       if(*iprescribedboundary){
       dynboun(amta,namta,nam,ampli,time,ttime,dtime,
           xbounold,xboun,
           xbounact,iamboun,nboun,nodeboun,ndirboun,ad,au,adb,
           aub,icol,irow,neq,nzs,&sigma,b,isolver,
           &alpham,&betam,nzl,&init,bact,bmin,jq,amname,bv,
               bprev,bdiff,nactmech,&iabsload,iprev);
       }
 
       /* correcting aamech */
 
       if(!(*cyclicsymmetry)){
       for(i=0;i<*nev;i++){
           i2=(long long)i*neq[1];
           
           if(iabsload==2){aamech[i]=0.;}
           if(*nactmech<neq[1]/2){
           for(j=0;j<*nactmech;j++){
               aamech[i]+=z[i2+ikactmech[j]]*b[ikactmech[j]];
           }
           }else{
           for(j=0;j<neq[1];j++){
               aamech[i]+=z[i2+j]*b[j];
           }
           }
       }
       }else{
       for(i=0;i<*nev;i++){
           if(iabsload==2){aamech[i]=0.;}
       }
       for(j=0;j<*nactmech;j++){
           FORTRAN(nident,(izdof,&ikactmech[j],nzdof,&id));
           if(id!=0){
           if(izdof[id-1]==ikactmech[j]){
               for(i=0;i<*nev;i++){
               aamech[i]+=z[i**nzdof+id-1]*b[ikactmech[j]];
               }
           }else{printf("*ERROR in dynacont\n");FORTRAN(stop,());}
           }else{printf("*ERROR in dynacont\n");FORTRAN(stop,());}
       }
       }
       
     }
 
     bbmax=0.;
     
     /* calculating the linearized force function connecting the
        mechanical+contact load at the start of the increment with
        the mechanical load at the end of the increment
        = base load */
 
     for(i=0;i<*nev;i++){
 
       aanew[i]=aamech[i];
 
       bb[i]=(aanew[i]-aa[i])/(*dtime);
       aa[i]=aanew[i]-bb[i]**time;
     }
     
     /* calculating the base response */
 
     NNEW(bjbas,double,*nev); /* basis response modal decomposition */
     NNEW(bjbasp,double,*nev);
     for(l=0;l<*nev;l++){
       zetaj=zeta[l];
       dj=d[l];
       
       /* zero eigenfrequency: rigid body mode */
       
       if(fabs(d[l])<=1.e-10){
       aai=aa[l];
       bbi=bb[l];
       tstart=*time0;
       tend=*time;
       sum=tend*(aai**time+
             tend*((bbi**time-aai)/2.-bbi*tend/3.))-
           tstart*(aai**time+
               tstart*((bbi**time-aai)/2.-bbi*tstart/3.));
       sump=tend*(aai+bbi*tend/2.)-tstart*(aai+bbi*tstart/2.);
       bjbas[l]=sum+cd[l]+*dtime*cv[l];
       bjbasp[l]=sump+cv[l];
       }
       
       /*   subcritical damping */
       
       else if(zetaj<1.-1.e-6){
     ddj=dj*sqrt(1.-zetaj*zetaj);
     h1=zetaj*dj;
     h2=h1*h1+ddj*ddj;
     h3=h1*h1-ddj*ddj;
     h4=2.*h1*ddj/h2;
     h14=zetaj*dj/ddj;
     tstart=0;
     FORTRAN(fsub,(time,dtime,&aa[l],&bb[l],&ddj,
               &h1,&h2,&h3,&h4,&func,&funcp));
     sum=func;sump=funcp;
     FORTRAN(fsub,(time,&tstart,&aa[l],&bb[l],&ddj,
               &h1,&h2,&h3,&h4,&func,&funcp));
     sum-=func;sump-=funcp;
     fexp=exp(-h1**dtime);
     fsin=sin(ddj**dtime);
     fcos=cos(ddj**dtime);
     
     bjbas[l]=sum/ddj+fexp*(fcos+zetaj/sqrt(1.-zetaj*zetaj)*fsin)*cd[l]+
       fexp*fsin*cv[l]/ddj;
     bjbasp[l]=sump/ddj+fexp*((-h1+ddj*h14)*fcos+(-ddj-h1*h14)*fsin)*cd[l]
       +fexp*(-h1*fsin+ddj*fcos)*cv[l]/ddj;
     
       }
       
       /*      supercritical damping */
       
       else if(zetaj>1.+1.e-6){
     ddj=dj*sqrt(zetaj*zetaj-1.);
     h1=ddj-zetaj*dj;
     h2=ddj+zetaj*dj;
     h3=1./h1;
     h4=1./h2;
     h5=h3*h3;
     h6=h4*h4;
     tstart=0;
     FORTRAN(fsuper,(time,dtime,&aa[l],&bb[l],
             &h1,&h2,&h3,&h4,&h5,&h6,&func,&funcp));
     sum=func;sump=funcp;
     FORTRAN(fsuper,(time,&tstart,&aa[l],&bb[l],
             &h1,&h2,&h3,&h4,&h5,&h6,&func,&funcp));
     sum-=func;sump-=funcp;
     fexm=exp(h1**dtime);
     fexp=exp(-h2**dtime);
     h14=zetaj*dj/ddj;
     
     bjbas[l]=sum/(2.*ddj)+(fexm+fexp)*cd[l]/2.+zetaj*(fexm-fexp)/(2.*sqrt(zetaj*zetaj-1.))*cd[l]+(fexm-fexp)*cv[l]/(2.*ddj);
     bjbasp[l]=sump/(2.*ddj)+(h1*fexm-h2*fexp)*cd[l]/2.+(h14*cd[l]+cv[l]/ddj)*(h1*fexm+h2*fexp)/2.;
       }
       
       /* critical damping */
       
       else{
     h1=zetaj*dj;
     h2=1./h1;
     h3=h2*h2;
     h4=h2*h3;
     tstart=0;
     FORTRAN(fcrit,(time,dtime,&aa[l],&bb[l],&zetaj,&dj,
                &ddj,&h1,&h2,&h3,&h4,&func,&funcp));
     sum=func;sump=funcp;
     FORTRAN(fcrit,(time,&tstart,&aa[l],&bb[l],&zetaj,&dj,
                &ddj,&h1,&h2,&h3,&h4,&func,&funcp));
     sum-=func;sump+=funcp;
     fexp=exp(-h1**dtime);
     bjbas[l]=sum+fexp*((1.+h1**dtime)*cd[l]+*dtime*cv[l]);
     bjbasp[l]=sump+fexp*(-h1*h1**dtime*cd[l]+(1.-h1**dtime)*cv[l]);
       }
     }
     
     /* calculating the incremental response due to contact */
     
     aai=-(*time-*dtime)/(*dtime);
     bbi=1./(*dtime);
     
     NNEW(bjinc,double,*nev); /* incremental response modal decomposition */
     NNEW(bjincp,double,*nev);
     for(l=0;l<*nev;l++){
       zetaj=zeta[l];
       dj=d[l];
       
       /* zero eigenfrequency: rigid body mode */
       
       if(fabs(d[l])<=1.e-10){
     tstart=*time0;
     tend=*time;
     sum=tend*(aai**time+
           tend*((bbi**time-aai)/2.-bbi*tend/3.))-
       tstart*(aai**time+
           tstart*((bbi**time-aai)/2.-bbi*tstart/3.));
     sump=tend*(aai+bbi*tend/2.)-tstart*(aai+bbi*tstart/2.);
     
     bjinc[l]=sum;
     bjincp[l]=sump;
       }
       
       /*   subcritical damping */
       
       else if(zetaj<1.-1.e-6){
     ddj=dj*sqrt(1.-zetaj*zetaj);
     h1=zetaj*dj;
     h2=h1*h1+ddj*ddj;
     h3=h1*h1-ddj*ddj;
     h4=2.*h1*ddj/h2;
     tstart=0.;
     FORTRAN(fsub,(time,dtime,&aai,&bbi,&ddj,
               &h1,&h2,&h3,&h4,&func,&funcp));
     sum=func;sump=funcp;
     FORTRAN(fsub,(time,&tstart,&aai,&bbi,&ddj,
               &h1,&h2,&h3,&h4,&func,&funcp));
     sum-=func;sump-=funcp;
     
     bjinc[l]=sum/ddj;
     bjincp[l]=sump/ddj;
     
       }
       
       /*      supercritical damping */
       
       else if(zetaj>1.+1.e-6){
     ddj=dj*sqrt(zetaj*zetaj-1.);
     h1=ddj-zetaj*dj;
     h2=ddj+zetaj*dj;
     h3=1./h1;
     h4=1./h2;
     h5=h3*h3;
     h6=h4*h4;
     tstart=0.;
     FORTRAN(fsuper,(time,dtime,&aai,&bbi,
             &h1,&h2,&h3,&h4,&h5,&h6,&func,&funcp));
     sum=func;sump=funcp;
     FORTRAN(fsuper,(time,&tstart,&aai,&bbi,
             &h1,&h2,&h3,&h4,&h5,&h6,&func,&funcp));
     sum-=func;sump-=funcp;
     
     bjinc[l]=sum/(2.*ddj);
     bjincp[l]=sump/(2.*ddj);
     
       }
       
       /* critical damping */
       
       else{
     h1=zetaj*dj;
     h2=1./h1;
     h3=h2*h2;
     h4=h2*h3;
     tstart=0.;
     FORTRAN(fcrit,(time,dtime,&aai,&bbi,&zetaj,&dj,
                &ddj,&h1,&h2,&h3,&h4,&func,&funcp));
     sum=func;sump=funcp;
     FORTRAN(fcrit,(time,&tstart,&aai,&bbi,&zetaj,&dj,
                &ddj,&h1,&h2,&h3,&h4,&func,&funcp));
     sum-=func;sump-=funcp;
     
     bjinc[l]=sum;
     bjincp[l]=sump;
     
       }
     }
 
     NNEW(aaa,double,*nev);
     NNEW(bbb,double,*nev**nev);
     NNEW(lhs,double,*nev**nev);
     NNEW(ipiv,ITG,*nev);
     NNEW(dbj,double,*nev); /* change in bj */
     NNEW(dbjp,double,*nev); /* change in djp */
     
     /* starting solution for the iteration loop = base solution */
 
     memcpy(&bj[0],&bjbas[0],sizeof(double)**nev);
     memcpy(&bjp[0],&bjbasp[0],sizeof(double)**nev);
     
     /* major iteration loop for the contact response */
     
     loop=0;
     do{
       loop++;
       
       /* composing the response */
       
       if(*iprescribedboundary){
       if(*nmdnode==0){
           memcpy(&b[0],&bmin[0],sizeof(double)*neq[1]);
           memcpy(&bp[0],&bv[0],sizeof(double)*neq[1]);
       }else{
           for(i=0;i<*nmddof;i++){
           b[imddof[i]]=bmin[imddof[i]];
           bp[imddof[i]]=bv[imddof[i]];
           }
       }
       }
       else{
       if(*nmdnode==0){
           DMEMSET(b,0,neq[1],0.);
           DMEMSET(bp,0,neq[1],0.);
       }else{
           for(i=0;i<*nmddof;i++){
           b[imddof[i]]=0.;
           bp[imddof[i]]=0.;
           }
       }
       }
       
       if(!(*cyclicsymmetry)){
       if(*nmdnode==0){
           for(i=0;i<neq[1];i++){
           for(j=0;j<*nev;j++){
               b[i]+=bj[j]*z[(long long)j*neq[1]+i];
               bp[i]+=bjp[j]*z[(long long)j*neq[1]+i];
           }
           }
       }else{
           for(i=0;i<*nmddof;i++){
           for(j=0;j<*nev;j++){
               b[imddof[i]]+=bj[j]*z[(long long)j*neq[1]+imddof[i]];
               bp[imddof[i]]+=bjp[j]*z[(long long)j*neq[1]+imddof[i]];
           }
           }
       }
       }else{
       for(i=0;i<*nmddof;i++){
           FORTRAN(nident,(izdof,&imddof[i],nzdof,&id));
           if(id!=0){
           if(izdof[id-1]==imddof[i]){
               for(j=0;j<*nev;j++){
               b[imddof[i]]+=bj[j]*z[j**nzdof+id-1];
               bp[imddof[i]]+=bjp[j]*z[j**nzdof+id-1];
               }
           }else{printf("*ERROR in dynacont\n");FORTRAN(stop,());}
           }else{printf("*ERROR in dynacont\n");FORTRAN(stop,());}
       }
       }
       
       /* update nonlinear MPC-coefficients (e.g. for rigid
      body MPC's */
 
       if(*inonlinmpc==1){
       FORTRAN(nonlinmpc,(co,vold,ipompc,nodempc,coefmpc,labmpc,
              nmpc,ikboun,ilboun,nboun,xbounact,aux,iaux,
              &maxlenmpc,ikmpc,ilmpc,&icascade,
              kon,ipkon,lakon,ne,reltime,&newstep,xboun,fmpc,
              iit,&idiscon,ncont,trab,ntrans,ithermal,mi));
       }
       
       /* calculating displacements/temperatures */
       
       FORTRAN(dynresults,(nk,v,ithermal,nactdof,vold,nodeboun,
           ndirboun,xbounact,nboun,ipompc,nodempc,coefmpc,labmpc,nmpc,
           b,bp,veold,dtime,mi,imdnode,nmdnode,imdboun,nmdboun,
           imdmpc,nmdmpc,nmethod,time));
       
       if((iconvergence==1)||((*idrct==1)&&(loop>1))){
     break;
       }
       
       /* creating contact elements and calculating the contact forces
      based on the displacements at the end of the present increment */
       
       for(j=0;j<*nactcont;j++){bcont[ikactcont[j]]=0.;}
 
       RENEW(dbcont,double,*nactcont_**nev);
       RENEW(ikactcont,ITG,*nactcont_);
       RENEW(ilactcont,ITG,*nactcont_);
       *nactcont=0;
       
       DMEMSET(dbcont,0,*nactcont_**nev,0.);
       DMEMSET(ikactcont,0,*nactcont_,0.);
       
       *ne=*ne0;*nkon=*nkon0;
       contact(ncont,ntie,tieset,nset,set,istartset,iendset,
           ialset,itietri,lakon,ipkon,kon,koncont,ne,cg,
           straight,nkon,co,vold,ielmat,cs,elcon,istep,
           iinc,iit,ncmat_,ntmat_,ne0,
           vini,nmethod,
           iperturb,ikboun,nboun,mi,imastop,nslavnode,islavnode,islavsurf,
               itiefac,areaslav,iponoels,inoels,springarea,tietol,reltime,
           imastnode,nmastnode,xmastnor,filab,mcs,ics,&nasym,
               xnoels,&mortar,pslavsurf,pmastsurf,clearini,theta,
           xstateini,xstate,nstate_,&icutb,&ialeatoric,jobnamef);
 
       for(i=*ne0;i<*ne;i++){
     indexe=ipkon[i];
     imat=ielmat[mi[2]*i];
     kodem=nelcon[2*imat-2];
     for(j=0;j<8;j++){lakonl[j]=lakon[8*i+j];}
     nope=atoi(&lakonl[7])+1;
     for(j=0;j<nope;j++){
       konl[j]=kon[indexe+j];
       for(j1=0;j1<3;j1++){
         xl[j*3+j1]=co[3*(konl[j]-1)+j1];
         voldl[mt*j+j1+1]=vold[mt*(konl[j]-1)+j1+1];
         veoldl[mt*j+j1+1]=veold[mt*(konl[j]-1)+j1+1];
       }
     }
     konl[nope]=kon[indexe+nope];
 
     FORTRAN(springforc_n2f,(xl,konl,voldl,&imat,elcon,nelcon,elas,
                 fnl,ncmat_,ntmat_,&nope,lakonl,
                 &t1l,&kodem,elconloc,plicon,nplicon,npmat_,
                 &senergy,nener,cstr,mi,
                             &springarea[2*(konl[nope]-1)],nmethod,ne0,
                 nstate_,xstateini,xstate,reltime,ielas,
                 &venergy,ielorien,orab,norien,&i));
     
     FORTRAN(springstiff_n2f,(xl,elas,konl,voldl,s,&imat,elcon,nelcon,
             ncmat_,ntmat_,&nope,lakonl,&t1l,&kode,elconloc,
         plicon,nplicon,npmat_,iperturb,&springarea[2*(konl[nope]-1)],
         nmethod,mi,ne0,nstate_,xstateini,xstate,reltime,&nasym,
         ielorien,orab,norien,&i));
 
     dfdbj(bcont,&dbcont,&neq[1],&nope,konl,nactdof,
           s,z,ikmpc,ilmpc,ipompc,nodempc,nmpc,coefmpc,
           fnl,nev,&ikactcont,&ilactcont,nactcont,nactcont_,mi,
               cyclicsymmetry,izdof,nzdof);
       }
 
       if(*nactcont>100){*nactcont_=*nactcont;}else{*nactcont_=100;}
       RENEW(ikactcont,ITG,*nactcont_);
       RENEW(ilactcont,ITG,*nactcont_);
       RENEW(dbcont,double,*nactcont_**nev);
 
       /* aaa(i) is the internal product of the contact force at the end of the
      increment with eigenmode i
      bbb(i,j) is the internal product of the change of the contact force with
      respect to modal coordinate j with the eigenmode i */
 
       DMEMSET(bbb,0,*nev**nev,0.);
       DMEMSET(aaa,0,*nev,0.);
 
       if(!(*cyclicsymmetry)){
       for(k=0; k<*nactcont; k++){
           i1=ikactcont[k];
           i2=(ilactcont[k]-1)**nev;
           for(j=0; j<*nev; j++){
           zl=z[(long long)j*neq[1]+i1];
           aaa[j]+=zl*bcont[i1];
           for(l=0; l<*nev; l++){
               bbb[l**nev+j]+=zl*dbcont[i2+l];
           }
           }
       }
       }else{
       for(k=0; k<*nactcont; k++){
           i1=ikactcont[k];
           i2=(ilactcont[k]-1)**nev;
           FORTRAN(nident,(izdof,&i1,nzdof,&id));
           if(id!=0){
           if(izdof[id-1]==i1){
               for(j=0; j<*nev; j++){
               zl=z[j**nzdof+id-1];
               aaa[j]+=zl*bcont[i1];
               for(l=0; l<*nev; l++){
                   bbb[l**nev+j]+=zl*dbcont[i2+l];
               }
               }
           }else{printf("*ERROR in dynacont\n");FORTRAN(stop,());}
           }else{printf("*ERROR in dynacont\n");FORTRAN(stop,());}
       }
       }
       
       for(l=0;l<*nev;l++){
     i1=l**nev;
     for(j=0;j<*nev;j++){
       if(j==l){lhs[i1+j]=1.;}else{lhs[i1+j]=0.;}
       lhs[i1+j]-=bjinc[j]*bbb[i1+j];
     }
     dbj[l]=bjbas[l]+bjinc[l]*aaa[l]-bj[l];
       }
 
       /* solve the system of equations; determine dbj */
       
       FORTRAN(dgesv,(nev,&nrhs,lhs,nev,ipiv,dbj,nev,&info));
       
       /* check the size of dbj */
       
       bjmax=0.;
       dbjmaxOLD2=dbjmaxOLD1;
       dbjmaxOLD1=dbjmax;
       dbjmax=0.;
       for(i=0;i<*nev;i++){
     if(fabs(bj[i])>bjmax) bjmax=fabs(bj[i]);
     if(fabs(dbj[i])>dbjmax) dbjmax=fabs(dbj[i]);
       }
 
       iconvergence=0;
       idivergence=0;
 
       if(dbjmax<=0.005*bjmax){
     
     //calculate bjp: the derivative of bj w.r.t. time
     
     for(j=0; j<*nev; j++){
       bjp[j]=bjbasp[j]+bjincp[j]*aaa[j];
     }
     FORTRAN(dgetrs,("No transpose",nev,&nrhs,lhs,nev,ipiv,bjp,nev,&info));
     iconvergence=1;    
       }
       else{
       if(loop>=i0 && loop<=ic){
 
       /* check for divergence */
 
       if((dbjmax>dbjmaxOLD1) && (dbjmax>dbjmaxOLD2)){
 
         /* divergence --> cutback */ 
 
         idivergence=1;
         icutb++;
         break;
       }
     }
     else{
       if(loop>ic){
 
         /* cutback after ic iterations*/
 
         idivergence=1;
         icutb++;
         break;
       }
     }
       }
 
       /* add dbj to db */
       
       for(j=0;j<*nev;j++){
     bj[j]+=dbj[j];
       }
       
     }while(1);
   }while(idivergence==1 && icutb<10 && *idrct==0);
 
   if(icutb>=10){
 
     //no convergence, stop all
 
     printf("*ERROR: Contact did not converge.\n");
     FORTRAN(stop,());
   }
   
   /* convergence has been reached */
   /* restoring aa[(*iinc-1)*nev+i] */
 
   for(i=0;i<*nev;i++){
     aa[i]+=bb[i]*(*time-*dtime);
   }
   
   /* calculating the linearized force function connecting the
      mechanical+contact load at the start of the increment with
      the mechanical+contact load at the end of the increment */
   
   if(!(*cyclicsymmetry)){
       for(i=0;i<*nev;i++){
       i2=(long long)i*neq[1];
       
       aanew[i]=aamech[i];
       for(j=0;j<*nactcont;j++){
           aanew[i]+=z[i2+ikactcont[j]]*bcont[ikactcont[j]];
       }
       
       bb[i]=(aanew[i]-aa[i])/(*dtime);
       aa[i]=aanew[i]-bb[i]**time;
       }
   }else{
       memcpy(&aanew[0],&aamech[0],sizeof(double)**nev);
       for(j=0;j<*nactcont;j++){
       FORTRAN(nident,(izdof,&ikactcont[j],nzdof,&id));
       if(id!=0){
           if(izdof[id-1]==ikactcont[j]){
           for(i=0;i<*nev;i++){
               aanew[i]+=z[i**nzdof+id-1]*bcont[ikactcont[j]];
           }
           }else{printf("*ERROR in dynacont\n");FORTRAN(stop,());}
       }else{printf("*ERROR in dynacont\n");FORTRAN(stop,());}
       }
       for(i=0;i<*nev;i++){
           bb[i]=(aanew[i]-aa[i])/(*dtime);
       aa[i]=aanew[i]-bb[i]**time;
       }
   }
   
   SFREE(aaa);SFREE(bbb);SFREE(bjbas);SFREE(bjinc);SFREE(dbj);SFREE(lhs);
   SFREE(ipiv);SFREE(bjbasp);SFREE(bjincp);SFREE(dbjp);SFREE(ilactcont);
   SFREE(dbcont);
   SFREE(xforcdiff);SFREE(xloaddiff);SFREE(xboundiff),SFREE(xbodydiff);
 
   if(*ithermal==1) SFREE(t1diff);
   
   *ikactcontp=ikactcont;*ikactmechp=ikactmech;
   
   return;
 }

◆ dynboun()

void dynboun	(	double *	amta,
		ITG *	namta,
		ITG *	nam,
		double *	ampli,
		double *	time,
		double *	ttime,
		double *	dtime,
		double *	xbounold,
		double *	xboun,
		double *	xbounact,
		ITG *	iamboun,
		ITG *	nboun,
		ITG *	nodeboun,
		ITG *	ndirboun,
		double *	ad,
		double *	au,
		double *	adb,
		double *	aub,
		ITG *	icol,
		ITG *	irow,
		ITG *	neq,
		ITG *	nzs,
		double *	sigma,
		double *	b,
		ITG *	isolver,
		double *	alpham,
		double *	betam,
		ITG *	nzl,
		ITG *	init,
		double *	bact,
		double *	bmin,
		ITG *	jq,
		char *	amname,
		double *	bv,
		double *	bprev,
		double *	bdiff,
		ITG *	nactmech,
		ITG *	icorrect,
		ITG *	iprev
	)

                                                       {
 
     ITG idiff[3],i,j,ic,ir,im,symmetryflag=0;
 
     double *xbounmin=NULL,*xbounplus=NULL,*bplus=NULL,
     *ba=NULL,deltatime,deltatime2,deltatimesq,timemin,ttimemin,
         timeplus,ttimeplus,*aux=NULL,*b1=NULL,*b2=NULL,*bnew=NULL;
 
 #ifdef SGI
   ITG token=1;
 #endif
     
   NNEW(xbounmin,double,*nboun);
   NNEW(xbounplus,double,*nboun);
 
       /* time increment for the calculation of the change of the
          particular solution (needed to account for nonzero
          SPC's) */
 
   deltatime=*dtime;
   deltatime2=2.*deltatime;
   deltatimesq=deltatime*deltatime;
 
       /* the SPC value at timemin is stored in xbounmin */
 
   if(*init==1){
 
       /* at the start of a new step it is assumed that the previous step
      has reached steady state (at least for the SPC conditions) */
 
       for(i=0;i<*nboun;i++){
       xbounmin[i]=xbounold[i];
       xbounact[i]=xbounold[i];
       }
   }
   else{
       timemin=*time-deltatime;
       ttimemin=*ttime-deltatime;
       FORTRAN(temploadmodal,(amta,namta,nam,ampli,&timemin,&ttimemin,dtime,
        xbounold,xboun,xbounmin,iamboun,nboun,nodeboun,ndirboun,
            amname));
   }
 
       /* the SPC value at timeplus is stored in xbounplus */
 
   timeplus=*time+deltatime;
   ttimeplus=*ttime+deltatime;
   FORTRAN(temploadmodal,(amta,namta,nam,ampli,&timeplus,&ttimeplus,dtime,
       xbounold,xboun,xbounplus,iamboun,nboun,nodeboun,ndirboun,
           amname));
 
   NNEW(bplus,double,neq[1]);
   NNEW(ba,double,neq[1]);
   NNEW(b1,double,neq[1]);
   NNEW(b2,double,neq[1]);
 
       /* check whether boundary conditions changed 
          comparision of min with prev */
 
   if(*init==1){
       for(i=0;i<*nboun;i++){
       ic=neq[1]+i;
       for(j=jq[ic]-1;j<jq[ic+1]-1;j++){
           ir=irow[j]-1;
           bmin[ir]=bmin[ir]-au[j]*xbounmin[i];
       }
       }
       if(*isolver==0){
 #ifdef SPOOLES
       spooles_solve(bmin,&neq[1]);
 #endif
       }
       else if(*isolver==4){
 #ifdef SGI
       sgi_solve(bmin,token);
 #endif
       }
       else if(*isolver==5){
 #ifdef TAUCS
       tau_solve(bmin,&neq[1]);
 #endif
       }
       if(*isolver==7){
 #ifdef PARDISO
       pardiso_solve(bmin,&neq[1],&symmetryflag);
 #endif
       }
   }
 
   /* check whether boundary conditions changed 
      comparision of act with min */
   
   idiff[1]=0;
   for(i=0;i<*nboun;i++){
       if(fabs(xbounact[i]-xbounmin[i])>1.e-10){
       idiff[1]=1;
       break;
       }
   }
   if(*init==1){
       for(i=0;i<*nboun;i++){
       ic=neq[1]+i;
       for(j=jq[ic]-1;j<jq[ic+1]-1;j++){
           ir=irow[j]-1;
           bact[ir]=bact[ir]-au[j]*xbounact[i];
       }
       }
       if(*isolver==0){
 #ifdef SPOOLES
       spooles_solve(bact,&neq[1]);
 #endif
       }
       else if(*isolver==4){
 #ifdef SGI
       sgi_solve(bact,token);
 #endif
       }
       else if(*isolver==5){
 #ifdef TAUCS
       tau_solve(bact,&neq[1]);
 #endif
       }
       if(*isolver==7){
 #ifdef PARDISO
       pardiso_solve(bact,&neq[1],&symmetryflag);
 #endif
       }
   }
 
       /* check whether boundary conditions changed 
          comparision of plus with act */
   
   idiff[2]=0;
   for(i=0;i<*nboun;i++){
       if(fabs(xbounplus[i]-xbounact[i])>1.e-10){
       idiff[2]=1;
       break;
       }
   }
   if(idiff[2]==1){
       for(i=0;i<*nboun;i++){
       ic=neq[1]+i;
       for(j=jq[ic]-1;j<jq[ic+1]-1;j++){
           ir=irow[j]-1;
           bplus[ir]=bplus[ir]-au[j]*xbounplus[i];
       }
       }
       if(*isolver==0){
 #ifdef SPOOLES
       spooles_solve(bplus,&neq[1]);
 #endif
       }
       else if(*isolver==4){
 #ifdef SGI
       sgi_solve(bplus,token);
 #endif
       }
       else if(*isolver==5){
 #ifdef TAUCS
       tau_solve(bplus,&neq[1]);
 #endif
       }
       if(*isolver==7){
 #ifdef PARDISO
       pardiso_solve(bplus,&neq[1],&symmetryflag);
 #endif
       }
   }
   
   if((idiff[1]!=0)||(idiff[2]!=0)){
 
       /* present value is not zero */
 
       if(idiff[2]==0){
       for(i=0;i<neq[1];i++){bplus[i]=bact[i];}
       }
       for(i=0;i<neq[1];i++){
       
       /* bv is the velocity */
       
       bv[i]=(bplus[i]-bmin[i])/deltatime2;
       
       /* ba is the acceleration */
       
       ba[i]=(bmin[i]-2.*bact[i]+bplus[i])/deltatimesq;
       
       b1[i]=ba[i]+*alpham*bv[i];
       b2[i]=*betam*bv[i];
 
       bmin[i]=bact[i];
       bact[i]=bplus[i];
       }
       NNEW(bnew,double,neq[1]);
       FORTRAN(op,(&neq[1],b1,bplus,adb,aub,jq,irow));
       for(i=0;i<neq[1];i++){bnew[i]=-bplus[i];}
       FORTRAN(op,(&neq[1],b2,bplus,ad,au,jq,irow));
       if(*icorrect==2){
       for(i=0;i<neq[1];i++){
           bnew[i]-=bplus[i];
           b[i]+=bnew[i];
       }
       }else if(*icorrect==0){
       for(i=0;i<neq[1];i++){
           bnew[i]-=bplus[i];
           bdiff[i]=bnew[i]-bprev[i];
           b[i]+=bdiff[i];
 //        printf("dynboun %e,%e,%e,%e\n",bprev[i],bnew[i],bdiff[i],b[i]);
       }
       memcpy(&bprev[0],&bnew[0],sizeof(double)*neq[1]);
       }else{
       for(i=0;i<neq[1];i++){
           bnew[i]-=bplus[i];
           bdiff[i]+=bnew[i]-bprev[i];
           b[i]+=bdiff[i];
       }
       memcpy(&bprev[0],&bnew[0],sizeof(double)*neq[1]);
       }
       SFREE(bnew);
       *nactmech=neq[1];
       *iprev=1;
   }else if((*iprev!=0)&&(*icorrect!=2)){
 
       /* present value of b is zero, previous value was not zero */
 
       if(*icorrect==0){
       for(i=0;i<neq[1];i++){
           bdiff[i]=-bprev[i];
           b[i]+=bdiff[i];
 //        printf("dynboun %e,%e,%e,%e\n",bprev[i],bdiff[i],b[i]);
       }
 //    memset(&bprev[0],0.,sizeof(double)*neq[1]);
       DMEMSET(bprev,0,neq[1],0.);
       }else{
       for(i=0;i<neq[1];i++){
           bdiff[i]+=-bprev[i];
           b[i]+=bdiff[i];
       }
 //    memset(&bprev[0],0.,sizeof(double)*neq[1]);
       DMEMSET(bprev,0,neq[1],0.);
       }
       *nactmech=neq[1];
       *iprev=0;
   }
   
   SFREE(xbounmin);SFREE(xbounplus);
   SFREE(bplus);SFREE(ba);SFREE(b1);SFREE(b2);
   
   return;
 }

◆ electromagnetics()

void electromagnetics	(	double **	co,
		ITG *	nk,
		ITG **	konp,
		ITG **	ipkonp,
		char **	lakonp,
		ITG *	ne,
		ITG *	nodeboun,
		ITG *	ndirboun,
		double *	xboun,
		ITG *	nboun,
		ITG **	ipompcp,
		ITG **	nodempcp,
		double **	coefmpcp,
		char **	labmpcp,
		ITG *	nmpc,
		ITG *	nodeforc,
		ITG *	ndirforc,
		double *	xforc,
		ITG *	nforc,
		ITG **	nelemloadp,
		char **	sideloadp,
		double *	xload,
		ITG *	nload,
		ITG *	nactdof,
		ITG **	icolp,
		ITG *	jq,
		ITG **	irowp,
		ITG *	neq,
		ITG *	nzl,
		ITG *	nmethod,
		ITG **	ikmpcp,
		ITG **	ilmpcp,
		ITG *	ikboun,
		ITG *	ilboun,
		double *	elcon,
		ITG *	nelcon,
		double *	rhcon,
		ITG *	nrhcon,
		double *	alcon,
		ITG *	nalcon,
		double *	alzero,
		ITG **	ielmatp,
		ITG **	ielorienp,
		ITG *	norien,
		double *	orab,
		ITG *	ntmat_,
		double *	t0,
		double *	t1,
		double *	t1old,
		ITG *	ithermal,
		double *	prestr,
		ITG *	iprestr,
		double **	vold,
		ITG *	iperturb,
		double *	sti,
		ITG *	nzs,
		ITG *	kode,
		char *	filab,
		ITG *	idrct,
		ITG *	jmax,
		ITG *	jout,
		double *	timepar,
		double *	eme,
		double *	xbounold,
		double *	xforcold,
		double *	xloadold,
		double *	veold,
		double *	accold,
		char *	amname,
		double *	amta,
		ITG *	namta,
		ITG *	nam,
		ITG *	iamforc,
		ITG **	iamloadp,
		ITG *	iamt1,
		double *	alpha,
		ITG *	iexpl,
		ITG *	iamboun,
		double *	plicon,
		ITG *	nplicon,
		double *	plkcon,
		ITG *	nplkcon,
		double **	xstatep,
		ITG *	npmat_,
		ITG *	istep,
		double *	ttime,
		char *	matname,
		double *	qaold,
		ITG *	mi,
		ITG *	isolver,
		ITG *	ncmat_,
		ITG *	nstate_,
		ITG *	iumat,
		double *	cs,
		ITG *	mcs,
		ITG *	nkon,
		double **	ener,
		ITG *	mpcinfo,
		char *	output,
		double *	shcon,
		ITG *	nshcon,
		double *	cocon,
		ITG *	ncocon,
		double *	physcon,
		ITG *	nflow,
		double *	ctrl,
		char **	setp,
		ITG *	nset,
		ITG **	istartsetp,
		ITG **	iendsetp,
		ITG **	ialsetp,
		ITG *	nprint,
		char *	prlab,
		char *	prset,
		ITG *	nener,
		ITG *	ikforc,
		ITG *	ilforc,
		double *	trab,
		ITG *	inotr,
		ITG *	ntrans,
		double **	fmpcp,
		char *	cbody,
		ITG *	ibody,
		double *	xbody,
		ITG *	nbody,
		double *	xbodyold,
		ITG *	ielprop,
		double *	prop,
		ITG *	ntie,
		char **	tiesetp,
		ITG *	itpamp,
		ITG *	iviewfile,
		char *	jobnamec,
		double **	tietolp,
		ITG *	nslavs,
		double *	thicke,
		ITG *	ics,
		ITG *	nalset,
		ITG *	nmpc_,
		ITG *	nmat,
		char *	typeboun,
		ITG *	iaxial,
		ITG *	nload_,
		ITG *	nprop,
		ITG *	network,
		char *	orname
	)

                                    {
 
   char description[13]="            ",*lakon=NULL,jobnamef[396]="",
       *labmpc=NULL,kind1[2]="E",kind2[2]="E",*set=NULL,*tieset=NULL,
       cflag[1]=" ",*sideloadref=NULL,*sideload=NULL; 
  
   ITG *inum=NULL,k,iout=0,icntrl,iinc=0,jprint=0,iit=-1,jnz=0,
       icutb=0,istab=0,ifreebody,uncoupled=0,maxfaces,indexe,nope,
       iperturb_sav[2],*icol=NULL,*irow=NULL,ielas=0,icmd=0,j,
       memmpc_,mpcfree,icascade,maxlenmpc,*nodempc=NULL,*iaux=NULL,
       *itg=NULL,*ineighe=NULL,null=0,iactive[3],neqterms,ntflag,
       *ieg=NULL,ntg=0,ntr,*kontri=NULL,*nloadtr=NULL,index,
       *ipiv=NULL,ntri,newstep,mode=-1,noddiam=-1,nasym=0,
       ntrit,*inocs=NULL,inewton=0,*ipobody=NULL,*nacteq=NULL,
       *nactdog=NULL,nteq,nmastnode,imast,massact[2],
       *ipkon=NULL,*kon=NULL,*ielorien=NULL,nmethodact,ne2=0,
       *ielmat=NULL,inext,itp=0,symmetryflag=0,inputformat=0,
       iitterm=0,ngraph=1,ithermalact=2,*islavact=NULL,neini,
       *ipompc=NULL,*ikmpc=NULL,*ilmpc=NULL,i0ref,irref,icref,
       *islavnode=NULL,*imastnode=NULL,*nslavnode=NULL,mortar=0,
       mt=mi[1]+1,*nactdofinv=NULL, inode,idir,*islavsurf=NULL,
       iemchange=0,nzsrad,*mast1rad=NULL,*irowrad=NULL,*icolrad=NULL,
       *jqrad=NULL,*ipointerrad=NULL,*integerglob=NULL,im,ne0,
       mass[2]={0,0}, stiffness=1, buckling=0, rhsi=1, intscheme=0,idiscon=0,
       coriolis=0,*ipneigh=NULL,*neigh=NULL,i,icfd=0,id,node,networknode,
       iflagact=0,*nodorig=NULL,*ipivr=NULL,*inomat=NULL,*nodface=NULL,
       *ipoface=NULL,*istartset=NULL,*iendset=NULL,*ialset=NULL,
       *nelemloadref=NULL,*iamloadref=NULL,nloadref,kscale=1,
       *nelemload=NULL,*iamload=NULL,*idefload=NULL,ialeatoric=0,
       *iponoel=NULL,*inoel=NULL,inoelsize;
 
   double *stn=NULL,*v=NULL,*een=NULL,cam[5],*epn=NULL,*cdn=NULL,
       *f=NULL,*fn=NULL,qa[4]={0.,0.,-1.,0.},qam[2]={0.,0.},dtheta,theta,
          err,ram[4]={0.,0.,0.,0.},*springarea=NULL,*h0=NULL,
      ram1[2]={0.,0.},ram2[2]={0.,0.},deltmx,*clearini=NULL,
      uam[2]={0.,0.},*vini=NULL,*ac=NULL,qa0,qau,ea,ptime,
      *t1act=NULL,qamold[2],*xbounact=NULL,*bc=NULL,
      *xforcact=NULL,*xloadact=NULL,*fext=NULL,h0scale=1.,
          reltime,time,bet=0.,gam=0.,*aux1=NULL,*aux2=NULL,dtime,*fini=NULL,
      *fextini=NULL,*veini=NULL,*xstateini=NULL,*h0ref=NULL,
      *ampli=NULL,*eei=NULL,*t1ini=NULL,*tinc,*tper,*tmin,*tmax,
      *xbounini=NULL,*xstiff=NULL,*stx=NULL,*cv=NULL,*cvini=NULL,
          *enern=NULL,*coefmpc=NULL,*aux=NULL,*xstaten=NULL,
      *enerini=NULL,*emn=NULL,*xmastnor=NULL,*fnext=NULL,
      *tarea=NULL,*tenv=NULL,*erad=NULL,*fnr=NULL,*fni=NULL,
      *adview=NULL,*auview=NULL,*qfx=NULL,*adaux=NULL,
          *qfn=NULL,*co=NULL,*vold=NULL,*fenv=NULL,sigma=0.,
          *xbodyact=NULL,*cgr=NULL,dthetaref,*vr=NULL,*vi=NULL,
      *stnr=NULL,*stni=NULL,*vmax=NULL,*stnmax=NULL,*fmpc=NULL,*ener=NULL,
      *f_cm=NULL,*f_cs=NULL,*tietol=NULL,
      *xstate=NULL,*eenmax=NULL,*adrad=NULL,*aurad=NULL,*bcr=NULL,
          *emeini=NULL,*doubleglob=NULL,*au=NULL,
      *ad=NULL,*b=NULL,*aub=NULL,*adb=NULL,*pslavsurf=NULL,*pmastsurf=NULL,
          *cdnr=NULL,*cdni=NULL,*energyini=NULL,*energy=NULL;
 
 #ifdef SGI
   ITG token;
 #endif
  
   ne0=*ne;
 
   /* next line is needed to avoid that elements with negative ipkon
      are taken into account in extrapolate.f */
 
   strcpy1(&filab[2],"C",1);
 
   if(*nmethod==8){
       *nmethod=1;
   }else if(*nmethod==9){
       *nmethod=4;
   }else if(*nmethod==10){
       *nmethod=2;
   }
  
   for(k=0;k<3;k++){
       strcpy1(&jobnamef[k*132],&jobnamec[k*132],132);
   }
   
   qa0=ctrl[20];qau=ctrl[21];ea=ctrl[23];deltmx=ctrl[26];
   i0ref=ctrl[0];irref=ctrl[1];icref=ctrl[3];
   
   memmpc_=mpcinfo[0];mpcfree=mpcinfo[1];icascade=mpcinfo[2];
   maxlenmpc=mpcinfo[3];
   
   icol=*icolp;irow=*irowp;co=*cop;vold=*voldp;
   ipkon=*ipkonp;lakon=*lakonp;kon=*konp;ielorien=*ielorienp;
   ielmat=*ielmatp;ener=*enerp;xstate=*xstatep;
   
   ipompc=*ipompcp;labmpc=*labmpcp;ikmpc=*ikmpcp;ilmpc=*ilmpcp;
   fmpc=*fmpcp;nodempc=*nodempcp;coefmpc=*coefmpcp;
 
   set=*setp;istartset=*istartsetp;iendset=*iendsetp;ialset=*ialsetp;
   tieset=*tiesetp;tietol=*tietolp;
 
   nelemload=*nelemloadp;iamload=*iamloadp;
   sideload=*sideloadp;
 
   tinc=&timepar[0];
   tper=&timepar[1];
   tmin=&timepar[2];
   tmax=&timepar[3];
   
   /* invert nactdof */
   
   NNEW(nactdofinv,ITG,mt**nk);
   NNEW(nodorig,ITG,*nk);
   FORTRAN(gennactdofinv,(nactdof,nactdofinv,nk,mi,nodorig,
              ipkon,lakon,kon,ne));
   SFREE(nodorig);
   
   /* allocating a field for the stiffness matrix */
   
   NNEW(xstiff,double,(long long)27*mi[0]**ne);
   
   /* allocating force fields */
   
   NNEW(f,double,neq[1]);
   NNEW(fext,double,neq[1]);
   
   NNEW(b,double,neq[1]);
   NNEW(vini,double,mt**nk);
   
   NNEW(aux,double,7*maxlenmpc);
   NNEW(iaux,ITG,maxlenmpc);
   
   /* allocating fields for the actual external loading */
   
   NNEW(xbounact,double,*nboun);
   NNEW(xbounini,double,*nboun);
   for(k=0;k<*nboun;++k){xbounact[k]=xbounold[k];}
   NNEW(xforcact,double,*nforc);
   NNEW(xloadact,double,2**nload);
   NNEW(xbodyact,double,7**nbody);
   /* copying the rotation axis and/or acceleration vector */
   for(k=0;k<7**nbody;k++){xbodyact[k]=xbody[k];}
   
   /* assigning the body forces to the elements */ 
   
   if(*nbody>0){
       ifreebody=*ne+1;
       NNEW(ipobody,ITG,2*ifreebody**nbody);
       for(k=1;k<=*nbody;k++){
       FORTRAN(bodyforce,(cbody,ibody,ipobody,nbody,set,istartset,
                  iendset,ialset,&inewton,nset,&ifreebody,&k));
       RENEW(ipobody,ITG,2*(*ne+ifreebody));
       }
       RENEW(ipobody,ITG,2*(ifreebody-1));
   }
   
   /* for thermal calculations: forced convection and cavity
      radiation*/
   
   if(*ithermal>1){
       NNEW(itg,ITG,*nload+3**nflow);
       NNEW(ieg,ITG,*nflow);
       /* max 6 triangles per face, 4 entries per triangle */
       NNEW(kontri,ITG,24**nload);
       NNEW(nloadtr,ITG,*nload);
       NNEW(nacteq,ITG,4**nk);
       NNEW(nactdog,ITG,4**nk);
       NNEW(v,double,mt**nk);
       FORTRAN(envtemp,(itg,ieg,&ntg,&ntr,sideload,nelemload,
                ipkon,kon,lakon,ielmat,ne,nload,
                        kontri,&ntri,nloadtr,nflow,ndirboun,nactdog,
                        nodeboun,nacteq,nboun,ielprop,prop,&nteq,
                        v,network,physcon,shcon,ntmat_,co,
                        vold,set,nshcon,rhcon,nrhcon,mi,nmpc,nodempc,
                        ipompc,labmpc,ikboun,&nasym,ttime,&time,iaxial));
       SFREE(v);
       
       if((*mcs>0)&&(ntr>0)){
       NNEW(inocs,ITG,*nk);
       radcyc(nk,kon,ipkon,lakon,ne,cs,mcs,nkon,ialset,istartset,
                iendset,&kontri,&ntri,&co,&vold,&ntrit,inocs,mi);
       }
       else{ntrit=ntri;}
       
       nzsrad=100*ntr;
       NNEW(mast1rad,ITG,nzsrad);
       NNEW(irowrad,ITG,nzsrad);
       NNEW(icolrad,ITG,ntr);
       NNEW(jqrad,ITG,ntr+1);
       NNEW(ipointerrad,ITG,ntr);
       
       if(ntr>0){
       mastructrad(&ntr,nloadtr,sideload,ipointerrad,
               &mast1rad,&irowrad,&nzsrad,
               jqrad,icolrad);
       }
       
       /* determine the network elements belonging to a given node (for usage
          in user subroutine film */
 
 //      if(ntg>0){
       if((*network>0)||(ntg>0)){
       NNEW(iponoel,ITG,*nk);
       NNEW(inoel,ITG,2**nkon);
       if(*network>0){
           FORTRAN(networkelementpernode,(iponoel,inoel,lakon,ipkon,kon,
                      &inoelsize,nflow,ieg,ne,network));
       }
       RENEW(inoel,ITG,2*inoelsize);
       }
       
       SFREE(ipointerrad);SFREE(mast1rad);
       RENEW(irowrad,ITG,nzsrad);
       
       RENEW(itg,ITG,ntg);
       NNEW(ineighe,ITG,ntg);
       RENEW(kontri,ITG,4*ntrit);
       RENEW(nloadtr,ITG,ntr);
       
       NNEW(adview,double,ntr);
       NNEW(auview,double,2*nzsrad);
       NNEW(tarea,double,ntr);
       NNEW(tenv,double,ntr);
       NNEW(fenv,double,ntr);
       NNEW(erad,double,ntr);
       
       NNEW(ac,double,nteq*nteq);
       NNEW(bc,double,nteq);
       NNEW(ipiv,ITG,nteq);
       NNEW(adrad,double,ntr);
       NNEW(aurad,double,2*nzsrad);
       NNEW(bcr,double,ntr);
       NNEW(ipivr,ITG,ntr);
   }
   if(*ithermal>1){NNEW(qfx,double,3*mi[0]**ne);}
   
   /* allocating a field for the instantaneous amplitude */
   
   NNEW(ampli,double,*nam);
   
   NNEW(fini,double,neq[1]);
   
   /* allocating fields for nonlinear dynamics */
   
   if(*nmethod==4){
       mass[0]=1;
       mass[1]=1;
       NNEW(aux2,double,neq[1]);
       NNEW(fextini,double,neq[1]);
       NNEW(cv,double,neq[1]);
       NNEW(cvini,double,neq[1]);
       NNEW(veini,double,mt**nk);
       NNEW(adb,double,neq[1]);
       NNEW(aub,double,nzs[1]);
   }
   
   qa[0]=qaold[0];
   qa[1]=qaold[1];
   
   /* normalizing the time */
   
   FORTRAN(checktime,(itpamp,namta,tinc,ttime,amta,tmin,&inext,&itp,istep,tper));
   dtheta=(*tinc)/(*tper);
   dthetaref=dtheta;
   if(dtheta<=1.e-6){
       printf("\n *ERROR in nonlingeo\n");
       printf(" increment size smaller than one millionth of step size\n");
       printf(" increase increment size\n\n");
   }
   *tmin=*tmin/(*tper);
   *tmax=*tmax/(*tper);
   theta=0.;
   
   /* calculating an initial flux norm */
   
   if(*ithermal!=2){
       if(qau>1.e-10){qam[0]=qau;}
       else if(qa0>1.e-10){qam[0]=qa0;}
       else if(qa[0]>1.e-10){qam[0]=qa[0];}
       else {qam[0]=1.e-2;}
   }
   if(*ithermal>1){
       if(qau>1.e-10){qam[1]=qau;}
       else if(qa0>1.e-10){qam[1]=qa0;}
       else if(qa[1]>1.e-10){qam[1]=qa[1];}
       else {qam[1]=1.e-2;}
   }
   
   
   /*********************************************************************/
   
   /* calculating the initial quasi-static magnetic intensity due to 
      the coil current */
   
   /*********************************************************************/
   
   /* calculate the current density in the coils
 
      in this section nload, nforc, nbody and nam are set to zero; the
      electrical potential is supposed to be given (in the form of a
      temperature), the current is calculated (in the form of heat
      flux) by thermal analogy  */
   
   reltime=1.;
   time=0.;
   dtime=0.;
   ithermalact=2;
 
   nmethodact=1;
   massact[0]=0;
   massact[1]=0;
 
   if(*ithermal<=1){
       NNEW(qfx,double,3*mi[0]**ne);
       NNEW(t0,double,*nk);
   }
   if(strcmp1(&filab[3567],"ECD ")==0){NNEW(qfn,double,3**nk);}
   
   /* the coil current is assumed to be applied at once, i.e. as 
      step loading; the calculation, however, is a quasi-static
      calculation */
 
   FORTRAN(tempload,(xforcold,xforc,xforcact,iamforc,&null,xloadold,xload,
           xloadact,iamload,&null,ibody,xbody,&null,xbodyold,xbodyact,
           t1old,t1,t1act,iamt1,nk,amta,
           namta,&null,ampli,&time,&reltime,ttime,&dtime,&ithermalact,nmethod,
               xbounold,xboun,xbounact,iamboun,nboun,
           nodeboun,ndirboun,nodeforc,ndirforc,istep,&iinc,
           co,vold,itg,&ntg,amname,ikboun,ilboun,nelemload,sideload,mi,
               ntrans,trab,inotr,veold,integerglob,doubleglob,tieset,istartset,
               iendset,ialset,ntie,nmpc,ipompc,ikmpc,ilmpc,nodempc,coefmpc,
               ipobody,iponoel,inoel));
   
   cam[0]=0.;cam[1]=0.;
   
   /* deactivating all elements except the shells */
   
   for(i=0;i<*ne;i++){
       if(strcmp1(&lakon[8*i+6],"L")!=0){
       ipkon[i]=-ipkon[i]-2;
       }
   }
   
   remastruct(ipompc,&coefmpc,&nodempc,nmpc,
          &mpcfree,nodeboun,ndirboun,nboun,ikmpc,ilmpc,ikboun,ilboun,
          labmpc,nk,&memmpc_,&icascade,&maxlenmpc,
          kon,ipkon,lakon,ne,nactdof,icol,jq,&irow,isolver,
          neq,nzs,&nmethodact,&f,&fext,&b,&aux2,&fini,&fextini,
          &adb,&aub,&ithermalact,iperturb,mass,mi,iexpl,&mortar,
              typeboun,&cv,&cvini,&iit,network);
   
   /* invert nactdof */
   
   SFREE(nactdofinv);
   NNEW(nactdofinv,ITG,mt**nk);
   NNEW(nodorig,ITG,*nk);
   FORTRAN(gennactdofinv,(nactdof,nactdofinv,nk,mi,nodorig,
              ipkon,lakon,kon,ne));
   SFREE(nodorig);
   
   iout=-1;
   
   NNEW(fn,double,mt**nk);
   NNEW(inum,ITG,*nk);
   NNEW(v,double,mt**nk);
 
   results(co,nk,kon,ipkon,lakon,ne,v,stn,inum,stx,
       elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat,
       ielorien,norien,orab,ntmat_,t0,t1act,&ithermalact,
       prestr,iprestr,filab,eme,emn,een,iperturb,f,fn,nactdof,&iout,
       qa,vold,b,nodeboun,ndirboun,xbounact,nboun,ipompc,nodempc,coefmpc,
       labmpc,nmpc,&nmethodact,cam,&neq[1],veold,accold,&bet,
           &gam,&dtime,&time,ttime,plicon,nplicon,plkcon,nplkcon,
       xstateini,xstiff,xstate,npmat_,epn,matname,mi,&ielas,&icmd,
           ncmat_,nstate_,sti,vini,ikboun,ilboun,ener,enern,emeini,xstaten,
           eei,enerini,alcon,nalcon,set,nset,istartset,iendset,
           ialset,nprint,prlab,prset,qfx,qfn,trab,inotr,ntrans,fmpc,
       nelemload,&null,ikmpc,ilmpc,istep,&iinc,springarea,&reltime,
       ne,xforc,&null,thicke,shcon,nshcon,
       sideload,xloadact,xloadold,&icfd,inomat,pslavsurf,pmastsurf,
           &mortar,islavact,cdn,islavnode,nslavnode,ntie,clearini,
       islavsurf,ielprop,prop,energyini,energy,&kscale,iponoel,
           inoel,nener,orname,network,ipobody,xbodyact,ibody);
   
   SFREE(fn);SFREE(inum);SFREE(v);
   
   iout=1;
   
   NNEW(ad,double,neq[1]);
   NNEW(au,double,nzs[1]);
   
   mafillsmmain(co,nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,xbounold,nboun,
             ipompc,nodempc,coefmpc,nmpc,nodeforc,ndirforc,xforcact,
             &null,nelemload,sideload,xloadact,&null,xbodyact,ipobody,
             &null,cgr,ad,au,fext,nactdof,icol,jq,irow,neq,nzl,
             &nmethodact,ikmpc,ilmpc,ikboun,ilboun,
             elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,
             ielmat,ielorien,norien,orab,ntmat_,
             t0,t1act,&ithermalact,prestr,iprestr,vold,iperturb,sti,
             nzs,stx,adb,aub,iexpl,plicon,nplicon,plkcon,nplkcon,
             xstiff,npmat_,&dtime,matname,mi,
             ncmat_,massact,&stiffness,&buckling,&rhsi,&intscheme,
             physcon,shcon,nshcon,alcon,nalcon,ttime,&time,istep,&iinc,
             &coriolis,ibody,xloadold,&reltime,veold,springarea,nstate_,
             xstateini,xstate,thicke,integerglob,doubleglob,
             tieset,istartset,iendset,ialset,ntie,&nasym,pslavsurf,
             pmastsurf,&mortar,clearini,ielprop,prop,&ne0,fnext,&kscale,
                 iponoel,inoel,network);
   
   if(nmethodact==0){
       
       /* error occurred in mafill: storing the geometry in frd format */
       
       ++*kode;
       
       ptime=*ttime+time;
       frd(co,nk,kon,ipkon,lakon,ne,v,stn,inum,&nmethodact,
       kode,filab,een,t1,fn,&ptime,epn,ielmat,matname,enern,xstaten,
       nstate_,istep,&iinc,&ithermalact,qfn,&mode,&noddiam,trab,inotr,
       ntrans,orab,ielorien,norien,description,ipneigh,neigh,
       mi,sti,vr,vi,stnr,stni,vmax,stnmax,&ngraph,veold,ener,ne,
       cs,set,nset,istartset,iendset,ialset,eenmax,fnr,fni,emn,
       thicke,jobnamec,output,qfx,cdn,&mortar,cdnr,cdni,nmat);
       
       FORTRAN(stop,());
       
   }
   
   for(k=0;k<neq[1];++k){
       b[k]=fext[k]-f[k];
   }
   
   if(*isolver==0){
 #ifdef SPOOLES
       spooles(ad,au,adb,aub,&sigma,b,icol,irow,&neq[1],&nzs[1],
           &symmetryflag,&inputformat,&nzs[2]);
 #else
       printf("*ERROR in nonlingeo: the SPOOLES library is not linked\n\n");
       FORTRAN(stop,());
 #endif
   }
   else if((*isolver==2)||(*isolver==3)){
       preiter(ad,&au,b,&icol,&irow,&neq[1],&nzs[1],isolver,iperturb);
   }
   else if(*isolver==4){
 #ifdef SGI
       token=1;
       sgi_main(ad,au,adb,aub,&sigma,b,icol,irow,&neq[1],&nzs[1],token);
 #else
       printf("*ERROR in nonlingeo: the SGI library is not linked\n\n");
       FORTRAN(stop,());
 #endif
   }
   else if(*isolver==5){
 #ifdef TAUCS
       tau(ad,&au,adb,aub,&sigma,b,icol,&irow,&neq[1],&nzs[1]);
 #else
       printf("*ERROR in nonlingeo: the TAUCS library is not linked\n\n");
       FORTRAN(stop,());
 #endif
   }
   else if(*isolver==7){
 #ifdef PARDISO
       pardiso_main(ad,au,adb,aub,&sigma,b,icol,irow,&neq[1],&nzs[1],
            &symmetryflag,&inputformat,jq,&nzs[2]);
 #else
       printf("*ERROR in nonlingeo: the PARDISO library is not linked\n\n");
       FORTRAN(stop,());
 #endif
   }
 
   SFREE(au);SFREE(ad);
 
   NNEW(v,double,mt**nk);
 //  memcpy(&v[0],&vold[0],sizeof(double)*mt**nk);
   
   NNEW(fn,double,mt**nk);
   
   NNEW(inum,ITG,*nk);
   results(co,nk,kon,ipkon,lakon,ne,v,stn,inum,stx,
       elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat,
       ielorien,norien,orab,ntmat_,t0,t1act,&ithermalact,
       prestr,iprestr,filab,eme,emn,een,iperturb,
       f,fn,nactdof,&iout,qa,vold,b,nodeboun,
       ndirboun,xbounact,nboun,ipompc,
       nodempc,coefmpc,labmpc,nmpc,&nmethodact,cam,&neq[1],veold,accold,
       &bet,&gam,&dtime,&time,ttime,plicon,nplicon,plkcon,nplkcon,
       xstateini,xstiff,xstate,npmat_,epn,matname,mi,&ielas,
       &icmd,ncmat_,nstate_,sti,vini,ikboun,ilboun,ener,enern,
       emeini,xstaten,eei,enerini,alcon,nalcon,set,nset,istartset,
       iendset,ialset,nprint,prlab,prset,qfx,qfn,trab,inotr,ntrans,
       fmpc,nelemload,&null,ikmpc,ilmpc,istep,&iinc,springarea,
       &reltime,ne,xforc,&null,thicke,shcon,nshcon,
       sideload,xloadact,xloadold,&icfd,inomat,pslavsurf,pmastsurf,
           &mortar,islavact,cdn,islavnode,nslavnode,ntie,clearini,
       islavsurf,ielprop,prop,energyini,energy,&kscale,iponoel,
           inoel,nener,orname,network,ipobody,xbodyact,ibody);
   
 //  memcpy(&vold[0],&v[0],sizeof(double)*mt**nk);
   
   /* reactivating the non-shell elements (for mesh output purposes) 
      deactivating the initial temperature for the non-shell nodes */
   
   for(i=0;i<*ne;i++){
       if(strcmp1(&lakon[8*i+6],"L")!=0){
       ipkon[i]=-ipkon[i]-2;
       }else if(ipkon[i]!=-1){
 
           /* copy shell results */
 
       indexe=ipkon[i];
       if(strcmp1(&lakon[8*i+3],"6")==0){nope=6;}
       else if(strcmp1(&lakon[8*i+3],"8")==0){nope=8;}
       else if(strcmp1(&lakon[8*i+3],"1")==0){nope=15;}
       else{nope=20;}
       for(j=0;j<nope;j++){
           node=kon[indexe+j];
           vold[mt*(node-1)]=v[mt*(node-1)];
       }
       }
   }
 
   /* deactivating the output of temperatures */
 
   if(strcmp1(&filab[87],"NT  ")==0){
       ntflag=1;
       strcpy1(&filab[87],"    ",4);
   }else{ntflag=0;}
 
   /* createinum is called in order to store the nodes and elements
      of the complete structure, not only of the coil */
 
   FORTRAN(createinum,(ipkon,inum,kon,lakon,nk,ne,&cflag[0],nelemload,
       nload,nodeboun,nboun,ndirboun,ithermal,co,vold,mi,ielmat));
 
   ++*kode;
   if(*mcs!=0){
       ptime=*ttime+time;
       frdcyc(co,nk,kon,ipkon,lakon,ne,v,stn,inum,&nmethodact,kode,filab,een,
          t1act,fn,&ptime,epn,ielmat,matname,cs,mcs,nkon,enern,xstaten,
          nstate_,istep,&iinc,iperturb,ener,mi,output,&ithermalact,qfn,
          ialset,istartset,iendset,trab,inotr,ntrans,orab,ielorien,
          norien,stx,veold,&noddiam,set,nset,emn,thicke,jobnamec,ne,
              cdn,&mortar,nmat,qfx);
   }else{
       
       ptime=*ttime+time;
       frd(co,nk,kon,ipkon,lakon,ne,v,stn,inum,&nmethodact,
       kode,filab,een,t1act,fn,&ptime,epn,ielmat,matname,enern,xstaten,
       nstate_,istep,&iinc,&ithermalact,qfn,&mode,&noddiam,trab,inotr,
       ntrans,orab,ielorien,norien,description,ipneigh,neigh,
       mi,stx,vr,vi,stnr,stni,vmax,stnmax,&ngraph,veold,ener,ne,
       cs,set,nset,istartset,iendset,ialset,eenmax,fnr,fni,emn,
       thicke,jobnamec,output,qfx,cdn,&mortar,cdnr,cdni,nmat);
       
   }
   SFREE(inum);SFREE(v);SFREE(fn);
 
   /* reactivating the temperature output, if previously deactivated */
 
   if(ntflag==1){
       strcpy1(&filab[87],"NT  ",4);
   }
 
   NNEW(inomat,ITG,*nk);
 
   /* calculating the magnetic intensity caused by the current */
 
   FORTRAN(assigndomtonodes,(ne,lakon,ipkon,kon,ielmat,inomat,
                 elcon,ncmat_,ntmat_,mi,&ne2));
 
   NNEW(h0ref,double,3**nk);
   NNEW(h0,double,3**nk);
 
   biosav(ipkon,kon,lakon,ne,co,qfx,h0ref,mi,inomat,nk);
 
   if(*ithermal<=1){SFREE(qfx);SFREE(t0);}
   if(strcmp1(&filab[3567],"ECD ")==0)SFREE(qfn);
   
   /* deactivating the shell elements */
   
   for(i=0;i<*ne;i++){
       if(strcmp1(&lakon[8*i+6],"L")==0){
       ipkon[i]=-ipkon[i]-2;
       }
   }
   
 /**************************************************************/
 /* creating connecting MPC's between the domains              */
 /**************************************************************/
 
 /* creating contact ties between the domains */
 
   if(*istep==1){
       
       NNEW(nodface,ITG,5*6**ne);
       NNEW(ipoface,ITG,*nk);
       
       RENEW(set,char,81*(*nset+3));
       RENEW(istartset,ITG,*nset+3);
       RENEW(iendset,ITG,*nset+3);
       RENEW(ialset,ITG,*nalset+6**ne);
       RENEW(tieset,char,243*(*ntie+5));
       RENEW(tietol,double,3*(*ntie+5));
       
       FORTRAN(createtiedsurfs,(nodface,ipoface,set,istartset,
           iendset,ialset,tieset,inomat,ne,ipkon,lakon,kon,ntie,
           tietol,nalset,nk,nset,iactive));
       
       SFREE(nodface);SFREE(ipoface);
       RENEW(set,char,81**nset);
       RENEW(istartset,ITG,*nset);
       RENEW(iendset,ITG,*nset);
       RENEW(ialset,ITG,*nalset);
       RENEW(tieset,char,243**ntie);
       RENEW(tietol,double,3**ntie);
       
       /* tied contact constraints: generate appropriate MPC's */
       
       tiedcontact(ntie,tieset,nset,set,istartset,iendset,ialset,
        lakon,ipkon,kon,tietol,nmpc, &mpcfree,&memmpc_,
        &ipompc,&labmpc,&ikmpc,&ilmpc,&fmpc,&nodempc,&coefmpc,
        ithermal,co,vold,&icfd,nmpc_,mi,nk,istep,ikboun,nboun,
        kind1,kind2);
 
       /* mapping h0ref from the phi domain onto the border of
          the A and A-V domains */
 
       FORTRAN(calch0interface,(nmpc,ipompc,nodempc,coefmpc,h0ref));
 
   }
   
 /**************************************************************/
 /* creating the A.n MPC                                       */
 /**************************************************************/
 
   /* identifying the interfaces between the A and A-V domains
      and the phi-domain */
 
   FORTRAN(generateeminterfaces,(istartset,iendset,
       ialset,iactive,ipkon,lakon,kon,ikmpc,nmpc,&maxfaces));
   
   for(i=1;i<3;i++){
       imast=iactive[i];
       if(imast==0) continue;
 
       /* determining the normals on the face */
 
       NNEW(imastnode,ITG,8*maxfaces);
       NNEW(xmastnor,double,3*8*maxfaces);
 
       FORTRAN(normalsoninterface,(istartset,iendset,
        ialset,&imast,ipkon,kon,lakon,imastnode,&nmastnode,
        xmastnor,co));
 
       /* enlarging the fields for MPC's */
 
       *nmpc_=*nmpc_+nmastnode;
       RENEW(ipompc,ITG,*nmpc_);
       RENEW(labmpc,char,20**nmpc_+1);
       RENEW(ikmpc,ITG,*nmpc_);
       RENEW(ilmpc,ITG,*nmpc_);
       RENEW(fmpc,double,*nmpc_);
       
       /* determining the maximum number of terms;
      expanding nodempc and coefmpc to accommodate
      those terms */
       
       neqterms=3*nmastnode;
       index=memmpc_;
       (memmpc_)+=neqterms;
       RENEW(nodempc,ITG,3*memmpc_);
       RENEW(coefmpc,double,memmpc_);
       for(k=index;k<memmpc_;k++){
       nodempc[3*k-1]=k+1;
       }
       nodempc[3*memmpc_-1]=0;
 
       /* creating the A.n MPC's */
 
       FORTRAN(createinterfacempcs,(imastnode,xmastnor,&nmastnode,
           ikmpc,ilmpc,nmpc,ipompc,nodempc,coefmpc,labmpc,&mpcfree,
               ikboun,nboun));
 
       SFREE(imastnode);SFREE(xmastnor);
   }
   
   /* determining the new matrix structure */
       
   remastructem(ipompc,&coefmpc,&nodempc,nmpc,
          &mpcfree,nodeboun,ndirboun,nboun,ikmpc,ilmpc,ikboun,ilboun,
          labmpc,nk,&memmpc_,&icascade,&maxlenmpc,
          kon,ipkon,lakon,ne,nactdof,icol,jq,&irow,isolver,
          neq,nzs,nmethod,&f,&fext,&b,&aux2,&fini,&fextini,
          &adb,&aub,ithermal,iperturb,mass,mi,ielmat,elcon,
          ncmat_,ntmat_,inomat,network);
 
 /**************************************************************/
 /* starting the loop over the increments                      */
 /**************************************************************/
   
   /* saving the distributed loads (volume heating will be
      added because of Joule heating) */
 
   if(*ithermal==3){
       nloadref=*nload;
       NNEW(nelemloadref,ITG,2**nload);
       if(*nam>0) NNEW(iamloadref,ITG,2**nload);
       NNEW(sideloadref,char,20**nload);
       
       memcpy(&nelemloadref[0],&nelemload[0],sizeof(ITG)*2**nload);
       if(*nam>0) memcpy(&iamloadref[0],&iamload[0],sizeof(ITG)*2**nload);
       memcpy(&sideloadref[0],&sideload[0],sizeof(char)*20**nload);
       
       /* generating new fields; ne2 is the number of elements
      in domain 2 = A,V-domain (the only domain with heating) */
       
       (*nload_)+=ne2;
       RENEW(nelemload,ITG,2**nload_);
       if(*nam>0) RENEW(iamload,ITG,2**nload_);
       RENEW(xloadact,double,2**nload_);
       RENEW(sideload,char,20**nload_);
   }
 
   if((*ithermal==1)||(*ithermal>=3)){
       NNEW(t1ini,double,*nk);
       NNEW(t1act,double,*nk);
       for(k=0;k<*nk;++k){t1act[k]=t1old[k];}
   }
   
   newstep=1;
   
   while(1.-theta>1.e-6){
       
       if(icutb==0){
       
       /* previous increment converged: update the initial values */
       
       iinc++;
       jprint++;
       
       /* vold is copied into vini */
       
       memcpy(&vini[0],&vold[0],sizeof(double)*mt**nk);
       
       for(k=0;k<*nboun;++k){xbounini[k]=xbounact[k];}
       if((*ithermal==1)||(*ithermal>=3)){
           for(k=0;k<*nk;++k){t1ini[k]=t1act[k];}
       }
       for(k=0;k<neq[1];++k){
           fini[k]=f[k];
       }
       if(*nmethod==4){
           for(k=0;k<mt**nk;++k){
           veini[k]=veold[k];
           }
           for(k=0;k<neq[1];++k){
           fextini[k]=fext[k];
           }
       }
       }
       
       /* check for max. # of increments */
       
       if(iinc>*jmax){
       printf(" *ERROR: max. # of increments reached\n\n");
       FORTRAN(stop,());
       }
       printf(" increment %" ITGFORMAT " attempt %" ITGFORMAT " \n",iinc,icutb+1);
       printf(" increment size= %e\n",dtheta**tper);
       printf(" sum of previous increments=%e\n",theta**tper);
       printf(" actual step time=%e\n",(theta+dtheta)**tper);
       printf(" actual total time=%e\n\n",*ttime+(theta+dtheta)**tper);
       
       printf(" iteration 1\n\n");
       
       qamold[0]=qam[0];
       qamold[1]=qam[1];
       
       /* determining the actual loads at the end of the new increment*/
       
       reltime=theta+dtheta;
       time=reltime**tper;
       dtime=dtheta**tper;
 
       /* restoring the distributed loading before adding the
          Joule heating */
 
       if(*ithermal==3){
       *nload=nloadref;
       DMEMSET(nelemload,0,2**nload_,0);
       memcpy(&nelemload[0],&nelemloadref[0],sizeof(ITG)*2**nload);
       if(*nam>0){
           DMEMSET(iamload,0,2**nload_,0);
           memcpy(&iamload[0],&iamloadref[0],sizeof(ITG)*2**nload);
       }
       DMEMSET(xloadact,0,2**nload_,0.);
       DMEMSET(sideload,0,'\0',0.);memcpy(&sideload[0],&sideloadref[0],sizeof(char)*20**nload);
       }
       
       /* determining the actual loading */
 
 //      for(i=0;i<3**nk;i++){h0[i]/=h0scale;}
       FORTRAN(tempload_em,(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,itg,&ntg,amname,ikboun,ilboun,nelemload,sideload,mi,
               ntrans,trab,inotr,veold,integerglob,doubleglob,tieset,istartset,
               iendset,ialset,ntie,nmpc,ipompc,ikmpc,ilmpc,nodempc,coefmpc,
               &h0scale,inomat,ipobody,iponoel,inoel));
       for(i=0;i<3**nk;i++){h0[i]=h0ref[i]*h0scale;}
 
       for(i=0;i<3;i++){cam[i]=0.;}for(i=3;i<5;i++){cam[i]=0.5;}
       if(*ithermal>1){radflowload(itg,ieg,&ntg,&ntr,adrad,aurad,bcr,ipivr,
        ac,bc,nload,sideload,nelemload,xloadact,lakon,ipiv,ntmat_,vold,
        shcon,nshcon,ipkon,kon,co,
        kontri,&ntri,nloadtr,tarea,tenv,physcon,erad,&adview,&auview,
        nflow,ikboun,xbounact,nboun,ithermal,&iinc,&iit,
        cs,mcs,inocs,&ntrit,nk,fenv,istep,&dtime,ttime,&time,ilboun,
        ikforc,ilforc,xforcact,nforc,cam,ielmat,&nteq,prop,ielprop,
        nactdog,nacteq,nodeboun,ndirboun,network,
        rhcon,nrhcon,ipobody,ibody,xbodyact,nbody,iviewfile,jobnamef,
        ctrl,xloadold,&reltime,nmethod,set,mi,istartset,iendset,ialset,nset,
        ineighe,nmpc,nodempc,ipompc,coefmpc,labmpc,&iemchange,nam,iamload,
        jqrad,irowrad,&nzsrad,icolrad,ne,iaxial,qa,cocon,ncocon,iponoel,
        inoel,nprop,amname,namta,amta);
       }
       
       /* prediction of the next solution (only for temperature) */
       
       NNEW(v,double,mt**nk);
       
 //      if(*ithermal>2){
       prediction_em(uam,nmethod,&bet,&gam,&dtime,ithermal,nk,veold,v,
          &iinc,&idiscon,vold,nactdof,mi);
 //      }
       
       NNEW(fn,double,mt**nk);
       
       iout=-1;
       iperturb_sav[0]=iperturb[0];
       iperturb_sav[1]=iperturb[1];
       
       /* first iteration in first increment: heat tangent */
       
       NNEW(inum,ITG,*nk);
       resultsinduction(co,nk,kon,ipkon,lakon,ne,v,stn,inum,
           elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat,
           ielorien,norien,orab,ntmat_,t0,t1act,ithermal,
           prestr,iprestr,filab,eme,emn,een,iperturb,
           f,fn,nactdof,&iout,qa,vold,b,nodeboun,
           ndirboun,xbounact,nboun,ipompc,
           nodempc,coefmpc,labmpc,nmpc,nmethod,cam,&neq[1],veold,accold,
           &bet,&gam,&dtime,&time,ttime,plicon,nplicon,plkcon,nplkcon,
           xstateini,xstiff,xstate,npmat_,epn,matname,mi,&ielas,
           &icmd,ncmat_,nstate_,sti,vini,ikboun,ilboun,ener,enern,
           emeini,xstaten,eei,enerini,cocon,ncocon,set,nset,istartset,
           iendset,ialset,nprint,prlab,prset,qfx,qfn,trab,inotr,ntrans,
           fmpc,nelemload,nload,ikmpc,ilmpc,istep,&iinc,springarea,
           &reltime,ne,xforc,nforc,thicke,shcon,nshcon,
           sideload,xloadact,xloadold,&icfd,inomat,h0,islavnode,
           nslavnode,ntie,ielprop,prop,iactive,energyini,energy,
           iponoel,inoel,orname,network,ipobody,xbodyact,ibody);
       SFREE(inum);
      
       /* the calculation of the electromagnetic fields is (quasi)linear,
          i.e. the solution of the equations is the fields;
          only the temperature calculation is nonlinear,
          i.e. the solution of the equations is a differential temperature */
  
       memcpy(&vold[0],&v[0],sizeof(double)*mt**nk);
       
       iout=0;
       
       SFREE(fn);SFREE(v);
       
       /***************************************************************/
       /* iteration counter and start of the loop over the iterations */
       /***************************************************************/
       
       iit=1;
       icntrl=0;
       ctrl[0]=i0ref;ctrl[1]=irref;ctrl[3]=icref;
       
       while(icntrl==0){
       
       if(iit!=1){
           
           printf(" iteration %" ITGFORMAT "\n\n",iit);
 
           /* restoring the distributed loading before adding the
          Joule heating */
 
           if(*ithermal==3){
           *nload=nloadref;
           DMEMSET(nelemload,0,2**nload_,0);
           memcpy(&nelemload[0],&nelemloadref[0],sizeof(ITG)*2**nload);
           if(*nam>0){
               DMEMSET(iamload,0,2**nload_,0);
               memcpy(&iamload[0],&iamloadref[0],sizeof(ITG)*2**nload);
           }
           DMEMSET(xloadact,0,2**nload_,0.);
           DMEMSET(sideload,0,20**nload_,'\0');memcpy(&sideload[0],&sideloadref[0],sizeof(char)*20**nload);
           }
       
               /* determining the actual loading */
           
 //        for(i=0;i<3**nk;i++){h0[i]/=h0scale;}
           FORTRAN(tempload_em,(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,itg,&ntg,amname,ikboun,ilboun,nelemload,sideload,mi,
                ntrans,trab,inotr,veold,integerglob,doubleglob,tieset,istartset,
                iendset,ialset,ntie,nmpc,ipompc,ikmpc,ilmpc,nodempc,coefmpc,
                &h0scale,inomat,ipobody,iponoel,inoel));
           for(i=0;i<3**nk;i++){h0[i]=h0ref[i]*h0scale;}
 
           for(i=0;i<3;i++){cam[i]=0.;}for(i=3;i<5;i++){cam[i]=0.5;}
           if(*ithermal>1){radflowload(itg,ieg,&ntg,&ntr,adrad,aurad,
                 bcr,ipivr,ac,bc,nload,sideload,nelemload,xloadact,lakon,ipiv,
                 ntmat_,vold,shcon,nshcon,ipkon,kon,co,
             kontri,&ntri,nloadtr,tarea,tenv,physcon,erad,&adview,&auview,
             nflow,ikboun,xbounact,nboun,ithermal,&iinc,&iit,
                 cs,mcs,inocs,&ntrit,nk,fenv,istep,&dtime,ttime,&time,ilboun,
             ikforc,ilforc,xforcact,nforc,cam,ielmat,&nteq,prop,ielprop,
             nactdog,nacteq,nodeboun,ndirboun,network,
                 rhcon,nrhcon,ipobody,ibody,xbodyact,nbody,iviewfile,jobnamef,
             ctrl,xloadold,&reltime,nmethod,set,mi,istartset,iendset,ialset,
             nset,ineighe,nmpc,nodempc,ipompc,coefmpc,labmpc,&iemchange,nam,
         iamload,jqrad,irowrad,&nzsrad,icolrad,ne,iaxial,qa,cocon,
         ncocon,iponoel,inoel,nprop,amname,namta,amta);
           }
           
       }
       
           /* add Joule heating  */
 
       if(*ithermal==3){
           NNEW(idefload,ITG,*nload_);
           DMEMSET(idefload,0,*nload_,1);
           FORTRAN(jouleheating,(ipkon,lakon,kon,co,elcon,nelcon,
           mi,ne,sti,ielmat,nelemload,sideload,xloadact,nload,nload_,
           iamload,nam,idefload,ncmat_,ntmat_,
           alcon,nalcon,ithermal,vold,t1));
           SFREE(idefload);
       }
 
       if(*ithermal==3){
           for(k=0;k<*nk;++k){t1act[k]=vold[mt*k];}
       }
           
       /* calculating the local stiffness matrix and external loading */
       
       NNEW(ad,double,neq[1]);
       NNEW(au,double,nzs[1]);
       
       FORTRAN(mafillem,(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,fext,nactdof,icol,jq,irow,neq,nzl,
           nmethod,ikmpc,ilmpc,ikboun,ilboun,
           elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,
           ielmat,ielorien,norien,orab,ntmat_,
           t0,t1act,ithermal,prestr,iprestr,vold,iperturb,sti,
           nzs,stx,adb,aub,iexpl,plicon,nplicon,plkcon,nplkcon,
           xstiff,npmat_,&dtime,matname,mi,
                   ncmat_,mass,&stiffness,&buckling,&rhsi,&intscheme,
                   physcon,shcon,nshcon,cocon,ncocon,ttime,&time,istep,&iinc,
           &coriolis,ibody,xloadold,&reltime,veold,springarea,nstate_,
                   xstateini,xstate,thicke,integerglob,doubleglob,
           tieset,istartset,iendset,ialset,ntie,&nasym,iactive,h0,
           pslavsurf,pmastsurf,&mortar,clearini,ielprop,prop,
           iponoel,inoel,network));
           
           iperturb[0]=iperturb_sav[0];
           iperturb[1]=iperturb_sav[1];
 
       /* calculating the residual (f is only for the temperature
              nonzero) */
 
       calcresidual_em(nmethod,neq,b,fext,f,iexpl,nactdof,aux1,aux2,vold,
         vini,&dtime,accold,nk,adb,aub,jq,irow,nzl,alpha,fextini,fini,
         islavnode,nslavnode,&mortar,ntie,f_cm,f_cs,mi,
         nzs,&nasym,ithermal);
       
       newstep=0;
       
       if(*nmethod==0){
           
           /* error occurred in mafill: storing the geometry in frd format */
           
           *nmethod=0;
           ++*kode;
           NNEW(inum,ITG,*nk);for(k=0;k<*nk;k++) inum[k]=1;
           
           ptime=*ttime+time;
           frd(co,nk,kon,ipkon,lakon,ne,v,stn,inum,nmethod,
           kode,filab,een,t1,fn,&ptime,epn,ielmat,matname,enern,xstaten,
           nstate_,istep,&iinc,ithermal,qfn,&mode,&noddiam,trab,inotr,
           ntrans,orab,ielorien,norien,description,ipneigh,neigh,
           mi,sti,vr,vi,stnr,stni,vmax,stnmax,&ngraph,veold,ener,ne,
           cs,set,nset,istartset,iendset,ialset,eenmax,fnr,fni,emn,
           thicke,jobnamec,output,qfx,cdn,&mortar,cdnr,cdni,nmat);
           
       }
       
       /* implicit step (static or dynamic */
       
       if(*nmethod==4){
           
           /* electromagnetic part */
           
           if(*ithermal!=2){
           for(k=0;k<neq[0];++k){
               ad[k]=adb[k]/dtime+ad[k];
           }
           for(k=0;k<nzs[0];++k){
               au[k]=aub[k]/dtime+au[k];
           }
           
           /* upper triangle of asymmetric matrix */
           
           if(nasym>0){
               for(k=nzs[2];k<nzs[2]+nzs[0];++k){
               au[k]=aub[k]/dtime+au[k];
               }
           }
           }
           
           /* thermal part */
           
           if(*ithermal>1){
           for(k=neq[0];k<neq[1];++k){
               ad[k]=adb[k]/dtime+ad[k];
           }
           for(k=nzs[0];k<nzs[1];++k){
               au[k]=aub[k]/dtime+au[k];
           }
           
           /* upper triangle of asymmetric matrix */
           
           if(nasym>0){
               for(k=nzs[2]+nzs[0];k<nzs[2]+nzs[1];++k){
               au[k]=aub[k]/dtime+au[k];
               }
           }
           }
       }
 
       NNEW(adaux,double,neq[2]);
       FORTRAN(preconditioning,(ad,au,b,&neq[1],irow,jq,adaux));
 
       
       if(*isolver==0){
 #ifdef SPOOLES
           if(*ithermal<2){
           spooles(ad,au,adb,aub,&sigma,b,icol,irow,&neq[0],&nzs[0],
               &symmetryflag,&inputformat,&nzs[2]);
           }else{
           spooles(ad,au,adb,aub,&sigma,b,icol,irow,&neq[1],&nzs[1],
               &symmetryflag,&inputformat,&nzs[2]);
           }
 #else
           printf(" *ERROR in nonlingeo: the SPOOLES library is not linked\n\n");
           FORTRAN(stop,());
 #endif
       }
       else if((*isolver==2)||(*isolver==3)){
           if(nasym>0){
           printf(" *ERROR in nonlingeo: the iterative solver cannot be used for asymmetric matrices\n\n");
           FORTRAN(stop,());
           }
           preiter(ad,&au,b,&icol,&irow,&neq[1],&nzs[1],isolver,iperturb);
       }
       else if(*isolver==4){
 #ifdef SGI
           if(nasym>0){
           printf(" *ERROR in nonlingeo: the SGI solver cannot be used for asymmetric matrices\n\n");
           FORTRAN(stop,());
           }
           token=1;
           if(*ithermal<2){
           sgi_main(ad,au,adb,aub,&sigma,b,icol,irow,&neq[0],&nzs[0],token);
           }else{
           sgi_main(ad,au,adb,aub,&sigma,b,icol,irow,&neq[1],&nzs[1],token);
           }
 #else
           printf(" *ERROR in nonlingeo: the SGI library is not linked\n\n");
           FORTRAN(stop,());
 #endif
       }
       else if(*isolver==5){
           if(nasym>0){
           printf(" *ERROR in nonlingeo: the TAUCS solver cannot be used for asymmetric matrices\n\n");
           FORTRAN(stop,());
           }
 #ifdef TAUCS
           tau(ad,&au,adb,aub,&sigma,b,icol,&irow,&neq[1],&nzs[1]);
 #else
           printf(" *ERROR in nonlingeo: the TAUCS library is not linked\n\n");
           FORTRAN(stop,());
 #endif
       }
       else if(*isolver==7){
 #ifdef PARDISO
           if(*ithermal<2){
           pardiso_main(ad,au,adb,aub,&sigma,b,icol,irow,&neq[0],&nzs[0],
                    &symmetryflag,&inputformat,jq,&nzs[2]);
           }else{
           pardiso_main(ad,au,adb,aub,&sigma,b,icol,irow,&neq[1],&nzs[1],
                    &symmetryflag,&inputformat,jq,&nzs[2]);
           }
 #else
           printf(" *ERROR in nonlingeo: the PARDISO library is not linked\n\n");
           FORTRAN(stop,());
 #endif
       }
 
       for(i=0;i<neq[1];i++){b[i]*=adaux[i];}
       SFREE(adaux);
       
       /* calculating the electromagnetic fields and temperatures 
              only the temperature calculation is differential */
       
       NNEW(v,double,mt**nk);
       memcpy(&v[0],&vold[0],sizeof(double)*mt**nk);
       
       NNEW(fn,double,mt**nk);
       
       NNEW(inum,ITG,*nk);
       resultsinduction(co,nk,kon,ipkon,lakon,ne,v,stn,inum,
           elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat,
           ielorien,norien,orab,ntmat_,t0,t1act,ithermal,
           prestr,iprestr,filab,eme,emn,een,iperturb,
           f,fn,nactdof,&iout,qa,vold,b,nodeboun,
           ndirboun,xbounact,nboun,ipompc,
           nodempc,coefmpc,labmpc,nmpc,nmethod,cam,&neq[1],veold,accold,
           &bet,&gam,&dtime,&time,ttime,plicon,nplicon,plkcon,nplkcon,
           xstateini,xstiff,xstate,npmat_,epn,matname,mi,&ielas,
           &icmd,ncmat_,nstate_,sti,vini,ikboun,ilboun,ener,enern,
           emeini,xstaten,eei,enerini,cocon,ncocon,set,nset,istartset,
           iendset,ialset,nprint,prlab,prset,qfx,qfn,trab,inotr,ntrans,
           fmpc,nelemload,nload,ikmpc,ilmpc,istep,&iinc,springarea,
           &reltime,ne,xforc,nforc,thicke,shcon,nshcon,
           sideload,xloadact,xloadold,&icfd,inomat,h0,islavnode,
           nslavnode,ntie,ielprop,prop,iactive,energyini,energy,
           iponoel,inoel,orname,network,ipobody,xbodyact,ibody);
       SFREE(inum);
       
       SFREE(ad);SFREE(au);
       
       if(*ithermal!=2){
           if(cam[0]>uam[0]){uam[0]=cam[0];}      
           if(qau<1.e-10){
           if(qa[0]>ea*qam[0]){qam[0]=(qamold[0]*jnz+qa[0])/(jnz+1);}
           else {qam[0]=qamold[0];}
           }
       }
       if(*ithermal>1){
           if(cam[1]>uam[1]){uam[1]=cam[1];}      
           if(qau<1.e-10){
           if(qa[1]>ea*qam[1]){qam[1]=(qamold[1]*jnz+qa[1])/(jnz+1);}
           else {qam[1]=qamold[1];}
           }
       }
       
       memcpy(&vold[0],&v[0],sizeof(double)*mt**nk);
       
       SFREE(v);SFREE(fn);
       
       /* calculating the residual */
       
       calcresidual_em(nmethod,neq,b,fext,f,iexpl,nactdof,aux1,aux2,vold,
           vini,&dtime,accold,nk,adb,aub,jq,irow,nzl,alpha,fextini,fini,
           islavnode,nslavnode,&mortar,ntie,f_cm,f_cs,mi,
           nzs,&nasym,ithermal);
       
       /* calculating the maximum residual (only thermal part)*/
       
       for(k=0;k<2;++k){
           ram2[k]=ram1[k];
           ram1[k]=ram[k];
           ram[k]=0.;
       }
 
       if(*ithermal!=2) ram[0]=0.;
 
       if(*ithermal>1){
           for(k=neq[0];k<neq[1];++k){
           err=fabs(b[k]);
           if(err>ram[1]){ram[1]=err;ram[3]=k+0.5;}
           }
       }
       
       /* printing residuals */
       
       if(*ithermal>1){
           if(ram[1]<1.e-6) ram[1]=0.;      
           printf(" average flux= %f\n",qa[1]);
           printf(" time avg. flux= %f\n",qam[1]);
           if((ITG)((double)nactdofinv[(ITG)ram[3]]/mt)+1==0){
           printf(" largest residual flux= %f\n",
              ram[1]);
           }else{
           inode=(ITG)((double)nactdofinv[(ITG)ram[3]]/mt)+1;
           idir=nactdofinv[(ITG)ram[3]]-mt*(inode-1);
           printf(" largest residual flux= %f in node %" ITGFORMAT " and dof %" ITGFORMAT "\n",ram[1],inode,idir);
           }
           printf(" largest increment of temp= %e\n",uam[1]);
           if((ITG)cam[4]==0){
           printf(" largest correction to temp= %e\n\n",
              cam[1]);
           }else{
           inode=(ITG)((double)nactdofinv[(ITG)cam[4]]/mt)+1;
           idir=nactdofinv[(ITG)cam[4]]-mt*(inode-1);
           printf(" largest correction to temp= %e in node %" ITGFORMAT " and dof %" ITGFORMAT "\n\n",cam[1],inode,idir);
           }
       }
       
       /* athermal electromagnetic calculations are linear:
              set iit=2 to force convergence */
 
       if(*ithermal<=1) iit=2;
       
       // MPADD: need for fake energy values!
       double energy[4] = {0, 0, 0, 0};
       double allwk     = 0.0;
       double energyref = 0.0;
       double emax, enres,enetoll, reswk, dampwk, allwkini;
 
       neini=*ne;
       checkconvergence(co,nk,kon,ipkon,lakon,ne,stn,nmethod, 
         kode,filab,een,t1act,&time,epn,ielmat,matname,enern, 
         xstaten,nstate_,istep,&iinc,iperturb,ener,mi,output,
             ithermal,qfn,&mode,&noddiam,trab,inotr,ntrans,orab,
         ielorien,norien,description,sti,&icutb,&iit,&dtime,qa,
         vold,qam,ram1,ram2,ram,cam,uam,&ntg,ttime,&icntrl,
         &theta,&dtheta,veold,vini,idrct,tper,&istab,tmax, 
         nactdof,b,tmin,ctrl,amta,namta,itpamp,&inext,&dthetaref,
             &itp,&jprint,jout,&uncoupled,t1,&iitterm,nelemload,
             nload,nodeboun,nboun,itg,ndirboun,&deltmx,&iflagact,
         set,nset,istartset,iendset,ialset,emn,thicke,jobnamec,
         &mortar,nmat,ielprop,prop,&ialeatoric,&kscale,
         energy, &allwk, &energyref,&emax, &enres, &enetoll,        //MPADD
         energyini, &allwkini ,&allwk, &reswk, &ne0, &ne0, &dampwk, //MPADD
         &dampwk, energy);                                          //MPADD
       }
       
       /*********************************************************/
       /*   end of the iteration loop                          */
       /*********************************************************/
       
       /* icutb=0 means that the iterations in the increment converged,
      icutb!=0 indicates that the increment has to be reiterated with
      another increment size (dtheta) */
       
       if(((qa[0]>ea*qam[0])||(qa[1]>ea*qam[1]))&&(icutb==0)){jnz++;}
       iit=0;
       
       if(icutb!=0){
       memcpy(&vold[0],&vini[0],sizeof(double)*mt**nk);
       
       for(k=0;k<*nboun;++k){xbounact[k]=xbounini[k];}
       if((*ithermal==1)||(*ithermal>=3)){
           for(k=0;k<*nk;++k){t1act[k]=t1ini[k];}
       }
       for(k=0;k<neq[1];++k){
           f[k]=fini[k];
       }
       if(*nmethod==4){
           for(k=0;k<mt**nk;++k){
           veold[k]=veini[k];
           }
           for(k=0;k<neq[1];++k){
           fext[k]=fextini[k];
           }
       }
       
       qam[0]=qamold[0];
       qam[1]=qamold[1];
       }
       
       if((jout[0]==jprint)&&(icutb==0)){
       
       jprint=0;
       
       /* calculating the displacements and the stresses and storing */
       /* the results in frd format  */
       
       NNEW(v,double,mt**nk);
       NNEW(fn,double,mt**nk);
       if(*ithermal>1) NNEW(qfn,double,3**nk);
       if((strcmp1(&filab[3741],"EMFE")==0)||
              (strcmp1(&filab[3828],"EMFB")==0)) NNEW(stn,double,6**nk);
       NNEW(inum,ITG,*nk);
       
       memcpy(&v[0],&vold[0],sizeof(double)*mt**nk);
       
       iout=2;
       icmd=3;
       
       resultsinduction(co,nk,kon,ipkon,lakon,ne,v,stn,inum,
           elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat,
           ielorien,norien,orab,ntmat_,t0,t1act,ithermal,
           prestr,iprestr,filab,eme,emn,een,iperturb,
           f,fn,nactdof,&iout,qa,vold,b,nodeboun,
           ndirboun,xbounact,nboun,ipompc,
           nodempc,coefmpc,labmpc,nmpc,nmethod,cam,&neq[1],veold,accold,
           &bet,&gam,&dtime,&time,ttime,plicon,nplicon,plkcon,nplkcon,
           xstateini,xstiff,xstate,npmat_,epn,matname,mi,&ielas,&icmd,
           ncmat_,nstate_,sti,vini,ikboun,ilboun,ener,enern,emeini,
           xstaten,eei,enerini,cocon,ncocon,set,nset,istartset,iendset,
           ialset,nprint,prlab,prset,qfx,qfn,trab,inotr,ntrans,fmpc,
           nelemload,nload,ikmpc,ilmpc,istep,&iinc,springarea,
           &reltime,ne,xforc,nforc,thicke,shcon,nshcon,
           sideload,xloadact,xloadold,&icfd,inomat,h0,islavnode,
           nslavnode,ntie,ielprop,prop,iactive,energyini,energy,
           iponoel,inoel,orname,network,ipobody,xbodyact,ibody);
       
       memcpy(&vold[0],&v[0],sizeof(double)*mt**nk);
       
       iout=0;
       icmd=0;
 //    FORTRAN(networkinum,(ipkon,inum,kon,lakon,ne,itg,&ntg));
       
       ++*kode;
       if(*mcs!=0){
           ptime=*ttime+time;
           frdcyc(co,nk,kon,ipkon,lakon,ne,v,stn,inum,nmethod,kode,filab,een,
          t1act,fn,&ptime,epn,ielmat,matname,cs,mcs,nkon,enern,xstaten,
          nstate_,istep,&iinc,iperturb,ener,mi,output,ithermal,qfn,
          ialset,istartset,iendset,trab,inotr,ntrans,orab,ielorien,
           norien,stx,veold,&noddiam,set,nset,emn,thicke,jobnamec,ne,
           cdn,&mortar,nmat,qfx);
       }else{
           
           ptime=*ttime+time;
           frd(co,nk,kon,ipkon,lakon,ne,v,stn,inum,nmethod,
           kode,filab,een,t1act,fn,&ptime,epn,ielmat,matname,
                   enern,xstaten,
           nstate_,istep,&iinc,ithermal,qfn,&mode,&noddiam,trab,inotr,
           ntrans,orab,ielorien,norien,description,ipneigh,neigh,
           mi,stx,vr,vi,stnr,stni,vmax,stnmax,&ngraph,veold,ener,ne,
           cs,set,nset,istartset,iendset,ialset,eenmax,fnr,fni,emn,
           thicke,jobnamec,output,qfx,cdn,&mortar,cdnr,cdni,nmat);
           
       }
       
       SFREE(v);SFREE(fn);SFREE(inum);
       if(*ithermal>1){SFREE(qfn);}
       if((strcmp1(&filab[3741],"EMFE")==0)||
              (strcmp1(&filab[3828],"EMFB")==0)) SFREE(stn);
       
       }
       
   }
   
   /*********************************************************/
   /*   end of the increment loop                          */
   /*********************************************************/
   
   if(jprint!=0){
       
       /* calculating the displacements and the stresses and storing  
      the results in frd format */
       
       NNEW(v,double,mt**nk);
       NNEW(fn,double,mt**nk);
       if(*ithermal>1) NNEW(qfn,double,3**nk);
       if(strcmp1(&filab[3741],"EMF ")==0) NNEW(stn,double,6**nk);
       NNEW(inum,ITG,*nk);
       
       memcpy(&v[0],&vold[0],sizeof(double)*mt**nk);
       iout=2;
       icmd=3;
       
       resultsinduction(co,nk,kon,ipkon,lakon,ne,v,stn,inum,
           elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat,
           ielorien,norien,orab,ntmat_,t0,t1act,ithermal,
           prestr,iprestr,filab,eme,emn,een,iperturb,
           f,fn,nactdof,&iout,qa,vold,b,nodeboun,
           ndirboun,xbounact,nboun,ipompc,
           nodempc,coefmpc,labmpc,nmpc,nmethod,cam,&neq[1],veold,accold,
           &bet,&gam,&dtime,&time,ttime,plicon,nplicon,plkcon,nplkcon,
           xstateini,xstiff,xstate,npmat_,epn,matname,mi,&ielas,&icmd,
           ncmat_,nstate_,sti,vini,ikboun,ilboun,ener,enern,emeini,
           xstaten,eei,enerini,cocon,ncocon,set,nset,istartset,iendset,
           ialset,nprint,prlab,prset,qfx,qfn,trab,inotr,ntrans,fmpc,
           nelemload,nload,ikmpc,ilmpc,istep,&iinc,springarea,
           &reltime,ne,xforc,nforc,thicke,shcon,nshcon,
           sideload,xloadact,xloadold,&icfd,inomat,h0,islavnode,
           nslavnode,ntie,ielprop,prop,iactive,energyini,energy,
           iponoel,inoel,orname,network,ipobody,xbodyact,ibody);
       
       memcpy(&vold[0],&v[0],sizeof(double)*mt**nk);
       
       iout=0;
       icmd=0;
 //      FORTRAN(networkinum,(ipkon,inum,kon,lakon,ne,itg,&ntg));
       
       ++*kode;
       if(*mcs>0){
       ptime=*ttime+time;
       frdcyc(co,nk,kon,ipkon,lakon,ne,v,stn,inum,nmethod,kode,filab,een,
          t1act,fn,&ptime,epn,ielmat,matname,cs,mcs,nkon,enern,xstaten,
          nstate_,istep,&iinc,iperturb,ener,mi,output,ithermal,qfn,
          ialset,istartset,iendset,trab,inotr,ntrans,orab,ielorien,
          norien,stx,veold,&noddiam,set,nset,emn,thicke,jobnamec,ne,
                  cdn,&mortar,nmat,qfx);
       }else{
       
       ptime=*ttime+time;
       frd(co,nk,kon,ipkon,lakon,ne,v,stn,inum,nmethod,
           kode,filab,een,t1act,fn,&ptime,epn,ielmat,matname,enern,xstaten,
           nstate_,istep,&iinc,ithermal,qfn,&mode,&noddiam,trab,inotr,
           ntrans,orab,ielorien,norien,description,ipneigh,neigh,
           mi,stx,vr,vi,stnr,stni,vmax,stnmax,&ngraph,veold,ener,ne,
           cs,set,nset,istartset,iendset,ialset,eenmax,fnr,fni,emn,
           thicke,jobnamec,output,qfx,cdn,&mortar,cdnr,cdni,nmat);
       
       }
       
       SFREE(v);SFREE(fn);SFREE(inum);
       if(*ithermal>1){SFREE(qfn);}
       if(strcmp1(&filab[3741],"EMF ")==0) SFREE(stn);
       
   }
 
       /* restoring the distributed loading  */
 
   if(*ithermal==3){
       *nload=nloadref;
       (*nload_)-=ne2;
       RENEW(nelemload,ITG,2**nload);memcpy(&nelemload[0],&nelemloadref[0],sizeof(ITG)*2**nload);
       if(*nam>0){
       RENEW(iamload,ITG,2**nload);
       memcpy(&iamload[0],&iamloadref[0],sizeof(ITG)*2**nload);
       }
       RENEW(sideload,char,20**nload);memcpy(&sideload[0],&sideloadref[0],sizeof(char)*20**nload);
       
       /* freeing the temporary fields */
       
       SFREE(nelemloadref);if(*nam>0){SFREE(iamloadref);};
       SFREE(sideloadref);
   }
   
   /* setting the velocity to zero at the end of a quasistatic or stationary
      step */
   
   if(abs(*nmethod)==1){
       for(k=0;k<mt**nk;++k){veold[k]=0.;}
   }
   
   /* 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){
       
       /* thermal boundary conditions are updated only if the
          step was thermal or thermomechanical */
       
       if(ndirboun[k]==0){
       if(*ithermal<2) continue;
       
       /* mechanical boundary conditions are updated only
              if the step was not thermal or the node is a
              network node */
       
       }else if((ndirboun[k]>0)&&(ndirboun[k]<4)){
       node=nodeboun[k];
       FORTRAN(nident,(itg,&node,&ntg,&id));
       networknode=0;
       if(id>0){
           if(itg[id-1]==node) networknode=1;
       }
       if((*ithermal==2)&&(networknode==0)) continue;
       }
       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];}
       for(k=0;k<*nk;++k){vold[mt*k]=t1act[k];}
   }
   else if(*ithermal>1){
       for(k=0;k<*nk;++k){t1[k]=vold[mt*k];}
       if(*ithermal>=3){
       for(k=0;k<*nk;++k){t1old[k]=t1act[k];}
       }
   }
   
   qaold[0]=qa[0];
   qaold[1]=qa[1];
   
   SFREE(f);
   SFREE(b);
   SFREE(xbounact);SFREE(xforcact);SFREE(xloadact);SFREE(xbodyact);
   if(*nbody>0) SFREE(ipobody);
   SFREE(fext);SFREE(ampli);SFREE(xbounini);SFREE(xstiff);
   if((*ithermal==1)||(*ithermal>=3)){SFREE(t1act);SFREE(t1ini);}
   
   if(*ithermal>1){
       SFREE(itg);SFREE(ieg);SFREE(kontri);SFREE(nloadtr);
       SFREE(nactdog);SFREE(nacteq);SFREE(ineighe);
       SFREE(tarea);SFREE(tenv);SFREE(fenv);SFREE(qfx);
       SFREE(erad);SFREE(ac);SFREE(bc);SFREE(ipiv);
       SFREE(bcr);SFREE(ipivr);SFREE(adview);SFREE(auview);SFREE(adrad);
       SFREE(aurad);SFREE(irowrad);SFREE(jqrad);SFREE(icolrad);
       if((*mcs>0)&&(ntr>0)){SFREE(inocs);}
       if((*network>0)||(ntg>0)){SFREE(iponoel);SFREE(inoel);}
   }
   
   SFREE(fini);
   if(*nmethod==4){
       SFREE(aux2);SFREE(fextini);SFREE(veini);
       SFREE(adb);SFREE(aub);SFREE(cv);SFREE(cvini);
   }
   
   SFREE(aux);SFREE(iaux);SFREE(vini);SFREE(h0ref);SFREE(h0);SFREE(inomat);
   
   /* reset icascade */
   
   if(icascade==1){icascade=0;}
   
   mpcinfo[0]=memmpc_;mpcinfo[1]=mpcfree;mpcinfo[2]=icascade;
   mpcinfo[3]=maxlenmpc;
   
   *icolp=icol;*irowp=irow;*cop=co;*voldp=vold;
   
   *ipompcp=ipompc;*labmpcp=labmpc;*ikmpcp=ikmpc;*ilmpcp=ilmpc;
   *fmpcp=fmpc;*nodempcp=nodempc;*coefmpcp=coefmpc;
   
   *ipkonp=ipkon;*lakonp=lakon;*konp=kon;*ielorienp=ielorien;
   *ielmatp=ielmat;*enerp=ener;*xstatep=xstate;
 
   *setp=set;*istartsetp=istartset;*iendsetp=iendset;*ialsetp=ialset;
   *tiesetp=tieset;*tietolp=tietol;
   
   *nelemloadp=nelemload;*iamloadp=iamload;
   *sideloadp=sideload;
   
   (*tmin)*=(*tper);
   (*tmax)*=(*tper);
   
   SFREE(nactdofinv);
  
   if(*nmethod==1){
       *nmethod=8;
   }else if(*nmethod==4){
       *nmethod=9;
   }else if(*nmethod==2){
       *nmethod=10;
   }
 
   (*ttime)+=(*tper);
   
   return;
 }

◆ expand()

void expand	(	double *	co,
		ITG *	nk,
		ITG *	kon,
		ITG *	ipkon,
		char *	lakon,
		ITG *	ne,
		ITG *	nodeboun,
		ITG *	ndirboun,
		double *	xboun,
		ITG *	nboun,
		ITG *	ipompc,
		ITG *	nodempc,
		double *	coefmpc,
		char *	labmpc,
		ITG *	nmpc,
		ITG *	nodeforc,
		ITG *	ndirforc,
		double *	xforc,
		ITG *	nforc,
		ITG *	nelemload,
		char *	sideload,
		double *	xload,
		ITG *	nload,
		ITG *	nactdof,
		ITG *	neq,
		ITG *	nmethod,
		ITG *	ikmpc,
		ITG *	ilmpc,
		ITG *	ikboun,
		ITG *	ilboun,
		double *	elcon,
		ITG *	nelcon,
		double *	rhcon,
		ITG *	nrhcon,
		double *	alcon,
		ITG *	nalcon,
		double *	alzero,
		ITG *	ielmat,
		ITG *	ielorien,
		ITG *	norien,
		double *	orab,
		ITG *	ntmat_,
		double *	t0,
		ITG *	ithermal,
		double *	prestr,
		ITG *	iprestr,
		double *	vold,
		ITG *	iperturb,
		double *	sti,
		ITG *	nzs,
		double *	adb,
		double *	aub,
		char *	filab,
		double *	eme,
		double *	plicon,
		ITG *	nplicon,
		double *	plkcon,
		ITG *	nplkcon,
		double *	xstate,
		ITG *	npmat_,
		char *	matname,
		ITG *	mi,
		ITG *	ics,
		double *	cs,
		ITG *	mpcend,
		ITG *	ncmat_,
		ITG *	nstate_,
		ITG *	mcs,
		ITG *	nkon,
		double *	ener,
		char *	jobnamec,
		char *	output,
		char *	set,
		ITG *	nset,
		ITG *	istartset,
		ITG *	iendset,
		ITG *	ialset,
		ITG *	nprint,
		char *	prlab,
		char *	prset,
		ITG *	nener,
		double *	trab,
		ITG *	inotr,
		ITG *	ntrans,
		double *	ttime,
		double *	fmpc,
		ITG *	nev,
		double **	z,
		ITG *	iamboun,
		double *	xbounold,
		ITG *	nsectors,
		ITG *	nm,
		ITG *	icol,
		ITG *	irow,
		ITG *	nzl,
		ITG *	nam,
		ITG *	ipompcold,
		ITG *	nodempcold,
		double *	coefmpcold,
		char *	labmpcold,
		ITG *	nmpcold,
		double *	xloadold,
		ITG *	iamload,
		double *	t1old,
		double *	t1,
		ITG *	iamt1,
		double *	xstiff,
		ITG **	icolep,
		ITG **	jqep,
		ITG **	irowep,
		ITG *	isolver,
		ITG *	nzse,
		double **	adbep,
		double **	aubep,
		ITG *	iexpl,
		ITG *	ibody,
		double *	xbody,
		ITG *	nbody,
		double *	cocon,
		ITG *	ncocon,
		char *	tieset,
		ITG *	ntie,
		ITG *	imddof,
		ITG *	nmddof,
		ITG *	imdnode,
		ITG *	nmdnode,
		ITG *	imdboun,
		ITG *	nmdboun,
		ITG *	imdmpc,
		ITG *	nmdmpc,
		ITG **	izdofp,
		ITG *	nzdof,
		ITG *	nherm,
		double *	xmr,
		double *	xmi,
		char *	typeboun,
		ITG *	ielprop,
		double *	prop,
		char *	orname
	)

                           {
 
   /* calls the Arnoldi Package (ARPACK) for cyclic symmetry calculations */
   
     char *filabt,*tchar1=NULL,*tchar2=NULL,*tchar3=NULL,lakonl[2]=" \0";
 
     ITG *inum=NULL,k,idir,lfin,j,iout=0,index,inode,id,i,idof,im,
         ielas,icmd,kk,l,nkt,icntrl,imag=1,icomplex,kkv,kk6,iterm,
         lprev,ilength,ij,i1,i2,iel,ielset,node,indexe,nope,ml1,nelem,
         *inocs=NULL,*ielcs=NULL,jj,l1,l2,is,nlabel,*nshcon=NULL,
         nodeleft,*noderight=NULL,numnodes,ileft,kflag=2,itr,locdir,
         neqh,j1,nodenew,mt=mi[1]+1,istep=1,iinc=1,iit=-1,
     tint=-1,tnstart=-1,tnend=-1,tint2=-1,network=0,
     noderight_,*izdof=*izdofp,iload,iforc,*iznode=NULL,nznode,ll,ne0,
     icfd=0,*inomat=NULL,mortar=0,*islavact=NULL,*ipobody=NULL,
     *islavnode=NULL,*nslavnode=NULL,*islavsurf=NULL,
         *iponoel=NULL,*inoel=NULL;
 
     long long lint;
 
     double *stn=NULL,*v=NULL,*temp_array=NULL,*vini=NULL,*csmass=NULL,
         *een=NULL,cam[5],*f=NULL,*fn=NULL,qa[4],*epn=NULL,summass,
         *stiini=NULL,*emn=NULL,*emeini=NULL,*clearini=NULL,
     *xstateini=NULL,theta,pi,*coefmpcnew=NULL,t[3],ctl,stl,
     *stx=NULL,*enern=NULL,*xstaten=NULL,*eei=NULL,*enerini=NULL,
     *qfx=NULL,*qfn=NULL,xreal,ximag,*vt=NULL,sum,
         *coefright=NULL,coef,a[9],ratio,reltime,
         *shcon=NULL,*springarea=NULL,*z=*zp, *zdof=NULL, *thicke=NULL,
         atrab[9],acs[9],diff,fin[3],fout[3],*sumi=NULL,
         *vti=NULL,*pslavsurf=NULL,*pmastsurf=NULL,*cdn=NULL,
         *energyini=NULL,*energy=NULL;
     
     /* dummy arguments for the results call */
     
     double *veold=NULL,*accold=NULL,bet,gam,dtime,time;
 
     pi=4.*atan(1.);
     neqh=neq[1]/2;
 
     noderight_=10;
     NNEW(noderight,ITG,noderight_);
     NNEW(coefright,double,noderight_);
 
     NNEW(v,double,2*mt**nk);
     NNEW(vt,double,mt**nk**nsectors);
     
     NNEW(fn,double,2*mt**nk);
     NNEW(stn,double,12**nk);
     NNEW(inum,ITG,*nk);
     NNEW(stx,double,6*mi[0]**ne);
     
     nlabel=47;
     NNEW(filabt,char,87*nlabel);
     for(i=1;i<87*nlabel;i++) filabt[i]=' ';
     filabt[0]='U';
     
     NNEW(temp_array,double,neq[1]);
     NNEW(coefmpcnew,double,*mpcend);
     
     nkt=*nsectors**nk;
  
     /* assigning nodes and elements to sectors */
     
     NNEW(inocs,ITG,*nk);
     NNEW(ielcs,ITG,*ne);
     ielset=cs[12];
     if((*mcs!=1)||(ielset!=0)){
     for(i=0;i<*nk;i++) inocs[i]=-1;
     for(i=0;i<*ne;i++) ielcs[i]=-1;
     }
     NNEW(csmass,double,*mcs);
     if(*mcs==1) csmass[0]=1.;
     
     for(i=0;i<*mcs;i++){
     is=cs[17*i];
     //  if(is==1) continue;
     ielset=cs[17*i+12];
     if(ielset==0) continue;
     for(i1=istartset[ielset-1]-1;i1<iendset[ielset-1];i1++){
         if(ialset[i1]>0){
         iel=ialset[i1]-1;
         if(ipkon[iel]<0) continue;
         ielcs[iel]=i;
         indexe=ipkon[iel];
         if(*mcs==1){
           if(strcmp1(&lakon[8*iel+3],"2")==0)nope=20;
           else if (strcmp1(&lakon[8*iel+3],"8")==0)nope=8;
           else if (strcmp1(&lakon[8*iel+3],"10")==0)nope=10;
           else if (strcmp1(&lakon[8*iel+3],"4")==0)nope=4;
           else if (strcmp1(&lakon[8*iel+3],"15")==0)nope=15;
           else if (strcmp1(&lakon[8*iel+3],"6")==0)nope=6;
           else if (strcmp1(&lakon[8*iel],"ES")==0){
               lakonl[0]=lakon[8*iel+7];
               nope=atoi(lakonl)+1;}
           else continue;
         }else{
           nelem=iel+1;
           FORTRAN(calcmass,(ipkon,lakon,kon,co,mi,&nelem,ne,thicke,
                         ielmat,&nope,t0,t1,rhcon,nrhcon,ntmat_,
             ithermal,&csmass[i],ielprop,prop));
         }
         for(i2=0;i2<nope;++i2){
             node=kon[indexe+i2]-1;
             inocs[node]=i;
         }
         }
         else{
         iel=ialset[i1-2]-1;
         do{
             iel=iel-ialset[i1];
             if(iel>=ialset[i1-1]-1) break;
             if(ipkon[iel]<0) continue;
             ielcs[iel]=i;
             indexe=ipkon[iel];
             if(*mcs==1){
               if(strcmp1(&lakon[8*iel+3],"2")==0)nope=20;
               else if (strcmp1(&lakon[8*iel+3],"8")==0)nope=8;
               else if (strcmp1(&lakon[8*iel+3],"10")==0)nope=10;
               else if (strcmp1(&lakon[8*iel+3],"4")==0)nope=4;
               else if (strcmp1(&lakon[8*iel+3],"15")==0)nope=15;
               else {nope=6;}
             }else{
               nelem=iel+1;
               FORTRAN(calcmass,(ipkon,lakon,kon,co,mi,&nelem,ne,thicke,
                         ielmat,&nope,t0,t1,rhcon,nrhcon,ntmat_,
             ithermal,&csmass[i],ielprop,prop));
             }
             for(i2=0;i2<nope;++i2){
             node=kon[indexe+i2]-1;
             inocs[node]=i;
             }
         }while(1);
         }
     } 
 //  printf("expand.c mass = %" ITGFORMAT ",%e\n",i,csmass[i]);
     }
 
     /* copying imdnode into iznode 
        iznode contains the nodes in which output is requested and
        the nodes in which loading is applied */
 
     NNEW(iznode,ITG,*nk);
     for(j=0;j<*nmdnode;j++){iznode[j]=imdnode[j];}
     nznode=*nmdnode;
 
 /* expanding imddof, imdnode, imdboun and imdmpc */
 
     for(i=1;i<*nsectors;i++){
     for(j=0;j<*nmddof;j++){
         imddof[i**nmddof+j]=imddof[j]+i*neqh;
     }
     for(j=0;j<*nmdnode;j++){
         imdnode[i**nmdnode+j]=imdnode[j]+i**nk;
     }
     for(j=0;j<*nmdboun;j++){
         imdboun[i**nmdboun+j]=imdboun[j]+i**nboun;
     }
     for(j=0;j<*nmdmpc;j++){
         imdmpc[i**nmdmpc+j]=imdmpc[j]+i**nmpc;
     }
     }
     (*nmddof)*=(*nsectors);
     (*nmdnode)*=(*nsectors);
     (*nmdboun)*=(*nsectors);
     (*nmdmpc)*=(*nsectors);
 
 /* creating a field with the degrees of freedom in which the eigenmodes
    are needed:
    1. all dofs in which the solution is needed (=imddof)
    2. all dofs in which loading was applied
  */ 
 
     NNEW(izdof,ITG,neqh**nsectors);
     for(j=0;j<*nmddof;j++){izdof[j]=imddof[j];}
     *nzdof=*nmddof;
     
     /* generating the coordinates for the other sectors */
     
     icntrl=1;
     
     FORTRAN(rectcyl,(co,v,fn,stn,qfn,een,cs,nk,&icntrl,t,filabt,&imag,mi,emn));
     
     for(jj=0;jj<*mcs;jj++){
     is=(ITG)(cs[17*jj]+0.5);
     for(i=1;i<is;i++){
         
         theta=i*2.*pi/cs[17*jj];
         
         for(l=0;l<*nk;l++){
         if(inocs[l]==jj){
             co[3*l+i*3**nk]=co[3*l];
             co[1+3*l+i*3**nk]=co[1+3*l]+theta;
             co[2+3*l+i*3**nk]=co[2+3*l];
             if(*ntrans>0) inotr[2*l+i*2**nk]=inotr[2*l];
         }
         }
         for(l=0;l<*nkon;l++){kon[l+i**nkon]=kon[l]+i**nk;}
         for(l=0;l<*ne;l++){
         if(ielcs[l]==jj){
             if(ipkon[l]>=0){
             ipkon[l+i**ne]=ipkon[l]+i**nkon;
             ielmat[mi[2]*(l+i**ne)]=ielmat[mi[2]*l];
             if(*norien>0) ielorien[l+i**ne]=ielorien[l];
             for(l1=0;l1<8;l1++){
                 l2=8*l+l1;
                 lakon[l2+i*8**ne]=lakon[l2];
             }
             }else{
             ipkon[l+i**ne]=ipkon[l];
             }   
         }
         }
     }
     }
     
     icntrl=-1;
     
     FORTRAN(rectcyl,(co,vt,fn,stn,qfn,een,cs,&nkt,&icntrl,t,filabt,&imag,mi,emn));
 
 /* expand nactdof */
 
     for(i=1;i<*nsectors;i++){
     lint=i*mt**nk;
     for(j=0;j<mt**nk;j++){
         if(nactdof[j]>0){
         nactdof[lint+j]=nactdof[j]+i*neqh;
         }else{
         nactdof[lint+j]=0;
         }
     }
     }
     
 /* copying the boundary conditions
    (SPC's must be defined in cylindrical coordinates) */
     
     for(i=1;i<*nsectors;i++){
     for(j=0;j<*nboun;j++){
         nodeboun[i**nboun+j]=nodeboun[j]+i**nk;
         ndirboun[i**nboun+j]=ndirboun[j];
         xboun[i**nboun+j]=xboun[j];
         xbounold[i**nboun+j]=xbounold[j];
         if(*nam>0) iamboun[i**nboun+j]=iamboun[j];
         ikboun[i**nboun+j]=ikboun[j]+8*i**nk;
         ilboun[i**nboun+j]=ilboun[j]+i**nboun;
     }
     }
     
     /* distributed loads */
     
     for(i=0;i<*nload;i++){
     if(nelemload[2*i+1]<*nsectors){
         nelemload[2*i]+=*ne*nelemload[2*i+1];
     }else{
         nelemload[2*i]+=*ne*(nelemload[2*i+1]-(*nsectors));
     }
     iload=i+1;
     FORTRAN(addizdofdload,(nelemload,sideload,ipkon,kon,lakon,
         nactdof,izdof,nzdof,mi,&iload,iznode,&nznode,nk,
         imdnode,nmdnode));
     }
 
     /* body loads */
 
     if(*nbody>0){
     printf("*ERROR in expand: body loads are not allowed for modal dynamics\n and steady state dynamics calculations in cyclic symmetric structures\n\n");
     FORTRAN(stop,());
     }
 
   /*  sorting the elements with distributed loads */
 
     if(*nload>0){
     if(*nam>0){
         FORTRAN(isortiiddc,(nelemload,iamload,xload,xloadold,sideload,nload,&kflag));
     }else{
         FORTRAN(isortiddc,(nelemload,xload,xloadold,sideload,nload,&kflag));
     }
     }
     
     /* point loads */
     
 /*    for(i=0;i<*nforc;i++){
     if(nodeforc[2*i+1]<*nsectors){
         nodeforc[2*i]+=*nk*nodeforc[2*i+1];
     }else{
         nodeforc[2*i]+=*nk*(nodeforc[2*i+1]-(*nsectors));
     }
     iforc=i+1;
     FORTRAN(addizdofcload,(nodeforc,ndirforc,nactdof,mi,izdof,
             nzdof,&iforc,iznode,&nznode,nk,imdnode,nmdnode,xforc));
         }*/
 
     i=0;
     while(i<*nforc){
     node=nodeforc[2*i];
     
     /* checking for a cylindrical transformation;
        comparison with the cyclic symmetry system */
     
     itr=inotr[2*node-2];
 
     if(itr==0){
 
             /* carthesian coordinate system */
 
         if(nodeforc[2*i+1]<*nsectors){
         nodeforc[2*i]+=*nk*nodeforc[2*i+1];
         }else{
         nodeforc[2*i]+=*nk*(nodeforc[2*i+1]-(*nsectors));
         }
         i++;iforc=i;
         FORTRAN(addizdofcload,(nodeforc,ndirforc,nactdof,mi,izdof,
             nzdof,&iforc,iznode,&nznode,nk,imdnode,nmdnode,xforc));
     }else{
 
         /* cylindrical coordinate system */ 
         
         FORTRAN(transformatrix,(&trab[7*(itr-1)],&co[3*(node-1)],atrab));
         FORTRAN(transformatrix,(&cs[5],&co[3*(node-1)],acs));
         diff=0.; for(j=0;j<9;j++) diff+=(atrab[j]-acs[j])*(atrab[j]-acs[j]);
         
         if((ndirforc[i]!=1)||
            (nodeforc[2*i+2]!=node)||(ndirforc[i+1]!=2)||
            (nodeforc[2*i+4]!=node)||(ndirforc[i+2]!=3)||
            ((diff>1.e-10)&&(fabs(diff-8.)>1.e-10))){
         printf("*ERROR: forces in a modal dynamic or steady state dynamics\n");
         printf("        calculation with cyclic symmetry must be defined in\n");
         printf("        the cyclic symmetric cylindrical coordinate system\n");
         printf("        force at fault is applied in node %" ITGFORMAT "\n",node);
         FORTRAN(stop,());
         }
         
         /* changing the complete force in the node in the basis sector from
            the global rectangular system into the cylindrical system */
         
         fin[0]=xforc[i];
         fin[1]=xforc[i+1];
         fin[2]=xforc[i+2];
         icntrl=2;
         FORTRAN(rectcyltrfm,(&node,co,cs,&icntrl,fin,fout));
         
         /* new node number (= node number in the target sector) */
         
         if(nodeforc[2*i+1]<*nsectors){
         nodeforc[2*i]+=*nk*nodeforc[2*i+1];
         }else{
         nodeforc[2*i]+=*nk*(nodeforc[2*i+1]-(*nsectors));
         }
         nodeforc[2*i+2]=nodeforc[2*i];
         nodeforc[2*i+4]=nodeforc[2*i];
         
         /* changing the complete force in the node in the target sector from
            the cylindrical system into the global rectangular system */
         
         node=nodeforc[2*i];
         fin[0]=fout[0];
         fin[1]=fout[1];
         fin[2]=fout[2];
         icntrl=-2;
         FORTRAN(rectcyltrfm,(&node,co,cs,&icntrl,fin,fout));
         xforc[i]=fout[0];
         xforc[i+1]=fout[1];
         xforc[i+2]=fout[2];
         
         /* storing the node and the dof into iznode and izdof */
         
         for(j=0;j<3;j++){
         i++;iforc=i;
         FORTRAN(addizdofcload,(nodeforc,ndirforc,nactdof,mi,izdof,
             nzdof,&iforc,iznode,&nznode,nk,imdnode,nmdnode,xforc));
         }
     }
     }
     
     /* loop over all eigenvalues; the loop starts from the highest eigenvalue
        so that the reuse of z is not a problem
        z before: real and imaginary part for a segment for all eigenvalues
        z after: real part for all segments for all eigenvalues */
 
     if(*nherm==1){
     NNEW(zdof,double,(long long)*nev**nzdof);
     }else{
     NNEW(zdof,double,(long long)2**nev**nzdof);
     NNEW(sumi,double,*nev);
     }
 
     lfin=0;
     for(j=*nev-1;j>-1;--j){
     lint=2*j*neqh;
 
     /* calculating the cosine and sine of the phase angle */
 
     for(jj=0;jj<*mcs;jj++){
         theta=nm[j]*2.*pi/cs[17*jj];
         cs[17*jj+14]=cos(theta);
         cs[17*jj+15]=sin(theta);
     }
     
     /* generating the cyclic MPC's (needed for nodal diameters
        different from 0 */
     
     NNEW(eei,double,6*mi[0]**ne);
 
     DMEMSET(v,0,2*mt**nk,0.);
     
     for(k=0;k<2*neqh;k+=neqh){
         
         for(i=0;i<6*mi[0]**ne;i++){eme[i]=0.;}
         
         if(k==0) {kk=0;kkv=0;kk6=0;}
         else {kk=*nk;kkv=mt**nk;kk6=6**nk;}
         for(i=0;i<*nmpc;i++){
         index=ipompc[i]-1;
         /* check whether thermal mpc */
         if(nodempc[3*index+1]==0) continue;
         coefmpcnew[index]=coefmpc[index];
         while(1){
             index=nodempc[3*index+2];
             if(index==0) break;
             index--;
             
             icomplex=0;
             inode=nodempc[3*index];
             if(strcmp1(&labmpc[20*i],"CYCLIC")==0){
             icomplex=atoi(&labmpc[20*i+6]);}
             else if(strcmp1(&labmpc[20*i],"SUBCYCLIC")==0){
             for(ij=0;ij<*mcs;ij++){
                 lprev=cs[ij*17+13];
                 ilength=cs[ij*17+3];
                 FORTRAN(nident,(&ics[lprev],&inode,&ilength,&id));
                 if(id!=0){
                 if(ics[lprev+id-1]==inode){icomplex=ij+1;break;}
                 }
             }
             }
             
             if(icomplex!=0){
             idir=nodempc[3*index+1];
             idof=nactdof[mt*(inode-1)+idir]-1;
             if(idof<=-1){xreal=1.;ximag=1.;}
             else{xreal=z[lint+idof];ximag=z[lint+idof+neqh];}
             if(k==0) {
                 if(fabs(xreal)<1.e-30)xreal=1.e-30;
                 coefmpcnew[index]=coefmpc[index]*
                 (cs[17*(icomplex-1)+14]+
                                  ximag/xreal*cs[17*(icomplex-1)+15]);}
             else {
                 if(fabs(ximag)<1.e-30)ximag=1.e-30;
                 coefmpcnew[index]=coefmpc[index]*
                 (cs[17*(icomplex-1)+14]-
                                  xreal/ximag*cs[17*(icomplex-1)+15]);}
             }
             else{coefmpcnew[index]=coefmpc[index];}
         }
         }
         
         results(co,nk,kon,ipkon,lakon,ne,&v[kkv],&stn[kk6],inum,
           stx,elcon,
           nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat,ielorien,
           norien,orab,ntmat_,t0,t0,ithermal,
           prestr,iprestr,filab,eme,&emn[kk6],&een[kk6],iperturb,
           f,&fn[kkv],nactdof,&iout,qa,vold,&z[lint+k],
           nodeboun,ndirboun,xboun,nboun,ipompc,
           nodempc,coefmpcnew,labmpc,nmpc,nmethod,cam,&neqh,veold,accold,
           &bet,&gam,&dtime,&time,ttime,plicon,nplicon,plkcon,nplkcon,
           xstateini,xstiff,xstate,npmat_,epn,matname,mi,&ielas,&icmd,
           ncmat_,nstate_,stiini,vini,ikboun,ilboun,ener,&enern[kk],emeini,
           xstaten,eei,enerini,cocon,ncocon,set,nset,istartset,iendset,
           ialset,nprint,prlab,prset,qfx,qfn,trab,inotr,ntrans,fmpc,
           nelemload,nload,ikmpc,ilmpc,&istep,&iinc,springarea,&reltime,
               &ne0,xforc,nforc,thicke,shcon,nshcon,
               sideload,xload,xloadold,&icfd,inomat,pslavsurf,pmastsurf,
           &mortar,islavact,cdn,islavnode,nslavnode,ntie,clearini,
           islavsurf,ielprop,prop,energyini,energy,&iit,iponoel,
           inoel,nener,orname,&network,ipobody,xbody,ibody);
         
     }
     SFREE(eei);
 
     /* mapping the results to the other sectors */
 
     if(*nherm!=1)NNEW(vti,double,mt**nk**nsectors);
     
     icntrl=2;imag=1;
     
     FORTRAN(rectcylexp,(co,v,fn,stn,qfn,een,cs,nk,&icntrl,t,filabt,&imag,mi,
                 iznode,&nznode,nsectors,nk,emn));
     
     /* basis sector */
 
     for(ll=0;ll<nznode;ll++){
         l1=iznode[ll]-1;
         for(l2=0;l2<mt;l2++){
         l=mt*l1+l2;
         vt[l]=v[l];
         if(*nherm!=1)vti[l]=v[l+mt**nk];
         }
     }
 
     /* other sectors */
 
     for(jj=0;jj<*mcs;jj++){
         ilength=cs[17*jj+3];
         lprev=cs[17*jj+13];
         for(i=1;i<*nsectors;i++){
         
         theta=i*nm[j]*2.*pi/cs[17*jj];
         ctl=cos(theta);
         stl=sin(theta);
         
         for(ll=0;ll<nznode;ll++){
             l1=iznode[ll]-1;
             if(inocs[l1]==jj){
             
             /* check whether node lies on axis */
             
             ml1=-l1-1;
             FORTRAN(nident,(&ics[lprev],&ml1,&ilength,&id));
             if(id!=0){
                 if(ics[lprev+id-1]==ml1){
                 for(l2=0;l2<mt;l2++){
                     l=mt*l1+l2;
                     vt[l+mt**nk*i]=v[l];
                     if(*nherm!=1)vti[l+mt**nk*i]=v[l+mt**nk];
                 }
                 continue;
                 }
             }
             for(l2=0;l2<mt;l2++){
                 l=mt*l1+l2;
                 vt[l+mt**nk*i]=ctl*v[l]-stl*v[l+mt**nk];
                 if(*nherm!=1)vti[l+mt**nk*i]=stl*v[l]+ctl*v[l+mt**nk];
             }
             }
         }
         }
     }
     
     icntrl=-2;imag=0;
     
     FORTRAN(rectcylexp,(co,vt,fn,stn,qfn,een,cs,&nkt,&icntrl,t,filabt,
                 &imag,mi,iznode,&nznode,nsectors,nk,emn));
     
 /* storing the displacements into the expanded eigenvectors */
 
     for(ll=0;ll<nznode;ll++){
         i=iznode[ll]-1;
 //  for(i=0;i<*nk;i++){
         for(j1=0;j1<mt;j1++){
 
         for(k=0;k<*nsectors;k++){
             /* C-convention */
             idof=nactdof[mt*(k**nk+i)+j1]-1;
             if(idof>-1){
             FORTRAN(nident,(izdof,&idof,nzdof,&id));
             if(id!=0){
                 if(izdof[id-1]==idof){
                 if(*nherm==1){
                     zdof[(long long)j**nzdof+id-1]=vt[k*mt**nk+mt*i+j1];
                 }else{
                     zdof[(long long)2*j**nzdof+id-1]=vt[k*mt**nk+mt*i+j1];
                     zdof[(long long)(2*j+1)**nzdof+id-1]=vti[k*mt**nk+mt*i+j1];
                 }
                 }
             }
             }
         }
         }       
     }
 
     if(*nherm!=1) SFREE(vti);
     
 /* normalizing the eigenvectors with the mass */
 
 /*  if (nm[j]==0||(nm[j]==(ITG)((cs[0]/2))&&(fmod(cs[0],2.)==0.)))
                  {sum=sqrt(cs[0]);}
          else{sum=sqrt(cs[0]/2);}*/
 
     sum=0.;
     summass=0.;
     for(i=0;i<*mcs;i++){
       if (nm[j]==0||(nm[j]==(ITG)((cs[17*i]/2))&&(fmod(cs[17*i],2.)==0.))){
         sum+=cs[17*i]*csmass[i];
       }else{
         sum+=cs[17*i]*csmass[i]/2.;
       }
       summass+=csmass[i];
     }
     if(fabs(summass)>1.e-20){
       sum=sqrt(sum/summass);
     }else{
       printf("*ERROR in expand.c: total mass of structure is zero\n");
       printf("       maybe no element sets were specified for the\n");
       printf("       cyclic symmetry ties\n");
       FORTRAN(stop,());
     }
 
     if(*nherm==1){
         for(i=0;i<*nzdof;i++){zdof[(long long)j**nzdof+i]/=sum;}
     }else{
         for(i=0;i<*nzdof;i++){zdof[(long long)(2*j)**nzdof+i]/=sum;}
         for(i=0;i<*nzdof;i++){zdof[(long long)(2*j+1)**nzdof+i]/=sum;}
         sumi[j]=sqrt(sum);
     }
     }
   
 /* copying zdof into z */
   
     if(*nherm==1){
     RENEW(z,double,(long long)*nev**nzdof);
     memcpy(&z[0],&zdof[0],(long long)sizeof(double)**nev**nzdof);
     }else{
     RENEW(z,double,(long long)2**nev**nzdof);
     memcpy(&z[0],&zdof[0],(long long)sizeof(double)*2**nev**nzdof);
     for(i=0;i<*nev;i++){
         for(j=0;j<*nev;j++){
         xmr[i**nev+j]/=(sumi[i]*sumi[j]);
         xmi[i**nev+j]/=(sumi[i]*sumi[j]);
         }
     }
     SFREE(sumi);
     }
     SFREE(zdof);
 
 /* copying the multiple point constraints */
 
     *nmpc=0;
     *mpcend=0;
     for(i=0;i<*nsectors;i++){
     if(i==0){
         ileft=*nsectors-1;
     }else{
         ileft=i-1;
     }
     for(j=0;j<*nmpcold;j++){
         if(noderight_>10){
         noderight_=10;
         RENEW(noderight,ITG,noderight_);
         RENEW(coefright,double,noderight_);
         }
         ipompc[*nmpc]=*mpcend+1;
         ikmpc[*nmpc]=ikmpc[j]+8*i**nk;
         ilmpc[*nmpc]=ilmpc[j]+i**nmpcold;
         strcpy1(&labmpc[20**nmpc],&labmpcold[20*j],20);
         if(strcmp1(&labmpcold[20*j],"CYCLIC")==0){
         index=ipompcold[j]-1;
         nodeleft=nodempcold[3*index];
         idir=nodempcold[3*index+1];
         index=nodempcold[3*index+2]-1;
         numnodes=0;
         do{
             node=nodempcold[3*index];
             if(nodempcold[3*index+1]==idir){
             noderight[numnodes]=node;
             coefright[numnodes]=coefmpcold[index];
             numnodes++;
             if(numnodes>=noderight_){
                 noderight_=(ITG)(1.5*noderight_);
                 RENEW(noderight,ITG,noderight_);
                 RENEW(coefright,double,noderight_);
             }
             }
             index=nodempcold[3*index+2]-1;
             if(index==-1) break;
         }while(1);
         if(numnodes>0){
             sum=0.;
             for(k=0;k<numnodes;k++){
             sum+=coefright[k];
             }
             for(k=0;k<numnodes;k++){
             coefright[k]/=sum;
             }
         }else{coefright[0]=1.;}
         nodempc[3**mpcend]=nodeleft+i**nk;
         nodempc[3**mpcend+1]=idir;
         nodempc[3**mpcend+2]=*mpcend+2;
         coefmpc[*mpcend]=1.;
         for(k=0;k<numnodes;k++){
             (*mpcend)++;
             nodempc[3**mpcend]=noderight[k]+ileft**nk;
             nodempc[3**mpcend+1]=idir;
             nodempc[3**mpcend+2]=*mpcend+2;
             coefmpc[*mpcend]=-coefright[k];
         }
         nodempc[3**mpcend+2]=0;
         (*mpcend)++;
         }else{
         index=ipompcold[j]-1;
         iterm=0;
         do{
             iterm++;
             node=nodempcold[3*index];
             idir=nodempcold[3*index+1];
             coef=coefmpcold[index];
 
             /* check whether SUBCYCLIC MPC: if the current node
                        is an independent node of a CYCLIC MPC, the
                        node in the new MPC should be the cylic previous
                        one */
 
             nodenew=node+i**nk;
             if(strcmp1(&labmpcold[20*j],"SUBCYCLIC")==0){
             for(ij=0;ij<*mcs;ij++){
                 lprev=cs[ij*17+13];
                 ilength=cs[ij*17+3];
                 FORTRAN(nident,(&ics[lprev],&node,&ilength,&id));
                 if(id!=0){
                 if(ics[lprev+id-1]==node){
                     nodenew=node+ileft**nk;
                     break;
                 }
                 }
             }
             }
             
             /* modification of the MPC coefficients if
                        cylindrical coordinate system is active
                        it is assumed that all terms in the MPC are
                        either in the radial, the circumferential
                        or axial direction  */
             
             if(*ntrans<=0){itr=0;}
             else if(inotr[2*node-2]==0){itr=0;}
             else{itr=inotr[2*node-2];}
             
             if(iterm==1) locdir=-1;
             
             if((itr!=0)&&(idir!=0)){
             if(trab[7*itr-1]<0){
                 FORTRAN(transformatrix,(&trab[7*itr-7],
                             &co[3*node-3],a));
                 if(iterm==1){
                 for(k=0;k<3;k++){
                     if(fabs(a[3*k+idir-1]-coef)<1.e-10){
                     FORTRAN(transformatrix,(&trab[7*itr-7],
                                 &co[3*nodenew-3],a));
                     coef=a[3*k+idir-1];
                     locdir=k;
                     break;
                     }
                     if(fabs(a[3*k+idir-1]+coef)<1.e-10){
                     FORTRAN(transformatrix,(&trab[7*itr-7],
                                 &co[3*nodenew-3],a));
                     coef=-a[3*k+idir-1];
                     locdir=k;
                     break;
                     }
                 }
                 }else{
                 if(locdir!=-1){
                     if(fabs(a[3*locdir+idir-1])>1.e-10){
                     ratio=coef/a[3*locdir+idir-1];
                     }else{ratio=0.;}
                     FORTRAN(transformatrix,(&trab[7*itr-7],
                                 &co[3*nodenew-3],a));
                     coef=ratio*a[3*locdir+idir-1];
                 }
                 }       
             }
             }
             
             nodempc[3**mpcend]=nodenew;
             nodempc[3**mpcend+1]=idir;
             coefmpc[*mpcend]=coef;
             index=nodempcold[3*index+2]-1;
             if(index==-1) break;
             nodempc[3**mpcend+2]=*mpcend+2;
             (*mpcend)++;
         }while(1);
         nodempc[3**mpcend+2]=0;
         (*mpcend)++;
         }
         (*nmpc)++;
     }
     }
 
     /* copying the temperatures */
 
     if(*ithermal!=0){
     for(i=1;i<*nsectors;i++){
         lint=i**nk;
         for(j=0;j<*nk;j++){
         t0[lint+j]=t0[j];
         t1old[lint+j]=t1old[j];
         t1[lint+j]=t1[j];
         }
     }
     if(*nam>0){
         for(i=1;i<*nsectors;i++){
         lint=i**nk;
         for(j=0;j<*nk;j++){
             iamt1[lint+j]=iamt1[j];
         }
         }
     }
     }
 
     /* copying the contact definition */
 
     if(*nmethod==4){
       
       /* first find the startposition to append the expanded contact fields*/
       
       for(j=0; j<*nset; j++){
     if(iendset[j]>tint){
       tint=iendset[j];
     }
       }
       tint++;
       /* now append and expand the contact definitons*/
       NNEW(tchar1,char,81);
       NNEW(tchar2,char,81);
       NNEW(tchar3,char,81);
       for(i=0; i<*ntie; i++){
     if(tieset[i*(81*3)+80]=='C'){
       memcpy(tchar2,&tieset[i*(81*3)+81],81);
       tchar2[80]='\0';
       memcpy(tchar3,&tieset[i*(81*3)+81+81],81);
       tchar3[80]='\0';
       //a contact constraint was found, so append and expand the information
       for(j=0; j<*nset; j++){
         memcpy(tchar1,&set[j*81],81);
         tchar1[80]='\0';
         if(strcmp(tchar1,tchar2)==0){
           /* dependent nodal surface was found,copy the original information first */
           tnstart=tint;
           for(k=0; k<iendset[j]-istartset[j]+1; k++){
         ialset[tint-1]=ialset[istartset[j]-1+k];
         tint++;
           }
           /* now append the expanded information */
           for(l=1; l<*nsectors; l++){
         for(k=0; k<iendset[j]-istartset[j]+1; k++){
           ialset[tint-1]=(ialset[istartset[j]-1+k]!=-1)?ialset[istartset[j]-1+k]+*nk*l:-1;
           tint++;
         }
           }
           tnend=tint-1;
           /* now replace the information in istartset and iendset*/
           istartset[j]=tnstart;
           iendset[j]=tnend;
         }
         else if(strcmp(tchar1,tchar3)==0){
           /* independent element face surface was found */
           tnstart=tint;
           for(k=0; k<iendset[j]-istartset[j]+1; k++){
         ialset[tint-1]=ialset[istartset[j]-1+k];
         tint++;
           }
           /* now append the expanded information*/
           for(l=1; l<*nsectors; l++){
         for(k=0; k<iendset[j]-istartset[j]+1; k++){
           tint2=((ITG)(ialset[istartset[j]-1+k]))/10;
           ialset[tint-1]=(ialset[istartset[j]-1+k]!=-1)?(tint2+*ne*l)*10+(ialset[istartset[j]-1+k]-(tint2*10)):-1;
           tint++;
         }
           }
           tnend=tint-1;
           /* now replace the information in istartset and iendset*/
           istartset[j]=tnstart;
           iendset[j]=tnend;
         }
       }
     }
       }
       SFREE(tchar1);
       SFREE(tchar2);
       SFREE(tchar3);
     }    
     
     *nk=nkt;
     (*ne)*=(*nsectors);
     (*nkon)*=(*nsectors);
     (*nboun)*=(*nsectors);
     neq[1]=neqh**nsectors;
 
     *zp=z;*izdofp=izdof;
     
     SFREE(temp_array);SFREE(coefmpcnew);SFREE(noderight);SFREE(coefright);
     SFREE(v);SFREE(vt);SFREE(fn);SFREE(stn);SFREE(inum);SFREE(stx);
     SFREE(inocs);SFREE(ielcs);SFREE(filabt);SFREE(iznode);SFREE(csmass);
 
     return;
 }

◆ filtermain()

void filtermain	(	double *	co,
		double *	dgdxglob,
		ITG *	nobject,
		ITG *	nk,
		ITG *	nodedesi,
		ITG *	ndesi,
		char *	objectset
	)

                                                            {
 
     /* filtering the sensitivities */
 
     ITG *nx=NULL,*ny=NULL,*nz=NULL,i,*ithread=NULL;
     
     double *xo=NULL,*yo=NULL,*zo=NULL,*x=NULL,*y=NULL,*z=NULL;
     
     /* if no radius is defined no filtering is performed
        the radius applies to all objective functions */
     
     if(*nobject==0){return;}
     if(strcmp1(&objectset[81],"                    ")==0){
     for(i=1;i<2**nk**nobject;i=i+2){
         dgdxglob[i]=dgdxglob[i-1];
     }
     return;
     }
     
     /* prepare for near3d_se */
     
     NNEW(xo,double,*ndesi);
     NNEW(yo,double,*ndesi);
     NNEW(zo,double,*ndesi);
     NNEW(x,double,*ndesi);
     NNEW(y,double,*ndesi);
     NNEW(z,double,*ndesi);
     NNEW(nx,ITG,*ndesi);
     NNEW(ny,ITG,*ndesi);
     NNEW(nz,ITG,*ndesi);
     
     FORTRAN(prefilter,(co,nodedesi,ndesi,xo,yo,zo,x,y,z,nx,ny,nz));
     
     /* variables for multithreading procedure */
     
     ITG sys_cpus;
     char *env,*envloc,*envsys;
     
     num_cpus = 0;
     sys_cpus=0;
     
     /* explicit user declaration prevails */
     
     envsys=getenv("NUMBER_OF_CPUS");
     if(envsys){
     sys_cpus=atoi(envsys);
     if(sys_cpus<0) sys_cpus=0;
     }
     
     /* automatic detection of available number of processors */
     
     if(sys_cpus==0){
     sys_cpus = getSystemCPUs();
     if(sys_cpus<1) sys_cpus=1;
     }
     
     /* local declaration prevails, if strictly positive */
     
     envloc = getenv("CCX_NPROC_FILTER");
     if(envloc){
     num_cpus=atoi(envloc);
     if(num_cpus<0){
         num_cpus=0;
     }else if(num_cpus>sys_cpus){
         num_cpus=sys_cpus;
     }
     
     }
     
     /* else global declaration, if any, applies */
     
     env = getenv("OMP_NUM_THREADS");
     if(num_cpus==0){
     if (env)
         num_cpus = atoi(env);
     if (num_cpus < 1) {
         num_cpus=1;
     }else if(num_cpus>sys_cpus){
         num_cpus=sys_cpus;
     }
     }
     
     /* check that the number of cpus does not supercede the number
        of design variables */
     
     if(*ndesi<num_cpus) num_cpus=*ndesi;
     
     pthread_t tid[num_cpus];
     
     NNEW(neighbor1,ITG,num_cpus*(*ndesi+6));
     NNEW(r1,double,num_cpus*(*ndesi+6));
     
     dgdxglob1=dgdxglob;nobject1=nobject;nk1=nk;nodedesi1=nodedesi;
     ndesi1=ndesi;objectset1=objectset;xo1=xo;yo1=yo;zo1=zo;
     x1=x;yy1=y;z1=z;nx1=nx;ny1=ny;nz1=nz;
     
     /* filtering */
     
     printf(" Using up to %" ITGFORMAT " cpu(s) for filtering the sensitivities.\n\n", num_cpus);
     
     /* create threads and wait */
   
     NNEW(ithread,ITG,num_cpus);
     for(i=0; i<num_cpus; i++)  {
     ithread[i]=i;
     pthread_create(&tid[i], NULL, (void *)filtermt, (void *)&ithread[i]);
     }
     for(i=0; i<num_cpus; i++)  pthread_join(tid[i], NULL);
     
     SFREE(neighbor1);SFREE(r1);SFREE(xo);SFREE(yo);SFREE(zo);
     SFREE(x);SFREE(y);SFREE(z);SFREE(nx);SFREE(ny);SFREE(nz);
     SFREE(ithread);
     
     /* postprocessing the filtered results */
     
 //    FORTRAN(postfilter,(dgdxglob,nobject,nk,nodedesi,ndesi));
     
     return;
     
 } 

◆ filtermt()

void* filtermt ( ITG * i )

                       {
 
     ITG indexr,ndesia,ndesib,ndesidelta;
 
     indexr=*i*(*ndesi1+6);
     
     ndesidelta=(ITG)ceil(*ndesi1/(double)num_cpus);
     ndesia=*i*ndesidelta+1;
     ndesib=(*i+1)*ndesidelta;
     if(ndesib>*ndesi1) ndesib=*ndesi1;
 
 //    printf("i=%" ITGFORMAT ",ntria=%" ITGFORMAT ",ntrib=%" ITGFORMAT "\n",i,ntria,ntrib);
 //    printf("indexad=%" ITGFORMAT ",indexau=%" ITGFORMAT ",indexdi=%" ITGFORMAT "\n",indexad,indexau,indexdi);
 
     FORTRAN(filter,(dgdxglob1,nobject1,nk1,nodedesi1,ndesi1,objectset1,
                     xo1,yo1,zo1,x1,yy1,z1,nx1,ny1,nz1,&neighbor1[indexr],
                     &r1[indexr],&ndesia,&ndesib));
 
     return NULL;
 }

◆ FORTRAN() [1/316]

void FORTRAN	(	actideacti	,
		(char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, char objectset, ITG ipkon, ITG ibject, ITG *ne)
	)

◆ FORTRAN() [2/316]

void FORTRAN	(	actideactistr	,
		(char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, char objectset, ITG ipkon, ITG iobject, ITG ne, ITG neinset, ITG iponoel, ITG inoel, ITG *nepar)
	)

◆ FORTRAN() [3/316]

void FORTRAN	(	addimdnodecload	,
		(ITG nodeforc, ITG i, ITG imdnode, ITG nmdnode, double xforc, ITG ikmpc, ITG ilmpc, ITG ipompc, ITG nodempc, ITG nmpc, ITG imddof, ITG nmddof, ITG nactdof, ITG mi, ITG imdmpc, ITG nmdmpc, ITG imdboun, ITG nmdboun, ITG ikboun, ITG nboun, ITG ilboun, ITG ithermal)
	)

◆ FORTRAN() [4/316]

void FORTRAN	(	addimdnodedload	,
		(ITG nelemload, char sideload, ITG ipkon, ITG kon, char lakon, ITG i, ITG imdnode, ITG nmdnode, ITG ikmpc, ITG ilmpc, ITG ipompc, ITG nodempc, ITG nmpc, ITG imddof, ITG nmddof, ITG nactdof, ITG mi, ITG imdmpc, ITG nmdmpc, ITG imdboun, ITG nmdboun, ITG ikboun, ITG nboun, ITG ilboun, ITG *ithermal)
	)

◆ FORTRAN() [5/316]

void FORTRAN	(	addizdofcload	,
		(ITG nodeforc, ITG ndirforc, ITG nactdof, ITG mi, ITG izdof, ITG nzdof, ITG i, ITG iznode, ITG nznode, ITG nk, ITG imdnode, ITG nmdnode, double *xforc)
	)

◆ FORTRAN() [6/316]

void FORTRAN	(	addizdofdload	,
		(ITG nelemload, char sideload, ITG ipkon, ITG kon, char lakon, ITG nactdof, ITG izdof, ITG nzdof, ITG mi, ITG i, ITG iznode, ITG nznode, ITG nk, ITG imdnode, ITG *nmdnode)
	)

◆ FORTRAN() [7/316]

void FORTRAN	(	adjustcontactnodes	,
		(char tieset, ITG ntie, ITG itietri, double cg, double straight, double co, double vold, double xo, double yo, double zo, double x, double y, double z, ITG nx, ITG ny, ITG nz, ITG istep, ITG iinc, ITG iit, ITG mi, ITG imastop, ITG nslavnode, ITG islavnode, char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, double tietol, double clearini, double clearslavnode, ITG itiefac, ITG ipkon, ITG kon, char lakon, ITG islavsurf)
	)

◆ FORTRAN() [8/316]

void FORTRAN	(	allocation	,
		(ITG nload_, ITG nforc_, ITG nboun_, ITG nk_, ITG ne_, ITG nmpc_, ITG nset_, ITG nalset_, ITG nmat_, ITG ntmat_, ITG npmat_, ITG norien_, ITG nam_, ITG nprint_, ITG mi, ITG ntrans_, char set, ITG meminset, ITG rmeminset, ITG ncs_, ITG namtot_, ITG ncmat_, ITG memmpc_, ITG ne1d, ITG ne2d, ITG nflow, char jobnamec, ITG irstrt, ITG ithermal, ITG nener, ITG nstate_, ITG istep, char inpc, ITG ipoinp, ITG inp, ITG ntie_, ITG nbody_, ITG nprop_, ITG ipoinpc, ITG nevdamp, ITG npt_, ITG nslavsm, ITG nkon_, ITG mcs, ITG mortar, ITG ifacecount, ITG nintpoint, ITG infree, ITG nheading_, ITG nobject_, ITG *iuel)
	)

◆ FORTRAN() [9/316]

void FORTRAN	(	allocont	,
		(ITG ncont, ITG ntie, char tieset, ITG nset, char set, ITG istartset, ITG iendset, ITG ialset, char lakon, ITG ncone, double tietol, ITG ismallsliding, char kind1, char kind2, ITG mortar, ITG istep)
	)

◆ FORTRAN() [10/316]

void FORTRAN	(	applyboun	,
		(ITG ifaext, ITG nfaext, ITG ielfa, ITG ikboun, ITG ilboun, ITG nboun, char typeboun, ITG nelemload, ITG nload, char sideload, ITG isolidsurf, ITG nsolidsurf, ITG ifabou, ITG nfabou, ITG nface, ITG nodeboun, ITG ndirboun, ITG ikmpc, ITG ilmpc, char labmpc, ITG nmpc, ITG nactdohinv, ITG compressible, ITG iatleastonepressurebc, ITG ipkonf, ITG kon, ITG konf, ITG nblk)
	)

◆ FORTRAN() [11/316]

void FORTRAN	(	applympc	,
		(ITG nface, ITG ielfa, ITG is, ITG ie, ITG ifabou, ITG ipompc, double vfa, double coefmpc, ITG nodempc, ITG ipnei, ITG neifa, char labmpc, double xbounact, ITG nactdoh, ITG ifaext, ITG nfaext)
	)

◆ FORTRAN() [12/316]

void FORTRAN	(	applympc_hfa	,
		(ITG nface, ITG ielfa, ITG is, ITG ie, ITG ifabou, ITG ipompc, double hfa, double coefmpc, ITG nodempc, ITG ipnei, ITG neifa, char labmpc, double xbounact, ITG nactdoh)
	)

◆ FORTRAN() [13/316]

void FORTRAN	(	assigndomtonodes	,
		(ITG ne, char lakon, ITG ipkon, ITG kon, ITG ielmat, ITG inomat, double elcon, ITG ncmat_, ITG ntmat_, ITG mi, ITG *ne2)
	)

◆ FORTRAN() [14/316]

void FORTRAN	(	autocovmatrix	,
		(double co, double ad, double au, ITG jqs, ITG irows, ITG ndesi, ITG nodedesi, double physcon)
	)

◆ FORTRAN() [15/316]

void FORTRAN	(	basis	,
		(double x, double y, double z, double xo, double yo, double zo, ITG nx, ITG ny, ITG nz, double planfa, ITG ifatet, ITG nktet, ITG netet, double field, ITG nfield, double cotet, ITG kontyp, ITG ipkon, ITG kon, ITG iparent, double xp, double yp, double zp, double value, double ratio, ITG iselect, ITG nselect, ITG istartset, ITG iendset, ITG ialset, ITG imastset, ITG ielemnr, ITG nterms, ITG konl)
	)

◆ FORTRAN() [16/316]

void FORTRAN	(	biotsavart	,
		(ITG ipkon, ITG kon, char lakon, ITG ne, double co, double qfx, double h0, ITG mi, ITG nka, ITG nkb)
	)

◆ FORTRAN() [17/316]

void FORTRAN	(	blockanalysis	,
		(char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, ITG nblk, ITG ipkon, ITG kon, ITG ielfa, ITG nodface, ITG neiel, ITG neij, ITG neifa, ITG ipoface, ITG ipnei, ITG konf, ITG istartblk, ITG iendblk, ITG nactdoh, ITG nblket, ITG nblkze, ITG nef, ITG ielblk, ITG nk, ITG *nactdohinv)
	)

◆ FORTRAN() [18/316]

void FORTRAN	(	bodyforce	,
		(char cbody, ITG ibody, ITG ipobody, ITG nbody, char set, ITG istartset, ITG iendset, ITG ialset, ITG inewton, ITG nset, ITG ifreebody, ITG k)
	)

◆ FORTRAN() [19/316]

void FORTRAN	(	calcbody	,
		(ITG nef, double body, ITG ipobody, ITG ibody, double xbody, double coel, double vel, char lakon, ITG *nactdohinv)
	)

◆ FORTRAN() [20/316]

void FORTRAN	(	calcguesstincf	,
		(ITG nface, double dmin, double vfa, double umfa, double cvfa, double hcfa, ITG ithermal, double tincfguess, ITG *compressible)
	)

◆ FORTRAN() [21/316]

void FORTRAN	(	calcinitialflux	,
		(double area, double vfa, double xxn, ITG ipnei, ITG nef, ITG neifa, char lakonf, double flux)
	)

◆ FORTRAN() [22/316]

void FORTRAN	(	calccvel	,
		(ITG nef, double vel, double shcon, ITG nshcon, ITG ielmatf, ITG ntmat_, ITG mi, double cvel, double *physcon)
	)

◆ FORTRAN() [23/316]

void FORTRAN	(	calccvelcomp	,
		(ITG nef, double vel, double shcon, ITG nshcon, ITG ielmatf, ITG ntmat_, ITG mi, double cvel, double *physcon)
	)

◆ FORTRAN() [24/316]

void FORTRAN	(	calccvfa	,
		(ITG nface, double vfa, double shcon, ITG nshcon, ITG ielmatf, ITG ntmat_, ITG mi, ITG ielfa, double cvfa, double physcon)
	)

◆ FORTRAN() [25/316]

void FORTRAN	(	calccvfacomp	,
		(ITG nface, double vfa, double shcon, ITG nshcon, ITG ielmatf, ITG ntmat_, ITG mi, ITG ielfa, double cvfa, double physcon)
	)

◆ FORTRAN() [26/316]

void FORTRAN	(	calcgamma	,
		(ITG nface, ITG ielfa, double vel, double gradvel, double gamma, double xlet, double xxn, double xxj, ITG ipnei, double betam, ITG nef, double flux)
	)

◆ FORTRAN() [27/316]

void FORTRAN	(	calcgammak	,
		(ITG nface, ITG ielfa, double vel, double gradkel, double gamma, double xlet, double xxn, double xxj, ITG ipnei, double betam, ITG nef, double flux)
	)

◆ FORTRAN() [28/316]

void FORTRAN	(	calcgammao	,
		(ITG nface, ITG ielfa, double vel, double gradoel, double gamma, double xlet, double xxn, double xxj, ITG ipnei, double betam, ITG nef, double flux)
	)

◆ FORTRAN() [29/316]

void FORTRAN	(	calcgammap	,
		(ITG nface, ITG ielfa, double vel, double gradpel, double gamma, double xlet, double xxn, double xxj, ITG ipnei, double betam, ITG nef, double flux)
	)

◆ FORTRAN() [30/316]

void FORTRAN	(	calcgammat	,
		(ITG nface, ITG ielfa, double vel, double gradtel, double gamma, double xlet, double xxn, double xxj, ITG ipnei, double betam, ITG nef, double flux)
	)

◆ FORTRAN() [31/316]

void FORTRAN	(	calcgradkel	,
		(ITG ne, char lakon, ITG ipnei, double vfa, double area, double xxn, double gradkel, ITG neifa, double *volume)
	)

◆ FORTRAN() [32/316]

void FORTRAN	(	calcgradoel	,
		(ITG ne, char lakon, ITG ipnei, double vfa, double area, double xxn, double gradoel, ITG neifa, double *volume)
	)

◆ FORTRAN() [33/316]

void FORTRAN	(	calcgradpel	,
		(ITG ne, char lakon, ITG ipnei, double vfa, double area, double xxn, double gradpel, ITG neifa, double *volume)
	)

◆ FORTRAN() [34/316]

void FORTRAN	(	calcgradtel	,
		(ITG ne, char lakon, ITG ipnei, double vfa, double area, double xxn, double gradtel, ITG neifa, double *volume)
	)

◆ FORTRAN() [35/316]

void FORTRAN	(	calcgradvel	,
		(ITG ne, char lakon, ITG ipnei, double vfa, double area, double xxn, double gradv, ITG neifa, double *volume)
	)

◆ FORTRAN() [36/316]

void FORTRAN	(	calchcel	,
		(double vel, double cocon, ITG ncocon, ITG ielmatf, ITG ntmat_, ITG mi, double hcel, ITG nef)
	)

◆ FORTRAN() [37/316]

void FORTRAN	(	calchcfa	,
		(ITG nface, double vfa, double cocon, ITG ncocon, ITG ielmatf, ITG ntmat_, ITG mi, ITG ielfa, double *hcfa)
	)

◆ FORTRAN() [38/316]

void FORTRAN	(	calch0interface	,
		(ITG nmpc, ITG ipompc, ITG nodempc, double coefmpc, double *h0)
	)

◆ FORTRAN() [39/316]

void FORTRAN	(	calcmac	,
		(ITG neq, double z, double zz, ITG nev, double mac, double maccpx, ITG istartnmd, ITG iendnmd, ITG nmd, ITG cyclicsymmetry, ITG neqact, double bett, double *betm)
	)

◆ FORTRAN() [40/316]

void FORTRAN	(	calcmass	,
		(ITG ipkon, char lakon, ITG kon, double co, ITG mi, ITG nelem, ITG ne, double thicke, ITG ielmat, ITG nope, double t0, double t1, double rhcon, ITG nrhcon, ITG ntmat_, ITG ithermal, double csmass, ITG ielprop, double *prop)
	)

◆ FORTRAN() [41/316]

void FORTRAN	(	calcmatwavspeed	,
		(ITG ne0, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double orab, ITG ntmat_, ITG ithermal, double alzero, double plicon, ITG nplicon, double plkcon, ITG nplkcon, ITG npmat_, ITG mi, double dtime, double xstiff, ITG ncmat_, double vold, ITG ielmat, double t0, double t1, char matname, char lakon, double xmatwavespeed, ITG nmat, ITG *ipkon)
	)

◆ FORTRAN() [42/316]

void FORTRAN	(	calcpel	,
		(ITG ne, ITG nactdoh, double vel, double b, ITG *nef)
	)

◆ FORTRAN() [43/316]

void FORTRAN	(	calcrhoel	,
		(ITG nef, double vel, double rhcon, ITG nrhcon, ITG ielmatf, ITG ntmat_, ITG ithermal, ITG mi)
	)

◆ FORTRAN() [44/316]

void FORTRAN	(	calcrhoelcomp	,
		(ITG nef, double vel, double shcon, ITG ielmatf, ITG ntmat_, ITG mi)
	)

◆ FORTRAN() [45/316]

void FORTRAN	(	calcrhofa	,
		(ITG nface, double vfa, double rhcon, ITG nrhcon, ITG ielmatf, ITG ntmat_, ITG ithermal, ITG mi, ITG *ielfa)
	)

◆ FORTRAN() [46/316]

void FORTRAN	(	calcrhofacomp	,
		(ITG nface, double vfa, double shcon, ITG ielmatf, ITG ntmat_, ITG mi, ITG ielfa, ITG ipnei, double vel, ITG nef, double flux, double gradpel, double gradtel, double xxj, double betam, double xlet)
	)

◆ FORTRAN() [47/316]

void FORTRAN	(	calcstabletimeinccont	,
		(ITG ne, char lakon, ITG kon, ITG ipkon, ITG mi, ITG ielmat, double elcon, ITG mortar, double adb, double alpha, ITG nactdof, double springarea, ITG ne0, ITG ntmat_, ITG ncmat_, double dtcont)
	)

◆ FORTRAN() [48/316]

void FORTRAN	(	calcstabletimeincvol	,
		(ITG ne0, char lakon, double co, ITG kon, ITG ipkon, ITG mi, ITG ielmat, double dtvol, double alpha, double xmatwavespeed)
	)

◆ FORTRAN() [49/316]

void FORTRAN	(	calcstressheatflux	,
		(double sti, double umel, double gradvel, double qfx, double hcel, double gradtel, ITG nef, ITG isti, ITG iqfx, ITG mi)
	)

◆ FORTRAN() [50/316]

void FORTRAN	(	calctel	,
		(ITG ne, ITG nactdoh, double vel, double b, ITG *nef)
	)

◆ FORTRAN() [51/316]

void FORTRAN	(	calcumel	,
		(ITG nef, double vel, double shcon, ITG nshcon, ITG ielmatf, ITG ntmat_, ITG ithermal, ITG mi, double *umel)
	)

◆ FORTRAN() [52/316]

void FORTRAN	(	calcumfa	,
		(ITG nface, double vfa, double shcon, ITG nshcon, ITG ielmatf, ITG ntmat_, ITG ithermal, ITG mi, ITG ielfa, double umfa)
	)

◆ FORTRAN() [53/316]

void FORTRAN	(	calcvel	,
		(ITG ne, ITG nactdoh, double vel, double b, ITG neq, ITG nef)
	)

◆ FORTRAN() [54/316]

void FORTRAN	(	calcview	,
		(char sideload, double vold, double co, double pmid, double e1, double e2, double e3, ITG kontri, ITG nloadtr, double adview, double auview, double dist, ITG idist, double area, ITG ntrit, ITG mi, ITG jqrad, ITG irowrad, ITG nzsrad, double sidemean, ITG ntria, ITG ntrib, char covered, ITG ng)
	)

◆ FORTRAN() [55/316]

void FORTRAN	(	calinput	,
		(double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG nkon, ITG ne, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, ITG nmpc_, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nforc_, ITG nelemload, char sideload, double xload, ITG nload, ITG nload_, ITG nprint, char prlab, char prset, ITG mpcfree, ITG nboun_, ITG mei, char set, ITG istartset, ITG iendset, ITG ialset, ITG nset, ITG nalset, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, double t0, double t1, char matname, ITG ielmat, char orname, double orab, ITG ielorien, char amname, double amta, ITG namta, ITG nam, ITG nmethod, ITG iamforc, ITG iamload, ITG iamt1, ITG ithermal, ITG iperturb, ITG istat, ITG istep, ITG nmat, ITG ntmat_, ITG norien, double prestr, ITG iprestr, ITG isolver, double fei, double veold, double timepar, double xmodal, char filab, ITG jout, ITG nlabel, ITG idrct, ITG jmax, ITG iexpl, double alpha, ITG iamboun, double plicon, ITG nplicon, double plkcon, ITG nplkcon, ITG iplas, ITG npmat_, ITG mi, ITG nk_, double trab, ITG inotr, ITG ntrans, ITG ikboun, ITG ilboun, ITG ikmpc, ITG ilmpc, ITG ics, double dcs, ITG ncs_, ITG namtot_, double cs, ITG nstate_, ITG ncmat_, ITG iumat, ITG mcs, char labmpc, ITG iponor, double xnor, ITG knor, double thickn, double thicke, ITG ikforc, ITG ilforc, double offset, ITG iponoel, ITG inoel, ITG rig, ITG infree, ITG nshcon, double shcon, double cocon, ITG ncocon, double physcon, ITG nflow, double ctrl, ITG maxlenmpc, ITG ne1d, ITG ne2d, ITG nener, double vold, ITG nodebounold, ITG ndirbounold, double xbounold, double xforcold, double xloadold, double t1old, double eme, double sti, double ener, double xstate, char jobnamec, ITG irstrt, double ttime, double qaold, char output, char typeboun, char inpc, ITG ipoinp, ITG inp, char tieset, double tietol, ITG ntie, double fmpc, char cbody, ITG ibody, double xbody, ITG nbody, ITG nbody_, double xbodyold, ITG nam_, ITG ielprop, ITG nprop, ITG nprop_, double prop, ITG itpamp, ITG iviewfile, ITG ipoinpc, ITG cfd, ITG nslavs, double t0g, double t1g, ITG network, ITG cyclicsymmetry, ITG idefforc, ITG idefload, ITG idefbody, ITG mortar, ITG ifacecount, ITG islavsurf, double pslavsurf, double clearini, char heading, ITG iaxial, ITG nobject, char objectset, ITG nprint_, ITG iuel, ITG nuel_, ITG nodempcref, double coefmpcref, ITG ikmpcref, ITG memmpcref_, ITG mpcfreeref, ITG maxlenmpcref, ITG memmpc_)
	)

◆ FORTRAN() [56/316]

void FORTRAN	(	cataloguenodes	,
		(ITG iponofa, ITG inofa, ITG ifreefa, ITG ielfa, ITG ifaboun, ITG ipkon, ITG kon, char lakon, ITG nface, ITG ne)
	)

◆ FORTRAN() [57/316]

void FORTRAN	(	checkconstraint	,
		(ITG nobject, char objectset, double g0, ITG nactive, ITG nnlconst, ITG ipoacti, ITG ndesi, double dgdxglob, ITG nk, ITG nodedesi)
	)

◆ FORTRAN() [58/316]

void FORTRAN	(	checkimpacts	,
		(ITG ne, ITG neini, double temax, double sizemaxinc, double energyref, double tmin, double tper, ITG idivergence, ITG idirinctime, ITG istab, double dtheta, double enres, double energy, double energyini, double allwk, double allwkini, double dampwk, double dampwkini, double emax, ITG mortar, double maxdecay, double enetoll)
	)

◆ FORTRAN() [59/316]

void FORTRAN	(	checkinputvaluesnet	,
		(ITG ieg, ITG nflow, double prop, ITG ielprop, char *lakon)
	)

◆ FORTRAN() [60/316]

void FORTRAN	(	checktime	,
		(ITG itpamp, ITG namta, double tinc, double ttime, double amta, double tmin, ITG inext, ITG itp, ITG istep, double tper)
	)

◆ FORTRAN() [61/316]

void FORTRAN	(	checktruecontact	,
		(ITG ntie, char tieset, double tietol, double elcon, ITG itruecontact, ITG ncmat_, ITG *ntmat_)
	)

◆ FORTRAN() [62/316]

void FORTRAN	(	closefile	,
		()
	)

◆ FORTRAN() [63/316]

void FORTRAN	(	closefilefluid	,
		()
	)

◆ FORTRAN() [64/316]

void FORTRAN	(	complete_hel	,
		(ITG neq, double b, double hel, double ad, double au, ITG jq, ITG irow, ITG nzs)
	)

◆ FORTRAN() [65/316]

void FORTRAN	(	complete_hel_blk	,
		(double vel, double hel, double auv6, ITG ipnei, ITG neiel, ITG nef, ITG *nactdohinv)
	)

◆ FORTRAN() [66/316]

void FORTRAN	(	complete_hel_cyclic	,
		(ITG neq, double b, double hel, double ad, double au, ITG jq, ITG irow, ITG ipnei, ITG neiel, ITG ifatie, double c, char lakonf, ITG neifa, ITG nzs)
	)

◆ FORTRAN() [67/316]

void FORTRAN	(	complete_hel_cyclic_blk	,
		(double vel, double hel, double auv6, double c, ITG ipnei, ITG neiel, ITG neifa, ITG ifatie, ITG *nef)
	)

◆ FORTRAN() [68/316]

void FORTRAN	(	convert2slapcol	,
		(double au, double ad, ITG jq, ITG nzs, ITG nef, double aua)
	)

◆ FORTRAN() [69/316]

void FORTRAN	(	coriolissolve	,
		(double cc, ITG nev, double aa, double bb, double xx, double eiga, double eigb, double eigxx, ITG iter, double d, double *temp)
	)

◆ FORTRAN() [70/316]

void FORTRAN	(	correctvel	,
		(double hel, double adv, double vfa, ITG ipnei, double area, double bv, double xxn, ITG neifa, char lakon, ITG ne, ITG *neq)
	)

◆ FORTRAN() [71/316]

void FORTRAN	(	correctvfa	,
		(ITG nface, ITG ielfa, double area, double vfa, double ap, double bp, double xxn, ITG ifabou, ITG ipnei, ITG nef, ITG neifa, double hfa, double vel, double xboun, char lakonf, double flux)
	)

◆ FORTRAN() [72/316]

void FORTRAN	(	createfint	,
		(ITG ne, ITG ipkon, char lakon, ITG kon, ITG nactdof, ITG mi, double fn0, double fint)
	)

◆ FORTRAN() [73/316]

void FORTRAN	(	createialdesi	,
		(ITG ndesi, ITG nodedesi, ITG iponoel, ITG inoel, ITG istartdesi, ITG ialdesi, char lakon, ITG ipkon, ITG kon, ITG nodedesiinv, ITG icoordinate, ITG noregion)
	)

◆ FORTRAN() [74/316]

void FORTRAN	(	createialelem	,
		(ITG ne, ITG istartelem, ITG ialelem, ITG ipoeldi, ITG *ieldi)
	)

◆ FORTRAN() [75/316]

void FORTRAN	(	createinterfacempcs	,
		(ITG imastnode, double xmastnor, ITG nmastnode, ITG ikmpc, ITG ilmpc, ITG nmpc, ITG ipompc, ITG nodempc, double coefmpc, char labmpc, ITG mpcfree, ITG ikboun, ITG *nboun)
	)

◆ FORTRAN() [76/316]

void FORTRAN	(	createinum	,
		(ITG ipkon, ITG inum, ITG kon, char lakon, ITG nk, ITG ne, char cflag, ITG nelemload, ITG nload, ITG nodeboun, ITG nboun, ITG ndirboun, ITG ithermal, double co, double vold, ITG mi, ITG *ielmat)
	)

◆ FORTRAN() [77/316]

void FORTRAN	(	createmddof	,
		(ITG imddof, ITG nmddof, ITG istartset, ITG iendset, ITG ialset, ITG nactdof, ITG ithermal, ITG mi, ITG imdnode, ITG nmdnode, ITG ikmpc, ITG ilmpc, ITG ipompc, ITG nodempc, ITG nmpc, ITG imdmpc, ITG nmdmpc, ITG imdboun, ITG nmdboun, ITG ikboun, ITG nboun, ITG nset, ITG ntie, char tieset, char set, char lakon, ITG kon, ITG ipkon, char labmpc, ITG ilboun, char filab, char prlab, char prset, ITG nprint, ITG ne, ITG cyclicsymmetry)
	)

◆ FORTRAN() [78/316]

void FORTRAN	(	createmdelem	,
		(ITG imdnode, ITG nmdnode, double xforc, ITG ikmpc, ITG ilmpc, ITG ipompc, ITG nodempc, ITG nmpc, ITG imddof, ITG nmddof, ITG nactdof, ITG mi, ITG imdmpc, ITG nmdmpc, ITG imdboun, ITG nmdboun, ITG ikboun, ITG nboun, ITG ilboun, ITG ithermal, ITG imdelem, ITG nmdelem, ITG iponoel, ITG inoel, char prlab, char prset, ITG nprint, char lakon, char set, ITG nset, ITG ialset, ITG ipkon, ITG kon, ITG istartset, ITG iendset, ITG nforc, ITG ikforc, ITG ilforc)
	)

◆ FORTRAN() [79/316]

void FORTRAN	(	createtiedsurfs	,
		(ITG nodface, ITG ipoface, char set, ITG istartset, ITG iendset, ITG ialset, char tieset, ITG inomat, ITG ne, ITG ipkon, char lakon, ITG kon, ITG ntie, double tietol, ITG nalset, ITG nk, ITG nset, ITG iactive)
	)

◆ FORTRAN() [80/316]

void FORTRAN	(	create_iau6	,
		(ITG nef, ITG ipnei, ITG neiel, ITG jq, ITG irow, ITG nzs, ITG iau6, char lakonf)
	)

◆ FORTRAN() [81/316]

void FORTRAN	(	dattime	,
		(char date, char clock)
	)

◆ FORTRAN() [82/316]

void FORTRAN	(	desiperelem	,
		(ITG ndesi, ITG istartdesi, ITG ialdesi, ITG ipoeldi, ITG ieldi, ITG ne)
	)

◆ FORTRAN() [83/316]

void FORTRAN	(	dgesv	,
		(ITG nteq, ITG nhrs, double ac, ITG lda, ITG ipiv, double bc, ITG ldb, ITG info)
	)

◆ FORTRAN() [84/316]

void FORTRAN	(	dgetrs	,
		(char trans, ITG nteq, ITG nrhs, double ac, ITG lda, ITG ipiv, double bc, ITG ldb, ITG *info)
	)

◆ FORTRAN() [85/316]

void FORTRAN	(	drfftf	,
		(ITG ndata, double r, double wsave, ITG isave)
	)

◆ FORTRAN() [86/316]

void FORTRAN	(	drffti	,
		(ITG ndata, double wsave, ITG *isave)
	)

◆ FORTRAN() [87/316]

void FORTRAN	(	dnaupd	,
		(ITG ido, char bmat, ITG n, char which, ITG nev, double tol, double resid, ITG ncv, double z, ITG ldz, ITG iparam, ITG ipntr, double workd, double workl, ITG lworkl, ITG info)
	)

◆ FORTRAN() [88/316]

void FORTRAN	(	dsaupd	,
		(ITG ido, char bmat, ITG n, char which, ITG nev, double tol, double resid, ITG ncv, double z, ITG ldz, ITG iparam, ITG ipntr, double workd, double workl, ITG lworkl, ITG info)
	)

◆ FORTRAN() [89/316]

void FORTRAN	(	dneupd	,
		(ITG rvec, char howmny, ITG select, double d, double di, double z, ITG ldz, double sigma, double sigmai, double workev, char bmat, ITG neq, char which, ITG nev, double tol, double resid, ITG ncv, double v, ITG ldv, ITG iparam, ITG ipntr, double workd, double workl, ITG lworkl, ITG *info)
	)

◆ FORTRAN() [90/316]

void FORTRAN	(	dseupd	,
		(ITG rvec, char howmny, ITG select, double d, double z, ITG ldz, double sigma, char bmat, ITG neq, char which, ITG nev, double tol, double resid, ITG ncv, double v, ITG ldv, ITG iparam, ITG ipntr, double workd, double workl, ITG lworkl, ITG info)
	)

◆ FORTRAN() [91/316]

void FORTRAN	(	dsort	,
		(double dx, ITG iy, ITG n, ITG kflag)
	)

◆ FORTRAN() [92/316]

void FORTRAN	(	dynresults	,
		(ITG nk, double v, ITG ithermal, ITG nactdof, double vold, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, char labmpc, ITG nmpc, double b, double bp, double veold, double dtime, ITG mi, ITG imdnode, ITG nmdnode, ITG imdboun, ITG nmdboun, ITG imdmpc, ITG nmdmpc, ITG nmethod, double *time)
	)

◆ FORTRAN() [93/316]

void FORTRAN	(	effectivemodalmass	,
		(ITG neq, ITG nactdof, ITG mi, double adb, double aub, ITG jq, ITG irow, ITG nev, double z, double co, ITG *nk)
	)

◆ FORTRAN() [94/316]

void FORTRAN	(	elementpernode	,
		(ITG iponoel, ITG inoel, char lakon, ITG ipkon, ITG kon, ITG ne, ITG *inoelsize)
	)

◆ FORTRAN() [95/316]

void FORTRAN	(	elementperorien	,
		(ITG ipoorel, ITG iorel, ITG ielorien, ITG ne, ITG *mi)
	)

◆ FORTRAN() [96/316]

void FORTRAN	(	envtemp	,
		(ITG itg, ITG ieg, ITG ntg, ITG ntr, char sideload, ITG nelemload, ITG ipkon, ITG kon, char lakon, ITG ielmat, ITG ne, ITG nload, ITG kontri, ITG ntri, ITG nloadtr, ITG nflow, ITG ndirboun, ITG nactdog, ITG nodeboun, ITG nacteq, ITG nboun, ITG ielprop, double prop, ITG nteq, double v, ITG network, double physcon, double shcon, ITG ntmat_, double co, double vold, char set, ITG nshcon, double rhcon, ITG nrhcon, ITG mi, ITG nmpc, ITG nodempc, ITG ipompc, char labmpc, ITG ikboun, ITG nasym, double ttime, double time, ITG *iaxial)
	)

◆ FORTRAN() [97/316]

void FORTRAN	(	equationcheck	,
		(double ac, ITG nteq, ITG nactdog, ITG itg, ITG ntg, ITG nacteq, ITG *network)
	)

◆ FORTRAN() [98/316]

void FORTRAN	(	errorestimator	,
		(double yi, double yn, ITG ipkon, ITG kon, char lakon, ITG nk, ITG ne, ITG mi, ITG ielmat, ITG nterms, ITG inum, double co, double vold, char cflag)
	)

◆ FORTRAN() [99/316]

void FORTRAN	(	rotationvector	,
		(double a, double euler)
	)

◆ FORTRAN() [100/316]

void FORTRAN	(	rotationvectorinv	,
		(double a, double euler)
	)

◆ FORTRAN() [101/316]

void FORTRAN	(	extrapolate	,
		(double sti, double stn, ITG ipkon, ITG inum, ITG kon, char lakon, ITG nfield, ITG nk, ITG ne, ITG mi, ITG ndim, double orab, ITG ielorien, double co, ITG iorienglob, char cflag, double vold, ITG force, ITG ielmat, double thicke, ITG ielprop, double prop)
	)

◆ FORTRAN() [102/316]

void FORTRAN	(	extrapolate_ad_h	,
		(ITG nface, ITG ielfa, double xrlfa, double ad, double adfa, double hel, double hfa, ITG icyclic, double c, ITG ifatie)
	)

◆ FORTRAN() [103/316]

void FORTRAN	(	extrapolate_ad_h_comp	,
		(ITG nface, ITG ielfa, double xrlfa, double ad, double adfa, double hel, double hfa, ITG icyclic, double c, ITG ifatie)
	)

◆ FORTRAN() [104/316]

void FORTRAN	(	extrapolatefluid	,
		(ITG nk, ITG iponofa, ITG inofa, ITG inum, double vfa, double v, ITG ielfa, ITG ithermal, ITG imach, ITG ikappa, double xmach, double xkappa, double shcon, ITG nshcon, ITG ntmat_, ITG ielmatf, double physcon, ITG mi, ITG iturb, double xturb)
	)

◆ FORTRAN() [105/316]

void FORTRAN	(	extrapolate_gradkel	,
		(ITG nface, ITG ielfa, double xrlfa, double gradkel, double gradkfa, ITG icyclic, double c, ITG ifatie)
	)

◆ FORTRAN() [106/316]

void FORTRAN	(	extrapolate_gradoel	,
		(ITG nface, ITG ielfa, double xrlfa, double gradoel, double gradofa, ITG icyclic, double c, ITG ifatie)
	)

◆ FORTRAN() [107/316]

void FORTRAN	(	extrapolate_gradtel	,
		(ITG nface, ITG ielfa, double xrlfa, double gradtel, double gradtfa, ITG icyclic, double c, ITG ifatie)
	)

◆ FORTRAN() [108/316]

void FORTRAN	(	extrapolate_gradvel	,
		(ITG nface, ITG ielfa, double xrlfa, double gradv, double gradvfa, ITG icyclic, double c, ITG ifatie)
	)

◆ FORTRAN() [109/316]

void FORTRAN	(	extrapolate_kel	,
		(ITG nface, ITG ielfa, double xrlfa, double vel, double vfa, ITG ifabou, double xboun, ITG ipnei, ITG nef, double physcon, double *umfa)
	)

◆ FORTRAN() [110/316]

void FORTRAN	(	extrapolate_oel	,
		(ITG nface, ITG ielfa, double xrlfa, double vel, double vfa, ITG ifabou, double xboun, ITG ipnei, ITG nef, double physcon, double umfa, double dy)
	)

◆ FORTRAN() [111/316]

void FORTRAN	(	extrapolate_pel	,
		(ITG nface, ITG ielfa, double xrlfa, double vel, double vfa, ITG ifabou, double xboun, ITG nef)
	)

◆ FORTRAN() [112/316]

void FORTRAN	(	extrapolate_tel	,
		(ITG nface, ITG ielfa, double xrlfa, double vel, double vfa, ITG ifabou, double xboun, ITG ipnei, ITG *nef)
	)

◆ FORTRAN() [113/316]

void FORTRAN	(	extrapolate_vel	,
		(ITG nface, ITG ielfa, double xrlfa, double vel, double vfa, ITG ifabou, double xboun, ITG ipnei, ITG nef, ITG icyclic, double c, ITG ifatie, double *xxn)
	)

◆ FORTRAN() [114/316]

void FORTRAN	(	extrapol_kel	,
		(ITG nface, ITG ielfa, double xrlfa, double vel, double vfa, ITG ifabou, double xbounact, ITG nef, double gradtel, double gradtfa, ITG neifa, double rf, double area, double volume, double xle, double xxi, ITG icyclic, double xxn, ITG ipnei, ITG ifatie, double xlet, double xxj, double coefmpc, ITG nmpc, char labmpc, ITG ipompc, ITG nodempc, ITG ifaext, ITG nfaext, ITG nactdoh, double umfa, double physcon)
	)

◆ FORTRAN() [115/316]

void FORTRAN	(	extrapol_oel	,
		(ITG nface, ITG ielfa, double xrlfa, double vel, double vfa, ITG ifabou, double xbounact, ITG nef, double gradtel, double gradtfa, ITG neifa, double rf, double area, double volume, double xle, double xxi, ITG icyclic, double xxn, ITG ipnei, ITG ifatie, double xlet, double xxj, double coefmpc, ITG nmpc, char labmpc, ITG ipompc, ITG nodempc, ITG ifaext, ITG nfaext, ITG nactdoh, double umfa, double physcon, double *dy)
	)

◆ FORTRAN() [116/316]

void FORTRAN	(	extrapol_pel	,
		(ITG nface, ITG ielfa, double xrlfa, double vel, double vfa, ITG ifabou, double xbounact, ITG nef, double gradpel, double gradpfa, ITG neifa, double rf, double area, double volume, double xle, double xxi, ITG icyclic, double xxn, ITG ipnei, ITG ifatie, double coefmpc, ITG nmpc, char labmpc, ITG ipompc, ITG nodempc, ITG ifaext, ITG nfaext, ITG nactdoh)
	)

◆ FORTRAN() [117/316]

void FORTRAN	(	extrapol_tel	,
		(ITG nface, ITG ielfa, double xrlfa, double vel, double vfa, ITG ifabou, double xbounact, ITG nef, double gradtel, double gradtfa, ITG neifa, double rf, double area, double volume, double xle, double xxi, ITG icyclic, double xxn, ITG ipnei, ITG ifatie, double xload, double xlet, double xxj, double coefmpc, ITG nmpc, char labmpc, ITG ipompc, ITG nodempc, ITG ifaext, ITG nfaext, ITG *nactdoh)
	)

◆ FORTRAN() [118/316]

void FORTRAN	(	extrapol_vel	,
		(ITG nface, ITG ielfa, double xrlfa, double vel, double vfa, ITG ifabou, double xbounact, ITG ipnei, ITG nef, ITG icyclic, double c, ITG ifatie, double xxn, double gradvel, double gradvfa, ITG neifa, double rf, double area, double volume, double xle, double xxi, double xxj, double xlet, double coefmpc, ITG nmpc, char labmpc, ITG ipompc, ITG nodempc, ITG ifaext, ITG nfaext, ITG *nactdoh)
	)

◆ FORTRAN() [119/316]

void FORTRAN	(	facepernode	,
		(ITG iponoelfa, ITG inoelfa, char lakonfa, ITG ipkonfa, ITG konfa, ITG nsurfs, ITG *inoelsize)
	)

◆ FORTRAN() [120/316]

void FORTRAN	(	fcrit	,
		(double time, double tend, double aai, double bbi, double zetaj, double dj, double ddj, double h1, double h2, double h3, double h4, double func, double *funcp)
	)

◆ FORTRAN() [121/316]

void FORTRAN	(	fill_neiel	,
		(ITG nef, ITG ipnei, ITG neiel, ITG neielcp)
	)

◆ FORTRAN() [122/316]

void FORTRAN	(	filter	,
		(double dgdxglob, ITG nobject, ITG nk, ITG nodedesi, ITG ndesi, char objectset, double xo, double yo, double zo, double x, double y, double z, ITG nx, ITG ny, ITG nz, ITG neighbor, double r, ITG ndesia, ITG *ndesib)
	)

◆ FORTRAN() [123/316]

void FORTRAN	(	findsurface	,
		(ITG ipoface, ITG nodface, ITG ne, ITG ipkon, ITG kon, char lakon, ITG ntie, char tieset)
	)

◆ FORTRAN() [124/316]

void FORTRAN	(	findsurface_se	,
		(ITG nodface, ITG ipoface, ITG ne, ITG ipkon, char lakon, ITG kon, ITG konfa, ITG ipkonfa, ITG nk, char lakonfa, ITG *nsurfs)
	)

◆ FORTRAN() [125/316]

void FORTRAN	(	flowoutput	,
		(ITG itg, ITG ieg, ITG ntg, ITG nteq, double bc, char lakon, ITG ntmat_, double v, double shcon, ITG nshcon, ITG ipkon, ITG kon, double co, ITG nflow, double dtime, double ttime, double time, ITG ielmat, double prop, ITG ielprop, ITG nactdog, ITG nacteq, ITG iin, double physcon, double camt, double camf, double camp, double rhcon, ITG nrhcon, double vold, char jobnamef, char set, ITG istartset, ITG iendset, ITG ialset, ITG nset, ITG mi, ITG iaxial, ITG istep, ITG iit)
	)

◆ FORTRAN() [126/316]

void FORTRAN	(	flowresult	,
		(ITG ntg, ITG itg, double cam, double vold, double v, ITG nload, char sideload, ITG nelemload, double xloadact, ITG nactdog, ITG network, ITG mi, ITG ne, ITG ipkon, char lakon, ITG kon)
	)

◆ FORTRAN() [127/316]

void FORTRAN	(	forcesolve	,
		(double zc, ITG nev, double aa, double bb, double xx, double eiga, double eigb, double eigxx, ITG iter, double d, ITG neq, double z, ITG istartnmd, ITG iendnmd, ITG nmd, ITG cyclicsymmetry, ITG neqact, ITG igeneralizedforce)
	)

◆ FORTRAN() [128/316]

void FORTRAN	(	formgradient	,
		(ITG istartdesi, ITG ialdesi, ITG ipkon, char lakon, ITG ipoface, ITG ndesi, ITG nodedesi, ITG nodface, ITG kon, double co, double dgdx, ITG nobject, double weightformgrad, ITG nodedesiinv, ITG noregion, char objectset, double dgdxglob, ITG nk)
	)

◆ FORTRAN() [129/316]

void FORTRAN	(	formgradinterpol	,
		(ITG ipkon, char lakon, ITG kon, ITG nobject, double dgdxglob, double xinterpol, ITG nnodes, ITG ne, ITG nk, ITG nodedesiinv, char *objectset)
	)

◆ FORTRAN() [130/316]

void FORTRAN	(	frdfluid	,
		(double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, double v, ITG kode, double time, ITG ielmatf, char matname, char filab, ITG inum, ITG ntrans, ITG inotr, double trab, ITG mi, ITG istep, double stn, double qfn, ITG nactdofinv, double xmach, double xkappa, double physcon, double *xturb)
	)

◆ FORTRAN() [131/316]

void FORTRAN	(	frditeration	,
		(double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, double v, double time, ITG ielmat, char matname, ITG mi, ITG istep, ITG iinc, ITG ithermal)
	)

◆ FORTRAN() [132/316]

void FORTRAN	(	frictionheating	,
		(ITG ne0, ITG ne, ITG ipkon, char lakon, ITG ielmat, ITG mi, double elcon, ITG ncmat_, ITG ntmat_, ITG kon, ITG islavsurf, double pmastsurf, double springarea, double co, double vold, double veold, double pslavsurf, double xload, ITG nload, ITG nload_, ITG nelemload, ITG iamload, ITG idefload, char sideload, double stx, ITG nam)
	)

◆ FORTRAN() [133/316]

void FORTRAN	(	fsub	,
		(double time, double tend, double aai, double bbi, double ddj, double h1, double h2, double h3, double h4, double func, double *funcp)
	)

◆ FORTRAN() [134/316]

void FORTRAN	(	fsuper	,
		(double time, double tend, double aai, double bbi, double h1, double h2, double h3, double h4, double h5, double h6, double func, double funcp)
	)

◆ FORTRAN() [135/316]

void FORTRAN	(	gasmechbc	,
		(double vold, ITG nload, char sideload, ITG nelemload, double xload, ITG mi)
	)

◆ FORTRAN() [136/316]

void FORTRAN	(	genadvecelem	,
		(ITG inodesd, ITG ipkon, ITG ne, char lakon, ITG kon, ITG nload, char sideload, ITG nelemload, ITG nkon, ITG network)
	)

◆ FORTRAN() [137/316]

void FORTRAN	(	gencontelem_f2f	,
		(char tieset, ITG ntie, ITG itietri, ITG ne, ITG ipkon, ITG kon, char lakon, double cg, double straight, ITG ifree, ITG koncont, double co, double vold, double xo, double yo, double zo, double x, double y, double z, ITG nx, ITG ny, ITG nz, ITG ielmat, double elcon, ITG istep, ITG iinc, ITG iit, ITG ncmat_, ITG ntmat_, ITG mi, ITG imastop, ITG islavsurf, ITG itiefac, double springarea, double tietol, double reltime, char filab, ITG nasym, double pslavsurf, double pmastsurf, double clearini, double theta, double xstateini, double xstate, ITG nstate_, ITG ne0, ITG icutb, ITG ialeatoric, ITG nmethod, char jobnamef)
	)

◆ FORTRAN() [138/316]

void FORTRAN	(	gencontelem_n2f	,
		(char tieset, ITG ntie, ITG itietri, ITG ne, ITG ipkon, ITG kon, char lakon, double cg, double straight, ITG ifree, ITG koncont, double co, double vold, double xo, double yo, double zo, double x, double y, double z, ITG nx, ITG ny, ITG nz, ITG ielmat, double elcon, ITG istep, ITG iinc, ITG iit, ITG ncmat_, ITG ntmat_, ITG nmethod, ITG mi, ITG imastop, ITG nslavnode, ITG islavnode, ITG islavsurf, ITG itiefac, double areaslav, ITG iponoels, ITG inoels, double springarea, char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, double tietol, double reltime, char filab, ITG nasym, double xnoels, ITG icutb, ITG ne0, char *jobnamef)
	)

◆ FORTRAN() [139/316]

void FORTRAN	(	generateeminterfaces	,
		(ITG istartset, ITG iendset, ITG ialset, ITG iactive, ITG ipkon, char lakon, ITG kon, ITG ikmpc, ITG nmpc, ITG nafaces)
	)

◆ FORTRAN() [140/316]

void FORTRAN	(	generatetet	,
		(ITG kontet, ITG ifatet, ITG netet, ITG inodfa, ITG ifreefa, double planfa, ITG ipofa, ITG nodes, double *cotet)
	)

◆ FORTRAN() [141/316]

void FORTRAN	(	gennactdofinv	,
		(ITG nactdof, ITG nactdofinv, ITG nk, ITG mi, ITG nodorig, ITG ipkon, char lakon, ITG kon, ITG *ne)
	)

◆ FORTRAN() [142/316]

void FORTRAN	(	gentiedmpc	,
		(char tieset, ITG ntie, ITG itietri, ITG ipkon, ITG kon, char lakon, char set, ITG istartset, ITG iendset, ITG ialset, double cg, double straight, ITG koncont, double co, double xo, double yo, double zo, double x, double y, double z, ITG nx, ITG ny, ITG nz, ITG nset, ITG ifaceslave, ITG istartfield, ITG iendfield, ITG ifield, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, ITG nmpc_, ITG mpcfree, ITG ikmpc, ITG ilmpc, char labmpc, ITG ithermal, double tietol, ITG icfd, ITG ncont, ITG imastop, ITG ikboun, ITG nboun, char *kind)
	)

◆ FORTRAN() [143/316]

void FORTRAN	(	geomview	,
		(double vold, double co, double pmid, double e1, double e2, double e3, ITG kontri, double area, double cs, ITG mcs, ITG inocs, ITG ntrit, ITG nk, ITG mi, double *sidemean)
	)

◆ FORTRAN() [144/316]

void FORTRAN	(	getdesiinfo	,
		(char set, ITG istartset, ITG iendset, ITG ialset, ITG nset, ITG mi, ITG nactdof, ITG ndesi, ITG nodedesi, ITG ntie, char tieset, ITG itmp, ITG nmpc, ITG nodempc, ITG ipompc, ITG nodedesiinv, ITG iponoel, ITG inoel, char lakon, ITG ipkon, ITG kon, ITG noregion, ITG ipoface, ITG nodface, ITG *nk)
	)

◆ FORTRAN() [145/316]

void FORTRAN	(	identamta	,
		(double amta, double reftime, ITG istart, ITG iend, ITG *id)
	)

◆ FORTRAN() [146/316]

void FORTRAN	(	identifytiedface	,
		(char tieset, ITG ntie, char set, ITG nset, ITG faceslave, char kind)
	)

◆ FORTRAN() [147/316]

void FORTRAN	(	includefilename	,
		(char buff, char includefn, ITG *lincludefn)
	)

◆ FORTRAN() [148/316]

void FORTRAN	(	inicalcbody	,
		(ITG nef, double body, ITG ipobody, ITG ibody, double xbody, double coel, double vel, char lakon, ITG nactdohinv, ITG icent)
	)

◆ FORTRAN() [149/316]

void FORTRAN	(	init	,
		(ITG nktet, ITG inodfa, ITG ipofa, ITG netet_)
	)

◆ FORTRAN() [150/316]

void FORTRAN	(	initialcfd	,
		(ITG ne, ITG ipkon, ITG kon, char lakon, double co, double coel, double cofa, ITG nface, ITG ielfa, double area, ITG ipnei, ITG neiel, double xxn, double xxi, double xle, double xlen, double xlet, double xrlfa, double cosa, double volume, ITG neifa, double xxj, double cosb, double dmin, ITG ifatie, double cs, char tieset, ITG icyclic, double c, ITG neij, double physcon, ITG isolidsurf, ITG nsolidsurf, double dy, double xxni, double xxnj, double xxicn, ITG nflnei, ITG iturbulent, double rf)
	)

◆ FORTRAN() [151/316]

void FORTRAN	(	initialchannel	,
		(ITG itg, ITG ieg, ITG ntg, double ac, double bc, char lakon, double v, ITG ipkon, ITG kon, ITG nflow, ITG ikboun, ITG nboun, double prop, ITG ielprop, ITG nactdog, ITG ndirboun, ITG nodeboun, double xbounact, ITG ielmat, ITG ntmat_, double shcon, ITG nshcon, double physcon, ITG ipiv, ITG nteq, double rhcon, ITG nrhcon, ITG ipobody, ITG ibody, double xbody, double co, ITG nbody, ITG network, ITG iin_abs, double vold, char set, ITG istep, ITG iit, ITG mi, ITG ineighe, ITG ilboun, double ttime, double time, ITG iaxial)
	)

◆ FORTRAN() [152/316]

void FORTRAN	(	initialnet	,
		(ITG itg, ITG ieg, ITG ntg, double ac, double bc, char lakon, double v, ITG ipkon, ITG kon, ITG nflow, ITG ikboun, ITG nboun, double prop, ITG ielprop, ITG nactdog, ITG ndirboun, ITG nodeboun, double xbounact, ITG ielmat, ITG ntmat_, double shcon, ITG nshcon, double physcon, ITG ipiv, ITG nteq, double rhcon, ITG nrhcon, ITG ipobody, ITG ibody, double xbody, double co, ITG nbody, ITG network, ITG iin_abs, double vold, char set, ITG istep, ITG iit, ITG mi, ITG ineighe, ITG ilboun, ITG channel, ITG iaxial, ITG nmpc, char labmpc, ITG ipompc, ITG nodempc, double coefmpc, double ttime, double time, ITG iponoel, ITG inoel)
	)

◆ FORTRAN() [153/316]

void FORTRAN	(	integral_boundary	,
		(double sumfix, double sumfree, ITG ifaext, ITG nfaext, ITG ielfa, ITG ifabou, double vfa, ITG ipnei, double *xxn)
	)

◆ FORTRAN() [154/316]

void FORTRAN	(	interpolatestate	,
		(ITG ne, ITG ipkon, ITG kon, char lakon, ITG ne0, ITG mi, double xstate, double pslavsurf, ITG nstate_, double xstateini, ITG islavsurf, ITG islavsurfold, double pslavsurfold, char tieset, ITG ntie, ITG itiefac)
	)

◆ FORTRAN() [155/316]

void FORTRAN	(	islavactive	,
		(char tieset, ITG ntie, ITG itietri, double cg, double straight, double co, double vold, double xo, double yo, double zo, double x, double y, double z, ITG nx, ITG ny, ITG nz, ITG mi, ITG imastop, ITG nslavnode, ITG islavnode, ITG *islavact)
	)

◆ FORTRAN() [156/316]

void FORTRAN	(	isortid	,
		(ITG ix, double dy, ITG n, ITG kflag)
	)

◆ FORTRAN() [157/316]

void FORTRAN	(	isortii	,
		(ITG ix, ITG iy, ITG n, ITG kflag)
	)

◆ FORTRAN() [158/316]

void FORTRAN	(	isortiid	,
		(ITG ix, ITG iy, double dy, ITG n, ITG *kflag)
	)

◆ FORTRAN() [159/316]

void FORTRAN	(	isortiddc	,
		(ITG ix, double dy1, double dy2, char cy, ITG n, ITG kflag)
	)

◆ FORTRAN() [160/316]

void FORTRAN	(	isortiiddc	,
		(ITG ix1, ITG ix2, double dy1, double dy2, char cy, ITG n, ITG *kflag)
	)

◆ FORTRAN() [161/316]

void FORTRAN	(	jouleheating	,
		(ITG ipkon, char lakon, ITG kon, double co, double elcon, ITG nelcon, ITG mi, ITG ne, double sti, ITG ielmat, ITG nelemload, char sideload, double xload, ITG nload, ITG nload_, ITG iamload, ITG nam, ITG idefload, ITG ncmat_, ITG ntmat_, double alcon, ITG nalcon, ITG ithermal, double vold, double *t1)
	)

◆ FORTRAN() [162/316]

void FORTRAN	(	keystart	,
		(ITG ifreeinp, ITG ipoinp, ITG inp, char name, ITG iline, ITG ikey)
	)

◆ FORTRAN() [163/316]

void FORTRAN	(	mafillcorio	,
		(double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemload, char sideload, double xload, ITG nload, double xbody, ITG ipobody, ITG nbody, double cgr, double ad, double au, ITG nactdof, ITG icol, ITG jq, ITG irow, ITG neq, ITG nzl, ITG nmethod, ITG ikmpc, ITG ilmpc, ITG ikboun, ITG ilboun, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, double prestr, ITG iprestr, double vold, ITG iperturb, double sti, ITG nzs, double stx, double adb, double aub, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstiff, ITG npmat_, double dtime, char matname, ITG mi, ITG ncmat_, double ttime, double time, ITG istep, ITG kinc, ITG ibody, ITG ielprop, double *prop)
	)

◆ FORTRAN() [164/316]

void FORTRAN	(	mafilldm	,
		(double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemload, char sideload, double xload, ITG nload, double xbody, ITG ipobody, ITG nbody, double cgr, double ad, double au, ITG nactdof, ITG icol, ITG jq, ITG irow, ITG neq, ITG nzl, ITG nmethod, ITG ikmpc, ITG ilmpc, ITG ikboun, ITG ilboun, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, double prestr, ITG iprestr, double vold, ITG iperturb, double sti, ITG nzs, double stx, double adb, double aub, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstiff, ITG npmat_, double dtime, char matname, ITG mi, ITG ncmat_, double ttime, double time, ITG istep, ITG kinc, ITG ibody, double clearini, ITG mortar, double springarea, double pslavsurf, double pmastsurf, double reltime, ITG nasym)
	)

◆ FORTRAN() [165/316]

void FORTRAN	(	mafillem	,
		(double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemload, char sideload, double xload, ITG nload, double xbody, ITG ipobody, ITG nbody, double cgr, double ad, double au, double bb, ITG nactdof, ITG icol, ITG jq, ITG irow, ITG neq, ITG nzl, ITG nmethod, ITG ikmpc, ITG ilmpc, ITG ikboun, ITG ilboun, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, double prestr, ITG iprestr, double vold, ITG iperturb, double sti, ITG nzs, double stx, double adb, double aub, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstiff, ITG npmat_, double dtime, char matname, ITG mi, ITG ncmat_, ITG mass, ITG stiffness, ITG buckling, ITG rhs, ITG intscheme, double physcon, double shcon, ITG nshcon, double cocon, ITG ncocon, double ttime, double time, ITG istep, ITG kinc, ITG coriolis, ITG ibody, double xloadold, double reltime, double veold, double springarea, ITG nstate_, double xstateini, double xstate, double thicke, ITG integerglob, double doubleglob, char tieset, ITG istartset, ITG iendset, ITG ialset, ITG ntie, ITG nasym, ITG iactive, double h0, double pslavsurf, double pmastsurf, ITG mortar, double clearini, ITG ielprop, double prop, ITG iponoel, ITG inoel, ITG network)
	)

◆ FORTRAN() [166/316]

void FORTRAN	(	mafillk	,
		(ITG nef, ITG ipnei, ITG neifa, ITG neiel, double vfa, double xxn, double area, double au, double ad, ITG jq, ITG irow, ITG nzs, double b, double vel, double umfa, double xlet, double xle, double gradkfa, double xxi, double body, double volume, ITG ielfa, char lakonf, ITG ifabou, ITG nbody, ITG neq, double dtimef, double velo, double veloo, double cpfa, double hcfa, double cvel, double gradvel, double xload, double gammat, double xrlfa, double xxj, ITG nactdohinv, double a1, double a2, double a3, double flux, ITG nefa, ITG nefb, ITG iau6, double xxni, double xxnj, ITG iturbulent)
	)

◆ FORTRAN() [167/316]

void FORTRAN	(	mafillnet	,
		(ITG itg, ITG ieg, ITG ntg, double ac, ITG nload, char sideload, ITG nelemload, double xloadact, char lakon, ITG ntmat_, double v, double shcon, ITG nshcon, ITG ipkon, ITG kon, double co, ITG nflow, ITG iinc, ITG istep, double dtime, double ttime, double time, ITG ielmat, ITG nteq, double prop, ITG ielprop, ITG nactdog, ITG nacteq, double physcon, double rhcon, ITG nrhcon, ITG ipobody, ITG ibody, double xbody, ITG nbody, double vold, double xloadold, double reltime, ITG nmethod, char set, ITG mi, ITG nmpc, ITG nodempc, ITG ipompc, double coefmpc, char labmpc, ITG iaxial, double cocon, ITG ncocon, ITG iponoel, ITG *inoel)
	)

◆ FORTRAN() [168/316]

void FORTRAN	(	mafillo	,
		(ITG nef, ITG ipnei, ITG neifa, ITG neiel, double vfa, double xxn, double area, double au, double ad, ITG jq, ITG irow, ITG nzs, double b, double vel, double umfa, double xlet, double xle, double gradofa, double xxi, double body, double volume, ITG ielfa, char lakonf, ITG ifabou, ITG nbody, ITG neq, double dtimef, double velo, double veloo, double cpfa, double hcfa, double cvel, double gradvel, double xload, double gammat, double xrlfa, double xxj, ITG nactdohinv, double a1, double a2, double a3, double flux, ITG nefa, ITG nefb, ITG iau6, double xxni, double xxnj, ITG iturbulent, double gradkel, double gradoel)
	)

◆ FORTRAN() [169/316]

void FORTRAN	(	mafillp	,
		(ITG ne, char lakonf, ITG ipnei, ITG neifa, ITG neiel, double vfa, double area, double adfa, double xlet, double cosa, double volume, double au, double ad, ITG jq, ITG irow, double ap, ITG ielfa, ITG ifabou, double xle, double b, double xxn, ITG neq, ITG nzs, double hfa, double gradpel, double bp, double xxi, ITG neij, double xlen, double cosb, ITG nefa, ITG nefb, ITG iau6, double xxicn)
	)

◆ FORTRAN() [170/316]

void FORTRAN	(	mafillpbc	,
		(ITG nef, double au, double ad, ITG jq, ITG irow, double b, ITG iatleastonepressurebc, ITG nzs)
	)

◆ FORTRAN() [171/316]

void FORTRAN	(	mafillpcomp	,
		(ITG ne, char lakonf, ITG ipnei, ITG neifa, ITG neiel, double vfa, double area, double adfa, double xlet, double cosa, double volume, double au, double ad, ITG jq, ITG irow, double ap, ITG ielfa, ITG ifabou, double xle, double b, double xxn, ITG neq, ITG nzs, double hfa, double gradpel, double bp, double xxi, ITG neij, double xlen, double cosb, ITG ielmatf, ITG mi, double a1, double a2, double a3, double velo, double veloo, double dtimef, double shcon, ITG ntmat_, double vel, ITG nactdohinv, double xrlfa, double flux, ITG nefa, ITG nefb, ITG iau6, double xxicn, double *gamma)
	)

◆ FORTRAN() [172/316]

void FORTRAN	(	mafillsm	,
		(double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemload, char sideload, double xload, ITG nload, double xbody, ITG ipobody, ITG nbody, double cgr, double ad, double au, double bb, ITG nactdof, ITG icol, ITG jq, ITG irow, ITG neq, ITG nzl, ITG nmethod, ITG ikmpc, ITG ilmpc, ITG ikboun, ITG ilboun, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, double prestr, ITG iprestr, double vold, ITG iperturb, double sti, ITG nzs, double stx, double adb, double aub, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstiff, ITG npmat_, double dtime, char matname, ITG mi, ITG ncmat_, ITG mass, ITG stiffness, ITG buckling, ITG rhs, ITG intscheme, double physcon, double shcon, ITG nshcon, double cocon, ITG ncocon, double ttime, double time, ITG istep, ITG kinc, ITG coriolis, ITG ibody, double xloadold, double reltime, double veold, double springarea, ITG nstate_, double xstateini, double xstate, double thicke, ITG integerglob, double doubleglob, char tieset, ITG istartset, ITG iendset, ITG ialset, ITG ntie, ITG nasym, double pslavsurf, double pmastsurf, ITG mortar, double clearini, ITG ielprop, double prop, ITG ne0, double fnext, ITG nea, ITG neb, ITG kscale, ITG iponoel, ITG inoel, ITG *network)
	)

◆ FORTRAN() [173/316]

void FORTRAN	(	mafillsmcsse	,
		(double co, ITG kon, ITG ipkon, char lakon, ITG ne, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, ITG nelemload, char sideload, double xload, ITG nload, double xbody, ITG ipobody, ITG nbody, double cgr, ITG nactdof, ITG neq, ITG nmethod, ITG ikmpc, ITG ilmpc, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, ITG iprestr, double vold, ITG iperturb, double sti, double stx, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstiff, ITG npmat_, double dtime, char matname, ITG mi, ITG ncmat_, ITG mass, ITG stiffness, ITG buckling, ITG rhs, ITG intscheme, double physcon, double ttime, double time, ITG istep, ITG iinc, ITG coriolis, ITG ibody, double xloadold, double reltime, double veold, double springarea, ITG nstate_, double xstateini, double xstate, double thicke, ITG integerglob, double doubleglob, char tieset, ITG istartset, ITG iendset, ITG ialset, ITG ntie, ITG nasym, double pslavsurf, double pmastsurf, ITG mortar, double clearini, ITG ielprop, double prop, ITG ne0, ITG nea, ITG neb, double distmin, ITG ndesi, ITG nodedesi, double df, ITG jqs, ITG irows, double dfminds, ITG icoordinate, double dxstiff, double xdesi, ITG istartelem, ITG ialelem, double v, double sigma, char labmpc, ITG ics, double cs, ITG mcs, ITG nk, ITG nzss)
	)

◆ FORTRAN() [174/316]

void FORTRAN	(	mafillsmse	,
		(double co, ITG kon, ITG ipkon, char lakon, ITG ne, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, ITG nelemload, char sideload, double xload, ITG nload, double xbody, ITG ipobody, ITG nbody, double cgr, ITG nactdof, ITG neq, ITG nmethod, ITG ikmpc, ITG ilmpc, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, ITG iprestr, double vold, ITG iperturb, double sti, double stx, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstiff, ITG npmat_, double dtime, char matname, ITG mi, ITG ncmat_, ITG mass, ITG stiffness, ITG buckling, ITG rhs, ITG intscheme, double physcon, double ttime, double time, ITG istep, ITG iinc, ITG coriolis, ITG ibody, double xloadold, double reltime, double veold, double springarea, ITG nstate_, double xstateini, double xstate, double thicke, ITG integerglob, double doubleglob, char tieset, ITG istartset, ITG iendset, ITG ialset, ITG ntie, ITG nasym, double pslavsurf, double pmastsurf, ITG mortar, double clearini, ITG ielprop, double prop, ITG ne0, ITG nea, ITG neb, double distmin, ITG ndesi, ITG nodedesi, double df, ITG jqs, ITG irows, double dfminds, ITG icoordinate, double dxstiff, double xdesi, ITG istartelem, ITG ialelem, double v, double sigma, ITG *ieigenfrequency)
	)

◆ FORTRAN() [175/316]

void FORTRAN	(	mafillsmas	,
		(double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemload, char sideload, double xload, ITG nload, double xbody, ITG ipobody, ITG nbody, double cgr, double ad, double au, double bb, ITG nactdof, ITG icol, ITG jq, ITG irow, ITG neq, ITG nzl, ITG nmethod, ITG ikmpc, ITG ilmpc, ITG ikboun, ITG ilboun, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, double prestr, ITG iprestr, double vold, ITG iperturb, double sti, ITG nzs, double stx, double adb, double aub, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstiff, ITG npmat_, double dtime, char matname, ITG mi, ITG ncmat_, ITG mass, ITG stiffness, ITG buckling, ITG rhs, ITG intscheme, double physcon, double shcon, ITG nshcon, double cocon, ITG ncocon, double ttime, double time, ITG istep, ITG kinc, ITG coriolis, ITG ibody, double xloadold, double reltime, double veold, double springarea, ITG nstate_, double xstateini, double xstate, double thicke, ITG integerglob, double doubleglob, char tieset, ITG istartset, ITG iendset, ITG ialset, ITG ntie, ITG nasym, double pslavsurf, double pmastsurf, ITG mortar, double clearini, ITG ielprop, double prop, ITG ne0, ITG kscale, ITG iponoel, ITG inoel, ITG network)
	)

◆ FORTRAN() [176/316]

void FORTRAN	(	mafillsmas1	,
		(double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemload, char sideload, double xload, ITG nload, double xbody, ITG ipobody, ITG nbody, double cgr, double ad, double au, double bb, ITG nactdof, ITG icol, ITG jq, ITG irow, ITG neq, ITG nzl, ITG nmethod, ITG ikmpc, ITG ilmpc, ITG ikboun, ITG ilboun, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, double prestr, ITG iprestr, double vold, ITG iperturb, double sti, ITG nzs, double stx, double adb, double aub, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstiff, ITG npmat_, double dtime, char matname, ITG mi, ITG ncmat_, ITG mass, ITG stiffness, ITG buckling, ITG rhs, ITG intscheme, double physcon, double shcon, ITG nshcon, double cocon, ITG ncocon, double ttime, double time, ITG istep, ITG kinc, ITG coriolis, ITG ibody, double xloadold, double reltime, double veold, double springarea, ITG nstate_, double xstateini, double xstate, double thicke, ITG integerglob, double doubleglob, char tieset, ITG istartset, ITG iendset, ITG ialset, ITG ntie, ITG nasym, double pslavsurf, double pmastsurf, ITG mortar, double clearini, ITG ielprop, double prop, ITG ne0, ITG nea, ITG neb, ITG *kscale)
	)

◆ FORTRAN() [177/316]

void FORTRAN	(	mafillsmcs	,
		(double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemload, char sideload, double xload, ITG nload, double xbody, ITG ipobody, ITG nbody, double cgr, double ad, double au, double bb, ITG nactdof, ITG icol, ITG jq, ITG irow, ITG neq, ITG nzl, ITG nmethod, ITG ikmpc, ITG ilmpc, ITG ikboun, ITG ilboun, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, double prestr, ITG iprestr, double vold, ITG iperturb, double sti, ITG nzs, double stx, double adb, double aub, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstiff, ITG npmat_, double dtime, char matname, ITG mi, ITG ics, double cs, ITG nm, ITG ncmat_, char labmpc, ITG mass, ITG stiffness, ITG buckling, ITG rhs, ITG intscheme, ITG mcs, ITG coriolis, ITG ibody, double xloadold, double reltime, ITG ielcs, double veold, double springarea, double thicke, ITG integerglob, double doubleglob, char tieset, ITG istartset, ITG iendset, ITG ialset, ITG ntie, ITG nasym, double pslavsurf, double pmastsurf, ITG mortar, double clearini, ITG ielprop, double prop, ITG ne0, ITG kscale, double xstateini, double xstate, ITG nstate_)
	)

◆ FORTRAN() [178/316]

void FORTRAN	(	mafillsmcsas	,
		(double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemload, char sideload, double xload, ITG nload, double xbody, ITG ipobody, ITG nbody, double cgr, double ad, double au, double bb, ITG nactdof, ITG icol, ITG jq, ITG irow, ITG neq, ITG nzl, ITG nmethod, ITG ikmpc, ITG ilmpc, ITG ikboun, ITG ilboun, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, double prestr, ITG iprestr, double vold, ITG iperturb, double sti, ITG nzs, double stx, double adb, double aub, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstiff, ITG npmat_, double dtime, char matname, ITG mi, ITG ics, double cs, ITG nm, ITG ncmat_, char labmpc, ITG mass, ITG stiffness, ITG buckling, ITG rhs, ITG intscheme, ITG mcs, ITG coriolis, ITG ibody, double xloadold, double reltime, ITG ielcs, double veold, double springarea, double thicke, ITG integerglob, double doubleglob, char tieset, ITG istartset, ITG iendset, ITG ialset, ITG ntie, ITG nasym, ITG nstate_, double xstateini, double xstate, double pslavsurf, double pmastsurf, ITG mortar, double clearini, ITG ielprop, double prop, ITG ne0, ITG kscale)
	)

◆ FORTRAN() [179/316]

void FORTRAN	(	mafillsmforc	,
		(ITG nforc, ITG ndirforc, ITG nodeforc, double xforc, ITG nactdof, double fext, ITG nmpc, ITG ipompc, ITG nodempc, ITG ikmpc, ITG ilmpc, double coefmpc, ITG mi, ITG rhsi, double fnext, ITG nmethod)
	)

◆ FORTRAN() [180/316]

void FORTRAN	(	mafillsm_company	,
		(double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemload, char sideload, double xload, ITG nload, double xbody, ITG ipobody, ITG nbody, double cgr, double ad, double au, double bb, ITG nactdof, ITG icol, ITG jq, ITG irow, ITG neq, ITG nzl, ITG nmethod, ITG ikmpc, ITG ilmpc, ITG ikboun, ITG ilboun, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, double prestr, ITG iprestr, double vold, ITG iperturb, double sti, ITG nzs, double stx, double adb, double aub, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstiff, ITG npmat_, double dtime, char matname, ITG mi, ITG ncmat_, ITG mass, ITG stiffness, ITG buckling, ITG rhs, ITG intscheme, double physcon, double shcon, ITG nshcon, double cocon, ITG ncocon, double ttime, double time, ITG istep, ITG kinc, ITG coriolis, ITG ibody, double xloadold, double reltime, double veold, double springarea, ITG nstate_, double xstateini, double xstate, double thicke, ITG integerglob, double doubleglob, char tieset, ITG istartset, ITG iendset, ITG ialset, ITG ntie, ITG nasym, double pslavsurf, double pmastsurf, ITG mortar, double clearini, ITG ielprop, double prop, ITG ne0, double fnext, ITG kscale, ITG iponoel, ITG inoel, ITG *network)
	)

◆ FORTRAN() [181/316]

void FORTRAN	(	mafillt	,
		(ITG nef, ITG ipnei, ITG neifa, ITG neiel, double vfa, double xxn, double area, double au, double ad, ITG jq, ITG irow, ITG nzs, double b, double vel, double umel, double xlet, double xle, double gradtfa, double xxi, double body, double volume, ITG ielfa, char lakonf, ITG ifabou, ITG nbody, ITG neq, double dtimef, double velo, double veloo, double cpfa, double hcfa, double cvel, double gradvel, double xload, double gammat, double xrlfa, double xxj, ITG nactdohinv, double a1, double a2, double a3, double flux, ITG nefa, ITG nefb, ITG iau6, double xxni, double xxnj, ITG iturbulent)
	)

◆ FORTRAN() [182/316]

void FORTRAN	(	mafilltcomp	,
		(ITG nef, ITG ipnei, ITG neifa, ITG neiel, double vfa, double xxn, double area, double au, double ad, ITG jq, ITG irow, ITG nzs, double b, double vel, double umel, double xlet, double xle, double gradtfa, double xxi, double body, double volume, ITG ielfa, char lakonf, ITG ifabou, ITG nbody, ITG neq, double dtimef, double velo, double veloo, double cpfa, double hcfa, double cvel, double gradvel, double xload, double gammat, double xrlfa, double xxj, ITG nactdohinv, double a1, double a2, double a3, double flux, ITG nefa, ITG nefb, ITG iau6, double xxni, double *xxnj)
	)

◆ FORTRAN() [183/316]

void FORTRAN	(	mafillv	,
		(ITG nef, ITG ipnei, ITG neifa, ITG neiel, double vfa, double xxn, double area, double au, double ad, ITG jq, ITG irow, ITG nzs, double b, double vel, double cosa, double umfa, double xlet, double xle, double gradvfa, double xxi, double body, double volume, ITG ielfa, char lakonf, ITG ifabou, ITG nbody, double dtimef, double velo, double veloo, double sel, double xrlfa, double gamma, double xxj, ITG nactdohinv, double a1, double a2, double a3, double flux, ITG nefa, ITG nefb, ITG icyclic, double c, ITG ifatie, ITG iau6, double xxni, double xxnj, ITG iturbulent, double gradvel)
	)

◆ FORTRAN() [184/316]

void FORTRAN	(	mafillvcomp	,
		(ITG nef, ITG ipnei, ITG neifa, ITG neiel, double vfa, double xxn, double area, double au, double ad, ITG jq, ITG irow, ITG nzs, double b, double vel, double cosa, double umfa, double xlet, double xle, double gradvfa, double xxi, double body, double volume, ITG ielfa, char lakonf, ITG ifabou, ITG nbody, double dtimef, double velo, double veloo, double sel, double xrlfa, double gamma, double xxj, ITG nactdohinv, double a1, double a2, double a3, double flux, ITG nefa, ITG nefb, ITG icyclic, double c, ITG ifatie, ITG iau6, double xxni, double xxnj)
	)

◆ FORTRAN() [185/316]

void FORTRAN	(	materialdata_cfd	,
		(ITG nef, double vel, double shcon, ITG nshcon, ITG ielmat, ITG ntmat_, ITG mi, double cvel, double vfa, double cocon, ITG ncocon, double physcon, double cvfa, ITG ithermal, ITG nface, double umel, double umfa, ITG ielfa, double hcfa, double rhcon, ITG *nrhcon)
	)

◆ FORTRAN() [186/316]

void FORTRAN	(	materialdata_cfd_comp	,
		(ITG nef, double vel, double shcon, ITG nshcon, ITG ielmat, ITG ntmat_, ITG mi, double cvel, double vfa, double cocon, ITG ncocon, double physcon, double cvfa, ITG ithermal, ITG nface, double umel, double umfa, ITG ielfa, double *hcfa)
	)

◆ FORTRAN() [187/316]

void FORTRAN	(	meannode	,
		(ITG nk, ITG inum, double *v)
	)

◆ FORTRAN() [188/316]

void FORTRAN	(	mpcrem	,
		(ITG i, ITG mpcfree, ITG nodempc, ITG nmpc, ITG ikmpc, ITG ilmpc, char labmpc, double coefmpc, ITG *ipompc)
	)

◆ FORTRAN() [189/316]

void FORTRAN	(	mult	,
		(double matrix, double trans, ITG *n)
	)

◆ FORTRAN() [190/316]

void FORTRAN	(	negativepressure	,
		(ITG ne0, ITG ne, ITG mi, double stx, double *pressureratio)
	)

◆ FORTRAN() [191/316]

void FORTRAN	(	networkelementpernode	,
		(ITG iponoel, ITG inoel, char lakon, ITG ipkon, ITG kon, ITG inoelsize, ITG nflow, ITG ieg, ITG ne, ITG network)
	)

◆ FORTRAN() [192/316]

void FORTRAN	(	networkinum	,
		(ITG ipkon, ITG inum, ITG kon, char lakon, ITG ne, ITG itg, ITG *ntg)
	)

◆ FORTRAN() [193/316]

void FORTRAN	(	nident	,
		(ITG x, ITG px, ITG n, ITG id)
	)

◆ FORTRAN() [194/316]

void FORTRAN	(	nidentll	,
		(long long x, long long px, ITG n, ITG id)
	)

◆ FORTRAN() [195/316]

void FORTRAN	(	nodestiedface	,
		(char tieset, ITG ntie, ITG ipkon, ITG kon, char lakon, char set, ITG istartset, ITG iendset, ITG ialset, ITG nset, ITG faceslave, ITG istartfield, ITG iendfield, ITG ifield, ITG nconf, ITG ncone, char *kind)
	)

◆ FORTRAN() [196/316]

void FORTRAN	(	nonlinmpc	,
		(double co, double vold, ITG ipompc, ITG nodempc, double coefmpc, char labmpc, ITG nmpc, ITG ikboun, ITG ilboun, ITG nboun, double xbounact, double aux, ITG iaux, ITG maxlenmpc, ITG ikmpc, ITG ilmpc, ITG icascade, ITG kon, ITG ipkon, char lakon, ITG ne, double reltime, ITG newstep, double xboun, double fmpc, ITG newinc, ITG idiscon, ITG ncont, double trab, ITG ntrans, ITG ithermal, ITG mi)
	)

◆ FORTRAN() [197/316]

void FORTRAN	(	norm	,
		(double vel, double velnorm, ITG *nef)
	)

◆ FORTRAN() [198/316]

void FORTRAN	(	normalsforequ_se	,
		(ITG nk, double co, ITG iponoelfa, ITG inoelfa, ITG konfa, ITG ipkonfa, char lakonfa, ITG ne, ITG ipnor, double xnor, ITG nodedesiinv, char jobnamef)
	)

◆ FORTRAN() [199/316]

void FORTRAN	(	normalsoninterface	,
		(ITG istartset, ITG iendset, ITG ialset, ITG imast, ITG ipkon, ITG kon, char lakon, ITG imastnode, ITG nmastnode, double xmastnor, double *co)
	)

◆ FORTRAN() [200/316]

void FORTRAN	(	normalsonsurface_se	,
		(ITG ipkon, ITG kon, char lakon, double extnor, double co, ITG nk, ITG ipoface, ITG nodface, ITG nactdof, ITG mi, ITG nodedesiinv, ITG noregion)
	)

◆ FORTRAN() [201/316]

void FORTRAN	(	objective_disp	,
		(ITG nodeset, ITG istartset, ITG iendset, ITG ialset, ITG nk, ITG idesvar, ITG iobject, ITG mi, double g0, ITG nobject, double *vold)
	)

◆ FORTRAN() [202/316]

void FORTRAN	(	objective_disp_dx	,
		(ITG nodeset, ITG istartset, ITG iendset, ITG ialset, ITG nk, ITG idesvar, ITG iobject, ITG mi, ITG nactdof, double dgdx, ITG ndesi, ITG nobject, double vold, double b)
	)

◆ FORTRAN() [203/316]

void FORTRAN	(	objective_freq	,
		(double dgdx, double df, double vold, ITG ndesi, ITG iobject, ITG mi, ITG nactdofinv, ITG jqs, ITG *irows)
	)

◆ FORTRAN() [204/316]

void FORTRAN	(	objective_freq_cs	,
		(double dgdx, double df, double vold, ITG ndesi, ITG iobject, ITG mi, ITG nactdofinv, ITG jqs, ITG irows, ITG nk, ITG *nzss)
	)

◆ FORTRAN() [205/316]

void FORTRAN	(	objective_mass_dx	,
		(double co1, ITG kon1, ITG ipkon1, char lakon1, ITG nelcon1, double rhcon1, ITG ielmat1, ITG ielorien1, ITG norien1, ITG ntmat1_, char matname1, ITG mi1, double thicke1, ITG mortar1, ITG nea, ITG neb, ITG ielprop1, double prop1, double distmin1, ITG ndesi1, ITG nodedesi1, ITG nobject1, double g01, double dgdx1, ITG iobject1, double xmass1, ITG istartdesi1, ITG ialdesi1, double xdesi1, ITG idesvar)
	)

◆ FORTRAN() [206/316]

void FORTRAN	(	objective_shapeener_dx	,
		(double co1, ITG kon1, ITG ipkon1, char lakon1, ITG ne1, double stx1, double elcon1, ITG nelcon1, double rhcon1, ITG nrhcon1, double alcon1, ITG nalcon1, double alzero1, ITG ielmat1, ITG ielorien1, ITG norien1, double orab1, ITG ntmat1_, double t01, double t11, ITG ithermal1, double prestr1, ITG iprestr1, ITG iperturb1, ITG iout1, double vold1, ITG nmethod1, double veold1, double dtime1, double time1, double ttime1, double plicon1, ITG nplicon1, double plkcon1, ITG nplkcon1, double xstateini1, double xstiff1, double xstate1, ITG npmat1_, char matname1, ITG mi1, ITG ielas1, ITG icmd1, ITG ncmat1_, ITG nstate1_, double stiini1, double vini1, double ener1, double enerini1, ITG istep1, ITG iinc1, double springarea1, double reltime1, ITG calcul_qa1, ITG iener1, ITG ikin1, ITG ne01, double thicke1, double emeini1, double pslavsurf1, double pmastsurf1, ITG mortar1, double clearini1, ITG nea, ITG neb, ITG ielprop1, double prop1, double distmin1, ITG ndesi1, ITG nodedesi1, ITG nobject1, double g01, double dgdx1, ITG iobject1, double sti1, double xener1, ITG istartdesi1, ITG ialdesi1, double xdesi1, ITG idesvar)
	)

◆ FORTRAN() [207/316]

void FORTRAN	(	objective_shapeener_tot	,
		(ITG ne, ITG kon, ITG ipkon, char lakon, double fint, double vold, ITG iperturb, ITG mi, ITG nactdof, double dgdx, double df, ITG ndesi, ITG iobject, ITG jqs, ITG irows, double vec)
	)

◆ FORTRAN() [208/316]

void FORTRAN	(	objective_stress	,
		(ITG nodeset, ITG istartset, ITG iendset, ITG ialset, ITG nk, ITG idesvar, ITG iobject, ITG mi, double g0, ITG nobject, double stn, char objectset)
	)

◆ FORTRAN() [209/316]

void FORTRAN	(	objective_stress_dx	,
		(ITG nodeset, ITG istartset, ITG iendset, ITG ialset, ITG nk, ITG idesvar, ITG iobject, double dgdx, ITG ndesi, ITG nobject, double stn, double dstn, char objectset, double g0)
	)

◆ FORTRAN() [210/316]

void FORTRAN	(	op	,
		(ITG n, double x, double y, double ad, double au, ITG jq, ITG *irow)
	)

◆ FORTRAN() [211/316]

void FORTRAN	(	opas	,
		(ITG n, double x, double y, double ad, double au, ITG jq, ITG irow, ITG nzs)
	)

◆ FORTRAN() [212/316]

void FORTRAN	(	op_corio	,
		(ITG n, double x, double y, double ad, double au, ITG jq, ITG *irow)
	)

◆ FORTRAN() [213/316]

void FORTRAN	(	openfile	,
		(char jobname, char output)
	)

◆ FORTRAN() [214/316]

void FORTRAN	(	openfilefluid	,
		(char *jobname)
	)

◆ FORTRAN() [215/316]

void FORTRAN	(	posttransition	,
		(double dgdxglob, ITG nobject, ITG nk, ITG nodedesi, ITG ndesi, char objectset)
	)

◆ FORTRAN() [216/316]

void FORTRAN	(	postview	,
		(ITG ntr, char sideload, ITG nelemload, ITG kontri, ITG ntri, ITG nloadtr, double tenv, double adview, double auview, double area, double fenv, ITG jqrad, ITG irowrad, ITG nzsrad)
	)

◆ FORTRAN() [217/316]

void FORTRAN	(	precfd	,
		(ITG ne, ITG ipkon, ITG kon, char lakon, ITG ipnei, ITG neifa, ITG neiel, ITG ipoface, ITG nodface, ITG ielfa, ITG nkonnei, ITG nface, ITG ifaext, ITG nfaext, ITG isolidsurf, ITG nsolidsurf, char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, double vel, double vold, ITG mi, ITG neij, ITG nef, ITG nactdoh, ITG ipkonf, char lakonf, ITG ielmatf, ITG ielmat, ITG ielorienf, ITG ielorien, ITG norien, double cs, ITG mcs, char tieset, double x, double y, double z, double xo, double yo, double zo, ITG nx, ITG ny, ITG nz, double co, ITG ifatei)
	)

◆ FORTRAN() [218/316]

void FORTRAN	(	preconvert2slapcol	,
		(ITG irow, ITG ia, ITG jq, ITG ja, ITG nzs, ITG nef)
	)

◆ FORTRAN() [219/316]

void FORTRAN	(	predgmres	,
		(ITG n, double b, double x, ITG nelt, ITG ia, ITG ja, double a, ITG isym, ITG itol, double tol, ITG itmax, ITG iter, double err, ITG ierr, ITG iunit, double sb, double sx, double rgwk, ITG lrgw, ITG igwk, ITG ligw, double rwork, ITG *iwork)
	)

◆ FORTRAN() [220/316]

void FORTRAN	(	prefilter	,
		(double co, ITG nodedesi, ITG ndesi, double xo, double yo, double zo, double x, double y, double z, ITG nx, ITG ny, ITG nz)
	)

◆ FORTRAN() [221/316]

void FORTRAN	(	prethickness	,
		(double co, double xo, double yo, double zo, double x, double y, double z, ITG nx, ITG ny, ITG nz, ITG ifree, ITG nodedesiinv, ITG ndesiboun, ITG nodedesiboun, char set, ITG nset, char objectset, ITG iobject, ITG istartset, ITG iendset, ITG *ialset)
	)

◆ FORTRAN() [222/316]

void FORTRAN	(	pretransition	,
		(ITG ipkon, ITG kon, char lakon, double co, ITG nk, ITG ipoface, ITG nodface, ITG nodedesiinv, double xo, double yo, double zo, double x, double y, double z, ITG nx, ITG ny, ITG nz, ITG ifree)
	)

◆ FORTRAN() [223/316]

void FORTRAN	(	printoutfluid	,
		(char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, ITG nprint, char prlab, char prset, ITG ipkon, char lakon, double stx, double eei, double xstate, double ener, ITG mi, ITG nstate_, double co, ITG kon, double qfx, double ttime, double trab, ITG inotr, ITG ntrans, double orab, ITG ielorien, ITG norien, double vold, ITG ielmatf, double thicke, double eme, double vcontu, double physcon, ITG nactdoh, ITG ielpropf, double prop, double xkappa, double xmach, ITG ithermal, char *orname)
	)

◆ FORTRAN() [224/316]

void FORTRAN	(	printoutface	,
		(double co, double rhcon, ITG nrhcon, ITG ntmat_, double vold, double shcon, ITG nshcon, double cocon, ITG ncocon, ITG icompressible, ITG istartset, ITG iendset, ITG ipkon, char lakon, ITG kon, ITG ialset, char prset, double timef, ITG nset, char set, ITG nprint, char prlab, ITG ielmat, ITG mi, ITG ithermal, ITG nactdoh, ITG icfd, double time, double *stn)
	)

◆ FORTRAN() [225/316]

void FORTRAN	(	propertynet	,
		(ITG ieg, ITG nflow, double prop, ITG ielprop, char lakon, ITG iin, double prop_store, double ttime, double time, ITG nam, char amname, ITG namta, double *amta)
	)

◆ FORTRAN() [226/316]

void FORTRAN	(	radmatrix	,
		(ITG ntr, double adrad, double aurad, double bcr, char sideload, ITG nelemload, double xloadact, char lakon, double vold, ITG ipkon, ITG kon, double co, ITG nloadtr, double tarea, double tenv, double physcon, double erad, double adview, double auview, ITG ithermal, ITG iinc, ITG iit, double fenv, ITG istep, double dtime, double ttime, double time, ITG iviewfile, double xloadold, double reltime, ITG nmethod, ITG mi, ITG iemchange, ITG nam, ITG iamload, ITG jqrad, ITG irowrad, ITG nzsrad)
	)

◆ FORTRAN() [227/316]

void FORTRAN	(	radresult	,
		(ITG ntr, double xloadact, double bcr, ITG nloadtr, double tarea, double tenv, double physcon, double erad, double auview, double fenv, ITG irowrad, ITG jqrad, ITG nzsrad, double q)
	)

◆ FORTRAN() [228/316]

void FORTRAN	(	randomval	,
		(double randval, ITG nev)
	)

◆ FORTRAN() [229/316]

void FORTRAN	(	readforce	,
		(double zc, ITG neq, ITG nev, ITG nactdof, ITG ikmpc, ITG nmpc, ITG ipompc, ITG nodempc, ITG mi, double coefmpc, char jobnamec, double aa, ITG *igeneralizedforce)
	)

◆ FORTRAN() [230/316]

void FORTRAN	(	readview	,
		(ITG ntr, double adview, double auview, double fenv, ITG nzsrad, ITG ithermal, char *jobnamef)
	)

◆ FORTRAN() [231/316]

void FORTRAN	(	rearrange	,
		(double au, ITG irow, ITG icol, ITG ndim, ITG *neq)
	)

◆ FORTRAN() [232/316]

void FORTRAN	(	rectcyl	,
		(double co, double v, double fn, double stn, double qfn, double een, double cs, ITG nk, ITG icntrl, double t, char filab, ITG imag, ITG mi, double emn)
	)

◆ FORTRAN() [233/316]

void FORTRAN	(	rectcylexp	,
		(double co, double v, double fn, double stn, double qfn, double een, double cs, ITG nkt, ITG icntrl, double t, char filab, ITG imag, ITG mi, ITG iznode, ITG nznode, ITG nsectors, ITG nk, double emn)
	)

◆ FORTRAN() [234/316]

void FORTRAN	(	rectcyltrfm	,
		(ITG node, double co, double cs, ITG cntrl, double fin, double fout)
	)

◆ FORTRAN() [235/316]

void FORTRAN	(	rectcylvi	,
		(double co, double v, double fn, double stn, double qfn, double een, double cs, ITG nk, ITG icntrl, double t, char filab, ITG imag, ITG mi, double emn)
	)

◆ FORTRAN() [236/316]

void FORTRAN	(	restartshort	,
		(ITG nset, ITG nload, ITG nbody, ITG nforc, ITG nboun, ITG nk, ITG ne, ITG nmpc, ITG nalset, ITG nmat, ITG ntmat, ITG npmat, ITG norien, ITG nam, ITG nprint, ITG mint, ITG ntrans, ITG ncs, ITG namtot, ITG ncmat, ITG memmpc, ITG ne1d, ITG ne2d, ITG nflow, char set, ITG meminset, ITG rmeminset, char jobnamec, ITG irestartstep, ITG icntrl, ITG ithermal, ITG nener, ITG nstate_, ITG ntie, ITG nslavs, ITG nkon, ITG mcs, ITG nprop, ITG mortar, ITG ifacecount, ITG nintpoint, ITG infree)
	)

◆ FORTRAN() [237/316]

void FORTRAN	(	restartwrite	,
		(ITG istep, ITG nset, ITG nload, ITG nforc, ITG nboun, ITG nk, ITG ne, ITG nmpc, ITG nalset, ITG nmat, ITG ntmat_, ITG npmat_, ITG norien, ITG nam, ITG nprint, ITG mi, ITG ntrans, ITG ncs_, ITG namtot_, ITG ncmat_, ITG mpcend, ITG maxlenmpc, ITG ne1d, ITG ne2d, ITG nflow, ITG nlabel, ITG iplas, ITG nkon, ITG ithermal, ITG nmethod, ITG iperturb, ITG nstate_, ITG nener, char set, ITG istartset, ITG iendset, ITG ialset, double co, ITG kon, ITG ipkon, char lakon, ITG nodeboun, ITG ndirboun, ITG iamboun, double xboun, ITG ikboun, ITG ilboun, ITG ipompc, ITG nodempc, double coefmpc, char labmpc, ITG ikmpc, ITG ilmpc, ITG nodeforc, ITG ndirforc, ITG iamforc, double xforc, ITG ikforc, ITG ilforc, ITG nelemload, ITG iamload, char sideload, double xload, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, double plicon, ITG nplicon, double plkcon, ITG nplkcon, char orname, double orab, ITG ielorien, double trab, ITG inotr, char amname, double amta, ITG namta, double t0, double t1, ITG iamt1, double veold, ITG ielmat, char matname, char prlab, char prset, char filab, double vold, ITG nodebounold, ITG ndirbounold, double xbounold, double xforcold, double xloadold, double t1old, double eme, ITG iponor, double xnor, ITG knor, double thicke, double offset, ITG iponoel, ITG inoel, ITG rig, double shcon, ITG nshcon, double cocon, ITG ncocon, ITG ics, double sti, double ener, double xstate, char jobnamec, ITG infree, double prestr, ITG iprestr, char cbody, ITG ibody, double xbody, ITG nbody, double xbodyold, double ttime, double qaold, double cs, ITG mcs, char output, double physcon, double ctrl, char typeboun, double fmpc, char tieset, ITG ntie, double tietol, ITG nslavs, double t0g, double t1g, ITG nprop, ITG ielprop, double prop, ITG mortar, ITG nintpoint, ITG ifacecount, ITG islavsurf, double pslavsurf, double clearini)
	)

◆ FORTRAN() [238/316]

void FORTRAN	(	resultnet	,
		(ITG itg, ITG ieg, ITG ntg, double bc, ITG nload, char sideload, ITG nelemload, double xloadact, char lakon, ITG ntmat_, double v, double shcon, ITG nshcon, ITG ipkon, ITG kon, double co, ITG nflow, ITG iinc, ITG istep, double dtime, double ttime, double time, ITG ikforc, ITG ilforc, double xforcact, ITG nforc, ITG ielmat, ITG nteq, double prop, ITG ielprop, ITG nactdog, ITG nacteq, ITG iin, double physcon, double camt, double camf, double camp, double rhcon, ITG nrhcon, ITG ipobody, ITG ibody, double xbody, ITG nbody, double dtheta, double vold, double xloadold, double reltime, ITG nmethod, char set, ITG mi, ITG ineighe, double cama, double vamt, double vamf, double vamp, double vama, ITG nmpc, ITG nodempc, ITG ipompc, double coefmpc, char labmpc, ITG iaxial, double qat, double qaf, double ramt, double ramf, double ramp, double cocon, ITG ncocon, ITG iponoel, ITG inoel, ITG iplausi)
	)

◆ FORTRAN() [239/316]

void FORTRAN	(	resultsem	,
		(double co, ITG kon, ITG ipkon, char lakon, double v, double elcon, ITG nelcon, ITG ielmat, ITG ntmat_, double vold, double dtime, char matname, ITG mi, ITG ncmat_, ITG nea, ITG neb, double sti, double alcon, ITG nalcon, double h0, ITG istartset, ITG iendset, ITG ialset, ITG iactive, double *fn)
	)

◆ FORTRAN() [240/316]

void FORTRAN	(	resultsforc	,
		(ITG nk, double f, double fn, ITG nactdof, ITG ipompc, ITG nodempc, double coefmpc, char labmpc, ITG nmpc, ITG mi, double fmpc, ITG calcul_fn, ITG *calcul_f)
	)

◆ FORTRAN() [241/316]

void FORTRAN	(	resultsforc_em	,
		(ITG nk, double f, double fn, ITG nactdof, ITG ipompc, ITG nodempc, double coefmpc, char labmpc, ITG nmpc, ITG mi, double fmpc, ITG calcul_fn, ITG calcul_f, ITG inomat)
	)

◆ FORTRAN() [242/316]

void FORTRAN	(	resultsforc_se	,
		(ITG nk, double dfn, ITG nactdof, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, ITG mi, double fmpc, ITG calcul_fn, ITG calcul_f, ITG idesvar, double df, ITG jqs, ITG irows, double distmin)
	)

◆ FORTRAN() [243/316]

void FORTRAN	(	resultsini	,
		(ITG nk, double v, ITG ithermal, char filab, ITG iperturb, double f, double fn, ITG nactdof, ITG iout, double qa, double vold, double b, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, char labmpc, ITG nmpc, ITG nmethod, double cam, ITG neq, double veold, double accold, double bet, double gam, double dtime, ITG mi, double vini, ITG nprint, char prlab, ITG intpointvar, ITG calcul_fn, ITG calcul_f, ITG calcul_qa, ITG calcul_cauchy, ITG iener, ITG ikin, ITG intpointvart, double xforc, ITG *nforc)
	)

◆ FORTRAN() [244/316]

void FORTRAN	(	resultsini_em	,
		(ITG nk, double v, ITG ithermal, char filab, ITG iperturb, double f, double fn, ITG nactdof, ITG iout, double qa, double b, ITG nodeboun, ITG ndirboun, double xboun, ITG nboun, ITG ipompc, ITG nodempc, double coefmpc, char labmpc, ITG nmpc, ITG nmethod, double cam, ITG neq, double veold, double dtime, ITG mi, double vini, ITG nprint, char prlab, ITG intpointvar, ITG calcul_fn, ITG calcul_f, ITG calcul_qa, ITG calcul_cauchy, ITG iener, ITG ikin, ITG intpointvart, double xforc, ITG *nforc)
	)

◆ FORTRAN() [245/316]

void FORTRAN	(	resultsmech	,
		(double co, ITG kon, ITG ipkon, char lakon, ITG ne, double v, double stx, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, double prestr, ITG iprestr, double eme, ITG iperturb, double fn, ITG iout, double qa, double vold, ITG nmethod, double veold, double dtime, double time, double ttime, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstateini, double xstiff, double xstate, ITG npmat_, char matname, ITG mi, ITG ielas, ITG icmd, ITG ncmat_, ITG nstate_, double stiini, double vini, double ener, double eei, double enerini, ITG istep, ITG iinc, double springarea, double reltime, ITG calcul_fn, ITG calcul_qa, ITG calcul_cauchy, ITG iener, ITG ikin, ITG nal, ITG ne0, double thicke, double emeini, double pslavsurf, double pmastsurf, ITG mortar, double clearini, ITG nea, ITG neb, ITG ielprop, double prop, ITG kscale)
	)

◆ FORTRAN() [246/316]

void FORTRAN	(	resultsmech_se	,
		(double co, ITG kon, ITG ipkon, char lakon, ITG ne, double v, double stx, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, double prestr, ITG iprestr, double eme, ITG iperturb, double fn, ITG iout, double vold, ITG nmethod, double veold, double dtime, double time, double ttime, double plicon, ITG nplicon, double plkcon, ITG nplkcon, double xstateini, double xstiff, double xstate, ITG npmat_, char matname, ITG mi, ITG ielas, ITG icmd, ITG ncmat_, ITG nstate_, double stiini, double vini, double ener, double eei, double enerini, ITG istep, ITG iinc, double springarea, double reltime, ITG calcul_fn, ITG calcul_cauchy, ITG iener, ITG ikin, ITG ne0, double thicke, double emeini, double pslavsurf, double pmastsurf, ITG mortar, double clearini, ITG nea, ITG neb, ITG ielprop, double prop, double dfn, ITG idesvar, ITG nodedesi, double fn0, double sti, ITG icoordinate, double dxstiff, ITG ialdesi, double *xdesi)
	)

◆ FORTRAN() [247/316]

void FORTRAN	(	resultsnoddir	,
		(ITG nk, double v, ITG nactdof, double b, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, ITG *mi)
	)

◆ FORTRAN() [248/316]

void FORTRAN	(	resultsprint	,
		(double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, double v, double stn, ITG inum, double stx, ITG ielorien, ITG norien, double orab, double t1, ITG ithermal, char filab, double een, ITG iperturb, double fn, ITG nactdof, ITG iout, double vold, ITG nodeboun, ITG ndirboun, ITG nboun, ITG nmethod, double ttime, double xstate, double epn, ITG mi, ITG nstate_, double ener, double enern, double xstaten, double eei, char set, ITG nset, ITG istartset, ITG iendset, ITG ialset, ITG nprint, char prlab, char prset, double qfx, double qfn, double trab, ITG inotr, ITG ntrans, ITG nelemload, ITG nload, ITG ikin, ITG ielmat, double thicke, double eme, double emn, double rhcon, ITG nrhcon, double shcon, ITG nshcon, double cocon, ITG ncocon, ITG ntmat_, char sideload, ITG icfd, ITG inomat, double pslavsurf, ITG islavact, double cdn, ITG mortar, ITG islavnode, ITG nslavnode, ITG ntie, ITG islavsurf, double time, ITG ielprop, double prop, double veold, ITG ne0, ITG nmpc, ITG ipompc, ITG nodempc, char labmpc, double energyini, double energy, char orname, double xload)
	)

◆ FORTRAN() [249/316]

void FORTRAN	(	resultstherm	,
		(double co, ITG kon, ITG ipkon, char lakon, double v, double elcon, ITG nelcon, double rhcon, ITG nrhcon, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, ITG iperturb, double fn, double shcon, ITG nshcon, ITG iout, double qa, double vold, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, double dtime, double time, double ttime, double plkcon, ITG nplkcon, double xstateini, double xstiff, double xstate, ITG npmat_, char matname, ITG mi, ITG ncmat_, ITG nstate_, double cocon, ITG ncocon, double qfx, ITG ikmpc, ITG ilmpc, ITG istep, ITG iinc, double springarea, ITG calcul_fn, ITG calcul_qa, ITG nal, ITG nea, ITG neb, ITG ithermal, ITG nelemload, ITG nload, ITG nmethod, double reltime, char sideload, double xload, double xloadold, double pslavsurf, double pmastsurf, ITG mortar, double clearini, double plicon, ITG nplicon, ITG ielprop, double prop, ITG iponoel, ITG inoel, ITG network, ITG ipobody, double xbodyact, ITG ibody)
	)

◆ FORTRAN() [250/316]

void FORTRAN	(	rhs	,
		(double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, ITG ipompc, ITG nodempc, double coefmpc, ITG nmpc, ITG nodeforc, ITG ndirforc, double xforc, ITG nforc, ITG nelemload, char sideload, double xload, ITG nload, double xbody, ITG ipobody, ITG nbody, double cgr, double bb, ITG nactdof, ITG neq, ITG nmethod, ITG ikmpc, ITG ilmpc, double elcon, ITG nelcon, double rhcon, ITG nrhcon, double alcon, ITG nalcon, double alzero, ITG ielmat, ITG ielorien, ITG norien, double orab, ITG ntmat_, double t0, double t1, ITG ithermal, ITG iprestr, double vold, ITG iperturb, ITG iexpl, double plicon, ITG nplicon, double plkcon, ITG nplkcon, ITG npmat_, double ttime, double time, ITG istep, ITG iinc, double dtime, double physcon, ITG ibody, double xbodyold, double reltime, double veold, char matname, ITG mi, ITG ikactmech, ITG nactmech, ITG ielprop, double prop, double sti, double xstateini, double xstate, ITG nstate_)
	)

◆ FORTRAN() [251/316]

void FORTRAN	(	rhsp	,
		(ITG ne, char lakon, ITG ipnei, ITG neifa, ITG neiel, double vfa, double area, double adfa, double xlet, double cosa, double volume, double au, double ad, ITG jq, ITG irow, double ap, ITG ielfa, ITG ifabou, double xle, double b, double xxn, ITG neq, ITG nzs, double hfa, double gradpel, double bp, double xxi, ITG neij, double xlen, ITG nefa, ITG nefb, double xxicn)
	)

◆ FORTRAN() [252/316]

void FORTRAN	(	sensitivity_glob	,
		(double dgdxtot, double dgdxtotglob, ITG nobject, ITG ndesi, ITG nodedesi, ITG nk)
	)

◆ FORTRAN() [253/316]

void FORTRAN	(	shape3tri	,
		(double xi, double et, double xl, double xsj, double xs, double shp, ITG *iflag)
	)

◆ FORTRAN() [254/316]

void FORTRAN	(	shape4q	,
		(double xi, double et, double xl, double xsj, double xs, double shp, ITG *iflag)
	)

◆ FORTRAN() [255/316]

void FORTRAN	(	shape4tet	,
		(double xi, double et, double ze, double xl, double xsj, double shp, ITG *iflag)
	)

◆ FORTRAN() [256/316]

void FORTRAN	(	shape6tri	,
		(double xi, double et, double xl, double xsj, double xs, double shp, ITG *iflag)
	)

◆ FORTRAN() [257/316]

void FORTRAN	(	shape6w	,
		(double xi, double et, double ze, double xl, double xsj, double shp, ITG *iflag)
	)

◆ FORTRAN() [258/316]

void FORTRAN	(	shape8h	,
		(double xi, double et, double ze, double xl, double xsj, double shp, ITG *iflag)
	)

◆ FORTRAN() [259/316]

void FORTRAN	(	shape8q	,
		(double xi, double et, double xl, double xsj, double xs, double shp, ITG *iflag)
	)

◆ FORTRAN() [260/316]

void FORTRAN	(	shape10tet	,
		(double xi, double et, double ze, double xl, double xsj, double shp, ITG *iflag)
	)

◆ FORTRAN() [261/316]

void FORTRAN	(	shape15w	,
		(double xi, double et, double ze, double xl, double xsj, double shp, ITG *iflag)
	)

◆ FORTRAN() [262/316]

void FORTRAN	(	shape20h	,
		(double xi, double et, double ze, double xl, double xsj, double shp, ITG *iflag)
	)

◆ FORTRAN() [263/316]

void FORTRAN	(	slavintpoints	,
		(ITG ntie, ITG itietri, ITG ipkon, ITG kon, char lakon, double straight, ITG nintpoint, ITG koncont, double co, double vold, double xo, double yo, double zo, double x, double y, double z, ITG nx, ITG ny, ITG nz, ITG islavsurf, ITG islavnode, ITG nslavnode, ITG imastop, ITG mi, ITG ncont, ITG ipe, ITG ime, double pslavsurf, ITG i, ITG l, ITG *ntri)
	)

◆ FORTRAN() [264/316]

void FORTRAN	(	smalldist	,
		(double co, double distmin, char lakon, ITG ipkon, ITG kon, ITG ne)
	)

◆ FORTRAN() [265/316]

void FORTRAN	(	sortev	,
		(ITG nev, ITG nmd, double eigxx, ITG cyclicsymmetry, double xx, double eigxr, ITG pev, ITG istartnmd, ITG iendnmd, double aa, double *bb)
	)

◆ FORTRAN() [266/316]

void FORTRAN	(	spcmatch	,
		(double xboun, ITG nodeboun, ITG ndirboun, ITG nboun, double xbounold, ITG nodebounold, ITG ndirbounold, ITG nbounold, ITG ikboun, ITG ilboun, double vold, double reorder, ITG nreorder, ITG mi)
	)

◆ FORTRAN() [267/316]

void FORTRAN	(	splitline	,
		(char text, char textpart, ITG *n)
	)

◆ FORTRAN() [268/316]

void FORTRAN	(	springforc_n2f	,
		(double xl, ITG konl, double vl, ITG imat, double elcon, ITG nelcon, double elas, double fnl, ITG ncmat_, ITG ntmat_, ITG nope, char lakonl, double t1l, ITG kode, double elconloc, double plicon, ITG nplicon, ITG npmat_, double senergy, ITG iener, double cstr, ITG mi, double springarea, ITG nmethod, ITG ne0, ITG nstate_, double xstateini, double xstate, double reltime, ITG ielas, double venergy, ITG ielorien, double orab, ITG norien, ITG *nelem)
	)

◆ FORTRAN() [269/316]

void FORTRAN	(	springstiff_n2f	,
		(double xl, double elas, ITG konl, double voldl, double s, ITG imat, double elcon, ITG nelcon, ITG ncmat_, ITG ntmat_, ITG nope, char lakonl, double t1l, ITG kode, double elconloc, double plicon, ITG nplicon, ITG npmat_, ITG iperturb, double springarea, ITG nmethod, ITG mi, ITG ne0, ITG nstate_, double xstateini, double xstate, double reltime, ITG nasym, ITG ielorien, double orab, ITG norien, ITG nelem)
	)

◆ FORTRAN() [270/316]

void FORTRAN	(	stop	,
		()
	)

◆ FORTRAN() [271/316]

void FORTRAN	(	storeresidual	,
		(ITG nactdof, double b, double fn, char filab, ITG ithermal, ITG nk, double sti, double stn, ITG ipkon, ITG inum, ITG kon, char lakon, ITG ne, ITG mi, double orab, ITG ielorien, double co, ITG itg, ITG ntg, double vold, ITG ielmat, double thicke, ITG ielprop, double prop)
	)

◆ FORTRAN() [272/316]

void FORTRAN	(	storecontactprop	,
		(ITG ne, ITG ne0, char lakon, ITG kon, ITG ipkon, ITG mi, ITG ielmat, double elcon, ITG mortar, double adb, ITG nactdof, double springarea, ITG ncmat_, ITG ntmat_, double stx, double temax)
	)

◆ FORTRAN() [273/316]

void FORTRAN	(	subspace	,
		(double d, double aa, double bb, double cc, double alpham, double betam, ITG nev, double xini, double cd, double cv, double time, double rwork, ITG lrw, ITG k, ITG jout, double rpar, double bj, ITG iwork, ITG liw, ITG iddebdf, double *bjp)
	)

◆ FORTRAN() [274/316]

void FORTRAN	(	tempload	,
		(double xforcold, double xforc, double xforcact, ITG iamforc, ITG nforc, double xloadold, double xload, double xloadact, ITG iamload, ITG nload, ITG ibody, double xbody, ITG nbody, double xbodyold, double xbodyact, double t1old, double t1, double t1act, ITG iamt1, ITG nk, double amta, ITG namta, ITG nam, double ampli, double time, double reltime, double ttime, double dtime, ITG ithermal, ITG nmethod, double xbounold, double xboun, double xbounact, ITG iamboun, ITG nboun, ITG nodeboun, ITG ndirboun, ITG nodeforc, ITG ndirforc, ITG istep, ITG iint, double co, double vold, ITG itg, ITG ntg, char amname, ITG ikboun, ITG ilboun, ITG nelemload, char sideload, ITG mi, ITG ntrans, double trab, ITG inotr, double veold, ITG integerglob, double doubleglob, char tieset, ITG istartset, ITG iendset, ITG ialset, ITG ntie, ITG nmpc, ITG ipompc, ITG ikmpc, ITG ilmpc, ITG nodempc, double coefmpc, ITG ipobody, ITG iponoel, ITG *inoel)
	)

◆ FORTRAN() [275/316]

void FORTRAN	(	tempload_em	,
		(double xforcold, double xforc, double xforcact, ITG iamforc, ITG nforc, double xloadold, double xload, double xloadact, ITG iamload, ITG nload, ITG ibody, double xbody, ITG nbody, double xbodyold, double xbodyact, double t1old, double t1, double t1act, ITG iamt1, ITG nk, double amta, ITG namta, ITG nam, double ampli, double time, double reltime, double ttime, double dtime, ITG ithermal, ITG nmethod, double xbounold, double xboun, double xbounact, ITG iamboun, ITG nboun, ITG nodeboun, ITG ndirboun, ITG nodeforc, ITG ndirforc, ITG istep, ITG iint, double co, double vold, ITG itg, ITG ntg, char amname, ITG ikboun, ITG ilboun, ITG nelemload, char sideload, ITG mi, ITG ntrans, double trab, ITG inotr, double veold, ITG integerglob, double doubleglob, char tieset, ITG istartset, ITG iendset, ITG ialset, ITG ntie, ITG nmpc, ITG ipompc, ITG ikmpc, ITG ilmpc, ITG nodempc, double coefmpc, double h0scale, ITG inomat, ITG ipobody, ITG iponoel, ITG *inoel)
	)

◆ FORTRAN() [276/316]

void FORTRAN	(	temploaddiff	,
		(double xforcold, double xforc, double xforcact, ITG iamforc, ITG nforc, double xloadold, double xload, double xloadact, ITG iamload, ITG nload, ITG ibody, double xbody, ITG nbody, double xbodyold, double xbodyact, double t1old, double t1, double t1act, ITG iamt1, ITG nk, double amta, ITG namta, ITG nam, double ampli, double time, double reltime, double ttime, double dtime, ITG ithermal, ITG nmethod, double xbounold, double xboun, double xbounact, ITG iamboun, ITG nboun, ITG nodeboun, ITG ndirboun, ITG nodeforc, ITG ndirforc, ITG istep, ITG iint, double co, double vold, ITG itg, ITG ntg, char amname, ITG ikboun, ITG ilboun, ITG nelemload, char sideload, ITG mi, double xforcdiff, double xloaddiff, double xbodydiff, double t1diff, double xboundiff, ITG icorrect, ITG iprescribedboundary, ITG ntrans, double trab, ITG inotr, double veold, ITG nactdof, double bcont, double fn, ITG ipobody, ITG iponoel, ITG inoel)
	)

◆ FORTRAN() [277/316]

void FORTRAN	(	temploadmodal	,
		(double amta, ITG namta, ITG nam, double ampli, double timemin, double ttimemin, double dtime, double xbounold, double xboun, double xbounmin, ITG iamboun, ITG nboun, ITG nodeboun, ITG ndirboun, char *amname)
	)

◆ FORTRAN() [278/316]

void FORTRAN	(	tiefaccont	,
		(char lakon, ITG ipkon, ITG kon, ITG ntie, char tieset, ITG nset, char set, ITG istartset, ITG iendset, ITG ialset, ITG itiefac, ITG islavsurf, ITG islavnode, ITG imastnode, ITG nslavnode, ITG nmastnode, ITG nslavs, ITG nmasts, ITG ifacecount, ITG iponoels, ITG inoels, ITG ifreenoels, ITG mortar, ITG ipoface, ITG nodface, ITG nk, double *xnoels)
	)

◆ FORTRAN() [279/316]

void FORTRAN	(	transformatrix	,
		(double xab, double p, double *a)
	)

◆ FORTRAN() [280/316]

void FORTRAN	(	transition	,
		(double dgdxglob, ITG nobject, ITG nk, ITG nodedesi, ITG ndesi, char objectset, double xo, double yo, double zo, double x, double y, double z, ITG nx, ITG ny, ITG nz, double co, ITG ifree, ITG ndesia, ITG *ndesib)
	)

◆ FORTRAN() [281/316]

void FORTRAN	(	trianeighbor	,
		(ITG ipe, ITG ime, ITG imastop, ITG ncont, ITG koncont, ITG ifreeme)
	)

◆ FORTRAN() [282/316]

void FORTRAN	(	triangucont	,
		(ITG ncont, ITG ntie, char tieset, ITG nset, char set, ITG istartset, ITG iendset, ITG ialset, ITG itietri, char lakon, ITG ipkon, ITG kon, ITG koncont, char kind1, char kind2, double co, ITG *nk)
	)

◆ FORTRAN() [283/316]

void FORTRAN	(	tridiagonal_nrhs	,
		(double a, double b, ITG n, ITG m, ITG *nrhs)
	)

◆ FORTRAN() [284/316]

void FORTRAN	(	ufaceload	,
		(double co, ITG ipkon, ITG kon, char lakon, ITG nboun, ITG nodeboun, ITG nelemload, char sideload, ITG nload, ITG ne, ITG *nk)
	)

◆ FORTRAN() [285/316]

void FORTRAN	(	uinit	,
		()
	)

◆ FORTRAN() [286/316]

void FORTRAN	(	uiter	,
		(ITG *iit)
	)

◆ FORTRAN() [287/316]

void FORTRAN	(	uout	,
		(double v, ITG mi, ITG ithermal, char filab)
	)

◆ FORTRAN() [288/316]

void FORTRAN	(	updatecont	,
		(ITG koncont, ITG ncont, double co, double vold, double cg, double straight, ITG *mi)
	)

◆ FORTRAN() [289/316]

void FORTRAN	(	updatecontpen	,
		(ITG koncont, ITG ncont, double co, double vold, double cg, double straight, ITG mi, ITG imastnode, ITG nmastnode, double xmastnor, ITG ntie, char tieset, ITG nset, char set, ITG istartset, ITG iendset, ITG ialset, ITG ipkon, char lakon, ITG kon, double cs, ITG mcs, ITG *ics)
	)

◆ FORTRAN() [290/316]

void FORTRAN	(	writeboun	,
		(ITG nodeboun, ITG ndirboun, double xboun, char typeboun, ITG *nboun)
	)

◆ FORTRAN() [291/316]

void FORTRAN	(	writebv	,
		(double , ITG )
	)

◆ FORTRAN() [292/316]

void FORTRAN	(	writecvg	,
		(ITG itep, ITG iinc, ITG icutb, ITG iit, ITG ne, ITG ne0, double ram, double qam, double cam, double uam, ITG *ithermal)
	)

◆ FORTRAN() [293/316]

void FORTRAN	(	writedeigdx	,
		(ITG iev, double d, ITG ndesi, char orname, double *dgdx)
	)

◆ FORTRAN() [294/316]

void FORTRAN	(	writedesi	,
		(ITG norien, char orname)
	)

◆ FORTRAN() [295/316]

void FORTRAN	(	writeev	,
		(double , ITG , double , double )
	)

◆ FORTRAN() [296/316]

void FORTRAN	(	writeevcomplex	,
		(double eigxx, ITG nev, double fmin, double fmax)
	)

◆ FORTRAN() [297/316]

void FORTRAN	(	writeevcs	,
		(double , ITG , ITG , double , double *)
	)

◆ FORTRAN() [298/316]

void FORTRAN	(	writeevcscomplex	,
		(double eigxx, ITG nev, ITG nm, double fmin, double *fmax)
	)

◆ FORTRAN() [299/316]

void FORTRAN	(	writehe	,
		(ITG *)
	)

◆ FORTRAN() [300/316]

void FORTRAN	(	writeim	,
		()
	)

◆ FORTRAN() [301/316]

void FORTRAN	(	writeinput	,
		(char inpc, ITG ipoinp, ITG inp, ITG nline, ITG ninp, ITG ipoinpc)
	)

◆ FORTRAN() [302/316]

void FORTRAN	(	writemac	,
		(double mac, ITG nev)
	)

◆ FORTRAN() [303/316]

void FORTRAN	(	writemaccs	,
		(double mac, ITG nev, ITG *nm)
	)

◆ FORTRAN() [304/316]

void FORTRAN	(	writempc	,
		(ITG , ITG , double , char , ITG *)
	)

◆ FORTRAN() [305/316]

void FORTRAN	(	writeobj	,
		(char objectset, ITG iobject, double *g0)
	)

◆ FORTRAN() [306/316]

void FORTRAN	(	writepf	,
		(double d, double bjr, double bji, double freq, ITG nev, ITG mode, ITG *nherm)
	)

◆ FORTRAN() [307/316]

void FORTRAN	(	writerandomfield	,
		(double d, ITG nev, double abserr, double relerr)
	)

◆ FORTRAN() [308/316]

void FORTRAN	(	writere	,
		()
	)

◆ FORTRAN() [309/316]

void FORTRAN	(	writesubmatrix	,
		(double submatrix, ITG noderetain, ITG ndirretain, ITG nretain, char *jobnamec)
	)

◆ FORTRAN() [310/316]

void FORTRAN	(	writesummary	,
		(ITG istep, ITG j, ITG icutb, ITG l, double ttime, double time, double *dtime)
	)

◆ FORTRAN() [311/316]

void FORTRAN	(	writesummarydiv	,
		(ITG istep, ITG j, ITG icutb, ITG l, double ttime, double time, double *dtime)
	)

◆ FORTRAN() [312/316]

void FORTRAN	(	writetetmesh	,
		(ITG kontet, ITG netet_, double cotet, ITG nktet, double field, ITG nfield)
	)

◆ FORTRAN() [313/316]

void FORTRAN	(	writeview	,
		(ITG ntr, double adview, double auview, double fenv, ITG nzsrad, char jobnamef)
	)

◆ FORTRAN() [314/316]

void FORTRAN	(	zienzhu	,
		(double co, ITG nk, ITG kon, ITG ipkon, char lakon, ITG ne, double stn, ITG ipneigh, ITG neigh, double sti, ITG *mi)
	)

◆ FORTRAN() [315/316]

void FORTRAN	(	znaupd	,
		(ITG ido, char bmat, ITG n, char which, ITG nev, double tol, double resid, ITG ncv, double z, ITG ldz, ITG iparam, ITG ipntr, double workd, double workl, ITG lworkl, double rwork, ITG *info)
	)

◆ FORTRAN() [316/316]

void FORTRAN	(	zneupd	,
		(ITG rvec, char howmny, ITG select, double d, double z, ITG ldz, double sigma, double workev, char bmat, ITG neq, char which, ITG nev, double tol, double resid, ITG ncv, double v, ITG ldv, ITG iparam, ITG ipntr, double workd, double workl, ITG lworkl, double rwork, ITG info)
	)

◆ frd()

void frd	(	double *	co,
		ITG *	nk,
		ITG *	kon,
		ITG *	ipkon,
		char *	lakon,
		ITG *	ne0,
		double *	v,
		double *	stn,
		ITG *	inum,
		ITG *	nmethod,
		ITG *	kode,
		char *	filab,
		double *	een,
		double *	t1,
		double *	fn,
		double *	time,
		double *	epn,
		ITG *	ielmat,
		char *	matname,
		double *	enern,
		double *	xstaten,
		ITG *	nstate_,
		ITG *	istep,
		ITG *	iinc,
		ITG *	ithermal,
		double *	qfn,
		ITG *	mode,
		ITG *	noddiam,
		double *	trab,
		ITG *	inotr,
		ITG *	ntrans,
		double *	orab,
		ITG *	ielorien,
		ITG *	norien,
		char *	description,
		ITG *	ipneigh,
		ITG *	neigh,
		ITG *	mi,
		double *	stx,
		double *	vr,
		double *	vi,
		double *	stnr,
		double *	stni,
		double *	vmax,
		double *	stnmax,
		ITG *	ngraph,
		double *	veold,
		double *	ener,
		ITG *	ne,
		double *	cs,
		char *	set,
		ITG *	nset,
		ITG *	istartset,
		ITG *	iendset,
		ITG *	ialset,
		double *	eenmax,
		double *	fnr,
		double *	fni,
		double *	emn,
		double *	thicke,
		char *	jobnamec,
		char *	output,
		double *	qfx,
		double *	cdn,
		ITG *	mortar,
		double *	cdnr,
		double *	cdni,
		ITG *	nmat
	)

                                                                      {
 
      /* stores the results in frd format
 
      iselect selects which nodes are to be stored:
           iselect=-1 means only those nodes for which inum negative
                      ist, i.e. network nodes
           iselect=+1 means only those nodes for which inum positive
                      ist, i.e. structural nodes
           iselect=0  means both of the above */
   
   FILE *f1;
   
   char c[2]="C",m1[4]=" -1",m2[4]=" -2",m3[4]=" -3",
     p0[6]="    0",p1[6]="    1",p2[6]="    2",p3[6]="    3",p4[6]="    4",
     p5[6]="    5",p6[6]="    6",p7[6]="    7",p8[6]="    8",p9[6]="    9",
     p10[6]="   10",p11[6]="   11",
     p12[6]="   12", fneig[132]="",date[8],clock[10],newdate[21],newclock[9],
     material[59]="                                                          ",
     text[2]=" ";
 
   static ITG icounter=0,nkcoords,iaxial;
 
   ITG null,one,i,j,k,indexe,nemax,nlayer,noutloc,iset,iselect,ncomp,nope,
       nodes,ifield[7],nfield[2],icomp[7],ifieldstate[*nstate_],two,three,
       icompstate[*nstate_],ip0=0,ip1=1,ip2=2,ip3=3,ip4=4,ip5=5,ip6=6,ip7=7,
       ip8=8,ip9=9,ip10=10,ip11=11,ip12=12,imat,nelout,
       nterms,nout,noutplus,noutmin,mt=mi[1]+1;
 
   ITG ncompscalar=1,ifieldscalar[1]={1},icompscalar[1]={0},
       nfieldscalar[2]={1,0};
   ITG ncompvector=3,ifieldvector[3]={1,1,1},icompvector[3]={0,1,2},
       nfieldvector1[2]={3,0},nfieldvector0[2]={mi[1]+1,0},
       icompvectorlast[3]={3,4,5};
   ITG ncomptensor=6,ifieldtensor[6]={1,1,1,1,1,1},icomptensor[6]={0,1,2,3,5,4},
       nfieldtensor[2]={6,0};
   ITG ncompscalph=2,ifieldscalph[2]={1,2},icompscalph[2]={0,0},
       nfieldscalph[2]={0,0};
   ITG ncompvectph=6,ifieldvectph[6]={1,1,1,2,2,2},icompvectph[6]={1,2,3,1,2,3},
       nfieldvectph[2]={mi[1]+1,mi[1]+1};
   ITG ncomptensph=12,ifieldtensph[12]={1,1,1,1,1,1,2,2,2,2,2,2},
       icomptensph[12]={0,1,2,3,5,4,0,1,2,3,5,4},nfieldtensph[2]={6,6};
       
   int iw;
 
   float ifl;
 
   double pi,oner,*vold=NULL;
 
 #ifdef EXODUSII
   if(strcmp1(output,"exo")==0){
     exo(co,nk,kon,ipkon,lakon,ne0,v,stn,inum,nmethod,kode,
     filab,een,t1,fn,time,epn,ielmat,matname,enern,
     xstaten,nstate_,istep,iinc,ithermal,qfn,mode,noddiam,
     trab,inotr,ntrans,orab,ielorien,norien,description,
     ipneigh,neigh,mi,stx,vr,vi,stnr,stni,vmax,stnmax,
     ngraph,veold,ener,ne,cs,set,nset,istartset,iendset,
     ialset,eenmax,fnr,fni,emn,thicke,jobnamec,output,qfx,
     cdn,mortar,cdnr,cdni,nmat);
     return;
   }
 #endif
 
   strcpy(fneig,jobnamec);
   strcat(fneig,".frd");
 
   if((f1=fopen(fneig,"ab"))==NULL){
     printf("*EOR in frd: cannot open frd file for writing...");
     exit(0);
   }
 
   pi=4.*atan(1.);
   null=0;
   one=1;two=2;three=3;
   oner=1.;
 
   /* determining nout, noutplus and noutmin 
               nout: number of structural and network nodes
               noutplus: number of structural nodes
               noutmin: number of network nodes */
 
   if(*nmethod!=0){
       nout=0;
       noutplus=0;
       noutmin=0;
       for(i=0;i<*nk;i++){
       if(inum[i]==0) continue;
       nout++;
       if(inum[i]>0) noutplus++;
       if(inum[i]<0) noutmin++;
       }
   }else{
       nout=*nk;
   }
 
   /* first time something is written in the frd-file: store
      computational metadata, the nodal coordinates and the
      topology */
 
 //  if(*kode==1){
   if((*kode==1)&&((*nmethod!=5)||(*mode!=0))){
     iaxial=0.;
 //    fprintf(f1,"%5s%1s\n",p1,c);
 
     /* date and time */
 
     FORTRAN(dattime,(date,clock));
 
     for(i=0;i<20;i++) newdate[i]=' ';
     newdate[20]='\0';
 
     strcpy1(newdate,&date[6],2);
     strcpy1(&newdate[2],".",1);
     if(strcmp1(&date[4],"01")==0){
       strcpy1(&newdate[3],"january.",8);
       strcpy1(&newdate[11],&date[0],4);
     }else if(strcmp1(&date[4],"02")==0){
       strcpy1(&newdate[3],"february.",9);
       strcpy1(&newdate[12],&date[0],4);
     }else if(strcmp1(&date[4],"03")==0){
       strcpy1(&newdate[3],"march.",6);
       strcpy1(&newdate[9],&date[0],4);
     }else if(strcmp1(&date[4],"04")==0){
       strcpy1(&newdate[3],"april.",6);
       strcpy1(&newdate[9],&date[0],4);
     }else if(strcmp1(&date[4],"05")==0){
       strcpy1(&newdate[3],"may.",4);
       strcpy1(&newdate[7],&date[0],4);
     }else if(strcmp1(&date[4],"06")==0){
       strcpy1(&newdate[3],"june.",5);
       strcpy1(&newdate[8],&date[0],4);
     }else if(strcmp1(&date[4],"07")==0){
       strcpy1(&newdate[3],"july.",5);
       strcpy1(&newdate[8],&date[0],4);
     }else if(strcmp1(&date[4],"08")==0){
       strcpy1(&newdate[3],"august.",7);
       strcpy1(&newdate[10],&date[0],4);
     }else if(strcmp1(&date[4],"09")==0){
       strcpy1(&newdate[3],"september.",10);
       strcpy1(&newdate[13],&date[0],4);
     }else if(strcmp1(&date[4],"10")==0){
       strcpy1(&newdate[3],"october.",8);
       strcpy1(&newdate[11],&date[0],4);
     }else if(strcmp1(&date[4],"11")==0){
       strcpy1(&newdate[3],"november.",9);
       strcpy1(&newdate[12],&date[0],4);
     }else if(strcmp1(&date[4],"12")==0){
       strcpy1(&newdate[3],"december.",9);
       strcpy1(&newdate[12],&date[0],4);
     }
 
     strcpy1(newclock,clock,2);
     strcpy1(&newclock[2],":",1);
     strcpy1(&newclock[3],&clock[2],2);
     strcpy1(&newclock[5],":",1);
     strcpy1(&newclock[6],&clock[4],2);
     newclock[8]='\0';
 
     fprintf(f1,"%5sUUSER                                                              \n",p1);
     fprintf(f1,"%5sUDATE              %20s                            \n",p1,newdate);
     fprintf(f1,"%5sUTIME              %8s                                        \n",p1,newclock);
     fprintf(f1,"%5sUHOST                                                              \n",p1);
     fprintf(f1,"%5sUPGM               CalculiX                                        \n",p1);
     fprintf(f1,"%5sUVERSION           Version 2.13                             \n",p1);
     fprintf(f1,"%5sUCOMPILETIME       Sat Feb 24 09:43:30 EST 2018                    \n",p1);
     fprintf(f1,"%5sUDIR                                                               \n",p1);
     fprintf(f1,"%5sUDBN                                                               \n",p1);
     
     for(i=0;i<*nmat;i++){
     strcpy1(material,&matname[80*i],58);
     fprintf(f1,"%5sUMAT%5" ITGFORMAT "%58s\n",p1,i+1,material);
     }
 
     /* storing the header of the coordinates */
 
     if(strcmp1(output,"asc")==0){
       fprintf(f1,"%5s%1s                  %12" ITGFORMAT "%38" ITGFORMAT "\n",p2,c,nout,one);
     }else{
       fprintf(f1,"%5s%1s                  %12" ITGFORMAT "%38" ITGFORMAT "\n",p2,c,nout,three);
     }
 
     /* storing the coordinates themselves */
 
     if(*nmethod!=0){
       for(i=0;i<*nk;i++){
     if(inum[i]==0) continue;
     if(strcmp1(output,"asc")==0){
         fprintf(f1,"%3s%10" ITGFORMAT "%12.5E%12.5E%12.5E\n",m1,i+1,(float)co[3*i],
           (float)co[3*i+1],(float)co[3*i+2]);
     }else{
       iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
       fwrite(&co[3*i],sizeof(double),1,f1);
       fwrite(&co[3*i+1],sizeof(double),1,f1);
       fwrite(&co[3*i+2],sizeof(double),1,f1);
     }
       }
     }else{
       for(i=0;i<*nk;i++){
     if(strcmp1(output,"asc")==0){
       fprintf(f1,"%3s%10" ITGFORMAT "%12.5E%12.5E%12.5E\n",m1,i+1,(float)co[3*i],
         (float)co[3*i+1],(float)co[3*i+2]);
     }else{
       iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
       fwrite(&co[3*i],sizeof(double),1,f1);
       fwrite(&co[3*i+1],sizeof(double),1,f1);
       fwrite(&co[3*i+2],sizeof(double),1,f1);
     }
       }
     }
 
     /* nkcoords is the number of nodes at the time when 
        the nodal coordinates are stored in the frd file */
 
     nkcoords=*nk;
     if(strcmp1(output,"asc")==0)fprintf(f1,"%3s\n",m3);
 
     /* determining the number of elements */
 
     if(*nmethod!=0){
     nelout=0;
     for(i=0;i<*ne0;i++){
         if(ipkon[i]<=-1){
         continue;
         }else if(strcmp1(&lakon[8*i],"ESPRNGC")==0){
         continue;
         }else if(strcmp1(&lakon[8*i],"ESPRNGF")==0){
         continue;
             }else if(strcmp1(&lakon[8*i],"DCOUP3D")==0){
         continue;
         }
         nelout++;
     }
     }else{
     nelout=*ne;
     }
 
     /* storing the topology */
 
     if(strcmp1(output,"asc")==0){
       fprintf(f1,"%5s%1s                  %12" ITGFORMAT "%38" ITGFORMAT "\n",p3,c,nelout,one);
     }else{
       fprintf(f1,"%5s%1s                  %12" ITGFORMAT "%38" ITGFORMAT "\n",p3,c,nelout,two);
     }
     nemax=*ne0;
 
     for(i=0;i<*ne0;i++){
       if(ipkon[i]<=-1){
       continue;
       }else if(strcmp1(&lakon[8*i],"F")==0){
       continue;
       }else if(strcmp1(&lakon[8*i],"ESPRNGC")==0){
       continue;
       }else if(strcmp1(&lakon[8*i],"ESPRNGF")==0){
       continue;
       }else if(strcmp1(&lakon[8*i],"DCOUP3D")==0){
       continue;
       }else{
       indexe=ipkon[i];
       }
       imat=ielmat[i*mi[2]];
       if(strcmp1(&lakon[8*i+3],"2")==0){
 
       /* 20-node brick element */
 
     if(((strcmp1(&lakon[8*i+6]," ")==0)||
             (strcmp1(&filab[4],"E")==0)||
         (strcmp1(&lakon[8*i+6],"I")==0))&&
            (strcmp2(&lakon[8*i+6],"LC",2)!=0)){
       if(strcmp1(output,"asc")==0){
         fprintf(f1,"%3s%10" ITGFORMAT "%5s%5s%5" ITGFORMAT "\n%3s",
             m1,i+1,p4,p0,imat,m2);
         for(j=0;j<10;j++)fprintf(f1,"%10" ITGFORMAT "",kon[indexe+j]);
         fprintf(f1,"\n%3s",m2);
         for(j=10;j<12;j++)fprintf(f1,"%10" ITGFORMAT "",kon[indexe+j]);
         for(j=16;j<19;j++)fprintf(f1,"%10" ITGFORMAT "",kon[indexe+j]);
         for(j=19;j<20;j++)fprintf(f1,"%10" ITGFORMAT "",kon[indexe+j]);
         for(j=12;j<16;j++)fprintf(f1,"%10" ITGFORMAT "",kon[indexe+j]);
         fprintf(f1,"\n");
       }else{
         iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
         iw=(int)ip4;fwrite(&iw,sizeof(int),1,f1);
         iw=(int)ip0;fwrite(&iw,sizeof(int),1,f1);
         iw=(int)imat;fwrite(&iw,sizeof(int),1,f1);
         for(j=0;j<10;j++){iw=(int)kon[indexe+j];
                           fwrite(&iw,sizeof(int),1,f1);}
         for(j=10;j<12;j++){iw=(int)kon[indexe+j];
                           fwrite(&iw,sizeof(int),1,f1);}
         for(j=16;j<19;j++){iw=(int)kon[indexe+j];
                           fwrite(&iw,sizeof(int),1,f1);}
         for(j=19;j<20;j++){iw=(int)kon[indexe+j];
                           fwrite(&iw,sizeof(int),1,f1);}
         for(j=12;j<16;j++){iw=(int)kon[indexe+j];
                           fwrite(&iw,sizeof(int),1,f1);}
       }
     }else if(strcmp2(&lakon[8*i+6],"LC",2)==0){
 
           /* composite material */
 
           /* 20-node brick elements */
 
       nlayer=0;
       for(k=0;k<mi[2];k++){
         if(ielmat[i*mi[2]+k]==0) break;
         nlayer++;
       }
       for(k=0;k<nlayer;k++){
         nemax++;
         if(strcmp1(output,"asc")==0){
           fprintf(f1,"%3s%10" ITGFORMAT "%5s%5s%5" ITGFORMAT "\n%3s",
               m1,nemax,p4,p0,imat,m2);
           for(j=0;j<10;j++)fprintf(f1,"%10" ITGFORMAT "",kon[indexe+28+20*k+j]);
           fprintf(f1,"\n%3s",m2);
           for(j=10;j<12;j++)fprintf(f1,"%10" ITGFORMAT "",kon[indexe+28+20*k+j]);
           for(j=16;j<19;j++)fprintf(f1,"%10" ITGFORMAT "",kon[indexe+28+20*k+j]);
           for(j=19;j<20;j++)fprintf(f1,"%10" ITGFORMAT "",kon[indexe+28+20*k+j]);
           for(j=12;j<16;j++)fprintf(f1,"%10" ITGFORMAT "",kon[indexe+28+20*k+j]);
           fprintf(f1,"\n");
         }else{
           iw=(int)nemax;fwrite(&iw,sizeof(int),1,f1);
           iw=(int)ip4;fwrite(&iw,sizeof(int),1,f1);
           iw=(int)ip0;fwrite(&iw,sizeof(int),1,f1);
           iw=(int)imat;fwrite(&iw,sizeof(int),1,f1);
           for(j=0;j<10;j++){iw=(int)kon[indexe+28+20*k+j];
                           fwrite(&iw,sizeof(int),1,f1);}
           for(j=10;j<12;j++){iw=(int)kon[indexe+28+20*k+j];
                           fwrite(&iw,sizeof(int),1,f1);}
           for(j=16;j<19;j++){iw=(int)kon[indexe+28+20*k+j];
                           fwrite(&iw,sizeof(int),1,f1);}
           for(j=19;j<20;j++){iw=(int)kon[indexe+28+20*k+j];
                           fwrite(&iw,sizeof(int),1,f1);}
           for(j=12;j<16;j++){iw=(int)kon[indexe+28+20*k+j];
                           fwrite(&iw,sizeof(int),1,f1);}
         }
       }
     }else if(strcmp1(&lakon[8*i+6],"B")==0){
 
         /* 3-node beam element */
 
       if(strcmp1(output,"asc")==0){
         fprintf(f1,"%3s%10" ITGFORMAT "%5s%5s%5" ITGFORMAT "\n",m1,i+1,p12,p0,imat);
         fprintf(f1,"%3s%10" ITGFORMAT "%10" ITGFORMAT "%10" ITGFORMAT "\n",m2,kon[indexe+20],
             kon[indexe+22],kon[indexe+21]);
       }else{
         iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
         iw=(int)ip12;fwrite(&iw,sizeof(int),1,f1);
         iw=(int)ip0;fwrite(&iw,sizeof(int),1,f1);
         iw=(int)imat;fwrite(&iw,sizeof(int),1,f1);
         iw=(int)kon[indexe+20];fwrite(&iw,sizeof(int),1,f1);
         iw=(int)kon[indexe+22];fwrite(&iw,sizeof(int),1,f1);
         iw=(int)kon[indexe+21];fwrite(&iw,sizeof(int),1,f1);
       }
     }else{
 
         /* 8-node 2d element */
         
       if(strcmp1(&lakon[8*i+6],"A")==0) iaxial=1;
       if(strcmp1(output,"asc")==0){
         fprintf(f1,"%3s%10" ITGFORMAT "%5s%5s%5" ITGFORMAT "\n%3s",
                     m1,i+1,p10,p0,imat,m2);
         for(j=0;j<8;j++)fprintf(f1,"%10" ITGFORMAT "",kon[indexe+20+j]);
         fprintf(f1,"\n");
       }else{
         iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
         iw=(int)ip10;fwrite(&iw,sizeof(int),1,f1);
         iw=(int)ip0;fwrite(&iw,sizeof(int),1,f1);
         iw=(int)imat;fwrite(&iw,sizeof(int),1,f1);
         for(j=0;j<8;j++){iw=(int)kon[indexe+20+j];
                           fwrite(&iw,sizeof(int),1,f1);}
       }
     }
       }else if(strcmp1(&lakon[8*i+3],"8")==0){
       if((strcmp1(&lakon[8*i+6]," ")==0)||
              (strcmp1(&filab[4],"E")==0)){
 
               /* 8-node brick element */
 
           if(strcmp1(output,"asc")==0){
           fprintf(f1,"%3s%10" ITGFORMAT "%5s%5s%5" ITGFORMAT "\n%3s",
               m1,i+1,p1,p0,imat,m2);
           for(j=0;j<8;j++)fprintf(f1,"%10" ITGFORMAT "",kon[indexe+j]);
           fprintf(f1,"\n");
           }else{
           iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
           iw=(int)ip1;fwrite(&iw,sizeof(int),1,f1);
           iw=(int)ip0;fwrite(&iw,sizeof(int),1,f1);
           iw=(int)imat;fwrite(&iw,sizeof(int),1,f1);
           for(j=0;j<8;j++){iw=(int)kon[indexe+j];
               fwrite(&iw,sizeof(int),1,f1);}
           }
       }else if(strcmp1(&lakon[8*i+6],"B")==0){
 
               /* 2-node 1d element */
 
           if(strcmp1(&lakon[8*i+4],"R")==0){
           if(strcmp1(output,"asc")==0){
               fprintf(f1,"%3s%10" ITGFORMAT "%5s%5s%5" ITGFORMAT "\n",m1,i+1,p11,p0,imat);
               fprintf(f1,"%3s%10" ITGFORMAT "%10" ITGFORMAT "\n",m2,kon[indexe+8],
                   kon[indexe+9]);
           }else{
               iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
               iw=(int)ip11;fwrite(&iw,sizeof(int),1,f1);
               iw=(int)ip0;fwrite(&iw,sizeof(int),1,f1);
               iw=(int)imat;fwrite(&iw,sizeof(int),1,f1);
               iw=(int)kon[indexe+8];fwrite(&iw,sizeof(int),1,f1);
               iw=(int)kon[indexe+9];fwrite(&iw,sizeof(int),1,f1);
           }
           }else if(strcmp1(&lakon[8*i+4],"I")==0){
           if(strcmp1(output,"asc")==0){
               fprintf(f1,"%3s%10" ITGFORMAT "%5s%5s%5" ITGFORMAT "\n",m1,i+1,p11,p0,imat);
               fprintf(f1,"%3s%10" ITGFORMAT "%10" ITGFORMAT "\n",m2,kon[indexe+11],
                   kon[indexe+12]);
           }else{
               iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
               iw=(int)ip11;fwrite(&iw,sizeof(int),1,f1);
               iw=(int)ip0;fwrite(&iw,sizeof(int),1,f1);
               iw=(int)imat;fwrite(&iw,sizeof(int),1,f1);
               iw=(int)kon[indexe+11];fwrite(&iw,sizeof(int),1,f1);
               iw=(int)kon[indexe+12];fwrite(&iw,sizeof(int),1,f1);
           }
           }
       }else{
 
               /* 4-node 2d element */
 
           if(strcmp1(&lakon[8*i+6],"A")==0) iaxial=1;
           if((strcmp1(&lakon[8*i+4],"R")==0)||
          (strcmp1(&lakon[8*i+4]," ")==0)){
           if(strcmp1(output,"asc")==0){
               fprintf(f1,"%3s%10" ITGFORMAT "%5s%5s%5" ITGFORMAT "\n%3s",
                   m1,i+1,p9,p0,imat,m2);
               for(j=0;j<4;j++)fprintf(f1,"%10" ITGFORMAT "",kon[indexe+8+j]);
               fprintf(f1,"\n");
           }else{
               iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
               iw=(int)ip9;fwrite(&iw,sizeof(int),1,f1);
               iw=(int)ip0;fwrite(&iw,sizeof(int),1,f1);
               iw=(int)imat;fwrite(&iw,sizeof(int),1,f1);
               for(j=0;j<4;j++){iw=(int)kon[indexe+8+j];
               fwrite(&iw,sizeof(int),1,f1);}
           }
           }else if(strcmp1(&lakon[8*i+4],"I")==0){
           if(strcmp1(output,"asc")==0){
               fprintf(f1,"%3s%10" ITGFORMAT "%5s%5s%5" ITGFORMAT "\n%3s",
                   m1,i+1,p9,p0,imat,m2);
               for(j=0;j<4;j++)fprintf(f1,"%10" ITGFORMAT "",kon[indexe+11+j]);
               fprintf(f1,"\n");
           }else{
               iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
               iw=(int)ip9;fwrite(&iw,sizeof(int),1,f1);
               iw=(int)ip0;fwrite(&iw,sizeof(int),1,f1);
               iw=(int)imat;fwrite(&iw,sizeof(int),1,f1);
               for(j=0;j<4;j++){iw=(int)kon[indexe+11+j];
               fwrite(&iw,sizeof(int),1,f1);}
           }
           }
       }
       }else if((strcmp1(&lakon[8*i+3],"10")==0)||
                (strcmp1(&lakon[8*i+3],"14")==0)){
 
     /* 10-node tetrahedral element */
 
     if(strcmp1(output,"asc")==0){
       fprintf(f1,"%3s%10" ITGFORMAT "%5s%5s%5" ITGFORMAT "\n%3s",
           m1,i+1,p6,p0,imat,m2);
       for(j=0;j<10;j++)fprintf(f1,"%10" ITGFORMAT "",kon[indexe+j]);
       fprintf(f1,"\n");
     }else{
       iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
       iw=(int)ip6;fwrite(&iw,sizeof(int),1,f1);
       iw=(int)ip0;fwrite(&iw,sizeof(int),1,f1);
       iw=(int)imat;fwrite(&iw,sizeof(int),1,f1);
       for(j=0;j<10;j++){iw=(int)kon[indexe+j];
                           fwrite(&iw,sizeof(int),1,f1);}
     }
       }else if(strcmp1(&lakon[8*i+3],"4")==0){
 
     /* 4-node tetrahedral element */
 
     if(strcmp1(output,"asc")==0){
       fprintf(f1,"%3s%10" ITGFORMAT "%5s%5s%5" ITGFORMAT "\n%3s",
           m1,i+1,p3,p0,imat,m2);
       for(j=0;j<4;j++)fprintf(f1,"%10" ITGFORMAT "",kon[indexe+j]);
       fprintf(f1,"\n");
     }else{
       iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
       iw=(int)ip3;fwrite(&iw,sizeof(int),1,f1);
       iw=(int)ip0;fwrite(&iw,sizeof(int),1,f1);
       iw=(int)imat;fwrite(&iw,sizeof(int),1,f1);
       for(j=0;j<4;j++){iw=(int)kon[indexe+j];
                           fwrite(&iw,sizeof(int),1,f1);}
     }
       }else if(strcmp1(&lakon[8*i+3],"15")==0){
     if(((strcmp1(&lakon[8*i+6]," ")==0)||
            (strcmp1(&filab[4],"E")==0))&&
            (strcmp2(&lakon[8*i+6],"LC",2)!=0)){
 
           /* 15-node wedge element */
 
       if(strcmp1(output,"asc")==0){
         fprintf(f1,"%3s%10" ITGFORMAT "%5s%5s%5" ITGFORMAT "\n%3s",
             m1,i+1,p5,p0,imat,m2);
         for(j=0;j<9;j++)fprintf(f1,"%10" ITGFORMAT "",kon[indexe+j]);
         for(j=12;j<13;j++)fprintf(f1,"%10" ITGFORMAT "",kon[indexe+j]);
         fprintf(f1,"\n%3s",m2);
         for(j=13;j<15;j++)fprintf(f1,"%10" ITGFORMAT "",kon[indexe+j]);
         for(j=9;j<12;j++)fprintf(f1,"%10" ITGFORMAT "",kon[indexe+j]);
         fprintf(f1,"\n");
       }else{
         iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
         iw=(int)ip5;fwrite(&iw,sizeof(int),1,f1);
         iw=(int)ip0;fwrite(&iw,sizeof(int),1,f1);
         iw=(int)imat;fwrite(&iw,sizeof(int),1,f1);
         for(j=0;j<9;j++){iw=(int)kon[indexe+j];
                           fwrite(&iw,sizeof(int),1,f1);}
         for(j=12;j<13;j++){iw=(int)kon[indexe+j];
                           fwrite(&iw,sizeof(int),1,f1);}
         for(j=13;j<15;j++){iw=(int)kon[indexe+j];
                           fwrite(&iw,sizeof(int),1,f1);}
         for(j=9;j<12;j++){iw=(int)kon[indexe+j];
                           fwrite(&iw,sizeof(int),1,f1);}
       }
 
    }else if(strcmp2(&lakon[8*i+6],"LC",2)==0){
 
           /* composite material */
 
           /* 15-node wedge elements */
 
      nlayer=0;
      for(k=0;k<mi[2];k++){
        if(ielmat[i*mi[2]+k]==0) break;
        nlayer++;
      }
      for(k=0;k<nlayer;k++){
        nemax++;
        if(strcmp1(output,"asc")==0){
          fprintf(f1,"%3s%10" ITGFORMAT "%5s%5s%5" ITGFORMAT "\n%3s",
              m1,nemax,p5,p0,imat,m2);
          for(j=0;j<9;j++)fprintf(f1,"%10" ITGFORMAT "",kon[indexe+21+15*k+j]);
          for(j=12;j<13;j++)fprintf(f1,"%10" ITGFORMAT "",kon[indexe+21+15*k+j]);
          fprintf(f1,"\n%3s",m2);
          for(j=13;j<15;j++)fprintf(f1,"%10" ITGFORMAT "",kon[indexe+21+15*k+j]);
          for(j=9;j<12;j++)fprintf(f1,"%10" ITGFORMAT "",kon[indexe+21+15*k+j]);
          fprintf(f1,"\n");
        }else{
          iw=(int)nemax;fwrite(&iw,sizeof(int),1,f1);
          iw=(int)ip5;fwrite(&iw,sizeof(int),1,f1);
          iw=(int)ip0;fwrite(&iw,sizeof(int),1,f1);
          iw=(int)imat;fwrite(&iw,sizeof(int),1,f1);
          for(j=0;j<9;j++){iw=(int)kon[indexe+21+15*k+j];
                            fwrite(&iw,sizeof(int),1,f1);}
          for(j=12;j<13;j++){iw=(int)kon[indexe+21+15*k+j];
                            fwrite(&iw,sizeof(int),1,f1);}
          for(j=13;j<15;j++){iw=(int)kon[indexe+21+15*k+j];
                            fwrite(&iw,sizeof(int),1,f1);}
          for(j=9;j<12;j++){iw=(int)kon[indexe+21+15*k+j];
                            fwrite(&iw,sizeof(int),1,f1);}
        }
      }
     }else{
 
       /* 6-node 2d element */
 
       if(strcmp1(&lakon[8*i+6],"A")==0) iaxial=1;
       if(strcmp1(output,"asc")==0){
         fprintf(f1,"%3s%10" ITGFORMAT "%5s%5s%5" ITGFORMAT "\n%3s",
             m1,i+1,p8,p0,imat,m2);
         for(j=0;j<6;j++)fprintf(f1,"%10" ITGFORMAT "",kon[indexe+15+j]);
         fprintf(f1,"\n");
       }else{
         iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
         iw=(int)ip8;fwrite(&iw,sizeof(int),1,f1);
         iw=(int)ip0;fwrite(&iw,sizeof(int),1,f1);
         iw=(int)imat;fwrite(&iw,sizeof(int),1,f1);
         for(j=0;j<6;j++){iw=(int)kon[indexe+15+j];
                           fwrite(&iw,sizeof(int),1,f1);}
       }
     }
       }else if(strcmp1(&lakon[8*i+3],"6")==0){
       if((strcmp1(&lakon[8*i+6]," ")==0)||
              (strcmp1(&filab[4],"E")==0)){
 
               /* 6-node wedge element */
 
           if(strcmp1(output,"asc")==0){
           fprintf(f1,"%3s%10" ITGFORMAT "%5s%5s%5" ITGFORMAT "\n%3s",
               m1,i+1,p2,p0,imat,m2);
           for(j=0;j<6;j++)fprintf(f1,"%10" ITGFORMAT "",kon[indexe+j]);
           fprintf(f1,"\n");
           }else{
           iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
           iw=(int)ip2;fwrite(&iw,sizeof(int),1,f1);
           iw=(int)ip0;fwrite(&iw,sizeof(int),1,f1);
           iw=(int)imat;fwrite(&iw,sizeof(int),1,f1);
           for(j=0;j<6;j++){iw=(int)kon[indexe+j];
               fwrite(&iw,sizeof(int),1,f1);}
           }
       }else{
 
               /* 3-node 2d element */
 
           if(strcmp1(&lakon[8*i+6],"A")==0) iaxial=1;
           if(strcmp1(output,"asc")==0){
           fprintf(f1,"%3s%10" ITGFORMAT "%5s%5s%5" ITGFORMAT "\n%3s",
               m1,i+1,p7,p0,imat,m2);
           for(j=0;j<3;j++)fprintf(f1,"%10" ITGFORMAT "",kon[indexe+6+j]);
           fprintf(f1,"\n");
           }else{
           iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
           iw=(int)ip7;fwrite(&iw,sizeof(int),1,f1);
           iw=(int)ip0;fwrite(&iw,sizeof(int),1,f1);
           iw=(int)imat;fwrite(&iw,sizeof(int),1,f1);
           for(j=0;j<3;j++){iw=(int)kon[indexe+6+j];
               fwrite(&iw,sizeof(int),1,f1);}
           }
       }
       }else if((strcmp1(&lakon[8*i],"D")==0)&&(ithermal[1]>1)){
       if(kon[indexe]==0){
 
               /* 2-node 1d element (network entry element) */
 
           if(strcmp1(output,"asc")==0){
           fprintf(f1,"%3s%10" ITGFORMAT "%5s%5s%5" ITGFORMAT "\n",m1,i+1,p11,p0,imat);
           fprintf(f1,"%3s%10" ITGFORMAT "%10" ITGFORMAT "\n",m2,
               kon[indexe+1],kon[indexe+2]);
           }else{
           iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
           iw=(int)ip11;fwrite(&iw,sizeof(int),1,f1);
           iw=(int)ip0;fwrite(&iw,sizeof(int),1,f1);
           iw=(int)imat;fwrite(&iw,sizeof(int),1,f1);
           iw=(int)kon[indexe+1];fwrite(&iw,sizeof(int),1,f1);
           iw=(int)kon[indexe+2];fwrite(&iw,sizeof(int),1,f1);
           }
       }else if(kon[indexe+2]==0){
 
               /* 2-node 1d element (network exit element) */
 
           if(strcmp1(output,"asc")==0){
           fprintf(f1,"%3s%10" ITGFORMAT "%5s%5s%5" ITGFORMAT "\n",m1,i+1,p11,p0,imat);
           fprintf(f1,"%3s%10" ITGFORMAT "%10" ITGFORMAT "\n",m2,kon[indexe],
               kon[indexe+1]);
           }else{
           iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
           iw=(int)ip11;fwrite(&iw,sizeof(int),1,f1);
           iw=(int)ip0;fwrite(&iw,sizeof(int),1,f1);
           iw=(int)imat;fwrite(&iw,sizeof(int),1,f1);
           iw=(int)kon[indexe];fwrite(&iw,sizeof(int),1,f1);
           iw=(int)kon[indexe+1];fwrite(&iw,sizeof(int),1,f1);
           }
       }else{
 
               /* 3-node 1d element (genuine network element) */
 
           if(strcmp1(output,"asc")==0){
           fprintf(f1,"%3s%10" ITGFORMAT "%5s%5s%5" ITGFORMAT "\n",m1,i+1,p12,p0,imat);
           fprintf(f1,"%3s%10" ITGFORMAT "%10" ITGFORMAT "%10" ITGFORMAT "\n",m2,kon[indexe],
               kon[indexe+2],kon[indexe+1]);
           }else{
           iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
           iw=(int)ip12;fwrite(&iw,sizeof(int),1,f1);
           iw=(int)ip0;fwrite(&iw,sizeof(int),1,f1);
           iw=(int)imat;fwrite(&iw,sizeof(int),1,f1);
           iw=(int)kon[indexe];fwrite(&iw,sizeof(int),1,f1);
           iw=(int)kon[indexe+2];fwrite(&iw,sizeof(int),1,f1);
           iw=(int)kon[indexe+1];fwrite(&iw,sizeof(int),1,f1);
           }
       }
       }else if((strcmp1(&lakon[8*i],"E")==0)&&
                (strcmp1(&lakon[8*i+6],"A")==0)){
 
       /* 2-node 1d element (spring element) */
 
     if(strcmp1(output,"asc")==0){
       fprintf(f1,"%3s%10" ITGFORMAT "%5s%5s%5" ITGFORMAT "\n",m1,i+1,p11,p0,imat);
       fprintf(f1,"%3s%10" ITGFORMAT "%10" ITGFORMAT "\n",m2,kon[indexe],kon[indexe+1]);
     }else{
       iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
       iw=(int)ip11;fwrite(&iw,sizeof(int),1,f1);
       iw=(int)ip0;fwrite(&iw,sizeof(int),1,f1);
       iw=(int)imat;fwrite(&iw,sizeof(int),1,f1);
       iw=(int)kon[indexe];fwrite(&iw,sizeof(int),1,f1);
       iw=(int)kon[indexe+1];fwrite(&iw,sizeof(int),1,f1);
     }
       }
     }
     if(strcmp1(output,"asc")==0)fprintf(f1,"%3s\n",m3);
 
     if(*nmethod==0){fclose(f1);return;}
   }
 
   /*  for cyclic symmetry frequency calculations only results for
       even numbers (= odd modes, numbering starts at 0) are stored */
 
   if((*nmethod==2)&&(((*mode/2)*2!=*mode)&&(*noddiam>=0))){fclose(f1);return;}
 
   /* storing the displacements in the nodes */
   
   if((*nmethod!=5)||(*mode==-1)){
       if((strcmp1(filab,"U ")==0)&&(*ithermal!=2)){
       iselect=1;
       
       frdset(filab,set,&iset,istartset,iendset,ialset,
          inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
          ngraph);
       
       frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
             &noutloc,description,kode,nmethod,f1,output,istep,iinc);
       
       if(mi[1]==3){
 
           fprintf(f1," -4  DISP        4    1\n");
           fprintf(f1," -5  D1          1    2    1    0\n");
           fprintf(f1," -5  D2          1    2    2    0\n");
           fprintf(f1," -5  D3          1    2    3    0\n");
           fprintf(f1," -5  ALL         1    2    0    0    1ALL\n");
           
           frdvector(v,&iset,ntrans,filab,&nkcoords,inum,m1,inotr,
             trab,co,istartset,iendset,ialset,mi,ngraph,f1,output,m3);
 
       }else if((mi[1]>3)&&(mi[1]<7)){
 
           fprintf(f1," -4  DISP        %1" ITGFORMAT "    1\n",mi[1]);
           for(j=1;j<=mi[1];j++){
           fprintf(f1," -5  D%1" ITGFORMAT "          1    1    0    0\n",j);
           }
 
           frdgeneralvector(v,&iset,ntrans,filab,&nkcoords,inum,m1,inotr,
             trab,co,istartset,iendset,ialset,mi,ngraph,f1,output,m3);
       }else{
           printf("*WARNING in frd:\n");
           printf("         for output purposes only 4, 5 or 6\n");
           printf("         degrees of freedom are allowed\n");
           printf("         for generalized vectors;\n");
           printf("         actual degrees of freedom = %d\n",mi[1]);
           printf("         output request ist not performed;\n");
       }
       }
   }
 
   /*     storing the imaginary part of displacements in the nodes
          for the odd modes of cyclic symmetry calculations */
 
   if(*noddiam>=0){
     if((strcmp1(filab,"U ")==0)&&(*ithermal!=2)){
     
       frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
         &noutloc,description,kode,nmethod,f1,output,istep,iinc);
 
       fprintf(f1," -4  DISPI       4    1\n");
       fprintf(f1," -5  D1          1    2    1    0\n");
       fprintf(f1," -5  D2          1    2    2    0\n");
       fprintf(f1," -5  D3          1    2    3    0\n");
       fprintf(f1," -5  ALL         1    2    0    0    1ALL\n");
       
       frdvector(&v[*nk*mt],&iset,ntrans,filab,&nkcoords,inum,m1,inotr,
         trab,co,istartset,iendset,ialset,mi,ngraph,f1,output,m3);
     }
   }
 
   /*     storing the imaginary part of displacements in the nodes
          for steady state calculations */
 
   if((*nmethod==5)&&(*mode==0)){
     if((strcmp1(filab,"U ")==0)&&(*ithermal!=2)){
     iselect=1;
     
     frdset(filab,set,&iset,istartset,iendset,ialset,
            inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
            ngraph);
     
       frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
         &noutloc,description,kode,nmethod,f1,output,istep,iinc);
 
       fprintf(f1," -4  DISPI       4    1\n");
       fprintf(f1," -5  D1          1    2    1    0\n");
       fprintf(f1," -5  D2          1    2    2    0\n");
       fprintf(f1," -5  D3          1    2    3    0\n");
       fprintf(f1," -5  ALL         1    2    0    0    1ALL\n");
       
       frdvector(v,&iset,ntrans,filab,&nkcoords,inum,m1,inotr,
         trab,co,istartset,iendset,ialset,mi,ngraph,f1,output,m3);
     }
   }
 
   /* storing the velocities in the nodes */
   
   if((strcmp1(&filab[1740],"V   ")==0)&&(*ithermal!=2)){
     iselect=1;
     
     frdset(&filab[1740],set,&iset,istartset,iendset,ialset,
        inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
        ngraph);
     
     frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
           &noutloc,description,kode,nmethod,f1,output,istep,iinc);
 
     fprintf(f1," -4  VELO        4    1\n");
     fprintf(f1," -5  V1          1    2    1    0\n");
     fprintf(f1," -5  V2          1    2    2    0\n");
     fprintf(f1," -5  V3          1    2    3    0\n");
     fprintf(f1," -5  ALL         1    2    0    0    1ALL\n");
 
     frdvector(veold,&iset,ntrans,&filab[1740],&nkcoords,inum,m1,inotr,
           trab,co,istartset,iendset,ialset,mi,ngraph,f1,output,m3);
   }
 
   /* storing the temperatures in the nodes */
   
   if(strcmp1(&filab[87],"NT  ")==0){
     iselect=0;
     
     frdset(&filab[87],set,&iset,istartset,iendset,ialset,
        inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
        ngraph);
     
     frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
           &noutloc,description,kode,nmethod,f1,output,istep,iinc);
 
     fprintf(f1," -4  NDTEMP      1    1\n");
     fprintf(f1," -5  T           1    1    0    0\n");
 
     if(*ithermal<=1){
       frdselect(t1,t1,&iset,&nkcoords,inum,m1,istartset,iendset,
                 ialset,ngraph,&ncompscalar,ifieldscalar,icompscalar,
                 nfieldscalar,&iselect,m2,f1,output,m3);
     }else{
       frdselect(v,v,&iset,&nkcoords,inum,m1,istartset,iendset,
                 ialset,ngraph,&ncompscalar,ifieldscalar,icompscalar,
                 nfieldvector0,&iselect,m2,f1,output,m3);
     }
   }
 
   /* storing the electrical potential in the nodes */
   
   if((strcmp1(&filab[3654],"POT ")==0)&&(*ithermal==2)){
     iselect=0;
     
     frdset(&filab[3654],set,&iset,istartset,iendset,ialset,
        inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
        ngraph);
     
     frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
           &noutloc,description,kode,nmethod,f1,output,istep,iinc);
 
     fprintf(f1," -4  ELPOT       1    1\n");
     fprintf(f1," -5  V           1    1    0    0\n");
     
     frdselect(v,v,&iset,&nkcoords,inum,m1,istartset,iendset,
           ialset,ngraph,&ncompscalar,ifieldscalar,icompscalar,
           nfieldvector0,&iselect,m2,f1,output,m3);
   }
 
   /* storing the stresses in the nodes */
   
   if((*nmethod!=5)||(*mode==-1)){
       if((strcmp1(&filab[174],"S   ")==0)&&(*ithermal!=2)){
       iselect=1;
       
       frdset(&filab[174],set,&iset,istartset,iendset,ialset,
          inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
          ngraph);
       
       frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
             &noutloc,description,kode,nmethod,f1,output,istep,iinc);
       
       fprintf(f1," -4  STRESS      6    1\n");
       fprintf(f1," -5  SXX         1    4    1    1\n");
       fprintf(f1," -5  SYY         1    4    2    2\n");
       fprintf(f1," -5  SZZ         1    4    3    3\n");
       fprintf(f1," -5  SXY         1    4    1    2\n");
       fprintf(f1," -5  SYZ         1    4    2    3\n");
       fprintf(f1," -5  SZX         1    4    3    1\n");
       
       frdselect(stn,stn,&iset,&nkcoords,inum,m1,istartset,iendset,
             ialset,ngraph,&ncomptensor,ifieldtensor,icomptensor,
             nfieldtensor,&iselect,m2,f1,output,m3);
       
       }
   }
 
   /* storing the imaginary part of the stresses in the nodes
      for the odd modes of cyclic symmetry calculations */
   
   if(*noddiam>=0){
     if((strcmp1(&filab[174],"S   ")==0)&&(*ithermal!=2)){
       
       frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
         &noutloc,description,kode,nmethod,f1,output,istep,iinc);
       
       fprintf(f1," -4  STRESSI     6    1\n");
       fprintf(f1," -5  SXX         1    4    1    1\n");
       fprintf(f1," -5  SYY         1    4    2    2\n");
       fprintf(f1," -5  SZZ         1    4    3    3\n");
       fprintf(f1," -5  SXY         1    4    1    2\n");
       fprintf(f1," -5  SYZ         1    4    2    3\n");
       fprintf(f1," -5  SZX         1    4    3    1\n");
       
       frdselect(&stn[6**nk],stn,&iset,&nkcoords,inum,m1,istartset,iendset,
                 ialset,ngraph,&ncomptensor,ifieldtensor,icomptensor,
                 nfieldtensor,&iselect,m2,f1,output,m3);
       
     }
   }
 
   /* storing the imaginary part of the stresses in the nodes
      for steady state calculations */
   
   if((*nmethod==5)&&(*mode==0)){
     if((strcmp1(&filab[174],"S   ")==0)&&(*ithermal!=2)){
       iselect=1;
     
       frdset(&filab[174],set,&iset,istartset,iendset,ialset,
            inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
            ngraph);
       
       frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
         &noutloc,description,kode,nmethod,f1,output,istep,iinc);
       
       fprintf(f1," -4  STRESSI     6    1\n");
       fprintf(f1," -5  SXX         1    4    1    1\n");
       fprintf(f1," -5  SYY         1    4    2    2\n");
       fprintf(f1," -5  SZZ         1    4    3    3\n");
       fprintf(f1," -5  SXY         1    4    1    2\n");
       fprintf(f1," -5  SYZ         1    4    2    3\n");
       fprintf(f1," -5  SZX         1    4    3    1\n");
       
       frdselect(stn,stn,&iset,&nkcoords,inum,m1,istartset,iendset,
                 ialset,ngraph,&ncomptensor,ifieldtensor,icomptensor,
                 nfieldtensor,&iselect,m2,f1,output,m3);
       
     }
   }
 
   /* storing the electromagnetic field E in the nodes */
   
   if((strcmp1(&filab[3741],"EMFE")==0)&&(*ithermal!=2)){
     iselect=1;
     
     frdset(&filab[3741],set,&iset,istartset,iendset,ialset,
        inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
        ngraph);
     
     frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
           &noutloc,description,kode,nmethod,f1,output,istep,iinc);
 
     fprintf(f1," -4  EMFE        4    1\n");
     fprintf(f1," -5  E1          1    2    1    0\n");
     fprintf(f1," -5  E2          1    2    2    0\n");
     fprintf(f1," -5  E3          1    2    3    0\n");
     fprintf(f1," -5  ALL         1    2    0    0    1ALL\n");
 
     frdselect(stn,stn,&iset,&nkcoords,inum,m1,istartset,iendset,
                 ialset,ngraph,&ncompvector,ifieldvector,icompvector,
                 nfieldtensor,&iselect,m2,f1,output,m3);
 
   }
 
   /* storing the electromagnetic field B in the nodes */
   
   if((strcmp1(&filab[3828],"EMFB")==0)&&(*ithermal!=2)){
     iselect=1;
     
     frdset(&filab[3828],set,&iset,istartset,iendset,ialset,
        inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
        ngraph);
     
     frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
           &noutloc,description,kode,nmethod,f1,output,istep,iinc);
 
     fprintf(f1," -4  EMFB        4    1\n");
     fprintf(f1," -5  B1          1    2    1    0\n");
     fprintf(f1," -5  B2          1    2    2    0\n");
     fprintf(f1," -5  B3          1    2    3    0\n");
     fprintf(f1," -5  ALL         1    2    0    0    1ALL\n");
 
     frdselect(stn,stn,&iset,&nkcoords,inum,m1,istartset,iendset,
                 ialset,ngraph,&ncompvector,ifieldvector,icompvectorlast,
                 nfieldtensor,&iselect,m2,f1,output,m3);
 
   }
 
   /* storing the total strains in the nodes */
   
   if((*nmethod!=5)||(*mode==-1)){
       if((strcmp1(&filab[261],"E   ")==0)&&(*ithermal!=2)){
       iselect=1;
       
       frdset(&filab[261],set,&iset,istartset,iendset,ialset,
          inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
          ngraph);
       
       frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
             &noutloc,description,kode,nmethod,f1,output,istep,iinc);
       
       fprintf(f1," -4  TOSTRAIN    6    1\n");
       fprintf(f1," -5  EXX         1    4    1    1\n");
       fprintf(f1," -5  EYY         1    4    2    2\n");
       fprintf(f1," -5  EZZ         1    4    3    3\n");
       fprintf(f1," -5  EXY         1    4    1    2\n");
       fprintf(f1," -5  EYZ         1    4    2    3\n");
       fprintf(f1," -5  EZX         1    4    3    1\n");
       
       frdselect(een,een,&iset,&nkcoords,inum,m1,istartset,iendset,
             ialset,ngraph,&ncomptensor,ifieldtensor,icomptensor,
             nfieldtensor,&iselect,m2,f1,output,m3);
       
       }
   }
 
   /* storing the imaginary part of the total strains in the nodes
      for the odd modes of cyclic symmetry calculations */
   
   if(*noddiam>=0){
     if((strcmp1(&filab[261],"E   ")==0)&&(*ithermal!=2)){
       
       frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
         &noutloc,description,kode,nmethod,f1,output,istep,iinc);
       
       fprintf(f1," -4  TOSTRAII    6    1\n");
       fprintf(f1," -5  EXX         1    4    1    1\n");
       fprintf(f1," -5  EYY         1    4    2    2\n");
       fprintf(f1," -5  EZZ         1    4    3    3\n");
       fprintf(f1," -5  EXY         1    4    1    2\n");
       fprintf(f1," -5  EYZ         1    4    2    3\n");
       fprintf(f1," -5  EZX         1    4    3    1\n");
       
       frdselect(&een[6**nk],een,&iset,&nkcoords,inum,m1,istartset,iendset,
                 ialset,ngraph,&ncomptensor,ifieldtensor,icomptensor,
                 nfieldtensor,&iselect,m2,f1,output,m3);
       
     }
   }
 
   /* storing the imaginary part of the total strains in the nodes
      for steady state calculations */
   
   if((*nmethod==5)&&(*mode==0)){
       if((strcmp1(&filab[261],"E   ")==0)&&(*ithermal!=2)){
       iselect=1;
       
       frdset(&filab[261],set,&iset,istartset,iendset,ialset,
          inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
          ngraph);
       
       frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
             &noutloc,description,kode,nmethod,f1,output,istep,iinc);
       
       fprintf(f1," -4  TOSTRAII    6    1\n");
       fprintf(f1," -5  EXX         1    4    1    1\n");
       fprintf(f1," -5  EYY         1    4    2    2\n");
       fprintf(f1," -5  EZZ         1    4    3    3\n");
       fprintf(f1," -5  EXY         1    4    1    2\n");
       fprintf(f1," -5  EYZ         1    4    2    3\n");
       fprintf(f1," -5  EZX         1    4    3    1\n");
       
       frdselect(een,een,&iset,&nkcoords,inum,m1,istartset,iendset,
             ialset,ngraph,&ncomptensor,ifieldtensor,icomptensor,
             nfieldtensor,&iselect,m2,f1,output,m3);
       
       }
   }
 
   /* storing the mechanical strains in the nodes */
   
   if((*nmethod!=5)||(*mode==-1)){
       if((strcmp1(&filab[2697],"ME  ")==0)&&(*ithermal!=2)){
       iselect=1;
       
       frdset(&filab[2697],set,&iset,istartset,iendset,ialset,
          inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
          ngraph);
       
       frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
             &noutloc,description,kode,nmethod,f1,output,istep,iinc);
       
       fprintf(f1," -4  MESTRAIN    6    1\n");
       fprintf(f1," -5  MEXX        1    4    1    1\n");
       fprintf(f1," -5  MEYY        1    4    2    2\n");
       fprintf(f1," -5  MEZZ        1    4    3    3\n");
       fprintf(f1," -5  MEXY        1    4    1    2\n");
       fprintf(f1," -5  MEYZ        1    4    2    3\n");
       fprintf(f1," -5  MEZX        1    4    3    1\n");
       
       
       frdselect(emn,emn,&iset,&nkcoords,inum,m1,istartset,iendset,
             ialset,ngraph,&ncomptensor,ifieldtensor,icomptensor,
             nfieldtensor,&iselect,m2,f1,output,m3);
       
       }
   }
 
   /* storing the imaginary part of the mechanical strains in the nodes
      for the odd modes of cyclic symmetry calculations */
   
   if((*noddiam>=0)||((*nmethod==5)&&(*mode==0))){
     if((strcmp1(&filab[2697],"ME  ")==0)&&(*ithermal!=2)){
       
       frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
         &noutloc,description,kode,nmethod,f1,output,istep,iinc);
       
       fprintf(f1," -4  MESTRAII    6    1\n");
       fprintf(f1," -5  MEXX        1    4    1    1\n");
       fprintf(f1," -5  MEYY        1    4    2    2\n");
       fprintf(f1," -5  MEZZ        1    4    3    3\n");
       fprintf(f1," -5  MEXY        1    4    1    2\n");
       fprintf(f1," -5  MEYZ        1    4    2    3\n");
       fprintf(f1," -5  MEZX        1    4    3    1\n");
       
       frdselect(&emn[6**nk],een,&iset,&nkcoords,inum,m1,istartset,iendset,
                 ialset,ngraph,&ncomptensor,ifieldtensor,icomptensor,
                 nfieldtensor,&iselect,m2,f1,output,m3);
       
     }
   }
 
   /* storing the forces in the nodes */
   
   if((*nmethod!=5)||(*mode==-1)){
       if((strcmp1(&filab[348],"RF  ")==0)&&(*ithermal!=2)){
       iselect=1;
       
       frdset(&filab[348],set,&iset,istartset,iendset,ialset,
          inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
          ngraph);
       
       frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
             &noutloc,description,kode,nmethod,f1,output,istep,iinc);
       
       fprintf(f1," -4  FORC        4    1\n");
       fprintf(f1," -5  F1          1    2    1    0\n");
       fprintf(f1," -5  F2          1    2    2    0\n");
       fprintf(f1," -5  F3          1    2    3    0\n");
       fprintf(f1," -5  ALL         1    2    0    0    1ALL\n");
       
       if((iaxial==1)&&(strcmp1(&filab[352],"I")==0)){for(i=0;i<*nk;i++){fn[1+i*mt]*=180.;fn[2+i*mt]*=180.;fn[3+i*mt]*=180.;}}
       frdvector(fn,&iset,ntrans,&filab[348],&nkcoords,inum,m1,inotr,
             trab,co,istartset,iendset,ialset,mi,ngraph,f1,output,m3);
       if((iaxial==1)&&(strcmp1(&filab[352],"I")==0)){for(i=0;i<*nk;i++){fn[1+i*mt]/=180.;fn[2+i*mt]/=180.;fn[3+i*mt]/=180.;}}
       }
   }
 
   /*     storing the imaginary part of the forces in the nodes
          for the odd modes of cyclic symmetry calculations */
 
   if((*noddiam>=0)||((*nmethod==5)&&(*mode==0))){
     if((strcmp1(&filab[348],"RF  ")==0)&&(*ithermal!=2)){
     
       frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
         &noutloc,description,kode,nmethod,f1,output,istep,iinc);
 
       fprintf(f1," -4  FORCI       4    1\n");
       fprintf(f1," -5  F1          1    2    1    0\n");
       fprintf(f1," -5  F2          1    2    2    0\n");
       fprintf(f1," -5  F3          1    2    3    0\n");
       fprintf(f1," -5  ALL         1    2    0    0    1ALL\n");
       
       frdvector(&fn[*nk*mt],&iset,ntrans,filab,&nkcoords,inum,m1,inotr,
         trab,co,istartset,iendset,ialset,mi,ngraph,f1,output,m3);
     }
   }
 
   /* storing the equivalent plastic strains in the nodes */
   
   if((strcmp1(&filab[435],"PEEQ")==0)&&(*ithermal!=2)){
     iselect=1;
     
     frdset(&filab[435],set,&iset,istartset,iendset,ialset,
        inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
        ngraph);
     
     frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
           &noutloc,description,kode,nmethod,f1,output,istep,iinc);
 
     fprintf(f1," -4  PE          1    1\n");
     fprintf(f1," -5  PE          1    1    0    0\n");
 
     frdselect(epn,epn,&iset,&nkcoords,inum,m1,istartset,iendset,
                 ialset,ngraph,&ncompscalar,ifieldscalar,icompscalar,
                 nfieldscalar,&iselect,m2,f1,output,m3);
 
   }
 
   /* storing the energy in the nodes */
   
   if((strcmp1(&filab[522],"ENER")==0)&&(*ithermal!=2)){
     iselect=1;
     
     frdset(&filab[522],set,&iset,istartset,iendset,ialset,
        inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
        ngraph);
     
     frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
           &noutloc,description,kode,nmethod,f1,output,istep,iinc);
 
     fprintf(f1," -4  ENER        1    1\n");
     fprintf(f1," -5  ENER        1    1    0    0\n");
 
     frdselect(enern,enern,&iset,&nkcoords,inum,m1,istartset,iendset,
                 ialset,ngraph,&ncompscalar,ifieldscalar,icompscalar,
                 nfieldscalar,&iselect,m2,f1,output,m3);
 
   }
   
   /* storing the contact displacements and stresses at the slave nodes */
 
   /* node-to-face penalty */
   
   if((strcmp1(&filab[2175],"CONT")==0)&&(*mortar!=1)&&(*ithermal!=2)&&(*nmethod!=2)){
     
     for(i=*ne-1;i>=0;i--){
       if((strcmp1(&lakon[8*i+1],"S")!=0)||(strcmp1(&lakon[8*i+6],"C")!=0))
     break;
     }
     noutloc=*ne-i-1;
     
     frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
           &noutloc,description,kode,nmethod,f1,output,istep,iinc);
     
     fprintf(f1," -4  CONTACT     6    1\n");
     fprintf(f1," -5  COPEN       1    4    1    1\n");
     fprintf(f1," -5  CSLIP1      1    4    2    2\n");
     fprintf(f1," -5  CSLIP2      1    4    3    3\n");
     fprintf(f1," -5  CPRESS      1    4    1    2\n");
     fprintf(f1," -5  CSHEAR1     1    4    2    3\n");
     fprintf(f1," -5  CSHEAR2     1    4    3    1\n");
     
     for(i=*ne-1;i>=0;i--){
       if((strcmp1(&lakon[8*i+1],"S")!=0)||(strcmp1(&lakon[8*i+6],"C")!=0))
     break;
       strcpy1(text,&lakon[8*i+7],1);
       nope=atoi(text)+1;
       nodes=kon[ipkon[i]+nope-1];
       if(strcmp1(output,"asc")==0){
       fprintf(f1,"%3s%10" ITGFORMAT "",m1,nodes);
       for(j=0;j<6;j++)fprintf(f1,"%12.5E",(float)stx[6*mi[0]*i+j]);
       }else{
       iw=(int)(nodes);fwrite(&iw,sizeof(int),1,f1);
       for(j=0;j<6;j++){
           ifl=(float)stx[6*mi[0]*i+j];
           fwrite(&ifl,sizeof(float),1,f1);
       }
       }
      if(strcmp1(output,"asc")==0)fprintf(f1,"\n");
     }
     
     if(strcmp1(output,"asc")==0)fprintf(f1,"%3s\n",m3);
   }
 
   /* face-to-face penalty */
 
   if((*nmethod!=5)||(*mode==-1)){
       if((strcmp1(&filab[2175],"CONT")==0)&&(*mortar==1)&&(*ithermal!=2)){
       iselect=1;
       
       frdset(&filab[2175],set,&iset,istartset,iendset,ialset,
          inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
          ngraph);
       
       frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
             &noutloc,description,kode,nmethod,f1,output,istep,iinc);
       fprintf(f1," -4  CONTACT     6    1\n");
       fprintf(f1," -5  COPEN       1    4    1    1\n");
       fprintf(f1," -5  CSLIP1      1    4    2    2\n");
       fprintf(f1," -5  CSLIP2      1    4    3    3\n");
       fprintf(f1," -5  CPRESS      1    4    1    2\n");
       fprintf(f1," -5  CSHEAR1     1    4    2    3\n");
       fprintf(f1," -5  CSHEAR2     1    4    3    1\n");
       
       frdselect(cdn,cdn,&iset,&nkcoords,inum,m1,istartset,iendset,
             ialset,ngraph,&ncomptensor,ifieldtensor,icomptensor,
             nfieldtensor,&iselect,m2,f1,output,m3);
       
       }
   }
 
   /* storing imaginary part of the differential contact displacements 
      and the contact stresses for the odd modes of cyclic symmetry
      calculations */
 
   if((*noddiam>=0)||((*nmethod==5)&&(*mode==0))){
       if((strcmp1(&filab[2175],"CONT")==0)&&(*mortar==1)&&(*ithermal!=2)){
       iselect=1;
       
       frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
          &noutloc,description,kode,nmethod,f1,output,istep,iinc);
       fprintf(f1," -4  CONTACTI    6    1\n");
       fprintf(f1," -5  COPEN       1    4    1    1\n");
       fprintf(f1," -5  CSLIP1      1    4    2    2\n");
       fprintf(f1," -5  CSLIP2      1    4    3    3\n");
       fprintf(f1," -5  CPRESS      1    4    1    2\n");
       fprintf(f1," -5  CSHEAR1     1    4    2    3\n");
       fprintf(f1," -5  CSHEAR2     1    4    3    1\n");
       
       frdselect(&cdn[6**nk],cdn,&iset,&nkcoords,inum,m1,istartset,iendset,
          ialset,ngraph,&ncomptensor,ifieldtensor,icomptensor,
          nfieldtensor,&iselect,m2,f1,output,m3);
       
       }
   }
   /* storing the contact energy at the slave nodes */
   
   if((strcmp1(&filab[2262],"CELS")==0)&&(*ithermal!=2)){
     
     for(i=*ne-1;i>=0;i--){
       if((strcmp1(&lakon[8*i+1],"S")!=0)||(strcmp1(&lakon[8*i+6],"C")!=0))
     break;
     }
     noutloc=*ne-i-1;
     
     frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
           &noutloc,description,kode,nmethod,f1,output,istep,iinc);
     
     fprintf(f1," -4  CELS        1    1\n");
     fprintf(f1," -5  CELS        1    1    0    0\n");
     
     for(i=*ne-1;i>=0;i--){
       if((strcmp1(&lakon[8*i+1],"S")!=0)||(strcmp1(&lakon[8*i+6],"C")!=0))
     break;
       nope=atoi(&lakon[8*i+7])+1;
       nodes=kon[ipkon[i]+nope-1];
       if(strcmp1(output,"asc")==0){
       fprintf(f1,"%3s%10" ITGFORMAT "%12.5E\n",m1,nodes,(float)ener[i*mi[0]]);
       }else{
       iw=(int)(nodes);fwrite(&iw,sizeof(int),1,f1);
       ifl=(float)ener[i*mi[0]];
       fwrite(&ifl,sizeof(float),1,f1);
       }
     }
     
     if(strcmp1(output,"asc")==0)fprintf(f1,"%3s\n",m3);
   }
   
   /* storing the internal state variables in the nodes */
   
   if(strcmp1(&filab[609],"SDV ")==0){
     iselect=1;
     
     frdset(&filab[609],set,&iset,istartset,iendset,ialset,
        inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
        ngraph);
     
     frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
           &noutloc,description,kode,nmethod,f1,output,istep,iinc);
 
     fprintf(f1," -4  SDV        %2" ITGFORMAT "    1\n",*nstate_);
     for(j=1;j<=*nstate_;j++){
       fprintf(f1," -5  SDV%-2" ITGFORMAT "       1    1    0    0\n",j);
     }
 
     for(i=0;i<*nstate_;i++){
       ifieldstate[i]=1;icompstate[i]=i;
     }
     nfield[0]=*nstate_;
 
     frdselect(xstaten,xstaten,&iset,&nkcoords,inum,m1,istartset,iendset,
                 ialset,ngraph,nstate_,ifieldstate,icompstate,
                 nfield,&iselect,m2,f1,output,m3);
 
   }
   
   /* storing the heat flux in the nodes
      the heat flux has been extrapolated from the integration points
      in subroutine extrapolate.f, taking into account whether the 
      results are requested in the global system or in a local system.
      Therefore, subroutine frdvector cannot be used, since it assumes
      the values are stored in the global system */
   
   if((strcmp1(&filab[696],"HFL ")==0)&&(*ithermal>1)){
     iselect=1;
     
     frdset(&filab[696],set,&iset,istartset,iendset,ialset,
        inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
        ngraph);
     
     frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
           &noutloc,description,kode,nmethod,f1,output,istep,iinc);
 
     fprintf(f1," -4  FLUX        4    1\n");
     fprintf(f1," -5  F1          1    2    1    0\n");
     fprintf(f1," -5  F2          1    2    2    0\n");
     fprintf(f1," -5  F3          1    2    3    0\n");
     fprintf(f1," -5  ALL         1    2    0    0    1ALL\n");
 
     frdselect(qfn,qfn,&iset,&nkcoords,inum,m1,istartset,iendset,
                 ialset,ngraph,&ncompvector,ifieldvector,icompvector,
                 nfieldvector1,&iselect,m2,f1,output,m3);
 
   }
   
   /* storing the electrical current in the nodes
      (cf. heat flux HFL above)  */
   
   if((strcmp1(&filab[3567],"ECD ")==0)&&(*ithermal==2)){
     iselect=1;
     
     frdset(&filab[3567],set,&iset,istartset,iendset,ialset,
        inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
        ngraph);
     
     frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
           &noutloc,description,kode,nmethod,f1,output,istep,iinc);
 
     fprintf(f1," -4  CURR        4    1\n");
     fprintf(f1," -5  j1          1    2    1    0\n");
     fprintf(f1," -5  j2          1    2    2    0\n");
     fprintf(f1," -5  j3          1    2    3    0\n");
     fprintf(f1," -5  ALL         1    2    0    0    1ALL\n");
 
     frdselect(qfn,qfn,&iset,&nkcoords,inum,m1,istartset,iendset,
                 ialset,ngraph,&ncompvector,ifieldvector,icompvector,
                 nfieldvector1,&iselect,m2,f1,output,m3);
 
   }
       
   /* storing the heat generation in the nodes */
 
   if((strcmp1(&filab[783],"RFL ")==0)&&(*ithermal>1)){
     iselect=1;
     
     frdset(&filab[783],set,&iset,istartset,iendset,ialset,
        inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
        ngraph);
     
     frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
           &noutloc,description,kode,nmethod,f1,output,istep,iinc);
 
     fprintf(f1," -4  RFL         1    1\n");
     fprintf(f1," -5  RFL         1    1    0    0\n");
 
     frdselect(fn,fn,&iset,&nkcoords,inum,m1,istartset,iendset,
                 ialset,ngraph,&ncompscalar,ifieldscalar,icompscalar,
                 nfieldvector0,&iselect,m2,f1,output,m3);
 
   }
   
   /* storing the Zienkiewicz-Zhu improved stresses in the nodes */
   
   if((*nmethod!=5)||(*mode==-1)){
       if((strcmp1(&filab[1044],"ZZS")==0)&&(*ithermal!=2)){
       
       FORTRAN(zienzhu,(co,nk,kon,ipkon,lakon,ne0,stn,ipneigh,neigh,
                stx,&mi[0]));
       
       iselect=1;
       
       frdset(&filab[1044],set,&iset,istartset,iendset,ialset,
          inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
          ngraph);
       
       frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
             &noutloc,description,kode,nmethod,f1,output,istep,iinc);
       
       fprintf(f1," -4  ZZSTR       6    1\n");
       fprintf(f1," -5  SXX         1    4    1    1\n");
       fprintf(f1," -5  SYY         1    4    2    2\n");
       fprintf(f1," -5  SZZ         1    4    3    3\n");
       fprintf(f1," -5  SXY         1    4    1    2\n");
       fprintf(f1," -5  SYZ         1    4    2    3\n");
       fprintf(f1," -5  SZX         1    4    3    1\n");
       
       frdselect(stn,stn,&iset,&nkcoords,inum,m1,istartset,iendset,
             ialset,ngraph,&ncomptensor,ifieldtensor,icomptensor,
             nfieldtensor,&iselect,m2,f1,output,m3);
       
       }
   }
 
   /* storing the imaginary part of the Zienkiewicz-Zhu 
      improved stresses in the nodes
      for the odd modes of cyclic symmetry calculations */
   
   if((*noddiam>=0)||((*nmethod==5)&&(*mode==0))){
     if((strcmp1(&filab[1044],"ZZS")==0)&&(*ithermal!=2)){
 
       FORTRAN(zienzhu,(co,nk,kon,ipkon,lakon,ne0,stn,ipneigh,neigh,
               &stx[6*mi[0]**ne],&mi[0]));
       
       frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
         &noutloc,description,kode,nmethod,f1,output,istep,iinc);
       
       fprintf(f1," -4  ZZSTRI      6    1\n");
       fprintf(f1," -5  SXX         1    4    1    1\n");
       fprintf(f1," -5  SYY         1    4    2    2\n");
       fprintf(f1," -5  SZZ         1    4    3    3\n");
       fprintf(f1," -5  SXY         1    4    1    2\n");
       fprintf(f1," -5  SYZ         1    4    2    3\n");
       fprintf(f1," -5  SZX         1    4    3    1\n");
       
       frdselect(stn,stn,&iset,&nkcoords,inum,m1,istartset,iendset,
                 ialset,ngraph,&ncomptensor,ifieldtensor,icomptensor,
                 nfieldtensor,&iselect,m2,f1,output,m3);
       
     }
   }
   
   /* storing the error estimator in the nodes */
   
   if((*nmethod!=5)||(*mode==-1)){
       if((strcmp1(&filab[1044],"ERR")==0)&&(*ithermal!=2)){
       
       nterms=6;
       FORTRAN(errorestimator,(stx,stn,ipkon,kon,lakon,nk,ne,
           mi,ielmat,&nterms,inum,co,vold,&filab[1048]));
       
       iselect=1;
       
       frdset(&filab[1044],set,&iset,istartset,iendset,ialset,
          inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
          ngraph);
       
       frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
             &noutloc,description,kode,nmethod,f1,output,istep,iinc);
       
       fprintf(f1," -4  ERROR       2    1\n");
       fprintf(f1," -5  STR(%%)      1    1    1    0\n");
       fprintf(f1," -5  REL         1    2    2    0\n");
       
       ncomp=2;
       ifield[0]=1;ifield[1]=1;
       icomp[0]=0;icomp[1]=1;
       
       frdselect(stn,stn,&iset,&nkcoords,inum,m1,istartset,iendset,
             ialset,ngraph,&ncomp,ifield,icomp,
             nfieldtensor,&iselect,m2,f1,output,m3);
       
       }
   }
 
   /* storing the imaginary part of the error estimator in the nodes
      for the odd modes of cyclic symmetry calculations */
   
   if((*noddiam>=0)||((*nmethod==5)&&(*mode==0))){
     if((strcmp1(&filab[1044],"ERR")==0)&&(*ithermal!=2)){
 
       nterms=6;
       FORTRAN(errorestimator,(&stx[6*mi[0]**ne],stn,ipkon,kon,lakon,nk,ne,
           mi,ielmat,&nterms,inum,co,vold,&filab[1048]));
       
       frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
         &noutloc,description,kode,nmethod,f1,output,istep,iinc);
 
       fprintf(f1," -4  ERRORI      2    1\n");
       fprintf(f1," -5  STR(%%)      1    1    1    0\n");
       fprintf(f1," -5  REL         1    2    2    0\n");
       
       ncomp=2;
       ifield[0]=1;ifield[1]=1;
       icomp[0]=0;icomp[1]=1;
 
       frdselect(stn,stn,&iset,&nkcoords,inum,m1,istartset,iendset,
                 ialset,ngraph,&ncomp,ifield,icomp,
                 nfieldtensor,&iselect,m2,f1,output,m3);
       
     }
   }
   
   /* storing the thermal error estimator in the nodes */
   
   if((*nmethod!=5)||(*mode==-1)){
       if((strcmp1(&filab[2784],"HER")==0)&&(*ithermal>1)){
       
       nterms=3;
       FORTRAN(errorestimator,(qfx,qfn,ipkon,kon,lakon,nk,ne,
           mi,ielmat,&nterms,inum,co,vold,&filab[2788]));
       
       iselect=1;
       
       frdset(&filab[2784],set,&iset,istartset,iendset,ialset,
          inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
          ngraph);
       
       frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
             &noutloc,description,kode,nmethod,f1,output,istep,iinc);
       
       fprintf(f1," -4  HERROR      1    1\n");
       fprintf(f1," -5  HFLSTD      1    1    1    0\n");
       
       ncomp=1;
       ifield[0]=1;
       icomp[0]=1;
       
       frdselect(qfn,qfn,&iset,&nkcoords,inum,m1,istartset,iendset,
             ialset,ngraph,&ncomp,ifield,icomp,
             nfieldvector1,&iselect,m2,f1,output,m3);
       
       }
   }
 
   /* storing the imaginary part of the thermal error estimator in the nodes
      for the odd modes of cyclic symmetry calculations */
   
   if((*noddiam>=0)||((*nmethod==5)&&(*mode==0))){
     if((strcmp1(&filab[2784],"HER")==0)&&(*ithermal>1)){
 
       nterms=3;
       FORTRAN(errorestimator,(&qfx[3*mi[0]**ne],qfn,ipkon,kon,lakon,nk,ne,
           mi,ielmat,&nterms,inum,co,vold,&filab[2788]));
       
       frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
         &noutloc,description,kode,nmethod,f1,output,istep,iinc);
 
       fprintf(f1," -4  HERRORI     1    1\n");
       fprintf(f1," -5  HFLSTD      1    1    1    0\n");
       
       ncomp=1;
       ifield[0]=1;
       icomp[0]=1;
 
       frdselect(qfn,qfn,&iset,&nkcoords,inum,m1,istartset,iendset,
                 ialset,ngraph,&ncomp,ifield,icomp,
                 nfieldtensor,&iselect,m2,f1,output,m3);
       
     }
   }
 
   /* storing the total temperatures in the network nodes */
   
   if((strcmp1(&filab[1131],"TT  ")==0)&&(*ithermal>1)){
 
     iselect=-1;
     frdset(&filab[1131],set,&iset,istartset,iendset,ialset,
        inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
        ngraph);
     
     frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
           &noutloc,description,kode,nmethod,f1,output,istep,iinc);
 
     fprintf(f1," -4  TOTEMP      1    1\n");
     fprintf(f1," -5  TT          1    1    0    0\n");
 
     frdselect(v,v,&iset,&nkcoords,inum,m1,istartset,iendset,
                 ialset,ngraph,&ncompscalar,ifieldscalar,icompscalar,
                 nfieldvector0,&iselect,m2,f1,output,m3);
 
   }
 
   /* storing the mass flow in the network nodes */
   
   if((strcmp1(&filab[1218],"MF  ")==0)&&(*ithermal>1)){
 
     iselect=-1;
     frdset(&filab[1218],set,&iset,istartset,iendset,ialset,
        inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
        ngraph);
     
     frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
           &noutloc,description,kode,nmethod,f1,output,istep,iinc);
 
     fprintf(f1," -4  MAFLOW      1    1\n");
     fprintf(f1," -5  MF          1    1    0    0\n");
 
     icomp[0]=1;
     if((iaxial==1)&&(strcmp1(&filab[1222],"I")==0)){for(i=0;i<*nk;i++)v[1+i*mt]*=180.;}
     frdselect(v,v,&iset,&nkcoords,inum,m1,istartset,iendset,
                 ialset,ngraph,&ncompscalar,ifieldscalar,icomp,
                 nfieldvector0,&iselect,m2,f1,output,m3);
     if((iaxial==1)&&(strcmp1(&filab[1222],"I")==0)){for(i=0;i<*nk;i++)v[1+i*mt]/=180.;}
 
   }
 
   /* storing the total pressure in the network nodes */
   
   if((strcmp1(&filab[1305],"PT  ")==0)&&(*ithermal>1)){
 
     iselect=-1;
     frdset(&filab[1305],set,&iset,istartset,iendset,ialset,
        inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
        ngraph);
     
     frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
           &noutloc,description,kode,nmethod,f1,output,istep,iinc);
 
     fprintf(f1," -4  TOPRES      1    1\n");
     fprintf(f1," -5  PT          1    1    0    0\n");
 
     icomp[0]=2;
     frdselect(v,v,&iset,&nkcoords,inum,m1,istartset,iendset,
                 ialset,ngraph,&ncompscalar,ifieldscalar,icomp,
                 nfieldvector0,&iselect,m2,f1,output,m3);
 
   }
 
   /* storing the static pressure in the liquid network nodes */
   
   if((strcmp1(&filab[1827],"PS  ")==0)&&(*ithermal>1)){
 
     iselect=-1;
     frdset(&filab[1827],set,&iset,istartset,iendset,ialset,
        inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
        ngraph);
     
     frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
           &noutloc,description,kode,nmethod,f1,output,istep,iinc);
 
     fprintf(f1," -4  STPRES      1    1\n");
     fprintf(f1," -5  PS          1    1    0    0\n");
 
     icomp[0]=2;
     frdselect(v,v,&iset,&nkcoords,inum,m1,istartset,iendset,
                 ialset,ngraph,&ncompscalar,ifieldscalar,icomp,
                 nfieldvector0,&iselect,m2,f1,output,m3);
 
   }
 
   /* storing the liquid depth in the channel nodes */
   
   if((strcmp1(&filab[2349],"PS  ")==0)&&(*ithermal>1)){
 
     iselect=-1;
     frdset(&filab[2349],set,&iset,istartset,iendset,ialset,
        inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
        ngraph);
     
     frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
           &noutloc,description,kode,nmethod,f1,output,istep,iinc);
 
     fprintf(f1," -4  DEPTH       1    1\n");
     fprintf(f1," -5  DEPTH       1    1    0    0\n");
 
     icomp[0]=2;
     frdselect(v,v,&iset,&nkcoords,inum,m1,istartset,iendset,
                 ialset,ngraph,&ncompscalar,ifieldscalar,icomp,
                 nfieldvector0,&iselect,m2,f1,output,m3);
 
   }
 
   /* storing the critical depth in the channel nodes */
   
   if((strcmp1(&filab[2436],"HCRI")==0)&&(*ithermal>1)){
 
     iselect=-1;
     frdset(&filab[2436],set,&iset,istartset,iendset,ialset,
        inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
        ngraph);
     
     frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
           &noutloc,description,kode,nmethod,f1,output,istep,iinc);
 
     fprintf(f1," -4  HCRIT       1    1\n");
     fprintf(f1," -5  HCRIT       1    1    0    0\n");
 
     icomp[0]=3;
     frdselect(v,v,&iset,&nkcoords,inum,m1,istartset,iendset,
                 ialset,ngraph,&ncompscalar,ifieldscalar,icomp,
                 nfieldvector0,&iselect,m2,f1,output,m3);
 
   }
 
   /* storing the static temperature in the network nodes */
   
   if((strcmp1(&filab[1392],"TS  ")==0)&&(*ithermal>1)){
 
     iselect=-1;
     frdset(&filab[1392],set,&iset,istartset,iendset,ialset,
        inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
        ngraph);
     
     frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
           &noutloc,description,kode,nmethod,f1,output,istep,iinc);
 
     fprintf(f1," -4  STTEMP      1    1\n");
     fprintf(f1," -5  TS          1    1    0    0\n");
 
     icomp[0]=3;
     frdselect(v,v,&iset,&nkcoords,inum,m1,istartset,iendset,
                 ialset,ngraph,&ncompscalar,ifieldscalar,icomp,
                 nfieldvector0,&iselect,m2,f1,output,m3);
 
   }
 
   /*  the remaining lines only apply to frequency calculations
       with cyclic symmetry, complex frequency and steady state calculations */
 
   if((*nmethod!=2)&&(*nmethod!=5)&&(*nmethod!=6)&&(*nmethod!=7)){fclose(f1);return;}
   if((*nmethod==5)&&(*mode==-1)){fclose(f1);return;}
 
   /* storing the displacements in the nodes (magnitude, phase) */
       
   if((strcmp1(&filab[870],"PU  ")==0)&&(*ithermal!=2)){
     iselect=1;
     
     frdset(&filab[870],set,&iset,istartset,iendset,ialset,
        inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
        ngraph);
     
     frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
           &noutloc,description,kode,nmethod,f1,output,istep,iinc);
 
     fprintf(f1," -4  PDISP       6    1\n");
     fprintf(f1," -5  MAG1        1   12    1    0\n");
     fprintf(f1," -5  MAG2        1   12    2    0\n");
     fprintf(f1," -5  MAG3        1   12    3    0\n");
     fprintf(f1," -5  PHA1        1   12    4    0\n");
     fprintf(f1," -5  PHA2        1   12    5    0\n");
     fprintf(f1," -5  PHA3        1   12    6    0\n");
 
     frdselect(vr,vi,&iset,&nkcoords,inum,m1,istartset,iendset,
                 ialset,ngraph,&ncompvectph,ifieldvectph,icompvectph,
                 nfieldvectph,&iselect,m2,f1,output,m3);
 
   }
 
   /* storing the temperatures in the nodes (magnitude, phase) */
       
   if((strcmp1(&filab[957],"PNT ")==0)&&(*ithermal>1)){
     iselect=1;
     
     frdset(&filab[957],set,&iset,istartset,iendset,ialset,
        inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
        ngraph);
     
     frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
           &noutloc,description,kode,nmethod,f1,output,istep,iinc);
 
     fprintf(f1," -4  PNDTEMP     2    1\n");
     fprintf(f1," -5  MAG1        1    1    1    0\n");
     fprintf(f1," -5  PHA1        1    1    2    0\n");
 
     frdselect(vr,vi,&iset,&nkcoords,inum,m1,istartset,iendset,
                 ialset,ngraph,&ncompscalph,ifieldscalph,icompscalph,
                 nfieldscalph,&iselect,m2,f1,output,m3);
 
   }
 
   /* storing the stresses in the nodes (magnitude, phase) */
       
   if((strcmp1(&filab[1479],"PHS ")==0)&&(*ithermal!=2)){
     iselect=1;
     
     frdset(&filab[1479],set,&iset,istartset,iendset,ialset,
        inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
        ngraph);
     
     frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
           &noutloc,description,kode,nmethod,f1,output,istep,iinc);
 
     fprintf(f1," -4  PSTRESS    12    1\n");
     fprintf(f1," -5  MAGXX       1   14    1    1\n");
     fprintf(f1," -5  MAGYY       1   14    2    2\n");
     fprintf(f1," -5  MAGZZ       1   14    3    3\n");
     fprintf(f1," -5  MAGXY       1   14    1    2\n");
     fprintf(f1," -5  MAGYZ       1   14    2    3\n");
     fprintf(f1," -5  MAGZX       1   14    3    1\n");
     fprintf(f1," -5  PHAXX       1   14    1    1\n");
     fprintf(f1," -5  PHAYY       1   14    2    2\n");
     fprintf(f1," -5  PHAZZ       1   14    3    3\n");
     fprintf(f1," -5  PHAXY       1   14    1    2\n");
     fprintf(f1," -5  PHAYZ       1   14    2    3\n");
     fprintf(f1," -5  PHAZX       1   14    3    1\n");
 
     frdselect(stnr,stni,&iset,&nkcoords,inum,m1,istartset,iendset,
                 ialset,ngraph,&ncomptensph,ifieldtensph,icomptensph,
                 nfieldtensph,&iselect,m2,f1,output,m3);
 
   }
 
   /* storing the differential contact displacements and
      the contact stresses in the nodes (magnitude, phase)
      only for face-to-face penalty contact */
       
   if((strcmp1(&filab[3915],"PCON")==0)&&(*ithermal!=2)&&(*mortar==1)){
     iselect=1;
     
     frdset(&filab[3915],set,&iset,istartset,iendset,ialset,
        inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
        ngraph);
     
     frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
           &noutloc,description,kode,nmethod,f1,output,istep,iinc);
 
     fprintf(f1," -4  PCONTAC    12    1\n");
     fprintf(f1," -5  MAGO        1   14    1    1\n");
     fprintf(f1," -5  MAGSL1      1   14    2    2\n");
     fprintf(f1," -5  MAGSL2      1   14    3    3\n");
     fprintf(f1," -5  MAGP        1   14    1    2\n");
     fprintf(f1," -5  MAGSH1      1   14    2    3\n");
     fprintf(f1," -5  MAGSH2      1   14    3    1\n");
     fprintf(f1," -5  PHAO        1   14    1    1\n");
     fprintf(f1," -5  PHASL1      1   14    2    2\n");
     fprintf(f1," -5  PHASL2      1   14    3    3\n");
     fprintf(f1," -5  PHAP        1   14    1    2\n");
     fprintf(f1," -5  PHASH1      1   14    2    3\n");
     fprintf(f1," -5  PHASH2      1   14    3    1\n");
 
     frdselect(cdnr,cdni,&iset,&nkcoords,inum,m1,istartset,iendset,
                 ialset,ngraph,&ncomptensph,ifieldtensph,icomptensph,
                 nfieldtensph,&iselect,m2,f1,output,m3);
 
   }
 
   /* storing the forces in the nodes (magnitude, phase) */
       
   if((strcmp1(&filab[2610],"PRF ")==0)&&(*ithermal!=2)){
     iselect=1;
     
     frdset(&filab[2610],set,&iset,istartset,iendset,ialset,
        inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
        ngraph);
     
     frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
           &noutloc,description,kode,nmethod,f1,output,istep,iinc);
 
     fprintf(f1," -4  PFORC       6    1\n");
     fprintf(f1," -5  MAG1        1   12    1    0\n");
     fprintf(f1," -5  MAG2        1   12    2    0\n");
     fprintf(f1," -5  MAG3        1   12    3    0\n");
     fprintf(f1," -5  PHA1        1   12    4    0\n");
     fprintf(f1," -5  PHA2        1   12    5    0\n");
     fprintf(f1," -5  PHA3        1   12    6    0\n");
 
     frdselect(fnr,fni,&iset,&nkcoords,inum,m1,istartset,iendset,
                 ialset,ngraph,&ncompvectph,ifieldvectph,icompvectph,
                 nfieldvectph,&iselect,m2,f1,output,m3);
 
   }
 
   /* the remaining parts are for frequency calculations with cyclic symmetry only */
 
   if(*nmethod!=2){fclose(f1);return;}
 
   /* storing the maximum displacements of the nodes in the base sector
      (components, magnitude) */
       
   if((strcmp1(&filab[1566],"MAXU")==0)&&(*ithermal!=2)){
     iselect=1;
     
     frdset(&filab[1566],set,&iset,istartset,iendset,ialset,
        inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
        ngraph);
     
     frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
           &noutloc,description,kode,nmethod,f1,output,istep,iinc);
 
     fprintf(f1," -4  MDISP       4    1\n");
     fprintf(f1," -5  DX          1    4    1    0\n");
     fprintf(f1," -5  DY          1    4    2    0\n");
     fprintf(f1," -5  DZ          1    4    3    0\n");
     fprintf(f1," -5  ANG         1    4    4    0\n");
     
     ncomp=4;
     ifield[0]=1;icomp[0]=1;
     ifield[1]=1;icomp[1]=2;
     ifield[2]=1;icomp[2]=3;
     ifield[3]=1;icomp[3]=0;
     nfield[0]=4;nfield[1]=4;
 
     frdselect(vmax,vmax,&iset,&nkcoords,inum,m1,istartset,iendset,
                 ialset,ngraph,&ncomp,ifield,icomp,
                 nfield,&iselect,m2,f1,output,m3);
 
   }
 
   /* storing the worst principal stress at the nodes
      in the basis sector (components, magnitude)
 
      the worst principal stress is the maximum of the
      absolute value of all principal stresses, times
      its original sign */
       
   if((strcmp1(&filab[1653],"MAXS")==0)&&(*ithermal!=2)){
     iselect=1;
     
     frdset(&filab[1653],set,&iset,istartset,iendset,ialset,
        inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
        ngraph);
     
     frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
           &noutloc,description,kode,nmethod,f1,output,istep,iinc);
 
     fprintf(f1," -4  MSTRESS     7    1\n");
     fprintf(f1," -5  SXX         1    4    1    1\n");
     fprintf(f1," -5  SYY         1    4    2    2\n");
     fprintf(f1," -5  SZZ         1    4    3    3\n");
     fprintf(f1," -5  SXY         1    4    1    2\n");
     fprintf(f1," -5  SYZ         1    4    2    3\n");
     fprintf(f1," -5  SZX         1    4    3    1\n");
     fprintf(f1," -5  MAG         1    4    0    0\n");
     
     ncomp=7;
     ifield[0]=1;icomp[0]=1;
     ifield[1]=1;icomp[1]=2;
     ifield[2]=1;icomp[2]=3;
     ifield[3]=1;icomp[3]=4;
     ifield[4]=1;icomp[4]=6;
     ifield[5]=1;icomp[5]=5;
     ifield[6]=1;icomp[6]=0;
     nfield[0]=7;nfield[1]=7;
 
     frdselect(stnmax,stnmax,&iset,&nkcoords,inum,m1,istartset,iendset,
                 ialset,ngraph,&ncomp,ifield,icomp,
                 nfield,&iselect,m2,f1,output,m3);
 
   }
 
   /* storing the worst principal strain at the nodes
      in the basis sector (components, magnitude)
 
      the worst principal strain is the maximum of the
      absolute value of all principal strains, times
      its original sign */
       
   if((strcmp1(&filab[2523],"MAXE")==0)&&(*ithermal!=2)){
     iselect=1;
     
     frdset(&filab[2523],set,&iset,istartset,iendset,ialset,
        inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
        ngraph);
     
     frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
           &noutloc,description,kode,nmethod,f1,output,istep,iinc);
 
     fprintf(f1," -4  MSTRAIN     7    1\n");
     fprintf(f1," -5  EXX         1    4    1    1\n");
     fprintf(f1," -5  EYY         1    4    2    2\n");
     fprintf(f1," -5  EZZ         1    4    3    3\n");
     fprintf(f1," -5  EXY         1    4    1    2\n");
     fprintf(f1," -5  EYZ         1    4    2    3\n");
     fprintf(f1," -5  EZX         1    4    3    1\n");
     fprintf(f1," -5  MAG         1    4    0    0\n");
     
     ncomp=7;
     ifield[0]=1;icomp[0]=1;
     ifield[1]=1;icomp[1]=2;
     ifield[2]=1;icomp[2]=3;
     ifield[3]=1;icomp[3]=4;
     ifield[4]=1;icomp[4]=6;
     ifield[5]=1;icomp[5]=5;
     ifield[6]=1;icomp[6]=0;
     nfield[0]=7;nfield[1]=7;
 
     frdselect(eenmax,eenmax,&iset,&nkcoords,inum,m1,istartset,iendset,
                 ialset,ngraph,&ncomp,ifield,icomp,
                 nfield,&iselect,m2,f1,output,m3);
 
   }
   
   fclose(f1);
   return;
   
 }

◆ frd_norm_se()

void frd_norm_se	(	double *	co,
		ITG *	nk,
		double *	stn,
		ITG *	inum,
		ITG *	nmethod,
		ITG *	kode,
		char *	filab,
		double *	fn,
		double *	time,
		ITG *	nstate_,
		ITG *	istep,
		ITG *	iinc,
		ITG *	mode,
		ITG *	noddiam,
		char *	description,
		ITG *	mi,
		ITG *	ngraph,
		ITG *	ne,
		double *	cs,
		char *	set,
		ITG *	nset,
		ITG *	istartset,
		ITG *	iendset,
		ITG *	ialset,
		double *	thicke,
		char *	jobnamec,
		char *	output,
		double *	dgdxtotglob,
		ITG *	numobject,
		char *	objectset,
		double *	extnor,
		ITG *	ntrans,
		double *	trab,
		ITG *	inotr
	)

◆ frd_orien_se()

void frd_orien_se	(	double *	co,
		ITG *	nk,
		double *	stn,
		ITG *	inum,
		ITG *	nmethod,
		ITG *	kode,
		char *	filab,
		double *	fn,
		double *	time,
		ITG *	nstate_,
		ITG *	istep,
		ITG *	iinc,
		ITG *	mode,
		ITG *	noddiam,
		char *	description,
		ITG *	mi,
		ITG *	ngraph,
		ITG *	ne,
		double *	cs,
		char *	set,
		ITG *	nset,
		ITG *	istartset,
		ITG *	iendset,
		ITG *	ialset,
		double *	thicke,
		char *	jobnamec,
		char *	output,
		double *	dgdxtotglob,
		ITG *	numobject,
		char *	objectset,
		ITG *	ntrans,
		ITG *	inotr,
		double *	trab,
		ITG *	idesvar,
		char *	orname
	)

◆ frd_sen()

void frd_sen	(	double *	co,
		ITG *	nk,
		double *	dstn,
		ITG *	inum,
		ITG *	nmethod,
		ITG *	kode,
		char *	filab,
		double *	time,
		ITG *	nstate_,
		ITG *	istep,
		ITG *	iinc,
		ITG *	mode,
		ITG *	noddiam,
		char *	description,
		ITG *	mi,
		ITG *	ngraph,
		ITG *	ne,
		double *	cs,
		char *	set,
		ITG *	nset,
		ITG *	istartset,
		ITG *	iendset,
		ITG *	ialset,
		char *	jobnamec,
		char *	output,
		double *	v,
		ITG *	iobject,
		char *	objectset,
		ITG *	ntrans,
		ITG *	inotr,
		double *	trab,
		ITG *	idesvar,
		char *	orname,
		ITG *	icoordinate,
		ITG *	inorm,
		ITG *	irand
	)

                     {
      
      /* stores the results in frd format
 
      iselect selects which nodes are to be stored:
           iselect=-1 means only those nodes for which inum negative
                      ist, i.e. network nodes
           iselect=+1 means only those nodes for which inum positive
                      ist, i.e. structural nodes
           iselect=0  means both of the above */
   
   FILE *f1;
   
   char m1[4]=" -1",m2[4]=" -2",m3[4]=" -3",fneig[132]="",text[132];
 
   static ITG icounter=0,nkcoords;
 
   ITG null,one,i,noutloc,iset,iselect,two,three,nout,noutplus,noutmin;
 
   ITG ncomptensoro=6,ifieldtensoro[6]={1,1,1,1,1,1},
       icomptensoro[6]={0,1,2,3,5,4},nfieldtensoro[2]={6,0},
       ncomptensord=2,ifieldtensord[4]={1,1},icomptensord[2]={0,1},
       nfieldtensord[2]={2,0};
   ITG ncompvector=3,ifieldvector[3]={1,1,1},icompvector[3]={0,1,2},
       nfieldvector1[2]={3,0};
 
   double pi,oner;
 
   strcpy(fneig,jobnamec);
   strcat(fneig,".frd");
 
   if((f1=fopen(fneig,"ab"))==NULL){
     printf("*ERROR in frd: cannot open frd file for writing...");
     exit(0);
   }
 
   pi=4.*atan(1.);
   null=0;
   one=1;two=2;three=3;
   oner=1.;
 
   /* determining nout, noutplus and noutmin 
               nout: number of structural and network nodes
               noutplus: number of structural nodes
               noutmin: number of network nodes */
 
   if(*nmethod!=0){
       nout=0;
       noutplus=0;
       noutmin=0;
       for(i=0;i<*nk;i++){
       if(inum[i]==0) continue;
       nout++;
       if(inum[i]>0) noutplus++;
       if(inum[i]<0) noutmin++;   
       }
   }else{
       nout=*nk;
   }  
 
   nkcoords=*nk;
   iselect=1;
 
   if(*inorm==1){
 
       /* storing the normals to the structure */
       
       frdset(&filab[4002],set,&iset,istartset,iendset,ialset,
          inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
          ngraph);
       
       frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
         &noutloc,description,kode,nmethod,f1,output,istep,iinc); 
       
       fprintf(f1," -4  NORM        4    1\n");
       fprintf(f1," -5  NORMX       1    2    1    0\n");
       fprintf(f1," -5  NORMY       1    2    2    0\n");
       fprintf(f1," -5  NORMZ       1    2    3    0\n");
       fprintf(f1," -5  ALL         1    2    0    0    1ALL\n");
       
       frdselect(v,v,&iset,&nkcoords,inum,m1,istartset,iendset,
                 ialset,ngraph,&ncompvector,ifieldvector,icompvector,
                 nfieldvector1,&iselect,m2,f1,output,m3);
 
   }else if(*irand==1){
 
       /* storing the random vectors in the structure */
 
       /* storing the normals to the structure */
       
       frdset(&filab[4002],set,&iset,istartset,iendset,ialset,
          inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
          ngraph);
       
       frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
         &noutloc,description,kode,nmethod,f1,output,istep,iinc); 
       
       fprintf(f1," -4  RAND        4    1\n");
       fprintf(f1," -5  RANDX       1    2    1    0\n");
       fprintf(f1," -5  RANDY       1    2    2    0\n");
       fprintf(f1," -5  RANDZ       1    2    3    0\n");
       fprintf(f1," -5  ALL         1    2    0    0    1ALL\n");
       
       frdselect(v,v,&iset,&nkcoords,inum,m1,istartset,iendset,
                 ialset,ngraph,&ncompvector,ifieldvector,icompvector,
                 nfieldvector1,&iselect,m2,f1,output,m3);
       
   }else if(*icoordinate!=1){
 
       /* storing the orientation sensitivities in the nodes */
   
       if((strcmp1(&objectset[(*iobject-1)*324],"DISPLACEMENT")==0)||
      (strcmp1(&objectset[(*iobject-1)*324],"EIGENFREQUENCY")==0)||
      (strcmp1(&objectset[(*iobject-1)*324],"GREEN")==0)){
       
       frdset(&filab[4002],set,&iset,istartset,iendset,ialset,
          inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
          ngraph);
       
       frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
             &noutloc,description,kode,nmethod,f1,output,istep,iinc); 
       
       strcpy1(&text[0]," -4              4    1",23);
       strcpy1(&text[5],"D",1);
       strcpy1(&text[6],&orname[80*(*idesvar/3)],5);
       if(*idesvar-(*idesvar/3)*3==0){
           strcpy1(&text[11],"Rx",2);
           text[23]='\0';
           fprintf(f1,"%s\n",text);
           fprintf(f1," -5  dD1dRx      1    2    1    0\n");
           fprintf(f1," -5  dD2dRx      1    2    1    0\n");
           fprintf(f1," -5  dD3dRx      1    2    1    0\n");
       }else if(*idesvar-(*idesvar/3)*3==1){
           strcpy1(&text[11],"Ry",2);
           text[23]='\0';
           fprintf(f1,"%s\n",text);
           fprintf(f1," -5  dD1dRy      1    2    1    0\n");
           fprintf(f1," -5  dD2dRy      1    2    1    0\n");
           fprintf(f1," -5  dD3dRy      1    2    1    0\n");
       }else{
           strcpy1(&text[11],"Rz",2);
           text[23]='\0';
           fprintf(f1,"%s\n",text);
           fprintf(f1," -5  dD1dRz      1    2    1    0\n");
           fprintf(f1," -5  dD2dRz      1    2    1    0\n");
           fprintf(f1," -5  dD3dRz      1    2    1    0\n");
       }
       fprintf(f1," -5  ALL         1    2    0    0    1ALL\n");
       
       frdvector(v,&iset,ntrans,&filab[4002],&nkcoords,inum,m1,inotr,
             trab,co,istartset,iendset,ialset,mi,ngraph,f1,output,m3);
       
       }else if(strcmp1(&objectset[(*iobject-1)*324],"STRESS")==0){
       
       frdset(&filab[4002],set,&iset,istartset,iendset,ialset,
          inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
          ngraph);
       
       frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
             &noutloc,description,kode,nmethod,f1,output,istep,iinc); 
       
       strcpy1(&text[0]," -4              6    1",23);
       strcpy1(&text[5],"S",1);
       strcpy1(&text[6],&orname[80*(*idesvar/3)],5);
       if(*idesvar-(*idesvar/3)*3==0){
           strcpy1(&text[11],"Rx",2);
           text[23]='\0';
           fprintf(f1,"%s\n",text);
           fprintf(f1," -5  dSXXdRx     1    4    1    1\n");
           fprintf(f1," -5  dSYYdRx     1    4    2    2\n");
           fprintf(f1," -5  dSZZdRx     1    4    3    3\n");
           fprintf(f1," -5  dSXYdRx     1    4    1    2\n");
           fprintf(f1," -5  dSYZdRx     1    4    2    3\n");
           fprintf(f1," -5  dSZXdRx     1    4    3    1\n");
       }else if(*idesvar-(*idesvar/3)*3==1){
           strcpy1(&text[11],"Ry",2);
           text[23]='\0';
           fprintf(f1,"%s\n",text);
           fprintf(f1," -5  dSXXdRy     1    4    1    1\n");
           fprintf(f1," -5  dSYYdRy     1    4    2    2\n");
           fprintf(f1," -5  dSZZdRy     1    4    3    3\n");
           fprintf(f1," -5  dSXYdRy     1    4    1    2\n");
           fprintf(f1," -5  dSYZdRy     1    4    2    3\n");
           fprintf(f1," -5  dSZXdRy     1    4    3    1\n");
       }else{
           strcpy1(&text[11],"Rz",2);
           text[23]='\0';
           fprintf(f1,"%s\n",text);
           fprintf(f1," -5  dSXXdRz     1    4    1    1\n");
           fprintf(f1," -5  dSYYdRz     1    4    2    2\n");
           fprintf(f1," -5  dSZZdRz     1    4    3    3\n");
           fprintf(f1," -5  dSXYdRz     1    4    1    2\n");
           fprintf(f1," -5  dSYZdRz     1    4    2    3\n");
           fprintf(f1," -5  dSZXdRz     1    4    3    1\n");
       }
       
       frdselect(dstn,dstn,&iset,&nkcoords,inum,m1,istartset,iendset,
             ialset,ngraph,&ncomptensoro,ifieldtensoro,icomptensoro,
             nfieldtensoro,&iselect,m2,f1,output,m3);
       
       } 
       
   }else{
 
       /* storing the coordinate sensitivities in the nodes */
   
       frdset(&filab[4002],set,&iset,istartset,iendset,ialset,
          inum,&noutloc,&nout,nset,&noutmin,&noutplus,&iselect,
          ngraph);
       
       frdheader(&icounter,&oner,time,&pi,noddiam,cs,&null,mode,
         &noutloc,description,kode,nmethod,f1,output,istep,iinc); 
       
       if(strcmp1(&objectset[*iobject*324],"SHAPEENERGY")==0){
       fprintf(f1," -4  SENENER     2    1\n");
       }else if(strcmp1(&objectset[*iobject*324],"MASS")==0){
       fprintf(f1," -4  SENMASS     2    1\n");
       }else if(strcmp1(&objectset[*iobject*324],"DISPLACEMENT")==0){
       fprintf(f1," -4  SENDISP     2    1\n");
       }else if(strcmp1(&objectset[*iobject*324],"STRESS")==0){
       fprintf(f1," -4  SENSTRE     2    1\n");
       }else if(strcmp1(&objectset[*iobject*324],"EIGENFREQUENCY")==0){
       fprintf(f1," -4  SENFREQ     2    1\n");
       }else if(strcmp1(&objectset[*iobject*324],"THICKNESS")==0){
       fprintf(f1," -4  SENTHCK     2    1\n");
       }else if(strcmp1(&objectset[*iobject*324],"PROJECTGRAD")==0){
       fprintf(f1," -4  PRJGRAD     2    1\n");
       }
       
       fprintf(f1," -5  DFDN        1    1    1    0\n");
       fprintf(f1," -5  DFDNFIL     1    1    2    0\n");
       
       frdselect(&v[2**nk**iobject],v,&iset,&nkcoords,inum,m1,istartset,
         iendset,ialset,ngraph,&ncomptensord,ifieldtensord,icomptensord,
         nfieldtensord,&iselect,m2,f1,output,m3);
 
   }
   
   fclose(f1);
   return;
   
 }

◆ frd_sen_se()

void frd_sen_se	(	double *	co,
		ITG *	nk,
		double *	stn,
		ITG *	inum,
		ITG *	nmethod,
		ITG *	kode,
		char *	filab,
		double *	fn,
		double *	time,
		ITG *	nstate_,
		ITG *	istep,
		ITG *	iinc,
		ITG *	mode,
		ITG *	noddiam,
		char *	description,
		ITG *	mi,
		ITG *	ngraph,
		ITG *	ne,
		double *	cs,
		char *	set,
		ITG *	nset,
		ITG *	istartset,
		ITG *	iendset,
		ITG *	ialset,
		double *	thicke,
		char *	jobnamec,
		char *	output,
		double *	dgdxglob,
		ITG *	iobject,
		char *	objectset
	)

◆ frdcyc()

void frdcyc	(	double *	co,
		ITG *	nk,
		ITG *	kon,
		ITG *	ipkon,
		char *	lakon,
		ITG *	ne,
		double *	v,
		double *	stn,
		ITG *	inum,
		ITG *	nmethod,
		ITG *	kode,
		char *	filab,
		double *	een,
		double *	t1,
		double *	fn,
		double *	time,
		double *	epn,
		ITG *	ielmat,
		char *	matname,
		double *	cs,
		ITG *	mcs,
		ITG *	nkon,
		double *	enern,
		double *	xstaten,
		ITG *	nstate_,
		ITG *	istep,
		ITG *	iinc,
		ITG *	iperturb,
		double *	ener,
		ITG *	mi,
		char *	output,
		ITG *	ithermal,
		double *	qfn,
		ITG *	ialset,
		ITG *	istartset,
		ITG *	iendset,
		double *	trab,
		ITG *	inotr,
		ITG *	ntrans,
		double *	orab,
		ITG *	ielorien,
		ITG *	norien,
		double *	sti,
		double *	veold,
		ITG *	noddiam,
		char *	set,
		ITG *	nset,
		double *	emn,
		double *	thicke,
		char *	jobnamec,
		ITG *	ne0,
		double *	cdn,
		ITG *	mortar,
		ITG *	nmat,
		double *	qfx
	)

                                   {
 
   /* duplicates fields for static cyclic symmetric calculations */
 
   char *lakont=NULL,description[13]="            ";
 
   ITG nkt,icntrl,*kont=NULL,*ipkont=NULL,*inumt=NULL,*ielmatt=NULL,net,i,l,
      imag=0,mode=-1,ngraph,*inocs=NULL,*ielcs=NULL,l1,l2,is,
       jj,node,i1,i2,nope,iel,indexe,j,ielset,*inotrt=NULL,mt=mi[1]+1,
       *ipneigh=NULL,*neigh=NULL,net0;
 
   double *vt=NULL,*fnt=NULL,*stnt=NULL,*eent=NULL,*cot=NULL,*t1t=NULL,
          *epnt=NULL,*enernt=NULL,*xstatent=NULL,theta,pi,t[3],*qfnt=NULL,
          *vr=NULL,*vi=NULL,*stnr=NULL,*stni=NULL,*vmax=NULL,*stnmax=NULL,
          *stit=NULL,*eenmax=NULL,*fnr=NULL,*fni=NULL,*emnt=NULL,
          *cdnr=NULL,*cdni=NULL;
 
   pi=4.*atan(1.);
 
   /* determining the maximum number of sectors to be plotted */
 
   ngraph=1;
   for(j=0;j<*mcs;j++){
     if(cs[17*j+4]>ngraph) ngraph=cs[17*j+4];
   }
 
   /* assigning nodes and elements to sectors */
 
   NNEW(inocs,ITG,*nk);
   NNEW(ielcs,ITG,*ne);
   ielset=cs[12];
   if((*mcs!=1)||(ielset!=0)){
     for(i=0;i<*nk;i++) inocs[i]=-1;
     for(i=0;i<*ne;i++) ielcs[i]=-1;
   }
 
   for(i=0;i<*mcs;i++){
     is=cs[17*i+4];
     if(is==1) continue;
     ielset=cs[17*i+12];
     if(ielset==0) continue;
     for(i1=istartset[ielset-1]-1;i1<iendset[ielset-1];i1++){
       if(ialset[i1]>0){
         iel=ialset[i1]-1;
         if(ipkon[iel]<0) continue;
         ielcs[iel]=i;
         indexe=ipkon[iel];
         if(strcmp1(&lakon[8*iel+3],"2")==0)nope=20;
         else if (strcmp1(&lakon[8*iel+3],"8")==0)nope=8;
         else if (strcmp1(&lakon[8*iel+3],"10")==0)nope=10;
         else if (strcmp1(&lakon[8*iel+3],"4")==0)nope=4;
         else if (strcmp1(&lakon[8*iel+3],"15")==0)nope=15;
         else {nope=6;}
         for(i2=0;i2<nope;++i2){
           node=kon[indexe+i2]-1;
           inocs[node]=i;
         }
       }
       else{
         iel=ialset[i1-2]-1;
         do{
           iel=iel-ialset[i1];
           if(iel>=ialset[i1-1]-1) break;
           if(ipkon[iel]<0) continue;
           ielcs[iel]=i;
           indexe=ipkon[iel];
           if(strcmp1(&lakon[8*iel+3],"2")==0)nope=20;
           else if (strcmp1(&lakon[8*iel+3],"8")==0)nope=8;
           else if (strcmp1(&lakon[8*iel+3],"10")==0)nope=10;
           else if (strcmp1(&lakon[8*iel+3],"4")==0)nope=4;
           else if (strcmp1(&lakon[8*iel+3],"15")==0)nope=15;
           else {nope=6;}
           for(i2=0;i2<nope;++i2){
             node=kon[indexe+i2]-1;
             inocs[node]=i;
           }
         }while(1);
       }
     } 
   }
 
   NNEW(cot,double,3**nk*ngraph);
   if(*ntrans>0)NNEW(inotrt,ITG,2**nk*ngraph);
 
   if((strcmp1(&filab[0],"U ")==0)||
      (strcmp1(&filab[1131],"TT  ")==0)||
      (strcmp1(&filab[1218],"MF  ")==0)||
      (strcmp1(&filab[1305],"PT  ")==0)||
      ((strcmp1(&filab[87],"NT  ")==0)&&(*ithermal>=2)))
     NNEW(vt,double,mt**nk*ngraph);
   if((strcmp1(&filab[87],"NT  ")==0)&&(*ithermal<2))
     NNEW(t1t,double,*nk*ngraph);
   if((strcmp1(&filab[174],"S   ")==0)||(strcmp1(&filab[1044],"ZZS ")==0)||
      (strcmp1(&filab[1044],"ERR ")==0))
     NNEW(stnt,double,6**nk*ngraph);
   if(strcmp1(&filab[261],"E   ")==0)
     NNEW(eent,double,6**nk*ngraph);
   if((strcmp1(&filab[348],"RF  ")==0)||(strcmp1(&filab[783],"RFL ")==0))
     NNEW(fnt,double,mt**nk*ngraph);
   if(strcmp1(&filab[435],"PEEQ")==0)
     NNEW(epnt,double,*nk*ngraph);
   if(strcmp1(&filab[522],"ENER")==0)
     NNEW(enernt,double,*nk*ngraph);
   if(strcmp1(&filab[609],"SDV ")==0)
     NNEW(xstatent,double,*nstate_**nk*ngraph);
   if((strcmp1(&filab[696],"HFL ")==0)||(strcmp1(&filab[2784],"HER ")==0))
     NNEW(qfnt,double,3**nk*ngraph);
   if((strcmp1(&filab[1044],"ZZS ")==0)||(strcmp1(&filab[1044],"ERR ")==0)||
      (strcmp1(&filab[2175],"CONT")==0))
     NNEW(stit,double,6*mi[0]**ne*ngraph);
   if(strcmp1(&filab[2697],"ME  ")==0)
     NNEW(emnt,double,6**nk*ngraph);
 
   /* the topology only needs duplication the first time it is
      stored in the frd file (*kode=1)
      the above two lines are not true: lakon is needed for
      contact information in frd.f */
 
   NNEW(kont,ITG,*nkon*ngraph);
   NNEW(ipkont,ITG,*ne*ngraph);
   NNEW(lakont,char,8**ne*ngraph);
   NNEW(ielmatt,ITG,mi[2]**ne*ngraph);
   NNEW(inumt,ITG,*nk*ngraph);
   
   nkt=ngraph**nk;
   net0=(ngraph-1)**ne+(*ne0);
   net=ngraph**ne;
 
   /* copying the coordinates of the first sector */
   
   for(l=0;l<3**nk;l++){cot[l]=co[l];}
   if(*ntrans>0){for(l=0;l<*nk;l++){inotrt[2*l]=inotr[2*l];}}
 
   /* copying the topology of the first sector */
   
   for(l=0;l<*nkon;l++){kont[l]=kon[l];}
   for(l=0;l<*ne;l++){ipkont[l]=ipkon[l];}
   for(l=0;l<8**ne;l++){lakont[l]=lakon[l];}
   for(l=0;l<mi[2]**ne;l++){ielmatt[l]=ielmat[l];}
 
   /* generating the coordinates for the other sectors */
   
   icntrl=1;
   
   FORTRAN(rectcyl,(cot,v,fn,stn,qfn,een,cs,nk,&icntrl,t,filab,&imag,mi,emn));
   
   for(jj=0;jj<*mcs;jj++){
     is=cs[17*jj+4];
     for(i=1;i<is;i++){
       
       theta=i*2.*pi/cs[17*jj];
       
       for(l=0;l<*nk;l++){
         if(inocs[l]==jj){
       cot[3*l+i*3**nk]=cot[3*l];
       cot[1+3*l+i*3**nk]=cot[1+3*l]+theta;
       cot[2+3*l+i*3**nk]=cot[2+3*l];
         }
       }
       
       if(*ntrans>0){
       for(l=0;l<*nk;l++){
           if(inocs[l]==jj){
           inotrt[2*l+i*2**nk]=inotrt[2*l];
           }
       }
       }
       
         for(l=0;l<*nkon;l++){kont[l+i**nkon]=kon[l]+i**nk;}
         for(l=0;l<*ne;l++){
           if(ielcs[l]==jj){
             if(ipkon[l]>=0){
               ipkont[l+i**ne]=ipkon[l]+i**nkon;
               ielmatt[mi[2]*(l+i**ne)]=ielmat[mi[2]*l];
               for(l1=0;l1<8;l1++){
                 l2=8*l+l1;
                 lakont[l2+i*8**ne]=lakon[l2];
               }
             }
             else ipkont[l+i**ne]=-1;
       }
         }
     }
   }
 
   icntrl=-1;
     
   FORTRAN(rectcyl,(cot,vt,fnt,stnt,qfnt,eent,cs,&nkt,&icntrl,t,filab,
            &imag,mi,emnt));
   
   /* mapping the results to the other sectors */
   
   for(l=0;l<*nk;l++){inumt[l]=inum[l];}
   
   icntrl=2;
   
   FORTRAN(rectcyl,(co,v,fn,stn,qfn,een,cs,nk,&icntrl,t,filab,&imag,mi,emn));
   
   if((strcmp1(&filab[0],"U ")==0)||
      (strcmp1(&filab[1131],"TT  ")==0)||
      (strcmp1(&filab[1218],"MF  ")==0)||
      (strcmp1(&filab[1305],"PT  ")==0)||
      ((strcmp1(&filab[87],"NT  ")==0)&&(*ithermal>=2)))
     for(l=0;l<mt**nk;l++){vt[l]=v[l];};
   if((strcmp1(&filab[87],"NT  ")==0)&&(*ithermal<2))
     for(l=0;l<*nk;l++){t1t[l]=t1[l];};
   if(strcmp1(&filab[174],"S   ")==0)
     for(l=0;l<6**nk;l++){stnt[l]=stn[l];};
   if(strcmp1(&filab[261],"E   ")==0)
     for(l=0;l<6**nk;l++){eent[l]=een[l];};
   if((strcmp1(&filab[348],"RF  ")==0)||(strcmp1(&filab[783],"RFL ")==0))
     for(l=0;l<mt**nk;l++){fnt[l]=fn[l];};
   if(strcmp1(&filab[435],"PEEQ")==0)
     for(l=0;l<*nk;l++){epnt[l]=epn[l];};
   if(strcmp1(&filab[522],"ENER")==0)
     for(l=0;l<*nk;l++){enernt[l]=enern[l];};
   if(strcmp1(&filab[609],"SDV ")==0)
     for(l=0;l<*nstate_**nk;l++){xstatent[l]=xstaten[l];};
   if((strcmp1(&filab[696],"HFL ")==0)||(strcmp1(&filab[2784],"HER ")==0))
     for(l=0;l<3**nk;l++){qfnt[l]=qfn[l];};
   if((strcmp1(&filab[1044],"ZZS ")==0)||(strcmp1(&filab[1044],"ERR ")==0)||
      (strcmp1(&filab[2175],"CONT")==0))
     for(l=0;l<6*mi[0]**ne;l++){stit[l]=sti[l];};
   if(strcmp1(&filab[2697],"ME  ")==0)
     for(l=0;l<6**nk;l++){emnt[l]=emn[l];};
   
   for(jj=0;jj<*mcs;jj++){
     is=cs[17*jj+4];
     for(i=1;i<is;i++){
     
       for(l=0;l<*nk;l++){inumt[l+i**nk]=inum[l];}
     
       if((strcmp1(&filab[0],"U ")==0)||
          (strcmp1(&filab[1131],"TT  ")==0)||
          (strcmp1(&filab[1218],"MF  ")==0)||
          (strcmp1(&filab[1305],"PT  ")==0)||
          ((strcmp1(&filab[87],"NT  ")==0)&&(*ithermal>=2))){
         for(l1=0;l1<*nk;l1++){
           if(inocs[l1]==jj){
             for(l2=0;l2<4;l2++){
               l=mt*l1+l2;
               vt[l+mt**nk*i]=v[l];
             }
           }
         }
       }
     
       if((strcmp1(&filab[87],"NT  ")==0)&&(*ithermal<2)){
         for(l=0;l<*nk;l++){
           if(inocs[l]==jj) t1t[l+*nk*i]=t1[l];
         }
       }
     
       if(strcmp1(&filab[174],"S   ")==0){
         for(l1=0;l1<*nk;l1++){
           if(inocs[l1]==jj){
             for(l2=0;l2<6;l2++){
               l=6*l1+l2;
               stnt[l+6**nk*i]=stn[l];
             }
           }
         }
       }
     
       if(strcmp1(&filab[261],"E   ")==0){
         for(l1=0;l1<*nk;l1++){
           if(inocs[l1]==jj){
             for(l2=0;l2<6;l2++){
               l=6*l1+l2;
               eent[l+6**nk*i]=een[l];
             }
           }
         }
       }
     
       if((strcmp1(&filab[348],"RF  ")==0)||(strcmp1(&filab[783],"RFL ")==0)){
         for(l1=0;l1<*nk;l1++){
           if(inocs[l1]==jj){
             for(l2=0;l2<4;l2++){
               l=mt*l1+l2;
               fnt[l+mt**nk*i]=fn[l];
             }
           }
         }
       }
     
       if(strcmp1(&filab[435],"PEEQ")==0){
         for(l=0;l<*nk;l++){
           if(inocs[l]==jj) epnt[l+*nk*i]=epn[l];
         }
       } 
     
       if(strcmp1(&filab[522],"ENER")==0){
         for(l=0;l<*nk;l++){
           if(inocs[l]==jj) enernt[l+*nk*i]=enern[l];
         }
       } 
     
       if(strcmp1(&filab[609],"SDV ")==0){
         for(l1=0;l1<*nk;l1++){
           if(inocs[l1]==jj){
             for(l2=0;l2<*nstate_;l2++){
               l=*nstate_*l1+l2;
               xstatent[l+*nstate_**nk*i]=xstaten[l];
             }
           } 
         }
       }
     
       if((strcmp1(&filab[696],"HFL ")==0)||(strcmp1(&filab[2784],"HER ")==0)){
         for(l1=0;l1<*nk;l1++){
           if(inocs[l1]==jj){
             for(l2=0;l2<3;l2++){
               l=3*l1+l2;
               qfnt[l+3**nk*i]=qfn[l];
             }
           }
         }
       }
     
       if(strcmp1(&filab[2697],"ME  ")==0){
         for(l1=0;l1<*nk;l1++){
           if(inocs[l1]==jj){
             for(l2=0;l2<6;l2++){
               l=6*l1+l2;
               emnt[l+6**nk*i]=emn[l];
             }
           }
         }
       }
     }
   }
   
   icntrl=-2;
   
   FORTRAN(rectcyl,(cot,vt,fnt,stnt,qfnt,eent,cs,&nkt,&icntrl,t,filab,
            &imag,mi,emnt));
   
   if(strcmp1(&filab[1044],"ZZS")==0){
       NNEW(neigh,ITG,40*net);
       NNEW(ipneigh,ITG,nkt);
   }
 
   frd(cot,&nkt,kont,ipkont,lakont,&net0,vt,stnt,inumt,nmethod,
         kode,filab,eent,t1t,fnt,time,epnt,ielmatt,matname,enernt,xstatent,
         nstate_,istep,iinc,ithermal,qfnt,&mode,noddiam,trab,inotrt,
         ntrans,orab,ielorien,norien,description,ipneigh,neigh,
         mi,stit,vr,vi,stnr,stni,vmax,stnmax,&ngraph,veold,ener,&net,
         cs,set,nset,istartset,iendset,ialset,eenmax,fnr,fni,emnt,
         thicke,jobnamec,output,qfx,cdn,mortar,cdnr,cdni,nmat);
 
   if(strcmp1(&filab[1044],"ZZS")==0){SFREE(ipneigh);SFREE(neigh);}
   
   if((strcmp1(&filab[0],"U ")==0)||
      (strcmp1(&filab[1131],"TT  ")==0)||
      (strcmp1(&filab[1218],"MF  ")==0)||
      (strcmp1(&filab[1305],"PT  ")==0)||
      ((strcmp1(&filab[87],"NT  ")==0)&&(*ithermal>=2))) SFREE(vt);
   if((strcmp1(&filab[87],"NT  ")==0)&&(*ithermal<2)) SFREE(t1t);
   if((strcmp1(&filab[174],"S   ")==0)||(strcmp1(&filab[1044],"ZZS ")==0)||
      (strcmp1(&filab[1044],"ERR ")==0)) 
      SFREE(stnt);
   if(strcmp1(&filab[261],"E   ")==0) SFREE(eent);
   if((strcmp1(&filab[348],"RF  ")==0)||(strcmp1(&filab[783],"RFL ")==0))
         SFREE(fnt);
   if(strcmp1(&filab[435],"PEEQ")==0) SFREE(epnt);
   if(strcmp1(&filab[522],"ENER")==0) SFREE(enernt);
   if(strcmp1(&filab[609],"SDV ")==0) SFREE(xstatent);
   if((strcmp1(&filab[696],"HFL ")==0)||(strcmp1(&filab[2784],"HER ")==0)) SFREE(qfnt);
   if((strcmp1(&filab[1044],"ZZS ")==0)||(strcmp1(&filab[1044],"ERR ")==0)||
      (strcmp1(&filab[2175],"CONT")==0)) SFREE(stit);
   if(strcmp1(&filab[2697],"ME  ")==0) SFREE(emnt);
 
   SFREE(kont);SFREE(ipkont);SFREE(lakont);SFREE(ielmatt);
   SFREE(inumt);SFREE(cot);if(*ntrans>0)SFREE(inotrt);
   SFREE(inocs);SFREE(ielcs);
   return;
 }

◆ frdgeneralvector()

void frdgeneralvector	(	double *	v,
		ITG *	iset,
		ITG *	ntrans,
		char *	filabl,
		ITG *	nkcoords,
		ITG *	inum,
		char *	m1,
		ITG *	inotr,
		double *	trab,
		double *	co,
		ITG *	istartset,
		ITG *	iendset,
		ITG *	ialset,
		ITG *	mi,
		ITG *	ngraph,
		FILE *	f1,
		char *	output,
		char *	m3
	)

                                               {
 
     ITG i,j,k,l,m,nksegment;
       
   int iw;
 
   float ifl;
   
   double a[9];
 
   if(*iset==0){
     if((*ntrans==0)||(strcmp1(&filabl[5],"G")==0)){
       for(i=0;i<*nkcoords;i++){
     if(inum[i]<=0) continue;
     if(strcmp1(output,"asc")==0){
         if(mi[1]==4){
         fprintf(f1,"%3s%10" ITGFORMAT "%12.5E%12.5E%12.5E%12.5E\n",m1,i+1,
             (float)v[(mi[1]+1)*i+1],(float)v[(mi[1]+1)*i+2],
             (float)v[(mi[1]+1)*i+3],(float)v[(mi[1]+1)*i+4]);
         }else if(mi[1]==5){
         fprintf(f1,"%3s%10" ITGFORMAT "%12.5E%12.5E%12.5E%12.5E%12.5E\n",m1,i+1,
             (float)v[(mi[1]+1)*i+1],(float)v[(mi[1]+1)*i+2],
             (float)v[(mi[1]+1)*i+3],(float)v[(mi[1]+1)*i+4],
             (float)v[(mi[1]+1)*i+5]);
         }else if(mi[1]==6){
         fprintf(f1,"%3s%10" ITGFORMAT "%12.5E%12.5E%12.5E%12.5E%12.5E%12.5E\n",m1,i+1,
             (float)v[(mi[1]+1)*i+1],(float)v[(mi[1]+1)*i+2],
             (float)v[(mi[1]+1)*i+3],(float)v[(mi[1]+1)*i+4],
             (float)v[(mi[1]+1)*i+5],(float)v[(mi[1]+1)*i+6]);
         }
     }else{
       iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
       for(j=1;j<=mi[1];j++){
           ifl=(float)v[(mi[1]+1)*i+j];fwrite(&ifl,sizeof(float),1,f1);
       }
     }
       }
     }else{
       for(i=0;i<*nkcoords;i++){
     if(inum[i]<=0) continue;
     if(inotr[2*i]==0){
       if(strcmp1(output,"asc")==0){
         if(mi[1]==4){
         fprintf(f1,"%3s%10" ITGFORMAT "%12.5E%12.5E%12.5E%12.5E\n",m1,i+1,
             (float)v[(mi[1]+1)*i+1],(float)v[(mi[1]+1)*i+2],
             (float)v[(mi[1]+1)*i+3],(float)v[(mi[1]+1)*i+4]);
         }else if(mi[1]==5){
         fprintf(f1,"%3s%10" ITGFORMAT "%12.5E%12.5E%12.5E%12.5E%12.5E\n",m1,i+1,
             (float)v[(mi[1]+1)*i+1],(float)v[(mi[1]+1)*i+2],
             (float)v[(mi[1]+1)*i+3],(float)v[(mi[1]+1)*i+4],
             (float)v[(mi[1]+1)*i+5]);
         }else if(mi[1]==6){
         fprintf(f1,"%3s%10" ITGFORMAT "%12.5E%12.5E%12.5E%12.5E%12.5E%12.5E\n",m1,i+1,
             (float)v[(mi[1]+1)*i+1],(float)v[(mi[1]+1)*i+2],
             (float)v[(mi[1]+1)*i+3],(float)v[(mi[1]+1)*i+4],
             (float)v[(mi[1]+1)*i+5],(float)v[(mi[1]+1)*i+6]);
         }
       }else{
         iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
         for(j=1;j<=mi[1];j++){
         ifl=(float)v[(mi[1]+1)*i+j];fwrite(&ifl,sizeof(float),1,f1);
         }
       }
     }else{
         printf("*WARNING in frdgeneralvector:\n");
         printf("         no output in local coordinates allowed\n");
         printf("         for generalized vectors\n");
         printf("         output request ist not performed;\n");
     }
       }
     }
   }else{
     nksegment=(*nkcoords)/(*ngraph);
     for(k=istartset[*iset-1]-1;k<iendset[*iset-1];k++){
       if(ialset[k]>0){
     for(l=0;l<*ngraph;l++){
       i=ialset[k]+l*nksegment-1;
       if(inum[i]<=0) continue;
       if((*ntrans==0)||(strcmp1(&filabl[5],"G")==0)||(inotr[2*i]==0)){
           if(strcmp1(output,"asc")==0){
           if(mi[1]==4){
               fprintf(f1,"%3s%10" ITGFORMAT "%12.5E%12.5E%12.5E%12.5E\n",m1,i+1,
                   (float)v[(mi[1]+1)*i+1],(float)v[(mi[1]+1)*i+2],
                   (float)v[(mi[1]+1)*i+3],(float)v[(mi[1]+1)*i+4]);
           }else if(mi[1]==5){
               fprintf(f1,"%3s%10" ITGFORMAT "%12.5E%12.5E%12.5E%12.5E%12.5E\n",m1,i+1,
                   (float)v[(mi[1]+1)*i+1],(float)v[(mi[1]+1)*i+2],
                   (float)v[(mi[1]+1)*i+3],(float)v[(mi[1]+1)*i+4],
                   (float)v[(mi[1]+1)*i+5]);
           }else if(mi[1]==6){
               fprintf(f1,"%3s%10" ITGFORMAT "%12.5E%12.5E%12.5E%12.5E%12.5E%12.5E\n",m1,i+1,
                   (float)v[(mi[1]+1)*i+1],(float)v[(mi[1]+1)*i+2],
                   (float)v[(mi[1]+1)*i+3],(float)v[(mi[1]+1)*i+4],
                   (float)v[(mi[1]+1)*i+5],(float)v[(mi[1]+1)*i+6]);
           }
           }else{
           iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
           for(j=1;j<=mi[1];j++){
               ifl=(float)v[(mi[1]+1)*i+j];fwrite(&ifl,sizeof(float),1,f1);
           }
           }
       }else{
           printf("*WARNING in frdgeneralvector:\n");
           printf("         no output in local coordinates allowed\n");
           printf("         for generalized vectors\n");
           printf("         output request ist not performed;\n");
       }
     }
       }else{
     l=ialset[k-2];
     do{
       l-=ialset[k];
       if(l>=ialset[k-1]) break;
       for(m=0;m<*ngraph;m++){
         i=l+m*nksegment-1;
         if(inum[i]<=0) continue;
         if((*ntrans==0)||(strcmp1(&filabl[5],"G")==0)||(inotr[2*i]==0)){
         if(strcmp1(output,"asc")==0){
             if(mi[1]==4){
             fprintf(f1,"%3s%10" ITGFORMAT "%12.5E%12.5E%12.5E%12.5E\n",m1,i+1,
                 (float)v[(mi[1]+1)*i+1],(float)v[(mi[1]+1)*i+2],
                 (float)v[(mi[1]+1)*i+3],(float)v[(mi[1]+1)*i+4]);
             }else if(mi[1]==5){
             fprintf(f1,"%3s%10" ITGFORMAT "%12.5E%12.5E%12.5E%12.5E%12.5E\n",m1,i+1,
                 (float)v[(mi[1]+1)*i+1],(float)v[(mi[1]+1)*i+2],
                 (float)v[(mi[1]+1)*i+3],(float)v[(mi[1]+1)*i+4],
                 (float)v[(mi[1]+1)*i+5]);
             }else if(mi[1]==6){
             fprintf(f1,"%3s%10" ITGFORMAT "%12.5E%12.5E%12.5E%12.5E%12.5E%12.5E\n",m1,i+1,
                 (float)v[(mi[1]+1)*i+1],(float)v[(mi[1]+1)*i+2],
                 (float)v[(mi[1]+1)*i+3],(float)v[(mi[1]+1)*i+4],
                 (float)v[(mi[1]+1)*i+5],(float)v[(mi[1]+1)*i+6]);
             }
         }else{
             iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
             for(j=1;j<=mi[1];j++){
             ifl=(float)v[(mi[1]+1)*i+j];fwrite(&ifl,sizeof(float),1,f1);
             }
         }
         }else{
           printf("*WARNING in frdgeneralvector:\n");
           printf("         no output in local coordinates allowed\n");
           printf("         for generalized vectors\n");
           printf("         output request ist not performed;\n");
         }
       }
     }while(1);
       }
     }
   }
       
   if(strcmp1(output,"asc")==0)fprintf(f1,"%3s\n",m3);
 
   return;
 
 }

◆ frdheader()

void frdheader	(	ITG *	icounter,
		double *	oner,
		double *	time,
		double *	pi,
		ITG *	noddiam,
		double *	cs,
		ITG *	null,
		ITG *	mode,
		ITG *	noutloc,
		char *	description,
		ITG *	kode,
		ITG *	nmethod,
		FILE *	f1,
		char *	output,
		ITG *	istep,
		ITG *	iinc
	)

                                                            {
 
   char tmp[132],text[132];
 
   ITG i,ncomma;
   
   /* icounter counts the number of loadcases in the frd-file 
      kode counts the number of increments in the frd-file */
 
   strcpy1(&text[0],"    1PSTEP",10);
   for(i=10;i<70;i++)text[i]=' ';text[70]='\0';
   (*icounter)++;
   sprintf(&text[24],"%12" ITGFORMAT "",*icounter);
   sprintf(&text[36],"%12" ITGFORMAT "",*iinc);
   sprintf(&text[48],"%12" ITGFORMAT "",*istep);text[60]=' ';
   fprintf(f1,"%s\n",text);
 
   /* additional headers for frequency calculations */
 
   if((*nmethod==2)||(*nmethod==6)||(*nmethod==7)||
      ((*nmethod==12)&&(*noddiam>-1))){
     strcpy1(&text[0],"    1PGM",8);
     for(i=8;i<70;i++)text[i]=' ';text[70]='\0';
     sprintf(&text[24],"%12.6E",*oner);text[36]=' ';
     fprintf(f1,"%s\n",text);
 
     strcpy1(&text[0],"    1PGK",8);
     for(i=8;i<70;i++)text[i]=' ';text[70]='\0';
     sprintf(&text[24],"%12.6E",(*time*2.**pi)*(*time*2.**pi));text[36]=' ';
     fprintf(f1,"%s\n",text);
 
     strcpy1(&text[0],"    1PHID",9);
     for(i=9;i<70;i++)text[i]=' ';text[70]='\0';
     sprintf(&text[24],"%12" ITGFORMAT "",*noddiam);text[36]=' ';
     fprintf(f1,"%s\n",text);
 
     /* additional headers for cyclic symmetry calculations */
 
     if((*noddiam>=0)&&(cs!=NULL)){
       strcpy1(&text[0],"    1PAX",8);
       for(i=8;i<24;i++)text[i]=' ';
       sprintf(&text[24],"%12.5E",cs[5]);
       sprintf(&text[36],"%12.5E",cs[6]);
       sprintf(&text[48],"%12.5E",cs[7]);
       sprintf(&text[60],"%12.5E",cs[8]);
       sprintf(&text[72],"%12.5E",cs[9]);
       sprintf(&text[84],"%12.5E",cs[10]);
       fprintf(f1,"%s\n",text);
     }
 
     strcpy1(&text[0],"    1PSUBC",10);
     for(i=10;i<70;i++)text[i]=' ';text[70]='\0';
     sprintf(&text[24],"%12" ITGFORMAT "",*null);text[36]=' ';
     fprintf(f1,"%s\n",text);
 
     strcpy1(&text[0],"    1PMODE",10);
     for(i=10;i<70;i++)text[i]=' ';text[70]='\0';
     sprintf(&text[24],"%12" ITGFORMAT "",*mode+1);text[36]=' ';
     fprintf(f1,"%s\n",text);
   }
 
 #ifdef COMPANY
   writeBasisParameter(f1,istep,iinc);
 #endif    
      
   /* 100CL line */
  
   for(i=0;i<75;i++)text[i]=' ';
   if(abs(*nmethod)==1){
     strcpy1(&text[0],"  100CL       .00000E+00                                 0    1",63);
   }else if(*nmethod==2){
     strcpy1(&text[0],"  100CL       .00000E+00                                 2    1",63);
   }else if(*nmethod==3){
     strcpy1(&text[0],"  100CL       .00000E+00                                 4    1",63);
   }else if((*nmethod==4)||(*nmethod==5)){
     strcpy1(&text[0],"  100CL       .00000E+00                                 1    1",63);
   }else{
     strcpy1(&text[0],"  100CL       .00000E+00                                 3    1",63);
   }
 
   sprintf(tmp,"%12" ITGFORMAT "",*noutloc);
   strcpy1(&text[24],tmp,12);
   strcpy1(&text[36],description,12);
   if(*nmethod==2)strcpy1(&text[63],"MODAL",5);
   if(strcmp1(output,"asc")==0){
     strcpy1(&text[74],"1",1);
   }else{
     strcpy1(&text[74],"2",1);
   }
   sprintf(tmp,"%5" ITGFORMAT "",100+(*kode));
   strcpy1(&text[7],tmp,5);
 //  sprintf(tmp,"%12.5E",*time);
 
   if((*time<=0.)||(*nmethod==2)){
       sprintf(tmp,"%12.5E",*time);
   }else if((log10(*time)>=0)&&(log10(*time)<10.)){
       ncomma=10-floor(log10(*time)+1.);
       if(ncomma==0){
       sprintf(tmp,"%12.0f",*time);
       }else if(ncomma==1){
       sprintf(tmp,"%12.1f",*time);
       }else if(ncomma==2){
       sprintf(tmp,"%12.2f",*time);
       }else if(ncomma==3){
       sprintf(tmp,"%12.3f",*time);
       }else if(ncomma==4){
       sprintf(tmp,"%12.4f",*time);
       }else if(ncomma==5){
       sprintf(tmp,"%12.5f",*time);
       }else if(ncomma==6){
       sprintf(tmp,"%12.6f",*time);
       }else if(ncomma==7){
       sprintf(tmp,"%12.7f",*time);
       }else if(ncomma==8){
       sprintf(tmp,"%12.8f",*time);
       }else{
       sprintf(tmp,"%12.9f",*time);
       }
   }else{
       sprintf(tmp,"%12.5E",*time);
   }
 
   strcpy1(&text[12],tmp,12);
   sprintf(tmp,"%5" ITGFORMAT "",*kode);
   strcpy1(&text[58],tmp,5);
   text[75]='\0';
   fprintf(f1,"%s\n",text);
 
 }

◆ frdselect()

void frdselect	(	double *	field1,
		double *	field2,
		ITG *	iset,
		ITG *	nkcoords,
		ITG *	inum,
		char *	m1,
		ITG *	istartset,
		ITG *	iendset,
		ITG *	ialset,
		ITG *	ngraph,
		ITG *	ncomp,
		ITG *	ifield,
		ITG *	icomp,
		ITG *	nfield,
		ITG *	iselect,
		char *	m2,
		FILE *	f1,
		char *	output,
		char *	m3
	)

                            {
 
   /* storing scalars, components of vectors and tensors without additional
      transformations */
 
   /* number of components in field1: nfield[0]
      number of components in field2: nfield[1]
 
      number of entities to store: ncomp
      for each entity i, 0<=i<ncomp:
          - ifield[i]: 1=field1,2=field2
          - icomp[i]: component: 0...,(nfield[0]-1 or nfield[1]-1) */
  
   ITG i,j,k,l,m,n,nksegment;
       
   int iw;
 
   float ifl;
 
   if(*iset==0){
     for(i=0;i<*nkcoords;i++){
 
       /* check whether output is requested for solid nodes or
          network nodes */
 
       if(*iselect==1){
     if(inum[i]<=0) continue;
       }else if(*iselect==-1){
     if(inum[i]>=0) continue;
       }else{
     if(inum[i]==0) continue;
       }
 
       /* storing the entities */
 
     for(n=1;n<=(ITG)((*ncomp+5)/6);n++){
       if(n==1){
         if(strcmp1(output,"asc")==0){
           fprintf(f1,"%3s%10" ITGFORMAT "",m1,i+1);
         }else{
           iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
         }
         for(j=0;j<min(6,*ncomp);j++){
           if(ifield[j]==1){
         if(strcmp1(output,"asc")==0){
             fprintf(f1,"%12.5E",(float)field1[i*nfield[0]+icomp[j]]);
         }else{
           ifl=(float)field1[i*nfield[0]+icomp[j]];
           fwrite(&ifl,sizeof(float),1,f1);
         }
           }else{
         if(strcmp1(output,"asc")==0){
           fprintf(f1,"%12.5E",(float)field2[i*nfield[1]+icomp[j]]);
         }else{
           ifl=(float)field2[i*nfield[1]+icomp[j]];
           fwrite(&ifl,sizeof(float),1,f1);
         }
           }
         }
         if(strcmp1(output,"asc")==0)fprintf(f1,"\n");
       }else{
         if(strcmp1(output,"asc")==0)fprintf(f1,"%3s          ",m2);
         for(j=(n-1)*6;j<min(n*6,*ncomp);j++){
           if(ifield[j]==1){
         if(strcmp1(output,"asc")==0){
           fprintf(f1,"%12.5E",(float)field1[i*nfield[0]+icomp[j]]);
         }else{
           ifl=(float)field1[i*nfield[0]+icomp[j]];
           fwrite(&ifl,sizeof(float),1,f1);
         }
           }else{
         if(strcmp1(output,"asc")==0){
           fprintf(f1,"%12.5E",(float)field2[i*nfield[1]+icomp[j]]);
         }else{
           ifl=(float)field2[i*nfield[1]+icomp[j]];
           fwrite(&ifl,sizeof(float),1,f1);
         }
           }
         }
         if(strcmp1(output,"asc")==0)fprintf(f1,"\n");
       }
     }
 
     }
   }else{
     nksegment=(*nkcoords)/(*ngraph);
     for(k=istartset[*iset-1]-1;k<iendset[*iset-1];k++){
       if(ialset[k]>0){
     for(l=0;l<*ngraph;l++){
       i=ialset[k]+l*nksegment-1;
 
       /* check whether output is requested for solid nodes or
          network nodes */
 
       if(*iselect==1){
         if(inum[i]<=0) continue;
       }else if(*iselect==-1){
         if(inum[i]>=0) continue;
       }else{
         if(inum[i]==0) continue;
       }
       
       /* storing the entities */
 
       for(n=1;n<=(ITG)((*ncomp+5)/6);n++){
         if(n==1){
           if(strcmp1(output,"asc")==0){
         fprintf(f1,"%3s%10" ITGFORMAT "",m1,i+1);
           }else{
         iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
           }
           for(j=0;j<min(6,*ncomp);j++){
         if(ifield[j]==1){
           if(strcmp1(output,"asc")==0){
             fprintf(f1,"%12.5E",(float)field1[i*nfield[0]+icomp[j]]);
           }else{
             ifl=(float)field1[i*nfield[0]+icomp[j]];
             fwrite(&ifl,sizeof(float),1,f1);
           }
         }else{
           if(strcmp1(output,"asc")==0){
             fprintf(f1,"%12.5E",(float)field2[i*nfield[1]+icomp[j]]);
           }else{
             ifl=(float)field2[i*nfield[1]+icomp[j]];
             fwrite(&ifl,sizeof(float),1,f1);
           }
         }
           }
           if(strcmp1(output,"asc")==0)fprintf(f1,"\n");
         }else{
           if(strcmp1(output,"asc")==0)fprintf(f1,"%3s          ",m2);
           for(j=(n-1)*6;j<min(n*6,*ncomp);j++){
         if(ifield[j]==1){
           if(strcmp1(output,"asc")==0){
             fprintf(f1,"%12.5E",(float)field1[i*nfield[0]+icomp[j]]);
           }else{
             ifl=(float)field1[i*nfield[0]+icomp[j]];
             fwrite(&ifl,sizeof(float),1,f1);
           }
         }else{
           if(strcmp1(output,"asc")==0){
             fprintf(f1,"%12.5E",(float)field2[i*nfield[1]+icomp[j]]);
           }else{
             ifl=(float)field2[i*nfield[1]+icomp[j]];
             fwrite(&ifl,sizeof(float),1,f1);
           }
         }
           }
           if(strcmp1(output,"asc")==0)fprintf(f1,"\n");
         }
       }
       
     }
       }else{
     l=ialset[k-2];
     do{
       l-=ialset[k];
       if(l>=ialset[k-1]) break;
       for(m=0;m<*ngraph;m++){
         i=l+m*nksegment-1;
         
         /* check whether output is requested for solid nodes or
            network nodes */
         
         if(*iselect==1){
           if(inum[i]<=0) continue;
         }else if(*iselect==-1){
           if(inum[i]>=0) continue;
         }else{
           if(inum[i]==0) continue;
         }
         
         /* storing the entities */
         
         for(n=1;n<=(ITG)((*ncomp+5)/6);n++){
           if(n==1){
         if(strcmp1(output,"asc")==0){
           fprintf(f1,"%3s%10" ITGFORMAT "",m1,i+1);
         }else{
           iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
         }
         for(j=0;j<min(6,*ncomp);j++){
           if(ifield[j]==1){
             if(strcmp1(output,"asc")==0){
               fprintf(f1,"%12.5E",(float)field1[i*nfield[0]+icomp[j]]);
             }else{
               ifl=(float)field1[i*nfield[0]+icomp[j]];
               fwrite(&ifl,sizeof(float),1,f1);
             }
           }else{
             if(strcmp1(output,"asc")==0){
               fprintf(f1,"%12.5E",(float)field2[i*nfield[1]+icomp[j]]);
             }else{
               ifl=(float)field2[i*nfield[1]+icomp[j]];
               fwrite(&ifl,sizeof(float),1,f1);
             }
           }
         }
         if(strcmp1(output,"asc")==0)fprintf(f1,"\n");
           }else{
         if(strcmp1(output,"asc")==0)fprintf(f1,"%3s          ",m2);
         for(j=(n-1)*6;j<min(n*6,*ncomp);j++){
           if(ifield[j]==1){
             if(strcmp1(output,"asc")==0){
               fprintf(f1,"%12.5E",(float)field1[i*nfield[0]+icomp[j]]);
             }else{
               ifl=(float)field1[i*nfield[0]+icomp[j]];
               fwrite(&ifl,sizeof(float),1,f1);
             }
           }else{
             if(strcmp1(output,"asc")==0){
               fprintf(f1,"%12.5E",(float)field2[i*nfield[1]+icomp[j]]);
             }else{
               ifl=(float)field2[i*nfield[1]+icomp[j]];
               fwrite(&ifl,sizeof(float),1,f1);
             }
           }
         }
         if(strcmp1(output,"asc")==0)fprintf(f1,"\n");
           }
         }
         
       }
     }while(1);
       }
     }
   }
   
   if(strcmp1(output,"asc")==0)fprintf(f1,"%3s\n",m3);
 
   return;
 
 }

◆ frdset()

void frdset	(	char *	filabl,
		char *	set,
		ITG *	iset,
		ITG *	istartset,
		ITG *	iendset,
		ITG *	ialset,
		ITG *	inum,
		ITG *	noutloc,
		ITG *	nout,
		ITG *	nset,
		ITG *	noutmin,
		ITG *	noutplus,
		ITG *	iselect,
		ITG *	ngraph
	)

                                                             {
 
   ITG j,k;
 
   char noset[81];
      
   /* check for a set, if any */
 
   strcpy1(noset,&filabl[6],81);
   for((*iset)=0;(*iset)<(*nset);(*iset)++){
     if(strcmp2(&set[81**iset],noset,81)==0) break;
   }
   (*iset)++;
   if(*iset>*nset)*iset=0;
   //    printf("iset,noutplus %" ITGFORMAT " %" ITGFORMAT "\n",*iset,*noutplus);
 
   /* determining the number of nodes in the set */
 
   if(*iset==0){
 
     /* no set defined */
 
     //    printf("iselect,noutplus %" ITGFORMAT " %" ITGFORMAT "\n",*iselect,*noutplus);
 
     if(*iselect==1){
       *noutloc=*noutplus;
     }else if(*iselect==-1){
       *noutloc=*noutmin;
     }else{
       *noutloc=*nout;
     }
 
   }else{
 
     /* a set was defined */
 
     *noutloc=0;
     for(j=istartset[*iset-1]-1;j<iendset[*iset-1];j++){
       if(ialset[j]>0){
     if(*iselect==-1){
       if(inum[ialset[j]-1]<0) (*noutloc)++;
     }else if(*iselect==1){
       if(inum[ialset[j]-1]>0) (*noutloc)++;
     }else{
       if(inum[ialset[j]-1]!=0) (*noutloc)++;
     }
       }else{
     k=ialset[j-2];
     do{
       k=k-ialset[j];
       if(k>=ialset[j-1]) break;
       if(*iselect==-1){
         if(inum[k-1]<0) (*noutloc)++;
       }else if(*iselect==1){
         if(inum[k-1]>0) (*noutloc)++;
       }else{
         if(inum[k-1]!=0) (*noutloc)++;
       }
     }while(1);
       }
     }
     if(*ngraph>1) (*noutloc)*=(*ngraph);
   }
     
 
 }

◆ frdvector()

void frdvector	(	double *	v,
		ITG *	iset,
		ITG *	ntrans,
		char *	filabl,
		ITG *	nkcoords,
		ITG *	inum,
		char *	m1,
		ITG *	inotr,
		double *	trab,
		double *	co,
		ITG *	istartset,
		ITG *	iendset,
		ITG *	ialset,
		ITG *	mi,
		ITG *	ngraph,
		FILE *	f1,
		char *	output,
		char *	m3
	)

                                               {
 
   ITG i,k,l,m,nksegment;
       
   int iw;
 
   float ifl;
   
   double a[9];
 
   if(*iset==0){
     if((*ntrans==0)||(strcmp1(&filabl[5],"G")==0)){
       for(i=0;i<*nkcoords;i++){
     if(inum[i]<=0) continue;
     if(strcmp1(output,"asc")==0){
       fprintf(f1,"%3s%10" ITGFORMAT "%12.5E%12.5E%12.5E\n",m1,i+1,
                   (float)v[(mi[1]+1)*i+1],
           (float)v[(mi[1]+1)*i+2],(float)v[(mi[1]+1)*i+3]);
     }else{
       iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
       ifl=(float)v[(mi[1]+1)*i+1];fwrite(&ifl,sizeof(float),1,f1);
       ifl=(float)v[(mi[1]+1)*i+2];fwrite(&ifl,sizeof(float),1,f1);
       ifl=(float)v[(mi[1]+1)*i+3];fwrite(&ifl,sizeof(float),1,f1);
     }
       }
     }else{
       for(i=0;i<*nkcoords;i++){
     if(inum[i]<=0) continue;
     if(inotr[2*i]==0){
       if(strcmp1(output,"asc")==0){
         fprintf(f1,"%3s%10" ITGFORMAT "%12.5E%12.5E%12.5E\n",m1,i+1,
                     (float)v[(mi[1]+1)*i+1],
             (float)v[(mi[1]+1)*i+2],(float)v[(mi[1]+1)*i+3]);
       }else{
         iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
         ifl=(float)v[(mi[1]+1)*i+1];fwrite(&ifl,sizeof(float),1,f1);
         ifl=(float)v[(mi[1]+1)*i+2];fwrite(&ifl,sizeof(float),1,f1);
         ifl=(float)v[(mi[1]+1)*i+3];fwrite(&ifl,sizeof(float),1,f1);
       }
     }else{
       FORTRAN(transformatrix,(&trab[7*(inotr[2*i]-1)],&co[3*i],a));
       if(strcmp1(output,"asc")==0){
         fprintf(f1,"%3s%10" ITGFORMAT "%12.5E%12.5E%12.5E\n",m1,i+1,
             (float)(v[(mi[1]+1)*i+1]*a[0]+v[(mi[1]+1)*i+2]*a[1]+v[(mi[1]+1)*i+3]*a[2]),
             (float)(v[(mi[1]+1)*i+1]*a[3]+v[(mi[1]+1)*i+2]*a[4]+v[(mi[1]+1)*i+3]*a[5]),
             (float)(v[(mi[1]+1)*i+1]*a[6]+v[(mi[1]+1)*i+2]*a[7]+v[(mi[1]+1)*i+3]*a[8]));
       }else{
         iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
         ifl=(float)v[(mi[1]+1)*i+1]*a[0]+v[(mi[1]+1)*i+2]*a[1]+v[(mi[1]+1)*i+3]*a[2];
         fwrite(&ifl,sizeof(float),1,f1);
         ifl=(float)v[(mi[1]+1)*i+1]*a[3]+v[(mi[1]+1)*i+2]*a[4]+v[(mi[1]+1)*i+3]*a[5];
         fwrite(&ifl,sizeof(float),1,f1);
         ifl=(float)v[(mi[1]+1)*i+1]*a[6]+v[(mi[1]+1)*i+2]*a[7]+v[(mi[1]+1)*i+3]*a[8];
         fwrite(&ifl,sizeof(float),1,f1);
       }
     }
       }
     }
   }else{
     nksegment=(*nkcoords)/(*ngraph);
     for(k=istartset[*iset-1]-1;k<iendset[*iset-1];k++){
       if(ialset[k]>0){
     for(l=0;l<*ngraph;l++){
       i=ialset[k]+l*nksegment-1;
       if(inum[i]<=0) continue;
       if((*ntrans==0)||(strcmp1(&filabl[5],"G")==0)||(inotr[2*i]==0)){
           if(strcmp1(output,"asc")==0){
           fprintf(f1,"%3s%10" ITGFORMAT "%12.5E%12.5E%12.5E\n",m1,i+1,(float)v[(mi[1]+1)*i+1],
               (float)v[(mi[1]+1)*i+2],(float)v[(mi[1]+1)*i+3]);
           }else{
           iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
           ifl=(float)v[(mi[1]+1)*i+1];fwrite(&ifl,sizeof(float),1,f1);
           ifl=(float)v[(mi[1]+1)*i+2];fwrite(&ifl,sizeof(float),1,f1);
           ifl=(float)v[(mi[1]+1)*i+3];fwrite(&ifl,sizeof(float),1,f1);
           }
       }else{
           FORTRAN(transformatrix,(&trab[7*(inotr[2*i]-1)],&co[3*i],a));
           if(strcmp1(output,"asc")==0){
           fprintf(f1,"%3s%10" ITGFORMAT "%12.5E%12.5E%12.5E\n",m1,i+1,   
               (float)(v[(mi[1]+1)*i+1]*a[0]+v[(mi[1]+1)*i+2]*a[1]+v[(mi[1]+1)*i+3]*a[2]),
               (float)(v[(mi[1]+1)*i+1]*a[3]+v[(mi[1]+1)*i+2]*a[4]+v[(mi[1]+1)*i+3]*a[5]),
               (float)(v[(mi[1]+1)*i+1]*a[6]+v[(mi[1]+1)*i+2]*a[7]+v[(mi[1]+1)*i+3]*a[8]));
           }else{
           iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
           ifl=(float)v[(mi[1]+1)*i+1]*a[0]+v[(mi[1]+1)*i+2]*a[1]+v[(mi[1]+1)*i+3]*a[2];
           fwrite(&ifl,sizeof(float),1,f1);
           ifl=(float)v[(mi[1]+1)*i+1]*a[3]+v[(mi[1]+1)*i+2]*a[4]+v[(mi[1]+1)*i+3]*a[5];
           fwrite(&ifl,sizeof(float),1,f1);
           ifl=(float)v[(mi[1]+1)*i+1]*a[6]+v[(mi[1]+1)*i+2]*a[7]+v[(mi[1]+1)*i+3]*a[8];
           fwrite(&ifl,sizeof(float),1,f1);
           }
       }
     }
       }else{
     l=ialset[k-2];
     do{
       l-=ialset[k];
       if(l>=ialset[k-1]) break;
       for(m=0;m<*ngraph;m++){
         i=l+m*nksegment-1;
         if(inum[i]<=0) continue;
         if((*ntrans==0)||(strcmp1(&filabl[5],"G")==0)||(inotr[2*i]==0)){
         if(strcmp1(output,"asc")==0){
             fprintf(f1,"%3s%10" ITGFORMAT "%12.5E%12.5E%12.5E\n",m1,i+1,(float)v[(mi[1]+1)*i+1],
                 (float)v[(mi[1]+1)*i+2],(float)v[(mi[1]+1)*i+3]);
         }else{
             iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
             ifl=(float)v[(mi[1]+1)*i+1];fwrite(&ifl,sizeof(float),1,f1);
             ifl=(float)v[(mi[1]+1)*i+2];fwrite(&ifl,sizeof(float),1,f1);
             ifl=(float)v[(mi[1]+1)*i+3];fwrite(&ifl,sizeof(float),1,f1);
         }
         }else{
           FORTRAN(transformatrix,(&trab[7*(inotr[2*i]-1)],&co[3*i],a));
           if(strcmp1(output,"asc")==0){
           fprintf(f1,"%3s%10" ITGFORMAT "%12.5E%12.5E%12.5E\n",m1,i+1,   
               (float)(v[(mi[1]+1)*i+1]*a[0]+v[(mi[1]+1)*i+2]*a[1]+
                   v[(mi[1]+1)*i+3]*a[2]),
               (float)(v[(mi[1]+1)*i+1]*a[3]+v[(mi[1]+1)*i+2]*a[4]+
                   v[(mi[1]+1)*i+3]*a[5]),
               (float)(v[(mi[1]+1)*i+1]*a[6]+v[(mi[1]+1)*i+2]*a[7]+
                   v[(mi[1]+1)*i+3]*a[8]));
           }else{
           iw=(int)(i+1);fwrite(&iw,sizeof(int),1,f1);
           ifl=(float)v[(mi[1]+1)*i+1]*a[0]+v[(mi[1]+1)*i+2]*a[1]+v[(mi[1]+1)*i+3]*a[2];
           fwrite(&ifl,sizeof(float),1,f1);
           ifl=(float)v[(mi[1]+1)*i+1]*a[3]+v[(mi[1]+1)*i+2]*a[4]+v[(mi[1]+1)*i+3]*a[5];
           fwrite(&ifl,sizeof(float),1,f1);
           ifl=(float)v[(mi[1]+1)*i+1]*a[6]+v[(mi[1]+1)*i+2]*a[7]+v[(mi[1]+1)*i+3]*a[8];
           fwrite(&ifl,sizeof(float),1,f1);
           }
         }
       }
     }while(1);
       }
     }
   }
       
   if(strcmp1(output,"asc")==0)fprintf(f1,"%3s\n",m3);
 
   return;
 
 }

◆ getglobalresults()

void getglobalresults	(	char *	jobnamec,
		ITG **	integerglobp,
		double **	doubleglobp,
		ITG *	nboun,
		ITG *	iamboun,
		double *	xboun,
		ITG *	nload,
		char *	sideload,
		ITG *	iamload,
		ITG *	iglob,
		ITG *	nforc,
		ITG *	iamforc,
		double *	xforc,
		ITG *	ithermal,
		ITG *	nk,
		double *	t1,
		ITG *	iamt1
	)

 {
  
     char  datin[MAX_LINE_LENGTH],text[13]="            ";
     Summen    anz[1]; 
     Nodes     *node=NULL;
     Elements  *elem=NULL;
     Datasets *lcase=NULL;
     
     ITG *kontet=NULL,*ifatet=NULL,*inodfa=NULL,*ipofa=NULL,type,n1,n2,n3,n4,
     *nnx=NULL,*nny=NULL,*nnz=NULL,*kon=NULL,*ipkon=NULL,*kontyp=NULL,
     *iparent=NULL,ifreefa=1,kflag=2,ne,netet,numnodes,nkon,
     indexe,istep,loadcase,nfaces,netet_,nktet=0,nfield,j,nodes[4],i,
     read_mode=0,nodenr,*integerglob=NULL,*ielemnr=NULL,istep_global;
     
     ITG i1[24]={3,7,8,6,4,3,8,1,3,8,5,6,3,5,8,1,2,3,5,6,2,5,3,1};
     ITG i2[12]={1,2,3,5,1,5,3,4,4,5,3,6};
     ITG i4[88]={5,20,17,13,20,8,19,16,19,7,18,15,18,6,17,14,
         1,9,12,13,12,11,4,16,11,10,3,15,9,2,10,14,
         9,13,11,12,11,13,16,12,13,17,19,20,13,19,16,20,
         17,14,19,18,19,14,15,18,9,11,14,10,11,15,14,10,
         11,19,16,13,11,15,19,14,11,14,19,17,11,19,13,17,
               11,14,17,9,11,17,13,9};
     ITG i5[56]={1,7,9,10,7,2,8,11,8,3,9,12,5,13,14,11,
               13,4,15,10,14,15,6,12,11,12,7,10,7,12,9,10,
         11,7,12,8,12,7,9,8,13,15,11,10,11,15,12,10,
         13,11,15,14,15,11,12,14};
     ITG i6[32]={8,9,10,4,1,5,7,8,7,6,3,10,9,8,10,7,
         8,9,5,7,9,10,6,7,5,6,7,9,5,2,6,9};
     
     double *planfa=NULL,*cotet=NULL,*cgtet=NULL,*field=NULL,
     *x=NULL,*y=NULL,*z=NULL,*xo=NULL,*yo=NULL,*zo=NULL,
     *doubleglob=NULL;
     
     integerglob=*integerglobp;doubleglob=*doubleglobp;
 
     /*  The global mesh is remeshed into tetrahedral elements
 
         cotet(j,i):    j-coordinate of node i of tet mesh
         iparent(i):    parent element from global mesh for tet i
         kontet(4,i):   topology of tet i
         netet:         total # of tets
         cgtet(3,i):    center of gravity of tet i */
     
     /* reading the global coordinates and the topology from file
        (if any, else return) */
     
     if(strcmp1(&jobnamec[396]," ")==0)return;
     strcpy1(datin,&jobnamec[396],132); 
     for(i=0;i<MAX_LINE_LENGTH;i++){
     if(strcmp1(&datin[i]," ")==0){
         datin[i]='\0';
         break;
     }
     }
     
     /* determining the appropriate step number: scanning the SPC
        boundary conditions and distribed facial loads 
        if no global data is needed return*/
     
     istep=0;
     for(i=0;i<*nboun;i++){
     if((xboun[i]<1.9232931375)&&(xboun[i]>1.9232931373)){
         istep=iamboun[i];
         break;
     }
     }
     if(istep==0){
     for(i=0;i<*nforc;i++){
         if((xforc[i]<1.9232931375)&&(xforc[i]>1.9232931373)){
         istep=iamforc[i];
         break;
         }
     }
     }
     if(istep==0){
     for(i=0;i<*nload;i++){
         if(strcmp1(&sideload[20*i+2],"SM")==0){
         istep=iamload[2*i];
         break;
         }
     }
     }
     if((istep==0)&&(*ithermal>0)){
     for(i=0;i<*nk;i++){
         if((t1[i]<1.9232931375)&&(t1[i]>1.9232931373)){
         istep=iamt1[i];
         break;
         }
     }
     }
     if(istep==0){
     return;
     }else{
     *iglob=1;
     }
     
     /* initialization of the size of fields used in readfrd.c */
 
     anz->orign=0;
     anz->n=0;
     anz->e=0;
     anz->f=0;
     anz->g=0;
     anz->t=0;
     anz->l=0;
     anz->olc=0;
     anz->orignmax=0;
     anz->nmax=0;
     anz->nmin=MAX_INTEGER;
     anz->emax=0;
     anz->emin=MAX_INTEGER;
     anz->sets=0;
     anz->mats=0;
     anz->amps=0;
     anz->noffs=0;
     anz->eoffs=0;
     
     readfrd( datin, anz, &node, &elem, &lcase, read_mode);
     
     /* calculation of the highest node number */
     
     nktet=0;
     for(i=0;i<anz[0].n;i++){
     if(node[i].nr>nktet) nktet=node[i].nr;
     }
     NNEW(cotet,double,3*nktet);
     
     /* storing the global coordinates */
     
     for (i=0;i<anz[0].n;i++){
     nodenr=node[i].nr;
     j=nodenr-1;
     cotet[3*j]=node[nodenr].nx;
     cotet[3*j+1]=node[nodenr].ny;
     cotet[3*j+2]=node[nodenr].nz;
     }
     
     /* number of elements (not highest element number; this number
        is not needed) */
     
     ne=anz[0].e;
 
     /* check for the existence of nodes and/or elements */
 
     if((anz[0].n==0)||(anz[0].e==0)){
     printf(" *ERROR in getglobalresults: there are either no nodes or\n no elements or neither nodes nor elements in the master frd-file\n");
     FORTRAN(stop,());
     }
     
     /* storing the topology */
     
     indexe=0;
     NNEW(ielemnr,ITG,ne);
     NNEW(kontyp,ITG,ne);
     NNEW(ipkon,ITG,ne);
     NNEW(kon,ITG,20*ne);
     for(i=0;i<anz[0].e;i++){
     ielemnr[i]=elem[i].nr;
     kontyp[i]=elem[i].type;
     ipkon[i]=indexe;
     if(kontyp[i]==1){
         numnodes=8;
     }else if(kontyp[i]==2){
         numnodes=6;
     }else if(kontyp[i]==3){
         numnodes=4;
     }else if(kontyp[i]==4){
         numnodes=20;
     }else if(kontyp[i]==5){
         numnodes=15;
     }else if(kontyp[i]==6){
         numnodes=10;
     }else{
         printf("*WARNING in getglobalresults.c: element in global\n");
         printf("         mesh not recognized; cgx element type=%" ITGFORMAT "\n",kontyp[i]);
         continue;
     }
     for(j=0;j<numnodes;j++){
         kon[indexe++]=elem[i].nod[j];
     }
     }
     nkon=indexe;
     RENEW(kon,ITG,nkon);
     
     /* generating the tetrahedral elements */
     
     netet=0;
     netet_=22*ne;
     
     NNEW(iparent,ITG,netet_);
     NNEW(kontet,ITG,4*netet_);
     NNEW(ipofa,ITG,nktet);
     NNEW(inodfa,ITG,16*netet_);
     NNEW(ifatet,ITG,4*netet_);
     NNEW(planfa,double,16*netet_);
     
     /* initialization of fields */
     
     FORTRAN(init,(&nktet,inodfa,ipofa,&netet_));
     
     for(i=0;i<ne;i++){
     type=kontyp[i];
     indexe=ipkon[i]-1;
     if(type==1){
         
         /* C3D8* */
         
         for(j=0;j<6;j++){
         nodes[0]=kon[indexe+i1[4*j]];
         nodes[1]=kon[indexe+i1[4*j+1]];
         nodes[2]=kon[indexe+i1[4*j+2]];
         nodes[3]=kon[indexe+i1[4*j+3]];
         iparent[netet]=i+1;
         netet++;
         FORTRAN(generatetet,(kontet,ifatet,&netet,inodfa,
                      &ifreefa,planfa,ipofa,nodes,cotet));
         }
     }
     else if(type==2){
         
         /* C3D6 */
         
         for(j=0;j<3;j++){
         nodes[0]=kon[indexe+i2[4*j]];
         nodes[1]=kon[indexe+i2[4*j+1]];
         nodes[2]=kon[indexe+i2[4*j+2]];
         nodes[3]=kon[indexe+i2[4*j+3]];
         iparent[netet]=i+1;
         netet++;
         FORTRAN(generatetet,(kontet,ifatet,&netet,inodfa,
                      &ifreefa,planfa,ipofa,nodes,cotet));
         }
     }
     else if(type==3){
         
         /* C3D4 */
         
         nodes[0]=kon[indexe+1];
         nodes[1]=kon[indexe+2];
         nodes[2]=kon[indexe+3];
         nodes[3]=kon[indexe+4];
         iparent[netet]=i+1;
         netet++;
         FORTRAN(generatetet,(kontet,ifatet,&netet,inodfa,
                  &ifreefa,planfa,ipofa,nodes,cotet));
     }
     else if(type==4){
         
         /* C3D20* */
         
         for(j=0;j<22;j++){
         nodes[0]=kon[indexe+i4[4*j]];
         nodes[1]=kon[indexe+i4[4*j+1]];
         nodes[2]=kon[indexe+i4[4*j+2]];
         nodes[3]=kon[indexe+i4[4*j+3]];
         iparent[netet]=i+1;
         netet++;
         FORTRAN(generatetet,(kontet,ifatet,&netet,inodfa,
                      &ifreefa,planfa,ipofa,nodes,cotet));
         }
     }
     else if(type==5){
         
         /* C3D15 */
         
         for(j=0;j<14;j++){
         nodes[0]=kon[indexe+i5[4*j]];
         nodes[1]=kon[indexe+i5[4*j+1]];
         nodes[2]=kon[indexe+i5[4*j+2]];
         nodes[3]=kon[indexe+i5[4*j+3]];
         iparent[netet]=i+1;
         netet++;
         FORTRAN(generatetet,(kontet,ifatet,&netet,inodfa,
                      &ifreefa,planfa,ipofa,nodes,cotet));
         }
     }
     else if(type==6){
         
         /* C3D10 */
         
         for(j=0;j<8;j++){
         nodes[0]=kon[indexe+i6[4*j]];
         nodes[1]=kon[indexe+i6[4*j+1]];
         nodes[2]=kon[indexe+i6[4*j+2]];
         nodes[3]=kon[indexe+i6[4*j+3]];
         iparent[netet]=i+1;
         netet++;
         FORTRAN(generatetet,(kontet,ifatet,&netet,inodfa,
                      &ifreefa,planfa,ipofa,nodes,cotet));
         }
     }
     }
     SFREE(ipofa);
     
     nfaces=ifreefa-1;
     
     RENEW(ifatet,ITG,4*netet);
     RENEW(iparent,ITG,netet);
     RENEW(planfa,double,4*nfaces);
     
     /* writing the tet mesh in frd format */
     
 //    FORTRAN(writetetmesh,(kontet,&netet,cotet,&nktet,field,&nfield));
     
     /* calculating the center of gravity of the tetrahedra */
     
     NNEW(cgtet,double,3*netet);
     for(i=0;i<netet;i++){
     n1=kontet[4*i]-1;
     n2=kontet[4*i+1]-1;
     n3=kontet[4*i+2]-1;
     n4=kontet[4*i+3]-1;
     cgtet[3*i]=(cotet[3*n1]+cotet[3*n2]+cotet[3*n3]+cotet[3*n4])/4.;
     cgtet[3*i+1]=(cotet[3*n1+1]+cotet[3*n2+1]+cotet[3*n3+1]+cotet[3*n4+1])/4.;
     cgtet[3*i+2]=(cotet[3*n1+2]+cotet[3*n2+2]+cotet[3*n3+2]+cotet[3*n4+2])/4.;
     }
     
     /* initialization of additional fields */
     
     NNEW(x,double,netet);
     NNEW(y,double,netet);
     NNEW(z,double,netet);
     NNEW(xo,double,netet);
     NNEW(yo,double,netet);
     NNEW(zo,double,netet);
     NNEW(nnx,ITG,netet);
     NNEW(nny,ITG,netet);
     NNEW(nnz,ITG,netet);
     for(i=0;i<netet;i++){
     nnx[i]=i+1;
     nny[i]=i+1;
     nnz[i]=i+1;
     x[i]=cgtet[3*i];
     y[i]=cgtet[3*i+1];
     z[i]=cgtet[3*i+2];
     xo[i]=x[i];
     yo[i]=y[i];
     zo[i]=z[i];
     }
     FORTRAN(dsort,(x,nnx,&netet,&kflag));
     FORTRAN(dsort,(y,nny,&netet,&kflag));
     FORTRAN(dsort,(z,nnz,&netet,&kflag));
     SFREE(cgtet);
     
     /* loading the step data : NDTEMP (1 variable), DISP (3 variables) and
        STRESS (6 variables), if present */
     
     NNEW(field,double,13*nktet);
     
     /* reading the temperatures */
     /* 1. determining the last temperature loadcase in the step */
     
     loadcase=-1;
     for(i=0;i<anz[0].l;i++){
     for(j=0;j<lcase[i].npheader;j++){
         if(strcmp1(&lcase[i].pheader[j][5],"PSTEP")==0){
         strcpy1(text,&lcase[i].pheader[j][48],12);
         istep_global=atoi(text);
         break;
         }
     }
     if((istep_global==istep)&&
        (strcmp1(lcase[i].name,"NDTEMP")==0)){
         loadcase=i;
     }else if(istep_global>istep){
         break;
     }
     }
     
     /* 2. reading the data */
     
     if(loadcase>-1){
 //  if( readfrdblock(loadcase, anz, node, lcase )==-1) 
     if(!read_mode && readfrdblock(loadcase, anz, node, lcase )==-1) 
     {
         printf("ERROR in getglobalresults: Could not read data for Dataset:%" ITGFORMAT "\n", i+1); 
         FORTRAN(stop,());
     }
     
     /* 3. storing the data */
     
     for(i=0;i<anz[0].n;i++){
         nodenr=node[i].nr;
         field[13*(nodenr-1)]=lcase[loadcase].dat[0][nodenr];
     }
     }else{
     printf("INFO in getglobalresults: no temperature data\n was found for step %d in the global model\n\n",istep);
     }
     
     /* reading the displacements */
     /* 1. determining the last displacement loadcase in the step */
     
     loadcase=-1;
     for(i=0;i<anz[0].l;i++){
     for(j=0;j<lcase[i].npheader;j++){
         if(strcmp1(&lcase[i].pheader[j][5],"PSTEP")==0){
         strcpy1(text,&lcase[i].pheader[j][48],12);
         istep_global=atoi(text);
         break;
         }
     }
     if((istep_global==istep)&&
        (strcmp1(lcase[i].name,"DISPR")!=0)&&
        (strcmp1(lcase[i].name,"DISP")==0)){
         loadcase=i;
     }else if(istep_global>istep){
         break;
     }
     }
     
     /* 2. reading the data */
     
     if(loadcase>-1){
 //  if( readfrdblock(loadcase, anz, node, lcase )==-1) 
     if(!read_mode && readfrdblock(loadcase, anz, node, lcase )==-1) 
     {
         printf("ERROR in getglobalresults: Could not read data for Dataset:%" ITGFORMAT "\n", i+1); 
         FORTRAN(stop,());
     }
     
     /* 3. storing the data */
     
     for(i=0;i<anz[0].n;i++){
         nodenr=node[i].nr;
         field[13*(nodenr-1)+1]=lcase[loadcase].dat[0][nodenr];
         field[13*(nodenr-1)+2]=lcase[loadcase].dat[1][nodenr];
         field[13*(nodenr-1)+3]=lcase[loadcase].dat[2][nodenr];
     }
     }else{
     printf("INFO in getglobalresults: no displacement data\n was found for step %d in the global model\n\n",istep);
     }
     
     /* reading the stresses */
     /* 1. determining the last stress loadcase in the step */
     
     loadcase=-1;
     for(i=0;i<anz[0].l;i++){
     for(j=0;j<lcase[i].npheader;j++){
         if(strcmp1(&lcase[i].pheader[j][5],"PSTEP")==0){
         strcpy1(text,&lcase[i].pheader[j][48],12);
         istep_global=atoi(text);
         break;
         }
     }
     if((istep_global==istep)&&
        (strcmp1(lcase[i].name,"STRESS")==0)){
         loadcase=i;
     }else if(istep_global>istep){
         break;
     }
     }
     
     /* 2. reading the data */
     
     if(loadcase>-1){
 //  if( readfrdblock(loadcase, anz, node, lcase )==-1) 
     if(!read_mode && readfrdblock(loadcase, anz, node, lcase )==-1) 
     {
         printf("ERROR in getglobalresults: Could not read data for Dataset:%" ITGFORMAT "\n", i+1); 
         FORTRAN(stop,());
     }
     
     /* 3. storing the data */
     
     for(i=0;i<anz[0].n;i++){
         nodenr=node[i].nr;
         field[13*(nodenr-1)+4]=lcase[loadcase].dat[0][nodenr];
         field[13*(nodenr-1)+5]=lcase[loadcase].dat[1][nodenr];
         field[13*(nodenr-1)+6]=lcase[loadcase].dat[2][nodenr];
         field[13*(nodenr-1)+7]=lcase[loadcase].dat[3][nodenr];
         field[13*(nodenr-1)+8]=lcase[loadcase].dat[4][nodenr];
         field[13*(nodenr-1)+9]=lcase[loadcase].dat[5][nodenr];
     }
     }else{
     printf("INFO in getglobalresults: no stress data\n was found for step %d in the global model\n\n",istep);
     }
     
     /* reading the forces */
     /* 1. determining the last force loadcase in the step */
     
     loadcase=-1;
     for(i=0;i<anz[0].l;i++){
     for(j=0;j<lcase[i].npheader;j++){
         if(strcmp1(&lcase[i].pheader[j][5],"PSTEP")==0){
         strcpy1(text,&lcase[i].pheader[j][48],12);
         istep_global=atoi(text);
         break;
         }
     }
     if((istep_global==istep)&&
        (strcmp1(lcase[i].name,"FORC")==0)){
         loadcase=i;
     }else if(istep_global>istep){
         break;
     }
     }
     
     /* 2. reading the data */
     
     if(loadcase>-1){
     if(!read_mode && readfrdblock(loadcase, anz, node, lcase )==-1) 
     {
         printf("ERROR in getglobalresults: Could not read data for Dataset:%" ITGFORMAT "\n", i+1); 
         FORTRAN(stop,());
     }
     
     /* 3. storing the data */
     
     for(i=0;i<anz[0].n;i++){
         nodenr=node[i].nr;
         field[13*(nodenr-1)+10]=lcase[loadcase].dat[0][nodenr];
         field[13*(nodenr-1)+11]=lcase[loadcase].dat[1][nodenr];
         field[13*(nodenr-1)+12]=lcase[loadcase].dat[2][nodenr];
     }
     }else{
     printf("INFO in getglobalresults: no force data\n was found for step %d in the global model\n\n",istep);
     }
     
     SFREE(kontet);SFREE(inodfa);
     SFREE(node);SFREE(elem);
     for(j=0;j<anz->l;j++){
       freeDatasets(lcase,j);
     }
     SFREE(lcase);lcase=NULL;
     
     /* storing the global data in a common block */
     
     
     NNEW(integerglob,ITG,5+3*ne+nkon+8*netet);
     
     integerglob[0]=nktet;
     integerglob[1]=netet;
     integerglob[2]=ne;
     integerglob[3]=nkon;
     integerglob[4]=nfaces;
     memcpy(&integerglob[5],&nnx[0],sizeof(ITG)*netet);
     memcpy(&integerglob[netet+5],&nny[0],sizeof(ITG)*netet);
     memcpy(&integerglob[2*netet+5],&nnz[0],sizeof(ITG)*netet);
     memcpy(&integerglob[3*netet+5],&ifatet[0],sizeof(ITG)*4*netet);
     memcpy(&integerglob[7*netet+5],&kontyp[0],sizeof(ITG)*ne);
     memcpy(&integerglob[ne+7*netet+5],&ipkon[0],sizeof(ITG)*ne);
     memcpy(&integerglob[2*ne+7*netet+5],&kon[0],sizeof(ITG)*nkon);
     memcpy(&integerglob[nkon+2*ne+7*netet+5],&iparent[0],sizeof(ITG)*netet);
     memcpy(&integerglob[nkon+2*ne+8*netet+5],&ielemnr[0],sizeof(ITG)*ne);
     
     NNEW(doubleglob,double,16*nktet+4*nfaces+6*netet);
     
     memcpy(&doubleglob[0],&x[0],sizeof(double)*netet);
     memcpy(&doubleglob[netet],&y[0],sizeof(double)*netet);
     memcpy(&doubleglob[2*netet],&z[0],sizeof(double)*netet);
     memcpy(&doubleglob[3*netet],&xo[0],sizeof(double)*netet);
     memcpy(&doubleglob[4*netet],&yo[0],sizeof(double)*netet);
     memcpy(&doubleglob[5*netet],&zo[0],sizeof(double)*netet);
     memcpy(&doubleglob[6*netet],&planfa[0],sizeof(double)*4*nfaces);
     memcpy(&doubleglob[4*nfaces+6*netet],&field[0],sizeof(double)*13*nktet);
     memcpy(&doubleglob[13*nktet+4*nfaces+6*netet],&cotet[0],sizeof(double)*3*nktet);
     
     SFREE(nnx);SFREE(nny);SFREE(nnz);SFREE(ifatet);SFREE(kontyp);SFREE(ipkon);
     SFREE(kon);SFREE(iparent);SFREE(ielemnr);
 
     SFREE(x);SFREE(y);SFREE(z);SFREE(xo);SFREE(yo);SFREE(zo);
     SFREE(planfa);SFREE(field);SFREE(cotet);
 
     *integerglobp=integerglob;*doubleglobp=doubleglob;
     
     return;
 
 }

◆ getSystemCPUs()

ITG getSystemCPUs ( )

                    {
     return sysconf(_SC_NPROCESSORS_CONF);;
 }

◆ inicont()

void inicont	(	ITG *	nk,
		ITG *	ncont,
		ITG *	ntie,
		char *	tieset,
		ITG *	nset,
		char *	set,
		ITG *	istartset,
		ITG *	iendset,
		ITG *	ialset,
		ITG **	itietrip,
		char *	lakon,
		ITG *	ipkon,
		ITG *	kon,
		ITG **	koncontp,
		ITG *	ncone,
		double *	tietol,
		ITG *	ismallsliding,
		ITG **	itiefacp,
		ITG **	islavsurfp,
		ITG **	islavnodep,
		ITG **	imastnodep,
		ITG **	nslavnodep,
		ITG **	nmastnodep,
		ITG *	mortar,
		ITG **	imastopp,
		ITG *	nkon,
		ITG **	iponoels,
		ITG **	inoelsp,
		ITG **	ipep,
		ITG **	imep,
		ITG *	ne,
		ITG *	ifacecount,
		ITG *	iperturb,
		ITG *	ikboun,
		ITG *	nboun,
		double *	co,
		ITG *	istep,
		double **	xnoelsp
	)

                                        {
     
   char kind1[2]="C",kind2[2]="-",*tchar1=NULL,*tchar3=NULL;
     
   ITG *itietri=NULL,*koncont=NULL,*itiefac=NULL, *islavsurf=NULL,im,
       *islavnode=NULL,*imastnode=NULL,*nslavnode=NULL,*nmastnode=NULL,
       nmasts,*ipe=NULL,*ime=NULL,*imastop=NULL,
       *iponoels=NULL,*inoels=NULL,ifreenoels,ifreeme,*ipoface=NULL,
       *nodface=NULL,iface,i,j,k,ncone;
     
   double *xnoels=NULL;
     
   itietri=*itietrip;koncont=*koncontp;itiefac=*itiefacp;islavsurf=*islavsurfp;
   islavnode=*islavnodep;imastnode=*imastnodep;nslavnode=*nslavnodep;
   nmastnode=*nmastnodep;imastop=*imastopp,iponoels=*iponoelsp;
   inoels=*inoelsp;ipe=*ipep;ime=*imep;xnoels=*xnoelsp;
 
   /* determining the number of slave entities (nodes or faces, ncone),
      and the number of master triangles (ncont) */
 
   FORTRAN(allocont,(ncont,ntie,tieset,nset,set,istartset,iendset,
       ialset,lakon,&ncone,tietol,ismallsliding,kind1,kind2,mortar,
           istep));
   if(*ncont==0) return;
 
   NNEW(itietri,ITG,2**ntie);
   NNEW(koncont,ITG,4**ncont);
   
   /* triangulation of the master side */
   
   FORTRAN(triangucont,(ncont,ntie,tieset,nset,set,istartset,iendset,
       ialset,itietri,lakon,ipkon,kon,koncont,kind1,kind2,co,nk));
 
   NNEW(ipe,ITG,*nk);
   NNEW(ime,ITG,12**ncont);
   DMEMSET(ipe,0,*nk,0.);
   DMEMSET(ime,0,12**ncont,0.);
   NNEW(imastop,ITG,3**ncont);
 
   FORTRAN(trianeighbor,(ipe,ime,imastop,ncont,koncont,
                 &ifreeme));
 
   if(*mortar==0){SFREE(ipe);SFREE(ime);}
   else{RENEW(ime,ITG,4*ifreeme);}
 
   /* catalogueing the external faces (only for node-to-face
      contact with a nodal slave surface */
 
   NNEW(ipoface,ITG,*nk);
   NNEW(nodface,ITG,5*6**ne);
   FORTRAN(findsurface,(ipoface,nodface,ne,ipkon,kon,lakon,ntie,
          tieset));
     
   NNEW(itiefac,ITG,2**ntie);
   RENEW(islavsurf,ITG,2*6**ne);DMEMSET(islavsurf,0,12**ne,0);
   NNEW(islavnode,ITG,8*ncone);
   NNEW(nslavnode,ITG,*ntie+1);
   NNEW(iponoels,ITG,*nk);
   NNEW(inoels,ITG,2**nkon);
   NNEW(xnoels,double,*nkon);
   
   NNEW(imastnode,ITG,3**ncont);
   NNEW(nmastnode,ITG,*ntie+1);
   
   /* catalogueing the slave faces and slave nodes 
      catalogueing the master nodes (only for Mortar contact) */
 
   FORTRAN(tiefaccont,(lakon,ipkon,kon,ntie,tieset,nset,set,
        istartset,iendset,ialset,itiefac,islavsurf,islavnode,
        imastnode,nslavnode,nmastnode,nslavs,&nmasts,ifacecount,
        iponoels,inoels,&ifreenoels,mortar,ipoface,nodface,nk,
        xnoels));
 
   RENEW(islavsurf,ITG,2**ifacecount+2);
   RENEW(islavnode,ITG,*nslavs);
   RENEW(inoels,ITG,2*ifreenoels);
   RENEW(xnoels,double,ifreenoels);
   SFREE(ipoface);SFREE(nodface);
   
   RENEW(imastnode,ITG,nmasts);
 
   *itietrip=itietri;*koncontp=koncont;
   *itiefacp=itiefac;*islavsurfp=islavsurf;
   *islavnodep=islavnode;*imastnodep=imastnode;
   *nslavnodep=nslavnode;*nmastnodep=nmastnode;
   *imastopp=imastop;*iponoelsp=iponoels;*inoelsp=inoels;
   *ipep=ipe;*imep=ime;*xnoelsp=xnoels;
   
   return;
 }

◆ insert()

void insert	(	ITG *	ipointer,
		ITG **	mast1p,
		ITG **	mast2p,
		ITG *	i1,
		ITG *	i2,
		ITG *	ifree,
		ITG *	nzs_
	)

                                        {
 
   /* routine for the lower triangular matrix, excluding the diagonal */
 
   /*   inserts a new nonzero matrix position into the data structure 
        in FORTRAN notation: 
        - ipointer(i) points to a position in field mast1 containing
          the row number of a nonzero position in column i; 
          next(ipointer(i)) points a position in field mast1 containing
          the row number of another nonzero position in column i, and
          so on until no nonzero positions in column i are left; for 
          the position j in field mast1 containing the momentarily last
          nonzero number in column i we have next(j)=0 
 
        notice that in C the positions start at 0 and not at 1 as in 
        FORTRAN; the present routine is written in FORTRAN convention */
 
     ITG idof1,idof2,istart,*mast1=NULL,*next=NULL;
 
   mast1=*mast1p;
   next=*nextp;
 
   if(*i1==*i2) return;
   if(*i1<*i2){
     idof1=*i2;
     idof2=*i1-1;
   }
   else{
     idof1=*i1;
     idof2=*i2-1;
   }
 
   if(*ifree>=*nzs_){
       *nzs_=(ITG)(1.1**nzs_);
       RENEW(mast1,ITG,*nzs_);
       RENEW(next,ITG,*nzs_);
   }
   mast1[*ifree]=idof1;
   next[*ifree]=ipointer[idof2];
   ipointer[idof2]=++*ifree;
 
   *mast1p=mast1;
   *nextp=next;
   
   return;
 
 }

◆ insertfreq()

void insertfreq	(	ITG *	ipointer,
		ITG **	mast1p,
		ITG **	nextp,
		ITG *	i1,
		ITG *	i2,
		ITG *	ifree,
		ITG *	nzs_
	)

                                        {
 
     /* subroutine for the boundary stiffness coefficients */
 
   /*   inserts a new nonzero matrix position into the data structure 
        in FORTRAN notation: 
        - ipointer(i) points to a position in field mast1 containing
          the row number of a nonzero position in column i; 
          next(ipointer(i)) points a position in field mast1 containing
          the row number of another nonzero position in column i, and
          so on until no nonzero positions in column i are left; for 
          the position j in field mast1 containing the momentarily last
          nonzero number in column i we have next(j)=0 
 
        notice that in C the positions start at 0 and not at 1 as in 
        FORTRAN; the present routine is written in FORTRAN convention */
 
     ITG idof1,idof2,istart,*mast1=NULL,*next=NULL;
 
   mast1=*mast1p;
   next=*nextp;
 
   idof1=*i1;
   idof2=*i2-1;
 
   if(*ifree>=*nzs_){
       *nzs_=(ITG)(1.1**nzs_);
       RENEW(mast1,ITG,*nzs_);
       RENEW(next,ITG,*nzs_);
   }
   mast1[*ifree]=idof1;
   next[*ifree]=ipointer[idof2];
   ipointer[idof2]=++*ifree;
 
   *mast1p=mast1;
   *nextp=next;
   
   return;
 
 }

◆ insertrad()

void insertrad	(	ITG *	ipointer,
		ITG **	mast1p,
		ITG **	mast2p,
		ITG *	i1,
		ITG *	i2,
		ITG *	ifree,
		ITG *	nzs_
	)

                                        {
 
   /*   inserts a new nonzero matrix position into the data structure 
        in FORTRAN notation: 
        - ipointer(i) points to a position in field irow containing
          the row number of a nonzero position in column i; 
          next(ipointer(i)) points a position in field irow containing
          the row number of another nonzero position in column i, and
          so on until no nonzero positions in column i are left; for 
          the position j in field irow containing the momentarily last
          nonzero number in column i we have next(j)=0 
 
          special version of insert.c for the call in mastructrad.c
 
        notice that in C the positions start at 0 and not at 1 as in 
        FORTRAN; the present routine is written in FORTRAN convention */
 
   ITG *irow=NULL,*next=NULL;
 
   irow=*irowp;
   next=*nextp;
 
   ++*ifree;
   if(*ifree>*nzs_){
       *nzs_=(ITG)(1.1**nzs_);
       RENEW(irow,ITG,*nzs_);
       RENEW(next,ITG,*nzs_);
   }
   
   irow[*ifree-1]=*i2;
   next[*ifree-1]=ipointer[*i1-1];
   ipointer[*i1-1]=*ifree;
 
   *irowp=irow;
   *nextp=next;
   
   return;
 
 }

◆ linstatic()

void linstatic	(	double *	co,
		ITG *	nk,
		ITG **	konp,
		ITG **	ipkonp,
		char **	lakonp,
		ITG *	ne,
		ITG *	nodeboun,
		ITG *	ndirboun,
		double *	xboun,
		ITG *	nboun,
		ITG *	ipompc,
		ITG *	nodempc,
		double *	coefmpc,
		char *	labmpc,
		ITG *	nmpc,
		ITG *	nodeforc,
		ITG *	ndirforc,
		double *	xforc,
		ITG *	nforc,
		ITG *	nelemload,
		char *	sideload,
		double *	xload,
		ITG *	nload,
		ITG *	nactdof,
		ITG **	icolp,
		ITG *	jq,
		ITG **	irowp,
		ITG *	neq,
		ITG *	nzl,
		ITG *	nmethod,
		ITG *	ikmpc,
		ITG *	ilmpc,
		ITG *	ikboun,
		ITG *	ilboun,
		double *	elcon,
		ITG *	nelcon,
		double *	rhcon,
		ITG *	nrhcon,
		double *	alcon,
		ITG *	nalcon,
		double *	alzero,
		ITG **	ielmatp,
		ITG **	ielorienp,
		ITG *	norien,
		double *	orab,
		ITG *	ntmat_,
		double *	t0,
		double *	t1,
		double *	t1old,
		ITG *	ithermal,
		double *	prestr,
		ITG *	iprestr,
		double *	vold,
		ITG *	iperturb,
		double *	sti,
		ITG *	nzs,
		ITG *	kode,
		char *	filab,
		double *	eme,
		ITG *	iexpl,
		double *	plicon,
		ITG *	nplicon,
		double *	plkcon,
		ITG *	nplkcon,
		double **	xstatep,
		ITG *	npmat_,
		char *	matname,
		ITG *	isolver,
		ITG *	mi,
		ITG *	ncmat_,
		ITG *	nstate_,
		double *	cs,
		ITG *	mcs,
		ITG *	nkon,
		double **	enerp,
		double *	xbounold,
		double *	xforcold,
		double *	xloadold,
		char *	amname,
		double *	amta,
		ITG *	namta,
		ITG *	nam,
		ITG *	iamforc,
		ITG *	iamload,
		ITG *	iamt1,
		ITG *	iamboun,
		double *	ttime,
		char *	output,
		char *	set,
		ITG *	nset,
		ITG *	istartset,
		ITG *	iendset,
		ITG *	ialset,
		ITG *	nprint,
		char *	prlab,
		char *	prset,
		ITG *	nener,
		double *	trab,
		ITG *	inotr,
		ITG *	ntrans,
		double *	fmpc,
		char *	cbody,
		ITG *	ibody,
		double *	xbody,
		ITG *	nbody,
		double *	xbodyold,
		double *	timepar,
		double *	thicke,
		char *	jobnamec,
		char *	tieset,
		ITG *	ntie,
		ITG *	istep,
		ITG *	nmat,
		ITG *	ielprop,
		double *	prop,
		char *	typeboun,
		ITG *	mortar,
		ITG *	mpcinfo,
		double *	tietol,
		ITG *	ics,
		ITG *	icontact,
		char *	orname
	)

                           {
   
   char description[13]="            ",*lakon=NULL,stiffmatrix[132]="",
        fneig[132]="",jobnamef[396]="";
 
   ITG *inum=NULL,k,*icol=NULL,*irow=NULL,ielas=0,icmd=0,iinc=1,nasym=0,i,j,ic,ir,
       mass[2]={0,0}, stiffness=1, buckling=0, rhsi=1, intscheme=0,*ncocon=NULL,
       *nshcon=NULL,mode=-1,noddiam=-1,*ipobody=NULL,inewton=0,coriolis=0,iout,
       ifreebody,*itg=NULL,ntg=0,symmetryflag=0,inputformat=0,ngraph=1,im,
       mt=mi[1]+1,ne0,*integerglob=NULL,iglob=0,*ipneigh=NULL,*neigh=NULL,
       icfd=0,*inomat=NULL,*islavact=NULL,*islavnode=NULL,*nslavnode=NULL,
       *islavsurf=NULL,nretain,*iretain=NULL,*noderetain=NULL,*ndirretain=NULL,
       nmethodl,nintpoint,ifacecount,memmpc_,mpcfree,icascade,maxlenmpc,
       ncont=0,*itietri=NULL,*koncont=NULL,nslavs=0,ismallsliding=0,
       *itiefac=NULL,*imastnode=NULL,*nmastnode=NULL,*imastop=NULL,
       *iponoels=NULL,*inoels=NULL,*ipe=NULL,*ime=NULL,iit=-1,iflagact=0,
       icutb=0,*kon=NULL,*ipkon=NULL,*ielmat=NULL,ialeatoric=0,kscale=1,
       *iponoel=NULL,*inoel=NULL,zero=0,nherm=1,nev=*nforc,node,idir,
       *ielorien=NULL,network=0;
 
   double *stn=NULL,*v=NULL,*een=NULL,cam[5],*xstiff=NULL,*stiini=NULL,*tper,
          *f=NULL,*fn=NULL,qa[4],*fext=NULL,*epn=NULL,*xstateini=NULL,
          *vini=NULL,*stx=NULL,*enern=NULL,*xbounact=NULL,*xforcact=NULL,
          *xloadact=NULL,*t1act=NULL,*ampli=NULL,*xstaten=NULL,*eei=NULL,
          *enerini=NULL,*cocon=NULL,*shcon=NULL,*physcon=NULL,*qfx=NULL,
          *qfn=NULL,sigma=0.,*cgr=NULL,*xbodyact=NULL,*vr=NULL,*vi=NULL,
          *stnr=NULL,*stni=NULL,*vmax=NULL,*stnmax=NULL,*springarea=NULL,
          *eenmax=NULL,*fnr=NULL,*fni=NULL,*emn=NULL,*clearini=NULL,ptime,
          *emeini=NULL,*doubleglob=NULL,*au=NULL,*ad=NULL,*b=NULL,*aub=NULL,
          *adb=NULL,*pslavsurf=NULL,*pmastsurf=NULL,*cdn=NULL,*cdnr=NULL,
          *cdni=NULL,*submatrix=NULL,*xnoels=NULL,*cg=NULL,*straight=NULL,
          *areaslav=NULL,*xmastnor=NULL,theta=0.,*ener=NULL,*xstate=NULL,
       *fnext=NULL,*energyini=NULL,*energy=NULL,*d=NULL;
 
   FILE *f1,*f2;
   
 #ifdef SGI
   ITG token;
 #endif
 
   /* dummy arguments for the results call */
 
   double *veold=NULL,*accold=NULL,bet,gam,dtime,time,reltime=1.;
 
   irow=*irowp;ener=*enerp;xstate=*xstatep;ipkon=*ipkonp;lakon=*lakonp;
   kon=*konp;ielmat=*ielmatp;ielorien=*ielorienp;icol=*icolp;
   
   for(k=0;k<3;k++){
       strcpy1(&jobnamef[k*132],&jobnamec[k*132],132);
   }
 
   tper=&timepar[1];
 
   time=*tper;
   dtime=*tper;
 
   ne0=*ne;
 
   /* determining the global values to be used as boundary conditions
      for a submodel */
 
   getglobalresults(jobnamec,&integerglob,&doubleglob,nboun,iamboun,xboun,
            nload,sideload,iamload,&iglob,nforc,iamforc,xforc,
                    ithermal,nk,t1,iamt1);
 
   /* allocating fields for the actual external loading */
 
   NNEW(xbounact,double,*nboun);
   for(k=0;k<*nboun;++k){xbounact[k]=xbounold[k];}
   NNEW(xforcact,double,*nforc);
   NNEW(xloadact,double,2**nload);
   NNEW(xbodyact,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){
     NNEW(t1act,double,*nk);
     for(k=0;k<*nk;++k){t1act[k]=t1old[k];}
   }
   
   /* assigning the body forces to the elements */ 
 
   if(*nbody>0){
       ifreebody=*ne+1;
       NNEW(ipobody,ITG,2*ifreebody**nbody);
       for(k=1;k<=*nbody;k++){
       FORTRAN(bodyforce,(cbody,ibody,ipobody,nbody,set,istartset,
                  iendset,ialset,&inewton,nset,&ifreebody,&k));
       RENEW(ipobody,ITG,2*(*ne+ifreebody));
       }
       RENEW(ipobody,ITG,2*(ifreebody-1));
   }
 
   /* contact conditions */
   
   if(*icontact==1){
 
       memmpc_=mpcinfo[0];mpcfree=mpcinfo[1];icascade=mpcinfo[2];
       maxlenmpc=mpcinfo[3];
 
       inicont(nk,&ncont,ntie,tieset,nset,set,istartset,iendset,ialset,&itietri,
       lakon,ipkon,kon,&koncont,&nslavs,tietol,&ismallsliding,&itiefac,
           &islavsurf,&islavnode,&imastnode,&nslavnode,&nmastnode,
           mortar,&imastop,nkon,&iponoels,&inoels,&ipe,&ime,ne,&ifacecount,
       iperturb,ikboun,nboun,co,istep,&xnoels);
 
       if(ncont!=0){
 
       NNEW(cg,double,3*ncont);
       NNEW(straight,double,16*ncont);
       
       /* 11 instead of 10: last position is reserved for the
          local contact spring element number; needed as
          pointer into springarea */
       
       if(*mortar==0){
           RENEW(kon,ITG,*nkon+11*nslavs);
           NNEW(springarea,double,2*nslavs);
           if(*nener==1){
           RENEW(ener,double,mi[0]*(*ne+nslavs)*2);
           }
           RENEW(ipkon,ITG,*ne+nslavs);
           RENEW(lakon,char,8*(*ne+nslavs));
           
           if(*norien>0){
           RENEW(ielorien,ITG,mi[2]*(*ne+nslavs));
           for(k=mi[2]**ne;k<mi[2]*(*ne+nslavs);k++) ielorien[k]=0;
           }
           
           RENEW(ielmat,ITG,mi[2]*(*ne+nslavs));
           for(k=mi[2]**ne;k<mi[2]*(*ne+nslavs);k++) ielmat[k]=1;
           
           if(nslavs!=0){
           RENEW(xstate,double,*nstate_*mi[0]*(*ne+nslavs));
           for(k=*nstate_*mi[0]**ne;k<*nstate_*mi[0]*(*ne+nslavs);k++){
               xstate[k]=0.;
           }
           }
           
           NNEW(areaslav,double,ifacecount);
           NNEW(xmastnor,double,3*nmastnode[*ntie]);
       }else if(*mortar==1){
           NNEW(islavact,ITG,nslavnode[*ntie]);
           DMEMSET(islavact,0,nslavnode[*ntie],1);
           NNEW(clearini,double,3*9*ifacecount);
           NNEW(xmastnor,double,3*nmastnode[*ntie]);
 
 
           nintpoint=0;
           
           precontact(&ncont,ntie,tieset,nset,set,istartset,
              iendset,ialset,itietri,lakon,ipkon,kon,koncont,ne,
              cg,straight,co,vold,istep,&iinc,&iit,itiefac,
              islavsurf,islavnode,imastnode,nslavnode,nmastnode,
              imastop,mi,ipe,ime,tietol,&iflagact,
              &nintpoint,&pslavsurf,xmastnor,cs,mcs,ics,clearini,
                          &nslavs);
           
           /* changing the dimension of element-related fields */
           
           RENEW(kon,ITG,*nkon+22*nintpoint);
           RENEW(springarea,double,2*nintpoint);
           RENEW(pmastsurf,double,6*nintpoint);
           
           if(*nener==1){
           RENEW(ener,double,mi[0]*(*ne+nintpoint)*2);
           }
           RENEW(ipkon,ITG,*ne+nintpoint);
           RENEW(lakon,char,8*(*ne+nintpoint));
           
           if(*norien>0){
           RENEW(ielorien,ITG,mi[2]*(*ne+nintpoint));
           for(k=mi[2]**ne;k<mi[2]*(*ne+nintpoint);k++) ielorien[k]=0;
           }
           RENEW(ielmat,ITG,mi[2]*(*ne+nintpoint));
           for(k=mi[2]**ne;k<mi[2]*(*ne+nintpoint);k++) ielmat[k]=1;
 
               /* interpolating the state variables */
 
           if(*nstate_!=0){
           
           RENEW(xstate,double,*nstate_*mi[0]*(ne0+nintpoint));
           for(k=*nstate_*mi[0]*ne0;k<*nstate_*mi[0]*(ne0+nintpoint);k++){
               xstate[k]=0.;
           }
           
           RENEW(xstateini,double,*nstate_*mi[0]*(ne0+nintpoint));
           for(k=0;k<*nstate_*mi[0]*(ne0+nintpoint);++k){
               xstateini[k]=xstate[k];
           }
           }
       }
       
           /* generating contact spring elements */
 
       contact(&ncont,ntie,tieset,nset,set,istartset,iendset,
          ialset,itietri,lakon,ipkon,kon,koncont,ne,cg,straight,nkon,
          co,vold,ielmat,cs,elcon,istep,&iinc,&iit,ncmat_,ntmat_,
          &ne0,vini,nmethod,
          iperturb,ikboun,nboun,mi,imastop,nslavnode,islavnode,islavsurf,
          itiefac,areaslav,iponoels,inoels,springarea,tietol,&reltime,
          imastnode,nmastnode,xmastnor,filab,mcs,ics,&nasym,
          xnoels,mortar,pslavsurf,pmastsurf,clearini,&theta,
          xstateini,xstate,nstate_,&icutb,&ialeatoric,jobnamef);
       
       printf("number of contact spring elements=%" ITGFORMAT "\n\n",*ne-ne0);
       
           /* determining the structure of the stiffness/mass matrix */
       
       remastructar(ipompc,&coefmpc,&nodempc,nmpc,
          &mpcfree,nodeboun,ndirboun,nboun,ikmpc,ilmpc,ikboun,ilboun,
          labmpc,nk,&memmpc_,&icascade,&maxlenmpc,
          kon,ipkon,lakon,ne,nactdof,icol,jq,&irow,isolver,
          neq,nzs,nmethod,ithermal,iperturb,mass,mi,ics,cs,
          mcs,mortar,typeboun,&iit,&network);
       }
 
       /* field for initial values of state variables (needed for contact */
 
       if((*nstate_!=0)&&((*mortar==0)||(ncont==0))){
       NNEW(xstateini,double,*nstate_*mi[0]*(ne0+nslavs));
       for(k=0;k<*nstate_*mi[0]*(ne0+nslavs);++k){
           xstateini[k]=xstate[k];
       }
       }
   }
 
   /* allocating a field for the instantaneous amplitude */
 
   NNEW(ampli,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,itg,&ntg,amname,ikboun,ilboun,nelemload,sideload,mi,
               ntrans,trab,inotr,veold,integerglob,doubleglob,tieset,istartset,
               iendset,ialset,ntie,nmpc,ipompc,ikmpc,ilmpc,nodempc,coefmpc,
               ipobody,iponoel,inoel));
 
   /* determining the internal forces and the stiffness coefficients */
 
   NNEW(f,double,*neq);
 
   /* allocating a field for the stiffness matrix */
 
   NNEW(xstiff,double,(long long)27*mi[0]**ne);
 
   iout=-1;
   NNEW(v,double,mt**nk);
   NNEW(fn,double,mt**nk);
   NNEW(stx,double,6*mi[0]**ne);
   NNEW(inum,ITG,*nk);
   results(co,nk,kon,ipkon,lakon,ne,v,stn,inum,stx,
       elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat,
       ielorien,norien,orab,ntmat_,t0,t1act,ithermal,
       prestr,iprestr,filab,eme,emn,een,iperturb,
       f,fn,nactdof,&iout,qa,vold,b,nodeboun,
       ndirboun,xbounact,nboun,ipompc,
       nodempc,coefmpc,labmpc,nmpc,nmethod,cam,neq,veold,accold,
       &bet,&gam,&dtime,&time,ttime,plicon,nplicon,plkcon,nplkcon,
       xstateini,xstiff,xstate,npmat_,epn,matname,mi,&ielas,
       &icmd,ncmat_,nstate_,stiini,vini,ikboun,ilboun,ener,enern,
       emeini,xstaten,eei,enerini,cocon,ncocon,set,nset,istartset,
       iendset,ialset,nprint,prlab,prset,qfx,qfn,trab,inotr,ntrans,
       fmpc,nelemload,nload,ikmpc,ilmpc,istep,&iinc,springarea,
       &reltime,&ne0,xforc,nforc,thicke,shcon,nshcon,
       sideload,xloadact,xloadold,&icfd,inomat,pslavsurf,pmastsurf,
       mortar,islavact,cdn,islavnode,nslavnode,ntie,clearini,
       islavsurf,ielprop,prop,energyini,energy,&kscale,iponoel,
           inoel,nener,orname,&network,ipobody,xbodyact,ibody);
   SFREE(v);SFREE(fn);SFREE(stx);SFREE(inum);
   iout=1;
   
   /* determining the system matrix and the external forces */
 
   NNEW(ad,double,*neq);
   NNEW(fext,double,*neq);
 
   if(*nmethod==11){
       
     /* determining the nodes and the degrees of freedom in those nodes
        belonging to the substructure */
       
       NNEW(iretain,ITG,*nk);
       NNEW(noderetain,ITG,*nk);
       NNEW(ndirretain,ITG,*nk);
       nretain=0;
       
       for(i=0;i<*nboun;i++){
       if(strcmp1(&typeboun[i],"C")==0){
           iretain[nretain]=i+1;
           noderetain[nretain]=nodeboun[i];
           ndirretain[nretain]=ndirboun[i];
           nretain++;
       }
       }
  
       /* nretain!=0: submatrix application
          nretain==0: Green function application */
       
       if(nretain>0){
       RENEW(iretain,ITG,nretain);
       RENEW(noderetain,ITG,nretain);
       RENEW(ndirretain,ITG,nretain);
       }else{
       SFREE(iretain);SFREE(noderetain);SFREE(ndirretain);
       }
       
       /* creating the right size au */
 
       NNEW(au,double,nzs[2]);
       rhsi=0;
       nmethodl=2;
 
       /* providing for the mass matrix in case of Green functions */
 
       if(nretain==0){
       mass[0]=1.;
       NNEW(adb,double,*neq);
       NNEW(aub,double,nzs[1]);
       }
 
   }else{
       NNEW(au,double,*nzs);
       nmethodl=*nmethod;
   }
 
   mafillsmmain(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,fext,nactdof,icol,jq,irow,neq,nzl,&nmethodl,
         ikmpc,ilmpc,ikboun,ilboun,
         elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat,
         ielorien,norien,orab,ntmat_,
         t0,t1act,ithermal,prestr,iprestr,vold,iperturb,sti,
         nzs,stx,adb,aub,iexpl,plicon,nplicon,plkcon,nplkcon,
         xstiff,npmat_,&dtime,matname,mi,
             ncmat_,mass,&stiffness,&buckling,&rhsi,&intscheme,physcon,
             shcon,nshcon,cocon,ncocon,ttime,&time,istep,&iinc,&coriolis,
         ibody,xloadold,&reltime,veold,springarea,nstate_,
             xstateini,xstate,thicke,integerglob,doubleglob,
         tieset,istartset,iendset,ialset,ntie,&nasym,pslavsurf,
         pmastsurf,mortar,clearini,ielprop,prop,&ne0,fnext,&kscale,
         iponoel,inoel,&network);
 
   if(nasym==1){
       RENEW(au,double,2*nzs[1]);
       symmetryflag=2;
       inputformat=1;
       
       FORTRAN(mafillsmas,(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,fext,nactdof,icol,jq,irow,neq,nzl,
           nmethod,ikmpc,ilmpc,ikboun,ilboun,
           elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,
           ielmat,ielorien,norien,orab,ntmat_,
           t0,t1act,ithermal,prestr,iprestr,vold,iperturb,sti,
           nzs,stx,adb,aub,iexpl,plicon,nplicon,plkcon,nplkcon,
           xstiff,npmat_,&dtime,matname,mi,
                   ncmat_,mass,&stiffness,&buckling,&rhsi,&intscheme,
                   physcon,shcon,nshcon,cocon,ncocon,ttime,&time,istep,&iinc,
                   &coriolis,ibody,xloadold,&reltime,veold,springarea,nstate_,
                   xstateini,xstate,thicke,
                   integerglob,doubleglob,tieset,istartset,iendset,
           ialset,ntie,&nasym,pslavsurf,pmastsurf,mortar,clearini,
           ielprop,prop,&ne0,&kscale,iponoel,inoel,&network));
   }
 
   /* determining the right hand side */
 
   NNEW(b,double,*neq);
   for(k=0;k<*neq;++k){
       b[k]=fext[k]-f[k];
   }
   SFREE(fext);SFREE(f);
 
   /* generation of a substructure stiffness matrix */
 
   if(*nmethod==11){
 
       /* recovering omega_0^2 for Green applications */
 
       if(nretain==0){
       if(*nforc>0){sigma=xforc[0];}
       }
 
       /* factorizing the matrix */
 
       if(*neq>0){
       if(*isolver==0){
 #ifdef SPOOLES
           spooles_factor(ad,au,adb,aub,&sigma,icol,irow,neq,nzs,&symmetryflag,
                  &inputformat,&nzs[2]);
 #else
           printf("*ERROR in linstatic: the SPOOLES library is not linked\n\n");
           FORTRAN(stop,());
 #endif
       }
       else if(*isolver==7){
 #ifdef PARDISO
           pardiso_factor(ad,au,adb,aub,&sigma,icol,irow,neq,nzs,
                  &symmetryflag,&inputformat,jq,&nzs[2]);
 #else
           printf("*ERROR in linstatic: the PARDISO library is not linked\n\n");
           FORTRAN(stop,());
 #endif
       }
       }
 
     /* solving the system of equations with appropriate rhs */
 
       if(nretain>0){
 
       NNEW(submatrix,double,nretain*nretain);
       
       for(i=0;i<nretain;i++){
           DMEMSET(b,0,*neq,0.);
           ic=*neq+iretain[i]-1;
           for(j=jq[ic]-1;j<jq[ic+1]-1;j++){
           ir=irow[j]-1;
           b[ir]-=au[j];
           }
           
           /* solving the system */
           
           if(*neq>0){
           if(*isolver==0){
 #ifdef SPOOLES
               spooles_solve(b,neq);
 #endif
           }
           else if(*isolver==7){
 #ifdef PARDISO
               pardiso_solve(b,neq,&symmetryflag);
 #endif
               
           }
           }
           
           /* calculating the internal forces */
           
           NNEW(v,double,mt**nk);
           NNEW(fn,double,mt**nk);
           NNEW(stn,double,6**nk);
           NNEW(inum,ITG,*nk);
           NNEW(stx,double,6*mi[0]**ne);
           
           if(strcmp1(&filab[261],"E   ")==0) NNEW(een,double,6**nk);
           if(strcmp1(&filab[2697],"ME  ")==0) NNEW(emn,double,6**nk);
           if(strcmp1(&filab[522],"ENER")==0) NNEW(enern,double,*nk);
           
           NNEW(eei,double,6*mi[0]**ne);
           if(*nener==1){
           NNEW(stiini,double,6*mi[0]**ne);
           NNEW(emeini,double,6*mi[0]**ne);
           NNEW(enerini,double,mi[0]**ne);}
           
           /* replacing the appropriate boundary value by unity */
           
           xbounact[iretain[i]-1]=1.;
           
           results(co,nk,kon,ipkon,lakon,ne,v,stn,inum,stx,
            elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat,
            ielorien,norien,orab,ntmat_,t0,t1act,ithermal,
            prestr,iprestr,filab,eme,emn,een,iperturb,
            f,fn,nactdof,&iout,qa,vold,b,nodeboun,ndirboun,
                    xbounact,nboun,ipompc,
            nodempc,coefmpc,labmpc,nmpc,nmethod,cam,neq,veold,
                    accold,&bet,
            &gam,&dtime,&time,ttime,plicon,nplicon,plkcon,nplkcon,
            xstateini,xstiff,xstate,npmat_,epn,matname,mi,&ielas,&icmd,
            ncmat_,nstate_,stiini,vini,ikboun,ilboun,ener,enern,emeini,
            xstaten,eei,enerini,cocon,ncocon,set,nset,istartset,iendset,
            ialset,nprint,prlab,prset,qfx,qfn,trab,inotr,ntrans,fmpc,
            nelemload,nload,ikmpc,ilmpc,istep,&iinc,springarea,&reltime,
            &ne0,xforc,nforc,thicke,shcon,nshcon,
            sideload,xloadact,xloadold,&icfd,inomat,pslavsurf,pmastsurf,
            mortar,islavact,cdn,islavnode,nslavnode,ntie,clearini,
            islavsurf,ielprop,prop,energyini,energy,&kscale,iponoel,
            inoel,nener,orname,&network,ipobody,xbodyact,ibody);
           
           xbounact[iretain[i]-1]=0.;
           
           SFREE(v);SFREE(stn);SFREE(inum);SFREE(stx);
           
           if(strcmp1(&filab[261],"E   ")==0) SFREE(een);
           if(strcmp1(&filab[2697],"ME  ")==0) SFREE(emn);
           if(strcmp1(&filab[522],"ENER")==0) SFREE(enern);
           
           SFREE(eei);if(*nener==1){SFREE(stiini);SFREE(emeini);SFREE(enerini);}
           
           /* storing the internal forces in the substructure
          stiffness matrix */
           
           for(j=0;j<nretain;j++){
           submatrix[i*nretain+j]=fn[mt*(noderetain[j]-1)+ndirretain[j]];
           }
           
           SFREE(fn);
           
       }
       SFREE(iretain);
       
       FORTRAN(writesubmatrix,(submatrix,noderetain,ndirretain,&nretain,jobnamec));
       
       SFREE(submatrix);SFREE(noderetain);SFREE(ndirretain);
 
       }else{
 
       /* Green function applications */
 
           /* storing omega_0^2 into d */
 
       NNEW(d,double,*nforc);
       for(i=0;i<*nforc;i++){d[i]=xforc[0];}
 
       strcpy(fneig,jobnamec);
       strcat(fneig,".eig");
       
       if((f2=fopen(fneig,"wb"))==NULL){
           printf("*ERROR in arpack: cannot open eigenvalue file for writing...");
           
           exit(0);
       }
       
       /* storing a zero as indication that this was not a
          cyclic symmetry calculation */
       
       if(fwrite(&zero,sizeof(ITG),1,f2)!=1){
           printf("*ERROR saving the cyclic symmetry flag to the eigenvalue file...");
           exit(0);
       }
       
       /* Hermitian */
       
       if(fwrite(&nherm,sizeof(ITG),1,f2)!=1){
           printf("*ERROR saving the Hermitian flag to the eigenvalue file...");
           exit(0);
       }
       
       /* storing the number of eigenvalues */
       
       if(fwrite(&nev,sizeof(ITG),1,f2)!=1){
           printf("*ERROR saving the number of eigenvalues to the eigenvalue file...");
           exit(0);
       }
       
       /* the eigenfrequencies are stores as radians/time */
       
       if(fwrite(d,sizeof(double),nev,f2)!=nev){
           printf("*ERROR saving the eigenfrequencies to the eigenvalue file...");
           exit(0);
       }
       
       /* storing the stiffness matrix */
       
       if(fwrite(ad,sizeof(double),neq[1],f2)!=neq[1]){
           printf("*ERROR saving the diagonal of the stiffness matrix to the eigenvalue file...");
           exit(0);
       }
       if(fwrite(au,sizeof(double),nzs[2],f2)!=nzs[2]){
           printf("*ERROR saving the off-diagonal terms of the stiffness matrix to the eigenvalue file...");
           exit(0);
       }
       
       /* storing the mass matrix */
       
       if(fwrite(adb,sizeof(double),neq[1],f2)!=neq[1]){
           printf("*ERROR saving the diagonal of the mass matrix to the eigenvalue file...");
           exit(0);
       }
       if(fwrite(aub,sizeof(double),nzs[1],f2)!=nzs[1]){
           printf("*ERROR saving the off-diagonal terms of the mass matrix to the eigenvalue file...");
           exit(0);
       }
 
       SFREE(d);
       
       /* calculating each Green function */
 
       for(i=0;i<*nforc;i++){
           node=nodeforc[2*i];
           idir=ndirforc[i];
 
               /* check whether degree of freedom is active */
 
           if(nactdof[mt*(node-1)+idir]==0){
           printf("*ERROR in linstatic: degree of freedom corresponding to node %d \n and direction %d is not active: no unit force can be applied\n",node,idir);
           FORTRAN(stop,());
           }
 
               /* defining a unit force on the rhs */
 
           DMEMSET(b,0,*neq,0.);
           b[nactdof[mt*(node-1)+idir]-1]=1.;
           
           /* solving the system */
           
           if(*neq>0){
           if(*isolver==0){
 #ifdef SPOOLES
               spooles_solve(b,neq);
 #endif
           }
           else if(*isolver==7){
 #ifdef PARDISO
               pardiso_solve(b,neq,&symmetryflag);
 #endif
               
           }
           }
           
           /* storing the Green function */
 
           if(fwrite(b,sizeof(double),*neq,f2)!=*neq){
           printf("*ERROR saving data to the eigenvalue file...");
           exit(0);
           }
 
           /* calculating the displacements and the stresses and storing */
           /* the results in frd format for each valid eigenmode */
           
           NNEW(v,double,mt**nk);
           NNEW(fn,double,mt**nk);
           NNEW(stn,double,6**nk);
           NNEW(inum,ITG,*nk);
           NNEW(stx,double,6*mi[0]**ne);
           
           if(strcmp1(&filab[261],"E   ")==0) NNEW(een,double,6**nk);
           if(strcmp1(&filab[2697],"ME  ")==0) NNEW(emn,double,6**nk);
           if(strcmp1(&filab[522],"ENER")==0) NNEW(enern,double,*nk);
           if(strcmp1(&filab[2175],"CONT")==0) NNEW(cdn,double,6**nk);
           
           NNEW(eei,double,6*mi[0]**ne);
           if(*nener==1){
           NNEW(stiini,double,6*mi[0]**ne);
           NNEW(emeini,double,6*mi[0]**ne);
           NNEW(enerini,double,mi[0]**ne);}
           
           results(co,nk,kon,ipkon,lakon,ne,v,stn,inum,stx,
            elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat,
            ielorien,norien,orab,ntmat_,t0,t1act,ithermal,
            prestr,iprestr,filab,eme,emn,een,iperturb,
            f,fn,nactdof,&iout,qa,vold,b,nodeboun,ndirboun,
                    xbounact,nboun,ipompc,
            nodempc,coefmpc,labmpc,nmpc,nmethod,cam,neq,veold,
                    accold,&bet,
            &gam,&dtime,&time,ttime,plicon,nplicon,plkcon,nplkcon,
            xstateini,xstiff,xstate,npmat_,epn,matname,mi,&ielas,&icmd,
            ncmat_,nstate_,stiini,vini,ikboun,ilboun,ener,enern,emeini,
            xstaten,eei,enerini,cocon,ncocon,set,nset,istartset,iendset,
            ialset,nprint,prlab,prset,qfx,qfn,trab,inotr,ntrans,fmpc,
            nelemload,nload,ikmpc,ilmpc,istep,&iinc,springarea,&reltime,
            &ne0,xforc,nforc,thicke,shcon,nshcon,
            sideload,xloadact,xloadold,&icfd,inomat,pslavsurf,pmastsurf,
            mortar,islavact,cdn,islavnode,nslavnode,ntie,clearini,
            islavsurf,ielprop,prop,energyini,energy,&kscale,iponoel,
            inoel,nener,orname,&network,ipobody,xbodyact,ibody);
           
           SFREE(eei);
           if(*nener==1){
           SFREE(stiini);SFREE(emeini);SFREE(enerini);}
           
           memcpy(&vold[0],&v[0],sizeof(double)*mt**nk);
           memcpy(&sti[0],&stx[0],sizeof(double)*6*mi[0]*ne0);
           
           ++*kode;
           time=1.*i;
           
           /* for cyclic symmetric sectors: duplicating the results */
           
           if(*mcs>0){
           ptime=*ttime+time;
           frdcyc(co,nk,kon,ipkon,lakon,ne,v,stn,inum,nmethod,kode,filab,een,t1act,
              fn,&ptime,epn,ielmat,matname,cs,mcs,nkon,enern,xstaten,
              nstate_,istep,&iinc,iperturb,ener,mi,output,ithermal,
              qfn,ialset,istartset,iendset,trab,inotr,ntrans,orab,
              ielorien,norien,sti,veold,&noddiam,set,nset,emn,thicke,
              jobnamec,&ne0,cdn,mortar,nmat,qfx);
           }
           else{
           if(strcmp1(&filab[1044],"ZZS")==0){
               NNEW(neigh,ITG,40**ne);
               NNEW(ipneigh,ITG,*nk);
           }
           ptime=*ttime+time;
           frd(co,nk,kon,ipkon,lakon,ne,v,stn,inum,nmethod,
               kode,filab,een,t1act,fn,&ptime,epn,ielmat,matname,enern,xstaten,
               nstate_,istep,&iinc,ithermal,qfn,&mode,&noddiam,trab,inotr,
               ntrans,orab,ielorien,norien,description,ipneigh,neigh,
               mi,stx,vr,vi,stnr,stni,vmax,stnmax,&ngraph,veold,ener,ne,
               cs,set,nset,istartset,iendset,ialset,eenmax,fnr,fni,emn,
               thicke,jobnamec,output,qfx,cdn,mortar,cdnr,cdni,nmat);
           if(strcmp1(&filab[1044],"ZZS")==0){SFREE(ipneigh);SFREE(neigh);}
           }
           
           SFREE(v);SFREE(stn);SFREE(inum);
           SFREE(stx);SFREE(fn);
           
           if(strcmp1(&filab[261],"E   ")==0) SFREE(een);
           if(strcmp1(&filab[2697],"ME  ")==0) SFREE(emn);
           if(strcmp1(&filab[522],"ENER")==0) SFREE(enern);
           if(strcmp1(&filab[2175],"CONT")==0) SFREE(cdn);
           
       }
 
       fclose(f2);
 
       }
       
       SFREE(au);SFREE(ad);SFREE(b);
       
       SFREE(xbounact);SFREE(xforcact);SFREE(xloadact);SFREE(t1act);SFREE(ampli);
       SFREE(xbodyact);if(*nbody>0) SFREE(ipobody);SFREE(xstiff);
       
       if(iglob==1){SFREE(integerglob);SFREE(doubleglob);}
       
       return;
 
 
   }else if(*nmethod!=0){
 
     /* linear static applications */
 
     if(*isolver==0){
 #ifdef SPOOLES
       spooles(ad,au,adb,aub,&sigma,b,icol,irow,neq,nzs,&symmetryflag,
               &inputformat,&nzs[2]);
 #else
             printf("*ERROR in linstatic: the SPOOLES library is not linked\n\n");
             FORTRAN(stop,());
 #endif
     }
     else if((*isolver==2)||(*isolver==3)){
       if(nasym>0){
       printf(" *ERROR in nonlingeo: the iterative solver cannot be used for asymmetric matrices\n\n");
       FORTRAN(stop,());
       }
       preiter(ad,&au,b,&icol,&irow,neq,nzs,isolver,iperturb);
     }
     else if(*isolver==4){
 #ifdef SGI
       if(nasym>0){
       printf(" *ERROR in nonlingeo: the SGI solver cannot be used for asymmetric matrices\n\n");
       FORTRAN(stop,());
       }
       token=1;
       sgi_main(ad,au,adb,aub,&sigma,b,icol,irow,neq,nzs,token);
 #else
             printf("*ERROR in linstatic: the SGI library is not linked\n\n");
             FORTRAN(stop,());
 #endif
     }
     else if(*isolver==5){
 #ifdef TAUCS
       if(nasym>0){
       printf(" *ERROR in nonlingeo: the TAUCS solver cannot be used for asymmetric matrices\n\n");
       FORTRAN(stop,());
       }
       tau(ad,&au,adb,aub,&sigma,b,icol,&irow,neq,nzs);
 #else
             printf("*ERROR in linstatic: the TAUCS library is not linked\n\n");
             FORTRAN(stop,());
 #endif
     }
     else if(*isolver==7){
 #ifdef PARDISO
       pardiso_main(ad,au,adb,aub,&sigma,b,icol,irow,neq,nzs,
            &symmetryflag,&inputformat,jq,&nzs[2]);
 #else
             printf("*ERROR in linstatic: the PARDISO library is not linked\n\n");
             FORTRAN(stop,());
 #endif
     }
 
     /* saving of ad and au for sensitivity analysis */
 
     for(i=0;i<*ntie;i++){
     if(strcmp1(&tieset[i*243+80],"D")==0){
         
         strcpy(stiffmatrix,jobnamec);
         strcat(stiffmatrix,".stm");
         
         if((f1=fopen(stiffmatrix,"wb"))==NULL){
         printf("*ERROR in linstatic: cannot open stiffness matrix file for writing...");
         exit(0);
         }
         
         /* storing the stiffness matrix */
 
             /* nzs,irow,jq and icol have to be stored too, since the static analysis
                can involve contact, whereas in the sensitivity analysis contact is not
                taken into account while determining the structure of the stiffness
                matrix (in mastruct.c)
          */
         
         if(fwrite(&nasym,sizeof(ITG),1,f1)!=1){
         printf("*ERROR saving the symmetry flag to the stiffness matrix file...");
         exit(0);
         }
         if(fwrite(nzs,sizeof(ITG),3,f1)!=3){
         printf("*ERROR saving the number of subdiagonal nonzeros to the stiffness matrix file...");
         exit(0);
         }
         if(fwrite(irow,sizeof(ITG),nzs[2],f1)!=nzs[2]){
         printf("*ERROR saving irow to the stiffness matrix file...");
         exit(0);
         }
         if(fwrite(jq,sizeof(ITG),neq[1]+1,f1)!=neq[1]+1){
         printf("*ERROR saving jq to the stiffness matrix file...");
         exit(0);
         }
         if(fwrite(icol,sizeof(ITG),neq[1],f1)!=neq[1]){
         printf("*ERROR saving icol to the stiffness matrix file...");
         exit(0);
         }
         if(fwrite(ad,sizeof(double),neq[1],f1)!=neq[1]){
         printf("*ERROR saving the diagonal of the stiffness matrix to the stiffness matrix file...");
         exit(0);
         }
         if(fwrite(au,sizeof(double),nzs[2],f1)!=nzs[2]){
         printf("*ERROR saving the off-diagonal terms of the stiffness matrix to the tiffness matrix file...");
         exit(0);
         }
         fclose(f1);
 
         break;
         }
     }
     
     SFREE(ad);SFREE(au);
 
     /* calculating the displacements and the stresses and storing */
     /* the results in frd format for each valid eigenmode */
 
     NNEW(v,double,mt**nk);
     NNEW(fn,double,mt**nk);
     NNEW(stn,double,6**nk);
     NNEW(inum,ITG,*nk);
     NNEW(stx,double,6*mi[0]**ne);
   
     if(strcmp1(&filab[261],"E   ")==0) NNEW(een,double,6**nk);
     if(strcmp1(&filab[2697],"ME  ")==0) NNEW(emn,double,6**nk);
     if(strcmp1(&filab[522],"ENER")==0) NNEW(enern,double,*nk);
     if(strcmp1(&filab[2175],"CONT")==0) NNEW(cdn,double,6**nk);
 
     NNEW(eei,double,6*mi[0]**ne);
     if(*nener==1){
     NNEW(stiini,double,6*mi[0]**ne);
         NNEW(emeini,double,6*mi[0]**ne);
     NNEW(enerini,double,mi[0]**ne);}
 
     results(co,nk,kon,ipkon,lakon,ne,v,stn,inum,stx,
         elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat,
         ielorien,norien,orab,ntmat_,t0,t1act,ithermal,
         prestr,iprestr,filab,eme,emn,een,iperturb,
             f,fn,nactdof,&iout,qa,vold,b,nodeboun,ndirboun,xbounact,nboun,ipompc,
         nodempc,coefmpc,labmpc,nmpc,nmethod,cam,neq,veold,accold,&bet,
             &gam,&dtime,&time,ttime,plicon,nplicon,plkcon,nplkcon,
         xstateini,xstiff,xstate,npmat_,epn,matname,mi,&ielas,&icmd,
             ncmat_,nstate_,stiini,vini,ikboun,ilboun,ener,enern,emeini,
             xstaten,eei,enerini,cocon,ncocon,set,nset,istartset,iendset,
             ialset,nprint,prlab,prset,qfx,qfn,trab,inotr,ntrans,fmpc,
         nelemload,nload,ikmpc,ilmpc,istep,&iinc,springarea,&reltime,
             &ne0,xforc,nforc,thicke,shcon,nshcon,
             sideload,xloadact,xloadold,&icfd,inomat,pslavsurf,pmastsurf,
             mortar,islavact,cdn,islavnode,nslavnode,ntie,clearini,
         islavsurf,ielprop,prop,energyini,energy,&kscale,iponoel,
             inoel,nener,orname,&network,ipobody,xbodyact,ibody);
 
     SFREE(eei);
     if(*nener==1){
     SFREE(stiini);SFREE(emeini);SFREE(enerini);}
 
     memcpy(&vold[0],&v[0],sizeof(double)*mt**nk);
     memcpy(&sti[0],&stx[0],sizeof(double)*6*mi[0]*ne0);
 
     ++*kode;
 
     /* for cyclic symmetric sectors: duplicating the results */
 
     if(*mcs>0){
     ptime=*ttime+time;
       frdcyc(co,nk,kon,ipkon,lakon,ne,v,stn,inum,nmethod,kode,filab,een,t1act,
            fn,&ptime,epn,ielmat,matname,cs,mcs,nkon,enern,xstaten,
                    nstate_,istep,&iinc,iperturb,ener,mi,output,ithermal,
                    qfn,ialset,istartset,iendset,trab,inotr,ntrans,orab,
                ielorien,norien,sti,veold,&noddiam,set,nset,emn,thicke,
                jobnamec,&ne0,cdn,mortar,nmat,qfx);
     }
     else{
     if(strcmp1(&filab[1044],"ZZS")==0){
         NNEW(neigh,ITG,40**ne);
         NNEW(ipneigh,ITG,*nk);
     }
     ptime=*ttime+time;
     frd(co,nk,kon,ipkon,lakon,ne,v,stn,inum,nmethod,
         kode,filab,een,t1act,fn,&ptime,epn,ielmat,matname,enern,xstaten,
         nstate_,istep,&iinc,ithermal,qfn,&mode,&noddiam,trab,inotr,
         ntrans,orab,ielorien,norien,description,ipneigh,neigh,
         mi,stx,vr,vi,stnr,stni,vmax,stnmax,&ngraph,veold,ener,ne,
         cs,set,nset,istartset,iendset,ialset,eenmax,fnr,fni,emn,
         thicke,jobnamec,output,qfx,cdn,mortar,cdnr,cdni,nmat);
     if(strcmp1(&filab[1044],"ZZS")==0){SFREE(ipneigh);SFREE(neigh);}
     }
 
     SFREE(v);SFREE(stn);SFREE(inum);
     SFREE(b);SFREE(stx);SFREE(fn);
 
     if(strcmp1(&filab[261],"E   ")==0) SFREE(een);
     if(strcmp1(&filab[2697],"ME  ")==0) SFREE(emn);
     if(strcmp1(&filab[522],"ENER")==0) SFREE(enern);
     if(strcmp1(&filab[2175],"CONT")==0) SFREE(cdn);
 
   }
   else {
 
     /* error occurred in mafill: storing the geometry in frd format */
 
     ++*kode;
     NNEW(inum,ITG,*nk);for(k=0;k<*nk;k++) inum[k]=1;
     if(strcmp1(&filab[1044],"ZZS")==0){
     NNEW(neigh,ITG,40**ne);
     NNEW(ipneigh,ITG,*nk);
     }
     ptime=*ttime+time;
     frd(co,nk,kon,ipkon,lakon,ne,v,stn,inum,nmethod,
         kode,filab,een,t1,fn,&ptime,epn,ielmat,matname,enern,xstaten,
         nstate_,istep,&iinc,ithermal,qfn,&mode,&noddiam,trab,inotr,
         ntrans,orab,ielorien,norien,description,ipneigh,neigh,
         mi,sti,vr,vi,stnr,stni,vmax,stnmax,&ngraph,veold,ener,ne,
         cs,set,nset,istartset,iendset,ialset,eenmax,fnr,fni,emn,
         thicke,jobnamec,output,qfx,cdn,mortar,cdnr,cdni,nmat);
     if(strcmp1(&filab[1044],"ZZS")==0){SFREE(ipneigh);SFREE(neigh);}
     SFREE(inum);FORTRAN(stop,());
 
   }
 
   if(*icontact==1){
       if(ncont!=0){
       *ne=ne0;
       if(*nener==1){
           RENEW(ener,double,mi[0]**ne*2);
       }
       RENEW(ipkon,ITG,*ne);
       RENEW(lakon,char,8**ne);
       RENEW(kon,ITG,*nkon);
       if(*norien>0){
           RENEW(ielorien,ITG,mi[2]**ne);
       }
       RENEW(ielmat,ITG,mi[2]**ne);
       SFREE(cg);SFREE(straight);
       SFREE(imastop);SFREE(itiefac);SFREE(islavnode);SFREE(islavsurf);
       SFREE(nslavnode);SFREE(iponoels);SFREE(inoels);SFREE(imastnode);
       SFREE(nmastnode);SFREE(itietri);SFREE(koncont);SFREE(xnoels);
       SFREE(springarea);SFREE(xmastnor);
 
       if(*mortar==0){
           SFREE(areaslav);
       }else if(*mortar==1){
           SFREE(pmastsurf);SFREE(ipe);SFREE(ime);SFREE(pslavsurf);
           SFREE(islavact);SFREE(clearini);
       }
       }
       mpcinfo[0]=memmpc_;mpcinfo[1]=mpcfree;mpcinfo[2]=icascade;
       mpcinfo[3]=maxlenmpc;
   }
 
   /* 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];}
     for(k=0;k<*nk;++k){vold[mt*k]=t1act[k];}
   }
 
   SFREE(xbounact);SFREE(xforcact);SFREE(xloadact);SFREE(t1act);SFREE(ampli);
   SFREE(xbodyact);if(*nbody>0) SFREE(ipobody);SFREE(xstiff);
 
   if(iglob==1){SFREE(integerglob);SFREE(doubleglob);}
 
   *irowp=irow;*enerp=ener;*xstatep=xstate;*ipkonp=ipkon;*lakonp=lakon;
   *konp=kon;*ielmatp=ielmat;*ielorienp=ielorien;*icolp=icol;
 
   (*ttime)+=(*tper);
  
   return;
 }

◆ mafillkmain()

void mafillkmain	(	ITG *	nef,
		ITG *	ipnei,
		ITG *	neifa,
		ITG *	neiel,
		double *	vfa,
		double *	xxn,
		double *	area,
		double *	au,
		double *	ad,
		ITG *	jq,
		ITG *	irow,
		ITG *	nzs,
		double *	b,
		double *	vel,
		double *	umel,
		double *	xlet,
		double *	xle,
		double *	gradkfa,
		double *	xxi,
		double *	body,
		double *	volume,
		ITG *	ielfa,
		char *	lakonf,
		ITG *	ifabou,
		ITG *	nbody,
		ITG *	neq,
		double *	dtimef,
		double *	velo,
		double *	veloo,
		double *	cpfa,
		double *	hcfa,
		double *	cvel,
		double *	gradvel,
		double *	xload,
		double *	gammat,
		double *	xrlfa,
		double *	xxj,
		ITG *	nactdohinv,
		double *	a1,
		double *	a2,
		double *	a3,
		double *	flux,
		ITG *	iau6,
		double *	xxni,
		double *	xxnj,
		ITG *	iturbulent
	)

                                {
 
     ITG i;
       
     /* variables for multithreading procedure */
     
     ITG sys_cpus,*ithread=NULL;
     char *env,*envloc,*envsys;
 
     num_cpus = 0;
     sys_cpus=0;
 
     /* explicit user declaration prevails */
 
     envsys=getenv("NUMBER_OF_CPUS");
     if(envsys){
     sys_cpus=atoi(envsys);
     if(sys_cpus<0) sys_cpus=0;
     }
 
     /* automatic detection of available number of processors */
 
     if(sys_cpus==0){
     sys_cpus = getSystemCPUs();
     if(sys_cpus<1) sys_cpus=1;
     }
 
     /* local declaration prevails, if strictly positive */
 
     envloc = getenv("CCX_NPROC_CFD");
     if(envloc){
     num_cpus=atoi(envloc);
     if(num_cpus<0){
         num_cpus=0;
     }else if(num_cpus>sys_cpus){
         num_cpus=sys_cpus;
     }
     
     }
 
     /* else global declaration, if any, applies */
 
     env = getenv("OMP_NUM_THREADS");
     if(num_cpus==0){
     if (env)
         num_cpus = atoi(env);
     if (num_cpus < 1) {
         num_cpus=1;
     }else if(num_cpus>sys_cpus){
         num_cpus=sys_cpus;
     }
     }
 
 // next line is to be inserted in a similar way for all other paralell parts
 
     if(*nef<num_cpus) num_cpus=*nef;
     
     pthread_t tid[num_cpus];
 
     /* calculating the stiffness and/or mass matrix 
        (symmetric part) */
 
     nef1=nef;ipnei1=ipnei;neifa1=neifa;neiel1=neiel;vfa1=vfa;xxn1=xxn;
     area1=area;
     jq1=jq;irow1=irow;nzs1=nzs;vel1=vel;umfa1=umfa;xlet1=xlet;xle1=xle;
     gradtfa1=gradtfa;xxi1=xxi;body1=body;volume1=volume;
     ielfa1=ielfa;lakonf1=lakonf;ifabou1=ifabou;
     nbody1=nbody;neq1=neq;dtimef1=dtimef;velo1=velo;veloo1=veloo;
     cvfa1=cvfa;hcfa1=hcfa;cvel1=cvel;gradvel1=gradvel;xload1=xload;
     gamma1=gamma;xrlfa1=xrlfa;xxj1=xxj;nactdohinv1=nactdohinv;a11=a1;
     a21=a2;a31=a3;flux1=flux;iau61=iau6;ad1=ad;au1=au;b1=b;xxni1=xxni;
     xxnj1=xxnj,iturbulent1=iturbulent;
     
     /* create threads and wait */
     
     NNEW(ithread,ITG,num_cpus);
     for(i=0; i<num_cpus; i++)  {
     ithread[i]=i;
     pthread_create(&tid[i], NULL, (void *)mafillkmt, (void *)&ithread[i]);
     }
     for(i=0; i<num_cpus; i++)  pthread_join(tid[i], NULL);
     
     SFREE(ithread);
   
   return;
 
 }

◆ mafillkmt()

void* mafillkmt ( ITG * i )

                        {
 
     ITG nefa,nefb,nefdelta;
     
 // ceil -> floor
 
     nefdelta=(ITG)floor(*nef1/(double)num_cpus);
     nefa=*i*nefdelta+1;
     nefb=(*i+1)*nefdelta;
 // next line! -> all parallel sections
     if((*i==num_cpus-1)&&(nefb<*nef1)) nefb=*nef1;
           
     FORTRAN(mafillk,(nef1,ipnei1,neifa1,neiel1,vfa1,xxn1,area1,
              au1,ad1,jq1,irow1,nzs1,
              b1,vel1,umfa1,xlet1,xle1,gradtfa1,xxi1,
              body1,volume1,ielfa1,lakonf1,ifabou1,
              nbody1,neq1,dtimef1,velo1,veloo1,cvfa1,hcfa1,cvel1,
              gradvel1,xload1,gamma1,xrlfa1,xxj1,nactdohinv1,
                  a11,a21,a31,flux1,&nefa,&nefb,iau61,xxni1,xxnj1,
                          iturbulent1));
 
     return NULL;
 }

◆ mafillomain()

void mafillomain	(	ITG *	nef,
		ITG *	ipnei,
		ITG *	neifa,
		ITG *	neiel,
		double *	vfa,
		double *	xxn,
		double *	area,
		double *	au,
		double *	ad,
		ITG *	jq,
		ITG *	irow,
		ITG *	nzs,
		double *	b,
		double *	vel,
		double *	umel,
		double *	xlet,
		double *	xle,
		double *	gradofa,
		double *	xxi,
		double *	body,
		double *	volume,
		ITG *	ielfa,
		char *	lakonf,
		ITG *	ifabou,
		ITG *	nbody,
		ITG *	neq,
		double *	dtimef,
		double *	velo,
		double *	veloo,
		double *	cpfa,
		double *	hcfa,
		double *	cvel,
		double *	gradvel,
		double *	xload,
		double *	gammat,
		double *	xrlfa,
		double *	xxj,
		ITG *	nactdohinv,
		double *	a1,
		double *	a2,
		double *	a3,
		double *	flux,
		ITG *	iau6,
		double *	xxni,
		double *	xxnj,
		ITG *	iturbulent,
		double *	gradkel,
		double *	gradoel
	)

                                                            {
 
     ITG i;
       
     /* variables for multithreading procedure */
     
     ITG sys_cpus,*ithread=NULL;
     char *env,*envloc,*envsys;
 
     num_cpus = 0;
     sys_cpus=0;
 
     /* explicit user declaration prevails */
 
     envsys=getenv("NUMBER_OF_CPUS");
     if(envsys){
     sys_cpus=atoi(envsys);
     if(sys_cpus<0) sys_cpus=0;
     }
 
     /* automatic detection of available number of processors */
 
     if(sys_cpus==0){
     sys_cpus = getSystemCPUs();
     if(sys_cpus<1) sys_cpus=1;
     }
 
     /* local declaration prevails, if strictly positive */
 
     envloc = getenv("CCX_NPROC_CFD");
     if(envloc){
     num_cpus=atoi(envloc);
     if(num_cpus<0){
         num_cpus=0;
     }else if(num_cpus>sys_cpus){
         num_cpus=sys_cpus;
     }
     
     }
 
     /* else global declaration, if any, applies */
 
     env = getenv("OMP_NUM_THREADS");
     if(num_cpus==0){
     if (env)
         num_cpus = atoi(env);
     if (num_cpus < 1) {
         num_cpus=1;
     }else if(num_cpus>sys_cpus){
         num_cpus=sys_cpus;
     }
     }
 
 // next line is to be inserted in a similar way for all other paralell parts
 
     if(*nef<num_cpus) num_cpus=*nef;
     
     pthread_t tid[num_cpus];
 
     /* calculating the stiffness and/or mass matrix 
        (symmetric part) */
 
     nef1=nef;ipnei1=ipnei;neifa1=neifa;neiel1=neiel;vfa1=vfa;xxn1=xxn;
     area1=area;
     jq1=jq;irow1=irow;nzs1=nzs;vel1=vel;umfa1=umfa;xlet1=xlet;xle1=xle;
     gradtfa1=gradtfa;xxi1=xxi;body1=body;volume1=volume;
     ielfa1=ielfa;lakonf1=lakonf;ifabou1=ifabou;
     nbody1=nbody;neq1=neq;dtimef1=dtimef;velo1=velo;veloo1=veloo;
     cvfa1=cvfa;hcfa1=hcfa;cvel1=cvel;gradvel1=gradvel;xload1=xload;
     gamma1=gamma;xrlfa1=xrlfa;xxj1=xxj;nactdohinv1=nactdohinv;a11=a1;
     a21=a2;a31=a3;flux1=flux;iau61=iau6;ad1=ad;au1=au;b1=b;xxni1=xxni;
     xxnj1=xxnj,iturbulent1=iturbulent;gradkel1=gradkel;gradoel1=gradoel;
     
     /* create threads and wait */
     
     NNEW(ithread,ITG,num_cpus);
     for(i=0; i<num_cpus; i++)  {
     ithread[i]=i;
     pthread_create(&tid[i], NULL, (void *)mafillomt, (void *)&ithread[i]);
     }
     for(i=0; i<num_cpus; i++)  pthread_join(tid[i], NULL);
     
     SFREE(ithread);
   
   return;
 
 }

◆ mafillomt()

void* mafillomt ( ITG * i )

                        {
 
     ITG nefa,nefb,nefdelta;
     
 // ceil -> floor
 
     nefdelta=(ITG)floor(*nef1/(double)num_cpus);
     nefa=*i*nefdelta+1;
     nefb=(*i+1)*nefdelta;
 // next line! -> all parallel sections
     if((*i==num_cpus-1)&&(nefb<*nef1)) nefb=*nef1;
           
     FORTRAN(mafillo,(nef1,ipnei1,neifa1,neiel1,vfa1,xxn1,area1,
              au1,ad1,jq1,irow1,nzs1,
              b1,vel1,umfa1,xlet1,xle1,gradtfa1,xxi1,
              body1,volume1,ielfa1,lakonf1,ifabou1,
              nbody1,neq1,dtimef1,velo1,veloo1,cvfa1,hcfa1,cvel1,
              gradvel1,xload1,gamma1,xrlfa1,xxj1,nactdohinv1,
                  a11,a21,a31,flux1,&nefa,&nefb,iau61,xxni1,xxnj1,
                  iturbulent1,gradkel1,gradoel1));
 
     return NULL;
 }

◆ mafillpcompmain()

void mafillpcompmain	(	ITG *	ne,
		char *	lakonf,
		ITG *	ipnei,
		ITG *	neifa,
		ITG *	neiel,
		double *	vfa,
		double *	area,
		double *	adfa,
		double *	xlet,
		double *	cosa,
		double *	volume,
		double *	au,
		double *	ad,
		ITG *	jq,
		ITG *	irow,
		double *	ap,
		ITG *	ielfa,
		ITG *	ifabou,
		double *	xle,
		double *	b,
		double *	xxn,
		ITG *	neq,
		ITG *	nzs,
		double *	hfa,
		double *	gradpel,
		double *	bp,
		double *	xxi,
		ITG *	neij,
		double *	xlen,
		double *	cosb,
		ITG *	ielmatf,
		ITG *	mi,
		double *	a1,
		double *	a2,
		double *	a3,
		double *	velo,
		double *	veloo,
		double *	dtimef,
		double *	shcon,
		ITG *	ntmat_,
		double *	vel,
		ITG *	nactdohinv,
		double *	xrlfa,
		double *	flux,
		ITG *	iau6,
		double *	xxicn,
		double *	gamma
	)

                            {
 
     ITG i,j;
       
     /* variables for multithreading procedure */
     
     ITG sys_cpus,*ithread=NULL;
     char *env,*envloc,*envsys;
 
     num_cpus = 0;
     sys_cpus=0;
 
     /* explicit user declaration prevails */
 
     envsys=getenv("NUMBER_OF_CPUS");
     if(envsys){
     sys_cpus=atoi(envsys);
     if(sys_cpus<0) sys_cpus=0;
     }
 
     /* automatic detection of available number of processors */
 
     if(sys_cpus==0){
     sys_cpus = getSystemCPUs();
     if(sys_cpus<1) sys_cpus=1;
     }
 
     /* local declaration prevails, if strictly positive */
 
     envloc = getenv("CCX_NPROC_CFD");
     if(envloc){
     num_cpus=atoi(envloc);
     if(num_cpus<0){
         num_cpus=0;
     }else if(num_cpus>sys_cpus){
         num_cpus=sys_cpus;
     }
     
     }
 
     /* else global declaration, if any, applies */
 
     env = getenv("OMP_NUM_THREADS");
     if(num_cpus==0){
     if (env)
         num_cpus = atoi(env);
     if (num_cpus < 1) {
         num_cpus=1;
     }else if(num_cpus>sys_cpus){
         num_cpus=sys_cpus;
     }
     }
 
 // next line is to be inserted in a similar way for all other paralell parts
 
     if(*nef<num_cpus) num_cpus=*nef;
     
     pthread_t tid[num_cpus];
 
     /* calculating the stiffness and/or mass matrix 
        (symmetric part) */
 
     nef1=nef;lakonf1=lakonf;ipnei1=ipnei;neifa1=neifa;neiel1=neiel;
     vfa1=vfa;area1=area;advfa1=advfa;xlet1=xlet,cosa1=cosa;volume1=volume;
     jq1=jq;irow1=irow;ap1=ap;ielfa1=ielfa;ifabou1=ifabou;xle1=xle;
     xxn1=xxn;neq1=neq;nzs1=nzs;hfa1=hfa;gradpel1=gradpel;bp1=bp;xxi1=xxi;
     neij1=neij;xlen1=xlen;cosb1=cosb;ielmatf1=ielmatf;mi1=mi,a11=a1;
     a21=a2;a31=a3;velo1=velo;veloo1=veloo;dtimef1=dtimef;shcon1=shcon;
     ntmat1_=ntmat_;vel1=vel;nactdohinv1=nactdohinv;xrlfa1=xrlfa;
     flux1=flux;iau61=iau6;ad1=ad;au1=au;b1=b;xxicn1=xxicn;gamma1=gamma;
     
     /* create threads and wait */
     
     NNEW(ithread,ITG,num_cpus);
     for(i=0; i<num_cpus; i++)  {
     ithread[i]=i;
     pthread_create(&tid[i], NULL, (void *)mafillpcompmt, (void *)&ithread[i]);
     }
     for(i=0; i<num_cpus; i++)  pthread_join(tid[i], NULL);
     
     SFREE(ithread);
   
   return;
 
 }

◆ mafillpcompmt()

void* mafillpcompmt ( ITG * i )

                            {
 
     ITG nefa,nefb,nefdelta;
     
 // ceil -> floor
 
     nefdelta=(ITG)floor(*nef1/(double)num_cpus);
     nefa=*i*nefdelta+1;
     nefb=(*i+1)*nefdelta;
 // next line! -> all parallel sections
     if((*i==num_cpus-1)&&(nefb<*nef1)) nefb=*nef1;
 
     FORTRAN(mafillpcomp,(nef1,lakonf1,ipnei1,neifa1,neiel1,vfa1,area1,
              advfa1,xlet1,cosa1,volume1,au1,ad1,
                          jq1,irow1,ap1,ielfa1,ifabou1,xle1,b1,xxn1,neq1,nzs1,
                          hfa1,gradpel1,bp1,xxi1,neij1,xlen1,cosb1,ielmatf1,mi1,
                          a11,a21,a31,velo1,veloo1,dtimef1,shcon1,ntmat1_,vel1,
                          nactdohinv1,xrlfa1,flux1,&nefa,&nefb,iau61,xxicn1,
                          gamma1));
 
     return NULL;
 }

◆ mafillpmain()

void mafillpmain	(	ITG *	ne,
		char *	lakonf,
		ITG *	ipnei,
		ITG *	neifa,
		ITG *	neiel,
		double *	vfa,
		double *	area,
		double *	adfa,
		double *	xlet,
		double *	cosa,
		double *	volume,
		double *	au,
		double *	ad,
		ITG *	jq,
		ITG *	irow,
		double *	ap,
		ITG *	ielfa,
		ITG *	ifabou,
		double *	xle,
		double *	b,
		double *	xxn,
		ITG *	neq,
		ITG *	nzs,
		double *	hfa,
		double *	gradpel,
		double *	bp,
		double *	xxi,
		ITG *	neij,
		double *	xlen,
		double *	cosb,
		ITG *	iatleastonepressurebc,
		ITG *	iau6,
		double *	xxicn
	)

                                                             {
 
     ITG i,j;
       
     /* variables for multithreading procedure */
     
     ITG sys_cpus,*ithread=NULL;
     char *env,*envloc,*envsys;
 
     num_cpus = 0;
     sys_cpus=0;
 
     /* explicit user declaration prevails */
 
     envsys=getenv("NUMBER_OF_CPUS");
     if(envsys){
     sys_cpus=atoi(envsys);
     if(sys_cpus<0) sys_cpus=0;
     }
 
     /* automatic detection of available number of processors */
 
     if(sys_cpus==0){
     sys_cpus = getSystemCPUs();
     if(sys_cpus<1) sys_cpus=1;
     }
 
     /* local declaration prevails, if strictly positive */
 
     envloc = getenv("CCX_NPROC_CFD");
     if(envloc){
     num_cpus=atoi(envloc);
     if(num_cpus<0){
         num_cpus=0;
     }else if(num_cpus>sys_cpus){
         num_cpus=sys_cpus;
     }
     
     }
 
     /* else global declaration, if any, applies */
 
     env = getenv("OMP_NUM_THREADS");
     if(num_cpus==0){
     if (env)
         num_cpus = atoi(env);
     if (num_cpus < 1) {
         num_cpus=1;
     }else if(num_cpus>sys_cpus){
         num_cpus=sys_cpus;
     }
     }
 
 // next line is to be inserted in a similar way for all other paralell parts
 
     if(*nef<num_cpus) num_cpus=*nef;
     
     pthread_t tid[num_cpus];
 
     /* calculating the stiffness and/or mass matrix 
        (symmetric part) */
 
     nef1=nef;lakonf1=lakonf;ipnei1=ipnei;neifa1=neifa;neiel1=neiel;
     vfa1=vfa;area1=area;advfa1=advfa;xlet1=xlet,cosa1=cosa;volume1=volume;
     jq1=jq;irow1=irow;ap1=ap;ielfa1=ielfa;ifabou1=ifabou;xle1=xle;
     xxn1=xxn;neq1=neq;nzs1=nzs;hfa1=hfa;gradpel1=gradpel;bp1=bp;xxi1=xxi;
     neij1=neij;xlen1=xlen;cosb1=cosb;iau61=iau6;ad1=ad;au1=au;b1=b;
     xxicn1=xxicn;
     
     /* create threads and wait */
     
     NNEW(ithread,ITG,num_cpus);
     for(i=0; i<num_cpus; i++)  {
     ithread[i]=i;
     pthread_create(&tid[i], NULL, (void *)mafillpmt, (void *)&ithread[i]);
     }
     for(i=0; i<num_cpus; i++)  pthread_join(tid[i], NULL);
     
     SFREE(ithread);
 
     FORTRAN(mafillpbc,(nef,au,ad,jq,irow,b,iatleastonepressurebc,nzs));
   
   return;
 
 }

◆ mafillpmt()

void* mafillpmt ( ITG * i )

                        {
 
     ITG nefa,nefb,nefdelta;
     
 // ceil -> floor
 
     nefdelta=(ITG)floor(*nef1/(double)num_cpus);
     nefa=*i*nefdelta+1;
     nefb=(*i+1)*nefdelta;
 // next line! -> all parallel sections
     if((*i==num_cpus-1)&&(nefb<*nef1)) nefb=*nef1;
 
     FORTRAN(mafillp,(nef1,lakonf1,ipnei1,neifa1,neiel1,vfa1,area1,
              advfa1,xlet1,cosa1,volume1,au1,ad1,
                          jq1,irow1,ap1,ielfa1,ifabou1,xle1,b1,xxn1,neq1,nzs1,
                  hfa1,gradpel1,bp1,xxi1,neij1,xlen1,cosb1,&nefa,&nefb,
                  iau61,xxicn1));
 
     return NULL;
 }

◆ mafillsmasmain()

void mafillsmasmain	(	double *	co,
		ITG *	nk,
		ITG *	kon,
		ITG *	ipkon,
		char *	lakon,
		ITG *	ne,
		ITG *	nodeboun,
		ITG *	ndirboun,
		double *	xboun,
		ITG *	nboun,
		ITG *	ipompc,
		ITG *	nodempc,
		double *	coefmpc,
		ITG *	nmpc,
		ITG *	nodeforc,
		ITG *	ndirforc,
		double *	xforc,
		ITG *	nforc,
		ITG *	nelemload,
		char *	sideload,
		double *	xload,
		ITG *	nload,
		double *	xbody,
		ITG *	ipobody,
		ITG *	nbody,
		double *	cgr,
		double *	ad,
		double *	au,
		double *	bb,
		ITG *	nactdof,
		ITG *	icol,
		ITG *	jq,
		ITG *	irow,
		ITG *	neq,
		ITG *	nzl,
		ITG *	nmethod,
		ITG *	ikmpc,
		ITG *	ilmpc,
		ITG *	ikboun,
		ITG *	ilboun,
		double *	elcon,
		ITG *	nelcon,
		double *	rhcon,
		ITG *	nrhcon,
		double *	alcon,
		ITG *	nalcon,
		double *	alzero,
		ITG *	ielmat,
		ITG *	ielorien,
		ITG *	norien,
		double *	orab,
		ITG *	ntmat_,
		double *	t0,
		double *	t1,
		ITG *	ithermal,
		double *	prestr,
		ITG *	iprestr,
		double *	vold,
		ITG *	iperturb,
		double *	sti,
		ITG *	nzs,
		double *	stx,
		double *	adb,
		double *	aub,
		ITG *	iexpl,
		double *	plicon,
		ITG *	nplicon,
		double *	plkcon,
		ITG *	nplkcon,
		double *	xstiff,
		ITG *	npmat_,
		double *	dtime,
		char *	matname,
		ITG *	mi,
		ITG *	ncmat_,
		ITG *	mass,
		ITG *	stiffness,
		ITG *	buckling,
		ITG *	rhs,
		ITG *	intscheme,
		double *	physcon,
		double *	shcon,
		ITG *	nshcon,
		double *	cocon,
		ITG *	ncocon,
		double *	ttime,
		double *	time,
		ITG *	istep,
		ITG *	kinc,
		ITG *	coriolis,
		ITG *	ibody,
		double *	xloadold,
		double *	reltime,
		double *	veold,
		double *	springarea,
		ITG *	nstate_,
		double *	xstateini,
		double *	xstate,
		double *	thicke,
		ITG *	integerglob,
		double *	doubleglob,
		char *	tieset,
		ITG *	istartset,
		ITG *	iendset,
		ITG *	ialset,
		ITG *	ntie,
		ITG *	nasym,
		double *	pslavsurf,
		double *	pmastsurf,
		ITG *	mortar,
		double *	clearini,
		ITG *	ielprop,
		double *	prop,
		ITG *	ne0,
		ITG *	kscale
	)

◆ mafillsmasmt()

void* mafillsmasmt ( ITG * i )

◆ mafillsmmain()

void mafillsmmain	(	double *	co,
		ITG *	nk,
		ITG *	kon,
		ITG *	ipkon,
		char *	lakon,
		ITG *	ne,
		ITG *	nodeboun,
		ITG *	ndirboun,
		double *	xboun,
		ITG *	nboun,
		ITG *	ipompc,
		ITG *	nodempc,
		double *	coefmpc,
		ITG *	nmpc,
		ITG *	nodeforc,
		ITG *	ndirforc,
		double *	xforc,
		ITG *	nforc,
		ITG *	nelemload,
		char *	sideload,
		double *	xload,
		ITG *	nload,
		double *	xbody,
		ITG *	ipobody,
		ITG *	nbody,
		double *	cgr,
		double *	ad,
		double *	au,
		double *	bb,
		ITG *	nactdof,
		ITG *	icol,
		ITG *	jq,
		ITG *	irow,
		ITG *	neq,
		ITG *	nzl,
		ITG *	nmethod,
		ITG *	ikmpc,
		ITG *	ilmpc,
		ITG *	ikboun,
		ITG *	ilboun,
		double *	elcon,
		ITG *	nelcon,
		double *	rhcon,
		ITG *	nrhcon,
		double *	alcon,
		ITG *	nalcon,
		double *	alzero,
		ITG *	ielmat,
		ITG *	ielorien,
		ITG *	norien,
		double *	orab,
		ITG *	ntmat_,
		double *	t0,
		double *	t1,
		ITG *	ithermal,
		double *	prestr,
		ITG *	iprestr,
		double *	vold,
		ITG *	iperturb,
		double *	sti,
		ITG *	nzs,
		double *	stx,
		double *	adb,
		double *	aub,
		ITG *	iexpl,
		double *	plicon,
		ITG *	nplicon,
		double *	plkcon,
		ITG *	nplkcon,
		double *	xstiff,
		ITG *	npmat_,
		double *	dtime,
		char *	matname,
		ITG *	mi,
		ITG *	ncmat_,
		ITG *	mass,
		ITG *	stiffness,
		ITG *	buckling,
		ITG *	rhs,
		ITG *	intscheme,
		double *	physcon,
		double *	shcon,
		ITG *	nshcon,
		double *	cocon,
		ITG *	ncocon,
		double *	ttime,
		double *	time,
		ITG *	istep,
		ITG *	kinc,
		ITG *	coriolis,
		ITG *	ibody,
		double *	xloadold,
		double *	reltime,
		double *	veold,
		double *	springarea,
		ITG *	nstate_,
		double *	xstateini,
		double *	xstate,
		double *	thicke,
		ITG *	integerglob,
		double *	doubleglob,
		char *	tieset,
		ITG *	istartset,
		ITG *	iendset,
		ITG *	ialset,
		ITG *	ntie,
		ITG *	nasym,
		double *	pslavsurf,
		double *	pmastsurf,
		ITG *	mortar,
		double *	clearini,
		ITG *	ielprop,
		double *	prop,
		ITG *	ne0,
		double *	fnext,
		ITG *	kscale,
		ITG *	iponoel,
		ITG *	inoel,
		ITG *	network
	)

                             {
 
     ITG i,j,mt=mi[1]+1;
       
     /* variables for multithreading procedure */
     
     ITG sys_cpus,*ithread=NULL;
     char *env,*envloc,*envsys;
     
     num_cpus = 0;
     sys_cpus=0;
 
     /* explicit user declaration prevails */
 
     envsys=getenv("NUMBER_OF_CPUS");
     if(envsys){
     sys_cpus=atoi(envsys);
     if(sys_cpus<0) sys_cpus=0;
     }
 
 //    sys_cpus=1;
 
     /* automatic detection of available number of processors */
 
     if(sys_cpus==0){
     sys_cpus = getSystemCPUs();
     if(sys_cpus<1) sys_cpus=1;
     }
 
     /* local declaration prevails, if strictly positive */
 
     envloc = getenv("CCX_NPROC_STIFFNESS");
     if(envloc){
     num_cpus=atoi(envloc);
     if(num_cpus<0){
         num_cpus=0;
     }else if(num_cpus>sys_cpus){
         num_cpus=sys_cpus;
     }
     
     }
 
     /* else global declaration, if any, applies */
 
     env = getenv("OMP_NUM_THREADS");
     if(num_cpus==0){
     if (env)
         num_cpus = atoi(env);
     if (num_cpus < 1) {
         num_cpus=1;
     }else if(num_cpus>sys_cpus){
         num_cpus=sys_cpus;
     }
     }
 
 // next line is to be inserted in a similar way for all other paralell parts
 
     if(*ne<num_cpus) num_cpus=*ne;
     
     pthread_t tid[num_cpus];
 
     /* determine nzl */
 
     *nzl=0;
     for(i=neq[1];i>=1;i--){
     if(icol[i-1]>0){
         *nzl=i;
         break;
     }
     }
 
     /* allocating fields for mass and stiffness matrix */
 
 //    if(*buckling!=1){
     NNEW(ad1,double,num_cpus*neq[1]);
     NNEW(au1,double,(long long)num_cpus*nzs[2]);
 //    }
 
     if(*rhsi==1){
     NNEW(fext1,double,num_cpus*neq[1]);
     }
 
     if((mass[1]==1)||((mass[0]==1)||(*buckling==1))){
     NNEW(adb1,double,num_cpus*neq[1]);
     NNEW(aub1,double,(long long)num_cpus*nzs[1]);
     }
 
     if(*nmethod==4){
     NNEW(fnext1,double,num_cpus*mt**nk);
     }
 
     /* allocating memory for nmethod; if the Jacobian determinant
        in any of the elements is nonpositive, nmethod is set to
        zero */
 
     NNEW(nmethod1,ITG,num_cpus);
     for(j=0;j<num_cpus;j++){
     nmethod1[j]=*nmethod;
     }
 
     /* calculating the stiffness and/or mass matrix 
        (symmetric part) */
 
     co1=co;nk1=nk;kon1=kon;ipkon1=ipkon;lakon1=lakon;ne1=ne;
     nodeboun1=nodeboun;ndirboun1=ndirboun;xboun1=xboun;
     nboun1=nboun;ipompc1=ipompc;nodempc1=nodempc;coefmpc1=coefmpc;
     nmpc1=nmpc;nodeforc1=nodeforc;ndirforc1=ndirforc;xforc1=xforc;
     nforc1=nforc;nelemload1=nelemload;sideload1=sideload;xload1=xload;
     nload1=nload;xbody1=xbody;ipobody1=ipobody;nbody1=nbody;
     cgr1=cgr;nactdof1=nactdof;icol1=icol;jq1=jq;irow1=irow;neq1=neq;
     nzl1=nzl;ikmpc1=ikmpc;ilmpc1=ilmpc;ikboun1=ikboun;
     ilboun1=ilboun;elcon1=elcon;nelcon1=nelcon;rhcon1=rhcon;
     nrhcon1=nrhcon;alcon1=alcon;nalcon1=nalcon;alzero1=alzero;
     ielmat1=ielmat;ielorien1=ielorien;norien1=norien;orab1=orab;
     ntmat1_=ntmat_;t01=t0;t11=t1;ithermal1=ithermal;prestr1=prestr;
     iprestr1=iprestr;vold1=vold;iperturb1=iperturb;sti1=sti;nzs1=nzs;
     stx1=stx;iexpl1=iexpl;plicon1=plicon;nplicon1=nplicon;
     plkcon1=plkcon;nplkcon1=nplkcon;xstiff1=xstiff;npmat1_=npmat_;
     dtime1=dtime;matname1=matname;mi1=mi;ncmat1_=ncmat_;mass1=mass;
     stiffness1=stiffness;buckling1=buckling;rhsi1=rhsi;intscheme1=intscheme;
     physcon1=physcon;shcon1=shcon;nshcon1=nshcon;cocon1=cocon;
     ncocon1=ncocon;ttime1=ttime;time1=time;istep1=istep;iinc1=iinc;
     coriolis1=coriolis;ibody1=ibody;xloadold1=xloadold;reltime1=reltime;
     veold1=veold;springarea1=springarea;nstate1_=nstate_;xstateini1=xstateini;
     xstate1=xstate;thicke1=thicke;integerglob1=integerglob;
     doubleglob1=doubleglob;tieset1=tieset;istartset1=istartset;
     iendset1=iendset;ialset1=ialset;ntie1=ntie;nasym1=nasym;
     pslavsurf1=pslavsurf;pmastsurf1=pmastsurf;mortar1=mortar;
     clearini1=clearini;ielprop1=ielprop;prop1=prop;ne01=ne0;kscale1=kscale;
     iponoel1=iponoel;inoel1=inoel;network1=network;  
 
     /* calculating the stiffness/mass */
     
     printf(" Using up to %" ITGFORMAT " cpu(s) for the symmetric stiffness/mass contributions.\n\n", num_cpus);
     
     /* create threads and wait */
     
     NNEW(ithread,ITG,num_cpus);
     for(i=0; i<num_cpus; i++)  {
     ithread[i]=i;
     pthread_create(&tid[i], NULL, (void *)mafillsmmt, (void *)&ithread[i]);
     }
     for(i=0; i<num_cpus; i++)  pthread_join(tid[i], NULL);
     
     SFREE(ithread);
 
     /*      for(i=0;i<num_cpus;i++){
       for(k=i*neq[1];k<i*neq[1]+neq[1];++k){printf("fext=%" ITGFORMAT ",%f\n",k-i*neq[1],fext1[k]);}
       for(k=i*neq[1];k<i*neq[1]+neq[1];++k){printf("ad=%" ITGFORMAT ",%f\n",k-i*neq[1],ad1[k]);}
       for(k=i*nzs[2];k<i*nzs[2]+nzs[2];++k){printf("au=%" ITGFORMAT ",%f\n",k-i*nzs[2],au1[k]);}
       }*/
 
     /* copying and accumulating the stiffnes and/or mass matrix 
        for buckling the matrices have to be added*/
 
     if(*buckling!=1){
 
         /* no buckling */
 
     for(i=0;i<neq[1];i++){
         ad[i]=ad1[i];
     }
     }else{
 
         /* buckling */
 
     for(i=0;i<neq[1];i++){
         ad[i]+=ad1[i];
     }
     }
 
     for(i=0;i<neq[1];i++){
     for(j=1;j<num_cpus;j++){
         ad[i]+=ad1[i+j*neq[1]];
     }
     }
     SFREE(ad1);
     
     if(*buckling!=1){
 
         /* no buckling */
 
     for(i=0;i<nzs[2];i++){
         au[i]=au1[i];
     }
     }else{
 
         /* buckling */
 
     for(i=0;i<nzs[2];i++){
         au[i]+=au1[i];
     }
     }
 
     for(i=0;i<nzs[2];i++){
     for(j=1;j<num_cpus;j++){
         au[i]+=au1[i+(long long)j*nzs[2]];
     }
     }
     SFREE(au1);
 
     if(*rhsi==1){
     for(i=0;i<neq[1];i++){
         fext[i]=fext1[i];
     }
     for(i=0;i<neq[1];i++){
         for(j=1;j<num_cpus;j++){
         fext[i]+=fext1[i+j*neq[1]];
         }
     }
     SFREE(fext1);
     }
 
     /* the heat capacity matrix and mass matrix must be treated
        separately, since the mass matrix is no recalculated
        in each iteration, whereas the capacity matrix is */
 
     /* heat capacity matrix */
 
     if(mass[1]==1){
     for(i=neq[0];i<neq[1];i++){
         adb[i]=adb1[i];
     }
     for(i=neq[0];i<neq[1];i++){
         for(j=1;j<num_cpus;j++){
         adb[i]+=adb1[i+j*neq[1]];
         }
     }
 
     for(i=nzs[0];i<nzs[1];i++){
         aub[i]=aub1[i];
     }
     for(i=nzs[0];i<nzs[1];i++){
         for(j=1;j<num_cpus;j++){
         aub[i]+=aub1[i+(long long)j*nzs[1]];
         }
     }
     }
 
     /* mass matrix or buckling matrix */
 
     if((mass[0]==1)||(*buckling==1)){
     for(i=0;i<neq[0];i++){
         adb[i]=adb1[i];
     }
     for(i=0;i<neq[0];i++){
         for(j=1;j<num_cpus;j++){
         adb[i]+=adb1[i+j*neq[1]];
         }
     }
 
     for(i=0;i<nzs[0];i++){
         aub[i]=aub1[i];
     }
     for(i=0;i<nzs[0];i++){
         for(j=1;j<num_cpus;j++){
         aub[i]+=aub1[i+(long long)j*nzs[1]];
         }
     }
     }
     if((mass[0]==1)||(mass[1]==1)||(*buckling==1)){
     SFREE(adb1);SFREE(aub1);
     }
 
     if(*nmethod==4){
     for(i=0;i<mt**nk;i++){
         fnext[i]=fnext1[i];
     }
     for(i=0;i<mt**nk;i++){
         for(j=1;j<num_cpus;j++){
         fnext[i]+=fnext1[i+j*mt**nk];
         }
     }
     SFREE(fnext1);
     }
 
     for(j=0;j<num_cpus;j++){
     if(nmethod1[j]==0){
         *nmethod=0;
         break;
     }
     }
     SFREE(nmethod1);
       
     /*     for(k=0;k<neq[1];++k){printf("fext=%" ITGFORMAT ",%f\n",k,fext[k]);}
       for(k=0;k<neq[1];++k){printf("ad=%" ITGFORMAT ",%f\n",k,ad[k]);}
       for(k=0;k<nzs[1];++k){printf("au=%" ITGFORMAT ",%f\n",k,au[k]);}*/
 
     /* taking point forces into account in fext */
 
     FORTRAN(mafillsmforc,(nforc,ndirforc,nodeforc,xforc,nactdof,
               fext,nmpc,ipompc,nodempc,ikmpc,ilmpc,
                   coefmpc,mi,rhsi,fnext,nmethod));
   
   return;
 
 }

◆ mafillsmmain_se()

void mafillsmmain_se	(	double *	co,
		ITG *	nk,
		ITG *	kon,
		ITG *	ipkon,
		char *	lakon,
		ITG *	ne,
		ITG *	nodeboun,
		ITG *	ndirboun,
		double *	xboun,
		ITG *	nboun,
		ITG *	ipompc,
		ITG *	nodempc,
		double *	coefmpc,
		ITG *	nmpc,
		ITG *	nodeforc,
		ITG *	ndirforc,
		double *	xforc,
		ITG *	nforc,
		ITG *	nelemload,
		char *	sideload,
		double *	xload,
		ITG *	nload,
		double *	xbody,
		ITG *	ipobody,
		ITG *	nbody,
		double *	cgr,
		ITG *	nactdof,
		ITG *	neq,
		ITG *	nmethod,
		ITG *	ikmpc,
		ITG *	ilmpc,
		ITG *	ikboun,
		ITG *	ilboun,
		double *	elcon,
		ITG *	nelcon,
		double *	rhcon,
		ITG *	nrhcon,
		double *	alcon,
		ITG *	nalcon,
		double *	alzero,
		ITG *	ielmat,
		ITG *	ielorien,
		ITG *	norien,
		double *	orab,
		ITG *	ntmat_,
		double *	t0,
		double *	t1,
		ITG *	ithermal,
		double *	prestr,
		ITG *	iprestr,
		double *	vold,
		ITG *	iperturb,
		double *	sti,
		double *	stx,
		ITG *	iexpl,
		double *	plicon,
		ITG *	nplicon,
		double *	plkcon,
		ITG *	nplkcon,
		double *	xstiff,
		ITG *	npmat_,
		double *	dtime,
		char *	matname,
		ITG *	mi,
		ITG *	ncmat_,
		ITG *	mass,
		ITG *	stiffness,
		ITG *	buckling,
		ITG *	rhs,
		ITG *	intscheme,
		double *	physcon,
		double *	shcon,
		ITG *	nshcon,
		double *	cocon,
		ITG *	ncocon,
		double *	ttime,
		double *	time,
		ITG *	istep,
		ITG *	kinc,
		ITG *	coriolis,
		ITG *	ibody,
		double *	xloadold,
		double *	reltime,
		double *	veold,
		double *	springarea,
		ITG *	nstate_,
		double *	xstateini,
		double *	xstate,
		double *	thicke,
		ITG *	integerglob,
		double *	doubleglob,
		char *	tieset,
		ITG *	istartset,
		ITG *	iendset,
		ITG *	ialset,
		ITG *	ntie,
		ITG *	nasym,
		double *	pslavsurf,
		double *	pmastsurf,
		ITG *	mortar,
		double *	clearini,
		ITG *	ielprop,
		double *	prop,
		ITG *	ne0,
		double *	fnext,
		double *	distmin,
		ITG *	ndesi,
		ITG *	nodedesi,
		double *	df,
		ITG *	nzss,
		ITG *	jqs,
		ITG *	irows,
		ITG *	icoordinate,
		double *	dxstiff,
		double *	xdesi,
		ITG *	istartelem,
		ITG *	ialelem,
		double *	v,
		double *	sigma,
		ITG *	cyclicsymmetry,
		char *	labmpc,
		ITG *	ics,
		double *	cs,
		ITG *	mcs,
		ITG *	ieigenfrequency
	)

                                          {
            
     ITG i,j;
      
     /* variables for multithreading procedure */
     
     ITG sys_cpus,*ithread=NULL;
     char *env,*envloc,*envsys;
     
     num_cpus = 0;
     sys_cpus=0;
 
     /* explicit user declaration prevails */
 
     envsys=getenv("NUMBER_OF_CPUS");
     if(envsys){
     sys_cpus=atoi(envsys);
     if(sys_cpus<0) sys_cpus=0;
     }
 
 //    sys_cpus=1;
 
     /* automatic detection of available number of processors */
 
     if(sys_cpus==0){
     sys_cpus = getSystemCPUs();
     if(sys_cpus<1) sys_cpus=1;
     }
 
     /* local declaration prevails, if strictly positive */
 
     envloc = getenv("CCX_NPROC_STIFFNESS");
     if(envloc){
     num_cpus=atoi(envloc);
     if(num_cpus<0){
         num_cpus=0;
     }else if(num_cpus>sys_cpus){
         num_cpus=sys_cpus;
     }
     
     }
 
     /* else global declaration, if any, applies */
 
     env = getenv("OMP_NUM_THREADS");
     if(num_cpus==0){
     if (env)
         num_cpus = atoi(env);
     if (num_cpus < 1) {
         num_cpus=1;
     }else if(num_cpus>sys_cpus){
         num_cpus=sys_cpus;
     }
     }
 
 // next line is to be inserted in a similar way for all other paralell parts
 
     if(*ne<num_cpus) num_cpus=*ne;
     
     pthread_t tid[num_cpus];
 
     /* allocating fields for mass and stiffness matrix and sensitivity matrix */
     
     if(!*cyclicsymmetry){
     NNEW(dfl1,double,num_cpus*60**ndesi);
     NNEW(df1,double,num_cpus**nzss);
     }else{
     NNEW(dfl1,double,num_cpus*120**ndesi);
     NNEW(df1,double,num_cpus*2**nzss);
     }
 
     /* allocating memory for nmethod; if the Jacobian determinant
        in any of the elements is nonpositive, nmethod is set to
        zero */
 
     NNEW(nmethod1,ITG,num_cpus);
     for(j=0;j<num_cpus;j++){
     nmethod1[j]=*nmethod;
     }
 
     /* calculating the stiffness and/or mass matrix 
        (symmetric part) */
 
     co1=co;nk1=nk;kon1=kon;ipkon1=ipkon;lakon1=lakon;ne1=ne;
     nodeboun1=nodeboun;ndirboun1=ndirboun;xboun1=xboun;
     nboun1=nboun;ipompc1=ipompc;nodempc1=nodempc;coefmpc1=coefmpc;
     nmpc1=nmpc;nodeforc1=nodeforc;ndirforc1=ndirforc;xforc1=xforc;
     nforc1=nforc;nelemload1=nelemload;sideload1=sideload;xload1=xload;
     nload1=nload;xbody1=xbody;ipobody1=ipobody;nbody1=nbody;
     cgr1=cgr;nactdof1=nactdof;neq1=neq;
     ikmpc1=ikmpc;ilmpc1=ilmpc;ikboun1=ikboun;
     ilboun1=ilboun;elcon1=elcon;nelcon1=nelcon;rhcon1=rhcon;
     nrhcon1=nrhcon;alcon1=alcon;nalcon1=nalcon;alzero1=alzero;
     ielmat1=ielmat;ielorien1=ielorien;norien1=norien;orab1=orab;
     ntmat1_=ntmat_;t01=t0;t11=t1;ithermal1=ithermal;prestr1=prestr;
     iprestr1=iprestr;vold1=vold;iperturb1=iperturb;sti1=sti;
     stx1=stx;iexpl1=iexpl;plicon1=plicon;nplicon1=nplicon;
     plkcon1=plkcon;nplkcon1=nplkcon;xstiff1=xstiff;npmat1_=npmat_;
     dtime1=dtime;matname1=matname;mi1=mi;ncmat1_=ncmat_;mass1=mass;
     stiffness1=stiffness;buckling1=buckling;rhsi1=rhsi;intscheme1=intscheme;
     physcon1=physcon;shcon1=shcon;nshcon1=nshcon;cocon1=cocon;
     ncocon1=ncocon;ttime1=ttime;time1=time;istep1=istep;iinc1=iinc;
     coriolis1=coriolis;ibody1=ibody;xloadold1=xloadold;reltime1=reltime;
     veold1=veold;springarea1=springarea;nstate1_=nstate_;xstateini1=xstateini;
     xstate1=xstate;thicke1=thicke;integerglob1=integerglob;
     doubleglob1=doubleglob;tieset1=tieset;istartset1=istartset;
     iendset1=iendset;ialset1=ialset;ntie1=ntie;nasym1=nasym;
     pslavsurf1=pslavsurf;pmastsurf1=pmastsurf;mortar1=mortar;
     clearini1=clearini;ielprop1=ielprop;prop1=prop;ne01=ne0;
     distmin1=distmin;ndesi1=ndesi;nodedesi1=nodedesi;v1=v;
     nzss1=nzss;jqs1=jqs;irows1=irows;icoordinate1=icoordinate;
     dxstiff1=dxstiff;xdesi1=xdesi;istartelem1=istartelem;ialelem1=ialelem;
     sigma1=sigma;cyclicsymmetry1=cyclicsymmetry;labmpc1=labmpc;
     ics1=ics;cs1=cs;mcs1=mcs;ieigenfrequency1=ieigenfrequency;
 
     /* calculating the stiffness/mass sensitivity */
     
     printf(" Using up to %" ITGFORMAT " cpu(s) for the calculation of the sensitivity of the external forces \n and/or the element stiffness matrices.\n\n", num_cpus);
     
     /* create threads and wait */
     
     NNEW(ithread,ITG,num_cpus);
     for(i=0; i<num_cpus; i++)  {
     ithread[i]=i;
     pthread_create(&tid[i], NULL, (void *)mafillsmsemt, (void *)&ithread[i]);
     }
     for(i=0; i<num_cpus; i++)  pthread_join(tid[i], NULL);
     
     SFREE(ithread);
 
     for(j=0;j<num_cpus;j++){
     if(nmethod1[j]==0){
         *nmethod=0;
         break;
     }
     }
     SFREE(nmethod1);
     
     /* passing of df */
 
     if(!*cyclicsymmetry){
 //  if((iperturb[1]==1)&&(*ieigenfrequency!=1)){
     if(*ieigenfrequency!=1){
 
             /* nonlinear geometric: add df to df from results_se */
 
         for(i=0;i<*nzss;i++){
         df[i]+=df1[i];
         }
     }else{
 
         for(i=0;i<*nzss;i++){
         df[i]=df1[i];
         }
     }
     for(i=0;i<*nzss;i++){
         for(j=1;j<num_cpus;j++){
         df[i]+=df1[i+j**nzss];
         }
     }
     }else{
     for(i=0;i<2**nzss;i++){
         df[i]=df1[i];
     }
     for(i=0;i<2**nzss;i++){
         for(j=1;j<num_cpus;j++){
         df[i]+=df1[i+j*2**nzss];
         }
     }
     }
     SFREE(df1);SFREE(dfl1);
         
         return;
 
 }

◆ mafillsmmt()

void* mafillsmmt ( ITG * i )

                         {
 
     ITG indexad,indexfext,indexadb,nea,neb,nedelta,indexfnext;
     long long indexau,indexaub;
 
     indexad=0;
     indexau=0;
     indexfext=0;
     indexadb=0;
     indexaub=0;
     indexfnext=0;
 
 //    if(*buckling1!=1){
     indexad=*i*neq1[1];
     indexau=(long long)*i*nzs1[2];
 //    }
     if(*rhsi1==1){
     indexfext=*i*neq1[1];
     }
     if(mass1[1]==1){
     indexadb=*i*neq1[1];
     indexaub=(long long)*i*nzs1[1];
     }else if((mass1[0]==1)||(*buckling1==1)){
     indexadb=*i*neq1[0];
     indexaub=(long long)*i*nzs1[0];
     }
     if(nmethod1[0]==4){
     indexfnext=*i*(mi1[1]+1)**nk1;
     }
     
 
     if((*nasym1==0)||(*ithermal1>1)){
 
         /* symmetric mechanical calculations or
            thermal/thermomechanical calculations:
            include contact elements (symmetric
            thermal contributions are not covered by
            mafillsmas.f) */
 
     nedelta=(ITG)floor(*ne1/(double)num_cpus);
     nea=*i*nedelta+1;
     neb=(*i+1)*nedelta;
     if((*i==num_cpus-1)&&(neb<*ne1)) neb=*ne1;
     }else{
 
         /* asymmetric mechanical calculations:
            do not include contact elements */
 
     nedelta=(ITG)floor(*ne01/(double)num_cpus);
     nea=*i*nedelta+1;
     neb=(*i+1)*nedelta;
     if((*i==num_cpus-1)&&(neb<*ne01)) neb=*ne01;
     }
 
 
     FORTRAN(mafillsm,(co1,nk1,kon1,ipkon1,lakon1,ne1,nodeboun1,ndirboun1,
         xboun1,nboun1,
         ipompc1,nodempc1,coefmpc1,nmpc1,nodeforc1,ndirforc1,xforc1,
         nforc1,nelemload1,sideload1,xload1,nload1,xbody1,ipobody1,
         nbody1,cgr1,&ad1[indexad],&au1[indexau],&fext1[indexfext],
         nactdof1,icol1,jq1,irow1,neq1,nzl1,&nmethod1[*i],
         ikmpc1,ilmpc1,ikboun1,ilboun1,
         elcon1,nelcon1,rhcon1,nrhcon1,alcon1,nalcon1,alzero1,ielmat1,
         ielorien1,norien1,orab1,ntmat1_,
         t01,t11,ithermal1,prestr1,iprestr1,vold1,iperturb1,sti1,
         nzs1,stx1,&adb1[indexadb],&aub1[indexaub],iexpl1,plicon1,
             nplicon1,plkcon1,nplkcon1,
         xstiff1,npmat1_,dtime1,matname1,mi1,
             ncmat1_,mass1,stiffness1,buckling1,rhsi1,intscheme1,physcon1,
             shcon1,nshcon1,cocon1,ncocon1,ttime1,time1,istep1,iinc1,coriolis1,
         ibody1,xloadold1,reltime1,veold1,springarea1,nstate1_,
             xstateini1,xstate1,thicke1,integerglob1,doubleglob1,
         tieset1,istartset1,iendset1,ialset1,ntie1,nasym1,pslavsurf1,
         pmastsurf1,mortar1,clearini1,ielprop1,prop1,ne01,
         &fnext1[indexfnext],&nea,&neb,kscale1,iponoel1,inoel1,network1));
 
     return NULL;
 }

◆ mafillsmsemt()

void* mafillsmsemt ( ITG * i )

                           {
 
     ITG indexdf,indexdfl,nea,neb,nedelta;
 
     if(!*cyclicsymmetry1){
     indexdf=*i**nzss1;
     indexdfl=*i*60**ndesi1;
     }else{
     indexdf=*i*2**nzss1;
     indexdfl=*i*120**ndesi1;
     }
 
     nedelta=(ITG)floor(*ne1/(double)num_cpus);
     nea=*i*nedelta+1;
     neb=(*i+1)*nedelta;
     if((*i==num_cpus-1)&&(neb<*ne1)) neb=*ne1;
 
     if(!*cyclicsymmetry1){
     FORTRAN(mafillsmse,(co1,kon1,ipkon1,lakon1,ne1,ipompc1,nodempc1,
         coefmpc1,nmpc1,nelemload1,sideload1,xload1,nload1,xbody1,
         ipobody1,nbody1,cgr1,nactdof1,neq1,&nmethod1[*i],ikmpc1,
         ilmpc1,elcon1,nelcon1,rhcon1,nrhcon1,alcon1,nalcon1,alzero1,
         ielmat1,ielorien1,norien1,orab1,ntmat1_,t01,t11,ithermal1,
         iprestr1,vold1,iperturb1,sti1,stx1,iexpl1,plicon1,nplicon1,
             plkcon1,nplkcon1,xstiff1,npmat1_,dtime1,matname1,mi1,
             ncmat1_,mass1,stiffness1,buckling1,rhsi1,intscheme1,physcon1,
             ttime1,time1,istep1,iinc1,coriolis1,ibody1,xloadold1,
         reltime1,veold1,springarea1,nstate1_,xstateini1,xstate1,
             thicke1,integerglob1,doubleglob1,tieset1,istartset1,iendset1,
         ialset1,ntie1,nasym1,pslavsurf1,pmastsurf1,mortar1,clearini1,
         ielprop1,prop1,ne01,&nea,&neb,distmin1,ndesi1,nodedesi1,
         &df1[indexdf],jqs1,irows1,&dfl1[indexdfl],
         icoordinate1,dxstiff1,xdesi1,istartelem1,ialelem1,v1,sigma1,
             ieigenfrequency1));
     }else{
     FORTRAN(mafillsmcsse,(co1,kon1,ipkon1,lakon1,ne1,ipompc1,nodempc1,
         coefmpc1,nmpc1,nelemload1,sideload1,xload1,nload1,xbody1,
         ipobody1,nbody1,cgr1,nactdof1,neq1,&nmethod1[*i],ikmpc1,
         ilmpc1,elcon1,nelcon1,rhcon1,nrhcon1,alcon1,nalcon1,alzero1,
         ielmat1,ielorien1,norien1,orab1,ntmat1_,t01,t11,ithermal1,
         iprestr1,vold1,iperturb1,sti1,stx1,iexpl1,plicon1,nplicon1,
             plkcon1,nplkcon1,xstiff1,npmat1_,dtime1,matname1,mi1,
             ncmat1_,mass1,stiffness1,buckling1,rhsi1,intscheme1,physcon1,
             ttime1,time1,istep1,iinc1,coriolis1,ibody1,xloadold1,
         reltime1,veold1,springarea1,nstate1_,xstateini1,xstate1,
             thicke1,integerglob1,doubleglob1,tieset1,istartset1,iendset1,
         ialset1,ntie1,nasym1,pslavsurf1,pmastsurf1,mortar1,clearini1,
         ielprop1,prop1,ne01,&nea,&neb,distmin1,ndesi1,nodedesi1,
         &df1[indexdf],jqs1,irows1,&dfl1[indexdfl],
         icoordinate1,dxstiff1,xdesi1,istartelem1,ialelem1,v1,sigma1,
         labmpc1,ics1,cs1,mcs1,nk1,nzss1));
     }
     
         
     return NULL;
 }

◆ mafilltcompmain()

void mafilltcompmain	(	ITG *	nef,
		ITG *	ipnei,
		ITG *	neifa,
		ITG *	neiel,
		double *	vfa,
		double *	xxn,
		double *	area,
		double *	au,
		double *	ad,
		ITG *	jq,
		ITG *	irow,
		ITG *	nzs,
		double *	b,
		double *	vel,
		double *	umel,
		double *	xlet,
		double *	xle,
		double *	gradtfa,
		double *	xxi,
		double *	body,
		double *	volume,
		ITG *	ielfa,
		char *	lakonf,
		ITG *	ifabou,
		ITG *	nbody,
		ITG *	neq,
		double *	dtimef,
		double *	velo,
		double *	veloo,
		double *	cpfa,
		double *	hcfa,
		double *	cvel,
		double *	gradvel,
		double *	xload,
		double *	gammat,
		double *	xrlfa,
		double *	xxj,
		ITG *	nactdohinv,
		double *	a1,
		double *	a2,
		double *	a3,
		double *	flux,
		ITG *	iau6,
		double *	xxni,
		double *	xxnj
	)

                                                             {
 
     ITG i,j;
       
     /* variables for multithreading procedure */
     
     ITG sys_cpus,*ithread=NULL;
     char *env,*envloc,*envsys;
 
     num_cpus = 0;
     sys_cpus=0;
 
     /* explicit user declaration prevails */
 
     envsys=getenv("NUMBER_OF_CPUS");
     if(envsys){
     sys_cpus=atoi(envsys);
     if(sys_cpus<0) sys_cpus=0;
     }
 
     /* automatic detection of available number of processors */
 
     if(sys_cpus==0){
     sys_cpus = getSystemCPUs();
     if(sys_cpus<1) sys_cpus=1;
     }
 
     /* local declaration prevails, if strictly positive */
 
     envloc = getenv("CCX_NPROC_CFD");
     if(envloc){
     num_cpus=atoi(envloc);
     if(num_cpus<0){
         num_cpus=0;
     }else if(num_cpus>sys_cpus){
         num_cpus=sys_cpus;
     }
     
     }
 
     /* else global declaration, if any, applies */
 
     env = getenv("OMP_NUM_THREADS");
     if(num_cpus==0){
     if (env)
         num_cpus = atoi(env);
     if (num_cpus < 1) {
         num_cpus=1;
     }else if(num_cpus>sys_cpus){
         num_cpus=sys_cpus;
     }
     }
 
 // next line is to be inserted in a similar way for all other paralell parts
 
     if(*nef<num_cpus) num_cpus=*nef;
     
     pthread_t tid[num_cpus];
 
     /* calculating the stiffness and/or mass matrix 
        (symmetric part) */
 
     nef1=nef;ipnei1=ipnei;neifa1=neifa;neiel1=neiel;vfa1=vfa;xxn1=xxn;
     area1=area;
     jq1=jq;irow1=irow;nzs1=nzs;vel1=vel;umel1=umel;xlet1=xlet;xle1=xle;
     gradtfa1=gradtfa;xxi1=xxi;body1=body;volume1=volume;
     ielfa1=ielfa;lakonf1=lakonf;ifabou1=ifabou;
     nbody1=nbody;neq1=neq;dtimef1=dtimef;velo1=velo;veloo1=veloo;
     cvfa1=cvfa;hcfa1=hcfa;cvel1=cvel;gradvel1=gradvel;xload1=xload;
     gamma1=gamma;xrlfa1=xrlfa;xxj1=xxj;nactdohinv1=nactdohinv;a11=a1;
     a21=a2;a31=a3;flux1=flux;iau61=iau6;ad1=ad;au1=au;b1=b;xxni1=xxni;
     xxnj1=xxnj;
     
     /* create threads and wait */
     
     NNEW(ithread,ITG,num_cpus);
     for(i=0; i<num_cpus; i++)  {
     ithread[i]=i;
     pthread_create(&tid[i], NULL, (void *)mafilltcompmt, (void *)&ithread[i]);
     }
     for(i=0; i<num_cpus; i++)  pthread_join(tid[i], NULL);
     
     SFREE(ithread);
   
   return;
 
 }

◆ mafilltcompmt()

void* mafilltcompmt ( ITG * i )

                            {
 
     ITG nefa,nefb,nefdelta;
     
 // ceil -> floor
 
     nefdelta=(ITG)floor(*nef1/(double)num_cpus);
     nefa=*i*nefdelta+1;
     nefb=(*i+1)*nefdelta;
 // next line! -> all parallel sections
     if((*i==num_cpus-1)&&(nefb<*nef1)) nefb=*nef1;
           
     FORTRAN(mafilltcomp,(nef1,ipnei1,neifa1,neiel1,vfa1,xxn1,area1,
              au1,ad1,jq1,irow1,nzs1,
              b1,vel1,umel1,xlet1,xle1,gradtfa1,xxi1,
              body1,volume1,ielfa1,lakonf1,ifabou1,
              nbody1,neq1,dtimef1,velo1,veloo1,cvfa1,hcfa1,cvel1,
              gradvel1,xload1,gamma1,xrlfa1,xxj1,nactdohinv1,
              a11,a21,a31,flux1,&nefa,&nefb,iau61,xxni1,xxnj1));
 
     return NULL;
 }

◆ mafilltmain()

void mafilltmain	(	ITG *	nef,
		ITG *	ipnei,
		ITG *	neifa,
		ITG *	neiel,
		double *	vfa,
		double *	xxn,
		double *	area,
		double *	au,
		double *	ad,
		ITG *	jq,
		ITG *	irow,
		ITG *	nzs,
		double *	b,
		double *	vel,
		double *	umel,
		double *	xlet,
		double *	xle,
		double *	gradtfa,
		double *	xxi,
		double *	body,
		double *	volume,
		ITG *	ielfa,
		char *	lakonf,
		ITG *	ifabou,
		ITG *	nbody,
		ITG *	neq,
		double *	dtimef,
		double *	velo,
		double *	veloo,
		double *	cpfa,
		double *	hcfa,
		double *	cvel,
		double *	gradvel,
		double *	xload,
		double *	gammat,
		double *	xrlfa,
		double *	xxj,
		ITG *	nactdohinv,
		double *	a1,
		double *	a2,
		double *	a3,
		double *	flux,
		ITG *	iau6,
		double *	xxni,
		double *	xxnj,
		ITG *	iturbulent
	)

                                {
 
     ITG i,j;
       
     /* variables for multithreading procedure */
     
     ITG sys_cpus,*ithread=NULL;
     char *env,*envloc,*envsys;
 
     num_cpus = 0;
     sys_cpus=0;
 
     /* explicit user declaration prevails */
 
     envsys=getenv("NUMBER_OF_CPUS");
     if(envsys){
     sys_cpus=atoi(envsys);
     if(sys_cpus<0) sys_cpus=0;
     }
 
     /* automatic detection of available number of processors */
 
     if(sys_cpus==0){
     sys_cpus = getSystemCPUs();
     if(sys_cpus<1) sys_cpus=1;
     }
 
     /* local declaration prevails, if strictly positive */
 
     envloc = getenv("CCX_NPROC_CFD");
     if(envloc){
     num_cpus=atoi(envloc);
     if(num_cpus<0){
         num_cpus=0;
     }else if(num_cpus>sys_cpus){
         num_cpus=sys_cpus;
     }
     
     }
 
     /* else global declaration, if any, applies */
 
     env = getenv("OMP_NUM_THREADS");
     if(num_cpus==0){
     if (env)
         num_cpus = atoi(env);
     if (num_cpus < 1) {
         num_cpus=1;
     }else if(num_cpus>sys_cpus){
         num_cpus=sys_cpus;
     }
     }
 
 // next line is to be inserted in a similar way for all other paralell parts
 
     if(*nef<num_cpus) num_cpus=*nef;
     
     pthread_t tid[num_cpus];
 
     /* calculating the stiffness and/or mass matrix 
        (symmetric part) */
 
     nef1=nef;ipnei1=ipnei;neifa1=neifa;neiel1=neiel;vfa1=vfa;xxn1=xxn;
     area1=area;
     jq1=jq;irow1=irow;nzs1=nzs;vel1=vel;umel1=umel;xlet1=xlet;xle1=xle;
     gradtfa1=gradtfa;xxi1=xxi;body1=body;volume1=volume;
     ielfa1=ielfa;lakonf1=lakonf;ifabou1=ifabou;
     nbody1=nbody;neq1=neq;dtimef1=dtimef;velo1=velo;veloo1=veloo;
     cvfa1=cvfa;hcfa1=hcfa;cvel1=cvel;gradvel1=gradvel;xload1=xload;
     gamma1=gamma;xrlfa1=xrlfa;xxj1=xxj;nactdohinv1=nactdohinv;a11=a1;
     a21=a2;a31=a3;flux1=flux;iau61=iau6;ad1=ad;au1=au;b1=b;xxni1=xxni;
     xxnj1=xxnj;iturbulent1=iturbulent;
     
     /* create threads and wait */
     
     NNEW(ithread,ITG,num_cpus);
     for(i=0; i<num_cpus; i++)  {
     ithread[i]=i;
     pthread_create(&tid[i], NULL, (void *)mafilltmt, (void *)&ithread[i]);
     }
     for(i=0; i<num_cpus; i++)  pthread_join(tid[i], NULL);
     
     SFREE(ithread);
   
   return;
 
 }

◆ mafilltmt()

void* mafilltmt ( ITG * i )

                        {
 
     ITG nefa,nefb,nefdelta;
     
 // ceil -> floor
 
     nefdelta=(ITG)floor(*nef1/(double)num_cpus);
     nefa=*i*nefdelta+1;
     nefb=(*i+1)*nefdelta;
 // next line! -> all parallel sections
     if((*i==num_cpus-1)&&(nefb<*nef1)) nefb=*nef1;
           
     FORTRAN(mafillt,(nef1,ipnei1,neifa1,neiel1,vfa1,xxn1,area1,
              au1,ad1,jq1,irow1,nzs1,
              b1,vel1,umel1,xlet1,xle1,gradtfa1,xxi1,
              body1,volume1,ielfa1,lakonf1,ifabou1,
              nbody1,neq1,dtimef1,velo1,veloo1,cvfa1,hcfa1,cvel1,
              gradvel1,xload1,gamma1,xrlfa1,xxj1,nactdohinv1,
                  a11,a21,a31,flux1,&nefa,&nefb,iau61,xxni1,xxnj1,
                          iturbulent1));
 
     return NULL;
 }

◆ mafillv0mt()

void* mafillv0mt ( ITG * i )

◆ mafillv1mt()

void* mafillv1mt ( ITG * i )

◆ mafillv2mt()

void* mafillv2mt ( ITG * i )

◆ mafillv3mt()

void* mafillv3mt ( ITG * i )

◆ mafillvcompmain()

void mafillvcompmain	(	ITG *	nef,
		ITG *	ipnei,
		ITG *	neifa,
		ITG *	neiel,
		double *	vfa,
		double *	xxn,
		double *	area,
		double *	au,
		double *	ad,
		ITG *	jq,
		ITG *	irow,
		ITG *	nzs,
		double *	b,
		double *	vel,
		double *	cosa,
		double *	umfa,
		double *	xlet,
		double *	xle,
		double *	gradvfa,
		double *	xxi,
		double *	body,
		double *	volume,
		ITG *	ielfa,
		char *	lakonf,
		ITG *	ifabou,
		ITG *	nbody,
		double *	dtimef,
		double *	velo,
		double *	veloo,
		double *	sel,
		double *	xrlfa,
		double *	gamma,
		double *	xxj,
		ITG *	nactdohinv,
		double *	a1,
		double *	a2,
		double *	a3,
		double *	flux,
		ITG *	icyclic,
		double *	c,
		ITG *	ifatie,
		ITG *	iau6,
		double *	xxni,
		double *	xxnj
	)

                           {
 
     ITG i,j;
       
     /* variables for multithreading procedure */
     
     ITG sys_cpus,*ithread=NULL;
     char *env,*envloc,*envsys;
 
 //    printf("entered mafillvcompmain \n");
 
     num_cpus = 0;
     sys_cpus=0;
 
     /* explicit user declaration prevails */
 
     envsys=getenv("NUMBER_OF_CPUS");
     if(envsys){
     sys_cpus=atoi(envsys);
     if(sys_cpus<0) sys_cpus=0;
     }
 
     /* automatic detection of available number of processors */
 
     if(sys_cpus==0){
     sys_cpus = getSystemCPUs();
     if(sys_cpus<1) sys_cpus=1;
     }
 
     /* local declaration prevails, if strictly positive */
 
     envloc = getenv("CCX_NPROC_CFD");
     if(envloc){
     num_cpus=atoi(envloc);
     if(num_cpus<0){
         num_cpus=0;
     }else if(num_cpus>sys_cpus){
         num_cpus=sys_cpus;
     }
     
     }
 
     /* else global declaration, if any, applies */
 
     env = getenv("OMP_NUM_THREADS");
     if(num_cpus==0){
     if (env)
         num_cpus = atoi(env);
     if (num_cpus < 1) {
         num_cpus=1;
     }else if(num_cpus>sys_cpus){
         num_cpus=sys_cpus;
     }
     }
 
 // next line is to be inserted in a similar way for all other paralell parts
 
     if(*nef<num_cpus) num_cpus=*nef;
     
     pthread_t tid[num_cpus];
 
     /* calculating the stiffness and/or mass matrix 
        (symmetric part) */
 
     nef1=nef;ipnei1=ipnei;neifa1=neifa;neiel1=neiel;vfa1=vfa;xxn1=xxn;
     area1=area;jq1=jq;irow1=irow;nzs1=nzs;vel1=vel;cosa1=cosa;umfa1=umfa;
     xlet1=xlet;xle1=xle;gradvfa1=gradvfa;xxi1=xxi;body1=body;volume1=volume;
     ielfa1=ielfa;lakonf1=lakonf;ifabou1=ifabou;nbody1=nbody;
     dtimef1=dtimef;velo1=velo;veloo1=veloo;sel1=sel;xrlfa1=xrlfa;
     gamma1=gamma;xxj1=xxj;nactdohinv1=nactdohinv;a11=a1;a21=a2;a31=a3;
     flux1=flux;icyclic1=icyclic;c1=c;ifatie1=ifatie;iau61=iau6;
     adv1=adv;auv1=auv;bv1=bv;xxni1=xxni;xxnj1=xxnj;
 
     /* create threads and wait */
     
     NNEW(ithread,ITG,num_cpus);
     for(i=0; i<num_cpus; i++)  {
     ithread[i]=i;
     pthread_create(&tid[i], NULL, (void *)mafillvcompmt, (void *)&ithread[i]);
     }
     for(i=0; i<num_cpus; i++)  pthread_join(tid[i], NULL);
     
     SFREE(ithread);
   
   return;
 
 }

◆ mafillvcompmt()

void* mafillvcompmt ( ITG * i )

                            {
 
     ITG nefa,nefb,nefdelta;
     
 // ceil -> floor
 
     nefdelta=(ITG)floor(*nef1/(double)num_cpus);
     nefa=*i*nefdelta+1;
     nefb=(*i+1)*nefdelta;
 // next line! -> all parallel sections
     if((*i==num_cpus-1)&&(nefb<*nef1)) nefb=*nef1;
 
     FORTRAN(mafillvcomp,(nef1,ipnei1,neifa1,neiel1,vfa1,xxn1,area1,
         auv1,adv1,jq1,irow1,nzs1,bv1,
             vel1,cosa1,umfa1,xlet1,xle1,gradvfa1,xxi1,
         body1,volume1,ielfa1,lakonf1,ifabou1,nbody1,
         dtimef1,velo1,veloo1,sel1,xrlfa1,gamma1,xxj1,nactdohinv1,a11,
         a21,a31,flux1,&nefa,&nefb,icyclic1,c1,ifatie1,iau61,
             xxni1,xxnj1));
 
     return NULL;
 }

◆ mafillvmain()

void mafillvmain	(	ITG *	nef,
		ITG *	ipnei,
		ITG *	neifa,
		ITG *	neiel,
		double *	vfa,
		double *	xxn,
		double *	area,
		double *	au,
		double *	ad,
		ITG *	jq,
		ITG *	irow,
		ITG *	nzs,
		double *	b,
		double *	vel,
		double *	cosa,
		double *	umfa,
		double *	xlet,
		double *	xle,
		double *	gradvfa,
		double *	xxi,
		double *	body,
		double *	volume,
		ITG *	ielfa,
		char *	lakonf,
		ITG *	ifabou,
		ITG *	nbody,
		double *	dtimef,
		double *	velo,
		double *	veloo,
		double *	sel,
		double *	xrlfa,
		double *	gamma,
		double *	xxj,
		ITG *	nactdohinv,
		double *	a1,
		double *	a2,
		double *	a3,
		double *	flux,
		ITG *	icyclic,
		double *	c,
		ITG *	ifatie,
		ITG *	iau6,
		double *	xxni,
		double *	xxnj,
		ITG *	iturbulent,
		double *	gradvel
	)

                                                                    {
 
     ITG i,j;
       
     /* variables for multithreading procedure */
     
     ITG sys_cpus,*ithread=NULL;
     char *env,*envloc,*envsys;
 
     num_cpus = 0;
     sys_cpus=0;
 
     /* explicit user declaration prevails */
 
     envsys=getenv("NUMBER_OF_CPUS");
     if(envsys){
     sys_cpus=atoi(envsys);
     if(sys_cpus<0) sys_cpus=0;
     }
 
     /* automatic detection of available number of processors */
 
     if(sys_cpus==0){
     sys_cpus = getSystemCPUs();
     if(sys_cpus<1) sys_cpus=1;
     }
 
     /* local declaration prevails, if strictly positive */
 
     envloc = getenv("CCX_NPROC_CFD");
     if(envloc){
     num_cpus=atoi(envloc);
     if(num_cpus<0){
         num_cpus=0;
     }else if(num_cpus>sys_cpus){
         num_cpus=sys_cpus;
     }
     
     }
 
     /* else global declaration, if any, applies */
 
     env = getenv("OMP_NUM_THREADS");
     if(num_cpus==0){
     if (env)
         num_cpus = atoi(env);
     if (num_cpus < 1) {
         num_cpus=1;
     }else if(num_cpus>sys_cpus){
         num_cpus=sys_cpus;
     }
     }
 
 // next line is to be inserted in a similar way for all other paralell parts
 
     if(*nef<num_cpus) num_cpus=*nef;
     
     pthread_t tid[num_cpus];
 
     /* calculating the stiffness and/or mass matrix 
        (symmetric part) */
 
     nef1=nef;ipnei1=ipnei;neifa1=neifa;neiel1=neiel;vfa1=vfa;xxn1=xxn;
     area1=area;jq1=jq;irow1=irow;nzs1=nzs;vel1=vel;cosa1=cosa;umfa1=umfa;
     xlet1=xlet;xle1=xle;gradvfa1=gradvfa;xxi1=xxi;body1=body;volume1=volume;
     ielfa1=ielfa;lakonf1=lakonf;ifabou1=ifabou;nbody1=nbody;
     dtimef1=dtimef;velo1=velo;veloo1=veloo;sel1=sel;xrlfa1=xrlfa;
     gamma1=gamma;xxj1=xxj;nactdohinv1=nactdohinv;a11=a1;a21=a2;a31=a3;
     flux1=flux;icyclic1=icyclic;c1=c;ifatie1=ifatie;iau61=iau6;
     adv1=adv;auv1=auv;bv1=bv;xxni1=xxni;xxnj1=xxnj;iturbulent1=iturbulent;
     gradvel1=gradvel;
     
     /* create threads and wait */
     
     NNEW(ithread,ITG,num_cpus);
     for(i=0; i<num_cpus; i++)  {
     ithread[i]=i;
     pthread_create(&tid[i], NULL, (void *)mafillvmt, (void *)&ithread[i]);
     }
     for(i=0; i<num_cpus; i++)  pthread_join(tid[i], NULL);
     
     SFREE(ithread);
   
   return;
 
 }

◆ mafillvmt()

void* mafillvmt ( ITG * i )

                        {
 
     ITG nefa,nefb,nefdelta;
     
 // ceil -> floor
 
     nefdelta=(ITG)floor(*nef1/(double)num_cpus);
     nefa=*i*nefdelta+1;
     nefb=(*i+1)*nefdelta;
 // next line! -> all parallel sections
     if((*i==num_cpus-1)&&(nefb<*nef1)) nefb=*nef1;
 
     FORTRAN(mafillv,(nef1,ipnei1,neifa1,neiel1,vfa1,xxn1,area1,
         auv1,adv1,jq1,irow1,nzs1,bv1,
             vel1,cosa1,umfa1,xlet1,xle1,gradvfa1,xxi1,
         body1,volume1,ielfa1,lakonf1,ifabou1,nbody1,
         dtimef1,velo1,veloo1,sel1,xrlfa1,gamma1,xxj1,nactdohinv1,
             a11,a21,a31,flux1,&nefa,&nefb,icyclic1,c1,ifatie1,iau61,
              xxni1,xxnj1,iturbulent1,gradvel1));
 
     return NULL;
 }

◆ mastruct()

void mastruct	(	ITG *	nk,
		ITG *	kon,
		ITG *	ipkon,
		char *	lakon,
		ITG *	ne,
		ITG *	nodeboun,
		ITG *	ndirboun,
		ITG *	nboun,
		ITG *	ipompc,
		ITG *	nodempc,
		ITG *	nmpc,
		ITG *	nactdof,
		ITG *	icol,
		ITG *	jq,
		ITG **	mast1p,
		ITG **	irowp,
		ITG *	isolver,
		ITG *	neq,
		ITG *	ikmpc,
		ITG *	ilmpc,
		ITG *	ipointer,
		ITG *	nzs,
		ITG *	nmethod,
		ITG *	ithermal,
		ITG *	ikboun,
		ITG *	ilboun,
		ITG *	iperturb,
		ITG *	mi,
		ITG *	mortar,
		char *	typeboun,
		char *	labmpc,
		ITG *	iit,
		ITG *	icascade,
		ITG *	network
	)

                                                                  {
 
   /* determines the structure of the thermo-mechanical matrices;
      (i.e. the location of the nonzeros */
 
   char lakonl[2]=" \0",lakonl2[3]="  \0";
 
   ITG i,j,k,l,jj,ll,id,index,jdof1,jdof2,idof1,idof2,mpc1,mpc2,id1,id2,
     ist1,ist2,node1,node2,isubtract,nmast,ifree,istart,istartold,
     index1,index2,m,node,nzs_,ist,kflag,indexe,nope,isize,*mast1=NULL,
     *irow=NULL,icolumn,nmastboun,mt=mi[1]+1,jmax,*next=NULL,nopeold=0,
     indexeold,identical,jstart,iatleastonenonzero,idof,ndof;
 
   /* the indices in the comments follow FORTRAN convention, i.e. the
      fields start with 1 */
 
   mast1=*mast1p;
   irow=*irowp;
 
   kflag=1;
 
   /* determining nactdof (only at start of step or if MPC's
      changed */
 
   if((*iit<0)||(*icascade!=0)){
 
       /* initialisation of nactdof */
       
       for(i=0;i<mt**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;
           if(strcmp1(&lakon[8*i],"F")==0)continue;
           indexe=ipkon[i];
 /* Bernhardi start */
           if (strcmp1(&lakon[8*i+3],"8I")==0){nope=11;ndof=3;}
           else if(strcmp1(&lakon[8*i+3],"20")==0){nope=20;ndof=3;}
 /* Bernhardi end */
           else if (strcmp1(&lakon[8*i+3],"8")==0){nope=8;ndof=3;}
           else if (strcmp1(&lakon[8*i+3],"10")==0){nope=10;ndof=3;}
           else if ((strcmp1(&lakon[8*i+3],"4")==0)||
                (strcmp1(&lakon[8*i+2],"4")==0)){nope=4;ndof=3;}
           else if (strcmp1(&lakon[8*i+3],"15")==0){nope=15;ndof=3;}
           else if (strcmp1(&lakon[8*i+3],"6")==0){nope=6;ndof=3;}
           else if (strcmp1(&lakon[8*i],"E")==0){
           if((strcmp1(&lakon[8*i+6],"C")==0)&&(*mortar==1)){
 
                       /* face-to-face contact (all nodes already belong
                          to other elements */
 
               continue;
           }else if(strcmp1(&lakon[8*i+6],"F")!=0){
 
                       /* node-to-face contact */
 
               lakonl[0]=lakon[8*i+7];
               nope=atoi(lakonl)+1;
               ndof=3;
           }else{
 
                       /* advection elements */
 
               continue;
           }
           }else if(strcmp1(&lakon[8*i],"U")==0){
 
                   /* user element
              number of dofs: 7th entry of label
              number of nodes: 8th entry of label */
 
           ndof=lakon[8*i+6];
           nope=lakon[8*i+7];
 /*        strcpy1(&lakonl2[0],&lakon[8*i+6],2);
           nope=atoi(lakonl2);
           lakonl[0]=lakon[8*i+5];
           ndof=atoi(lakonl);*/
           }else continue;
           
           /* displacement degrees of freedom */
           
           for(j=0;j<nope;++j){
           node=kon[indexe+j]-1;
           for(k=1;k<=ndof;++k){
               nactdof[mt*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;
           if(strcmp1(&lakon[8*i],"F")==0)continue;
           indexe=ipkon[i];
           if(strcmp1(&lakon[8*i+3],"20")==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 if (strcmp1(&lakon[8*i+3],"6")==0)nope=6;
           else if (strcmp1(&lakon[8*i],"E")==0){
           if((strcmp1(&lakon[8*i+6],"C")==0)&&(*mortar==1)){
               continue;
           }else{
               lakonl[0]=lakon[8*i+7];
               nope=atoi(lakonl)+1;
           }
           }else if ((strcmp1(&lakon[8*i],"D ")==0)||
                         ((strcmp1(&lakon[8*i],"D")==0)&&(*network==1))){
           
           /* check for entry or exit element */
           
           if((kon[indexe]==0)||(kon[indexe+2]==0)) continue;
           
           /* generic network element */
           
           for(j=0;j<3;j=j+2){
               node=kon[indexe+j]-1;
               nactdof[mt*node]=1;
           }
           continue;}
           else continue;
           
           for(j=0;j<nope;++j){
           node=kon[indexe+j]-1;
           nactdof[mt*node]=1;
           }
       }
       }
       
       /* determining the active degrees of freedom due to mpc's */
       
       for(i=0;i<*nmpc;++i){
       if (strcmp1(&labmpc[20*i],"FLUID")==0) continue;
 
       iatleastonenonzero=0;
 
       index=ipompc[i]-1;
       do{
           if(nodempc[3*index+1]<4){
           idof=mt*(nodempc[3*index]-1)+nodempc[3*index+1];
           if(nactdof[idof]==1){
               iatleastonenonzero=1;
           }else{
               nactdof[idof]=1;
           }
           }
           index=nodempc[3*index+2];
           if(index==0) break;
           index--;
       }while(1);
 
       if(iatleastonenonzero==1) continue;
 
           /* if all dofs in the MPC were inactive, keep then inactive
              (may e.g. belong to network elements) */
 
       index=ipompc[i]-1;
       do{
           if(nodempc[3*index+1]<4){
           nactdof[mt*(nodempc[3*index]-1)+nodempc[3*index+1]]=0;
           }
           index=nodempc[3*index+2];
           if(index==0) break;
           index--;
       }while(1);
 
       }
       
       /* subtracting the SPC and MPC nodes */
       
       for(i=0;i<*nboun;++i){
       if(ndirboun[i]>mi[1]) continue;
       if (strcmp1(&typeboun[i],"F")==0) continue;
       nactdof[mt*(nodeboun[i]-1)+ndirboun[i]]=-2*(i+1);
       }
       
       for(i=0;i<*nmpc;++i){
       if (strcmp1(&labmpc[20*i],"FLUID")==0) continue;
       index=ipompc[i]-1;
       if(nodempc[3*index+1]>mi[1]) continue;
       nactdof[mt*(nodempc[3*index]-1)+nodempc[3*index+1]]=-2*i-1;
       }
       
       /* numbering the active degrees of freedom */
       
       neq[0]=0;
       for(i=0;i<*nk;++i){
       for(j=1;j<mt;++j){
           if(nactdof[mt*i+j]>0){
           if((*ithermal<2)||(*ithermal>=3)){
               ++neq[0];
               nactdof[mt*i+j]=neq[0];
           }
           else{
               nactdof[mt*i+j]=0;
           }
           }
       }
       }
       neq[1]=neq[0];
       for(i=0;i<*nk;++i){
       if(nactdof[mt*i]>0){
           if(*ithermal>1){
           ++neq[1];
           nactdof[mt*i]=neq[1];
           }
           else{
           nactdof[mt*i]=0;
           }
       }
       }
       if((*nmethod==2)||((*nmethod==4)&&(*iperturb<=1))||((*nmethod>=5)&&(*nmethod<=7))){
       neq[2]=neq[1]+*nboun;
       }
       else{neq[2]=neq[1];}
   }
   
   /* determining the subdiagonal nonzeros in the stiffness/mass matrix */
 
   ifree=0;
   nzs_=nzs[1];
   NNEW(next,ITG,nzs_);
 
     /* determining the position of each nonzero matrix element in
        the SUBdiagonal matrix (excluding diagonal): x-elements on
        the left of the vertical line */
 
 //               |x x x
 //        x      |x x x
 //        x x    |x x x
 //        x x x  |x x x
 
     /*   mast1(ipointer(i)) = first nonzero row in column i
      next(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)){
 
     indexeold=0;
 
     for(i=0;i<*ne;++i){
       
       if(ipkon[i]<0) continue;
       if(strcmp1(&lakon[8*i],"F")==0)continue;
       indexe=ipkon[i];
 /* Bernhardi start */
       if (strcmp1(&lakon[8*i+3],"8I")==0){nope=11;ndof=3;}
       else if(strcmp1(&lakon[8*i+3],"20")==0){nope=20;ndof=3;}
 /* Bernhardi end */
       else if (strcmp1(&lakon[8*i+3],"8")==0){nope=8;ndof=3;}
       else if (strcmp1(&lakon[8*i+3],"10")==0){nope=10;ndof=3;}
       else if (strcmp1(&lakon[8*i+3],"4")==0){nope=4;ndof=3;}
       else if (strcmp1(&lakon[8*i+3],"15")==0){nope=15;ndof=3;}
       else if (strcmp1(&lakon[8*i+3],"6")==0){nope=6;ndof=3;}
       else if (strcmp1(&lakon[8*i],"E")==0){
       if((strcmp1(&lakon[8*i+6],"C")==0)&&(*mortar==1)){
           nope=kon[indexe-1];
           if(nope==nopeold){
           identical=1;
           for(j=0;j<nope;j++){
               if(kon[indexe+j]!=kon[indexeold+j]){
               identical=0;
               break;
               }
           }
           if(identical==1)continue;
           }
           nopeold=nope;
           indexeold=indexe;
           ndof=3;
       }else{
           lakonl[0]=lakon[8*i+7];
           nope=atoi(lakonl)+1;
           ndof=3;
       }
       }else if(strcmp1(&lakon[8*i],"U")==0){
       
       /* user element
          number of dofs: 7th entry of label
          number of nodes: 8th entry of label */
       
       ndof=lakon[8*i+6];
       nope=lakon[8*i+7];
       }else continue;
       
       for(jj=0;jj<ndof*nope;++jj){
     
     j=jj/ndof;
     k=jj-ndof*j;
     
     node1=kon[indexe+j];
     jdof1=nactdof[mt*(node1-1)+k+1];
     
     for(ll=jj;ll<ndof*nope;++ll){
       
       l=ll/ndof;
       m=ll-ndof*l;
       
       node2=kon[indexe+l];
       jdof2=nactdof[mt*(node2-1)+m+1];
       
       /* check whether one of the DOF belongs to a SPC or MPC */
       
       if((jdof1>0)&&(jdof2>0)){
         insert(ipointer,&mast1,&next,&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=jdof1;}
         else{
           idof1=jdof1;
           idof2=jdof2;}
         
         if(*nmpc>0){
           
           if(idof2!=2*(idof2/2)){
         
         /* regular DOF / MPC */
         
         id=(-idof2+1)/2;
         ist=ipompc[id-1];
         index=nodempc[3*ist-1];
         if(index==0) continue;
         while(1){
             idof2=nactdof[mt*(nodempc[3*index-3]-1)+nodempc[3*index-2]];
           if(idof2>0){
             insert(ipointer,&mast1,&next,&idof1,&idof2,&ifree,&nzs_);
           }
           index=nodempc[3*index-1];
           if(index==0) break;
         }
         continue;
           }
         }
 
             /* regular DOF/SPC */
 
             /* boundary stiffness coefficients (for frequency
                and modal dynamic calculations) : x-elements
                on the right of the vertical line */
 
 //               |x x x
 //        x      |x x x
 //        x x    |x x x
 //        x x x  |x x x
 
         if((*nmethod==2)||((*nmethod==4)&&(*iperturb<=1))||((*nmethod>=5)&&(*nmethod<=7))){
         icolumn=neq[1]-idof2/2;
             insertfreq(ipointer,&mast1,&next,&idof1,&icolumn,&ifree,&nzs_);
         }
       }
       
       else{
         idof1=jdof1;
         idof2=jdof2;
         mpc1=0;
         mpc2=0;
         if(*nmpc>0){
         if(idof1!=2*(idof1/2)) mpc1=1;
         if(idof2!=2*(idof2/2)) mpc2=1;
         }
         if((mpc1==1)&&(mpc2==1)){
           id1=(-idof1+1)/2;
           id2=(-idof2+1)/2;
           if(id1==id2){
         
         /* MPC id1 / MPC id1 */
         
         ist=ipompc[id1-1];
         index1=nodempc[3*ist-1];
         if(index1==0) continue;
         while(1){
             idof1=nactdof[mt*(nodempc[3*index1-3]-1)+nodempc[3*index1-2]];
           index2=index1;
           while(1){
               idof2=nactdof[mt*(nodempc[3*index2-3]-1)+nodempc[3*index2-2]];
             if((idof1>0)&&(idof2>0)){
               insert(ipointer,&mast1,&next,&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[mt*(nodempc[3*index1-3]-1)+nodempc[3*index1-2]];
           ist2=ipompc[id2-1];
           index2=nodempc[3*ist2-1];
           if(index2==0){
             index1=nodempc[3*index1-1];
             if(index1==0){break;}
             else{continue;}
           }
           while(1){
               idof2=nactdof[mt*(nodempc[3*index2-3]-1)+nodempc[3*index2-2]];
             if((idof1>0)&&(idof2>0)){
               insert(ipointer,&mast1,&next,&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){
 
     indexeold=0;
 
     for(i=0;i<*ne;++i){
       
       if(ipkon[i]<0) continue;
       if(strcmp1(&lakon[8*i],"F")==0)continue;
       indexe=ipkon[i];
       if(strcmp1(&lakon[8*i+3],"20")==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 if (strcmp1(&lakon[8*i+3],"6")==0)nope=6;
       else if (strcmp1(&lakon[8*i],"E")==0){
       if((strcmp1(&lakon[8*i+6],"C")==0)&&(*mortar==1)){
           nope=kon[indexe-1];
           if(nope==nopeold){
           identical=1;
           for(j=0;j<nope;j++){
               if(kon[indexe+j]!=kon[indexeold+j]){
               identical=0;
               break;
               }
           }
           if(identical==1)continue;
           }
           nopeold=nope;
           indexeold=indexe;
       }else{
           lakonl[0]=lakon[8*i+7];
           nope=atoi(lakonl)+1;
       }
       }else if ((strcmp1(&lakon[8*i],"D ")==0)||
                 ((strcmp1(&lakon[8*i],"D")==0)&&(*network==1))){
 
       /* check for entry or exit element */
 
       if((kon[indexe]==0)||(kon[indexe+2]==0)) continue;
       nope=3;}
       else continue;
       
       for(jj=0;jj<nope;++jj){
     
     j=jj;
     
     node1=kon[indexe+j];
     jdof1=nactdof[mt*(node1-1)];
     
     for(ll=jj;ll<nope;++ll){
       
       l=ll;
       
       node2=kon[indexe+l];
       jdof2=nactdof[mt*(node2-1)];
       
       /* check whether one of the DOF belongs to a SPC or MPC */
       
       if((jdof1>0)&&(jdof2>0)){
         insert(ipointer,&mast1,&next,&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=jdof1;}
         else{
           idof1=jdof1;
           idof2=jdof2;}
         
         if(*nmpc>0){
           
           if(idof2!=2*(idof2/2)){
         
         /* regular DOF / MPC */
         
         id=(-idof2+1)/2;
         ist=ipompc[id-1];
         index=nodempc[3*ist-1];
         if(index==0) continue;
         while(1){
             idof2=nactdof[mt*(nodempc[3*index-3]-1)+nodempc[3*index-2]];
           if(idof2>0){
             insert(ipointer,&mast1,&next,&idof1,&idof2,&ifree,&nzs_);
           }
           index=nodempc[3*index-1];
           if(index==0) break;
         }
         continue;
           }
         }
 
             /* regular DOF/SPC */
 
             /* boundary stiffness coefficients (for frequency and
                modal dynamic calculations */
 
         if((*nmethod==2)||((*nmethod==4)&&(*iperturb<=1))||((*nmethod>=5)&&(*nmethod<=7))){
         icolumn=neq[1]-idof2/2;
         insertfreq(ipointer,&mast1,&next,&idof1,&icolumn,&ifree,&nzs_);
         }
 
       }
       
       else{
         idof1=jdof1;
         idof2=jdof2;
         mpc1=0;
         mpc2=0;
         if(*nmpc>0){
         if(idof1!=2*(idof1/2)) mpc1=1;
         if(idof2!=2*(idof2/2)) mpc2=1;
         }
         if((mpc1==1)&&(mpc2==1)){
           id1=(-idof1+1)/2;
           id2=(-idof2+1)/2;
           if(id1==id2){
         
         /* MPC id1 / MPC id1 */
         
         ist=ipompc[id1-1];
         index1=nodempc[3*ist-1];
         if(index1==0) continue;
         while(1){
             idof1=nactdof[mt*(nodempc[3*index1-3]-1)+nodempc[3*index1-2]];
           index2=index1;
           while(1){
               idof2=nactdof[mt*(nodempc[3*index2-3]-1)+nodempc[3*index2-2]];
             if((idof1>0)&&(idof2>0)){
               insert(ipointer,&mast1,&next,&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[mt*(nodempc[3*index1-3]-1)+nodempc[3*index1-2]];
           ist2=ipompc[id2-1];
           index2=nodempc[3*ist2-1];
           if(index2==0){
             index1=nodempc[3*index1-1];
             if(index1==0){break;}
             else{continue;}
           }
           while(1){
               idof2=nactdof[mt*(nodempc[3*index2-3]-1)+nodempc[3*index2-2]];
             if((idof1>0)&&(idof2>0)){
               insert(ipointer,&mast1,&next,&idof1,&idof2,&ifree,&nzs_);}
             index2=nodempc[3*index2-1];
             if(index2==0) break;
           }
           index1=nodempc[3*index1-1];
           if(index1==0) break;
         }
           }
         }
       }
     }
       }
     }
 
     }
 
     if(neq[1]==0){
       printf("\n *WARNING: no degrees of freedom in the model\n\n");
     }
 
     /*   determination of the following fields:       
 
        - irow: row numbers, column per column
        - icol(i)=# SUBdiagonal nonzero's in column i
        - jq(i)= location in field irow of the first SUBdiagonal
          nonzero in column i  */
 
     /* subdiagonal elements of the regular stiffness/mass matrices
        (marked by X underneath) */ 
 
 //               |x x x
 //        X      |x x x
 //        X X    |x x x
 //        X X X  |x x x
 
     RENEW(irow,ITG,ifree);
     nmast=0;
     jq[0]=1;
     for(i=0;i<neq[1];i++){
     index=ipointer[i];
     do{
         if(index==0) break;
         irow[nmast++]=mast1[index-1];
         index=next[index-1];
     }while(1);
     jq[i+1]=nmast+1;
     }
 
     /* sorting the row numbers within each column */
 
     for(i=0;i<neq[1];++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));
     }
     }
 
     /* removing duplicate entries */
 
     nmast=0;
     for(i=0;i<neq[1];i++){
     jstart=nmast+1;
     if(jq[i+1]-jq[i]>0){
         irow[nmast++]=irow[jq[i]-1];
         for(j=jq[i];j<jq[i+1]-1;j++){
         if(irow[j]==irow[nmast-1])continue;
         irow[nmast++]=irow[j];
         }
     }
     jq[i]=jstart;
     }
     jq[neq[1]]=nmast+1;
 
     for(i=0;i<neq[1];i++){
     icol[i]=jq[i+1]-jq[i];
     }
 
     if(neq[0]==0){nzs[0]=0;}
     else{nzs[0]=jq[neq[0]]-1;}
     nzs[1]=jq[neq[1]]-1;
 
     /* summary */
 
     printf(" number of equations\n");
     printf(" %" ITGFORMAT "\n",neq[1]);
     printf(" number of nonzero lower triangular matrix elements\n");
     printf(" %" ITGFORMAT "\n",nmast);
     printf("\n");
 
     /* determining irow, jq and icol for the boundary stiffness matrix (only
        for frequency and modal dynamic calculations) 
        (entries marked by X underneath) */
 
 //               |X X X
 //        x      |X X X
 //        x x    |X X X
 //        x x x  |X X X
 
     if((*nmethod==2)||((*nmethod==4)&&(*iperturb<=1))||((*nmethod>=5)&&(*nmethod<=7))){
 
     nmastboun=nmast;
     for(i=neq[1];i<neq[2];i++){
         index=ipointer[i];
         do{
         if(index==0) break;
         irow[nmastboun++]=mast1[index-1];
         index=next[index-1];
         }while(1);
         jq[i+1]=nmastboun+1;
     }
 
     /* sorting the row numbers within each column */
 
     for(i=neq[1];i<neq[2];++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));
         }
     }
 
     /* removing duplicate entries */
 
     nmastboun=nmast;
     for(i=neq[1];i<neq[2];i++){
         jstart=nmastboun+1;
         if(jq[i+1]-jq[i]>0){
         irow[nmastboun++]=irow[jq[i]-1];
         for(j=jq[i];j<jq[i+1]-1;j++){
             if(irow[j]==irow[nmastboun-1])continue;
             irow[nmastboun++]=irow[j];
         }
         }
         jq[i]=jstart;
     }
     jq[neq[2]]=nmastboun+1;
     
     for(i=neq[1];i<neq[2];i++){
         icol[i]=jq[i+1]-jq[i];
     }
 
         /* number of nonzero's in the boundary part*/
 
     nzs[2]=jq[neq[2]]-1;
     }
     else{nzs[2]=nzs[1];}
 
   SFREE(next);
 
   *mast1p=mast1;
   *irowp=irow;
 
   return;
 
 }

◆ mastructcs()

void mastructcs	(	ITG *	nk,
		ITG *	kon,
		ITG *	ipkon,
		char *	lakon,
		ITG *	ne,
		ITG *	nodeboun,
		ITG *	ndirboun,
		ITG *	nboun,
		ITG *	ipompc,
		ITG *	nodempc,
		ITG *	nmpc,
		ITG *	nactdof,
		ITG *	icol,
		ITG *	jq,
		ITG **	mast1p,
		ITG **	irowp,
		ITG *	isolver,
		ITG *	neq,
		ITG *	ikmpc,
		ITG *	ilmpc,
		ITG *	ipointer,
		ITG *	nzs,
		ITG *	nmethod,
		ITG *	ics,
		double *	cs,
		char *	labmpc,
		ITG *	mcs,
		ITG *	mi,
		ITG *	mortar
	)

                                   {
 
   /* determines the structure of the thermo-mechanical matrices with
      cyclic symmetry;
      (i.e. the location of the nonzeros */
 
   char lakonl[2]=" \0";
 
   ITG i,j,k,l,jj,ll,id,index,jdof1,jdof2,idof1,idof2,mpc1,mpc2,id1,id2,
     ist1,ist2,node1,node2,isubtract,nmast,ifree,istart,istartold,
     index1,index2,m,node,nzs_,ist,kflag,indexe,nope,isize,*mast1=NULL,
     *irow=NULL,inode,icomplex,inode1,icomplex1,inode2,*next=NULL,
       icomplex2,kdof1,kdof2,ilength,lprev,ij,mt=mi[1]+1,jstart;
 
   /* the indices in the comments follow FORTRAN convention, i.e. the
      fields start with 1 */
 
   mast1=*mast1p;
   irow=*irowp;
 
   kflag=1;
   nzs_=nzs[1];
   NNEW(next,ITG,nzs_);
 
   /* initialisation of nactmpc */
 
   for(i=0;i<mt**nk;++i){nactdof[i]=0;}
 
   /* determining the active degrees of freedom due to elements */
 
   for(i=0;i<*ne;++i){
     
     if(ipkon[i]<0) continue;
     indexe=ipkon[i];
 /* Bernhardi start */
     if (strcmp1(&lakon[8*i+3],"8I")==0)nope=11;
     else if(strcmp1(&lakon[8*i+3],"20")==0)nope=20;
 /* Bernhardi end */
     else if(strcmp1(&lakon[8*i+3],"2")==0)nope=26;
     else if (strcmp1(&lakon[8*i+3],"8")==0)nope=8;
     else if (strcmp1(&lakon[8*i+3],"10")==0)nope=10;
     else if ((strcmp1(&lakon[8*i+3],"4")==0)||
          (strcmp1(&lakon[8*i+2],"4")==0)) nope=4;
     else if (strcmp1(&lakon[8*i+3],"15")==0)nope=15;
     else if (strcmp1(&lakon[8*i+3],"6")==0)nope=6;
     else if (strcmp1(&lakon[8*i],"E")==0){
     if((strcmp1(&lakon[8*i+6],"C")==0)&&(*mortar==1)){
         nope=kon[ipkon[i]-1];
     }else{
         lakonl[0]=lakon[8*i+7];
         nope=atoi(lakonl)+1;
     }
     }else continue;
 
 /*    else if (strcmp1(&lakon[8*i],"E")==0){
     lakonl[0]=lakon[8*i+7];
     nope=atoi(lakonl)+1;}
     else continue;*/
 
     for(j=0;j<nope;++j){
       node=kon[indexe+j]-1;
       for(k=1;k<4;++k){
     nactdof[mt*node+k]=1;
       }
     }
   }
 
   /* determining the active degrees of freedom due to mpc's */
 
   for(i=0;i<*nmpc;++i){
       index=ipompc[i]-1;
       do{
       if((nodempc[3*index+1]!=0)&&(nodempc[3*index+1]<4)){
           nactdof[mt*(nodempc[3*index]-1)+nodempc[3*index+1]]=1;}
       index=nodempc[3*index+2];
       if(index==0) break;
       index--;
       }while(1);
   }
        
   /* subtracting the SPC and MPC nodes */
 
   for(i=0;i<*nboun;++i){
       if(ndirboun[i]>mi[1]) continue;
       nactdof[mt*(nodeboun[i]-1)+ndirboun[i]]=-2*(i+1);
   }
 
   for(i=0;i<*nmpc;++i){
       index=ipompc[i]-1;
       if(nodempc[3*index+1]>mi[1]) continue;
       nactdof[mt*(nodempc[3*index]-1)+nodempc[3*index+1]]=-2*i-1;
   }
   
   /* numbering the active degrees of freedom */
   
   neq[0]=0;
   for(i=0;i<*nk;++i){
     for(j=1;j<4;++j){
     if(nactdof[mt*i+j]>0){
     ++neq[0];
     nactdof[mt*i+j]=neq[0];
       }
     }
   }
   
   ifree=0;
   
     /* determining the position of each nonzero matrix element
 
        mast1(ipointer(i)) = first nonzero row in column i
        next(ipointer(i))  points to further nonzero elements in 
                              column i */
       
   for(i=0;i<6**nk;++i){ipointer[i]=0;}
     
   for(i=0;i<*ne;++i){
       
     if(ipkon[i]<0) continue;
     indexe=ipkon[i];
 /*  Bernhardi start  */
     if(strcmp1(&lakon[8*i],"C3D8I")==0){nope=11;}
     else if(strcmp1(&lakon[8*i+3],"20")==0)nope=20;
 /*  Bernhardi end */
     else if(strcmp1(&lakon[8*i+3],"2")==0)nope=26;
     else if (strcmp1(&lakon[8*i+3],"8")==0)nope=8;
     else if (strcmp1(&lakon[8*i+3],"10")==0)nope=10;
     else if (strcmp1(&lakon[8*i+3],"4")==0)nope=4;
     else if (strcmp1(&lakon[8*i+3],"15")==0)nope=15;
     else if (strcmp1(&lakon[8*i+3],"6")==0)nope=6;
     else if (strcmp1(&lakon[8*i],"E")==0){
     if((strcmp1(&lakon[8*i+6],"C")==0)&&(*mortar==1)){
         nope=kon[ipkon[i]-1];
     }else{
         lakonl[0]=lakon[8*i+7];
         nope=atoi(lakonl)+1;
     }
     }else continue;
 
 /*    else if (strcmp1(&lakon[8*i],"E")==0){
     lakonl[0]=lakon[8*i+7];
     nope=atoi(lakonl)+1;}
     else continue;*/
       
     for(jj=0;jj<3*nope;++jj){
     
       j=jj/3;
       k=jj-3*j;
     
       node1=kon[indexe+j];
       jdof1=nactdof[mt*(node1-1)+k+1];
     
       for(ll=jj;ll<3*nope;++ll){
       
     l=ll/3;
     m=ll-3*l;
       
     node2=kon[indexe+l];
     jdof2=nactdof[mt*(node2-1)+m+1];
       
     /* check whether one of the DOF belongs to a SPC or MPC */
       
     if((jdof1>0)&&(jdof2>0)){
       insert(ipointer,&mast1,&next,&jdof1,&jdof2,&ifree,&nzs_);
       kdof1=jdof1+neq[0];kdof2=jdof2+neq[0];
       insert(ipointer,&mast1,&next,&kdof1,&kdof2,&ifree,&nzs_);
     }
     else if((jdof1>0)||(jdof2>0)){
       
       /* idof1: genuine DOF
          idof2: nominal DOF of the SPC/MPC */
       
       if(jdof1<=0){
         idof1=jdof2;
         idof2=jdof1;}
 //      idof2=8*node1+k-7;}
       else{
         idof1=jdof1;
         idof2=jdof2;}
 //      idof2=8*node2+m-7;}
       
       if(*nmpc>0){
         
 //      FORTRAN(nident,(ikmpc,&idof2,nmpc,&id));
 //      if((id>0)&&(ikmpc[id-1]==idof2)){
         if(idof2!=2*(idof2/2)){
           
           /* regular DOF / MPC */
           
 //        id1=ilmpc[id-1];
           id1=(-idof2+1)/2;
           ist=ipompc[id1-1];
           index=nodempc[3*ist-1];
           if(index==0) continue;
           while(1){
         inode=nodempc[3*index-3];
         icomplex=0;
         if(strcmp1(&labmpc[(id1-1)*20],"CYCLIC")==0){
                   icomplex=atoi(&labmpc[20*(id1-1)+6]);
         }
         else if(strcmp1(&labmpc[(id1-1)*20],"SUBCYCLIC")==0){
                   for(ij=0;ij<*mcs;ij++){
                     ilength=cs[17*ij+3];
                     lprev=cs[17*ij+13];
                     FORTRAN(nident,(&ics[lprev],&inode,&ilength,&id));
                     if(id>0){
                       if(ics[lprev+id-1]==inode){
                         icomplex=ij+1;
                         break;
                       }
                     }
                   }
         }
 //      idof2=nactdof[mt*inode+nodempc[3*index-2]-4];
         idof2=nactdof[mt*(inode-1)+nodempc[3*index-2]];
         if(idof2>0){
           insert(ipointer,&mast1,&next,&idof1,&idof2,&ifree,&nzs_);
           kdof1=idof1+neq[0];kdof2=idof2+neq[0];
           insert(ipointer,&mast1,&next,&kdof1,&kdof2,&ifree,&nzs_);
           if((icomplex!=0)&&(idof1!=idof2)){
             insert(ipointer,&mast1,&next,&kdof1,&idof2,&ifree,&nzs_);
             insert(ipointer,&mast1,&next,&idof1,&kdof2,&ifree,&nzs_);
           }
         }
         index=nodempc[3*index-1];
         if(index==0) break;
           }
           continue;
         }
       }
     }
     
     else{
 //    idof1=8*node1+k-7;
 //    idof2=8*node2+m-7;
       idof1=jdof1;
       idof2=jdof2;
       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(idof1!=2*(idof1/2)) mpc1=1;
         if(idof2!=2*(idof2/2)) mpc2=1;
       }
       if((mpc1==1)&&(mpc2==1)){
 //      id1=ilmpc[id1-1];
 //      id2=ilmpc[id2-1];
         id1=(-idof1+1)/2;
         id2=(-idof2+1)/2;
         if(id1==id2){
           
           /* MPC id1 / MPC id1 */
           
           ist=ipompc[id1-1];
           index1=nodempc[3*ist-1];
           if(index1==0) continue;
           while(1){
         inode1=nodempc[3*index1-3];
         icomplex1=0;
         if(strcmp1(&labmpc[(id1-1)*20],"CYCLIC")==0){
                   icomplex1=atoi(&labmpc[20*(id1-1)+6]);
         }
         else if(strcmp1(&labmpc[(id1-1)*20],"SUBCYCLIC")==0){
                   for(ij=0;ij<*mcs;ij++){
                     ilength=cs[17*ij+3];
                     lprev=cs[17*ij+13];
                     FORTRAN(nident,(&ics[lprev],&inode1,&ilength,&id));
                     if(id>0){
                       if(ics[lprev+id-1]==inode1){
                         icomplex1=ij+1;
                         break;
                       }
                     }
                   }
         }
 //      idof1=nactdof[mt*inode1+nodempc[3*index1-2]-4];
         idof1=nactdof[mt*(inode1-1)+nodempc[3*index1-2]];
         index2=index1;
         while(1){
           inode2=nodempc[3*index2-3];
           icomplex2=0;
           if(strcmp1(&labmpc[(id1-1)*20],"CYCLIC")==0){
                     icomplex2=atoi(&labmpc[20*(id1-1)+6]);
           }
           else if(strcmp1(&labmpc[(id1-1)*20],"SUBCYCLIC")==0){
                     for(ij=0;ij<*mcs;ij++){
                       ilength=cs[17*ij+3];
                       lprev=cs[17*ij+13];
                       FORTRAN(nident,(&ics[lprev],&inode2,&ilength,&id));
                       if(id>0){
                         if(ics[lprev+id-1]==inode2){
                           icomplex2=ij+1;
                           break;
                         }
                       }
                     }
                   }
 //        idof2=nactdof[mt*inode2+nodempc[3*index2-2]-4];
           idof2=nactdof[mt*(inode2-1)+nodempc[3*index2-2]];
           if((idof1>0)&&(idof2>0)){
             insert(ipointer,&mast1,&next,&idof1,&idof2,&ifree,&nzs_);
             kdof1=idof1+neq[0];kdof2=idof2+neq[0];
             insert(ipointer,&mast1,&next,&kdof1,&kdof2,&ifree,&nzs_);
                     if(((icomplex1!=0)||(icomplex2!=0))&&
                        (icomplex1!=icomplex2)){
                     /*   if(((icomplex1!=0)||(icomplex2!=0))&&
                          ((icomplex1==0)||(icomplex2==0))){*/
               insert(ipointer,&mast1,&next,&kdof1,&idof2,&ifree,&nzs_);
               insert(ipointer,&mast1,&next,&idof1,&kdof2,&ifree,&nzs_);
             }
           }
           index2=nodempc[3*index2-1];
           if(index2==0) break;
         }
         index1=nodempc[3*index1-1];
         if(index1==0) break;
           }
         }
         
         else{
           
           /* MPC id1 /MPC id2 */
           
           ist1=ipompc[id1-1];
           index1=nodempc[3*ist1-1];
           if(index1==0) continue;
           while(1){
         inode1=nodempc[3*index1-3];
         icomplex1=0;
         if(strcmp1(&labmpc[(id1-1)*20],"CYCLIC")==0){
                   icomplex1=atoi(&labmpc[20*(id1-1)+6]);
         }
         else if(strcmp1(&labmpc[(id1-1)*20],"SUBCYCLIC")==0){
                   for(ij=0;ij<*mcs;ij++){
                     ilength=cs[17*ij+3];
                     lprev=cs[17*ij+13];
                     FORTRAN(nident,(&ics[lprev],&inode1,&ilength,&id));
                     if(id>0){
                       if(ics[lprev+id-1]==inode1){
                         icomplex1=ij+1;
                         break;
                       }
                     }
                   }
         }
 //      idof1=nactdof[mt*inode1+nodempc[3*index1-2]-4];
         idof1=nactdof[mt*(inode1-1)+nodempc[3*index1-2]];
         ist2=ipompc[id2-1];
         index2=nodempc[3*ist2-1];
         if(index2==0){
           index1=nodempc[3*index1-1];
           if(index1==0){break;}
           else{continue;}
         }
         while(1){
           inode2=nodempc[3*index2-3];
           icomplex2=0;
           if(strcmp1(&labmpc[(id2-1)*20],"CYCLIC")==0){
                     icomplex2=atoi(&labmpc[20*(id2-1)+6]);
           }
           else if(strcmp1(&labmpc[(id2-1)*20],"SUBCYCLIC")==0){
                     for(ij=0;ij<*mcs;ij++){
                       ilength=cs[17*ij+3];
                       lprev=cs[17*ij+13];
                       FORTRAN(nident,(&ics[lprev],&inode2,&ilength,&id));
                       if(id>0){
                         if(ics[lprev+id-1]==inode2){
                           icomplex2=ij+1;
                           break;
                         }
                       }
                     }
                   }
 //        idof2=nactdof[mt*inode2+nodempc[3*index2-2]-4];
           idof2=nactdof[mt*(inode2-1)+nodempc[3*index2-2]];
           if((idof1>0)&&(idof2>0)){
             insert(ipointer,&mast1,&next,&idof1,&idof2,&ifree,&nzs_);
             kdof1=idof1+neq[0];kdof2=idof2+neq[0];
             insert(ipointer,&mast1,&next,&kdof1,&kdof2,&ifree,&nzs_);
                     if(((icomplex1!=0)||(icomplex2!=0))&&
                        (icomplex1!=icomplex2)){
                     /*   if(((icomplex1!=0)||(icomplex2!=0))&&
                          ((icomplex1==0)||(icomplex2==0))){*/
               insert(ipointer,&mast1,&next,&kdof1,&idof2,&ifree,&nzs_);
               insert(ipointer,&mast1,&next,&idof1,&kdof2,&ifree,&nzs_);
             }
           }
           index2=nodempc[3*index2-1];
           if(index2==0) break;
         }
         index1=nodempc[3*index1-1];
         if(index1==0) break;
           }
         }
       }
     }
       }
     }
   }
 
   neq[0]=2*neq[0];
   neq[1]=neq[0];
   
   if(neq[0]==0){
     printf("\n *WARNING: no degrees of freedom in the model\n");
     FORTRAN(stop,());
   }
 
     /*   determination of the following fields:       
 
        - irow: row numbers, column per column
        - icol(i)=# SUBdiagonal nonzero's in column i
        - jq(i)= location in field irow of the first SUBdiagonal
          nonzero in column i  */
 
     RENEW(irow,ITG,ifree);
     nmast=0;
     jq[0]=1;
     for(i=0;i<neq[1];i++){
     index=ipointer[i];
     do{
         if(index==0) break;
         irow[nmast++]=mast1[index-1];
         index=next[index-1];
     }while(1);
     jq[i+1]=nmast+1;
 //  icol[i]=jq[i+1]-jq[i];
     }
 
     /* sorting the row numbers within each column */
   
   for(i=0;i<neq[0];++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));
     }
   }
 
   /* removing duplicate entries */
   
   nmast=0;
   for(i=0;i<neq[0];i++){
       jstart=nmast+1;
       if(jq[i+1]-jq[i]>0){
       irow[nmast++]=irow[jq[i]-1];
       for(j=jq[i];j<jq[i+1]-1;j++){
           if(irow[j]==irow[nmast-1])continue;
           irow[nmast++]=irow[j];
       }
       }
       jq[i]=jstart;
   }
   jq[neq[0]]=nmast+1;
   
   for(i=0;i<neq[0];i++){
       icol[i]=jq[i+1]-jq[i];
   }
   
   nzs[0]=jq[neq[0]-1]-1;
   nzs[1]=nzs[0];
   nzs[2]=nzs[0];
 
     /* summary */
 
   printf(" number of equations\n");
   printf(" %" ITGFORMAT "\n",neq[0]);
   printf(" number of nonzero lower triangular matrix elements\n");
   printf(" %" ITGFORMAT "\n",nmast);
 
   SFREE(next);
   
   *mast1p=mast1;
   *irowp=irow;
   
   return;
   
 }

◆ mastructem()

void mastructem	(	ITG *	nk,
		ITG *	kon,
		ITG *	ipkon,
		char *	lakon,
		ITG *	ne,
		ITG *	nodeboun,
		ITG *	ndirboun,
		ITG *	nboun,
		ITG *	ipompc,
		ITG *	nodempc,
		ITG *	nmpc,
		ITG *	nactdof,
		ITG *	icol,
		ITG *	jq,
		ITG **	mast1p,
		ITG **	irowp,
		ITG *	isolver,
		ITG *	neq,
		ITG *	ikmpc,
		ITG *	ilmpc,
		ITG *	ipointer,
		ITG *	nzs,
		ITG *	ithermal,
		ITG *	mi,
		ITG *	ielmat,
		double *	elcon,
		ITG *	ncmat_,
		ITG *	ntmat_,
		ITG *	inomat,
		ITG *	network
	)

                                                {
 
   /* determines the structure of the thermo-electromagnetic matrices;
      (i.e. the location of the nonzeros */
 
   char lakonl[2]=" \0";
 
   ITG i,j,k,l,jj,ll,id,index,jdof1,jdof2,idof1,idof2,mpc1,mpc2,id1,id2,
     ist1,ist2,node1,node2,isubtract,nmast,ifree,istart,istartold,
     index1,index2,m,node,nzs_,ist,kflag,indexe,nope,isize,*mast1=NULL,
     *irow=NULL,mt=mi[1]+1,imat,idomain,jmin,jmax,*next=NULL,jstart;
 
   /* the indices in the comments follow FORTRAN convention, i.e. the
      fields start with 1 */
 
   mast1=*mast1p;
   irow=*irowp;
 
   kflag=1;
   nzs_=nzs[1];
   NNEW(next,ITG,nzs_);
 
   /* initialisation of nactmpc */
 
   for(i=0;i<mt**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],"20")==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 if (strcmp1(&lakon[8*i+3],"6")==0)nope=6;
       else continue;
       
           /* degrees of freedom:
              in domain 1: phi
              in domain 2: A and V
              in domain 3: A  */
 
       imat=ielmat[i*mi[2]];
       idomain=(ITG)elcon[(*ncmat_+1)**ntmat_*(imat-1)+2];
       if(idomain==1){
           jmin=5;jmax=6;
       }else if(idomain==2){
           jmin=1;jmax=5;
       }else if(idomain==3){
           jmin=1;jmax=4;
       }else{
           continue;
       }
 
           /* displacement degrees of freedom */
 
       for(j=0;j<nope;++j){
           node=kon[indexe+j]-1;
           for(k=jmin;k<jmax;++k){
           nactdof[mt*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;
 
           /* only the A-V domain (domain 2) has temperature variables */
 
       imat=ielmat[i*mi[2]];
       idomain=(ITG)elcon[(*ncmat_+1)**ntmat_*(imat-1)+2];
       if(idomain!=2) continue;
 
       indexe=ipkon[i];
       if(strcmp1(&lakon[8*i+3],"20")==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 if (strcmp1(&lakon[8*i+3],"6")==0)nope=6;
       else if (strcmp1(&lakon[8*i],"E")==0){
           lakonl[0]=lakon[8*i+7];
           nope=atoi(lakonl)+1;}
       else if ((strcmp1(&lakon[8*i],"D ")==0)||
                    ((strcmp1(&lakon[8*i],"D")==0)&&(*network==1))){
 
           /* check for entry or exit element */
           
           if((kon[indexe]==0)||(kon[indexe+2]==0)) continue;
           
           /* generic network element */
           
           for(j=0;j<3;j=j+2){
           node=kon[indexe+j]-1;
           nactdof[mt*node]=1;
           }
           continue;}
       else continue;
       
       for(j=0;j<nope;++j){
           node=kon[indexe+j]-1;
           nactdof[mt*node]=1;
       }
       }
   }
 
   /* determining the active degrees of freedom due to mpc's */
 
   for(i=0;i<*nmpc;++i){
       index=ipompc[i]-1;
       do{
       node=nodempc[3*index];
       if(inomat[node-1]>0){
           nactdof[mt*(node-1)+nodempc[3*index+1]]=1;
       }
       index=nodempc[3*index+2];
       if(index==0) break;
       index--;
       }while(1);
   }
   
   /* subtracting the SPC and MPC nodes */
 
   for(i=0;i<*nboun;++i){
       if(ndirboun[i]>mi[1]){continue;}
       nactdof[mt*(nodeboun[i]-1)+ndirboun[i]]=-2*(i+1);
   }
 
   for(i=0;i<*nmpc;++i){
     index=ipompc[i]-1;
     if(nodempc[3*index+1]>mi[1]) continue;
     nactdof[mt*(nodempc[3*index]-1)+nodempc[3*index+1]]=-2*i-1;
   }
  
   /* numbering the active degrees of freedom */
   
   neq[0]=0;
   for(i=0;i<*nk;++i){
     for(j=1;j<mt;++j){
     if(nactdof[mt*i+j]>0){
         if((*ithermal<2)||(*ithermal>=3)){
           ++neq[0];
           nactdof[mt*i+j]=neq[0];
         }
         else{
         nactdof[mt*i+j]=0;
         }
       }
     }
   }
   neq[1]=neq[0];
   for(i=0;i<*nk;++i){
       if(nactdof[mt*i]>0){
       if(*ithermal>1){
         ++neq[1];
         nactdof[mt*i]=neq[1];
       }
       else{
       nactdof[mt*i]=0;
       }
     }
   }
   neq[2]=neq[1];
   
   ifree=0;
 
     /* determining the position of each nonzero matrix element in
        the SUPERdiagonal matrix */
 
     /*   mast1(ipointer(i)) = first nonzero row in column i
      next(ipointer(i))  points to further nonzero elements in 
                              column i */
       
     for(i=0;i<4**nk;++i){ipointer[i]=0;}
 
     /* electromagnetic 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],"20")==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 if (strcmp1(&lakon[8*i+3],"6")==0)nope=6;
       else continue;
       
       for(jj=0;jj<mi[1]*nope;++jj){
     
     j=jj/mi[1];
     k=jj-mi[1]*j;
     
     node1=kon[indexe+j];
     jdof1=nactdof[mt*(node1-1)+k+1];
     
     for(ll=jj;ll<mi[1]*nope;++ll){
       
       l=ll/mi[1];
       m=ll-mi[1]*l;
       
       node2=kon[indexe+l];
       jdof2=nactdof[mt*(node2-1)+m+1];
       
       /* check whether one of the DOF belongs to a SPC or MPC */
       
       if((jdof1>0)&&(jdof2>0)){
         insert(ipointer,&mast1,&next,&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=jdof1;}
 //        idof2=8*node1+k-7;}
         else{
           idof1=jdof1;
           idof2=jdof2;}
 //        idof2=8*node2+m-7;}
         
         if(*nmpc>0){
           
 //        FORTRAN(nident,(ikmpc,&idof2,nmpc,&id));
 //        if((id>0)&&(ikmpc[id-1]==idof2)){
           if(idof2!=2*(idof2/2)){
         
         /* regular DOF / MPC */
         
 //      id=ilmpc[id-1];
         id=(-idof2+1)/2;
         ist=ipompc[id-1];
         index=nodempc[3*ist-1];
         if(index==0) continue;
         while(1){
             idof2=nactdof[mt*(nodempc[3*index-3]-1)+nodempc[3*index-2]];
           if(idof2>0){
             insert(ipointer,&mast1,&next,&idof1,&idof2,&ifree,&nzs_);
           }
           index=nodempc[3*index-1];
           if(index==0) break;
         }
         continue;
           }
         }
       }
       
       else{
 //      idof1=8*node1+k-7;
 //      idof2=8*node2+m-7;
         idof1=jdof1;
         idof2=jdof2;
         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(idof1!=2*(idof1/2)) mpc1=1;
           if(idof2!=2*(idof2/2)) mpc2=1;
         }
         if((mpc1==1)&&(mpc2==1)){
 //        id1=ilmpc[id1-1];
 //        id2=ilmpc[id2-1];
           id1=(-idof1+1)/2;
           id2=(-idof2+1)/2;
           if(id1==id2){
         
         /* MPC id1 / MPC id1 */
         
         ist=ipompc[id1-1];
         index1=nodempc[3*ist-1];
         if(index1==0) continue;
         while(1){
             idof1=nactdof[mt*(nodempc[3*index1-3]-1)+nodempc[3*index1-2]];
           index2=index1;
           while(1){
               idof2=nactdof[mt*(nodempc[3*index2-3]-1)+nodempc[3*index2-2]];
             if((idof1>0)&&(idof2>0)){
               insert(ipointer,&mast1,&next,&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[mt*(nodempc[3*index1-3]-1)+nodempc[3*index1-2]];
           ist2=ipompc[id2-1];
           index2=nodempc[3*ist2-1];
           if(index2==0){
             index1=nodempc[3*index1-1];
             if(index1==0){break;}
             else{continue;}
           }
           while(1){
               idof2=nactdof[mt*(nodempc[3*index2-3]-1)+nodempc[3*index2-2]];
             if((idof1>0)&&(idof2>0)){
               insert(ipointer,&mast1,&next,&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;
       
       /* only the A-V domain (domain 2) has temperature variables */
       
       imat=ielmat[i*mi[2]];
       idomain=(ITG)elcon[(*ncmat_+1)**ntmat_*(imat-1)+2];
       if(idomain!=2) continue;
 
       indexe=ipkon[i];
       if(strcmp1(&lakon[8*i+3],"20")==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 if (strcmp1(&lakon[8*i+3],"6")==0)nope=6;
       else if (strcmp1(&lakon[8*i],"E")==0){
       lakonl[0]=lakon[8*i+7];
       nope=atoi(lakonl)+1;}
       else if ((strcmp1(&lakon[8*i],"D ")==0)||
                ((strcmp1(&lakon[8*i],"D")==0)&&(*network==1))){
 
       /* check for entry or exit element */
 
       if((kon[indexe]==0)||(kon[indexe+2]==0)) continue;
       nope=3;}
       else continue;
       
       for(jj=0;jj<nope;++jj){
     
     j=jj;
     
     node1=kon[indexe+j];
     jdof1=nactdof[mt*(node1-1)];
     
     for(ll=jj;ll<nope;++ll){
       
       l=ll;
       
       node2=kon[indexe+l];
       jdof2=nactdof[mt*(node2-1)];
       
       /* check whether one of the DOF belongs to a SPC or MPC */
       
       if((jdof1>0)&&(jdof2>0)){
         insert(ipointer,&mast1,&next,&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=8*node1-8;}
           idof2=jdof1;}
         else{
           idof1=jdof1;
 //        idof2=8*node2-8;}
           idof2=jdof2;}
         
         if(*nmpc>0){
           
 //        FORTRAN(nident,(ikmpc,&idof2,nmpc,&id));
 //        if((id>0)&&(ikmpc[id-1]==idof2)){
           if(idof2!=2*(idof2/2)){
         
         /* regular DOF / MPC */
         
 //      id=ilmpc[id-1];
         id=(-idof2+1)/2;
         ist=ipompc[id-1];
         index=nodempc[3*ist-1];
         if(index==0) continue;
         while(1){
             idof2=nactdof[mt*(nodempc[3*index-3]-1)+nodempc[3*index-2]];
           if(idof2>0){
             insert(ipointer,&mast1,&next,&idof1,&idof2,&ifree,&nzs_);
           }
           index=nodempc[3*index-1];
           if(index==0) break;
         }
         continue;
           }
         }
       }
       
       else{
 //      idof1=8*node1-8;
 //      idof2=8*node2-8;
         idof1=jdof1;
         idof2=jdof2;
         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(idof1!=2*(idof1/2)) mpc1=1;
         if(idof2!=2*(idof2/2)) mpc2=1;
         }
         if((mpc1==1)&&(mpc2==1)){
 //        id1=ilmpc[id1-1];
 //        id2=ilmpc[id2-1];
           id1=(-idof1+1)/2;
           id2=(-idof2+1)/2;
           if(id1==id2){
         
         /* MPC id1 / MPC id1 */
         
         ist=ipompc[id1-1];
         index1=nodempc[3*ist-1];
         if(index1==0) continue;
         while(1){
             idof1=nactdof[mt*(nodempc[3*index1-3]-1)+nodempc[3*index1-2]];
           index2=index1;
           while(1){
               idof2=nactdof[mt*(nodempc[3*index2-3]-1)+nodempc[3*index2-2]];
             if((idof1>0)&&(idof2>0)){
               insert(ipointer,&mast1,&next,&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[mt*(nodempc[3*index1-3]-1)+nodempc[3*index1-2]];
           ist2=ipompc[id2-1];
           index2=nodempc[3*ist2-1];
           if(index2==0){
             index1=nodempc[3*index1-1];
             if(index1==0){break;}
             else{continue;}
           }
           while(1){
               idof2=nactdof[mt*(nodempc[3*index2-3]-1)+nodempc[3*index2-2]];
             if((idof1>0)&&(idof2>0)){
               insert(ipointer,&mast1,&next,&idof1,&idof2,&ifree,&nzs_);}
             index2=nodempc[3*index2-1];
             if(index2==0) break;
           }
           index1=nodempc[3*index1-1];
           if(index1==0) break;
         }
           }
         }
       }
     }
       }
     }
 
     }
 
     if(neq[1]==0){
       printf("\n *WARNING: no degrees of freedom in the model\n\n");
     }
 
     /*   determination of the following fields:       
 
        - irow: row numbers, column per column
        - icol(i)=# SUBdiagonal nonzero's in column i
        - jq(i)= location in field irow of the first SUBdiagonal
          nonzero in column i  */
 
     RENEW(irow,ITG,ifree);
     nmast=0;
     jq[0]=1;
     for(i=0;i<neq[1];i++){
     index=ipointer[i];
     do{
         if(index==0) break;
         irow[nmast++]=mast1[index-1];
         index=next[index-1];
     }while(1);
     jq[i+1]=nmast+1;
 //  icol[i]=jq[i+1]-jq[i];
     }
 
     /* sorting the row numbers within each column */
 
     for(i=0;i<neq[1];++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));
       }
     }
 
     /* removing duplicate entries */
 
     nmast=0;
     for(i=0;i<neq[1];i++){
     jstart=nmast+1;
     if(jq[i+1]-jq[i]>0){
         irow[nmast++]=irow[jq[i]-1];
         for(j=jq[i];j<jq[i+1]-1;j++){
         if(irow[j]==irow[nmast-1])continue;
         irow[nmast++]=irow[j];
         }
     }
     jq[i]=jstart;
     }
     jq[neq[1]]=nmast+1;
 
     for(i=0;i<neq[1];i++){
     icol[i]=jq[i+1]-jq[i];
     }
 
     if(neq[0]==0){nzs[0]=0;}
     else{nzs[0]=jq[neq[0]]-1;}
     nzs[1]=jq[neq[1]]-1;
 
     nzs[2]=nzs[1];
 
     /* summary */
 
     printf(" number of equations\n");
     printf(" %" ITGFORMAT "\n",neq[1]);
     printf(" number of nonzero lower triangular matrix elements\n");
     printf(" %" ITGFORMAT "\n",nmast);
     printf("\n");
   
     SFREE(next);
 
     *mast1p=mast1;
     *irowp=irow;
 
     return;
 
 }

◆ mastructf()

void mastructf	(	ITG *	nk,
		ITG *	kon,
		ITG *	ipkon,
		char *	lakon,
		ITG *	ne,
		ITG *	icol,
		ITG *	jq,
		ITG **	mast1p,
		ITG **	irowp,
		ITG *	isolver,
		ITG *	ipointer,
		ITG *	nzs,
		ITG *	ipnei,
		ITG *	ineiel,
		ITG *	mi
	)

                                              {
 
   ITG i,j,k,l,index,idof1,idof2,node1,isubtract,nmast,ifree=0,istart,istartold,
       nzs_,kflag,isize,*mast1=NULL,*irow=NULL,neighbor,mt=mi[1]+1,numfaces,
       *next=NULL,jstart;
 
   /* the indices in the comments follow FORTRAN convention, i.e. the
      fields start with 1 */
 
   mast1=*mast1p;irow=*irowp;
 
   kflag=1;
   nzs_=*nzs;
   NNEW(next,ITG,nzs_);
 
   /* determining the nonzero locations */
 
   for(i=0;i<*nef;i++){
       idof1=i+1;
       if(strcmp1(&lakonf[8*i+3],"8")==0){
       numfaces=6;
       }else if(strcmp1(&lakonf[8*i+3],"6")==0){
       numfaces=5;
       }else{
       numfaces=4;
       }
 
       index=ipnei[i];
       insert(ipointer,&mast1,&next,&idof1,&idof1,&ifree,&nzs_);
       for(j=0;j<numfaces;j++){
       neighbor=neiel[index+j];
       if(neighbor==0) continue;
       idof2=neighbor;
       insert(ipointer,&mast1,&next,&idof1,&idof2,&ifree,&nzs_);
       }
 
   }
   
   if(*nef==0){
       printf("\n *WARNING: no degrees of freedom in the model\n\n");
   }
 
     /*   determination of the following fields:       
 
        - irow: row numbers, column per column
        - icol(i)=# SUBdiagonal nonzero's in column i
        - jq(i)= location in field irow of the first SUBdiagonal
          nonzero in column i  */
 
     RENEW(irow,ITG,ifree);
     nmast=0;
     jq[0]=1;
     for(i=0;i<*nef;i++){
     index=ipointer[i];
     do{
         if(index==0) break;
         irow[nmast++]=mast1[index-1];
         index=next[index-1];
     }while(1);
     jq[i+1]=nmast+1;
 //  icol[i]=jq[i+1]-jq[i];
     }
   
 /* sorting the row numbers within each column */
   
   for(i=0;i<*nef;++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));
       }
   }
 
   /* removing duplicate entries */
   
   nmast=0;
   for(i=0;i<*nef;i++){
       jstart=nmast+1;
       if(jq[i+1]-jq[i]>0){
       irow[nmast++]=irow[jq[i]-1];
       for(j=jq[i];j<jq[i+1]-1;j++){
           if(irow[j]==irow[nmast-1])continue;
           irow[nmast++]=irow[j];
       }
       }
       jq[i]=jstart;
   }
   jq[*nef]=nmast+1;
   
   for(i=0;i<*nef;i++){
       icol[i]=jq[i+1]-jq[i];
   }
   
   /* summary */
   
   printf(" number of equations\n");
   printf(" %" ITGFORMAT "\n",*nef);
   printf(" number of nonzero lower triangular matrix elements\n");
   printf(" %" ITGFORMAT "\n",nmast);
   printf("\n");
   
   *nzs=jq[*nef]-1;
 
   SFREE(next);
   
   *mast1p=mast1;*irowp=irow;
   
   return;
   
 }

◆ mastructrad()

void mastructrad	(	ITG *	ntr,
		ITG *	nloadtr,
		char *	sideload,
		ITG *	ipointerrad,
		ITG **	mast1radp,
		ITG **	irowradp,
		ITG *	nzsrad,
		ITG *	jqrad,
		ITG *	icolrad
	)

                                       {
 
 /* determining the structure of the viewfactor and the radiation
    matrix (both have the same structure). Only the structure of the
    lower half of the matrix is determined, since the structure of
    the upper half is identical */
 
   char crcav[4]="   \0";
 
   ITG three=3,i,j,k,l,ii,jj,icav,jcav,*mast1rad=NULL,*irowrad=NULL,
       ifree,nzsrad_,nmast,isubtract,isize,kflag,istart,istartold;
 
   mast1rad=*mast1radp;
   irowrad=*irowradp;
 
   kflag=2;
   nzsrad_=*nzsrad;
 
     /* determining the position of each nonzero matrix element in
        the SUPERdiagonal matrix */
 
   ifree=0;
 
   for(ii=1;ii<=*ntr;ii++){
       i=nloadtr[ii-1]-1;
       strcpy1(crcav,&sideload[20*i+17],three);
       icav=atoi(crcav);
       for(jj=1;jj<=ii;jj++){
       j=nloadtr[jj-1]-1;
       strcpy1(crcav,&sideload[20*j+17],three);
       jcav=atoi(crcav);
       if(icav==jcav){
           insertrad(ipointerrad,&mast1rad,&irowrad,&ii,
                      &jj,&ifree,&nzsrad_);
       }
       }
   }
 
   /*   storing the nonzero nodes in the SUPERdiagonal columns:
        mast1rad contains the row numbers (already done),
        irowrad the column numbers (done in the next lines) */
     
   for(i=0;i<*ntr;++i){
       if(ipointerrad[i]==0){
       printf("*ERROR in mastructrad: zero column\n");
       printf("       DOF=%" ITGFORMAT "\n",i);
       FORTRAN(stop,());
       }
       istart=ipointerrad[i];
       while(1){
       istartold=istart;
       istart=irowrad[istart-1];
       irowrad[istartold-1]=i+1;
       if(istart==0) break;
       }
   }
   
   nmast=ifree;
   
   /* summary */
   
   printf(" number of radiation equations\n");
   printf(" %" ITGFORMAT "\n",*ntr);
   printf(" number of nonzero radiation matrix elements\n");
   printf(" %" ITGFORMAT "\n",2*nmast-*ntr);
   printf(" \n");
 
     /* switching from a SUPERdiagonal inventory to a SUBdiagonal one:
        since the nonzeros are located in symmetric positions mast1rad
        can be considered to contain the column numbers and irowrad the
        row numbers; after sorting mast1rad the following results:
 
        - irowrad contains the row numbers of the SUBdiagonal
          nonzero's, column per column
        - mast1rad contains the column numbers
 
        Furthermore, the following fields are determined:       
 
        - icolrad(i)=# SUBdiagonal nonzero's in column i
        - jqrad(i)= location in field irow of the first SUBdiagonal
          nonzero in column i  */
 
     /* ordering the column numbers in mast1rad */
   
   FORTRAN(isortii,(mast1rad,irowrad,&nmast,&kflag));
   
   /* filtering out the diagonal elements and generating icolrad and jqrad */
   
   isubtract=0;
   for(i=0;i<*ntr;++i){icolrad[i]=0;}
   k=0;
   for(i=0;i<nmast;++i){
       if(mast1rad[i]==irowrad[i]){++isubtract;}
       else{
       mast1rad[i-isubtract]=mast1rad[i];
       irowrad[i-isubtract]=irowrad[i];
       if(k!=mast1rad[i]){
           for(l=k;l<mast1rad[i];++l){jqrad[l]=i+1-isubtract;}
           k=mast1rad[i];
       }
       ++icolrad[k-1];
       }
   }
   nmast=nmast-isubtract;
   for(l=k;l<*ntr+1;++l){jqrad[l]=nmast+1;}
 
     /* sorting the row numbers within each column */
   
   for(i=0;i<*ntr;++i){
       if(jqrad[i+1]-jqrad[i]>0){
       isize=jqrad[i+1]-jqrad[i];
       FORTRAN(isortii,(&irowrad[jqrad[i]-1],&mast1rad[jqrad[i]-1],
                   &isize,&kflag));
       }
   }
   
   *nzsrad=jqrad[*ntr]-1;
   
   *mast1radp=mast1rad;
   *irowradp=irowrad;
   
   return;
 
 }

◆ mastructrand()

void mastructrand	(	ITG *	icols,
		ITG *	jqs,
		ITG **	mast1p,
		ITG **	irowsp,
		ITG *	ipointer,
		ITG *	nzss,
		ITG *	ndesi,
		double *	physcon,
		double *	xo,
		double *	yo,
		double *	zo,
		double *	x,
		double *	y,
		double *	z,
		ITG *	nx,
		ITG *	ny,
		ITG *	nz
	)

                           {
 
   /* determines the structure of the covariance matrix;
      (i.e. the location of the nonzeros */
 
   char lakonl[2]=" \0";
 
   ITG i,j,ii,index,jdof2,jdof1,nmast,ifree,kflag,indexe,isize,*mast1=NULL,
       *irows=NULL,*next=NULL,jstart,idesvar,*neighbor=NULL,nnodesinside;
 
   double *r=NULL,corrlength;
 
   /* the indices in the comments follow FORTRAN convention, i.e. the
      fields start with 1 */
 
   mast1=*mast1p;
   irows=*irowsp;
   ifree=0;
   kflag=2;
   corrlength=4*physcon[12];
 
   NNEW(next,ITG,*nzss);
   NNEW(neighbor,ITG,*ndesi+6);
   NNEW(r,double,*ndesi+6);
 
   for(idesvar=0;idesvar<*ndesi;idesvar++){
       jdof1=idesvar+1;
       
       /* nodes within 4 times the correlation length */
       
       FORTRAN(near3d_se,(xo,yo,zo,x,y,z,nx,ny,nz,&xo[idesvar],
              &yo[idesvar],&zo[idesvar],ndesi,neighbor,
              r,&nnodesinside,&corrlength));
       
       for(ii=0;ii<nnodesinside;ii++){
       jdof2=neighbor[ii];
       insert(ipointer,&mast1,&next,&jdof1,&jdof2,&ifree,nzss);
       }
   }
   
   /*   determination of the following fields:       
        
        - irows: row numbers, column per column
        - jqs(i)= location in field irows of the first SUBdiagonal
        nonzero in column i  */
   
   RENEW(irows,ITG,ifree);
   nmast=0;
   jqs[0]=1;
   for(i=0;i<*ndesi;i++){
       index=ipointer[i];
       do{
       if(index==0) break;
       irows[nmast++]=mast1[index-1];
       index=next[index-1];
       }while(1);
       jqs[i+1]=nmast+1;
   }
   
   /* sorting the row numbers within each column */
   
   for(i=0;i<*ndesi;++i){
       if(jqs[i+1]-jqs[i]>0){
       isize=jqs[i+1]-jqs[i];
       FORTRAN(isortii,(&irows[jqs[i]-1],&mast1[jqs[i]-1],&isize,&kflag));
       }
   }
   
   /* removing duplicate entries */
   
   nmast=0;
   for(i=0;i<*ndesi;i++){
       jstart=nmast+1;
       if(jqs[i+1]-jqs[i]>0){
       irows[nmast++]=irows[jqs[i]-1];
       for(j=jqs[i];j<jqs[i+1]-1;j++){
           if(irows[j]==irows[nmast-1])continue;
           irows[nmast++]=irows[j];
       }
       }
       jqs[i]=jstart;
   }
   jqs[*ndesi]=nmast+1;
   
   for(i=0;i<*ndesi;i++){
       icols[i]=jqs[i+1]-jqs[i];
   }
   *nzss=jqs[*ndesi]-1;
   
   SFREE(next);SFREE(neighbor);SFREE(r);
   
   *mast1p=mast1;
   *irowsp=irows;
   
   return;
   
 }

◆ mastructse()

void mastructse	(	ITG *	kon,
		ITG *	ipkon,
		char *	lakon,
		ITG *	ne,
		ITG *	ipompc,
		ITG *	nodempc,
		ITG *	nmpc,
		ITG *	nactdof,
		ITG *	icols,
		ITG *	jqs,
		ITG **	mast1p,
		ITG **	irowsp,
		ITG *	ipointer,
		ITG *	nzss,
		ITG *	mi,
		ITG *	mortar,
		ITG *	nodedesi,
		ITG *	ndesi,
		ITG *	icoordinate,
		ITG *	ielorien,
		ITG *	istartdesi,
		ITG *	ialdesi
	)

                                        {
 
   /* determines the structure of the thermo-mechanical matrices;
      (i.e. the location of the nonzeros */
 
   char lakonl[2]=" \0";
 
   ITG i,j,k,id,index,jdof1,idof1,idof2,nmast,ifree,kdof1,
     node,ist,kflag,indexe,nope,isize,*mast1=NULL,ii,
     *irows=NULL,mt=mi[1]+1,*next=NULL,jstart,idesvar;
 
   mast1=*mast1p;
   irows=*irowsp;
   ifree=0;
   kflag=2;
 
   NNEW(next,ITG,*nzss);
 
   for(idesvar=0;idesvar<*ndesi;idesvar++){
       idof2=idesvar+1;
 
       for(ii=istartdesi[idesvar]-1;ii<istartdesi[idesvar+1]-1;ii++){
       i=ialdesi[ii]-1;
       
       if(ipkon[i]<0) continue;
       if(strcmp1(&lakon[8*i],"F")==0)continue;
       indexe=ipkon[i];
 /* Bernhardi start */
       if (strcmp1(&lakon[8*i+3],"8I")==0)nope=11;
       else if(strcmp1(&lakon[8*i+3],"20")==0)nope=20;
 /* Bernhardi end */
       else if (strcmp1(&lakon[8*i+3],"8")==0)nope=8;
       else if (strcmp1(&lakon[8*i+3],"10")==0)nope=10;
       else if ((strcmp1(&lakon[8*i+3],"4")==0)||
            (strcmp1(&lakon[8*i+2],"4")==0)) nope=4;
       else if (strcmp1(&lakon[8*i+3],"15")==0)nope=15;
       else if (strcmp1(&lakon[8*i+3],"6")==0)nope=6;
       else if (strcmp1(&lakon[8*i],"E")==0){
           if((strcmp1(&lakon[8*i+6],"C")==0)&&(*mortar==1)){
           
           /* face-to-face contact (all nodes already belong
              to other elements */
           
           continue;
           }else if(strcmp1(&lakon[8*i+6],"F")!=0){
           
           /* node-to-face contact */
           
           lakonl[0]=lakon[8*i+7];
           nope=atoi(lakonl)+1;
           }else{
           
           /* advection elements */
           
           continue;
           }
       }else continue;
       
       /* displacement degrees of freedom */
       
       for(j=0;j<nope;++j){
           node=kon[indexe+j]-1;
           for(k=1;k<4;k++){
           idof1=nactdof[mt*node+k];
           if(idof1>0){
               insertfreq(ipointer,&mast1,&next,
                  &idof1,&idof2,&ifree,nzss);
           }else if(*nmpc!=0){
               if(idof1!=2*(idof1/2)){
               id=(-idof1+1)/2-1;
               ist=ipompc[id]-1;
               index=nodempc[3*ist+2];
               if(index==0) continue;
               do{
                   jdof1=nactdof[mt*(nodempc[3*index-3]-1)
                         +nodempc[3*index-2]];
                   if(jdof1>0){
                   insertfreq(ipointer,&mast1,&next,
                          &jdof1,&idof2,&ifree,nzss);
                   }
                   index=nodempc[3*index-1];
                   if(index==0) break;
               }while(1);
               }
           }
           }
       }
       }
   }
   
   /* determine irows and jqs */
   
   RENEW(irows,ITG,ifree);
   nmast=0;
   jqs[0]=1;
   for(i=0;i<*ndesi;i++){
       index=ipointer[i];
       do{
       if(index==0) break;
       irows[nmast++]=mast1[index-1];
       index=next[index-1];
       }while(1);
       jqs[i+1]=nmast+1;
   }
   
   /* sorting the row numbers within each column */
   
   for(i=0;i<*ndesi;++i){
       if(jqs[i+1]-jqs[i]>0){
       isize=jqs[i+1]-jqs[i];
       FORTRAN(isortii,(&irows[jqs[i]-1],&mast1[jqs[i]-1],&isize,&kflag));
       }
   }
   
   /* removing duplicate entries */
   
   nmast=0;
   for(i=0;i<*ndesi;i++){
       jstart=nmast+1;
       if(jqs[i+1]-jqs[i]>0){
       irows[nmast++]=irows[jqs[i]-1];
       for(j=jqs[i];j<jqs[i+1]-1;j++){
           if(irows[j]==irows[nmast-1])continue;
           irows[nmast++]=irows[j];
       }
       }
       jqs[i]=jstart;
   }
   jqs[*ndesi]=nmast+1;
   
   for(i=0;i<*ndesi;i++){
       icols[i]=jqs[i+1]-jqs[i];
   }
   
   *nzss=jqs[*ndesi]-1;
   
   SFREE(next);
   
   *mast1p=mast1;
   *irowsp=irows;
 
   return;
 
 }

◆ nonlingeo()

void nonlingeo	(	double **	co,
		ITG *	nk,
		ITG **	konp,
		ITG **	ipkonp,
		char **	lakonp,
		ITG *	ne,
		ITG *	nodeboun,
		ITG *	ndirboun,
		double *	xboun,
		ITG *	nboun,
		ITG **	ipompcp,
		ITG **	nodempcp,
		double **	coefmpcp,
		char **	labmpcp,
		ITG *	nmpc,
		ITG *	nodeforc,
		ITG *	ndirforc,
		double *	xforc,
		ITG *	nforc,
		ITG **	nelemloadp,
		char **	sideloadp,
		double *	xload,
		ITG *	nload,
		ITG *	nactdof,
		ITG **	icolp,
		ITG *	jq,
		ITG **	irowp,
		ITG *	neq,
		ITG *	nzl,
		ITG *	nmethod,
		ITG **	ikmpcp,
		ITG **	ilmpcp,
		ITG *	ikboun,
		ITG *	ilboun,
		double *	elcon,
		ITG *	nelcon,
		double *	rhcon,
		ITG *	nrhcon,
		double *	alcon,
		ITG *	nalcon,
		double *	alzero,
		ITG **	ielmatp,
		ITG **	ielorienp,
		ITG *	norien,
		double *	orab,
		ITG *	ntmat_,
		double *	t0,
		double *	t1,
		double *	t1old,
		ITG *	ithermal,
		double *	prestr,
		ITG *	iprestr,
		double **	vold,
		ITG *	iperturb,
		double *	sti,
		ITG *	nzs,
		ITG *	kode,
		char *	filab,
		ITG *	idrct,
		ITG *	jmax,
		ITG *	jout,
		double *	timepar,
		double *	eme,
		double *	xbounold,
		double *	xforcold,
		double *	xloadold,
		double *	veold,
		double *	accold,
		char *	amname,
		double *	amta,
		ITG *	namta,
		ITG *	nam,
		ITG *	iamforc,
		ITG **	iamloadp,
		ITG *	iamt1,
		double *	alpha,
		ITG *	iexpl,
		ITG *	iamboun,
		double *	plicon,
		ITG *	nplicon,
		double *	plkcon,
		ITG *	nplkcon,
		double **	xstatep,
		ITG *	npmat_,
		ITG *	istep,
		double *	ttime,
		char *	matname,
		double *	qaold,
		ITG *	mi,
		ITG *	isolver,
		ITG *	ncmat_,
		ITG *	nstate_,
		ITG *	iumat,
		double *	cs,
		ITG *	mcs,
		ITG *	nkon,
		double **	ener,
		ITG *	mpcinfo,
		char *	output,
		double *	shcon,
		ITG *	nshcon,
		double *	cocon,
		ITG *	ncocon,
		double *	physcon,
		ITG *	nflow,
		double *	ctrl,
		char *	set,
		ITG *	nset,
		ITG *	istartset,
		ITG *	iendset,
		ITG *	ialset,
		ITG *	nprint,
		char *	prlab,
		char *	prset,
		ITG *	nener,
		ITG *	ikforc,
		ITG *	ilforc,
		double *	trab,
		ITG *	inotr,
		ITG *	ntrans,
		double **	fmpcp,
		char *	cbody,
		ITG *	ibody,
		double *	xbody,
		ITG *	nbody,
		double *	xbodyold,
		ITG *	ielprop,
		double *	prop,
		ITG *	ntie,
		char *	tieset,
		ITG *	itpamp,
		ITG *	iviewfile,
		char *	jobnamec,
		double *	tietol,
		ITG *	nslavs,
		double *	thicke,
		ITG *	ics,
		ITG *	nintpoint,
		ITG *	mortar,
		ITG *	ifacecount,
		char *	typeboun,
		ITG **	islavsurfp,
		double **	pslavsurfp,
		double **	clearinip,
		ITG *	nmat,
		double *	xmodal,
		ITG *	iaxial,
		ITG *	inext,
		ITG *	nprop,
		ITG *	network,
		char *	orname
	)

                                    {
 
   char description[13]="            ",*lakon=NULL,jobnamef[396]="",
       *sideface=NULL,*labmpc=NULL,fnffrd[132]="",*lakonf=NULL,
       *sideloadref=NULL,*sideload=NULL,stiffmatrix[132]=""; 
  
   ITG *inum=NULL,k,iout=0,icntrl,iinc=0,jprint=0,iit=-1,jnz=0,
       icutb=0,istab=0,ifreebody,uncoupled,n1,n2,itruecontact,
       iperturb_sav[2],ilin,*icol=NULL,*irow=NULL,ielas=0,icmd=0,
       memmpc_,mpcfree,icascade,maxlenmpc,*nodempc=NULL,*iaux=NULL,
       *nodempcref=NULL,memmpcref_,mpcfreeref,*itg=NULL,*ineighe=NULL,
       *ieg=NULL,ntg=0,ntr,*kontri=NULL,*nloadtr=NULL,idamping=0,
       *ipiv=NULL,ntri,newstep,mode=-1,noddiam=-1,nasym=0,im,
       ntrit,*inocs=NULL,inewton=0,*ipobody=NULL,*nacteq=NULL,
       *nactdog=NULL,nteq,*itietri=NULL,*koncont=NULL,
       ncont,ne0,nkon0,*ipkon=NULL,*kon=NULL,*ielorien=NULL,
       *ielmat=NULL,itp=0,symmetryflag=0,inputformat=0,kscale=1,
       *iruc=NULL,iitterm=0,iturbulent,ngraph=1,ismallsliding=0,
       *ipompc=NULL,*ikmpc=NULL,*ilmpc=NULL,i0ref,irref,icref,
       *itiefac=NULL,*islavsurf=NULL,*islavnode=NULL,*imastnode=NULL,
       *nslavnode=NULL,*nmastnode=NULL,*imastop=NULL,imat,
       *iponoels=NULL,*inoels=NULL,*islavsurfold=NULL,maxlenmpcref,
       *islavact=NULL,mt=mi[1]+1,*nactdofinv=NULL,*ipe=NULL, 
       *ime=NULL,*ikactmech=NULL,nactmech,inode,idir,neold,neini,
       iemchange=0,nzsrad,*mast1rad=NULL,*irowrad=NULL,*icolrad=NULL,
       *jqrad=NULL,*ipointerrad=NULL,*integerglob=NULL,negpres=0,
       mass[2]={0,0}, stiffness=1, buckling=0, rhsi=1, intscheme=0,idiscon=0,
       coriolis=0,*ipneigh=NULL,*neigh=NULL,maxprevcontel,nslavs_prev_step,
       *nelemface=NULL,*ipoface=NULL,*nodface=NULL,*ifreestream=NULL,iex,
       *isolidsurf=NULL,*neighsolidsurf=NULL,*iponoel=NULL,*inoel=NULL,
       nef=0,nface,nfreestream,nsolidsurf,i,indexe,icfd=0,id,*neij=NULL,
       node,networknode,iflagact=0,*nodorig=NULL,*ipivr=NULL,iglob=0,
       *inomat=NULL,*ipnei=NULL,ntrimax,*nx=NULL,*ny=NULL,*nz=NULL,
       *neifa=NULL,*neiel=NULL,*ielfa=NULL,*ifaext=NULL,nflnei,nfaext,
       idampingwithoutcontact=0,*nactdoh=NULL,*nactdohinv=NULL,*ipkonf=NULL,
       *ielmatf=NULL,*ielorienf=NULL,ialeatoric=0,nloadref,isym,
       *nelemloadref=NULL,*iamloadref=NULL,*idefload=NULL,nload_,
       *nelemload=NULL,*iamload=NULL,ncontacts=0,inccontact=0,
       j=0,*ifatie=NULL,n,inoelsize=0,isensitivity=0,*istartblk=NULL,
       *iendblk=NULL,*nblket=NULL,*nblkze=NULL,nblk,*konf=NULL,*ielblk=NULL,
       *iwork=NULL,nelt,lrgw,*igwk=NULL,itol,itmax,iter,ierr,iunit,ligw;
 
   double *stn=NULL,*v=NULL,*een=NULL,cam[5],*epn=NULL,*cg=NULL,
          *cdn=NULL,*vel=NULL,*vfa=NULL,*pslavsurfold=NULL,
       *f=NULL,*fn=NULL,qa[4]={0.,0.,-1.,0.},qam[2]={0.,0.},dtheta,theta,
      err,ram[8]={0.,0.,0.,0.,0.,0.,0.,0.},*areaslav=NULL,
          *springarea=NULL,ram1[8]={0.,0.,0.,0.,0.,0.,0.,0.},
      ram2[8]={0.,0.,0.,0.,0.,0.,0.,0.},deltmx,ptime,smaxls,sminls,
          uam[2]={0.,0.},*vini=NULL,*ac=NULL,qa0,qau,ea,*straight=NULL,
      *t1act=NULL,qamold[2],*xbounact=NULL,*bc=NULL,
      *xforcact=NULL,*xloadact=NULL,*fext=NULL,*clearini=NULL,
          reltime,time,bet=0.,gam=0.,*aux2=NULL,dtime,*fini=NULL,
          *fextini=NULL,*veini=NULL,*accini=NULL,*xstateini=NULL,
      *ampli=NULL,scal1,*eei=NULL,*t1ini=NULL,pressureratio,
          *xbounini=NULL,dev,*xstiff=NULL,*stx=NULL,*stiini=NULL,
          *enern=NULL,*coefmpc=NULL,*aux=NULL,*xstaten=NULL,
      *coefmpcref=NULL,*enerini=NULL,*emn=NULL,alpham,betam,
      *tarea=NULL,*tenv=NULL,*erad=NULL,*fnr=NULL,*fni=NULL,
      *adview=NULL,*auview=NULL,*qfx=NULL,*cvini=NULL,*cv=NULL,
          *qfn=NULL,*co=NULL,*vold=NULL,*fenv=NULL,sigma=0.,
          *xbodyact=NULL,*cgr=NULL,dthetaref, *vr=NULL,*vi=NULL,
      *stnr=NULL,*stni=NULL,*vmax=NULL,*stnmax=NULL,*fmpc=NULL,*ener=NULL,
      *f_cm=NULL, *f_cs=NULL,*adc=NULL,*auc=NULL,*res=NULL,
      *xstate=NULL,*eenmax=NULL,*adrad=NULL,*aurad=NULL,*bcr=NULL,
      *xmastnor=NULL,*emeini=NULL,*tinc,*tper,*tmin,*tmax,*tincf,
      *doubleglob=NULL,*xnoels=NULL,*au=NULL,*resold=NULL,
      *ad=NULL,*b=NULL,*aub=NULL,*adb=NULL,*pslavsurf=NULL,*pmastsurf=NULL,
      *x=NULL,*y=NULL,*z=NULL,*xo=NULL,sum1,sum2,flinesearch,
      *yo=NULL,*zo=NULL,*cdnr=NULL,*cdni=NULL,*fnext=NULL,*fnextini=NULL,
      allwk=0.,allwkini,energy[4]={0.,0.,0.,0.},energyini[4],
      energyref,denergymax,dtcont,dtvol,wavespeed[*nmat],emax,r_abs,
          enetoll,dampwk=0.,dampwkini=0.,temax,*tmp=NULL,energystartstep[4],
      sizemaxinc,*adblump=NULL,*adcpy=NULL,*aucpy=NULL,*rwork=NULL,
      *sol=NULL,*rgwk=NULL,tol,*sb=NULL,*sx=NULL;
 
   FILE *f1;
      
   // MPADD: initialize rmin to the tolerance
   enetoll=0.02;
   r_abs=0.0;
   emax=0.0;
   // MPADD end
 
 
 #ifdef SGI
   ITG token;
 #endif
   
   icol=*icolp;irow=*irowp;co=*cop;vold=*voldp;
   ipkon=*ipkonp;lakon=*lakonp;kon=*konp;ielorien=*ielorienp;
   ielmat=*ielmatp;ener=*enerp;xstate=*xstatep;
   
   ipompc=*ipompcp;labmpc=*labmpcp;ikmpc=*ikmpcp;ilmpc=*ilmpcp;
   fmpc=*fmpcp;nodempc=*nodempcp;coefmpc=*coefmpcp;nelemload=*nelemloadp;
   iamload=*iamloadp;sideload=*sideloadp;
 
   islavsurf=*islavsurfp;pslavsurf=*pslavsurfp;clearini=*clearinip;
 
   tinc=&timepar[0];
   tper=&timepar[1];
   tmin=&timepar[2];
   tmax=&timepar[3];
   tincf=&timepar[4];
 
   if(*ithermal==4){
       uncoupled=1;
       *ithermal=3;
   }else{
       uncoupled=0;
   }
   
   if(*mortar!=1){
       maxprevcontel=*nslavs;
   }else if(*mortar==1){
       maxprevcontel=*nintpoint;
       if(*nstate_!=0){
       if(maxprevcontel!=0){
           NNEW(islavsurfold,ITG,2**ifacecount+2);
           NNEW(pslavsurfold,double,3**nintpoint);
           memcpy(&islavsurfold[0],&islavsurf[0],
              sizeof(ITG)*(2**ifacecount+2));
           memcpy(&pslavsurfold[0],&pslavsurf[0],
              sizeof(double)*(3**nintpoint));
       }
       }
   }
   nslavs_prev_step=*nslavs;
 
   /* turbulence model 
      iturbulent==0: laminar
      iturbulent==1: k-epsilon
      iturbulent==2: q-omega
      iturbulent==3: SST */
   
   iturbulent=(ITG)physcon[8];
   
   for(k=0;k<3;k++){
       strcpy1(&jobnamef[k*132],&jobnamec[k*132],132);
   }
   
   qa0=ctrl[20];qau=ctrl[21];ea=ctrl[23];deltmx=ctrl[26];
   i0ref=ctrl[0];irref=ctrl[1];icref=ctrl[3];
 
   sminls=ctrl[28];smaxls=ctrl[29];
   
   memmpc_=mpcinfo[0];mpcfree=mpcinfo[1];icascade=mpcinfo[2];
   maxlenmpc=mpcinfo[3];
 
   alpham=xmodal[0];
   betam=xmodal[1];
 
   /* check whether, for a dynamic calculation, damping is involved */
 
   if(*nmethod==4){
       if(*iexpl<=1){
       if((fabs(alpham)>1.e-30)||(fabs(betam)>1.e-30)){
           idamping=1;
           idampingwithoutcontact=1;
       }else{
           for(i=0;i<*ne;i++){
           if(ipkon[i]<0) continue;
           if(strcmp1(&lakon[i*8],"ED")==0){
               idamping=1;idampingwithoutcontact=1;break;
           }
           }
       }
       }
   }
 
   /* check whether a sensitivity step may follow (whether design variables
      were defined */
 
   for(i=0;i<*ntie;i++){
       if(strcmp1(&tieset[i*243+80],"D")==0){
       isensitivity=1;
       NNEW(adcpy,double,neq[1]);
           /* no asymmetric matrices allowed for sensitivity */
       NNEW(aucpy,double,nzs[1]);
       break;
       }
   }
 
   if((icascade==2)&&(*iexpl>=2)){
       printf(" *ERROR in nonlingeo: linear and nonlinear MPC's depend on each other\n");
       printf("        This is not allowed in a explicit dynamic calculation\n");
       FORTRAN(stop,());
   }
   
   /* check whether the submodel is meant for a fluid-structure
      interaction */
   
   strcpy(fnffrd,jobnamec);
   strcat(fnffrd,"f.frd");
   if((jobnamec[396]!='\0')&&(strcmp1(&jobnamec[396],fnffrd)==0)){
       
       /* fluid-structure interaction: wait till after the compfluid
          call */
       
       NNEW(integerglob,ITG,1);
       NNEW(doubleglob,double,1);
   }else{
       
       /* determining the global values to be used as boundary conditions
      for a submodel */
       
       getglobalresults(jobnamec,&integerglob,&doubleglob,nboun,iamboun,xboun,
                nload,sideload,iamload,&iglob,nforc,iamforc,xforc,
                        ithermal,nk,t1,iamt1);
   }
   
   /* invert nactdof */
   
   NNEW(nactdofinv,ITG,mt**nk);
   NNEW(nodorig,ITG,*nk);
   FORTRAN(gennactdofinv,(nactdof,nactdofinv,nk,mi,nodorig,
              ipkon,lakon,kon,ne));
   SFREE(nodorig);
   
   /* allocating a field for the stiffness matrix */
   
   NNEW(xstiff,double,(long long)27*mi[0]**ne);
   
   /* allocating force fields */
   
   NNEW(f,double,neq[1]);
   NNEW(fext,double,neq[1]);
   
   NNEW(b,double,neq[1]);
   NNEW(vini,double,mt**nk);
   
   NNEW(aux,double,7*maxlenmpc);
   NNEW(iaux,ITG,2*maxlenmpc);
   
   /* allocating fields for the actual external loading */
   
   NNEW(xbounact,double,*nboun);
   NNEW(xbounini,double,*nboun);
   for(k=0;k<*nboun;++k){xbounact[k]=xbounold[k];}
   NNEW(xforcact,double,*nforc);
   NNEW(xloadact,double,2**nload);
   NNEW(xbodyact,double,7**nbody);
   /* copying the rotation axis and/or acceleration vector */
   for(k=0;k<7**nbody;k++){xbodyact[k]=xbody[k];}
   
   /* assigning the body forces to the elements */ 
   
   if(*nbody>0){
       ifreebody=*ne+1;
       NNEW(ipobody,ITG,2*ifreebody**nbody);
       for(k=1;k<=*nbody;k++){
       FORTRAN(bodyforce,(cbody,ibody,ipobody,nbody,set,istartset,
                  iendset,ialset,&inewton,nset,&ifreebody,&k));
       RENEW(ipobody,ITG,2*(*ne+ifreebody));
       }
       RENEW(ipobody,ITG,2*(ifreebody-1));
       if(inewton==1){NNEW(cgr,double,4**ne);}
   }
   
   /* for mechanical calculations: updating boundary conditions
      calculated in a previous thermal step */
   
   if(*ithermal<2) FORTRAN(gasmechbc,(vold,nload,sideload,
                      nelemload,xload,mi));
   
   /* for thermal calculations: forced convection and cavity
      radiation*/
   
   if(*ithermal>1){
       NNEW(itg,ITG,*nload+3**nflow);
       NNEW(ieg,ITG,*nflow);
       /* max 6 triangles per face, 4 entries per triangle */
       NNEW(kontri,ITG,24**nload);
       NNEW(nloadtr,ITG,*nload);
       NNEW(nacteq,ITG,4**nk);
       NNEW(nactdog,ITG,4**nk);
       NNEW(v,double,mt**nk);
       FORTRAN(envtemp,(itg,ieg,&ntg,&ntr,sideload,nelemload,
                ipkon,kon,lakon,ielmat,ne,nload,
                        kontri,&ntri,nloadtr,nflow,ndirboun,nactdog,
                        nodeboun,nacteq,nboun,ielprop,prop,&nteq,
                        v,network,physcon,shcon,ntmat_,co,
                        vold,set,nshcon,rhcon,nrhcon,mi,nmpc,nodempc,
                        ipompc,labmpc,ikboun,&nasym,ttime,&time,iaxial));
       SFREE(v);
       
       if((*mcs>0)&&(ntr>0)){
       NNEW(inocs,ITG,*nk);
       radcyc(nk,kon,ipkon,lakon,ne,cs,mcs,nkon,ialset,istartset,
          iendset,&kontri,&ntri,&co,&vold,&ntrit,inocs,mi);
       }
       else{ntrit=ntri;}
       
       nzsrad=100*ntr;
       NNEW(mast1rad,ITG,nzsrad);
       NNEW(irowrad,ITG,nzsrad);
       NNEW(icolrad,ITG,ntr);
       NNEW(jqrad,ITG,ntr+1);
       NNEW(ipointerrad,ITG,ntr);
       
       if(ntr>0){
       mastructrad(&ntr,nloadtr,sideload,ipointerrad,
               &mast1rad,&irowrad,&nzsrad,
               jqrad,icolrad);
       }
       
       /* determine the network elements belonging to a given node (for usage
          in user subroutine film */
 
 //      if(ntg>0){
       if((*network>0)||(ntg>0)){
       NNEW(iponoel,ITG,*nk);
       NNEW(inoel,ITG,2**nkon);
       if(*network>0){
           FORTRAN(networkelementpernode,(iponoel,inoel,lakon,ipkon,kon,
           &inoelsize,nflow,ieg,ne,network));
       }
       RENEW(inoel,ITG,2*inoelsize);
       }
 
       SFREE(ipointerrad);SFREE(mast1rad);
       RENEW(irowrad,ITG,nzsrad);
       
       RENEW(itg,ITG,ntg);
       NNEW(ineighe,ITG,ntg);
       RENEW(kontri,ITG,4*ntrit);
       RENEW(nloadtr,ITG,ntr);
       
       NNEW(adview,double,ntr);
       NNEW(auview,double,2*nzsrad);
       NNEW(tarea,double,ntr);
       NNEW(tenv,double,ntr);
       NNEW(fenv,double,ntr);
       NNEW(erad,double,ntr);
       
       NNEW(ac,double,nteq*nteq);
       NNEW(bc,double,nteq);
       NNEW(ipiv,ITG,nteq);
       NNEW(adrad,double,ntr);
       NNEW(aurad,double,2*nzsrad);
       NNEW(bcr,double,ntr);
       NNEW(ipivr,ITG,ntr);
   }
   
   /* check for fluid elements */
   
   NNEW(nactdoh,ITG,*ne);
   NNEW(nactdohinv,ITG,*ne);
   for(i=0;i<*ne;++i){
       if(ipkon[i]<0) continue;
       indexe=ipkon[i];
       if(strcmp1(&lakon[8*i],"F")==0){
       icfd=1;nactdohinv[nef]=i+1;nef++;nactdoh[i]=nef;}
   }
   if(icfd==1){
 
       /* checking block structures (CFD calculations) */
 
       NNEW(ielfa,ITG,24*nef);
       NNEW(nodface,ITG,5*6*nef);
       NNEW(neiel,ITG,6*nef);
       NNEW(neij,ITG,6*nef);
       NNEW(neifa,ITG,6*nef);
       NNEW(ipoface,ITG,*nk);
       NNEW(ipnei,ITG,*ne+1);
       NNEW(konf,ITG,*nkon);
       NNEW(istartblk,ITG,*nset);
       NNEW(iendblk,ITG,*nset);
       NNEW(nblket,ITG,*nset);
       NNEW(nblkze,ITG,*nset);
       NNEW(ielblk,ITG,nef);
       FORTRAN(blockanalysis,(set,nset,istartset,iendset,ialset,&nblk,
               ipkon,kon,ielfa,nodface,neiel,neij,neifa,ipoface,ipnei,
           konf,istartblk,iendblk,nactdoh,nblket,nblkze,&nef,ielblk,
           nk,nactdohinv));
       if(nblk==0){
       memcpy(&konf[0],&kon[0],sizeof(ITG)**nkon);
       SFREE(istartblk);SFREE(iendblk);SFREE(nblket);
           SFREE(nblkze);SFREE(ielblk);
       }else{
       RENEW(istartblk,ITG,nblk);
       RENEW(iendblk,ITG,nblk);
       RENEW(nblket,ITG,nblk);
       RENEW(nblkze,ITG,nblk);
       }
       DMEMSET(ipoface,0,*nk,0);
       DMEMSET(neiel,0,6*nef,0);
       DMEMSET(ielfa,0,24*nef,0);
 
       /* gathering topological information (CFD calculations) */
 
       RENEW(nactdohinv,ITG,nef);
       NNEW(ipkonf,ITG,nef);
       NNEW(lakonf,char,8*nef);
       NNEW(ielmatf,ITG,mi[2]*nef);
       if(*norien>0) NNEW(ielorienf,ITG,mi[2]*nef);
       NNEW(ifatie,ITG,6*nef);
       NNEW(ifaext,ITG,6*nef);
       NNEW(isolidsurf,ITG,6*nef);
       NNEW(vel,double,8*nef);
       NNEW(vfa,double,8*6*nef);
 
       n=0;for(i=0;i<*mcs;i++){if(floor(cs[17*i+3])>n)n=floor(cs[17*i+3]);}
       NNEW(xo,double,n);NNEW(yo,double,n);NNEW(zo,double,n);        
       NNEW(x,double,n);NNEW(y,double,n);NNEW(z,double,n);      
       NNEW(nx,ITG,n);NNEW(ny,ITG,n);NNEW(nz,ITG,n);
 
       FORTRAN(precfd,(ne,ipkon,konf,lakon,ipnei,neifa,neiel,ipoface,
        nodface,ielfa,&nflnei,&nface,ifaext,&nfaext,
        isolidsurf,&nsolidsurf,set,nset,istartset,iendset,ialset,
        vel,vold,mi,neij,&nef,nactdoh,ipkonf,lakonf,ielmatf,ielmat,
        ielorienf,ielorien,norien,cs,mcs,tieset,x,y,z,xo,yo,zo,
        nx,ny,nz,co,ifatie));
 
       SFREE(xo);SFREE(yo);SFREE(zo);SFREE(x);SFREE(y);SFREE(z);SFREE(nx);
 
       SFREE(ipoface);
       SFREE(nodface);
       RENEW(neifa,ITG,nflnei);
       RENEW(neiel,ITG,nflnei);
       RENEW(neij,ITG,nflnei);
       RENEW(ielfa,ITG,4*nface);
       RENEW(ifatie,ITG,nface);
       RENEW(ifaext,ITG,nfaext);
       RENEW(isolidsurf,ITG,nsolidsurf);
       RENEW(vfa,double,8*nface);
       RENEW(ipnei,ITG,nef+1);
   }else{
       SFREE(nactdoh);SFREE(nactdohinv);
   }
   if(*ithermal>1){NNEW(qfx,double,3*mi[0]**ne);}
   
   /* contact conditions */
   
   inicont(nk,&ncont,ntie,tieset,nset,set,istartset,iendset,ialset,&itietri,
       lakon,ipkon,kon,&koncont,nslavs,tietol,&ismallsliding,&itiefac,
           &islavsurf,&islavnode,&imastnode,&nslavnode,&nmastnode,
           mortar,&imastop,nkon,&iponoels,&inoels,&ipe,&ime,ne,ifacecount,
       iperturb,ikboun,nboun,co,istep,&xnoels);
   
   if(ncont!=0){
       
       NNEW(cg,double,3*ncont);
       NNEW(straight,double,16*ncont);
       
       /* 11 instead of 10: last position is reserved for the
      local contact spring element number; needed as
      pointer into springarea */
       
       if(*mortar==0){
       RENEW(kon,ITG,*nkon+11**nslavs);
       NNEW(springarea,double,2**nslavs);
       if(*nener==1){
           RENEW(ener,double,mi[0]*(*ne+*nslavs)*2);
 
           /* setting the entries for the friction contact energy to zero */
 
           for(k=mi[0]*(2**ne+*nslavs);k<mi[0]*(*ne+*nslavs)*2;k++){ener[k]=0.;}
       }
       RENEW(ipkon,ITG,*ne+*nslavs);
       RENEW(lakon,char,8*(*ne+*nslavs));
       
       if(*norien>0){
           RENEW(ielorien,ITG,mi[2]*(*ne+*nslavs));
           for(k=mi[2]**ne;k<mi[2]*(*ne+*nslavs);k++) ielorien[k]=0;
       }
 
       RENEW(ielmat,ITG,mi[2]*(*ne+*nslavs));
       for(k=mi[2]**ne;k<mi[2]*(*ne+*nslavs);k++) ielmat[k]=1;
 
       if((maxprevcontel==0)&&(*nslavs!=0)){
           RENEW(xstate,double,*nstate_*mi[0]*(*ne+*nslavs));
           for(k=*nstate_*mi[0]**ne;k<*nstate_*mi[0]*(*ne+*nslavs);k++){
           xstate[k]=0.;
           }
       }
       maxprevcontel=*nslavs;
 
       NNEW(areaslav,double,*ifacecount);
       }else if(*mortar==1){
       NNEW(islavact,ITG,nslavnode[*ntie]);
       if((*istep==1)||(nslavs_prev_step==0)) NNEW(clearini,double,3*9**ifacecount);
 
           /* check whether at least one contact definition involves true contact
              and not just tied contact */
 
       FORTRAN(checktruecontact,(ntie,tieset,tietol,elcon,&itruecontact,
                     ncmat_,ntmat_));
       }
 
       NNEW(xmastnor,double,3*nmastnode[*ntie]);
   }
   
   if(icascade==2){
       memmpcref_=memmpc_;mpcfreeref=mpcfree;maxlenmpcref=maxlenmpc;
       NNEW(nodempcref,ITG,3*memmpc_);
       for(k=0;k<3*memmpc_;k++){nodempcref[k]=nodempc[k];}
       NNEW(coefmpcref,double,memmpc_);
       for(k=0;k<memmpc_;k++){coefmpcref[k]=coefmpc[k];}
   }
   
   if((*ithermal==1)||(*ithermal>=3)){
       NNEW(t1ini,double,*nk);
       NNEW(t1act,double,*nk);
       for(k=0;k<*nk;++k){t1act[k]=t1old[k];}
   }
   
   /* allocating a field for the instantaneous amplitude */
   
   NNEW(ampli,double,*nam);
   
   /* fini is also needed in static calculations if ilin=1
      to get correct values of f after a divergent increment */
 
   NNEW(fini,double,neq[1]);
   
   /* allocating fields for nonlinear dynamics */
   
   if(*nmethod==4){
       mass[0]=1;
       mass[1]=1;
       NNEW(aux2,double,neq[1]);
       NNEW(fextini,double,neq[1]);
       NNEW(fnext,double,mt**nk);
       NNEW(fnextini,double,mt**nk);
       NNEW(veini,double,mt**nk);
       NNEW(accini,double,mt**nk);
       NNEW(adb,double,neq[1]);
       NNEW(aub,double,nzs[1]);
       NNEW(cvini,double,neq[1]);
       NNEW(cv,double,neq[1]);
   }
 
   if((*nstate_!=0)&&((*mortar!=1)||(ncont==0))){
       NNEW(xstateini,double,*nstate_*mi[0]*(*ne+*nslavs));
       for(k=0;k<*nstate_*mi[0]*(*ne+*nslavs);++k){
       xstateini[k]=xstate[k];
       }
   }
   if((*nstate_!=0)&&(*mortar==1)) NNEW(xstateini,double,1);
   NNEW(eei,double,6*mi[0]**ne);
   NNEW(stiini,double,6*mi[0]**ne);
   NNEW(emeini,double,6*mi[0]**ne);
   if(*nener==1)
       NNEW(enerini,double,mi[0]**ne);
   
   qa[0]=qaold[0];
   qa[1]=qaold[1];
   
   /* normalizing the time */
   
   FORTRAN(checktime,(itpamp,namta,tinc,ttime,amta,tmin,inext,&itp,istep,tper));
   dtheta=(*tinc)/(*tper);
 
   /* taking care of a small increment at the end of the step
      for face-to-face penalty contact */
 
   dthetaref=dtheta;
   if((dtheta<=1.e-6)&&(*iexpl<=1)){
       printf("\n *ERROR in nonlingeo\n");
       printf(" increment size smaller than one millionth of step size\n");
       printf(" increase increment size\n\n");
   }
   *tmin=*tmin/(*tper);
   *tmax=*tmax/(*tper);
   theta=0.;
   
   /* calculating an initial flux norm */
   
   if(*ithermal!=2){
       if(qau>1.e-10){qam[0]=qau;}
       else if(qa0>1.e-10){qam[0]=qa0;}
       else if(qa[0]>1.e-10){qam[0]=qa[0];}
       else {qam[0]=1.e-2;}
   }
   if(*ithermal>1){
       if(qau>1.e-10){qam[1]=qau;}
       else if(qa0>1.e-10){qam[1]=qa0;}
       else if(qa[1]>1.e-10){qam[1]=qa[1];}
       else {qam[1]=1.e-2;}
   }
   
   /* storing the element and topology information before introducing 
      contact elements */
   
   ne0=*ne;nkon0=*nkon;neold=*ne;
   
   /*********************************************************************/
   
   /* calculating of the acceleration due to force discontinuities
      (external - internal force) at the start of a step */
   
   /*********************************************************************/
   
   if((*nmethod==4)&&(*ithermal!=2)&&(icfd!=1)){
       bet=(1.-*alpha)*(1.-*alpha)/4.;
       gam=0.5-*alpha;
 
       /* initialization of the energy */
 
       if(ithermal[0]<=1){
       for(k=0;k<mi[0]*ne0;++k){enerini[k]=ener[k];}
       }
       energyini[3]=energy[3];
       
       /* calculating the stiffness and mass matrix */
       
       reltime=0.;
       time=0.;
       dtime=0.;
       
       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,itg,&ntg,amname,ikboun,ilboun,nelemload,sideload,mi,
               ntrans,trab,inotr,veold,integerglob,doubleglob,tieset,istartset,
               iendset,ialset,ntie,nmpc,ipompc,ikmpc,ilmpc,nodempc,coefmpc,
               ipobody,iponoel,inoel));
       
       time=0.;
       dtime=1.;
     
       /*  updating the nonlinear mpc's (also affects the boundary
       conditions through the nonhomogeneous part of the mpc's)
       if contact arises the number of MPC's can also change */
       
       cam[0]=0.;cam[1]=0.;cam[2]=0.;
       
       if(icascade==2){
       memmpc_=memmpcref_;mpcfree=mpcfreeref;maxlenmpc=maxlenmpcref;
       RENEW(nodempc,ITG,3*memmpcref_);
       for(k=0;k<3*memmpcref_;k++){nodempc[k]=nodempcref[k];}
       RENEW(coefmpc,double,memmpcref_);
       for(k=0;k<memmpcref_;k++){coefmpc[k]=coefmpcref[k];}
       }
 
       newstep=0;
       FORTRAN(nonlinmpc,(co,vold,ipompc,nodempc,coefmpc,labmpc,
              nmpc,ikboun,ilboun,nboun,xbounold,aux,iaux,
              &maxlenmpc,ikmpc,ilmpc,&icascade,
              kon,ipkon,lakon,ne,&reltime,&newstep,xboun,fmpc,
              &iit,&idiscon,&ncont,trab,ntrans,ithermal,mi));
       if(icascade==2){
 //    memmpcref_=memmpc_;mpcfreeref=mpcfree;
 //    RENEW(nodempcref,ITG,3*memmpc_);
       for(k=0;k<3*memmpc_;k++){nodempcref[k]=nodempc[k];}
 //    RENEW(coefmpcref,double,memmpc_);
       for(k=0;k<memmpc_;k++){coefmpcref[k]=coefmpc[k];}
       }
       
       if(icascade>0) remastruct(ipompc,&coefmpc,&nodempc,nmpc,
           &mpcfree,nodeboun,ndirboun,nboun,ikmpc,ilmpc,ikboun,ilboun,
           labmpc,nk,&memmpc_,&icascade,&maxlenmpc,
           kon,ipkon,lakon,ne,nactdof,icol,jq,&irow,isolver,
           neq,nzs,nmethod,&f,&fext,&b,&aux2,&fini,&fextini,
           &adb,&aub,ithermal,iperturb,mass,mi,iexpl,mortar,
           typeboun,&cv,&cvini,&iit,network);
       
       /* invert nactdof */
 
       SFREE(nactdofinv);
       NNEW(nactdofinv,ITG,1);
       
       iout=-1;
       ielas=1;
       
       NNEW(fn,double,mt**nk);
       NNEW(stx,double,6*mi[0]**ne);
       
       NNEW(inum,ITG,*nk);
       results(co,nk,kon,ipkon,lakon,ne,vold,stn,inum,stx,
           elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat,
           ielorien,norien,orab,ntmat_,t0,t1old,ithermal,
           prestr,iprestr,filab,eme,emn,een,iperturb,
           f,fn,nactdof,&iout,qa,vold,b,nodeboun,
           ndirboun,xbounold,nboun,ipompc,
           nodempc,coefmpc,labmpc,nmpc,nmethod,cam,&neq[1],veold,accold,&bet,
           &gam,&dtime,&time,ttime,plicon,nplicon,plkcon,nplkcon,
           xstateini,xstiff,xstate,npmat_,epn,matname,mi,&ielas,&icmd,
           ncmat_,nstate_,sti,vini,ikboun,ilboun,ener,enern,emeini,xstaten,
           eei,enerini,cocon,ncocon,set,nset,istartset,iendset,
           ialset,nprint,prlab,prset,qfx,qfn,trab,inotr,ntrans,fmpc,
           nelemload,nload,ikmpc,ilmpc,istep,&iinc,springarea,&reltime,
           &ne0,xforc,nforc,thicke,shcon,nshcon,
           sideload,xloadact,xloadold,&icfd,inomat,pslavsurf,pmastsurf,
           mortar,islavact,cdn,islavnode,nslavnode,ntie,clearini,
           islavsurf,ielprop,prop,energyini,energy,&kscale,iponoel,
               inoel,nener,orname,network,ipobody,xbodyact,ibody);
       
       SFREE(fn);SFREE(stx);SFREE(inum);
       
       iout=0;
       ielas=0;
       
       reltime=0.;
       time=0.;
       dtime=0.;
       
       if(*iexpl<=1){intscheme=1;}
       
       /* in mafillsm the stiffness and mass matrix are computed;
      The primary aim is to calculate the mass matrix (not 
      lumped for an implicit dynamic calculation, lumped for an
      explicit dynamic calculation). However:
      - for an implicit calculation the mass matrix is "doped" with
      a small amount of stiffness matrix, therefore the calculation
      of the stiffness matrix is needed.
      - for an explicit calculation the stiffness matrix is not 
      needed at all. Since the calculation of the mass matrix alone
      is not possible in mafillsm, the determination of the stiffness
      matrix is taken as unavoidable "ballast". */
       
       NNEW(ad,double,neq[1]);
       NNEW(au,double,nzs[1]);
 
 #ifdef COMPANY
       if(*ithermal<2){
 #endif    
     mafillsmmain(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,fext,nactdof,icol,jq,irow,neq,nzl,
           nmethod,ikmpc,ilmpc,ikboun,ilboun,
           elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,
           ielmat,ielorien,norien,orab,ntmat_,
           t0,t1act,ithermal,prestr,iprestr,vold,iperturb,sti,
           nzs,stx,adb,aub,iexpl,plicon,nplicon,plkcon,nplkcon,
           xstiff,npmat_,&dtime,matname,mi,
                   ncmat_,mass,&stiffness,&buckling,&rhsi,&intscheme,
                   physcon,shcon,nshcon,cocon,ncocon,ttime,&time,istep,&iinc,
           &coriolis,ibody,xloadold,&reltime,veold,springarea,nstate_,
                   xstateini,xstate,thicke,integerglob,doubleglob,
           tieset,istartset,iendset,ialset,ntie,&nasym,pslavsurf,
           pmastsurf,mortar,clearini,ielprop,prop,&ne0,fnext,&kscale,
           iponoel,inoel,network);
 #ifdef COMPANY
       }else{
       FORTRAN(mafillsm_company,(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,fext,nactdof,icol,jq,irow,neq,nzl,
           nmethod,ikmpc,ilmpc,ikboun,ilboun,
           elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,
           ielmat,ielorien,norien,orab,ntmat_,
           t0,t1act,ithermal,prestr,iprestr,vold,iperturb,sti,
           nzs,stx,adb,aub,iexpl,plicon,nplicon,plkcon,nplkcon,
           xstiff,npmat_,&dtime,matname,mi,
                   ncmat_,mass,&stiffness,&buckling,&rhsi,&intscheme,
                   physcon,shcon,nshcon,cocon,ncocon,ttime,&time,istep,&iinc,
           &coriolis,ibody,xloadold,&reltime,veold,springarea,nstate_,
                   xstateini,xstate,thicke,integerglob,doubleglob,
           tieset,istartset,iendset,ialset,ntie,&nasym,pslavsurf,
           pmastsurf,mortar,clearini,ielprop,prop,&ne0,fnext,&kscale,
           iponoel,inoel,network));
       }
 #endif    
       
       if(*nmethod==0){
       
       /* error occurred in mafill: storing the geometry in frd format */
       
       ++*kode;
       if(strcmp1(&filab[1044],"ZZS")==0){
           NNEW(neigh,ITG,40**ne);
           NNEW(ipneigh,ITG,*nk);
       }
       
       ptime=*ttime+time;
       frd(co,nk,kon,ipkon,lakon,&ne0,v,stn,inum,nmethod,
           kode,filab,een,t1,fn,&ptime,epn,ielmat,matname,enern,xstaten,
           nstate_,istep,&iinc,ithermal,qfn,&mode,&noddiam,trab,inotr,
           ntrans,orab,ielorien,norien,description,ipneigh,neigh,
           mi,sti,vr,vi,stnr,stni,vmax,stnmax,&ngraph,veold,ener,ne,
           cs,set,nset,istartset,iendset,ialset,eenmax,fnr,fni,emn,
           thicke,jobnamec,output,qfx,cdn,mortar,cdnr,cdni,nmat);
       
       if(strcmp1(&filab[1044],"ZZS")==0){SFREE(ipneigh);SFREE(neigh);}      
 #ifdef COMPANY
       FORTRAN(uout,(v,mi,ithermal,filab));
 #endif    
       FORTRAN(stop,());
       
       }
       
       /* mass x acceleration = f(external)-f(internal) 
      only for the mechanical loading*/
       
       for(k=0;k<neq[0];++k){
       b[k]=fext[k]-f[k];
       }
       
       if(*iexpl<=1){
       
       /* a small amount of stiffness is added to the mass matrix
          otherwise the system leads to huge accelerations in 
          case of discontinuous load changes at the start of the step */
       
       dtime=*tinc/10.;
       scal1=bet*dtime*dtime*(1.+*alpha);
       for(k=0;k<neq[0];++k){
           ad[k]=adb[k]+scal1*ad[k];
       }
       for(k=0;k<nzs[0];++k){
           au[k]=aub[k]+scal1*au[k];
       }
       if(*isolver==0){
 #ifdef SPOOLES
           spooles(ad,au,adb,aub,&sigma,b,icol,irow,&neq[0],&nzs[0],
               &symmetryflag,&inputformat,&nzs[2]);
 #else
           printf(" *ERROR in nonlingeo: the SPOOLES library is not linked\n\n");
           FORTRAN(stop,());
 #endif
       }
       else if((*isolver==2)||(*isolver==3)){
           preiter(ad,&au,b,&icol,&irow,&neq[0],&nzs[0],isolver,iperturb);
       }
       else if(*isolver==4){
 #ifdef SGI
           token=1;
           sgi_main(ad,au,adb,aub,&sigma,b,icol,irow,&neq[0],&nzs[0],token);
 #else
           printf(" *ERROR in nonlingeo: the SGI library is not linked\n\n");
           FORTRAN(stop,());
 #endif
       }
       else if(*isolver==5){
 #ifdef TAUCS
           tau(ad,&au,adb,aub,&sigma,b,icol,&irow,&neq[0],&nzs[0]);
 #else
           printf(" *ERROR in nonlingeo: the TAUCS library is not linked\n\n");
           FORTRAN(stop,());
 #endif
       }
       else if(*isolver==7){
 #ifdef PARDISO
           pardiso_main(ad,au,adb,aub,&sigma,b,icol,irow,&neq[0],&nzs[0],
                &symmetryflag,&inputformat,jq,&nzs[2]);
 #else
           printf(" *ERROR in nonlingeo: the PARDISO library is not linked\n\n");
           FORTRAN(stop,());
 #endif
       }
       }
       
       else{
       for(k=0;k<neq[0];++k){
           b[k]=(fext[k]-f[k])/adb[k];
       }
       }
       
       /* for thermal loading the acceleration is set to zero */
       
       for(k=neq[0];k<neq[1];++k){
       b[k]=0.;
       }
       
       /* calculating the displacements, stresses and forces */
       
       NNEW(v,double,mt**nk);
       memcpy(&v[0],&vold[0],sizeof(double)*mt**nk);
       
       NNEW(stx,double,6*mi[0]**ne);
       NNEW(fn,double,mt**nk);
       
       /* setting a "special" time consisting of the first primes;
          used to recognize the initial acceleration procedure
          in file resultsini.f */
 
       NNEW(inum,ITG,*nk);
       dtime=1.235711130e-20;
       results(co,nk,kon,ipkon,lakon,ne,v,stn,inum,stx,
           elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat,
           ielorien,norien,orab,ntmat_,t0,t1act,ithermal,
           prestr,iprestr,filab,eme,emn,een,iperturb,
           f,fn,nactdof,&iout,qa,vold,b,nodeboun,
           ndirboun,xbounact,nboun,ipompc,
           nodempc,coefmpc,labmpc,nmpc,nmethod,cam,&neq[1],veold,accold,
           &bet,&gam,&dtime,&time,ttime,plicon,nplicon,plkcon,nplkcon,
           xstateini,xstiff,xstate,npmat_,epn,matname,mi,&ielas,
           &icmd,ncmat_,nstate_,stiini,vini,ikboun,ilboun,ener,enern,
           emeini,xstaten,eei,enerini,cocon,ncocon,set,nset,istartset,
           iendset,ialset,nprint,prlab,prset,qfx,qfn,trab,inotr,ntrans,
           fmpc,nelemload,nload,ikmpc,ilmpc,istep,&iinc,springarea,
           &reltime,&ne0,xforc,nforc,thicke,shcon,nshcon,
           sideload,xloadact,xloadold,&icfd,inomat,pslavsurf,pmastsurf,
           mortar,islavact,cdn,islavnode,nslavnode,ntie,clearini,
               islavsurf,ielprop,prop,energyini,energy,&kscale,iponoel,
               inoel,nener,orname,network,ipobody,xbodyact,ibody);
       SFREE(inum);
       dtime=0.;
 
       memcpy(&vold[0],&v[0],sizeof(double)*mt**nk);
       if(*ithermal!=2){
       for(k=0;k<6*mi[0]*ne0;++k){
           sti[k]=stx[k];
       }
       }
 
       SFREE(v);SFREE(stx);SFREE(fn);
       SFREE(ad);SFREE(au);
       
       /* the mass matrix is kept for subsequent calculations, therefore,
      no new mass calculation is necessary for the remaining iterations
      in the present step */
       
       mass[0]=0;intscheme=0;
       energyref=energy[0]+energy[1]+energy[2]+energy[3];
 
       /* carlo start */
 
       if(*iexpl>1){
       
       /* CMT: Calculation of stable time increment according to
          Courant's Law  CARLO MT*/
       
       FORTRAN(calcmatwavspeed,(ne,elcon,nelcon,
           rhcon,nrhcon,alcon,nalcon,orab,ntmat_,ithermal,alzero,
           plicon,nplicon,plkcon,nplkcon,npmat_,mi,&dtime,
           xstiff,ncmat_,vold,ielmat,t0,t1,
           matname,lakon,wavespeed,nmat,ipkon));
       
       FORTRAN(calcstabletimeincvol,(&ne0,lakon,co,kon,ipkon,mi,
                   ielmat,&dtvol,alpha,wavespeed));
       
       printf(" ++CMT DEBUG: courant criterion for stability time inc=%e\n",dtvol);
       *tinc=dtvol;
       dtheta=(*tinc)/(*tper);
       dthetaref=dtheta;
       
       } else {
               // # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
               // MPADD start
       /* lumping of the mass matrix for implict calculations to 
          midify the increment time when contact is involved
       */
       
       NNEW(tmp,double,neq[1]);
       NNEW(adblump,double,neq[1]);
       for(k=0;k<neq[1];k++){
         tmp[k] = 1;
       }
       if(nasym==0){
         FORTRAN(op,(&neq[1],tmp,adblump,adb,aub,jq,irow)); 
       }else{
         FORTRAN(opas,(&neq[1],tmp,adblump,adb,aub,jq,irow,nzs)); 
       }
       SFREE(tmp);
       
       // MPADD end
       // # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
       }
 
       /* carlo end */
       
   }
   
   if(*iexpl>1) icmd=3;
   
   /**************************************************************/
   /* starting the loop over the increments                      */
   /**************************************************************/
   
   newstep=1;
       
 //    MPADD start
   if((*nmethod==4)&&(*ithermal<2)&&(*iexpl<=1)){
       neini=*ne;
       for(k=0;k<4;k++){
       energystartstep[k]=energy[k];
       }
       emax=0.1*energyref; // Anti-stuck at the beginning of simulation
   } 
 //    MPADD end
 
   /* saving the distributed loads (volume heating will be
      added because of friction heating) */
 
   if((*ithermal==3)&&(ncont!=0)&&(*mortar==1)&&(*ncmat_>=11)){
       nloadref=*nload;
       NNEW(nelemloadref,ITG,2**nload);
       if(*nam>0) NNEW(iamloadref,ITG,2**nload);
       NNEW(sideloadref,char,20**nload);
       
       memcpy(&nelemloadref[0],&nelemload[0],sizeof(ITG)*2**nload);
       if(*nam>0) memcpy(&iamloadref[0],&iamload[0],sizeof(ITG)*2**nload);
       memcpy(&sideloadref[0],&sideload[0],sizeof(char)*20**nload);
   }
   
   while((1.-theta>1.e-6)||(negpres==1)){
       
       if(icutb==0){
       
       /* previous increment converged: update the initial values */
       
       iinc++;
       jprint++;
 
           /* store number of elements (important for implicit dynamic
              contact */
 
       neini=*ne;
       
       /* vold is copied into vini */
       
       memcpy(&vini[0],&vold[0],sizeof(double)*mt**nk);
       
       for(k=0;k<*nboun;++k){xbounini[k]=xbounact[k];}
       if((*ithermal==1)||(*ithermal>=3)){
           for(k=0;k<*nk;++k){t1ini[k]=t1act[k];}
       }
       for(k=0;k<neq[1];++k){
           fini[k]=f[k];
       }
       if(*nmethod==4){
           for(k=0;k<mt**nk;++k){
           veini[k]=veold[k];
           accini[k]=accold[k];
           fnextini[k]=fnext[k];
           }
           for(k=0;k<neq[1];++k){
           fextini[k]=fext[k];
           cvini[k]=cv[k];
           }
           if(*ithermal<2){
           allwkini=allwk;
           // MPADD start
           if(idamping==1)dampwkini = dampwk;
           for(k=0;k<4;k++){
             energyini[k]=energy[k];
           }
           // MPADD end
           }
       }
       if(*ithermal!=2){
           for(k=0;k<6*mi[0]*ne0;++k){
           stiini[k]=sti[k];
           emeini[k]=eme[k];
           }
       }
       if(*nener==1)
           for(k=0;k<mi[0]*ne0;++k){enerini[k]=ener[k];}
 
       if(*mortar!=1){
           if(*nstate_!=0){
           for(k=0;k<*nstate_*mi[0]*(ne0+*nslavs);++k){
               xstateini[k]=xstate[k];
           }
           }
       } 
       }
       
       /* check for max. # of increments */
       
       if(iinc>*jmax){
       printf(" *ERROR: max. # of increments reached\n\n");
       FORTRAN(stop,());
       }
       printf(" increment %" ITGFORMAT " attempt %" ITGFORMAT " \n",iinc,icutb+1);
       printf(" increment size= %e\n",dtheta**tper);
       printf(" sum of previous increments=%e\n",theta**tper);
       printf(" actual step time=%e\n",(theta+dtheta)**tper);
       printf(" actual total time=%e\n\n",*ttime+(theta+dtheta)**tper);
       
       printf(" iteration 1\n\n");
       
       qamold[0]=qam[0];
       qamold[1]=qam[1];
 
       icntrl=0;
 
       /* restoring the distributed loading before adding the
          friction heating */
 
       if((*ithermal==3)&&(ncont!=0)&&(*mortar==1)&&(*ncmat_>=11)){
       *nload=nloadref;
       memcpy(&nelemload[0],&nelemloadref[0],sizeof(ITG)*2**nload);
       if(*nam>0){
           memcpy(&iamload[0],&iamloadref[0],sizeof(ITG)*2**nload);
       }
       memcpy(&sideload[0],&sideloadref[0],sizeof(char)*20**nload);
       }
       
       /* determining the actual loads at the end of the new increment*/
       
       reltime=theta+dtheta;
       time=reltime**tper;
       dtime=dtheta**tper;
       
       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,itg,&ntg,amname,ikboun,ilboun,nelemload,sideload,mi,
               ntrans,trab,inotr,veold,integerglob,doubleglob,tieset,istartset,
               iendset,ialset,ntie,nmpc,ipompc,ikmpc,ilmpc,nodempc,coefmpc,
               ipobody,iponoel,inoel));
       
       for(i=0;i<3;i++){cam[i]=0.;}for(i=3;i<5;i++){cam[i]=0.5;}
       if(*ithermal>1){
       radflowload(itg,ieg,&ntg,&ntr,adrad,aurad,bcr,ipivr,
              ac,bc,nload,sideload,nelemload,xloadact,lakon,ipiv,ntmat_,vold,
              shcon,nshcon,ipkon,kon,co,
              kontri,&ntri,nloadtr,tarea,tenv,physcon,erad,&adview,&auview,
              nflow,ikboun,xbounact,nboun,ithermal,&iinc,&iit,
              cs,mcs,inocs,&ntrit,nk,fenv,istep,&dtime,ttime,&time,ilboun,
              ikforc,ilforc,xforcact,nforc,cam,ielmat,&nteq,prop,ielprop,
              nactdog,nacteq,nodeboun,ndirboun,network,
              rhcon,nrhcon,ipobody,ibody,xbodyact,nbody,iviewfile,jobnamef,
              ctrl,xloadold,&reltime,nmethod,set,mi,istartset,iendset,ialset,nset,
              ineighe,nmpc,nodempc,ipompc,coefmpc,labmpc,&iemchange,nam,iamload,
              jqrad,irowrad,&nzsrad,icolrad,ne,iaxial,qa,cocon,ncocon,iponoel,
              inoel,nprop,amname,namta,amta);
              
               /* check whether network iterations converged */
 
       if(qa[2]>0){
           checkdivergence(co,nk,kon,ipkon,lakon,ne,stn,nmethod, 
                kode,filab,een,t1act,&time,epn,ielmat,matname,enern, 
                xstaten,nstate_,istep,&iinc,iperturb,ener,mi,output,
                    ithermal,qfn,&mode,&noddiam,trab,inotr,ntrans,orab,
                ielorien,norien,description,sti,&icutb,&iit,&dtime,qa,
                vold,qam,ram1,ram2,ram,cam,uam,&ntg,ttime,&icntrl,
                &theta,&dtheta,veold,vini,idrct,tper,&istab,tmax, 
                nactdof,b,tmin,ctrl,amta,namta,itpamp,inext,&dthetaref,
                    &itp,&jprint,jout,&uncoupled,t1,&iitterm,nelemload,
                    nload,nodeboun,nboun,itg,ndirboun,&deltmx,&iflagact,
                set,nset,istartset,iendset,ialset,emn,thicke,jobnamec,
                mortar,nmat,ielprop,prop,&ialeatoric,&kscale,
                    energy, &allwk,&energyref,&emax,&r_abs,&enetoll,energyini,
                &allwkini,&temax,&sizemaxinc,&ne0,&neini,&dampwk,
                &dampwkini,energystartstep);
 
               /* the divergence is flagged by icntrl!=0
                  icutb is reset to zero in order to generate
                  regular contact elements etc.. */
 
           icutb--;
       }
       }
       
       if(icfd==1){
       compfluid(&co,nk,&ipkonf,konf,&lakonf,&sideface,
             ifreestream,&nfreestream,isolidsurf,neighsolidsurf,&nsolidsurf,
             nshcon,shcon,nrhcon,rhcon,&vold,ntmat_,nodeboun,
             ndirboun,nboun,ipompc,nodempc,nmpc,ikmpc,ilmpc,ithermal,
             ikboun,ilboun,&iturbulent,isolver,iexpl,ttime,
             &time,&dtime,nodeforc,ndirforc,xforc,nforc,nelemload,sideload,
             xload,nload,xbody,ipobody,nbody,ielmatf,matname,mi,ncmat_,
             physcon,istep,&iinc,ibody,xloadold,xboun,coefmpc,
             nmethod,xforcold,xforcact,iamforc,iamload,xbodyold,xbodyact,
             t1old,t1,t1act,iamt1,amta,namta,nam,ampli,xbounold,xbounact,
         iamboun,itg,&ntg,amname,t0,&nelemface,&nface,cocon,ncocon,xloadact,
         tper,jmax,jout,set,nset,istartset,iendset,ialset,prset,prlab,
         nprint,trab,inotr,ntrans,filab,labmpc,sti,norien,orab,jobnamef,
         tieset,ntie,mcs,ics,cs,nkon,&mpcfree,&memmpc_,fmpc,&nef,&inomat,
         qfx,neifa,neiel,ielfa,ifaext,vfa,vel,ipnei,&nflnei,&nfaext,
         typeboun,neij,tincf,nactdoh,nactdohinv,ielorienf,jobnamec,
         ifatie,nstate_,xstate,orname,&nblk,ielblk,istartblk,iendblk,
         nblket,nblkze,kon);
 
       /* determining the global values to be used as boundary conditions
          for a submodel */
       
       SFREE(integerglob);SFREE(doubleglob);
       getglobalresults(jobnamec,&integerglob,&doubleglob,nboun,iamboun,
                xboun,nload,sideload,iamload,&iglob,nforc,iamforc,
                            xforc,ithermal,nk,t1,iamt1);
       }
       
       if(icascade==2){
       memmpc_=memmpcref_;mpcfree=mpcfreeref;maxlenmpc=maxlenmpcref;
       RENEW(nodempc,ITG,3*memmpcref_);
       for(k=0;k<3*memmpcref_;k++){nodempc[k]=nodempcref[k];}
       RENEW(coefmpc,double,memmpcref_);
       for(k=0;k<memmpcref_;k++){coefmpc[k]=coefmpcref[k];}
       }
 
       /* generating contact elements */
       
       if((ncont!=0)&&(*mortar<=1)&&
 /*       for purely thermal calculations: determine contact integration
          points only at the start of a step */
          ((*ithermal!=2)||(iit==-1))){
 
       *ne=ne0;*nkon=nkon0;
 
       /* at start of new increment: 
              - copy state variables (node-to-face)
          - determine slave integration points (face-to-face)
          - interpolate state variables (face-to-face) */
 
       if(icutb==0){
           if(*mortar==1){
 
           if(*nstate_!=0){
               if(maxprevcontel!=0){
               if(iit!=-1){
                   NNEW(islavsurfold,ITG,2**ifacecount+2);
                   NNEW(pslavsurfold,double,3**nintpoint);
                   memcpy(&islavsurfold[0],&islavsurf[0],
                      sizeof(ITG)*(2**ifacecount+2));
                   memcpy(&pslavsurfold[0],&pslavsurf[0],
                      sizeof(double)*(3**nintpoint));
               }
               }
           }
 
           *nintpoint=0;
 
           /* determine the location of the slave integration
                      points */
 
           precontact(&ncont,ntie,tieset,nset,set,istartset,
                      iendset,ialset,itietri,lakon,ipkon,kon,koncont,ne,
                      cg,straight,co,vold,istep,&iinc,&iit,itiefac,
                      islavsurf,islavnode,imastnode,nslavnode,nmastnode,
                      imastop,mi,ipe,ime,tietol,&iflagact,
              nintpoint,&pslavsurf,xmastnor,cs,mcs,ics,clearini,
                      nslavs);
           
           /* changing the dimension of element-related fields */
           
           RENEW(kon,ITG,*nkon+22**nintpoint);
           RENEW(springarea,double,2**nintpoint);
           RENEW(pmastsurf,double,6**nintpoint);
           
           if(*nener==1){
               RENEW(ener,double,mi[0]*(*ne+*nintpoint)*2);
 
               /* setting the entries for the friction contact energy to zero */
 
               for(k=mi[0]*(2**ne+*nintpoint);k<mi[0]*(*ne+*nintpoint)*2;k++){ener[k]=0.;}
 
           }
           RENEW(ipkon,ITG,*ne+*nintpoint);
           RENEW(lakon,char,8*(*ne+*nintpoint));
           
           if(*norien>0){
               RENEW(ielorien,ITG,mi[2]*(*ne+*nintpoint));
               for(k=mi[2]**ne;k<mi[2]*(*ne+*nintpoint);k++) ielorien[k]=0;
           }
           RENEW(ielmat,ITG,mi[2]*(*ne+*nintpoint));
           for(k=mi[2]**ne;k<mi[2]*(*ne+*nintpoint);k++) ielmat[k]=1;
 
                   /* interpolating the state variables */
 
           if(*nstate_!=0){
               if(maxprevcontel!=0){
               RENEW(xstateini,double,
                                 *nstate_*mi[0]*(ne0+maxprevcontel));
               for(k=*nstate_*mi[0]*ne0;
                                 k<*nstate_*mi[0]*(ne0+maxprevcontel);++k){
                   xstateini[k]=xstate[k];
               }
               }
               
               RENEW(xstate,double,*nstate_*mi[0]*(ne0+*nintpoint));
               for(k=*nstate_*mi[0]*ne0;k<*nstate_*mi[0]*(ne0+*nintpoint);k++){
               xstate[k]=0.;
               }
               
               if((*nintpoint>0)&&(maxprevcontel>0)){
               iex=2;
               
               /* interpolation of xstate */
               
               FORTRAN(interpolatestate,(ne,ipkon,kon,lakon,
                                &ne0,mi,xstate,pslavsurf,nstate_,
                                xstateini,islavsurf,islavsurfold,
                    pslavsurfold,tieset,ntie,itiefac));
               
               }
 
               if(maxprevcontel!=0){
               SFREE(islavsurfold);SFREE(pslavsurfold);
               }
 
               maxprevcontel=*nintpoint;
 
               RENEW(xstateini,double,*nstate_*mi[0]*(ne0+*nintpoint));
               for(k=0;k<*nstate_*mi[0]*(ne0+*nintpoint);++k){
               xstateini[k]=xstate[k];
               }
           }
 
           }
       }
 
       contact(&ncont,ntie,tieset,nset,set,istartset,iendset,
           ialset,itietri,lakon,ipkon,kon,koncont,ne,cg,straight,nkon,
           co,vold,ielmat,cs,elcon,istep,&iinc,&iit,ncmat_,ntmat_,
           &ne0,vini,nmethod,
           iperturb,ikboun,nboun,mi,imastop,nslavnode,islavnode,
                   islavsurf,
           itiefac,areaslav,iponoels,inoels,springarea,tietol,&reltime,
           imastnode,nmastnode,xmastnor,filab,mcs,ics,&nasym,
           xnoels,mortar,pslavsurf,pmastsurf,clearini,&theta,
               xstateini,xstate,nstate_,&icutb,&ialeatoric,jobnamef);
    
       /* check whether, for a dynamic calculation, damping is involved */
 
       if(*nmethod==4){
           if(*iexpl<=1){
           if(idampingwithoutcontact==0){
               for(i=0;i<*ne;i++){
               if(ipkon[i]<0) continue;
               if(*ncmat_>=5){
                   if(strcmp1(&lakon[i*8],"ES")==0){
                   if(strcmp1(&lakon[i*8+6],"C")==0){
                       imat=ielmat[i*mi[2]];
                       if(elcon[(*ncmat_+1)**ntmat_*(imat-1)+4]>0.){
                       idamping=1;break;
                       }
                   }
                   }
               }
               }
           }
           }
       }
       
       printf(" Number of contact spring elements=%" ITGFORMAT "\n\n",*ne-ne0);
             
       /* carlo start */
 
       if((*iexpl>1)){
           
           if((*ne-ne0)<ncontacts){
           ncontacts=*ne-ne0;
           inccontact=0;
           }  
           else if((*ne-ne0)>ncontacts)  {           
           
           FORTRAN(calcstabletimeinccont,(ne,lakon,kon,ipkon,mi,
               ielmat,elcon,mortar,adb,alpha,nactdof,springarea,
               &ne0,ntmat_,ncmat_,&dtcont));
 
           if(dtcont<*tinc)*tinc=dtcont;
           dtheta=(*tinc)/(*tper);
           dthetaref=dtheta;
 
           ncontacts=*ne-ne0; 
           inccontact=0;
           }else if((inccontact==500)&&(ncontacts==0)){
           *tinc=dtvol;
           dtheta=(*tinc)/(*tper);
           dthetaref=dtheta;
 
           dtcont=1.e30;
           } 
           inccontact++;
       }
       
           /* carlo end */
 
       }
       
       /*  updating the nonlinear mpc's (also affects the boundary
       conditions through the nonhomogeneous part of the mpc's) */
       
       FORTRAN(nonlinmpc,(co,vold,ipompc,nodempc,coefmpc,labmpc,
              nmpc,ikboun,ilboun,nboun,xbounact,aux,iaux,
              &maxlenmpc,ikmpc,ilmpc,&icascade,
              kon,ipkon,lakon,ne,&reltime,&newstep,xboun,fmpc,
              &iit,&idiscon,&ncont,trab,ntrans,ithermal,mi));
       
       if(icascade==2){
       for(k=0;k<3*memmpc_;k++){nodempcref[k]=nodempc[k];}
       for(k=0;k<memmpc_;k++){coefmpcref[k]=coefmpc[k];}
       }
       
       if((icascade>0)||(ncont!=0)) remastruct(ipompc,&coefmpc,&nodempc,nmpc,
       &mpcfree,nodeboun,ndirboun,nboun,ikmpc,ilmpc,ikboun,ilboun,
       labmpc,nk,&memmpc_,&icascade,&maxlenmpc,
       kon,ipkon,lakon,ne,nactdof,icol,jq,&irow,isolver,
       neq,nzs,nmethod,&f,&fext,&b,&aux2,&fini,&fextini,
       &adb,&aub,ithermal,iperturb,mass,mi,iexpl,mortar,
       typeboun,&cv,&cvini,&iit,network);
       
       /* invert nactdof */
       
       SFREE(nactdofinv);
       NNEW(nactdofinv,ITG,mt**nk);
       NNEW(nodorig,ITG,*nk);
       FORTRAN(gennactdofinv,(nactdof,nactdofinv,nk,mi,nodorig,
                  ipkon,lakon,kon,ne));
       SFREE(nodorig);
       
       /* check whether the forced displacements changed; if so, and
      if the procedure is static, the first iteration has to be
      purely linear elastic, in order to get an equilibrium
      displacement field; otherwise huge (maybe nonelastic)
      stresses may occur, jeopardizing convergence */
       
       ilin=0;
       
       /* only for iinc=1 a linearized calculation is performed, since
      for iinc>1 a reasonable displacement field is predicted by using the
      initial velocity field at the end of the last increment */
       
       if((iinc==1)&&(*ithermal<2)){
       dev=0.;
       for(k=0;k<*nboun;++k){
           err=fabs(xbounact[k]-xbounini[k]);
           if(err>dev){dev=err;}
       }
       if(dev>1.e-5) ilin=1;
       }
       
       /* prediction of the kinematic vectors  */
       
       NNEW(v,double,mt**nk);
       
       prediction(uam,nmethod,&bet,&gam,&dtime,ithermal,nk,veold,accold,v,
          &iinc,&idiscon,vold,nactdof,mi);
       
       NNEW(fn,double,mt**nk);
       NNEW(stx,double,6*mi[0]**ne);
       
       /* determining the internal forces at the start of the increment
      
      for a static calculation with increased forced displacements
      the linear strains are calculated corresponding to
      
      the displacements at the end of the previous increment, extrapolated
      if appropriate (for nondispersive media) +
      the forced displacements at the end of the present increment +
      the temperatures at the end of the present increment (this sum is
      v) -
      the displacements at the end of the previous increment (this is vold)
      
      these linear strains are converted in stresses by multiplication
      with the tangent element stiffness matrix and converted into nodal
      forces. 
      
      this boils down to the fact that the effect of forced displacements
      should be handled in a purely linear way at the
      start of a new increment, in order to speed up the convergence and
      (for dissipative media) guarantee smooth loading within the increment.
      
      for all other cases the nodal force calculation is based on
      the true stresses derived from the appropriate strain tensor taking
      into account the extrapolated displacements at the end of the 
      previous increment + the forced displacements and the temperatures
      at the end of the present increment */
       
       iout=-1;
       iperturb_sav[0]=iperturb[0];
       iperturb_sav[1]=iperturb[1];
       
       /* first iteration in first increment: elastic tangent */
       
       if((*nmethod!=4)&&(ilin==1)){
       
       ielas=1;
       
       iperturb[0]=-1;
       iperturb[1]=0;
       
       for(k=0;k<neq[1];++k){b[k]=f[k];}
       NNEW(inum,ITG,*nk);
       results(co,nk,kon,ipkon,lakon,ne,v,stn,inum,stx,
           elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat,
           ielorien,norien,orab,ntmat_,t1ini,t1act,ithermal,
           prestr,iprestr,filab,eme,emn,een,iperturb,
           f,fn,nactdof,&iout,qa,vold,b,nodeboun,
           ndirboun,xbounact,nboun,ipompc,
           nodempc,coefmpc,labmpc,nmpc,nmethod,cam,&neq[1],veold,accold,
           &bet,&gam,&dtime,&time,ttime,plicon,nplicon,plkcon,nplkcon,
           xstateini,xstiff,xstate,npmat_,epn,matname,mi,&ielas,
           &icmd, ncmat_,nstate_,stiini,vini,ikboun,ilboun,ener,enern,
           emeini,xstaten,eei,enerini,cocon,ncocon,set,nset,istartset,
           iendset,ialset,nprint,prlab,prset,qfx,qfn,trab,inotr,ntrans,
           fmpc,nelemload,nload,ikmpc,ilmpc,istep,&iinc,springarea,
           &reltime,&ne0,xforc,nforc,thicke,shcon,nshcon,
           sideload,xloadact,xloadold,&icfd,inomat,pslavsurf,pmastsurf,
           mortar,islavact,cdn,islavnode,nslavnode,ntie,clearini,
                   islavsurf,ielprop,prop,energyini,energy,&kscale,iponoel,
                   inoel,nener,orname,network,ipobody,xbodyact,ibody);
       iperturb[0]=0;SFREE(inum);
       
       /* check whether any displacements or temperatures are changed
          in the new increment */
       
       for(k=0;k<neq[1];++k){f[k]=f[k]+b[k];}
       
       }
       else{
       
       NNEW(inum,ITG,*nk);
       results(co,nk,kon,ipkon,lakon,ne,v,stn,inum,stx,
           elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat,
           ielorien,norien,orab,ntmat_,t0,t1act,ithermal,
           prestr,iprestr,filab,eme,emn,een,iperturb,
           f,fn,nactdof,&iout,qa,vold,b,nodeboun,
           ndirboun,xbounact,nboun,ipompc,
           nodempc,coefmpc,labmpc,nmpc,nmethod,cam,&neq[1],veold,accold,
           &bet,&gam,&dtime,&time,ttime,plicon,nplicon,plkcon,nplkcon,
           xstateini,xstiff,xstate,npmat_,epn,matname,mi,&ielas,
           &icmd,ncmat_,nstate_,stiini,vini,ikboun,ilboun,ener,enern,
           emeini,xstaten,eei,enerini,cocon,ncocon,set,nset,istartset,
           iendset,ialset,nprint,prlab,prset,qfx,qfn,trab,inotr,ntrans,
           fmpc,nelemload,nload,ikmpc,ilmpc,istep,&iinc,springarea,
           &reltime,&ne0,xforc,nforc,thicke,shcon,nshcon,
           sideload,xloadact,xloadold,&icfd,inomat,pslavsurf,pmastsurf,
           mortar,islavact,cdn,islavnode,nslavnode,ntie,clearini,
                   islavsurf,ielprop,prop,energyini,energy,&kscale,iponoel,
                   inoel,nener,orname,network,ipobody,xbodyact,ibody);
       SFREE(inum);
       
       memcpy(&vold[0],&v[0],sizeof(double)*mt**nk);
       
       if(*ithermal!=2){
           for(k=0;k<6*mi[0]*ne0;++k){
           sti[k]=stx[k];
           }
       }
       
       }
       
       ielas=0;
       iout=0;
       
       SFREE(fn);SFREE(v);
       if((*ithermal!=3)||(ncont==0)||(*mortar!=1)||(*ncmat_<11)) SFREE(stx);
       
       /***************************************************************/
       /* iteration counter and start of the loop over the iterations */
       /***************************************************************/
 
     iit=1;
 //    icntrl=0;
 
     /* change due to previous checkdivergence routine */
 
     if(icntrl!=0) icutb++;
 
     ctrl[0]=i0ref;ctrl[1]=irref;ctrl[3]=icref;
     if(*nmethod!=4)NNEW(resold,double,neq[1]);
     if(uncoupled){
     *ithermal=2;
     NNEW(iruc,ITG,nzs[1]-nzs[0]);
     for(k=0;k<nzs[1]-nzs[0];k++) iruc[k]=irow[k+nzs[0]]-neq[0];
     }
 
     while(icntrl==0){
 
 #ifdef COMPANY
       FORTRAN(uiter,(&iit));
 #endif    
 
     /*  updating the nonlinear mpc's (also affects the boundary
     conditions through the nonhomogeneous part of the mpc's) */
 
       if((iit!=1)||((uncoupled)&&(*ithermal==1))){
 
       printf(" iteration %" ITGFORMAT "\n\n",iit);
 
       /* restoring the distributed loading before adding the
          friction heating */
       
       if((*ithermal==3)&&(ncont!=0)&&(*mortar==1)&&(*ncmat_>=11)){
           *nload=nloadref;
           memcpy(&nelemload[0],&nelemloadref[0],sizeof(ITG)*2**nload);
           if(*nam>0){
           memcpy(&iamload[0],&iamloadref[0],sizeof(ITG)*2**nload);
           }
           memcpy(&sideload[0],&sideloadref[0],sizeof(char)*20**nload);
       }
       
           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,itg,&ntg,amname,ikboun,ilboun,nelemload,sideload,mi,
               ntrans,trab,inotr,veold,integerglob,doubleglob,tieset,istartset,
               iendset,ialset,ntie,nmpc,ipompc,ikmpc,ilmpc,nodempc,coefmpc,
               ipobody,iponoel,inoel));
 
       for(i=0;i<3;i++){cam[i]=0.;}for(i=3;i<5;i++){cam[i]=0.5;}
       if(*ithermal>1){
           radflowload(itg,ieg,&ntg,&ntr,adrad,aurad,bcr,ipivr,
             ac,bc,nload,sideload,nelemload,xloadact,lakon,ipiv,
                 ntmat_,vold,shcon,nshcon,ipkon,kon,co,
             kontri,&ntri,nloadtr,tarea,tenv,physcon,erad,&adview,&auview,
             nflow,ikboun,xbounact,nboun,ithermal,&iinc,&iit,
                 cs,mcs,inocs,&ntrit,nk,fenv,istep,&dtime,ttime,&time,ilboun,
             ikforc,ilforc,xforcact,nforc,cam,ielmat,&nteq,prop,ielprop,
             nactdog,nacteq,nodeboun,ndirboun,network,
                 rhcon,nrhcon,ipobody,ibody,xbodyact,nbody,iviewfile,jobnamef,
             ctrl,xloadold,&reltime,nmethod,set,mi,istartset,iendset,ialset,
             nset,ineighe,nmpc,nodempc,ipompc,coefmpc,labmpc,&iemchange,nam,
             iamload,jqrad,irowrad,&nzsrad,icolrad,ne,iaxial,qa,cocon,ncocon,
         iponoel,inoel,nprop,amname,namta,amta);
              
               /* check whether network iterations converged */
 
           if(qa[2]>0){
           checkdivergence(co,nk,kon,ipkon,lakon,ne,stn,nmethod, 
                kode,filab,een,t1act,&time,epn,ielmat,matname,enern, 
                xstaten,nstate_,istep,&iinc,iperturb,ener,mi,output,
                    ithermal,qfn,&mode,&noddiam,trab,inotr,ntrans,orab,
                ielorien,norien,description,sti,&icutb,&iit,&dtime,qa,
                vold,qam,ram1,ram2,ram,cam,uam,&ntg,ttime,&icntrl,
                &theta,&dtheta,veold,vini,idrct,tper,&istab,tmax, 
                nactdof,b,tmin,ctrl,amta,namta,itpamp,inext,&dthetaref,
                    &itp,&jprint,jout,&uncoupled,t1,&iitterm,nelemload,
                    nload,nodeboun,nboun,itg,ndirboun,&deltmx,&iflagact,
                set,nset,istartset,iendset,ialset,emn,thicke,jobnamec,
                mortar,nmat,ielprop,prop,&ialeatoric,&kscale,
                    energy, &allwk,&energyref,&emax,&r_abs,&enetoll,energyini,
                &allwkini,&temax,&sizemaxinc,&ne0,&neini,&dampwk,
                &dampwkini,energystartstep);
           continue;
           }
       }
 
       if(icascade==2){
           memmpc_=memmpcref_;mpcfree=mpcfreeref;maxlenmpc=maxlenmpcref;
           RENEW(nodempc,ITG,3*memmpcref_);
           for(k=0;k<3*memmpcref_;k++){nodempc[k]=nodempcref[k];}
           RENEW(coefmpc,double,memmpcref_);
           for(k=0;k<memmpcref_;k++){coefmpc[k]=coefmpcref[k];}
       }
 
       if((ncont!=0)&&(*mortar<=1)&&(ismallsliding==0)&&
 /*           for node-to-face contact: freeze contact elements for
              iterations 8 and higher */
              ((iit<=8)||(*mortar==1))&&
 /*           for purely thermal calculations: freeze contact elements
              during complete step */
              ((*ithermal!=2)||(iit==-1))){
 
           neold=*ne;
           *ne=ne0;*nkon=nkon0;
           contact(&ncont,ntie,tieset,nset,set,istartset,iendset,
               ialset,itietri,lakon,ipkon,kon,koncont,ne,cg,
                       straight,nkon,co,vold,ielmat,cs,elcon,istep,
                       &iinc,&iit,ncmat_,ntmat_,&ne0,
                       vini,nmethod,iperturb,
                       ikboun,nboun,mi,imastop,nslavnode,islavnode,islavsurf,
                       itiefac,areaslav,iponoels,inoels,springarea,tietol,
                       &reltime,imastnode,nmastnode,xmastnor,
                       filab,mcs,ics,&nasym,xnoels,mortar,pslavsurf,pmastsurf,
                       clearini,&theta,xstateini,xstate,nstate_,&icutb,
                       &ialeatoric,jobnamef);
 
           /* check whether, for a dynamic calculation, damping is involved */
           
           if(*nmethod==4){
           if(*iexpl<=1){
               if(idampingwithoutcontact==0){
               for(i=0;i<*ne;i++){
                   if(ipkon[i]<0) continue;
                   if(*ncmat_>=5){
                   if(strcmp1(&lakon[i*8],"ES")==0){
                       if(strcmp1(&lakon[i*8+6],"C")==0){
                       imat=ielmat[i*mi[2]];
                       if(elcon[(*ncmat_+1)**ntmat_*(imat-1)+4]>0.){
                           idamping=1;break;
                       }
                       }
                   }
                   }
               }
               }
           }
           }
           
           if(*mortar==0){
              if(*ne!=neold){iflagact=1;}
           }else if(*mortar==1){
              if(((*ne-ne0)<(neold-ne0)*0.999)||
                     ((*ne-ne0)>(neold-ne0)*1.001)){iflagact=1;}
               }
 
           printf(" Number of contact spring elements=%" ITGFORMAT "\n\n",*ne-ne0);
 
       }
       
       if(*ithermal==3){
           for(k=0;k<*nk;++k){t1act[k]=vold[mt*k];}
       }
 
       FORTRAN(nonlinmpc,(co,vold,ipompc,nodempc,coefmpc,labmpc,
         nmpc,ikboun,ilboun,nboun,xbounact,aux,iaux,
             &maxlenmpc,ikmpc,ilmpc,&icascade,
             kon,ipkon,lakon,ne,&reltime,&newstep,xboun,fmpc,&iit,
         &idiscon,&ncont,trab,ntrans,ithermal,mi));
 
       if(icascade==2){
           for(k=0;k<3*memmpc_;k++){nodempcref[k]=nodempc[k];}
           for(k=0;k<memmpc_;k++){coefmpcref[k]=coefmpc[k];}
       }
 
       if((icascade>0)||(ncont!=0)){
           remastruct(ipompc,&coefmpc,&nodempc,nmpc,
         &mpcfree,nodeboun,ndirboun,nboun,ikmpc,ilmpc,ikboun,ilboun,
         labmpc,nk,&memmpc_,&icascade,&maxlenmpc,
         kon,ipkon,lakon,ne,nactdof,icol,jq,&irow,isolver,
         neq,nzs,nmethod,&f,&fext,&b,&aux2,&fini,&fextini,
         &adb,&aub,ithermal,iperturb,mass,mi,iexpl,mortar,
         typeboun,&cv,&cvini,&iit,network);
 
           /* invert nactdof */
           
           SFREE(nactdofinv);
           NNEW(nactdofinv,ITG,mt**nk);
           NNEW(nodorig,ITG,*nk);
           FORTRAN(gennactdofinv,(nactdof,nactdofinv,nk,mi,nodorig,
                      ipkon,lakon,kon,ne));
           SFREE(nodorig);
           
           NNEW(v,double,mt**nk);
           NNEW(stx,double,6*mi[0]**ne);
           NNEW(fn,double,mt**nk);
       
           memcpy(&v[0],&vold[0],sizeof(double)*mt**nk);
           iout=-1;
           
           NNEW(inum,ITG,*nk);
           results(co,nk,kon,ipkon,lakon,ne,v,stn,inum,stx,
             elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat,
         ielorien,norien,orab,ntmat_,t0,t1act,ithermal,
         prestr,iprestr,filab,eme,emn,een,iperturb,
         f,fn,nactdof,&iout,qa,vold,b,nodeboun,
         ndirboun,xbounact,nboun,ipompc,
         nodempc,coefmpc,labmpc,nmpc,nmethod,cam,&neq[1],veold,accold,
         &bet,&gam,&dtime,&time,ttime,plicon,nplicon,plkcon,nplkcon,
         xstateini,xstiff,xstate,npmat_,epn,matname,mi,&ielas,&icmd,
         ncmat_,nstate_,stiini,vini,ikboun,ilboun,ener,enern,emeini,
         xstaten,eei,enerini,cocon,ncocon,set,nset,istartset,iendset,
             ialset,nprint,prlab,prset,qfx,qfn,trab,inotr,ntrans,fmpc,
         nelemload,nload,ikmpc,ilmpc,istep,&iinc,springarea,
         &reltime,&ne0,xforc,nforc,thicke,shcon,nshcon,
                 sideload,xloadact,xloadold,&icfd,inomat,pslavsurf,pmastsurf,
         mortar,islavact,cdn,islavnode,nslavnode,ntie,clearini,
         islavsurf,ielprop,prop,energyini,energy,&kscale,iponoel,
         inoel,nener,orname,network,ipobody,xbodyact,ibody);
       
           memcpy(&vold[0],&v[0],sizeof(double)*mt**nk);
           
           if(*ithermal!=2){
           for(k=0;k<6*mi[0]*ne0;++k){
               sti[k]=stx[k];
           }
           }
 
           /*for(k=0;k<neq[1];++k){printf("f=%" ITGFORMAT ",%f\n",k,f[k]);}*/
           
           SFREE(v);SFREE(fn);SFREE(inum);
           if((*ithermal!=3)||(ncont==0)||(*mortar!=1)||(*ncmat_<11)) SFREE(stx);
           iout=0;
           
       }else{
 
           /*for(k=0;k<neq[1];++k){printf("f=%" ITGFORMAT ",%f\n",k,f[k]);}*/
       }
       }
       
       /* add friction heating  */
       
       if((*ithermal==3)&&(ncont!=0)&&(*mortar==1)&&(*ncmat_>=11)){
       nload_=*nload+2*(*ne-ne0);
 
       RENEW(nelemload,ITG,2*nload_);
       DMEMSET(nelemload,2**nload,2*nload_,0);
       if(*nam>0){
           RENEW(iamload,ITG,2*nload_);
           DMEMSET(iamload,2**nload,2*nload_,0);
       }
       RENEW(xloadact,double,2*nload_);
       DMEMSET(xloadact,2**nload,2*nload_,0.);
       RENEW(sideload,char,20*nload_);
       DMEMSET(sideload,20**nload,20*nload_,'\0');
 
       NNEW(idefload,ITG,nload_);
       DMEMSET(idefload,0,nload_,1);
       FORTRAN(frictionheating,(&ne0,ne,ipkon,lakon,ielmat,mi,elcon,
           ncmat_,ntmat_,kon,islavsurf,pmastsurf,springarea,co,vold,
                   veold,pslavsurf,xloadact,nload,&nload_,nelemload,iamload,
           idefload,sideload,stx,nam));
       SFREE(idefload);SFREE(stx);
       }
       
       if(*iexpl<=1){
 
     /* calculating the local stiffness matrix and external loading */
 
     NNEW(ad,double,neq[1]);
     NNEW(au,double,nzs[1]);
 
     if(*nmethod==4) DMEMSET(fnext,0,mt**nk,0.);
 
 #ifdef COMPANY
       if(*ithermal<2){
 #endif    
     mafillsmmain(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,fext,nactdof,icol,jq,irow,neq,nzl,
           nmethod,ikmpc,ilmpc,ikboun,ilboun,
           elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,
           ielmat,ielorien,norien,orab,ntmat_,
           t0,t1act,ithermal,prestr,iprestr,vold,iperturb,sti,
           nzs,stx,adb,aub,iexpl,plicon,nplicon,plkcon,nplkcon,
           xstiff,npmat_,&dtime,matname,mi,
                   ncmat_,mass,&stiffness,&buckling,&rhsi,&intscheme,
                   physcon,shcon,nshcon,cocon,ncocon,ttime,&time,istep,&iinc,
           &coriolis,ibody,xloadold,&reltime,veold,springarea,nstate_,
                   xstateini,xstate,thicke,integerglob,doubleglob,
           tieset,istartset,iendset,ialset,ntie,&nasym,pslavsurf,
           pmastsurf,mortar,clearini,ielprop,prop,&ne0,fnext,&kscale,
           iponoel,inoel,network);
 #ifdef COMPANY
       }else{
       FORTRAN(mafillsm_company,(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,fext,nactdof,icol,jq,irow,neq,nzl,
           nmethod,ikmpc,ilmpc,ikboun,ilboun,
           elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,
           ielmat,ielorien,norien,orab,ntmat_,
           t0,t1act,ithermal,prestr,iprestr,vold,iperturb,sti,
           nzs,stx,adb,aub,iexpl,plicon,nplicon,plkcon,nplkcon,
           xstiff,npmat_,&dtime,matname,mi,
                   ncmat_,mass,&stiffness,&buckling,&rhsi,&intscheme,
                   physcon,shcon,nshcon,cocon,ncocon,ttime,&time,istep,&iinc,
           &coriolis,ibody,xloadold,&reltime,veold,springarea,nstate_,
                   xstateini,xstate,thicke,integerglob,doubleglob,
           tieset,istartset,iendset,ialset,ntie,&nasym,pslavsurf,
           pmastsurf,mortar,clearini,ielprop,prop,&ne0,fnext,&kscale,
           iponoel,inoel,network));
       }
 #endif    
 
     if(nasym==1){
         RENEW(au,double,2*nzs[1]);
         if(*nmethod==4) RENEW(aub,double,2*nzs[1]);
         symmetryflag=2;
         inputformat=1;
 
         FORTRAN(mafillsmas,(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,fext,nactdof,icol,jq,irow,neq,nzl,
           nmethod,ikmpc,ilmpc,ikboun,ilboun,
           elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,
           ielmat,ielorien,norien,orab,ntmat_,
           t0,t1act,ithermal,prestr,iprestr,vold,iperturb,sti,
           nzs,stx,adb,aub,iexpl,plicon,nplicon,plkcon,nplkcon,
           xstiff,npmat_,&dtime,matname,mi,
                   ncmat_,mass,&stiffness,&buckling,&rhsi,&intscheme,
                   physcon,shcon,nshcon,cocon,ncocon,ttime,&time,istep,&iinc,
                   &coriolis,ibody,xloadold,&reltime,veold,springarea,nstate_,
                   xstateini,xstate,thicke,
                   integerglob,doubleglob,tieset,istartset,iendset,
           ialset,ntie,&nasym,pslavsurf,pmastsurf,mortar,clearini,
           ielprop,prop,&ne0,&kscale,iponoel,inoel,network));
     }
         
 
     iperturb[0]=iperturb_sav[0];
     iperturb[1]=iperturb_sav[1];
 
       }else{
 
     /* calculating the external loading 
 
        This is only done once per increment. In reality, the
            external loading is a function of vold (specifically,
            the body forces and surface loading). This effect is
            neglected, since the increment size in dynamic explicit
            calculations is usually small */
 
       FORTRAN(rhs,(co,nk,kon,ipkon,lakon,ne,
           ipompc,nodempc,coefmpc,nmpc,nodeforc,ndirforc,xforcact,
           nforc,nelemload,sideload,xloadact,nload,xbodyact,ipobody,
           nbody,cgr,fext,nactdof,&neq[1],
           nmethod,ikmpc,ilmpc,
           elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,
           ielmat,ielorien,norien,orab,ntmat_,
           t0,t1act,ithermal,iprestr,vold,iperturb,
           iexpl,plicon,nplicon,plkcon,nplkcon,
           npmat_,ttime,&time,istep,&iinc,&dtime,physcon,ibody,
           xbodyold,&reltime,veold,matname,mi,ikactmech,
           &nactmech,ielprop,prop,sti,xstateini,xstate,nstate_));
       }
       
 /*      for(k=0;k<neq[1];++k){printf("f=%" ITGFORMAT ",%f\n",k,f[k]);}
       for(k=0;k<neq[1];++k){printf("fext=%" ITGFORMAT ",%f\n",k,fext[k]);}
       for(k=0;k<neq[1];++k){printf("ad=%" ITGFORMAT ",%f\n",k,ad[k]);}
       for(k=0;k<nzs[1];++k){printf("au=%" ITGFORMAT ",%f\n",k,au[k]);}*/
 
       /* calculating the damping matrix for implicit dynamic
          calculations */
 
       if(idamping==1){
 
           /* Rayleigh damping */
 
       NNEW(adc,double,neq[1]);
       for(k=0;k<neq[0];k++){adc[k]=alpham*adb[k]+betam*ad[k];}
       if(nasym==0){
           NNEW(auc,double,nzs[1]);
           for(k=0;k<nzs[0];k++){auc[k]=alpham*aub[k]+betam*au[k];}
       }else{
           NNEW(auc,double,2*nzs[1]);
           for(k=0;k<2*nzs[0];k++){auc[k]=alpham*aub[k]+betam*au[k];}
       }
  
           /* dashpots and contact damping */
 
       FORTRAN(mafilldm,(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,
           adc,auc,nactdof,icol,jq,irow,neq,nzl,nmethod,
           ikmpc,ilmpc,ikboun,ilboun,
           elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat,
           ielorien,norien,orab,ntmat_,
           t0,t1act,ithermal,prestr,iprestr,vold,iperturb,sti,
           nzs,stx,adb,aub,iexpl,plicon,nplicon,plkcon,nplkcon,
           xstiff,npmat_,&dtime,matname,mi,ncmat_,
           ttime,&time,istep,&iinc,ibody,clearini,mortar,springarea,
               pslavsurf,pmastsurf,&reltime,&nasym));
       }
 
       /* calculating the residual */
 
       calcresidual(nmethod,neq,b,fext,f,iexpl,nactdof,aux2,vold,
      vini,&dtime,accold,nk,adb,aub,jq,irow,nzl,alpha,fextini,fini,
      islavnode,nslavnode,mortar,ntie,f_cm,f_cs,mi,
      nzs,&nasym,&idamping,veold,adc,auc,cvini,cv);
 
       /* storing the residuum in resold (for line search) */
 
       if((*mortar==1)&&(iit!=1)&&(*ne-ne0>0)&(*nmethod!=4)){memcpy(&resold[0],&b[0],sizeof(double)*neq[1]);}
       
       newstep=0;
       
       if(*nmethod==0){
       
       /* error occurred in mafill: storing the geometry in frd format */
       
       *nmethod=0;
       ++*kode;
       NNEW(inum,ITG,*nk);for(k=0;k<*nk;k++) inum[k]=1;
       if(strcmp1(&filab[1044],"ZZS")==0){
           NNEW(neigh,ITG,40**ne);
           NNEW(ipneigh,ITG,*nk);
       }
       
       ptime=*ttime+time;
       frd(co,nk,kon,ipkon,lakon,&ne0,v,stn,inum,nmethod,
           kode,filab,een,t1,fn,&ptime,epn,ielmat,matname,enern,xstaten,
           nstate_,istep,&iinc,ithermal,qfn,&mode,&noddiam,trab,inotr,
           ntrans,orab,ielorien,norien,description,ipneigh,neigh,
           mi,sti,vr,vi,stnr,stni,vmax,stnmax,&ngraph,veold,ener,ne,
           cs,set,nset,istartset,iendset,ialset,eenmax,fnr,fni,emn,
           thicke,jobnamec,output,qfx,cdn,mortar,cdnr,cdni,nmat);
 
       if(strcmp1(&filab[1044],"ZZS")==0){SFREE(ipneigh);SFREE(neigh);} 
      #ifdef COMPANY
       FORTRAN(uout,(v,mi,ithermal,filab));
 #endif
       SFREE(inum);FORTRAN(stop,());
       
       }
       
       /* implicit step (static or dynamic */
       
       if(*iexpl<=1){
       if((*nmethod==4)&&(*mortar<2)){
           
           /* mechanical part */
           
           if(*ithermal!=2){
           scal1=bet*dtime*dtime*(1.+*alpha);
           for(k=0;k<neq[0];++k){
               ad[k]=adb[k]+scal1*ad[k];
           }
           for(k=0;k<nzs[0];++k){
               au[k]=aub[k]+scal1*au[k];
           }
           
           /* upper triangle of asymmetric matrix */
           
           if(nasym>0){
               for(k=nzs[2];k<nzs[2]+nzs[0];++k){
               au[k]=aub[k]+scal1*au[k];
               }
           }
 
                   /* damping */
           
           if(idamping==1){
               scal1=gam*dtime*(1.+*alpha);
               for(k=0;k<neq[0];++k){
               ad[k]+=scal1*adc[k];
               }
               for(k=0;k<nzs[0];++k){
               au[k]+=scal1*auc[k];
               }
               
               /* upper triangle of asymmetric matrix */
               
               if(nasym>0){
               for(k=nzs[2];k<nzs[2]+nzs[0];++k){
                   au[k]+=scal1*auc[k];
               }
               }
           }
 
           }
           
           /* thermal part */
           
           if(*ithermal>1){
           for(k=neq[0];k<neq[1];++k){
               ad[k]=adb[k]/dtime+ad[k];
           }
           for(k=nzs[0];k<nzs[1];++k){
               au[k]=aub[k]/dtime+au[k];
           }
           
           /* upper triangle of asymmetric matrix */
           
           if(nasym>0){
               for(k=nzs[2]+nzs[0];k<nzs[2]+nzs[1];++k){
               au[k]=aub[k]/dtime+au[k];
               }
           }
           }
       }
       
       if(*isolver==0){
 #ifdef SPOOLES
           if(*ithermal<2){
           spooles(ad,au,adb,aub,&sigma,b,icol,irow,&neq[0],&nzs[0],
               &symmetryflag,&inputformat,&nzs[2]);
           }else if((*ithermal==2)&&(uncoupled)){
           n1=neq[1]-neq[0];
           n2=nzs[1]-nzs[0];
           spooles(&ad[neq[0]],&au[nzs[0]],&adb[neq[0]],&aub[nzs[0]],
               &sigma,&b[neq[0]],&icol[neq[0]],iruc,
               &n1,&n2,&symmetryflag,&inputformat,&nzs[2]);
           }else{
           spooles(ad,au,adb,aub,&sigma,b,icol,irow,&neq[1],&nzs[1],
               &symmetryflag,&inputformat,&nzs[2]);
           }
 #else
           printf(" *ERROR in nonlingeo: the SPOOLES library is not linked\n\n");
           FORTRAN(stop,());
 #endif
       }
       else if((*isolver==2)||(*isolver==3)){
           if(nasym>0){
           if(*isolver==3){
               printf(" *WARNING in nonlingeo: the iterative Cholesky solver cannot be used for asymmetric matrices.\nThe iterative scaling solver will be used instead\n\n");
           }
           NNEW(rwork,double,neq[1]);
           NNEW(sol,double,neq[1]);
           RENEW(au,double,2*nzs[1]+neq[1]);
           memcpy(&au[2*nzs[1]],ad,sizeof(double)*neq[1]);
           nelt=2*nzs[1]+neq[1];
           lrgw=131+16*neq[1];
           isym=0;
           NNEW(rgwk,double,lrgw);
           NNEW(igwk,ITG,20);
           for(i=0;i<neq[1];i++){rwork[i]=1./ad[i];}
           FORTRAN(predgmres_struct,(&neq[1],b,sol,&nelt,irow,jq,au,
                      &isym,&itol,&tol,&itmax,&iter,
                      &err,&ierr,&iunit,sb,sx,rgwk,&lrgw,igwk,
                      &ligw,rwork,iwork));
           memcpy(b,sol,sizeof(double)*neq[1]);
           SFREE(rgwk);SFREE(igwk);SFREE(rwork);SFREE(sol);
           }else{
           preiter(ad,&au,b,&icol,&irow,&neq[1],&nzs[1],isolver,iperturb);
           }
       }
       else if(*isolver==4){
 #ifdef SGI
           if(nasym>0){
           printf(" *ERROR in nonlingeo: the SGI solver cannot be used for asymmetric matrices\n\n");
           FORTRAN(stop,());
           }
           token=1;
           if(*ithermal<2){
           sgi_main(ad,au,adb,aub,&sigma,b,icol,irow,&neq[0],&nzs[0],token);
           }else if((*ithermal==2)&&(uncoupled)){
           n1=neq[1]-neq[0];
           n2=nzs[1]-nzs[0];
           sgi_main(&ad[neq[0]],&au[nzs[0]],&adb[neq[0]],&aub[nzs[0]],
                &sigma,&b[neq[0]],&icol[neq[0]],iruc,
                &n1,&n2,token);
           }else{
           sgi_main(ad,au,adb,aub,&sigma,b,icol,irow,&neq[1],&nzs[1],token);
           }
 #else
           printf(" *ERROR in nonlingeo: the SGI library is not linked\n\n");
           FORTRAN(stop,());
 #endif
       }
       else if(*isolver==5){
 #ifdef TAUCS
           if(nasym>0){
           printf(" *ERROR in nonlingeo: the TAUCS solver cannot be used for asymmetric matrices\n\n");
           FORTRAN(stop,());
           }
           tau(ad,&au,adb,aub,&sigma,b,icol,&irow,&neq[1],&nzs[1]);
 #else
           printf(" *ERROR in nonlingeo: the TAUCS library is not linked\n\n");
           FORTRAN(stop,());
 #endif
       }
       else if(*isolver==7){
 #ifdef PARDISO
           if(*ithermal<2){
           pardiso_main(ad,au,adb,aub,&sigma,b,icol,irow,&neq[0],&nzs[0],
                    &symmetryflag,&inputformat,jq,&nzs[2]);
           }else if((*ithermal==2)&&(uncoupled)){
           n1=neq[1]-neq[0];
           n2=nzs[1]-nzs[0];
           pardiso_main(&ad[neq[0]],&au[nzs[0]],&adb[neq[0]],&aub[nzs[0]],
                    &sigma,&b[neq[0]],&icol[neq[0]],iruc,
                    &n1,&n2,&symmetryflag,&inputformat,jq,&nzs[2]);
           }else{
           pardiso_main(ad,au,adb,aub,&sigma,b,icol,irow,&neq[1],&nzs[1],
                    &symmetryflag,&inputformat,jq,&nzs[2]);
           }
 #else
           printf(" *ERROR in nonlingeo: the PARDISO library is not linked\n\n");
           FORTRAN(stop,());
 #endif
       }
       
       if(*mortar<=1){
           if(isensitivity){
 /*        if(nasym!=0){
               printf("*ERROR in nonlingeo: a sensitivity analysis \n is not allowed in combination with frictional contact \n\n");
               FORTRAN(stop,());
               }*/
           SFREE(adcpy);NNEW(adcpy,double,neq[1]);
           SFREE(aucpy);NNEW(aucpy,double,(nasym+1)*nzs[1]);
           memcpy(&adcpy[0],&ad[0],sizeof(double)*neq[1]);
           memcpy(&aucpy[0],&au[0],sizeof(double)*(nasym+1)*nzs[1]);
           }
           SFREE(ad);SFREE(au);
       } 
       }
       
       /* explicit dynamic step */
       
       else{
       if(*ithermal!=2){
           for(k=0;k<neq[0];++k){
           b[k]=b[k]/adb[k];
           }
       }
       if(*ithermal>1){
           for(k=neq[0];k<neq[1];++k){
           b[k]=b[k]*dtime/adb[k];
           }
       }
       }
 
       /* calculating the displacements, stresses and forces */
       
       NNEW(v,double,mt**nk);
       memcpy(&v[0],&vold[0],sizeof(double)*mt**nk);
       
       NNEW(stx,double,6*mi[0]**ne);
       NNEW(fn,double,mt**nk);
       
       NNEW(inum,ITG,*nk);
       results(co,nk,kon,ipkon,lakon,ne,v,stn,inum,stx,
           elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat,
           ielorien,norien,orab,ntmat_,t0,t1act,ithermal,
           prestr,iprestr,filab,eme,emn,een,iperturb,
           f,fn,nactdof,&iout,qa,vold,b,nodeboun,
           ndirboun,xbounact,nboun,ipompc,
           nodempc,coefmpc,labmpc,nmpc,nmethod,cam,&neq[1],veold,accold,
           &bet,&gam,&dtime,&time,ttime,plicon,nplicon,plkcon,nplkcon,
           xstateini,xstiff,xstate,npmat_,epn,matname,mi,&ielas,
           &icmd,ncmat_,nstate_,stiini,vini,ikboun,ilboun,ener,enern,
           emeini,xstaten,eei,enerini,cocon,ncocon,set,nset,istartset,
           iendset,ialset,nprint,prlab,prset,qfx,qfn,trab,inotr,ntrans,
           fmpc,nelemload,nload,ikmpc,ilmpc,istep,&iinc,springarea,
           &reltime,&ne0,xforc,nforc,thicke,shcon,nshcon,
           sideload,xloadact,xloadold,&icfd,inomat,pslavsurf,pmastsurf,
           mortar,islavact,cdn,islavnode,nslavnode,ntie,clearini,
               islavsurf,ielprop,prop,energyini,energy,&kscale,iponoel,
               inoel,nener,orname,network,ipobody,xbodyact,ibody);
       SFREE(inum);
 
       /* implicit dynamics (Matteo Pacher) */
 
       if((*ne!=ne0)&&(*nmethod==4)&&(*ithermal<2)&&(*iexpl<=1)){
          FORTRAN(storecontactprop,(ne,&ne0,lakon,kon,ipkon,mi,
                          ielmat,elcon,mortar,adblump,nactdof,springarea,
                          ncmat_,ntmat_,stx,&temax));
       }
 
       /* updating the external work (only for dynamic calculations) */
 
       if((*nmethod==4)&&(*ithermal<2)){
       allwk=allwkini;
       for(i=0;i<*nk;i++){
           for(k=1;k<4;k++){
           allwk+=(fnext[i*mt+k]+fnextini[i*mt+k])*
               (v[i*mt+k]-vini[i*mt+k])/2.;
           }
       }
 
         /* Work due to damping forces (cv and cvini) --> MPADD */
 
       if(idamping==1){
           dampwk=dampwkini;
           for(k=0;k<*nk;++k){
           for(j=1;j<mt;++j){
               if(nactdof[mt*k+j]>0){
               aux2[nactdof[mt*k+j]-1]=v[mt*k+j]-vini[mt*k+j];
               }
           }
           }
           for(k=0;k<neq[0];k++){
           dampwk+=-(cv[k]+cvini[k])*aux2[k]/2.;
           }
       }
         /* Damping forces --> MPADD */
       }
 
       /* line search (only for static surface-to-surface penalty contact)
          and not in the first iteration */
 
       if((*mortar==1)&&(iit!=1)&&(*ne-ne0>0)&&(*nmethod!=4)){
 
       SFREE(v);SFREE(stx);SFREE(fn);
       
       /* calculating the residual */
       
       NNEW(res,double,neq[1]);
       calcresidual(nmethod,neq,res,fext,f,iexpl,nactdof,aux2,vold,
          vini,&dtime,accold,nk,adb,aub,jq,irow,nzl,alpha,fextini,fini,
          islavnode,nslavnode,mortar,ntie,f_cm,f_cs,mi,
          nzs,&nasym,&idamping,veold,adc,auc,cvini,cv);
 
           /* calculating the line search factor */
 
       sum1=0.;sum2=0.;
       for(i=0;i<neq[1];i++){
           sum1+=b[i]*resold[i];
           sum2+=b[i]*res[i];
       }
       SFREE(res);
 
       if(fabs(sum1-sum2)<1.e-30){
           flinesearch=1.;
       }else{
           flinesearch=sum1/(sum1-sum2);
           if(flinesearch>smaxls){
           flinesearch=smaxls;
           }else if(flinesearch<sminls){
           flinesearch=sminls;
           }
       }
       printf("line search factor=%f\n\n",flinesearch);
 
           /* update the solution */
 
       for(i=0;i<neq[1];i++){b[i]*=flinesearch;}
       
       NNEW(v,double,mt**nk);
       memcpy(&v[0],&vold[0],sizeof(double)*mt**nk);
       
       NNEW(stx,double,6*mi[0]**ne);
       NNEW(fn,double,mt**nk);
       
       NNEW(inum,ITG,*nk);
       results(co,nk,kon,ipkon,lakon,ne,v,stn,inum,stx,
           elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat,
           ielorien,norien,orab,ntmat_,t0,t1act,ithermal,
           prestr,iprestr,filab,eme,emn,een,iperturb,
           f,fn,nactdof,&iout,qa,vold,b,nodeboun,
           ndirboun,xbounact,nboun,ipompc,
           nodempc,coefmpc,labmpc,nmpc,nmethod,cam,&neq[1],veold,accold,
           &bet,&gam,&dtime,&time,ttime,plicon,nplicon,plkcon,nplkcon,
           xstateini,xstiff,xstate,npmat_,epn,matname,mi,&ielas,
           &icmd,ncmat_,nstate_,stiini,vini,ikboun,ilboun,ener,enern,
           emeini,xstaten,eei,enerini,cocon,ncocon,set,nset,istartset,
           iendset,ialset,nprint,prlab,prset,qfx,qfn,trab,inotr,ntrans,
           fmpc,nelemload,nload,ikmpc,ilmpc,istep,&iinc,springarea,
           &reltime,&ne0,xforc,nforc,thicke,shcon,nshcon,
           sideload,xloadact,xloadold,&icfd,inomat,pslavsurf,pmastsurf,
           mortar,islavact,cdn,islavnode,nslavnode,ntie,clearini,
           islavsurf,ielprop,prop,energyini,energy,&kscale,iponoel,
           inoel,nener,orname,network,ipobody,xbodyact,ibody);
       SFREE(inum);
       }
       
       /* calculating the residual */
       
       calcresidual(nmethod,neq,b,fext,f,iexpl,nactdof,aux2,vold,
      vini,&dtime,accold,nk,adb,aub,jq,irow,nzl,alpha,fextini,fini,
      islavnode,nslavnode,mortar,ntie,f_cm,f_cs,mi,
      nzs,&nasym,&idamping,veold,adc,auc,cvini,cv);
 
       memcpy(&vold[0],&v[0],sizeof(double)*mt**nk);
       if(*ithermal!=2){
       for(k=0;k<6*mi[0]*ne0;++k){
           sti[k]=stx[k];
       }
       }
       
       /* calculating the ratio of the smallest to largest pressure
          for face-to-face contact
          only done at the end of a step */
 
       if((*mortar==1)&&(1.-theta-dtheta<=1.e-6)){
       FORTRAN(negativepressure,(&ne0,ne,mi,stx,&pressureratio));
       }else{pressureratio=0.;}
 
       SFREE(v);SFREE(stx);SFREE(fn);
 
       if(idamping==1){SFREE(adc);SFREE(auc);}
 
       if(*iexpl<=1){
       
       /* store the residual forces for the next iteration */
 
       if(*ithermal!=2){
           if(cam[0]>uam[0]){uam[0]=cam[0];}      
           if(qau<1.e-10){
           if(qa[0]>ea*qam[0]){qam[0]=(qamold[0]*jnz+qa[0])/(jnz+1);}
           else {qam[0]=qamold[0];}
           }
       }
       if(*ithermal>1){
           if(cam[1]>uam[1]){uam[1]=cam[1];}      
           if(qau<1.e-10){
           if(qa[1]>ea*qam[1]){qam[1]=(qamold[1]*jnz+qa[1])/(jnz+1);}
           else {qam[1]=qamold[1];}
           }
       }
       
       /* calculating the maximum residual */
 
       for(k=0;k<2;++k){
           ram2[k]=ram1[k];
           ram1[k]=ram[k];
           ram[k]=0.;
       }
       if(*ithermal!=2){
           for(k=0;k<neq[0];++k){
           err=fabs(b[k]);
           if(err>ram[0]){ram[0]=err;ram[2]=k+0.5;}
           }
       }
       if(*ithermal>1){
           for(k=neq[0];k<neq[1];++k){
           err=fabs(b[k]);
           if(err>ram[1]){ram[1]=err;ram[3]=k+0.5;}
           }
       }
       
       /*   Divergence criteria for face-to-face penalty is different */
       
       if(*mortar==1){
           for(k=4;k<8;++k){
           ram2[k]=ram1[k];
           ram1[k]=ram[k];
           } 
           ram[4]=ram[0]+ram1[0];
           if((iflagact==0)&&(iit>1)){
           ram[5]=1.5;
           }else{ram[5]=0.5;}
           ram[6]=(*ne-ne0)-(neold-ne0)+0.5;
           if(iit>3){
           if((fabs(ram[6])>=fabs(ram1[6]))&&(fabs(ram[6])>=fabs(ram2[6]))){
               ram[7]=1.5;
           }else{ram[7]=0.5;}
           }
           
       }
       
       /* next line is inserted to cope with stress-less
          temperature calculations */
       
       if(*ithermal!=2){
           if(ram[0]<1.e-6) ram[0]=0.;      
           printf(" average force= %f\n",qa[0]);
           printf(" time avg. forc= %f\n",qam[0]);
           if((ITG)((double)nactdofinv[(ITG)ram[2]]/mt)+1==0){
           printf(" largest residual force= %f\n",
              ram[0]);
           }else{
           inode=(ITG)((double)nactdofinv[(ITG)ram[2]]/mt)+1;
           idir=nactdofinv[(ITG)ram[2]]-mt*(inode-1);
           printf(" largest residual force= %f in node %" ITGFORMAT " and dof %" ITGFORMAT "\n",
              ram[0],inode,idir);
           }
           printf(" largest increment of disp= %e\n",uam[0]);
           if((ITG)cam[3]==0){
           printf(" largest correction to disp= %e\n\n",
              cam[0]);
           }else{
           inode=(ITG)((double)nactdofinv[(ITG)cam[3]]/mt)+1;
           idir=nactdofinv[(ITG)cam[3]]-mt*(inode-1);
           printf(" largest correction to disp= %e in node %" ITGFORMAT " and dof %" ITGFORMAT "\n\n",cam[0],inode,idir);
           }
       }
       if(*ithermal>1){
           if(ram[1]<1.e-6) ram[1]=0.;      
           printf(" average flux= %f\n",qa[1]);
           printf(" time avg. flux= %f\n",qam[1]);
           if((ITG)((double)nactdofinv[(ITG)ram[3]]/mt)+1==0){
           printf(" largest residual flux= %f\n",
              ram[1]);
           }else{
           inode=(ITG)((double)nactdofinv[(ITG)ram[3]]/mt)+1;
           idir=nactdofinv[(ITG)ram[3]]-mt*(inode-1);
           printf(" largest residual flux= %f in node %" ITGFORMAT " and dof %" ITGFORMAT "\n",ram[1],inode,idir);
           }
           printf(" largest increment of temp= %e\n",uam[1]);
           if((ITG)cam[4]==0){
           printf(" largest correction to temp= %e\n\n",
              cam[1]);
           }else{
           inode=(ITG)((double)nactdofinv[(ITG)cam[4]]/mt)+1;
           idir=nactdofinv[(ITG)cam[4]]-mt*(inode-1);
           printf(" largest correction to temp= %e in node %" ITGFORMAT " and dof %" ITGFORMAT "\n\n",cam[1],inode,idir);
           }
       }
       fflush(stdout);
       
       FORTRAN(writecvg,(istep,&iinc,&icutb,&iit,ne,&ne0,ram,qam,cam,uam,
             ithermal));
 
       checkconvergence(co,nk,kon,ipkon,lakon,ne,stn,nmethod, 
          kode,filab,een,t1act,&time,epn,ielmat,matname,enern, 
          xstaten,nstate_,istep,&iinc,iperturb,ener,mi,output,
              ithermal,qfn,&mode,&noddiam,trab,inotr,ntrans,orab,
          ielorien,norien,description,sti,&icutb,&iit,&dtime,qa,
          vold,qam,ram1,ram2,ram,cam,uam,&ntg,ttime,&icntrl,
          &theta,&dtheta,veold,vini,idrct,tper,&istab,tmax, 
          nactdof,b,tmin,ctrl,amta,namta,itpamp,inext,&dthetaref,
              &itp,&jprint,jout,&uncoupled,t1,&iitterm,nelemload,
              nload,nodeboun,nboun,itg,ndirboun,&deltmx,&iflagact,
          set,nset,istartset,iendset,ialset,emn,thicke,jobnamec,
          mortar,nmat,ielprop,prop,&ialeatoric,&kscale,
              energy,&allwk,&energyref,&emax,&r_abs,&enetoll,energyini,
          &allwkini,&temax,&sizemaxinc,&ne0,&neini,&dampwk,
          &dampwkini,energystartstep);
       
       }else{
 
           /* explicit dynamics */
 
       icntrl=1;
       icutb=0;   
 
           /* recalculation of the time increment every 500 icrements
              (may have changed due to deformation) */
 
       if((iinc/500)*500==iinc){
           FORTRAN(calcstabletimeincvol,(&ne0,lakon,co,kon,ipkon,mi,
                   ielmat,&dtvol,alpha,wavespeed));
 
           if(dtvol<*tinc)*tinc=dtvol;
           dtheta=(*tinc)/(*tper);
           dthetaref=dtheta;
       }
 
       theta=theta+dtheta;  
       if(dtheta>=1.-theta){
           if(dtheta>1.-theta){
           printf(" the increment size exceeds the remainder of the step and is decreased to %e\n\n",
               dtheta**tper);
           }
           dtheta=1.-theta;
           dthetaref=dtheta;
       }
       iflagact=0;
       }
       
     }
 
     if(*nmethod!=4)SFREE(resold);
 
     /*********************************************************/
     /*   end of the iteration loop                          */
     /*********************************************************/
 
     /* icutb=0 means that the iterations in the increment converged,
        icutb!=0 indicates that the increment has to be reiterated with
                 another increment size (dtheta) */
    
     /* printing the energies (only for dynamic calculations) */
 
     if((icutb==0)&&(*nmethod==4)&&(*ithermal<2)){
     printf(" initial energy (at start of step) = %e\n\n",energyref);
 
     printf(" since start of the step: \n");
     printf(" external work = %e\n",allwk);
     printf(" work performed by the damping forces = %e\n",dampwk);
     printf(" netto work = %e\n\n",allwk+dampwk);
 
         printf(" actual energy: \n");
     printf(" internal energy = %e\n",energy[0]);
     printf(" kinetic energy = %e\n",energy[1]);
     printf(" elastic contact energy = %e\n",energy[2]);
     printf(" energy lost due to friction = %e\n",energy[3]);
     printf(" total energy  = %e\n\n",energy[0]+energy[1]+energy[2]+energy[3]);
 
     printf(" energy increase = %e\n\n",energy[0]+energy[1]+energy[2]+energy[3]-energyref);
 
     printf(" energy balance (absolute) = %e \n",energy[0]+energy[1]+energy[2]+energy[3]-energyref-allwk-dampwk);
 
     /* Belytschko criterion */
 
     denergymax=energy[0];
     if(denergymax<energy[1]) denergymax=energy[1];
     if(denergymax<fabs(allwk)) denergymax=fabs(allwk);
 
     if(denergymax>1.e-30){
         printf(" energy balance (relative) = %f %% \n\n",
             fabs((energy[0]+energy[1]+energy[2]+energy[3]-energyref-allwk-dampwk)/
             denergymax*100.));
     }else{
         printf(" energy balance (relative) =0 %% \n\n");
     }
 // # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
 //    MPADD start
 //  printf(" work done by the damping forces = %e\n", dampwk);
 //  neini=*ne; 
 //  printf(" contact elements end of increment = %"ITGFORMAT"\n\n", *ne - ne0);
 //    MPADD end
 // # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
 
     }
 
     if(uncoupled){
     SFREE(iruc);
     }
 
     if(((qa[0]>ea*qam[0])||(qa[1]>ea*qam[1]))&&(icutb==0)){jnz++;}
     iit=0;
 
     if(icutb!=0){
       memcpy(&vold[0],&vini[0],sizeof(double)*mt**nk);
 
       for(k=0;k<*nboun;++k){xbounact[k]=xbounini[k];}
       if((*ithermal==1)||(*ithermal>=3)){
     for(k=0;k<*nk;++k){t1act[k]=t1ini[k];}
       }
       for(k=0;k<neq[1];++k){
       f[k]=fini[k];
       }
       if(*nmethod==4){
     for(k=0;k<mt**nk;++k){
       veold[k]=veini[k];
       accold[k]=accini[k];
     }
     for(k=0;k<neq[1];++k){
 //    f[k]=fini[k];
       fext[k]=fextini[k];
       cv[k]=cvini[k];
     }
       }
       if(*ithermal!=2){
       for(k=0;k<6*mi[0]*ne0;++k){
           sti[k]=stiini[k];
           eme[k]=emeini[k];
       }
       }
       if(*nener==1)
       for(k=0;k<mi[0]*ne0;++k){ener[k]=enerini[k];}
 
       for(k=0;k<*nstate_*mi[0]*(ne0+maxprevcontel);++k){
       xstate[k]=xstateini[k];
       }   
 
       qam[0]=qamold[0];
       qam[1]=qamold[1];
     }
     
     /* face-to-face penalty */
 
     if((*mortar==1)&&(icutb==0)){
     
     ntrimax=0;
     for(i=0;i<*ntie;i++){       
         if(itietri[2*i+1]-itietri[2*i]+1>ntrimax)       
         ntrimax=itietri[2*i+1]-itietri[2*i]+1;      
     }
     NNEW(xo,double,ntrimax);        
     NNEW(yo,double,ntrimax);        
     NNEW(zo,double,ntrimax);        
     NNEW(x,double,ntrimax);     
     NNEW(y,double,ntrimax);     
     NNEW(z,double,ntrimax);    
     NNEW(nx,ITG,ntrimax);      
     NNEW(ny,ITG,ntrimax);       
     NNEW(nz,ITG,ntrimax);
       
     /*  Determination of active nodes (islavact) */
       
     FORTRAN(islavactive,(tieset,ntie,itietri,cg,straight,
            co,vold,xo,yo,zo,x,y,z,nx,ny,nz,mi,
            imastop,nslavnode,islavnode,islavact));
 
     SFREE(xo);SFREE(yo);SFREE(zo);SFREE(x);SFREE(y);SFREE(z);SFREE(nx);     
     SFREE(ny);SFREE(nz);
 
     if(negpres==0){
         if((*mortar==1)&&(1.-theta-dtheta<=1.e-6)&&(itruecontact==1)){
         printf(" pressure ratio (smallest/largest pressure over all contact areas) =%e\n\n",pressureratio);
         if(pressureratio<-0.05){
             printf(" zero-size increment is appended\n\n");
             negpres=1;theta=1.-1.e-6;dtheta=1.e-6;
         }
         }
     }else{negpres=0;}
 
     }
 
     /* output */
 
     if((jout[0]==jprint)&&(icutb==0)){
 
       jprint=0;
 
       /* calculating the displacements and the stresses and storing */
       /* the results in frd format  */
     
       NNEW(v,double,mt**nk);
       NNEW(fn,double,mt**nk);
       NNEW(stn,double,6**nk);
       if(*ithermal>1) NNEW(qfn,double,3**nk);
       NNEW(inum,ITG,*nk);
       NNEW(stx,double,6*mi[0]**ne);
       
       if(strcmp1(&filab[261],"E   ")==0) NNEW(een,double,6**nk);
       if(strcmp1(&filab[435],"PEEQ")==0) NNEW(epn,double,*nk);
       if(strcmp1(&filab[522],"ENER")==0) NNEW(enern,double,*nk);
       if(strcmp1(&filab[609],"SDV ")==0) NNEW(xstaten,double,*nstate_**nk);
       if(strcmp1(&filab[2175],"CONT")==0) NNEW(cdn,double,6**nk);
       if(strcmp1(&filab[2697],"ME  ")==0) NNEW(emn,double,6**nk);
 
       memcpy(&v[0],&vold[0],sizeof(double)*mt**nk);
 
       iout=2;
       icmd=3;
       
 #ifdef COMPANY
       FORTRAN(uinit,());
 #endif
       results(co,nk,kon,ipkon,lakon,ne,v,stn,inum,stx,
           elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat,
           ielorien,norien,orab,ntmat_,t0,t1act,ithermal,
           prestr,iprestr,filab,eme,emn,een,iperturb,
           f,fn,nactdof,&iout,qa,vold,b,nodeboun,
           ndirboun,xbounact,nboun,ipompc,
           nodempc,coefmpc,labmpc,nmpc,nmethod,cam,&neq[1],veold,accold,
               &bet,&gam,&dtime,&time,ttime,plicon,nplicon,plkcon,nplkcon,
           xstateini,xstiff,xstate,npmat_,epn,matname,mi,&ielas,&icmd,
           ncmat_,nstate_,stiini,vini,ikboun,ilboun,ener,enern,emeini,
               xstaten,eei,enerini,cocon,ncocon,set,nset,istartset,iendset,
               ialset,nprint,prlab,prset,qfx,qfn,trab,inotr,ntrans,fmpc,
           nelemload,nload,ikmpc,ilmpc,istep,&iinc,springarea,
               &reltime,&ne0,xforc,nforc,thicke,shcon,nshcon,
               sideload,xloadact,xloadold,&icfd,inomat,pslavsurf,pmastsurf,
               mortar,islavact,cdn,islavnode,nslavnode,ntie,clearini,
           islavsurf,ielprop,prop,energyini,energy,&kscale,iponoel,
               inoel,nener,orname,network,ipobody,xbodyact,ibody);
       
       memcpy(&vold[0],&v[0],sizeof(double)*mt**nk);
 
       iout=0;
       if(*iexpl<=1) icmd=0;
 //      FORTRAN(networkinum,(ipkon,inum,kon,lakon,ne,itg,&ntg));
 //      for(k=0;k<ntg;k++)if(inum[itg[k]-1]>0){inum[itg[k]-1]*=-1;}
       
       ++*kode;
       if(*mcs!=0){
     ptime=*ttime+time;
     frdcyc(co,nk,kon,ipkon,lakon,ne,v,stn,inum,nmethod,kode,filab,een,
            t1act,fn,&ptime,epn,ielmat,matname,cs,mcs,nkon,enern,xstaten,
                nstate_,istep,&iinc,iperturb,ener,mi,output,ithermal,qfn,
                ialset,istartset,iendset,trab,inotr,ntrans,orab,ielorien,
            norien,stx,veold,&noddiam,set,nset,emn,thicke,jobnamec,&ne0,
                cdn,mortar,nmat,qfx);
 #ifdef COMPANY
     FORTRAN(uout,(v,mi,ithermal,filab));
 #endif
       }
       else{
       if(strcmp1(&filab[1044],"ZZS")==0){
           NNEW(neigh,ITG,40**ne);
           NNEW(ipneigh,ITG,*nk);
       }
 
       ptime=*ttime+time;
       frd(co,nk,kon,ipkon,lakon,&ne0,v,stn,inum,nmethod,
         kode,filab,een,t1act,fn,&ptime,epn,ielmat,matname,enern,xstaten,
         nstate_,istep,&iinc,ithermal,qfn,&mode,&noddiam,trab,inotr,
         ntrans,orab,ielorien,norien,description,ipneigh,neigh,
         mi,stx,vr,vi,stnr,stni,vmax,stnmax,&ngraph,veold,ener,ne,
         cs,set,nset,istartset,iendset,ialset,eenmax,fnr,fni,emn,
         thicke,jobnamec,output,qfx,cdn,mortar,cdnr,cdni,nmat);
 
       if(strcmp1(&filab[1044],"ZZS")==0){SFREE(ipneigh);SFREE(neigh);}
 #ifdef COMPANY
       FORTRAN(uout,(v,mi,ithermal,filab));
 #endif
       }
       
       SFREE(v);SFREE(fn);SFREE(stn);SFREE(inum);SFREE(stx);
       if(*ithermal>1){SFREE(qfn);}
       
       if(strcmp1(&filab[261],"E   ")==0) SFREE(een);
       if(strcmp1(&filab[435],"PEEQ")==0) SFREE(epn);
       if(strcmp1(&filab[522],"ENER")==0) SFREE(enern);
       if(strcmp1(&filab[609],"SDV ")==0) SFREE(xstaten);
       if(strcmp1(&filab[2175],"CONT")==0) SFREE(cdn);
       if(strcmp1(&filab[2697],"ME  ")==0) SFREE(emn);
    }
     
   }
 
   /*********************************************************/
   /*   end of the increment loop                          */
   /*********************************************************/
 
   if(jprint!=0){
 
   /* calculating the displacements and the stresses and storing  
      the results in frd format */
   
     NNEW(v,double,mt**nk);
     NNEW(fn,double,mt**nk);
     NNEW(stn,double,6**nk);
     if(*ithermal>1) NNEW(qfn,double,3**nk);
     NNEW(inum,ITG,*nk);
     NNEW(stx,double,6*mi[0]**ne);
   
     if(strcmp1(&filab[261],"E   ")==0) NNEW(een,double,6**nk);
     if(strcmp1(&filab[435],"PEEQ")==0) NNEW(epn,double,*nk);
     if(strcmp1(&filab[522],"ENER")==0) NNEW(enern,double,*nk);
     if(strcmp1(&filab[609],"SDV ")==0) NNEW(xstaten,double,*nstate_**nk);
     if(strcmp1(&filab[2175],"CONT")==0) NNEW(cdn,double,6**nk);
     if(strcmp1(&filab[2697],"ME  ")==0) NNEW(emn,double,6**nk);
     
     memcpy(&v[0],&vold[0],sizeof(double)*mt**nk);
     iout=2;
     icmd=3;
 
 #ifdef COMPANY
     FORTRAN(uinit,());
 #endif
     results(co,nk,kon,ipkon,lakon,ne,v,stn,inum,stx,
         elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat,
         ielorien,norien,orab,ntmat_,t0,t1act,ithermal,
         prestr,iprestr,filab,eme,emn,een,iperturb,
         f,fn,nactdof,&iout,qa,vold,b,nodeboun,
         ndirboun,xbounact,nboun,ipompc,
         nodempc,coefmpc,labmpc,nmpc,nmethod,cam,&neq[1],veold,accold,
             &bet,&gam,&dtime,&time,ttime,plicon,nplicon,plkcon,nplkcon,
         xstateini,xstiff,xstate,npmat_,epn,matname,mi,&ielas,&icmd,
             ncmat_,nstate_,stiini,vini,ikboun,ilboun,ener,enern,emeini,
             xstaten,eei,enerini,cocon,ncocon,set,nset,istartset,iendset,
             ialset,nprint,prlab,prset,qfx,qfn,trab,inotr,ntrans,fmpc,
         nelemload,nload,ikmpc,ilmpc,istep,&iinc,springarea,
             &reltime,&ne0,xforc,nforc,thicke,shcon,nshcon,
             sideload,xloadact,xloadold,&icfd,inomat,pslavsurf,pmastsurf,
             mortar,islavact,cdn,islavnode,nslavnode,ntie,clearini,
         islavsurf,ielprop,prop,energyini,energy,&kscale,iponoel,
             inoel,nener,orname,network,ipobody,xbodyact,ibody);
     
     memcpy(&vold[0],&v[0],sizeof(double)*mt**nk);
 
     iout=0;
     if(*iexpl<=1) icmd=0;
 //    FORTRAN(networkinum,(ipkon,inum,kon,lakon,ne,itg,&ntg));
 //    for(k=0;k<ntg;k++)if(inum[itg[k]-1]>0){inum[itg[k]-1]*=-1;}
     
     ++*kode;
     if(*mcs>0){
     ptime=*ttime+time;
       frdcyc(co,nk,kon,ipkon,lakon,ne,v,stn,inum,nmethod,kode,filab,een,
          t1act,fn,&ptime,epn,ielmat,matname,cs,mcs,nkon,enern,xstaten,
              nstate_,istep,&iinc,iperturb,ener,mi,output,ithermal,qfn,
              ialset,istartset,iendset,trab,inotr,ntrans,orab,ielorien,
          norien,stx,veold,&noddiam,set,nset,emn,thicke,jobnamec,&ne0,
              cdn,mortar,nmat,qfx);
 #ifdef COMPANY
       FORTRAN(uout,(v,mi,ithermal,filab));
 #endif
 
     }
     else{
     if(strcmp1(&filab[1044],"ZZS")==0){
         NNEW(neigh,ITG,40**ne);
         NNEW(ipneigh,ITG,*nk);
     }
 
     ptime=*ttime+time;
     frd(co,nk,kon,ipkon,lakon,&ne0,v,stn,inum,nmethod,
         kode,filab,een,t1act,fn,&ptime,epn,ielmat,matname,enern,xstaten,
         nstate_,istep,&iinc,ithermal,qfn,&mode,&noddiam,trab,inotr,
         ntrans,orab,ielorien,norien,description,ipneigh,neigh,
         mi,stx,vr,vi,stnr,stni,vmax,stnmax,&ngraph,veold,ener,ne,
         cs,set,nset,istartset,iendset,ialset,eenmax,fnr,fni,emn,
         thicke,jobnamec,output,qfx,cdn,mortar,cdnr,cdni,nmat);
 
     if(strcmp1(&filab[1044],"ZZS")==0){SFREE(ipneigh);SFREE(neigh);}
 #ifdef COMPANY
     FORTRAN(uout,(v,mi,ithermal,filab));
 #endif
     }
 
     SFREE(v);SFREE(fn);SFREE(stn);SFREE(inum);SFREE(stx);
     if(*ithermal>1){SFREE(qfn);}
     
     if(strcmp1(&filab[261],"E   ")==0) SFREE(een);
     if(strcmp1(&filab[435],"PEEQ")==0) SFREE(epn);
     if(strcmp1(&filab[522],"ENER")==0) SFREE(enern);
     if(strcmp1(&filab[609],"SDV ")==0) SFREE(xstaten);
     if(strcmp1(&filab[2175],"CONT")==0) SFREE(cdn);
     if(strcmp1(&filab[2697],"ME  ")==0) SFREE(emn);
 
   }
     
   /* writing out the latest stiffness matrix for a subsequent
      sensitivity analysis */
 
   if(isensitivity){
       
       strcpy(stiffmatrix,jobnamec);
       strcat(stiffmatrix,".stm");
       
       if((f1=fopen(stiffmatrix,"wb"))==NULL){
       printf("*ERROR in linstatic: cannot open stiffness matrix file for writing...");
       exit(0);
       }
       
       /* storing the stiffness matrix */
 
       /* nzs,irow,jq and icol have to be stored too, since the static analysis
      can involve contact, whereas in the sensitivity analysis contact is not
      taken into account while determining the structure of the stiffness
      matrix (in mastruct.c)
       */
       
       if(fwrite(&nasym,sizeof(ITG),1,f1)!=1){
       printf("*ERROR saving the symmetry flag to the stiffness matrix file...");
       exit(0);
       }
       if(fwrite(nzs,sizeof(ITG),3,f1)!=3){
       printf("*ERROR saving the number of subdiagonal nonzeros to the stiffness matrix file...");
       exit(0);
       }
       if(fwrite(irow,sizeof(ITG),nzs[2],f1)!=nzs[2]){
       printf("*ERROR saving irow to the stiffness matrix file...");
       exit(0);
       }
       if(fwrite(jq,sizeof(ITG),neq[1]+1,f1)!=neq[1]+1){
       printf("*ERROR saving jq to the stiffness matrix file...");
       exit(0);
       }
       if(fwrite(icol,sizeof(ITG),neq[1],f1)!=neq[1]){
       printf("*ERROR saving icol to the stiffness matrix file...");
       exit(0);
       }
       if(fwrite(adcpy,sizeof(double),neq[1],f1)!=neq[1]){
       printf("*ERROR saving the diagonal of the stiffness matrix to the stiffness matrix file...");
       exit(0);
       }
       if(fwrite(aucpy,sizeof(double),(nasym+1)*nzs[2],f1)!=(nasym+1)*nzs[2]){
       printf("*ERROR saving the off-diagonal terms of the stiffness matrix to the stiffness matrix file...");
       exit(0);
       }
       fclose(f1);
       SFREE(adcpy);SFREE(aucpy);
   }
   
   /* restoring the distributed loading  */
 
   if((*ithermal==3)&&(ncont!=0)&&(*mortar==1)&&(*ncmat_>=11)){
       *nload=nloadref;
       RENEW(nelemload,ITG,2**nload);memcpy(&nelemload[0],&nelemloadref[0],sizeof(ITG)*2**nload);
       if(*nam>0){
       RENEW(iamload,ITG,2**nload);
       memcpy(&iamload[0],&iamloadref[0],sizeof(ITG)*2**nload);
       }
       RENEW(sideload,char,20**nload);memcpy(&sideload[0],&sideloadref[0],sizeof(char)*20**nload);
       
       /* freeing the temporary fields */
       
       SFREE(nelemloadref);if(*nam>0){SFREE(iamloadref);};
       SFREE(sideloadref);
   }
 
   /* setting the velocity to zero at the end of a quasistatic or stationary
      step */
 
   if(abs(*nmethod)==1){
     for(k=0;k<mt**nk;++k){veold[k]=0.;}
   }
 
   /* 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){
 
       /* thermal boundary conditions are updated only if the
          step was thermal or thermomechanical */
 
       if(ndirboun[k]==0){
       if(*ithermal<2) continue;
 
       /* mechanical boundary conditions are updated only
              if the step was not thermal or the node is a
              network node */
 
       }else if((ndirboun[k]>0)&&(ndirboun[k]<4)){
       node=nodeboun[k];
       FORTRAN(nident,(itg,&node,&ntg,&id));
       networknode=0;
       if(id>0){
           if(itg[id-1]==node) networknode=1;
       }
       if((*ithermal==2)&&(networknode==0)) continue;
       }
       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];}
     for(k=0;k<*nk;++k){vold[mt*k]=t1act[k];}
   }
   else if(*ithermal>1){
     for(k=0;k<*nk;++k){t1[k]=vold[mt*k];}
     if(*ithermal>=3){
     for(k=0;k<*nk;++k){t1old[k]=t1act[k];}
     }
   }
 
   qaold[0]=qa[0];
   qaold[1]=qa[1];
 
   SFREE(f);SFREE(b);
   SFREE(xbounact);SFREE(xforcact);SFREE(xloadact);SFREE(xbodyact);
   if(*nbody>0) SFREE(ipobody);if(inewton==1){SFREE(cgr);}
   SFREE(fext);SFREE(ampli);SFREE(xbounini);SFREE(xstiff);
   if((*ithermal==1)||(*ithermal>=3)){SFREE(t1act);SFREE(t1ini);}
 
   if(*ithermal>1){
       SFREE(itg);SFREE(ieg);SFREE(kontri);SFREE(nloadtr);
       SFREE(nactdog);SFREE(nacteq);SFREE(ineighe);
       SFREE(tarea);SFREE(tenv);SFREE(fenv);SFREE(qfx);
       SFREE(erad);SFREE(ac);SFREE(bc);SFREE(ipiv);
       SFREE(bcr);SFREE(ipivr);SFREE(adview);SFREE(auview);SFREE(adrad);
       SFREE(aurad);SFREE(irowrad);SFREE(jqrad);SFREE(icolrad);
       if((*mcs>0)&&(ntr>0)){SFREE(inocs);}
       if((*network>0)||(ntg>0)){SFREE(iponoel);SFREE(inoel);}
   }
 
   if(icfd==1){
       SFREE(neifa);SFREE(neiel);SFREE(neij);SFREE(ielfa);SFREE(ifaext);
       SFREE(vel);SFREE(vfa);SFREE(nactdoh);SFREE(nactdohinv);SFREE(konf);
       SFREE(ipkonf);SFREE(lakonf);SFREE(ielmatf);free(ifatie);
       if(*norien>0) SFREE(ielorienf);
       if(nblk!=0){SFREE(istartblk);SFREE(iendblk);
       SFREE(nblket);SFREE(nblkze);SFREE(ielblk);}
   }
 
   SFREE(fini);
   if(*nmethod==4){
     SFREE(aux2);SFREE(fextini);SFREE(veini);SFREE(accini);
     SFREE(adb);SFREE(aub);SFREE(cvini);SFREE(cv);SFREE(fnext);
     SFREE(fnextini);
   }
   SFREE(eei);SFREE(stiini);SFREE(emeini);
   if(*nener==1)SFREE(enerini);
   if(*nstate_!=0){SFREE(xstateini);}
 
   SFREE(aux);SFREE(iaux);SFREE(vini);
 
   if(icascade==2){
       memmpc_=memmpcref_;mpcfree=mpcfreeref;maxlenmpc=maxlenmpcref;
       RENEW(nodempc,ITG,3*memmpcref_);
       for(k=0;k<3*memmpcref_;k++){nodempc[k]=nodempcref[k];}
       RENEW(coefmpc,double,memmpcref_);
       for(k=0;k<memmpcref_;k++){coefmpc[k]=coefmpcref[k];}
       SFREE(nodempcref);SFREE(coefmpcref);
   }
 
   if(ncont!=0){
       *ne=ne0;*nkon=nkon0;
       if(*nener==1){
     RENEW(ener,double,mi[0]**ne*2);
       }
       RENEW(ipkon,ITG,*ne);
       RENEW(lakon,char,8**ne);
       RENEW(kon,ITG,*nkon);
       if(*norien>0){
       RENEW(ielorien,ITG,mi[2]**ne);
       }
       RENEW(ielmat,ITG,mi[2]**ne);
 
       SFREE(cg);SFREE(straight);
       SFREE(imastop);SFREE(itiefac);SFREE(islavnode);
       SFREE(nslavnode);SFREE(iponoels);SFREE(inoels);SFREE(imastnode);
       SFREE(nmastnode);SFREE(itietri);SFREE(koncont);SFREE(xnoels);
       SFREE(springarea);SFREE(xmastnor);
 
       if(*mortar==0){
       SFREE(areaslav);
       }else if(*mortar==1){
       SFREE(pmastsurf);SFREE(ipe);SFREE(ime);
           SFREE(islavact);
       }
   }
 
   /* reset icascade */
 
   if(icascade==1){icascade=0;}
 
   mpcinfo[0]=memmpc_;mpcinfo[1]=mpcfree;mpcinfo[2]=icascade;
   mpcinfo[3]=maxlenmpc;
 
   if(iglob==1){SFREE(integerglob);SFREE(doubleglob);}
 
   *icolp=icol;*irowp=irow;*cop=co;*voldp=vold;
 
   *ipompcp=ipompc;*labmpcp=labmpc;*ikmpcp=ikmpc;*ilmpcp=ilmpc;
   *fmpcp=fmpc;*nodempcp=nodempc;*coefmpcp=coefmpc;*nelemloadp=nelemload;
   *iamloadp=iamload;*sideloadp=sideload;
 
   *ipkonp=ipkon;*lakonp=lakon;*konp=kon;*ielorienp=ielorien;
   *ielmatp=ielmat;*enerp=ener;*xstatep=xstate;
 
   *islavsurfp=islavsurf;*pslavsurfp=pslavsurf;*clearinip=clearini;
 
   (*tmin)*=(*tper);
   (*tmax)*=(*tper);
 
   SFREE(nactdofinv);
   // MPADD start
   if((*nmethod==4)&&(*ithermal!=2)&&(*iexpl<=1)&&(icfd!=1)){ SFREE(adblump);}
   // MPADD end
   
   (*ttime)+=(*tper);
   
   return;
 }

◆ objectivemain_se()

void objectivemain_se	(	double *	co,
		ITG *	nk,
		ITG *	kon,
		ITG *	ipkon,
		char *	lakon,
		ITG *	ne,
		double *	v,
		double *	stn,
		ITG *	inum,
		double *	stx,
		double *	elcon,
		ITG *	nelcon,
		double *	rhcon,
		ITG *	nrhcon,
		double *	alcon,
		ITG *	nalcon,
		double *	alzero,
		ITG *	ielmat,
		ITG *	ielorien,
		ITG *	norien,
		double *	orab,
		ITG *	ntmat_,
		double *	t0,
		double *	t1,
		ITG *	ithermal,
		double *	prestr,
		ITG *	iprestr,
		char *	filab,
		double *	eme,
		double *	emn,
		double *	een,
		ITG *	iperturb,
		double *	f,
		double *	fn,
		ITG *	nactdof,
		ITG *	iout,
		double *	qa,
		double *	vold,
		ITG *	nodeboun,
		ITG *	ndirboun,
		double *	xboun,
		ITG *	nboun,
		ITG *	ipompc,
		ITG *	nodempc,
		double *	coefmpc,
		char *	labmpc,
		ITG *	nmpc,
		ITG *	nmethod,
		double *	cam,
		ITG *	neq,
		double *	veold,
		double *	accold,
		double *	bet,
		double *	gam,
		double *	dtime,
		double *	time,
		double *	ttime,
		double *	plicon,
		ITG *	nplicon,
		double *	plkcon,
		ITG *	nplkcon,
		double *	xstateini,
		double *	xstiff,
		double *	xstate,
		ITG *	npmat_,
		double *	epn,
		char *	matname,
		ITG *	mi,
		ITG *	ielas,
		ITG *	icmd,
		ITG *	ncmat_,
		ITG *	nstate_,
		double *	stiini,
		double *	vini,
		ITG *	ikboun,
		ITG *	ilboun,
		double *	ener,
		double *	enern,
		double *	emeini,
		double *	xstaten,
		double *	eei,
		double *	enerini,
		double *	cocon,
		ITG *	ncocon,
		char *	set,
		ITG *	nset,
		ITG *	istartset,
		ITG *	iendset,
		ITG *	ialset,
		ITG *	nprint,
		char *	prlab,
		char *	prset,
		double *	qfx,
		double *	qfn,
		double *	trab,
		ITG *	inotr,
		ITG *	ntrans,
		double *	fmpc,
		ITG *	nelemload,
		ITG *	nload,
		ITG *	ikmpc,
		ITG *	ilmpc,
		ITG *	istep,
		ITG *	iinc,
		double *	springarea,
		double *	reltime,
		ITG *	ne0,
		double *	xforc,
		ITG *	nforc,
		double *	thicke,
		double *	shcon,
		ITG *	nshcon,
		char *	sideload,
		double *	xload,
		double *	xloadold,
		ITG *	icfd,
		ITG *	inomat,
		double *	pslavsurf,
		double *	pmastsurf,
		ITG *	mortar,
		ITG *	islavact,
		double *	cdn,
		ITG *	islavnode,
		ITG *	nslavnode,
		ITG *	ntie,
		double *	clearini,
		ITG *	islavsurf,
		ITG *	ielprop,
		double *	prop,
		double *	energyini,
		double *	energy,
		double *	distmin,
		ITG *	ndesi,
		ITG *	nodedesi,
		ITG *	nobject,
		char *	objectset,
		double *	g0,
		double *	dgdx,
		double *	sti,
		double *	df,
		ITG *	nactdofinv,
		ITG *	jqs,
		ITG *	irows,
		ITG *	idisplacement,
		ITG *	nzs,
		char *	jobnamec,
		ITG *	isolver,
		ITG *	icol,
		ITG *	irow,
		ITG *	jq,
		ITG *	kode,
		double *	cs,
		char *	output,
		ITG *	istartdesi,
		ITG *	ialdesi,
		double *	xdesi,
		char *	orname,
		ITG *	icoordinate,
		ITG *	iev,
		double *	d,
		double *	z,
		double *	au,
		double *	ad,
		double *	aub,
		double *	adb,
		ITG *	cyclicsymmetry,
		ITG *	nzss,
		ITG *	nev,
		ITG *	ishapeenergy,
		double *	fint,
		ITG *	nlabel,
		ITG *	igreen,
		ITG *	nasym,
		ITG *	iponoel,
		ITG *	inoel,
		ITG *	nodedesiinv,
		double *	dgdxglob
	)

                                                                  {
 
     char description[13]="            ",cflag[1]=" ",*filabl=NULL;
 
     ITG calcul_qa,nener=0,ikin,i,j,k,m,iobject,im,symmetryflag=0,inputformat=0,
         mt=mi[1]+1,mode=-1,noddiam=-1,ngraph=1,idesvar,nea,neb,nodeset,lmax,
         kscale=1,idir,iorien,network=0,inorm=0,irand=0,*neinset=NULL,
         nepar,isum,idelta,*neapar=NULL,*nebpar=NULL,nestart,neend,num_cpus,
         l;
 
     double sigma=0.,ptime=0.,*temp=NULL,*bfix=NULL,*vnew=NULL,*dstn=NULL,
       freq,*c=NULL,orabsav[7],rotvec[3],a[9],pgauss[3],*b=NULL,
         *vec=NULL;
     
     if(*nasym!=0){symmetryflag=2;inputformat=1;}
 
     /* variables for multithreading procedure */
     
     ITG sys_cpus,*ithread=NULL;
     char *env,*envloc,*envsys;
     
     num_cpus=0;
     sys_cpus=0;
     
     /* explicit user declaration prevails */
     
     envsys=getenv("NUMBER_OF_CPUS");
     if(envsys){
         sys_cpus=atoi(envsys);
         if(sys_cpus<0) sys_cpus=0;
     }
     
     /* automatic detection of available number of processors */
     
     if(sys_cpus==0){
         sys_cpus = getSystemCPUs();
         if(sys_cpus<1) sys_cpus=1;
     }
     
     /* local declaration prevails, if strictly positive */
     
     envloc = getenv("CCX_NPROC_RESULTS");
     if(envloc){
         num_cpus=atoi(envloc);
         if(num_cpus<0){
             num_cpus=0;
         }else if(num_cpus>sys_cpus){
             num_cpus=sys_cpus;
         }
         
     }
     
     /* else global declaration, if any, applies */
     
     env = getenv("OMP_NUM_THREADS");
     if(num_cpus==0){
         if (env)
             num_cpus = atoi(env);
         if (num_cpus < 1) {
             num_cpus=1;
         }else if(num_cpus>sys_cpus){
             num_cpus=sys_cpus;
         }
     }
     
     pthread_t tid[num_cpus];
 
     if((*idisplacement==1)||((*ishapeenergy==1)&&(iperturb[1]==1))){
 
     /* factor the system */
 
     if(*isolver==0){
 #ifdef SPOOLES
         spooles_factor(ad,au,adb,aub,&sigma,icol,irow,&neq[1],&nzs[1],
                &symmetryflag,&inputformat,&nzs[2]);
 #else
         printf("*ERROR in objectivemain_se: the SPOOLES library is not linked\n\n");
         FORTRAN(stop,());
 #endif
     }
     else if(*isolver==4){
 #ifdef SGI
         token=1;
         sgi_factor(ad,au,adb,aub,&sigma,icol,irow,&neq[1],&nzs[1],token);
 #else
         printf("*ERROR in objectivemain_se: the SGI library is not linked\n\n");
         FORTRAN(stop,());
 #endif
     }
     else if(*isolver==5){
 #ifdef TAUCS
         tau_factor(ad,&au,adb,aub,&sigma,icol,&irow,&neq[1],&nzs[1]);
 #else
         printf("*ERROR in objectivemain_se: the TAUCS library is not linked\n\n");
         FORTRAN(stop,());
 #endif
     }
     else if(*isolver==7){
 #ifdef PARDISO
         pardiso_factor(ad,au,adb,aub,&sigma,icol,irow,&neq[1],&nzs[1],
                &symmetryflag,&inputformat,jq,&nzs[2]);
 #else
         printf("*ERROR in objectivemain_se: the PARDISO library is not linked\n\n");
         FORTRAN(stop,());
 #endif
     }
     
     }
     
     /* loop over all objective functions */
 
     for(m=0;m<*nobject;m++){
     if(strcmp1(&objectset[m*324],"MASS")==0){
         iobject=m+1;
         iobject1=iobject;
         
         /* OBJECTIVE: MASS */
         
         NNEW(xmass1,double,*ne);
 
             /* deactivating the elements which are not part of the 
                target function */
 
         FORTRAN(actideacti,(set,nset,istartset,iendset,ialset,objectset,
                                 ipkon,&iobject,ne));
  
             /* call without perturbation */
    
         idesvar=0;
 
         /* calculating the objective function and the derivatives */
 
         if(*ne<num_cpus){num_cpuse=*ne;}else{num_cpuse=num_cpus;}
         
         NNEW(g01,double,num_cpuse**nobject);
         
         co1=co;kon1=kon;ipkon1=ipkon;lakon1=lakon;v1=v;nelcon1=nelcon;rhcon1=rhcon;
         ielmat1=ielmat;ielorien1=ielorien;norien1=norien;ntmat1_=ntmat_;vold1=vold;
             matname1=matname;mi1=mi;thicke1=thicke;mortar1=mortar;ielprop1=ielprop;
             prop1=prop;distmin1=distmin;ndesi1=ndesi;nodedesi1=nodedesi;
         nobject1=nobject;iobject1=iobject;ne1=ne;istartdesi1=istartdesi;
             ialdesi1=ialdesi;xdesi1=xdesi;idesvar1=idesvar;
         
         if(((*nmethod!=4)&&(*nmethod!=5))||(iperturb[0]>1)){
         printf(" Using up to %" ITGFORMAT " cpu(s) for the mass sensitivity.\n\n", num_cpuse);
         }
         
         NNEW(ithread,ITG,num_cpuse);
         
         /* Total difference of the mass */
         /* create threads and wait */
         
         for(i=0;i<num_cpuse;i++)  {
         ithread[i]=i;
         pthread_create(&tid[i], NULL, (void *)objectivemt_mass_dx, (void *)&ithread[i]);
         }
         
         for(i=0;i<num_cpuse;i++)  pthread_join(tid[i], NULL);
     
         /* Assembling g0 */
         
         g0[m]=g01[m];
         for(j=1;j<num_cpuse;j++){
         g0[m]+=g01[m+j**nobject];
         }
         SFREE(g01);SFREE(ithread);
     
         /* loop over the design variables (perturbation) */
     
         for(idesvar=1;idesvar<=*ndesi;idesvar++){
 
         nea=istartdesi[idesvar-1];
         neb=istartdesi[idesvar]-1;
 
         FORTRAN(objective_mass_dx,(co,kon,ipkon,lakon,nelcon,rhcon,
             ielmat,ielorien,norien,ntmat1_,matname,mi,
             thicke,mortar,&nea,&neb,ielprop,prop,distmin,ndesi,nodedesi,
             nobject,g0,dgdx,&iobject,xmass1,
             istartdesi,ialdesi,xdesi,&idesvar));
         }
 
         SFREE(xmass1);
 
             /* reactivating all elements */
 
         for(i=0;i<*ne;i++){
         if(ipkon[i]<-1) ipkon[i]=-2-ipkon[i];
         }
         
     }else if(strcmp1(&objectset[m*324],"SHAPEENERGY")==0){
         iobject=m+1;
         iobject1=iobject;
         
         /* OBJECTIVE: SHAPE ENERGY */
         
         NNEW(xener1,double,*ne);
 
             /* deactivating the elements which are not part of the 
                target function */
 
         FORTRAN(actideacti,(set,nset,istartset,iendset,ialset,objectset,
                                 ipkon,&iobject,ne));
  
             /* call without perturbation */
    
         idesvar=0;
         
         /* calculating the objective function and the derivatives */
 
         if(*ne<num_cpus){num_cpuse=*ne;}else{num_cpuse=num_cpus;}
         
         NNEW(g01,double,num_cpuse**nobject);
         
         co1=co;kon1=kon;ipkon1=ipkon;lakon1=lakon;ne1=ne;
         stx1=stx;elcon1=elcon;nelcon1=nelcon;rhcon1=rhcon;
         nrhcon1=nrhcon;alcon1=alcon;nalcon1=nalcon;alzero1=alzero;
         ielmat1=ielmat;ielorien1=ielorien;norien1=norien;orab1=orab;
         ntmat1_=ntmat_;t01=t0;t11=t1;ithermal1=ithermal;prestr1=prestr;
         iprestr1=iprestr;iperturb1=iperturb;iout1=iout;
         vold1=vold;nmethod1=nmethod;veold1=veold;dtime1=dtime;
         time1=time;ttime1=ttime;plicon1=plicon;nplicon1=nplicon;
         plkcon1=plkcon;nplkcon1=nplkcon;xstateini1=xstateini;
         xstiff1=xstiff;xstate1=xstate;npmat1_=npmat_;matname1=matname;
         mi1=mi;ielas1=ielas;icmd1=icmd;ncmat1_=ncmat_;nstate1_=nstate_;
         stiini1=stiini;vini1=vini;ener1=ener;eei1=eei;enerini1=enerini;
         istep1=istep;iinc1=iinc;springarea1=springarea;reltime1=reltime;
         calcul_qa1=calcul_qa;nener1=nener;ikin1=ikin;ne01=ne0;thicke1=thicke;
         emeini1=emeini;pslavsurf1=pslavsurf;pmastsurf1=pmastsurf;mortar1=mortar;
             clearini1=clearini;ielprop1=ielprop;prop1=prop;
         distmin1=distmin;ndesi1=ndesi;nodedesi1=nodedesi;
         nobject1=nobject;iobject1=iobject;sti1=sti;istartdesi1=istartdesi;
             ialdesi1=ialdesi;xdesi1=xdesi;idesvar1=idesvar;
         
         if(((*nmethod!=4)&&(*nmethod!=5))||(iperturb[0]>1)){
         printf(" Using up to %" ITGFORMAT " cpu(s) for the shape energy sensitivity.\n\n", num_cpuse);
         }
         
         NNEW(ithread,ITG,num_cpuse);
         
         /* Total difference of the internal shape energy */
         /* create threads and wait */
         
         for(i=0;i<num_cpuse;i++)  {
         ithread[i]=i;
         pthread_create(&tid[i], NULL, (void *)objectivemt_shapeener_dx, (void *)&ithread[i]);
         }
         
         for(i=0;i<num_cpuse;i++)  pthread_join(tid[i], NULL);
     
         /* Assembling g0 */
         
         g0[m]=g01[m];
         for(j=1;j<num_cpuse;j++){
         g0[m]+=g01[m+j**nobject];
         }
         SFREE(g01);SFREE(ithread);
     
         /* loop over the design variables (perturbation) */
     
         for(idesvar=1;idesvar<=*ndesi;idesvar++){
 
         nea=istartdesi[idesvar-1];
         neb=istartdesi[idesvar]-1;
     
         FORTRAN(objective_shapeener_dx,(co,kon,ipkon,lakon,ne,
                        stx,elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,
                    ielmat,ielorien,norien,orab,ntmat1_,t0,t1,ithermal,prestr,
                    iprestr,iperturb,iout,vold,
                    nmethod,veold,dtime,time,ttime,plicon,nplicon,plkcon,
                    nplkcon,xstateini,xstiff,xstate,npmat1_,matname,mi,ielas,
                    icmd,ncmat1_,nstate1_,stiini,vini,ener,enerini,istep,iinc,
                        springarea,reltime,&calcul_qa,&nener,&ikin,          
                        ne0,thicke,emeini,pslavsurf,pmastsurf,mortar,clearini,
                        &nea,&neb,ielprop,prop,distmin,ndesi,nodedesi,
                    nobject,g0,dgdx,&iobject,sti,xener1,
                istartdesi,ialdesi,xdesi,&idesvar));
 
         }
 
             if(iperturb[1]==1){
                    
            /* solve the system */
             
             if(*isolver==0){
 #ifdef SPOOLES
             spooles_solve(fint,&neq[1]);
 #endif
             }
             else if(*isolver==4){
 #ifdef SGI
             sgi_solve(fint,token);
 #endif
             }
             else if(*isolver==5){
 #ifdef TAUCS
             tau_solve(fint,&neq[1]);
 #endif
             }
             else if(*isolver==7){
 #ifdef PARDISO
             pardiso_solve(fint,&neq[1],&symmetryflag);
 #endif
 }         
           
            /* solve the system */         
                 
         }
         
         SFREE(xener1);
 
             /* reactivating all elements */
 
         for(i=0;i<*ne;i++){
         if(ipkon[i]<-1) ipkon[i]=-2-ipkon[i];
         }
 
             /* composing the total derivative */
 
         NNEW(vec,double,*neq);
 
         FORTRAN(objective_shapeener_tot,(ne,kon,ipkon,lakon,fint,vold,
             iperturb,mi,nactdof,dgdx,df,ndesi,&iobject,jqs,
             irows,vec));
         
         SFREE(vec);
         
     }else if((strcmp1(&objectset[m*324],"EIGENFREQUENCY")==0)||
                  (strcmp1(&objectset[m*324],"GREEN")==0)){
         iobject=m+1;
         
         /* OBJECTIVE: EIGENFREQUENCY */
 
         if(*igreen!=1){
 
                 /* determination of the sensitivity of the eigenvalues */
 
         if(!*cyclicsymmetry){
             
             FORTRAN(objective_freq,(dgdx,df,v,ndesi,&iobject,
                         mi,nactdofinv,jqs,irows));
             
             /* change sign since df contains -(dK/dX-lambda*dM/DX).U */
             
             for(idesvar=0;idesvar<*ndesi;idesvar++){dgdx[idesvar]=-dgdx[idesvar];}
         }else{
             
             FORTRAN(objective_freq_cs,(dgdx,df,v,ndesi,&iobject,
                            mi,nactdofinv,jqs,irows,nk,nzss));
         }
         }
 
         g0[m]=d[*iev];
 
             /* in case the design variables are the orientations
                the sensitivity of the eigenvectors is also
                determined */
 
         if(*icoordinate!=1){
         if(*igreen!=1) FORTRAN(writedeigdx,(iev,d,ndesi,orname,dgdx));
 
             /* createinum is called in order to determine the nodes belonging
                to elements; this information is needed in frd_se */
         
         NNEW(inum,ITG,*nk);
         FORTRAN(createinum,(ipkon,inum,kon,lakon,nk,ne,&cflag[0],
                     nelemload,nload,nodeboun,nboun,ndirboun,ithermal,co,
                     vold,mi,ielmat));
         
                 /* the frequency is also needed for frd_se */
 
         if(d[*iev]>=0.){
             freq=sqrt(d[*iev])/6.283185308;
         }else{
             freq=0.;
         }
 
                 /* determine the derivative of the eigenvectors */
 
         NNEW(bfix,double,neq[1]);
         NNEW(b,double,neq[1]);
         NNEW(temp,double,mt**nk);
 
         if(*igreen!=1){
             
             /* bfix = M * eigenvector */
             
             FORTRAN(op,(neq,&z[*iev*neq[1]],bfix,adb,aub,jq,irow));
 
         }else{      
 
             sigma=d[*iev];
             
             /* factor the system */
             
             if(*isolver==0){
 #ifdef SPOOLES
             spooles_factor(ad,au,adb,aub,&sigma,icol,irow,&neq[1],&nzs[1],
                    &symmetryflag,&inputformat,&nzs[2]);
 #else
             printf("*ERROR in objectivemain_se: the SPOOLES library is not linked\n\n");
             FORTRAN(stop,());
 #endif
             }
             else if(*isolver==4){
 #ifdef SGI
             token=1;
             sgi_factor(ad,au,adb,aub,&sigma,icol,irow,&neq[1],&nzs[1],token);
 #else
             printf("*ERROR in objectivemain_se: the SGI library is not linked\n\n");
             FORTRAN(stop,());
 #endif
             }
             else if(*isolver==5){
 #ifdef TAUCS
             tau_factor(ad,&au,adb,aub,&sigma,icol,&irow,&neq[1],&nzs[1]);
 #else
             printf("*ERROR in objectivemain_se: the TAUCS library is not linked\n\n");
             FORTRAN(stop,());
 #endif
             }
             else if(*isolver==7){
 #ifdef PARDISO
             pardiso_factor(ad,au,adb,aub,&sigma,icol,irow,&neq[1],&nzs[1],
                        &symmetryflag,&inputformat,jq,&nzs[2]);
 #else
             printf("*ERROR in objectivemain_se: the PARDISO library is not linked\n\n");
             FORTRAN(stop,());
 #endif
             }
         }   
         
                 /* loop over all design variables */
     
         for(idesvar=0;idesvar<*ndesi;idesvar++){
 
                     /* setting up the RHS of the system */
 
             if(*igreen!=1){
             for(j=0;j<neq[1];j++){
                 b[j]=dgdx[idesvar]*bfix[j];
             }
             }else{
             DMEMSET(b,0,neq[1],0.);
             }
 
             for(j=jqs[idesvar]-1;j<jqs[idesvar+1]-1;j++){
             b[irows[j]-1]+=df[j];
             }
 
             if(*igreen==1){
 
             /* solve the system */
             
             if(*isolver==0){
 #ifdef SPOOLES
                 spooles_solve(b,&neq[1]);
 #endif
             }
             else if(*isolver==4){
 #ifdef SGI
                 sgi_solve(b,token);
 #endif
             }
             else if(*isolver==5){
 #ifdef TAUCS
                 tau_solve(b,&neq[1]);
 #endif
             }
             else if(*isolver==7){
 #ifdef PARDISO
                 pardiso_solve(b,&neq[1],&symmetryflag);
 #endif
             }
             }else{
             
             NNEW(c,double,*nev);
             for(j=0;j<*nev;j++){
                 if(j==*iev) continue;
                 for(k=0;k<neq[1];k++){
                 c[j]+=z[j*neq[1]+k]*b[k];
                 }
                 c[j]/=(d[j]-d[*iev]);
             }
             DMEMSET(b,0,neq[1],0.);
             for(j=0;j<*nev;j++){
                 if(j==*iev) continue;
                 for(k=0;k<neq[1];k++){
                 b[k]+=c[j]*z[j*neq[1]+k];
                 }
             }
             SFREE(c);
             }
 
             /* store the answer in temp w.r.t. node and direction
                instead of w.r.t. dof */
             
             DMEMSET(temp,0,mt**nk,0.);
             FORTRAN(resultsnoddir,(nk,temp,nactdof,b,ipompc,nodempc,
                       coefmpc,nmpc,mi));
             
             /* storing the sensitivity of the eigenmodes to file */
             
             ++*kode;
             frd_sen(co,nk,stn,inum,nmethod,kode,filab,
                        &freq,nstate_,
                istep,iinc,&mode,&noddiam,description,mi,&ngraph,
                        ne,cs,set,nset,istartset,iendset,ialset,
                jobnamec,output,temp,&iobject,objectset,ntrans,
                inotr,trab,&idesvar,orname,icoordinate,&inorm,
                        &irand); 
 
         }  // enddo loop idesvar
 
         if(*igreen==1){
             
             /* clean the system */
             
             if(*isolver==0){
 #ifdef SPOOLES
             spooles_cleanup();
 #endif
             }
             else if(*isolver==4){
 #ifdef SGI
             sgi_cleanup(token);
 #endif
             }
             else if(*isolver==5){
 #ifdef TAUCS
             tau_cleanup();
 #endif
             }
             else if(*isolver==7){
 #ifdef PARDISO
             pardiso_cleanup(&neq[1],&symmetryflag);
 #endif
             }
         }
 
         SFREE(temp);SFREE(bfix);SFREE(b);SFREE(inum);
 
         }
 
     }else if(strcmp1(&objectset[m*324],"DISPLACEMENT")==0){
         iobject=m+1;
 
             /* OBJECTIVE: DISPLACEMENT */
         
         /* createinum is called in order to determine the nodes belonging
            to elements; this information is needed in frd_se */
         
         NNEW(inum,ITG,*nk);
         FORTRAN(createinum,(ipkon,inum,kon,lakon,nk,ne,&cflag[0],nelemload,
             nload,nodeboun,nboun,ndirboun,ithermal,co,vold,mi,ielmat));
         
         NNEW(b,double,neq[1]);
         NNEW(temp,double,mt**nk);
 
             /* if the design variables are the coordinates:
                check for the existence of a target node set */
 
             /* calculating the objective function */
 
         if(*icoordinate==1){
         nodeset=0;
         for(i=0;i<*nset;i++){
             if(strcmp1(&objectset[m*324+162]," ")==0) continue;
             if(strcmp2(&objectset[m*324+162],&set[i*81],81)==0){
             nodeset=i+1;
             break;
             }
         }
         FORTRAN(objective_disp,(&nodeset,istartset,iendset,
             ialset,nk,&idesvar,&iobject,mi,g0,
             nobject,vold));
         }
         
         for(idesvar=0;idesvar<*ndesi;idesvar++){
         
                 /* copying the RHS from field df */
 
         DMEMSET(b,0,neq[1],0.);
         for(j=jqs[idesvar]-1;j<jqs[idesvar+1]-1;j++){
             b[irows[j]-1]=df[j];
         }
 
                 /* solve the system */
 
         if(*isolver==0){
 #ifdef SPOOLES
             spooles_solve(b,&neq[1]);
 #endif
         }
         else if(*isolver==4){
 #ifdef SGI
             sgi_solve(b,token);
 #endif
         }
         else if(*isolver==5){
 #ifdef TAUCS
             tau_solve(b,&neq[1]);
 #endif
         }
         else if(*isolver==7){
 #ifdef PARDISO
             pardiso_solve(b,&neq[1],&symmetryflag);
 #endif
         }
 
         if(*icoordinate!=1){
             
             /* store the answer in temp w.r.t. node and direction
                instead of w.r.t. dof */
             
             DMEMSET(temp,0,mt**nk,0.);
             FORTRAN(resultsnoddir,(nk,temp,nactdof,b,ipompc,nodempc,
                       coefmpc,nmpc,mi));
             
             /* storing the results to file */
             
             ++*kode;
             frd_sen(co,nk,stn,inum,nmethod,kode,filab,
                        &ptime,nstate_,
                istep,iinc,&mode,&noddiam,description,mi,&ngraph,
                        ne,cs,set,nset,istartset,iendset,ialset,
                jobnamec,output,temp,&iobject,objectset,ntrans,
                inotr,trab,&idesvar,orname,icoordinate,&inorm,
                        &irand); 
 
         }else{
             FORTRAN(objective_disp_dx,(&nodeset,istartset,iendset,
                 ialset,nk,&idesvar,&iobject,mi,nactdof,dgdx,
                             ndesi,nobject,vold,b));
         }
         }
 
         SFREE(b);SFREE(temp);SFREE(inum);
         
     }else if(strcmp1(&objectset[m*324],"STRESS")==0){
         iobject=m+1;
 
         NNEW(filabl,char,87**nlabel);
         for(i=0;i<87**nlabel;i++){strcpy1(&filabl[i]," ",1);}
         strcpy1(&filabl[174],"S   ",4);
         
         /* deactivating all elements which are not part of
            the target function */
        
         NNEW(neinset,ITG,*ne);
 
         FORTRAN(actideactistr,(set,nset,istartset,iendset,ialset,objectset,
                                 ipkon,&iobject,ne,neinset,iponoel,inoel,&nepar));
 
             /* determining the nodal bounds in each thread */
 
         if(nepar<num_cpus){num_cpuse=nepar;}else{num_cpuse=num_cpus;}
 
             NNEW(neapar,ITG,num_cpuse);
             NNEW(nebpar,ITG,num_cpuse);
         
         idelta=nepar/num_cpuse;
         
         /* dividing the range from 1 to the number of active elements */
         
             isum=0;
             for(i=0;i<num_cpuse;i++){
            neapar[i]=isum;
            if(i!=num_cpuse-1){
               isum+=idelta;
            }else{
               isum=nepar;
            }
            nebpar[i]=isum-1;
             }
         
             /* translating the bounds of the ranges to real node numbers */
 
             i=-1;
             j=0;
             nepar=-1;
 
             do{
             if(j==num_cpuse) break;
             do{
                 if(neapar[j]==nepar){
                 neapar[j]=i;
                 break;
                 }else{
                 do{
                     i++;
                     if(neinset[i]==1){
                     nepar++;
                     break;
                     }
                 }while(1);
                 }
             }while(1);
 
             do{
                 if(nebpar[j]==nepar){
                 nebpar[j]=i;
                 j++;
                 break;
                 }else{
                 do{
                     i++;
                     if(neinset[i]==1){
                     nepar++;
                     break;
                     }
                 }while(1);
                 }
             }while(1);
             }while(1);
 
             /* FORTRAN convention */
 
         nestart=neapar[0]+1;
         neend=nebpar[num_cpuse-1]+1;
 
         SFREE(neinset);
         
         /* OBJECTIVE: STRESS */
 
             /* calculating the stress in the unperturbed state */
   
         NNEW(v,double,mt**nk);
         NNEW(fn,double,mt**nk);
         NNEW(stn,double,6**nk);
         NNEW(inum,ITG,*nk);
         NNEW(stx,double,6*mi[0]**ne);
         NNEW(eei,double,6*mi[0]**ne);
         
         memcpy(&v[0],&vold[0],sizeof(double)*mt**nk);
         *iout=2;
         *icmd=3;
         
         resultsstr(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,filabl,eme,emn,een,iperturb,
             f,fn,nactdof,iout,qa,vold,b,nodeboun,
             ndirboun,xboun,nboun,ipompc,
             nodempc,coefmpc,labmpc,nmpc,nmethod,cam,&neq[1],veold,accold,
             bet,gam,dtime,time,ttime,plicon,nplicon,plkcon,nplkcon,
             xstateini,xstiff,xstate,npmat_,epn,matname,mi,ielas,icmd,
             ncmat_,nstate_,stiini,vini,ikboun,ilboun,ener,enern,emeini,
             xstaten,eei,enerini,cocon,ncocon,set,nset,istartset,iendset,
             ialset,nprint,prlab,prset,qfx,qfn,trab,inotr,ntrans,fmpc,
             nelemload,nload,ikmpc,ilmpc,istep,iinc,springarea,
             reltime,ne0,xforc,nforc,thicke,shcon,nshcon,
             sideload,xload,xloadold,icfd,inomat,pslavsurf,pmastsurf,
             mortar,islavact,cdn,islavnode,nslavnode,ntie,clearini,
             islavsurf,ielprop,prop,energyini,energy,&kscale,
             &nener,orname,&network,neapar,nebpar);
         
         *icmd=0;
         
         SFREE(v);SFREE(fn);SFREE(stx);SFREE(eei);
         
 
             /* if the design variables are the coordinates:
                check for the existence of a target node set */
 
             /* calculating the objective function */
 
         if(*icoordinate==1){
         nodeset=0;
         for(i=0;i<*nset;i++){
             if(strcmp1(&objectset[m*324+162]," ")==0) continue;
             if(strcmp2(&objectset[m*324+162],&set[i*81],81)==0){
             nodeset=i+1;
             break;
             }
         }
         FORTRAN(objective_stress,(&nodeset,istartset,iendset,
             ialset,nk,&idesvar,&iobject,mi,g0,
             nobject,stn,objectset));
         }
 
         if(*icoordinate!=1){
 
         /* orientation as design variables */
           
           NNEW(b,double,neq[1]);
           NNEW(vnew,double,mt**nk);
           
           for(idesvar=0;idesvar<*ndesi;idesvar++){
         
                 /* copying the RHS from field df */
         
         DMEMSET(b,0,neq[1],0.);
         for(j=jqs[idesvar]-1;j<jqs[idesvar+1]-1;j++){
           b[irows[j]-1]=df[j];
         }
         
                 /* solve the system */
         
         if(*isolver==0){
 #ifdef SPOOLES
           spooles_solve(b,&neq[1]);
 #endif
         }
         else if(*isolver==4){
 #ifdef SGI
           sgi_solve(b,token);
 #endif
         }
         else if(*isolver==5){
 #ifdef TAUCS
           tau_solve(b,&neq[1]);
 #endif
         }
         else if(*isolver==7){
 #ifdef PARDISO
           pardiso_solve(b,&neq[1],&symmetryflag);
 #endif
         }
         
                 /* calculating the perturbed displacements */
         
         FORTRAN(resultsnoddir,(nk,vnew,nactdof,b,ipompc,nodempc,
                        coefmpc,nmpc,mi));
         
         for(i=0;i<mt**nk;i++){vnew[i]=vold[i]+(*distmin)*vnew[i];}
         
                 /* calculating the stress in the perturbed state */
         
         NNEW(v,double,mt**nk);
         NNEW(fn,double,mt**nk);
         NNEW(stx,double,6*mi[0]**ne);
         NNEW(eei,double,6*mi[0]**ne);
         NNEW(dstn,double,6**nk);
         
         memcpy(&v[0],&vnew[0],sizeof(double)*mt**nk);
         *iout=2;
         *icmd=3;
         
         /* calculate a delta in the orientation
            in case the material orientation is the design variable */
         
         iorien=idesvar/3;
         
         /* save nominal orientation */
         
         memcpy(&orabsav[0],&orab[7*iorien],sizeof(double)*7);
         
         /* calculate the transformation matrix */
         
         FORTRAN(transformatrix,(&orab[7*iorien],pgauss,a));
         
         /* calculate the rotation vector from the transformation matrix */
         
         FORTRAN(rotationvector,(a,rotvec));
         idir=idesvar-iorien*3;
         
         /* add a small variation to the rotation vector component */
         
         rotvec[idir]+=*distmin;
         
         /* determine the new transformation matrix */
         
         FORTRAN(rotationvectorinv,(a,rotvec));
         
         /* determine two new points in the x-y plane */
         
         for(i=0;i<6;i++){orab[7*iorien+i]=a[i];}
         
         resultsstr(co,nk,kon,ipkon,lakon,ne,v,dstn,inum,stx,
                elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat,
                ielorien,norien,orab,ntmat_,t0,t1,ithermal,
                prestr,iprestr,filabl,eme,emn,een,iperturb,
                f,fn,nactdof,iout,qa,vold,b,nodeboun,
                ndirboun,xboun,nboun,ipompc,
                nodempc,coefmpc,labmpc,nmpc,nmethod,cam,&neq[1],veold,accold,
                bet,gam,dtime,time,ttime,plicon,nplicon,plkcon,nplkcon,
                xstateini,xstiff,xstate,npmat_,epn,matname,mi,ielas,icmd,
                ncmat_,nstate_,stiini,vini,ikboun,ilboun,ener,enern,emeini,
                xstaten,eei,enerini,cocon,ncocon,set,nset,istartset,iendset,
                ialset,nprint,prlab,prset,qfx,qfn,trab,inotr,ntrans,fmpc,
                nelemload,nload,ikmpc,ilmpc,istep,iinc,springarea,
                reltime,ne0,xforc,nforc,thicke,shcon,nshcon,
                sideload,xload,xloadold,icfd,inomat,pslavsurf,pmastsurf,
                mortar,islavact,cdn,islavnode,nslavnode,ntie,clearini,
                islavsurf,ielprop,prop,energyini,energy,&kscale,
                &nener,orname,&network,neapar,nebpar);
         
         *icmd=0;
         
         SFREE(v);SFREE(fn);SFREE(stx);SFREE(eei);
         
                 /* calculate the stress sensitivity */
         
         for(i=0;i<6**nk;i++){dstn[i]=(dstn[i]-stn[i])/(*distmin);}
         
         /* restoring the nominal orientation  */
         
 //      if(idesvar>0){
           memcpy(&orab[7*iorien],&orabsav[0],sizeof(double)*7);
 //      }
         
         /* storing the results to file */
         
         ++*kode;
         frd_sen(co,nk,dstn,inum,nmethod,kode,filab,
             &ptime,nstate_,
             istep,iinc,&mode,&noddiam,description,mi,&ngraph,
             ne,cs,set,nset,istartset,iendset,ialset,
             jobnamec,output,temp,&iobject,objectset,ntrans,
             inotr,trab,&idesvar,orname,icoordinate,&inorm,
             &irand); 
         
         SFREE(dstn);
         
           }
           
           SFREE(vnew);SFREE(b);
           
         }else{
           
           /* coordinates as design variables */
           
           lmax=*ndesi/num_cpus;
 
               /* deviding the design variables in sets of
                  num_cpus variables */
 
           for(l=0;l<lmax+1;l++){
         if(l<lmax){
           num_cpusd=num_cpus;
         }else{
           num_cpusd=*ndesi-lmax*num_cpus;
           if(num_cpusd==0){break;}
         }
           
         /* solving the system of equations for
                    num_cpusd design variables */
           
         NNEW(b,double,num_cpusd*neq[1]);
         
         for(k=0;k<num_cpusd;k++){
 
           /* design variable at stake */
 
           idesvar=l*num_cpus+k;
           
           /* copying the RHS from field df */
           
           for(j=jqs[idesvar]-1;j<jqs[idesvar+1]-1;j++){
             b[k*neq[1]+irows[j]-1]=df[j];
           }
           
           /* solve the system */
           
           if(*isolver==0){
 #ifdef SPOOLES
             spooles_solve(&b[k*neq[1]],&neq[1]);
 #endif
           }
           else if(*isolver==4){
 #ifdef SGI
             sgi_solve(&b[k*neq[1]],token);
 #endif
           }
           else if(*isolver==5){
 #ifdef TAUCS
             tau_solve(&b[k*neq[1]],&neq[1]);
 #endif
           }
           else if(*isolver==7){
 #ifdef PARDISO
             pardiso_solve(&b[k*neq[1]],&neq[1],&symmetryflag);
 #endif
           }
         }
 
                 /* last design variable treated (FORTRAN-notation) */
 
         idesvar=l*num_cpus;
 
         printf(" Using up to %" ITGFORMAT " cpu(s) for the stress sensitivity.\n\n", num_cpusd);
   
         co1=co;nk1=nk;kon1=kon;ipkon1=ipkon;lakon1=lakon;ne1=ne;stn1=stn;
         elcon1=elcon;nelcon1=nelcon;rhcon1=rhcon;nrhcon1=nrhcon;alcon1=alcon;
         nalcon1=nalcon;alzero1=alzero;ielmat1=ielmat;ielorien1=ielorien;norien1=norien;
         orab1=orab;ntmat1_=ntmat_;t01=t0;t11=t1;ithermal1=ithermal;prestr1=prestr;
         iprestr1=iprestr;filabl1=filabl;emn1=emn;een1=een;iperturb1=iperturb;
         f1=f;nactdof1=nactdof;vold1=vold;nodeboun1=nodeboun;
         ndirboun1=ndirboun;xboun1=xboun;nboun1=nboun;ipompc1=ipompc;nodempc1=nodempc;
         coefmpc1=coefmpc;labmpc1=labmpc;nmpc1=nmpc;nmethod1=nmethod;cam1=cam;neq1=neq;
         veold1=veold;accold1=accold;bet1=bet;gam1=gam;dtime1=dtime;time1=time;ttime1=ttime;
         plicon1=plicon;nplicon1=nplicon;plkcon1=plkcon;nplkcon1=nplkcon;xstateini1=xstateini;
         xstate1=xstate;npmat1_=npmat_;epn1=epn;matname1=matname;mi1=mi;
         ielas1=ielas;ncmat1_=ncmat_;nstate1_=nstate_;stiini1=stiini;vini1=vini;
         ikboun1=ikboun;ilboun1=ilboun;enern1=enern;emeini1=emeini;xstaten1=xstaten;
         enerini1=enerini;cocon1=cocon;ncocon1=ncocon;set1=set;nset1=nset;
         istartset1=istartset;iendset1=iendset;ialset1=ialset;nprint1=nprint;prlab1=prlab;
         prset1=prset;qfx1=qfx;qfn1=qfn;trab1=trab;inotr1=inotr;ntrans1=ntrans;fmpc1=fmpc;
         nelemload1=nelemload;nload1=nload;ikmpc1=ikmpc;ilmpc1=ilmpc;istep1=istep;iinc1=iinc;
         springarea1=springarea;reltime1=reltime;ne01=ne0;xforc1=xforc;nforc1=nforc;
         thicke1=thicke;shcon1=shcon;nshcon1=nshcon;sideload1=sideload;xload1=xload;
         xloadold1=xloadold;icfd1=icfd;inomat1=inomat;pslavsurf1=pslavsurf;pmastsurf1=pmastsurf;
         mortar1=mortar;islavact1=islavact;cdn1=cdn;islavnode1=islavnode;nslavnode1=nslavnode;
         ntie1=ntie;clearini1=clearini;islavsurf1=islavsurf;ielprop1=ielprop;prop1=prop;
         energyini1=energyini;energy1=energy;kscale1=kscale;orname1=orname;
         network1=network;nestart1=nestart;neend1=neend;jqs1=jqs;irows1=irows;
         nodedesi1=nodedesi;xdesi1=xdesi;ndesi1=ndesi;iobject1=iobject;nobject1=nobject;
         objectset1=objectset;g01=g0;dgdx1=dgdx;nasym1=nasym;isolver1=isolver;distmin1=distmin;
         nodeset1=nodeset;b1=b;idesvar1=idesvar;
         
         NNEW(ithread,ITG,num_cpusd);
         
         /* Total difference of the mass */
         /* create threads and wait */
         
         for(i=0;i<num_cpusd;i++)  {
           ithread[i]=i;
           pthread_create(&tid[i], NULL, (void *)stress_senmt, (void *)&ithread[i]);
         }
         
         for(i=0;i<num_cpusd;i++)  pthread_join(tid[i], NULL);
         
         SFREE(ithread);SFREE(b);
 
           }
           
         }
 
             /* reactivating all elements */
 
         for(i=0;i<*ne;i++){
         if(ipkon[i]<-1) ipkon[i]=-2-ipkon[i];
         }
 
         SFREE(inum);SFREE(stn);SFREE(filabl);
         SFREE(neapar);SFREE(nebpar);
         
         }else if(strcmp1(&objectset[m*324],"THICKNESS")==0){
         iobject=m+1;
 
             thicknessmain(co,dgdx,nobject,nk,nodedesi,ndesi,objectset,
                       ipkon,kon,lakon,set,nset,istartset,iendset,ialset,
               &iobject,nodedesiinv,dgdxglob); 
         }
     }
     
     if(*idisplacement==1){
 
     /* clean the system */
 
     if(*isolver==0){
 #ifdef SPOOLES
         spooles_cleanup();
 #endif
     }
     else if(*isolver==4){
 #ifdef SGI
         sgi_cleanup(token);
 #endif
     }
     else if(*isolver==5){
 #ifdef TAUCS
         tau_cleanup();
 #endif
     }
     else if(*isolver==7){
 #ifdef PARDISO
         pardiso_cleanup(&neq[1],&symmetryflag);
 #endif
     }
     }
     
     return;
     
 }

◆ objectivemt_mass_dx()

void* objectivemt_mass_dx ( ITG * i )

                                  {
 
     ITG nea,neb,nedelta,indexg0,indexdgdx;
     
     indexg0=*i**nobject1;
     indexdgdx=*i**nobject1**ndesi1;
 
     nedelta=(ITG)floor(*ne1/(double)num_cpuse);
     nea=*i*nedelta+1;
     neb=(*i+1)*nedelta;
     if((*i==num_cpuse-1)&&(neb<*ne1)) neb=*ne1;
 
     FORTRAN(objective_mass_dx,(co1,kon1,ipkon1,lakon1,nelcon1,rhcon1,          
           ielmat1,ielorien1,norien1,ntmat1_,matname1,mi1,
           thicke1,mortar1,&nea,&neb,ielprop1,prop1,distmin1,ndesi1,nodedesi1,
       nobject1,&g01[indexg0],&dgdx1[indexdgdx],&iobject1,xmass1,
       istartdesi1,ialdesi1,xdesi1,&idesvar1));
           
     return NULL;
 }

◆ objectivemt_shapeener_dx()

void* objectivemt_shapeener_dx ( ITG * i )

                                       {
     
     ITG nea,neb,nedelta,indexg0,indexdgdx;
     
     indexg0=*i**nobject1;
     indexdgdx=*i**nobject1**ndesi1;
 
     nedelta=(ITG)floor(*ne1/(double)num_cpuse);
     nea=*i*nedelta+1;
     neb=(*i+1)*nedelta;
     if((*i==num_cpuse-1)&&(neb<*ne1)) neb=*ne1;
     
     FORTRAN(objective_shapeener_dx,(co1,kon1,ipkon1,lakon1,ne1,
       stx1,elcon1,nelcon1,rhcon1,nrhcon1,alcon1,nalcon1,alzero1,
       ielmat1,ielorien1,norien1,orab1,ntmat1_,t01,t11,ithermal1,prestr1,
       iprestr1,iperturb1,iout1,vold1,
       nmethod1,veold1,dtime1,time1,ttime1,plicon1,nplicon1,plkcon1,
       nplkcon1,xstateini1,xstiff1,xstate1,npmat1_,matname1,mi1,ielas1,
       icmd1,ncmat1_,nstate1_,stiini1,vini1,ener1,enerini1,istep1,iinc1,
           springarea1,reltime1,&calcul_qa1,&nener1,&ikin1,          
           ne01,thicke1,emeini1,pslavsurf1,pmastsurf1,mortar1,clearini1,
           &nea,&neb,ielprop1,prop1,distmin1,ndesi1,nodedesi1,
       nobject1,&g01[indexg0],&dgdx1[indexdgdx],&iobject1,sti1,xener1,
       istartdesi1,ialdesi1,xdesi1,&idesvar1));
 
     return NULL;
 }

◆ precontact()

void precontact	(	ITG *	ncont,
		ITG *	ntie,
		char *	tieset,
		ITG *	nset,
		char *	set,
		ITG *	istartset,
		ITG *	iendset,
		ITG *	ialset,
		ITG *	itietri,
		char *	lakon,
		ITG *	ipkon,
		ITG *	kon,
		ITG *	koncont,
		ITG *	ne,
		double *	cg,
		double *	straight,
		double *	co,
		double *	vold,
		ITG *	istep,
		ITG *	iinc,
		ITG *	iit,
		ITG *	itiefac,
		ITG *	islavsurf,
		ITG *	islavnode,
		ITG *	imastnode,
		ITG *	nslavnode,
		ITG *	nmastnode,
		ITG *	imastop,
		ITG *	mi,
		ITG *	ipe,
		ITG *	ime,
		double *	tietol,
		ITG *	iflagact,
		ITG *	nintpoint,
		double **	pslavsurfp,
		double *	xmastnor,
		double *	cs,
		ITG *	mcs,
		ITG *	ics,
		double *	clearini,
		ITG *	nslavs
	)

                                                    {
 
     /* authors: S. Rakotonanahary, S. Sitzmann and J. Hokkanen */
 
     ITG i,j,ntrimax,*nx=NULL,*ny=NULL,*nz=NULL,im,
         l,nstart,kflag,ntri,ii;
     
     double *xo=NULL,*yo=NULL,*zo=NULL,*x=NULL,*y=NULL,*z=NULL,
         *pslavsurf=NULL,*clearslavnode=NULL;
     
     pslavsurf=*pslavsurfp;
     
     /* update the location of the center of gravity of 
        the master triangles and the coefficients of their
        bounding planes */
     
     DMEMSET(xmastnor,0,3*nmastnode[*ntie],0.);
     
     FORTRAN(updatecontpen,(koncont,ncont,co,vold,
                cg,straight,mi,imastnode,nmastnode,xmastnor,
                ntie,tieset,nset,set,istartset,
                iendset,ialset,ipkon,lakon,kon,cs,mcs,ics));
     
     /* determining the size of the auxiliary fields 
        (needed for the master triangle search for any
        given location on the slave faces */ 
     
     ntrimax=0;  
     for(i=0;i<*ntie;i++){       
     if(itietri[2*i+1]-itietri[2*i]+1>ntrimax)       
         ntrimax=itietri[2*i+1]-itietri[2*i]+1;      
     }
     
     /* only at the start of a new step */
     
     if ((*istep==1)&&(*iinc==1)&&(*iit<=0)){        
     NNEW(xo,double,ntrimax);        
     NNEW(yo,double,ntrimax);        
     NNEW(zo,double,ntrimax);        
     NNEW(x,double,ntrimax);     
     NNEW(y,double,ntrimax);     
     NNEW(z,double,ntrimax);    
     NNEW(nx,ITG,ntrimax);      
     NNEW(ny,ITG,ntrimax);       
     NNEW(nz,ITG,ntrimax);
 
     NNEW(clearslavnode,double,3**nslavs);
         
     FORTRAN(adjustcontactnodes,(tieset,ntie,itietri,cg,straight,
         co,vold,xo,yo,zo,x,y,z,nx,ny,nz,istep,iinc,iit,
         mi,imastop,nslavnode,islavnode,set,nset,istartset,
         iendset,ialset,tietol,clearini,clearslavnode,itiefac,
                 ipkon,kon,lakon,islavsurf));
         
     SFREE(clearslavnode);
     SFREE(xo);SFREE(yo);SFREE(zo);SFREE(x);SFREE(y);SFREE(z);SFREE(nx);     
     SFREE(ny);SFREE(nz);        
     }
     
     NNEW(xo,double,ntrimax);    
     NNEW(yo,double,ntrimax);    
     NNEW(zo,double,ntrimax);    
     NNEW(x,double,ntrimax); 
     NNEW(y,double,ntrimax); 
     NNEW(z,double,ntrimax); 
     NNEW(nx,ITG,ntrimax);   
     NNEW(ny,ITG,ntrimax);   
     NNEW(nz,ITG,ntrimax);
     
     /* Calculating the location of the matched slave/master
        integration points */
     
     RENEW(pslavsurf,double,198);
     
     /* pointer of islavsurf into field pslavsurf and
        pmastsurf */
     
     islavsurf[1]=0; 
     
     /* loop over all ties */
     
     for(i=0;i<*ntie;i++){
     ii=i+1;    
     
     /* only active contact ties are treated */
     
     if(tieset[i*(81*3)+80]=='C'){       
         nstart=itietri[2*i]-1;      
         ntri=itietri[2*i+1]-nstart;     
         for(j=0;j<ntri;j++){            
         xo[j]=cg[(nstart+j)*3];         
         x[j]=xo[j];        
         nx[j]=j+1;          
         yo[j]=cg[(nstart+j)*3+1];           
         y[j]=yo[j];         
         ny[j]=j+1;          
         zo[j]=cg[(nstart+j)*3+2];           
         z[j]=zo[j];         
         nz[j]=j+1;      
         }
         kflag=2;        
         FORTRAN(dsort,(x,nx,&ntri,&kflag));     
         FORTRAN(dsort,(y,ny,&ntri,&kflag));     
         FORTRAN(dsort,(z,nz,&ntri,&kflag)); 
         
         /* loop over all slave faces belonging to the tie */
         
         for(l=itiefac[2*i];l<=itiefac[2*i+1];l++){
         RENEW(pslavsurf,double,3*(*nintpoint+ntri*66));         
         FORTRAN(slavintpoints,(ntie,itietri,ipkon,kon,
             lakon,straight,nintpoint,koncont,co,vold,
                         xo,yo,zo,x,y,z,nx,ny,nz,islavsurf,
                 islavnode,nslavnode,imastop,
                 mi,ncont,ipe,ime,pslavsurf,&ii,&l,&ntri));
         }       
     }   
     }
     SFREE(xo);SFREE(yo);SFREE(zo);SFREE(x);SFREE(y);SFREE(z);SFREE(nx);     
     SFREE(ny);SFREE(nz);
     
     *pslavsurfp=pslavsurf;
     
     return;
 }

◆ prediction()

void prediction	(	double *	uam,
		ITG *	nmethod,
		double *	bet,
		double *	gam,
		double *	dtime,
		ITG *	ithermal,
		ITG *	nk,
		double *	veold,
		double *	accold,
		double *	v,
		ITG *	iinc,
		ITG *	idiscon,
		double *	vold,
		ITG *	nactdof,
		ITG *	mi
	)

                                                                         {
 
     ITG j,k,mt=mi[1]+1;
     double dextrapol,scal1,scal2;
 
     uam[0]=0.;
     uam[1]=0.;
     if(*nmethod==4){
       
     scal1=0.5*(1.-2.**bet)**dtime**dtime;
     scal2=(1.-*gam)**dtime;
     
     if(*ithermal<2){
         for(k=0;k<*nk;++k){
         for(j=0;j<mt;j++){
             dextrapol=*dtime*veold[mt*k+j]+scal1*accold[mt*k+j];
             if((fabs(dextrapol)>uam[0])&&(nactdof[mt*k+j]>0)) {uam[0]=fabs(dextrapol);}
             v[mt*k+j]=vold[mt*k+j]+dextrapol;
             veold[mt*k+j]=veold[mt*k+j]+scal2*accold[mt*k+j];
             accold[mt*k+j]=0.;
         }
         }
     }else if(*ithermal==2){
         for(k=0;k<*nk;++k){
         for(j=0;j<mt;j++){
             v[mt*k+j]=vold[mt*k+j];
         }
         }
         for(k=0;k<*nk;++k){
         dextrapol=*dtime*veold[mt*k];
         if(fabs(dextrapol)>100.) dextrapol=100.*dextrapol/fabs(dextrapol);
         if((fabs(dextrapol)>uam[1])&&(nactdof[mt*k]>0)) {uam[1]=fabs(dextrapol);}
         v[mt*k]+=dextrapol;
         }
     }else{
         for(k=0;k<*nk;++k){
         for(j=0;j<mt;++j){
             dextrapol=*dtime*veold[mt*k+j]+scal1*accold[mt*k+j];
             if((j==0)&&fabs(dextrapol)>100.) dextrapol=100.*dextrapol/fabs(dextrapol);
             if(j==0){
             if((fabs(dextrapol)>uam[1])&&(nactdof[mt*k]>0)) {uam[1]=fabs(dextrapol);}
             }else{
             if((fabs(dextrapol)>uam[0])&&(nactdof[mt*k+j]>0)) {uam[0]=fabs(dextrapol);}
             }
             v[mt*k+j]=vold[mt*k+j]+dextrapol;
             veold[mt*k+j]=veold[mt*k+j]+scal2*accold[mt*k+j];
             accold[mt*k+j]=0.;
         }
         }
     }
     }
     
     /* for the static case: extrapolation of the previous increment
        (if any within the same step) */
     
     else{
     if(*iinc>1){
         if(*ithermal<2){
         for(k=0;k<*nk;++k){
             for(j=0;j<mt;++j){
             if(*idiscon==0){
                 dextrapol=*dtime*veold[mt*k+j];
                 if((fabs(dextrapol)>uam[0])&&(nactdof[mt*k+j]>0)) {uam[0]=fabs(dextrapol);} 
                 v[mt*k+j]=vold[mt*k+j]+dextrapol;
             }else{
                 v[mt*k+j]=vold[mt*k+j];
             }
             }
         }
         }else if(*ithermal==2){
         for(k=0;k<*nk;++k){
             for(j=0;j<mt;++j){
             v[mt*k+j]=vold[mt*k+j];
             }
         }
         for(k=0;k<*nk;++k){
             if(*idiscon==0){
             dextrapol=*dtime*veold[mt*k];
             if(fabs(dextrapol)>100.) dextrapol=100.*dextrapol/fabs(dextrapol);
             if((fabs(dextrapol)>uam[1])&&(nactdof[mt*k]>0)) {uam[1]=fabs(dextrapol);}   
             v[mt*k]+=dextrapol;
             }
         }
         }else{
         for(k=0;k<*nk;++k){
             for(j=0;j<mt;++j){
             if(*idiscon==0){
                 dextrapol=*dtime*veold[mt*k+j];
                 if((j==0)&&fabs(dextrapol)>100.) dextrapol=100.*dextrapol/fabs(dextrapol);
                 if(j==0){
                 if((fabs(dextrapol)>uam[1])&&(nactdof[mt*k+j]>0)) {uam[1]=fabs(dextrapol);}
                 }else{
                 if((fabs(dextrapol)>uam[0])&&(nactdof[mt*k+j]>0)) {uam[0]=fabs(dextrapol);}
                 }   
                 v[mt*k+j]=vold[mt*k+j]+dextrapol;
             }else{
                 v[mt*k+j]=vold[mt*k+j];
             }
             }
         }
         }
     }
     else{
         for(k=0;k<*nk;++k){
         for(j=0;j<mt;++j){
             v[mt*k+j]=vold[mt*k+j];
         }
         }
     }
     }
     *idiscon=0;
 
   return;
 }

◆ prediction_em()

void prediction_em	(	double *	uam,
		ITG *	nmethod,
		double *	bet,
		double *	gam,
		double *	dtime,
		ITG *	ithermal,
		ITG *	nk,
		double *	veold,
		double *	v,
		ITG *	iinc,
		ITG *	idiscon,
		double *	vold,
		ITG *	nactdof,
		ITG *	mi
	)

                                                                         {
 
     ITG j,k,mt=mi[1]+1,jstart;
     double dextrapol;
 
     uam[0]=0.;
     uam[1]=0.;
 
     if(*ithermal<2){
     jstart=1;
     }else{
     jstart=0;
     }
 
     if(*nmethod==4){
     for(k=0;k<*nk;++k){
         for(j=jstart;j<mt;j++){
         dextrapol=*dtime*veold[mt*k+j];
         if(fabs(dextrapol)>100.) dextrapol=100.*dextrapol/fabs(dextrapol);
         if(j==0){
             if((fabs(dextrapol)>uam[1])&&(nactdof[mt*k]>0)) {uam[1]=fabs(dextrapol);}
         }
         v[mt*k+j]=vold[mt*k+j]+dextrapol;
         }
     }
     }
     
     /* for the static case: extrapolation of the previous increment
        (if any within the same step) */
     
     else{
     if(*iinc>1){
         for(k=0;k<*nk;++k){
         for(j=jstart;j<mt;j++){
             if(*idiscon==0){
             dextrapol=*dtime*veold[mt*k+j];
             if(fabs(dextrapol)>100.) dextrapol=100.*dextrapol/fabs(dextrapol);
             if(j==0){
                 if((fabs(dextrapol)>uam[1])&&(nactdof[mt*k]>0)) {uam[1]=fabs(dextrapol);}
             }
             v[mt*k+j]=vold[mt*k+j]+dextrapol;
             }else{
             v[mt*k+j]=vold[mt*k+j];
             }
         }
         }
     }
     else{
         for(k=0;k<*nk;++k){
         for(j=jstart;j<mt;j++){
             v[mt*k+j]=vold[mt*k+j];
         }
         }
     }
     }
     *idiscon=0;
     
     return;
 }

◆ preiter()

void preiter	(	double *	ad,
		double **	aup,
		double *	b,
		ITG **	icolp,
		ITG **	irowp,
		ITG *	neq,
		ITG *	nzs,
		ITG *	isolver,
		ITG *	iperturb
	)

                                                          {
   
   ITG precFlg,niter=5000000,ndim,i,j,k,ier,*icol=NULL,*irow=NULL,
     *irow_save=NULL,*icol_save=NULL;
   double eps=1.e-4,*u=NULL,*au=NULL;
 
   if(*neq==0) return;
 
   /* icol(i) = # subdiagonal nonzeros in column i (i=1,neq)
      irow(i) = row number of entry i in au (i=1,nzs)
      ad(i) = diagonal term in column i of the matrix
      au(i) = subdiagonal nonzero term i; the terms are entered
              column per column */
 
   au=*aup;
   irow=*irowp;
   icol=*icolp;
 
   if(*iperturb>1){
     NNEW(irow_save,ITG,*nzs);
     NNEW(icol_save,ITG,*neq);
     for(i=0;i<*nzs;++i){
       irow_save[i]=irow[i];
     }
     for(i=0;i<*neq;++i){
       icol_save[i]=icol[i];
     }
   }
 
   if(*isolver==2) {precFlg=0;}
   else {precFlg=3;}
 
   ndim=*neq+*nzs;
 
   RENEW(au,double,ndim);
   RENEW(irow,ITG,ndim);
   RENEW(icol,ITG,ndim);
 
   k=*nzs;
   for(i=*neq-1;i>=0;--i){
     for(j=0;j<icol[i];++j){
       icol[--k]=i+1;
     }
   }
 
   k=*nzs;
   j=0;
   for(i=0;i<*neq;++i){
     au[k]=ad[i];
     irow[k]=++j;
     icol[k]=j;
     ++k;
   }
 
   /* rearranging the storage of the left hand side */
 
   FORTRAN(rearrange,(au,irow,icol,&ndim,neq));
 
   RENEW(irow,ITG,*neq);
 
   NNEW(u,double,*neq);
 
   ier=cgsolver(au,u,b,*neq,ndim,icol,irow,&eps,&niter,precFlg);
 
   printf("error condition (0=good, 1=bad) = %" ITGFORMAT "\n",ier);
   printf("# of iterations = %" ITGFORMAT "\n",niter);
 
   for(i=0;i<*neq;++i){
     b[i]=u[i];
   }
 
   SFREE(u);
 
   if(*iperturb>1){
     RENEW(irow,ITG,*nzs);
     RENEW(icol,ITG,*neq);
     for(i=0;i<*nzs;++i){
       irow[i]=irow_save[i];
     }
     for(i=0;i<*neq;++i){
       icol[i]=icol_save[i];
     }
     SFREE(irow_save);SFREE(icol_save);
   }
 
   *aup=au;
   *irowp=irow;
   *icolp=icol;
 
   return;
 }

◆ projectgradmain()

void projectgradmain	(	ITG *	nobject,
		char *	objectset,
		double *	dgdxglob,
		double *	g0,
		ITG *	ndesi,
		ITG *	nodedesi,
		ITG *	nk,
		ITG *	isolver,
		ITG *	nactive,
		ITG *	nnlconst,
		ITG *	ipoacti
	)

◆ pthread_create()

int pthread_create	(	pthread_t *	thread_id,
		const pthread_attr_t *	attributes,
		void ()(void *)	thread_function,
		void *	arguments
	)

◆ pthread_join()

int pthread_join	(	pthread_t	thread,
		void **	status_ptr
	)

◆ radcyc()

void radcyc	(	ITG *	nk,
		ITG *	kon,
		ITG *	ipkon,
		char *	lakon,
		ITG *	ne,
		double *	cs,
		ITG *	mcs,
		ITG *	nkon,
		ITG *	ialset,
		ITG *	istartset,
		ITG *	iendset,
		ITG **	kontrip,
		ITG *	ntri,
		double **	cop,
		double **	voldp,
		ITG *	ntrit,
		ITG *	inocs,
		ITG *	mi
	)

                     {
 
   /* duplicates triangular faces for cyclic radiation conditions */
 
   char *filab=NULL;
 
   ITG i,is,nsegments,idtie,nkt,icntrl,imag=0,*kontri=NULL,mt=mi[1]+1,
      node,i1,i2,nope,iel,indexe,j,k,ielset,node1,node2,node3,l,jj;
 
   double *vt=NULL,*fnt=NULL,*stnt=NULL,*eent=NULL,*qfnt=NULL,t[3],theta,
      pi,*v=NULL,*fn=NULL,*stn=NULL,*een=NULL,*qfn=NULL,*co=NULL,
      *vold=NULL,*emnt=NULL,*emn=NULL;
 
   pi=4.*atan(1.);
   
   kontri=*kontrip;co=*cop;vold=*voldp;
 
   /* determining the maximum number of sectors */
 
   nsegments=1;
   for(j=0;j<*mcs;j++){
       if(cs[17*j]>nsegments) nsegments=(ITG)(cs[17*j]);
   }
 
   /* assigning nodes and elements to sectors */
 
   ielset=cs[12];
   if((*mcs!=1)||(ielset!=0)){
     for(i=0;i<*nk;i++) inocs[i]=-1;
   }
 
   for(i=0;i<*mcs;i++){
     is=cs[17*i+4];
     if(is==1) continue;
     ielset=cs[17*i+12];
     if(ielset==0) continue;
     for(i1=istartset[ielset-1]-1;i1<iendset[ielset-1];i1++){
       if(ialset[i1]>0){
         iel=ialset[i1]-1;
         if(ipkon[iel]<0) continue;
         indexe=ipkon[iel];
         if(strcmp1(&lakon[8*iel+3],"2")==0)nope=20;
         else if (strcmp1(&lakon[8*iel+3],"8")==0)nope=8;
         else if (strcmp1(&lakon[8*iel+3],"10")==0)nope=10;
         else if (strcmp1(&lakon[8*iel+3],"4")==0)nope=4;
         else if (strcmp1(&lakon[8*iel+3],"15")==0)nope=15;
         else {nope=6;}
         for(i2=0;i2<nope;++i2){
           node=kon[indexe+i2]-1;
           inocs[node]=i;
         }
       }
       else{
         iel=ialset[i1-2]-1;
         do{
           iel=iel-ialset[i1];
           if(iel>=ialset[i1-1]-1) break;
           if(ipkon[iel]<0) continue;
           indexe=ipkon[iel];
           if(strcmp1(&lakon[8*iel+3],"2")==0)nope=20;
           else if (strcmp1(&lakon[8*iel+3],"8")==0)nope=8;
           else if (strcmp1(&lakon[8*iel+3],"10")==0)nope=10;
           else if (strcmp1(&lakon[8*iel+3],"4")==0)nope=4;
           else if (strcmp1(&lakon[8*iel+3],"15")==0)nope=15;
           else {nope=6;}
           for(i2=0;i2<nope;++i2){
             node=kon[indexe+i2]-1;
             inocs[node]=i;
           }
         }while(1);
       }
     } 
   }
 
   /* duplicating triangular faces 
      only those faces are duplicated the nodes of which belong to
      the same cyclic symmetry. non-integer cyclic symmety numbers are
      reduced to the next lower integer. */
 
   *ntrit=nsegments**ntri;
   RENEW(kontri,ITG,4**ntrit);
   for(i=4**ntri;i<4**ntrit;i++) kontri[i]=0;
 
   for(i=0;i<*ntri;i++){
     node1=kontri[4*i];
     if(inocs[node1-1]<0) continue;
     idtie=inocs[node1-1];
     node2=kontri[4*i+1];
     if((inocs[node2-1]<0)||(inocs[node2-1]!=idtie)) continue;
     node3=kontri[4*i+2];
     if((inocs[node3-1]<0)||(inocs[node3-1]!=idtie)) continue;
     idtie=cs[17*idtie];
     for(k=1;k<idtie;k++){
       j=i+k**ntri;
       kontri[4*j]=node1+k**nk;
       kontri[4*j+1]=node2+k**nk;
       kontri[4*j+2]=node3+k**nk;
       kontri[4*j+3]=kontri[4*i+3];
     }
   }
 
   RENEW(co,double,3**nk*nsegments);
   RENEW(vold,double,mt**nk*nsegments);
   nkt=*nk*nsegments;
       
   /* generating the coordinates for the other sectors */
   
   icntrl=1;
   
   FORTRAN(rectcyl,(co,v,fn,stn,qfn,een,cs,nk,&icntrl,t,filab,&imag,mi,emn));
   
   for(jj=0;jj<*mcs;jj++){
     is=(ITG)(cs[17*jj]);
     for(i=1;i<is;i++){
       
       theta=i*2.*pi/cs[17*jj];
       
       for(l=0;l<*nk;l++){
         if(inocs[l]==jj){
       co[3*l+i*3**nk]=co[3*l];
       co[1+3*l+i*3**nk]=co[1+3*l]-theta;
       co[2+3*l+i*3**nk]=co[2+3*l];
         }
       }
     }
   }
 
   icntrl=-1;
     
   FORTRAN(rectcyl,(co,vt,fnt,stnt,qfnt,eent,cs,&nkt,&icntrl,t,filab,
            &imag,mi,emnt));
 
   *kontrip=kontri;*cop=co;*voldp=vold;
 
   return;
 }

◆ radflowload()

void radflowload	(	ITG *	itg,
		ITG *	ieg,
		ITG *	ntg,
		ITG *	ntr,
		double *	adrad,
		double *	aurad,
		double *	bcr,
		ITG *	ipivr,
		double *	ac,
		double *	bc,
		ITG *	nload,
		char *	sideload,
		ITG *	nelemload,
		double *	xloadact,
		char *	lakon,
		ITG *	ipiv,
		ITG *	ntmat_,
		double *	vold,
		double *	shcon,
		ITG *	nshcon,
		ITG *	ipkon,
		ITG *	kon,
		double *	co,
		ITG *	kontri,
		ITG *	ntri,
		ITG *	nloadtr,
		double *	tarea,
		double *	tenv,
		double *	physcon,
		double *	erad,
		double **	adviewp,
		double **	auviewp,
		ITG *	nflow,
		ITG *	ikboun,
		double *	xboun,
		ITG *	nboun,
		ITG *	ithermal,
		ITG *	iinc,
		ITG *	iit,
		double *	cs,
		ITG *	mcs,
		ITG *	inocs,
		ITG *	ntrit,
		ITG *	nk,
		double *	fenv,
		ITG *	istep,
		double *	dtime,
		double *	ttime,
		double *	time,
		ITG *	ilboun,
		ITG *	ikforc,
		ITG *	ilforc,
		double *	xforc,
		ITG *	nforc,
		double *	cam,
		ITG *	ielmat,
		ITG *	nteq,
		double *	prop,
		ITG *	ielprop,
		ITG *	nactdog,
		ITG *	nacteq,
		ITG *	nodeboun,
		ITG *	ndirboun,
		ITG *	network,
		double *	rhcon,
		ITG *	nrhcon,
		ITG *	ipobody,
		ITG *	ibody,
		double *	xbody,
		ITG *	nbody,
		ITG *	iviewfile,
		char *	jobnamef,
		double *	ctrl,
		double *	xloadold,
		double *	reltime,
		ITG *	nmethod,
		char *	set,
		ITG *	mi,
		ITG *	istartset,
		ITG *	iendset,
		ITG *	ialset,
		ITG *	nset,
		ITG *	ineighe,
		ITG *	nmpc,
		ITG *	nodempc,
		ITG *	ipompc,
		double *	coefmpc,
		char *	labmpc,
		ITG *	iemchange,
		ITG *	nam,
		ITG *	iamload,
		ITG *	jqrad,
		ITG *	irowrad,
		ITG *	nzsrad,
		ITG *	icolrad,
		ITG *	ne,
		ITG *	iaxial,
		double *	qa,
		double *	cocon,
		ITG *	ncocon,
		ITG *	iponoel,
		ITG *	inoel,
		ITG *	nprop,
		char *	amname,
		ITG *	namta,
		double *	amta
	)

                                                                  {
   
   /* network=0: no network
      network=1: purely thermal (presence of "Dx"- and/or of "D " network elements; declared
                 by the user to be purely thermal (on the *STEP card); simultaneous solution)
      network=2: purely thermal (alternating solution; this becomes a simultaneous solution in
                 the absence of "Dx"-elements)
      network=3: general case (temperatures, fluxes and pressures unknown)
      network=4: purely aerodynamic, i.e. only fluxes and pressures unknown
 
      "D "-elements (D followed by a blank) alone do not trigger the alternating solution 
      (are not counted in envtemp.f as true network elements) */
 
   ITG nhrs=1,info=0,i,j,iin=0,icntrl,icutb=0,iin_abs=0,mt=mi[1]+1,im,
       symmetryflag=2,inputformat=1,node,channel,*ithread=NULL,iplausi;
 
   static ITG ifactorization=0;
 
   double camt[2],camf[2],camp[2],qat,qaf,ramt,ramf,ramp,
     cam1t=0.,cam1f=0.,cam1p=0.,sidemean,qa0,qau,ea,*prop_store=NULL,
     cam2t=0.,cam2f=0.,cam2p=0.,dtheta=1.,*v=NULL,cama[2],cam1a=0.,
     cam2a=0.,vamt=0.,vamf=0.,vamp=0.,vama=0.,cam0t=0.,cam0f=0.,
     cam0p=0.,cam0a=0.,sigma=0.,*adbrad=NULL,*aubrad=NULL,*q=NULL,
     *area=NULL,*pmid=NULL,*e1=NULL,*e2=NULL,*e3=NULL,
     qamt,qamf,qamtold,qamfold;
   
   adview=*adviewp;auview=*auviewp;
 
   qa0=ctrl[20];qau=ctrl[21];ea=ctrl[23];
 
   /* check whether there are any gas temperature nodes; this check should
      NOT be done on nteq, since also for zero equations the temperature
      of the gas nodes with boundary conditions must be stored in v
      (in initialgas) */ 
 
   NNEW(v,double,mt**nk);
 
   /* gas networks */
 
   if(*ntg!=0) {
 #ifdef COMPANY
       NNEW(prop_store,double,*nprop);
       memcpy(&prop_store[0],&prop[0],sizeof(double)**nprop);
       FORTRAN(propertynet,(ieg,nflow,prop,ielprop,lakon,&iin,
                prop_store,ttime,time,nam,amname,namta,amta));
       FORTRAN(checkinputvaluesnet,(ieg,nflow,prop,ielprop,lakon));
 #else
       if(*iit==-1) FORTRAN(checkinputvaluesnet,(ieg,nflow,prop,ielprop,lakon));
 #endif    
       icntrl=0;
       while(icntrl==0) {
       
       if(iin==0){
          
           memcpy(&v[0],&vold[0],sizeof(double)*mt**nk);
 
               /* resetting ineighe to 0 for renewed call of
                  radflowload (not for cut-backs without
                  leaving radflowload */
 
               /* for a cut-back iin is reset to 0, iin_abs is not */
 
           if(iin_abs==0) DMEMSET(ineighe,0,*ntg,0);
 
 //        for(i=0;i<mt**nk;i++) v[i]=vold[i];
 
               /* initialization pressurized flow 
                  (no free surface: gas networks or
                   water networks with fully wetted perimeter*/
 
           FORTRAN(initialnet,(itg,ieg,ntg,ac,bc,lakon,v,
                            ipkon,kon,nflow,
                ikboun,nboun,prop,ielprop,nactdog,ndirboun,
                nodeboun,xbounact,ielmat,ntmat_,shcon,nshcon,
                physcon,ipiv,nteq,rhcon,nrhcon,ipobody,ibody,
                xbodyact,co,nbody,network,&iin_abs,vold,set,
                istep,iit,mi,ineighe,ilboun,&channel,iaxial,
                nmpc,labmpc,ipompc,nodempc,coefmpc,ttime,time,
                iponoel,inoel));
       
               /* initialization for channels with free surface */
 
           if(channel==1){
           FORTRAN(initialchannel,(itg,ieg,ntg,ac,bc,lakon,v,
                            ipkon,kon,nflow,
                ikboun,nboun,prop,ielprop,nactdog,ndirboun,
                nodeboun,xbounact,ielmat,ntmat_,shcon,nshcon,
                physcon,ipiv,nteq,rhcon,nrhcon,ipobody,ibody,
                xbodyact,co,nbody,network,&iin_abs,vold,set,
                istep,iit,mi,ineighe,ilboun,ttime,time,iaxial));
           }
 
               /* storing the residual in the rhs vector */
 
           FORTRAN(resultnet,(itg,ieg,ntg,bc,nload,sideload,
               nelemload,xloadact,
               lakon,ntmat_,v,shcon,nshcon,ipkon,kon,co,nflow,
               iinc,istep,dtime,ttime,time,
               ikforc,ilforc,xforcact,
                           nforc,ielmat,nteq,prop,ielprop,nactdog,nacteq,&iin,
               physcon,camt,camf,camp,rhcon,nrhcon,ipobody,
               ibody,xbodyact,nbody,&dtheta,vold,xloadold,
               reltime,nmethod,set,mi,ineighe,cama,&vamt,
               &vamf,&vamp,&vama,nmpc,nodempc,ipompc,coefmpc,
               labmpc,iaxial,&qat,&qaf,&ramt,&ramf,&ramp,
               cocon,ncocon,iponoel,inoel,&iplausi));
 
               /* iniializing qamt and qamf (mean typical energy flow
                  and mass flow */
 
           if(qau>1.e-10){qamt=qau;}
           else if(qa0>1.e-10){qamt=qa0;}
           else if(qat>1.e-10){qamt=qat;}
           else {qamt=1.e-2;}
 
           if(qau>1.e-10){qamf=qau;}
           else if(qa0>1.e-10){qamf=qa0;}
           else if(qaf>1.e-10){qamf=qaf;}
           else {qamf=1.e-2;}
       }
       
       iin++;
       iin_abs++;
       printf("      gas iteration %" ITGFORMAT " \n \n",iin);
       
           /* store actual values of typical energy flow and 
              mass flow */
 
       qamtold=qamt;
       qamfold=qamf;
 
           /* filling the lhs matrix */
          
       FORTRAN(mafillnet,(itg,ieg,ntg,ac,nload,sideload,
                  nelemload,xloadact,lakon,ntmat_,v,
                  shcon,nshcon,ipkon,kon,co,nflow,iinc,
                  istep,dtime,ttime,time,
                  ielmat,nteq,prop,ielprop,nactdog,nacteq,
                  physcon,rhcon,nrhcon,ipobody,ibody,xbodyact,
                  nbody,vold,xloadold,reltime,nmethod,set,mi,
                              nmpc,nodempc,ipompc,coefmpc,labmpc,iaxial,
                              cocon,ncocon,iponoel,inoel));
       
           /* solving the system of equations */
 
       if(*nteq>0){
           FORTRAN(dgesv,(nteq,&nhrs,ac,nteq,ipiv,bc,nteq,&info)); 
       }
 
         /*spooles(ac,au,adb,aub,&sigma,bc,icol,irow,nteq,nteq,
           &symmetryflag,&inputformat);*/
       
       if (info!=0) {
           printf(" *WARNING in radflowload: singular matrix\n");
         
           FORTRAN(mafillnet,(itg,ieg,ntg,ac,nload,sideload,
                  nelemload,xloadact,lakon,ntmat_,v,
                  shcon,nshcon,ipkon,kon,co,nflow,iinc,
                  istep,dtime,ttime,time,
                  ielmat,nteq,prop,ielprop,nactdog,nacteq,
                  physcon,rhcon,nrhcon,ipobody,ibody,xbodyact,
                  nbody,vold,xloadold,reltime,nmethod,set,mi,
                                  nmpc,nodempc,ipompc,coefmpc,labmpc,iaxial,
                                  cocon,ncocon,iponoel,inoel));
         
           FORTRAN(equationcheck,(ac,nteq,nactdog,itg,ntg,nacteq,network));
         
           iin=0;
 
       }
       else {
 
               /* storing the residual in the rhs vector */
 
           FORTRAN(resultnet,(itg,ieg,ntg,bc,nload,sideload,nelemload,
            xloadact,lakon,ntmat_,v,shcon,nshcon,ipkon,kon,co,
            nflow,iinc,istep,dtime,ttime,time,ikforc,ilforc,xforcact,
            nforc,ielmat,nteq,prop,ielprop,nactdog,nacteq,
            &iin,physcon,camt,camf,camp,rhcon,nrhcon,ipobody,
            ibody,xbodyact,nbody,&dtheta,vold,xloadold,
            reltime,nmethod,set,mi,ineighe,cama,&vamt,
            &vamf,&vamp,&vama,nmpc,nodempc,ipompc,coefmpc,labmpc,
                iaxial,&qat,&qaf,&ramt,&ramf,&ramp,cocon,ncocon,iponoel,
            inoel,&iplausi));
 
           /* updating the mean typical energy flow and mass flow */
 
           if(qau<1.e-10){
           if(qat>ea*qamt){qamt=(qamtold*iin+qat)/(iin+1);}
           else {qamt=qamtold;}
           if(qaf>ea*qamf){qamf=(qamfold*iin+qaf)/(iin+1);}
           else {qamf=qamfold;}
           }
 
               /* printing the largest corrections */
         
           if(*network!=4){ 
           cam2t=cam1t;
           cam1t=cam0t;
           cam0t=camt[0];
           printf
                     ("      mean typical energy flow since start of network iterations= %e\n",qamt);
           printf
                     ("      largest energy flow residual in present network iteration= %e\n",ramt);
           printf
                     ("      largest change of gas temperature since start of network iteratons= %e\n",vamt);
           if((ITG)camt[1]==0){
               printf
               ("      largest correction to gas temperature in present network iteration= %e\n\n",
                        camt[0]);
           }else{
               printf
               ("      largest correction to gas temperature= %e in node %" ITGFORMAT "\n\n",
                        camt[0],(ITG)camt[1]);
           }
           }
           
           if(*network>2){
           cam2f=cam1f;
           cam1f=cam0f;
           cam0f=camf[0];
           printf
                     ("      mean typical mass flow since start of network iterations= %e\n",qamf);
           printf
                     ("      largest mass flow residual in present network iteration= %e\n",ramf);
           printf("      largest change of gas massflow since start of network iterations= %e\n",vamf);
           if((ITG)camf[1]==0){
               printf("      largest correction to gas massflow in present network iteration= %e\n\n",
              camf[0]);
           }else{
               printf("      largest correction to gas massflow= %e in node %" ITGFORMAT "\n\n",
              camf[0],(ITG)camf[1]);
           }
           
           cam2p=cam1p;
           cam1p=cam0p;
           cam0p=camp[0];
           printf
                     ("      largest element equation residual in present network iteration= %e\n",ramp);
           printf("      largest change of gas pressure since start of network iterations= %e\n",vamp);
           if((ITG)camp[1]==0){
               printf("      largest correction to gas pressure in present network iteration= %e\n\n",
                          camp[0]);
           }else{
               printf("      largest correction to gas pressure= %e in node %" ITGFORMAT "\n\n",
                          camp[0],(ITG)camp[1]);
           }
           
           cam2a=cam1a;
           cam1a=cam0a;
           cam0a=cama[0];
           printf("      largest change of geometry since start of network iterations= %e\n",vama);
           if((ITG)cama[1]==0){
               printf("      largest correction to geometry in present network iteration= %e\n",
                          cama[0]);
           }else{
               printf("      largest correction to geometry= %e in node %" ITGFORMAT "\n",
                          cama[0],(ITG)cama[1]);
           }
           }       
       }
       
       printf("\n");
       
       /* for purely thermal calculations no iterations are
          deemed necessary */
       
       if(*network<=2) {icntrl=1;}
       else {
 
               /* check the convergence */
 
           checkconvnet(&icutb,&iin,
          &cam1t,&cam1f,&cam1p,&cam2t,&cam2f,&cam2p,&cam0t,&cam0f,
          &cam0p,&icntrl,&dtheta,ctrl,&cam1a,&cam2a,&cam0a,
          &vamt,&vamf,&vamp,&vama,qa,&qamt,&qamf,&ramt,&ramf,&ramp,
                  &iplausi);
       }
       }
 
       /* storing network output as boundary conditions for
          the structure */
 
       FORTRAN(flowresult,(ntg,itg,cam,vold,v,nload,sideload,
           nelemload,xloadact,nactdog,network,mi,ne,ipkon,lakon,kon));
 
       /* extra output for hydraulic jump (fluid channels) */
 
 #ifdef NETWORKOUT
       if(*network>2){
     FORTRAN(flowoutput,(itg,ieg,ntg,nteq,bc,lakon,ntmat_,
                 v,shcon,nshcon,ipkon,kon,co,nflow, dtime,ttime,time,
                 ielmat,prop,ielprop,nactdog,nacteq,&iin,physcon,
                 camt,camf,camp,rhcon,nrhcon,
                 vold,jobnamef,set,istartset,iendset,ialset,nset,
                             mi,iaxial,istep,iit));
       }
 #endif
 #ifdef COMPANY
       memcpy(&prop[0],&prop_store[0],sizeof(double)**nprop);
       SFREE(prop_store);
 #endif    
   }
       
   /* radiation */
 
   if(*ntr>0){
       
       /* variables for multithreading procedure */
       
       ITG sys_cpus;
       char *env,*envloc,*envsys;
       
       num_cpus = 0;
       sys_cpus=0;
       
       /* explicit user declaration prevails */
       
       envsys=getenv("NUMBER_OF_CPUS");
       if(envsys){
       sys_cpus=atoi(envsys);
       if(sys_cpus<0) sys_cpus=0;
       }
       
       /* automatic detection of available number of processors */
       
       if(sys_cpus==0){
       sys_cpus = getSystemCPUs();
       if(sys_cpus<1) sys_cpus=1;
       }
       
       /* local declaration prevails, if strictly positive */
       
       envloc = getenv("CCX_NPROC_VIEWFACTOR");
       if(envloc){
       num_cpus=atoi(envloc);
       if(num_cpus<0){
           num_cpus=0;
       }else if(num_cpus>sys_cpus){
           num_cpus=sys_cpus;
       }
       
       }
       
       /* else global declaration, if any, applies */
       
       env = getenv("OMP_NUM_THREADS");
       if(num_cpus==0){
       if (env)
           num_cpus = atoi(env);
       if (num_cpus < 1) {
           num_cpus=1;
       }else if(num_cpus>sys_cpus){
           num_cpus=sys_cpus;
       }
       }
       
 // next line is to be inserted in a similar way for all other paralell parts
       
       if(*ntr<num_cpus) num_cpus=*ntr;
       
       pthread_t tid[num_cpus];
       
       /*the default sink temperature is updated at the start of each
     increment */
      
       for(i=0;i<*ntr;i++){
       node=nelemload[2*nloadtr[i]-1];
       if(node!=0){
           tenv[i]=vold[mt*(node-1)]-physcon[0];
       }else if(*iit<=0){
           tenv[i]=xloadact[2*nloadtr[i]-1]-physcon[0];
       }
       }
      
 /*     for pure thermal steps the viewfactors have to be
        calculated only once, for thermo-mechanical steps
        (ithermal=3) they are recalculated in each iteration
        unless they are read from file */
 
       if(((*ithermal==3)&&(*iviewfile>=0))||(*iit==-1)){
       if(*iviewfile<0){
 
               /* reading viewfactors from file */
 
           FORTRAN(readview,(ntr,adview,auview,fenv,nzsrad,ithermal,
                 jobnamef));
 
       }else{
 
           /* determining geometric data to calculate the viewfactors */
 
           NNEW(area,double,*ntrit);
           NNEW(pmid,double,3**ntrit);
           NNEW(e1,double,3**ntrit);
           NNEW(e2,double,3**ntrit);
           NNEW(e3,double,4**ntrit);
 
           FORTRAN(geomview,(vold,co,pmid,e1,e2,e3,kontri,area,
                 cs,mcs,inocs,ntrit,nk,mi,&sidemean));
 
           RENEW(adview,double,num_cpus**ntr);
           RENEW(auview,double,num_cpus*2**nzsrad);
           
           NNEW(dist,double,num_cpus**ntrit);
           NNEW(idist,ITG,num_cpus**ntrit);
 
           DMEMSET(adview,0,num_cpus**ntr,0.);
           DMEMSET(auview,0,num_cpus*2**nzsrad,0.);
 
           sideload1=sideload;vold1=vold;co1=co;pmid1=pmid;
           e11=e1;e21=e2;e31=e3;kontri1=kontri;ntr1=ntr;
               nloadtr1=nloadtr;area1=area;ntri1=ntri;
               ntrit1=ntrit;mi1=mi;jqrad1=jqrad;irowrad1=irowrad;
               nzsrad1=nzsrad;sidemean1=sidemean;
 
               /* size of the square mesh used to detect
                  the visibility of a triangle; the denser
                  the mesh,the more accurate the results */
 
           ng1=1280;
 //        ng1=2560;
           NNEW(covered1,char,num_cpus*ng1*ng1);
 
           /* calculating the viewfactors */
           
           printf(" Using up to %" ITGFORMAT " cpu(s) for the viewfactor calculation.\n\n", num_cpus);
   
           /* create threads and wait */
           
           NNEW(ithread,ITG,num_cpus);
           for(i=0; i<num_cpus; i++)  {
           ithread[i]=i;
           pthread_create(&tid[i], NULL, (void *)calcviewmt, (void *)&ithread[i]);
           }
           for(i=0; i<num_cpus; i++)  pthread_join(tid[i], NULL);
           
           for(i=0;i<*ntr;i++){
           for(j=1;j<num_cpus;j++){
               adview[i]+=adview[i+j**ntr];
           }
           }
           RENEW(adview,double,*ntr);
           
           for(i=0;i<2**nzsrad;i++){
           for(j=1;j<num_cpus;j++){
               auview[i]+=auview[i+j*2**nzsrad];
           }
           }
           RENEW(auview,double,2**nzsrad);
 
 /*        for(i=0;i<*ntr;i++){
           printf("radflowload adview = %" ITGFORMAT " %e\n",i,adview[i]);
           }
           for(i=0;i<2**nzsrad;i++){
           printf("radflowload auview = %" ITGFORMAT " %e\n",i,auview[i]);
           }*/
 
           SFREE(dist);SFREE(idist);SFREE(e1);SFREE(e2);SFREE(e3);
               SFREE(pmid);SFREE(ithread);SFREE(covered1);
 
           /* postprocessing the viewfactors */
 
           FORTRAN(postview,(ntr,sideload,nelemload,kontri,ntri,nloadtr,
                 tenv,adview,auview,area,fenv,jqrad,irowrad,
                                 nzsrad));
 
           SFREE(area);
 
           if(*iviewfile>=2){
           
           /* writing viewfactors to file */
           
           FORTRAN(writeview,(ntr,adview,auview,fenv,nzsrad,
                      jobnamef));
           }
           
           if(*iviewfile==3){
           
           /* calculation of viewfactors only */
           
           FORTRAN(stop,());
           }
 
       }
       }
 
       /* assembling the radiation matrix */
       
       FORTRAN(radmatrix,(ntr,adrad,aurad,bcr,sideload,nelemload,
           xloadact,lakon,vold,ipkon,kon,co,nloadtr,tarea,tenv,physcon,
           erad,adview,auview,ithermal,iinc,iit,fenv,istep,dtime,ttime,
           time,iviewfile,xloadold,reltime,nmethod,mi,iemchange,nam,
           iamload,jqrad,irowrad,nzsrad));
 
       /* factoring the system of equations */
 
       /* the left hand side of the radiation matrix has probably
          changed if
          - the viewfactors were updated
          - a new step was started and NO CHANGE is not active
          - the emissivity coefficients were changed
          - a new increment was started in a stationary calculation
            (since the emissivity coefficients are ramped)
        in that case the LU decomposition has to be repeated
            (i.e. call of dgesv) */
 
       if(((*ithermal==3)&&(*iviewfile>=0))||
          ((*iit==-1)&&(*iviewfile!=-2))||(*iemchange==1)||((*iit==0)&&(abs(*nmethod)==1))){
 
 #if defined(PARDISO)
     if(ifactorization==1) pardiso_cleanup_as(ntr,&symmetryflag);
     pardiso_factor_as(adrad,aurad,adbrad,aubrad,&sigma,icolrad,
               irowrad,ntr,nzsrad,jqrad);
     ifactorization=1;
 #elif defined(SPOOLES)
     if(ifactorization==1) spooles_cleanup_rad();
     spooles_factor_rad(adrad,aurad,adbrad,aubrad,&sigma,
                icolrad,irowrad,ntr,nzsrad,
                &symmetryflag,&inputformat);
     ifactorization=1;
 #else
     printf("*ERROR in radflowload: the SPOOLES library is not linked\n\n");
     FORTRAN(stop,());
 #endif
 
       }
 
       /* solving the system of equations */
 
 #if defined(PARDISO)
           pardiso_solve_as(bcr,ntr);
 
 #elif defined(SPOOLES)
           spooles_solve_rad(bcr,ntr);
 #endif
     
       if (info!=0){
       printf("*ERROR IN RADFLOWLOAD: SINGULAR MATRIX*\n");}   
       
       else{ 
       NNEW(q,double,*ntr);
       FORTRAN(radresult,(ntr,xloadact,bcr,nloadtr,tarea,
                 tenv,physcon,erad,auview,fenv,
                     irowrad,jqrad,nzsrad,q));
       SFREE(q);
       }
       
   }
 
   SFREE(v);
 
   *adviewp=adview;*auviewp=auview;
 
   return;
 
 } 

◆ randomfieldmain()

void randomfieldmain	(	ITG *	kon,
		ITG *	ipkon,
		char *	lakon,
		ITG *	ne,
		ITG *	nmpc,
		ITG *	nactdof,
		ITG *	mi,
		ITG *	nodedesi,
		ITG *	ndesi,
		ITG *	istartdesi,
		ITG *	ialdesi,
		double *	co,
		double *	physcon,
		ITG *	isolver,
		ITG *	ntrans,
		ITG *	nk,
		ITG *	inotr,
		double *	trab,
		char *	jobnamec,
		ITG *	nboun,
		double *	cs,
		ITG *	mcs,
		ITG *	inum,
		ITG *	nmethod,
		ITG *	kode,
		char *	filab,
		ITG *	nstate_,
		ITG *	istep,
		char *	description,
		char *	set,
		ITG *	nset,
		ITG *	iendset,
		char *	output,
		ITG *	istartset,
		ITG *	ialset,
		double *	extnor
	)

◆ readinput()

void readinput	(	char *	jobnamec,
		char **	inpcp,
		ITG *	nline,
		ITG *	nset,
		ITG *	ipoinp,
		ITG **	inpp,
		ITG **	ipoinpcp,
		ITG *	ithermal,
		ITG *	nuel_
	)

                          {
 
   /*   reads and stores the input deck in inpcp; determines the
        number of sets  */
 
   FILE *f1[10];
 
   char buff[1320]="", fninp[132]="", includefn[132]="", *inpc=NULL,
        textpart[2112]="",*set=NULL;
 
   ITG i,j,k,n,in=0,nlinemax=100000,irestartread,irestartstep,
       icntrl,nload,nforc,nboun,nk,ne,nmpc,nalset,nmat,ntmat,npmat,
       norien,nam,nprint,mi[3],ntrans,ncs,namtot,ncmat,memmpc,ne1d,
       ne2d,nflow,*meminset=NULL,*rmeminset=NULL, *inp=NULL,ntie,
       nener,nstate,nentries=17,ifreeinp,ikey,lincludefn,nslavs,
       nbody,ncharmax=1000000,*ipoinpc=NULL,ichangefriction=0,nkon,
       ifile,mcs,initialtemperature=0,nprop,mortar,ifacecount,
       nintpoint,infree[4],iheading=0,ichangesurfacebehavior=0; 
 
   /* initialization */
 
   /* nentries is the number of different keyword cards for which
      the input deck order is important, cf keystart.f */
 
   NNEW(inpc,char,ncharmax);
   NNEW(ipoinpc,ITG,nlinemax+1);
   NNEW(inp,ITG,3*nlinemax);
   *nline=0;
   for(i=0;i<2*nentries;i++){ipoinp[i]=0;}
   ifreeinp=1;
   ikey=0;
 
   /* opening the input file */
 
   strcpy(fninp,jobnamec);
   strcat(fninp,".inp");
   if((f1[in]=fopen(fninp,"r"))==NULL){
       printf("*ERROR in readinput: cannot open file %s\n",fninp);
       exit(0);
   }
 
   /* starting to read the input file */
 
   do{
       if(fgets(buff,1320,f1[in])==NULL){
       fclose(f1[in]);
       if(in!=0){
           in--;
           continue;
       }
       else{break;}
       }
       
       /* check for heading lines: should not be changed */
 
       if(iheading==1){
       if((buff[0]=='*')&&(buff[1]!='*')){
           iheading=0;
       }
       }
 
       /* storing the significant characters */
       /* get rid of blanks  */
     
       k=0;
       i=-1;
       if(iheading==0){
       do{
           i++;
           if((buff[i]=='\0')||(buff[i]=='\n')||(buff[i]=='\r')||(k==1320)) break;
           if((buff[i]==' ')||(buff[i]=='\t')) continue;
           buff[k]=buff[i];
           k++;
       }while(1);
       }else{
       do{
           i++;
           if((buff[i]=='\0')||(buff[i]=='\n')||(buff[i]=='\r')||(k==1320)) break;
           buff[k]=buff[i];
           k++;
       }while(1);
       }
     
       /* check for blank lines and comments */
 
       if(k==0) continue;
       if(strcmp1(&buff[0],"**")==0) continue;
 
       /* changing to uppercase except filenames */
 
       if(iheading==0){
       j=0;
       ifile=0;
       do{
           if(j>=6){
           if(strcmp1(&buff[j-6],"INPUT=")==0) ifile=1;
           }
           if(j>=7){
           if(strcmp1(&buff[j-7],"OUTPUT=")==0) ifile=1;
           }
           if(j>=9){
           if(strcmp1(&buff[j-9],"FILENAME=")==0) ifile=1;
           }
           if(ifile==1){
           do{
               if(strcmp1(&buff[j],",")!=0){
               j++;
               }else{
               ifile=0;
               break;
               }
           }while(j<k);
           }else{
           buff[j]=toupper(buff[j]);
           }
           j++;
       }while(j<k);
       }
 
       /* check for a *HEADING card */
 
       if(strcmp1(&buff[0],"*HEADING")==0){
       iheading=1;
       }
 
       /* check for a *KINEMATIC or *DISTRIBUTING card and change
          the asterisk into a C (is a "dependent" card of the 
          *COUPLING card */
 
       if((strcmp1(&buff[0],"*KINEMATIC")==0)||
          ((strcmp1(&buff[0],"*DISTRIBUTING")==0)&&
           (strcmp1(&buff[0],"*DISTRIBUTINGCOUPLING")!=0)))
          {
       buff[0]='C';
       }
       
       /* check for include statements */
       
       if(strcmp1(&buff[0],"*INCLUDE")==0){
       lincludefn=k;
       FORTRAN(includefilename,(buff,includefn,&lincludefn));
           includefn[lincludefn]='\0';
       in++;
       if(in>9){
           printf("*ERROR in readinput: include statements can \n not be cascaded over more than 9 levels\n");
       }
       if((f1[in]=fopen(includefn,"r"))==NULL){
           printf("*ERROR in readinput: cannot open file %s\n",includefn);
           exit(0);
       }
           continue;
       }
 
       /* adding a line */
       
       (*nline)++;
       if(*nline>nlinemax){
       nlinemax=(ITG)(1.1*nlinemax);
       RENEW(ipoinpc,ITG,nlinemax+1);
       RENEW(inp,ITG,3*nlinemax);
       }
 
       /* checking the total number of characters */
 
       if(ipoinpc[*nline-1]+k>ncharmax){
       ncharmax=(ITG)(1.1*ncharmax);
       RENEW(inpc,char,ncharmax);
       }
       
       /* copying into inpc */
 
       for(j=0;j<k;j++){
       inpc[ipoinpc[*nline-1]+j]=buff[j];
       }
       ipoinpc[*nline]=ipoinpc[*nline-1]+k;
 
       /* counting sets */
       
       if(strcmp1(&buff[0],"*AMPLITUDE")==0){
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"AMPLITUDE",
                           nline,&ikey));
       }
       else if(strcmp1(&buff[0],"*CHANGEFRICTION")==0){
     ichangefriction=1;
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"REST",
                           nline,&ikey));
       }
       else if(strcmp1(&buff[0],"*CHANGESURFACEBEHAVIOR")==0){
     ichangesurfacebehavior=1;
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"REST",
                           nline,&ikey));
       }
       else if(strcmp1(&buff[0],"*CONDUCTIVITY")==0){
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
                           nline,&ikey));
       }
       else if(strcmp1(&buff[0],"*CONTACTDAMPING")==0){
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"SURFACEINTERACTION",
                           nline,&ikey));
       }
       else if(strcmp1(&buff[0],"*CONTACTPAIR")==0){
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"CONTACTPAIR",
                           nline,&ikey));
       }
       else if(strcmp1(&buff[0],"*COUPLING")==0){
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"COUPLING",
                           nline,&ikey));
       }
       else if(strcmp1(&buff[0],"*CREEP")==0){
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
                           nline,&ikey));
       }
       else if(strcmp1(&buff[0],"*CYCLICHARDENING")==0){
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
                           nline,&ikey));
       }
       else if(strcmp1(&buff[0],"*DEFORMATIONPLASTICITY")==0){
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
                           nline,&ikey));
       }
       else if(strcmp1(&buff[0],"*DENSITY")==0){
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
                           nline,&ikey));
       }
       else if(strcmp1(&buff[0],"*DEPVAR")==0){
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
                           nline,&ikey));
       }
       else if(strcmp1(&buff[0],"*ELASTIC")==0){
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
                           nline,&ikey));
       }
       else if(strcmp1(&buff[0],"*ELECTRICALCONDUCTIVITY")==0){
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
                           nline,&ikey));
       }
       else if((strcmp1(&buff[0],"*ELEMENT")==0)&&
               (strcmp1(&buff[0],"*ELEMENTOUTPUT")!=0)){
         (*nset)++;
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"ELEMENT",
                           nline,&ikey));
       }
       else if(strcmp1(&buff[0],"*ELSET")==0){
         (*nset)++;
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"ELSET",
                           nline,&ikey));
       }
       else if(strcmp1(&buff[0],"*EXPANSION")==0){
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
                           nline,&ikey));
       }
       else if(strcmp1(&buff[0],"*FLUIDCONSTANTS")==0){
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
                           nline,&ikey));
       }
       else if((strcmp1(&buff[0],"*FRICTION")==0)&&(ichangefriction==0)){
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"SURFACEINTERACTION",
                           nline,&ikey));
       }
       else if(strcmp1(&buff[0],"*GAPCONDUCTANCE")==0){
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"SURFACEINTERACTION",
                           nline,&ikey));
       }
       else if(strcmp1(&buff[0],"*GAPHEATGENERATION")==0){
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"SURFACEINTERACTION",
                           nline,&ikey));
       }
       else if(strcmp1(&buff[0],"*HYPERELASTIC")==0){
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
                           nline,&ikey));
       }
       else if(strcmp1(&buff[0],"*HYPERFOAM")==0){
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
                           nline,&ikey));
       }
       else if(strcmp1(&buff[0],"*INITIALCONDITIONS")==0){
       FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"INITIALCONDITIONS",
                 nline,&ikey));
       FORTRAN(splitline,(buff,textpart,&n));
       for(i=0;i<n;i++){
           if(strcmp1(&textpart[(long long)132*i],"TYPE=TEMPERATURE")==0){
           initialtemperature=1;
           }
           }
       }
       else if(strcmp1(&buff[0],"*MAGNETICPERMEABILITY")==0){
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
                           nline,&ikey));
       }
       else if(strcmp1(&buff[0],"*MATERIAL")==0){
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
                           nline,&ikey));
       }
       else if((strcmp1(&buff[0],"*NODE")==0)&&
           (strcmp1(&buff[0],"*NODEPRINT")!=0)&&
           (strcmp1(&buff[0],"*NODEOUTPUT")!=0)&&
           (strcmp1(&buff[0],"*NODEFILE")!=0)){
         (*nset)++;
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"NODE",
                           nline,&ikey));
       }
       else if(strcmp1(&buff[0],"*NSET")==0){
         (*nset)++;
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"NSET",
                           nline,&ikey));
       }
       else if(strcmp1(&buff[0],"*ORIENTATION")==0){
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"ORIENTATION",
                           nline,&ikey));
       }
       else if(strcmp1(&buff[0],"*PLASTIC")==0){
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
                           nline,&ikey));
       }
       else if(strcmp1(&buff[0],"*RESTART")==0){
       irestartread=0;
       irestartstep=0;
       strcpy1(&buff[k]," ",1);
       FORTRAN(splitline,(buff,textpart,&n));
       for(i=0;i<n;i++){
           if(strcmp1(&textpart[(long long)132*i],"READ")==0){
           irestartread=1;
           }
           if(strcmp1(&textpart[(long long)132*i],"STEP")==0){
           irestartstep=atoi(&textpart[(long long)132*i+5]);
           }
           }
           if(irestartread==1){
             icntrl=0;
             FORTRAN(restartshort,(nset,&nload,&nbody,&nforc,&nboun,&nk,
               &ne,&nmpc,&nalset,&nmat,&ntmat,&npmat,&norien,&nam,
               &nprint,mi,&ntrans,&ncs,&namtot,&ncmat,&memmpc,
               &ne1d,&ne2d,&nflow,set,meminset,rmeminset,jobnamec,
           &irestartstep,&icntrl,ithermal,&nener,&nstate,&ntie,
           &nslavs,&nkon,&mcs,&nprop,&mortar,&ifacecount,&nintpoint,
               infree));
             FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"RESTART,READ",
                               nline,&ikey));
       }
           else{
             FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"REST",
                               nline,&ikey));
           }
 
       }
       else if(strcmp1(&buff[0],"*SPECIFICGASCONSTANT")==0){
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
                           nline,&ikey));
       }
       else if(strcmp1(&buff[0],"*SPECIFICHEAT")==0){
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
                           nline,&ikey));
       }
       else if(strcmp1(&buff[0],"*SUBMODEL")==0){
     (*nset)+=2;
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"REST",
                           nline,&ikey));
       }
       else if(strcmp1(&buff[0],"*SURFACEINTERACTION")==0){
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"SURFACEINTERACTION",
                           nline,&ikey));
       }
       else if(strcmp1(&buff[0],"*SURFACEBEHAVIOR")==0){
       if(ichangesurfacebehavior==0){
           FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"SURFACEINTERACTION",
                           nline,&ikey));
       }else{
           FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"REST",
                 nline,&ikey));
       }
       }
       else if(strcmp1(&buff[0],"*SURFACE")==0){
         (*nset)++;
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"SURFACE",
                           nline,&ikey));
       }
       else if(strcmp1(&buff[0],"*TIE")==0){
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"TIE",
                           nline,&ikey));
       }
       else if(strcmp1(&buff[0],"*TRANSFORM")==0){
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"TRANSFORM",
                           nline,&ikey));
       }
       else if(strcmp1(&buff[0],"*USERELEMENT")==0){
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"USERELEMENT",
                           nline,&ikey));
     (*nuel)++;
       }
       else if(strcmp1(&buff[0],"*USERMATERIAL")==0){
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"MATERIAL",
                           nline,&ikey));
       }
       else if(strcmp1(&buff[0],"*")==0){
         FORTRAN(keystart,(&ifreeinp,ipoinp,inp,"REST",
                           nline,&ikey));
 
         /* checking whether the calculation is mechanical,
            thermal or thermomechanical: needed to know
            which mpc's to apply to 2-D elements */
 
     if((strcmp1(&buff[0],"*STATIC")==0)||
        (strcmp1(&buff[0],"*VISCO")==0)||
        (strcmp1(&buff[0],"*DYNAMIC")==0)){
         if(ithermal[1]==0){
         if(initialtemperature==1)ithermal[1]=1;
         }else if(ithermal[1]==2){
         ithermal[1]=3;
         }
     }else if(strcmp1(&buff[0],"*HEATTRANSFER")==0){
         if(ithermal[1]<2) ithermal[1]=ithermal[1]+2;
     }else if(strcmp1(&buff[0],"*COUPLEDTEMPERATURE-DISPLACEMENT")==0){
         ithermal[1]=3;
     }else if(strcmp1(&buff[0],"*UNCOUPLEDTEMPERATURE-DISPLACEMENT")==0){
         ithermal[1]=3;
     }else if(strcmp1(&buff[0],"*ELECTROMAGNETICS")==0){
         ithermal[1]=3;
     }
       }
   }while(1);
 
   inp[3*ipoinp[2*ikey-1]-2]=*nline;
   RENEW(inpc,char,(long long)132**nline);
   RENEW(inp,ITG,3*ipoinp[2*ikey-1]);
   *inpcp=inpc;
   *ipoinpcp=ipoinpc;
   *inpp=inp;
   
 //  FORTRAN(writeinput,(inpc,ipoinp,inp,nline,&ipoinp[2*ikey-1],ipoinpc));
 
   return;
 
 }

◆ remastruct()

void remastruct	(	ITG *	ipompc,
		double **	coefmpcp,
		ITG **	nodempcp,
		ITG *	nmpc,
		ITG *	mpcfree,
		ITG *	nodeboun,
		ITG *	ndirboun,
		ITG *	nboun,
		ITG *	ikmpc,
		ITG *	ilmpc,
		ITG *	ikboun,
		ITG *	ilboun,
		char *	labmpc,
		ITG *	nk,
		ITG *	memmpc_,
		ITG *	icascade,
		ITG *	maxlenmpc,
		ITG *	kon,
		ITG *	ipkon,
		char *	lakon,
		ITG *	ne,
		ITG *	nactdof,
		ITG *	icol,
		ITG *	jq,
		ITG **	irowp,
		ITG *	isolver,
		ITG *	neq,
		ITG *	nzs,
		ITG *	nmethod,
		double **	fp,
		double **	fextp,
		double **	bp,
		double **	aux2p,
		double **	finip,
		double **	fextinip,
		double **	adbp,
		double **	aubp,
		ITG *	ithermal,
		ITG *	iperturb,
		ITG *	mass,
		ITG *	mi,
		ITG *	iexpl,
		ITG *	mortar,
		char *	typeboun,
		double **	cvp,
		double **	cvinip,
		ITG *	iit,
		ITG *	network
	)

                            {
 
     /* reconstructs the nonzero locations in the stiffness and mass
        matrix after a change in MPC's */
 
     ITG *nodempc=NULL,*mast1=NULL,*ipointer=NULL,mpcend,
         callfrommain,i,*irow=NULL,mt,im;
 
     double *coefmpc=NULL,*f=NULL,*fext=NULL,*b=NULL,*aux2=NULL,
         *fini=NULL,*fextini=NULL,*adb=NULL,*aub=NULL,*cv=NULL,*cvini=NULL;
     
     nodempc=*nodempcp;coefmpc=*coefmpcp;irow=*irowp;
     f=*fp;fext=*fextp;b=*bp;aux2=*aux2p;fini=*finip;
     fextini=*fextinip;adb=*adbp;aub=*aubp;cv=*cvp;cvini=*cvinip;
 
     mt=mi[1]+1;
 
     /* decascading the MPC's */
 
     if(*icascade>0){
     printf(" Decascading the MPC's\n\n");
     
     callfrommain=0;
     cascade(ipompc,&coefmpc,&nodempc,nmpc,
         mpcfree,nodeboun,ndirboun,nboun,ikmpc,
         ilmpc,ikboun,ilboun,&mpcend,
         labmpc,nk,memmpc_,icascade,maxlenmpc,
         &callfrommain,iperturb,ithermal);
     }
 
     /* determining the matrix structure */
     
     printf(" Determining the structure of the matrix:\n");
  
     if(nzs[1]<10) nzs[1]=10;   
     NNEW(mast1,ITG,nzs[1]);
     NNEW(ipointer,ITG,mt**nk);
     
     mastruct(nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,nboun,ipompc,
          nodempc,nmpc,nactdof,icol,jq,&mast1,&irow,isolver,neq,
          ikmpc,ilmpc,ipointer,nzs,nmethod,ithermal,
              ikboun,ilboun,iperturb,mi,mortar,typeboun,labmpc,
              iit,icascade,network);
 
     SFREE(ipointer);SFREE(mast1);
     RENEW(irow,ITG,nzs[2]);
     
     *nodempcp=nodempc;*coefmpcp=coefmpc;*irowp=irow;
 
     /* reallocating fields the size of which depends on neq[1] or *nzs */
 
     RENEW(f,double,neq[1]);DMEMSET(f,0,neq[1],0.);
     RENEW(fext,double,neq[1]);DMEMSET(fext,0,neq[1],0.);
     RENEW(b,double,neq[1]);DMEMSET(b,0,neq[1],0.);
     RENEW(fini,double,neq[1]);
 
     /* for static calculations fini has to be set to f at the
        start of the calculation; in dynamic calculations this is
        not needed, since the initial accelerations has already
        been calculated */
 
     if((*nmethod!=4)&&(*iit==-1)) DMEMSET(fini,0,neq[1],0.);
 
     if(*nmethod==4){
     RENEW(aux2,double,neq[1]);DMEMSET(aux2,0,neq[1],0.);
     RENEW(cv,double,neq[1]);
     RENEW(cvini,double,neq[1]);
     RENEW(fextini,double,neq[1]);
 
         /* the mass matrix is diagonal in an explicit dynamic
            calculation and is not changed by contact; this
            assumes that the number of degrees of freedom does
            not change  */
 
     if(*iexpl<=1){
         RENEW(adb,double,neq[1]);for(i=0;i<neq[1];i++) adb[i]=0.;
         RENEW(aub,double,nzs[1]);for(i=0;i<nzs[1];i++) aub[i]=0.;
         mass[0]=1;
     }
     }
 
     *fp=f;*fextp=fext;*bp=b;*aux2p=aux2;*finip=fini;
     *fextinip=fextini;*adbp=adb;*aubp=aub;*cvp=cv;*cvinip=cvini;
 
     return;
 }

◆ remastructar()

void remastructar	(	ITG *	ipompc,
		double **	coefmpcp,
		ITG **	nodempcp,
		ITG *	nmpc,
		ITG *	mpcfree,
		ITG *	nodeboun,
		ITG *	ndirboun,
		ITG *	nboun,
		ITG *	ikmpc,
		ITG *	ilmpc,
		ITG *	ikboun,
		ITG *	ilboun,
		char *	labmpc,
		ITG *	nk,
		ITG *	memmpc_,
		ITG *	icascade,
		ITG *	maxlenmpc,
		ITG *	kon,
		ITG *	ipkon,
		char *	lakon,
		ITG *	ne,
		ITG *	nactdof,
		ITG *	icol,
		ITG *	jq,
		ITG **	irowp,
		ITG *	isolver,
		ITG *	neq,
		ITG *	nzs,
		ITG *	nmethod,
		ITG *	ithermal,
		ITG *	iperturb,
		ITG *	mass,
		ITG *	mi,
		ITG *	ics,
		double *	cs,
		ITG *	mcs,
		ITG *	mortar,
		char *	typeboun,
		ITG *	iit,
		ITG *	network
	)

                            {
 
     /* reconstructs the nonzero locations in the stiffness and mass
        matrix after a change in MPC's or the generation of contact
        spring elements: version for frequency calculations (called
        by arpack and arpackcs)  */
 
     ITG *nodempc=NULL,*mast1=NULL,*ipointer=NULL,mpcend,
         callfrommain,i,*irow=NULL,mt;
 
     double *coefmpc=NULL;
     
     nodempc=*nodempcp;coefmpc=*coefmpcp;irow=*irowp;
 
     mt=mi[1]+1;
 
     /* decascading the MPC's */
 
     printf(" Decascading the MPC's\n\n");
    
     callfrommain=0;
     cascade(ipompc,&coefmpc,&nodempc,nmpc,
         mpcfree,nodeboun,ndirboun,nboun,ikmpc,
         ilmpc,ikboun,ilboun,&mpcend,
         labmpc,nk,memmpc_,icascade,maxlenmpc,
             &callfrommain,iperturb,ithermal);
 
     /* determining the matrix structure */
     
     printf(" Determining the structure of the matrix:\n");
  
     if(nzs[1]<10) nzs[1]=10;   
     NNEW(mast1,ITG,nzs[1]);
     RENEW(irow,ITG,nzs[1]);
   
     if((*mcs==0)||(cs[1]<0)){
 
     NNEW(ipointer,ITG,mt**nk);
     
     mastruct(nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,nboun,ipompc,
          nodempc,nmpc,nactdof,icol,jq,&mast1,&irow,isolver,neq,
          ikmpc,ilmpc,ipointer,nzs,nmethod,ithermal,
          ikboun,ilboun,iperturb,mi,mortar,typeboun,labmpc,
          iit,icascade,network);
 
     }else{
       
       NNEW(ipointer,ITG,8**nk);
       
       mastructcs(nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,nboun,
          ipompc,nodempc,nmpc,nactdof,icol,jq,&mast1,&irow,isolver,
          neq,ikmpc,ilmpc,ipointer,nzs,nmethod,
          ics,cs,labmpc,mcs,mi,mortar);
     }
 
     SFREE(ipointer);SFREE(mast1);
     RENEW(irow,ITG,nzs[2]);
     
     *nodempcp=nodempc;*coefmpcp=coefmpc;*irowp=irow;
 
     return;
 }

◆ remastructem()

void remastructem	(	ITG *	ipompc,
		double **	coefmpcp,
		ITG **	nodempcp,
		ITG *	nmpc,
		ITG *	mpcfree,
		ITG *	nodeboun,
		ITG *	ndirboun,
		ITG *	nboun,
		ITG *	ikmpc,
		ITG *	ilmpc,
		ITG *	ikboun,
		ITG *	ilboun,
		char *	labmpc,
		ITG *	nk,
		ITG *	memmpc_,
		ITG *	icascade,
		ITG *	maxlenmpc,
		ITG *	kon,
		ITG *	ipkon,
		char *	lakon,
		ITG *	ne,
		ITG *	nactdof,
		ITG *	icol,
		ITG *	jq,
		ITG **	irowp,
		ITG *	isolver,
		ITG *	neq,
		ITG *	nzs,
		ITG *	nmethod,
		double **	fp,
		double **	fextp,
		double **	bp,
		double **	aux2p,
		double **	finip,
		double **	fextinip,
		double **	adbp,
		double **	aubp,
		ITG *	ithermal,
		ITG *	iperturb,
		ITG *	mass,
		ITG *	mi,
		ITG *	ielmat,
		double *	elcon,
		ITG *	ncmat_,
		ITG *	ntmat_,
		ITG *	inomat,
		ITG *	network
	)

                                                             {
 
     /* reconstructs the nonzero locations in the stiffness and mass
        matrix after a change in MPC's */
 
     ITG *nodempc=NULL,*mast1=NULL,*ipointer=NULL,mpcend,
         callfrommain,i,*irow=NULL,mt;
 
     double *coefmpc=NULL,*f=NULL,*fext=NULL,*b=NULL,*aux2=NULL,
         *fini=NULL,*fextini=NULL,*adb=NULL,*aub=NULL;
     
     nodempc=*nodempcp;coefmpc=*coefmpcp;irow=*irowp;
     f=*fp;fext=*fextp;b=*bp;aux2=*aux2p;fini=*finip;
     fextini=*fextinip;adb=*adbp;aub=*aubp;
 
     mt=mi[1]+1;
 
     /* decascading the MPC's */
 
     printf(" Decascading the MPC's\n\n");
    
     callfrommain=0;
     cascade(ipompc,&coefmpc,&nodempc,nmpc,
         mpcfree,nodeboun,ndirboun,nboun,ikmpc,
         ilmpc,ikboun,ilboun,&mpcend,
         labmpc,nk,memmpc_,icascade,maxlenmpc,
             &callfrommain,iperturb,ithermal);
 
     /* determining the matrix structure */
     
     printf(" Determining the structure of the matrix:\n");
  
     if(nzs[1]<10) nzs[1]=10;   
     NNEW(mast1,ITG,nzs[1]);
     NNEW(ipointer,ITG,mt**nk);
     RENEW(irow,ITG,nzs[1]);
     
     mastructem(nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,nboun,ipompc,
          nodempc,nmpc,nactdof,icol,jq,&mast1,&irow,isolver,neq,
          ikmpc,ilmpc,ipointer,nzs,ithermal,mi,ielmat,elcon,
          ncmat_,ntmat_,inomat,network);
 
     SFREE(ipointer);SFREE(mast1);
     RENEW(irow,ITG,nzs[2]);
     
     *nodempcp=nodempc;*coefmpcp=coefmpc;*irowp=irow;
 
     /* reallocating fields the size of which depends on neq[1] or *nzs */
 
     RENEW(f,double,neq[1]);for(i=0;i<neq[1];i++) f[i]=0.;
     RENEW(fext,double,neq[1]);for(i=0;i<neq[1];i++) fext[i]=0.;
     RENEW(b,double,neq[1]);for(i=0;i<neq[1];i++) b[i]=0.;
     RENEW(fini,double,neq[1]);for(i=0;i<neq[1];i++) fini[i]=0.;
 
     if(*nmethod==4){
     RENEW(aux2,double,neq[1]);for(i=0;i<neq[1];i++) aux2[i]=0.;
     RENEW(fextini,double,neq[1]);for(i=0;i<neq[1];i++) fextini[i]=0.;
     RENEW(adb,double,neq[1]);for(i=0;i<neq[1];i++) adb[i]=0.;
     RENEW(aub,double,nzs[1]);for(i=0;i<nzs[1];i++) aub[i]=0.;
     mass[0]=1;
     }
 
     *fp=f;*fextp=fext;*bp=b;*aux2p=aux2;*finip=fini;
     *fextinip=fextini;*adbp=adb;*aubp=aub;
 
     return;
 }

◆ results()

void results	(	double *	co,
		ITG *	nk,
		ITG *	kon,
		ITG *	ipkon,
		char *	lakon,
		ITG *	ne,
		double *	v,
		double *	stn,
		ITG *	inum,
		double *	stx,
		double *	elcon,
		ITG *	nelcon,
		double *	rhcon,
		ITG *	nrhcon,
		double *	alcon,
		ITG *	nalcon,
		double *	alzero,
		ITG *	ielmat,
		ITG *	ielorien,
		ITG *	norien,
		double *	orab,
		ITG *	ntmat_,
		double *	t0,
		double *	t1,
		ITG *	ithermal,
		double *	prestr,
		ITG *	iprestr,
		char *	filab,
		double *	eme,
		double *	emn,
		double *	een,
		ITG *	iperturb,
		double *	f,
		double *	fn,
		ITG *	nactdof,
		ITG *	iout,
		double *	qa,
		double *	vold,
		double *	b,
		ITG *	nodeboun,
		ITG *	ndirboun,
		double *	xboun,
		ITG *	nboun,
		ITG *	ipompc,
		ITG *	nodempc,
		double *	coefmpc,
		char *	labmpc,
		ITG *	nmpc,
		ITG *	nmethod,
		double *	vmax,
		ITG *	neq,
		double *	veold,
		double *	accold,
		double *	beta,
		double *	gamma,
		double *	dtime,
		double *	time,
		double *	ttime,
		double *	plicon,
		ITG *	nplicon,
		double *	plkcon,
		ITG *	nplkcon,
		double *	xstateini,
		double *	xstiff,
		double *	xstate,
		ITG *	npmat_,
		double *	epl,
		char *	matname,
		ITG *	mi,
		ITG *	ielas,
		ITG *	icmd,
		ITG *	ncmat_,
		ITG *	nstate_,
		double *	stiini,
		double *	vini,
		ITG *	ikboun,
		ITG *	ilboun,
		double *	ener,
		double *	enern,
		double *	emeini,
		double *	xstaten,
		double *	eei,
		double *	enerini,
		double *	cocon,
		ITG *	ncocon,
		char *	set,
		ITG *	nset,
		ITG *	istartset,
		ITG *	iendset,
		ITG *	ialset,
		ITG *	nprint,
		char *	prlab,
		char *	prset,
		double *	qfx,
		double *	qfn,
		double *	trab,
		ITG *	inotr,
		ITG *	ntrans,
		double *	fmpc,
		ITG *	nelemload,
		ITG *	nload,
		ITG *	ikmpc,
		ITG *	ilmpc,
		ITG *	istep,
		ITG *	iinc,
		double *	springarea,
		double *	reltime,
		ITG *	ne0,
		double *	xforc,
		ITG *	nforc,
		double *	thicke,
		double *	shcon,
		ITG *	nshcon,
		char *	sideload,
		double *	xload,
		double *	xloadold,
		ITG *	icfd,
		ITG *	inomat,
		double *	pslavsurf,
		double *	pmastsurf,
		ITG *	mortar,
		ITG *	islavact,
		double *	cdn,
		ITG *	islavnode,
		ITG *	nslavnode,
		ITG *	ntie,
		double *	clearini,
		ITG *	islavsurf,
		ITG *	ielprop,
		double *	prop,
		double *	energyini,
		double *	energy,
		ITG *	kscale,
		ITG *	iponoel,
		ITG *	inoel,
		ITG *	nener,
		char *	orname,
		ITG *	network,
		ITG *	ipobody,
		double *	xbodyact,
		ITG *	ibody
	)

                                                                        {
 
     ITG intpointvarm,calcul_fn,calcul_f,calcul_qa,calcul_cauchy,ikin,
         intpointvart,mt=mi[1]+1,i,j;
 
     /*
 
      calculating integration point values (strains, stresses,
      heat fluxes, material tangent matrices and nodal forces)
 
      storing the nodal and integration point results in the
      .dat file
 
      iout=-2: v is assumed to be known and is used to
               calculate strains, stresses..., no result output
               corresponds to iout=-1 with in addition the
               calculation of the internal energy density
      iout=-1: v is assumed to be known and is used to
               calculate strains, stresses..., no result output;
               is used to take changes in SPC's and MPC's at the
               start of a new increment or iteration into account
      iout=0: v is calculated from the system solution
              and strains, stresses.. are calculated, no result output
      iout=1:  v is calculated from the system solution and strains,
               stresses.. are calculated, requested results output
      iout=2: v is assumed to be known and is used to 
              calculate strains, stresses..., requested results output */
       
     /* variables for multithreading procedure */
     
     ITG sys_cpus,*ithread=NULL;
     char *env,*envloc,*envsys;
     
     num_cpus = 0;
     sys_cpus=0;
 
     /* explicit user declaration prevails */
 
     envsys=getenv("NUMBER_OF_CPUS");
     if(envsys){
     sys_cpus=atoi(envsys);
     if(sys_cpus<0) sys_cpus=0;
     }
 
     /* automatic detection of available number of processors */
 
     if(sys_cpus==0){
     sys_cpus = getSystemCPUs();
     if(sys_cpus<1) sys_cpus=1;
     }
 
     /* local declaration prevails, if strictly positive */
 
     envloc = getenv("CCX_NPROC_RESULTS");
     if(envloc){
     num_cpus=atoi(envloc);
     if(num_cpus<0){
         num_cpus=0;
     }else if(num_cpus>sys_cpus){
         num_cpus=sys_cpus;
     }
     
     }
 
     /* else global declaration, if any, applies */
 
     env = getenv("OMP_NUM_THREADS");
     if(num_cpus==0){
     if (env)
         num_cpus = atoi(env);
     if (num_cpus < 1) {
         num_cpus=1;
     }else if(num_cpus>sys_cpus){
         num_cpus=sys_cpus;
     }
     }
 
 // next line is to be inserted in a similar way for all other paralell parts
 
     if(*ne<num_cpus) num_cpus=*ne;
     
     pthread_t tid[num_cpus];
     
     /* 1. nodewise storage of the primary variables
        2. determination which derived variables have to be calculated */
 
     FORTRAN(resultsini,(nk,v,ithermal,filab,iperturb,f,fn,
        nactdof,iout,qa,vold,b,nodeboun,ndirboun,
        xboun,nboun,ipompc,nodempc,coefmpc,labmpc,nmpc,nmethod,cam,neq,
        veold,accold,bet,gam,dtime,mi,vini,nprint,prlab,
        &intpointvarm,&calcul_fn,&calcul_f,&calcul_qa,&calcul_cauchy,nener,
        &ikin,&intpointvart,xforc,nforc));
 
    /* next statement allows for storing the displacements in each
       iteration: for debugging purposes */
 
     if((strcmp1(&filab[3],"I")==0)&&(*iout==0)){
     FORTRAN(frditeration,(co,nk,kon,ipkon,lakon,ne,v,
         ttime,ielmat,matname,mi,istep,iinc,ithermal));
     }
 
     /* calculating the stresses and material tangent at the 
        integration points; calculating the internal forces */
 
     if(((ithermal[0]<=1)||(ithermal[0]>=3))&&(intpointvarm==1)){
 
     NNEW(fn1,double,num_cpus*mt**nk);
     NNEW(qa1,double,num_cpus*4);
     NNEW(nal,ITG,num_cpus);
 
     co1=co;kon1=kon;ipkon1=ipkon;lakon1=lakon;ne1=ne;v1=v;
         stx1=stx;elcon1=elcon;nelcon1=nelcon;rhcon1=rhcon;
         nrhcon1=nrhcon;alcon1=alcon;nalcon1=nalcon;alzero1=alzero;
         ielmat1=ielmat;ielorien1=ielorien;norien1=norien;orab1=orab;
         ntmat1_=ntmat_;t01=t0;t11=t1;ithermal1=ithermal;prestr1=prestr;
         iprestr1=iprestr;eme1=eme;iperturb1=iperturb;iout1=iout;
         vold1=vold;nmethod1=nmethod;veold1=veold;dtime1=dtime;
         time1=time;ttime1=ttime;plicon1=plicon;nplicon1=nplicon;
         plkcon1=plkcon;nplkcon1=nplkcon;xstateini1=xstateini;
         xstiff1=xstiff;xstate1=xstate;npmat1_=npmat_;matname1=matname;
         mi1=mi;ielas1=ielas;icmd1=icmd;ncmat1_=ncmat_;nstate1_=nstate_;
         stiini1=stiini;vini1=vini;ener1=ener;eei1=eei;enerini1=enerini;
         istep1=istep;iinc1=iinc;springarea1=springarea;reltime1=reltime;
         calcul_fn1=calcul_fn;calcul_qa1=calcul_qa;calcul_cauchy1=calcul_cauchy;
         nener1=nener;ikin1=ikin;mt1=mt;nk1=nk;ne01=ne0;thicke1=thicke;
         emeini1=emeini;pslavsurf1=pslavsurf;clearini1=clearini;
         pmastsurf1=pmastsurf;mortar1=mortar;ielprop1=ielprop;prop1=prop;
         kscale1=kscale;
 
     /* calculating the stresses */
     
     if(((*nmethod!=4)&&(*nmethod!=5))||(iperturb[0]>1)){
         printf(" Using up to %" ITGFORMAT " cpu(s) for the stress calculation.\n\n", num_cpus);
     }
     
     /* create threads and wait */
     
     NNEW(ithread,ITG,num_cpus);
     for(i=0; i<num_cpus; i++)  {
         ithread[i]=i;
         pthread_create(&tid[i], NULL, (void *)resultsmechmt, (void *)&ithread[i]);
     }
     for(i=0; i<num_cpus; i++)  pthread_join(tid[i], NULL);
     
     for(i=0;i<mt**nk;i++){
         fn[i]=fn1[i];
     }
     for(i=0;i<mt**nk;i++){
         for(j=1;j<num_cpus;j++){
         fn[i]+=fn1[i+j*mt**nk];
         }
     }
     SFREE(fn1);SFREE(ithread);
     
         /* determine the internal force */
 
     qa[0]=qa1[0];
     for(j=1;j<num_cpus;j++){
         qa[0]+=qa1[j*4];
     }
 
         /* determine the decrease of the time increment in case
            the material routine diverged */
 
     qa[2]=qa1[2];
         for(j=1;j<num_cpus;j++){
         if(qa1[2+j*4]>0.){
         if(qa[2]<0.){
             qa[2]=qa1[2+j*4];
         }else{
             if(qa1[2+j*4]<qa[2]){qa[2]=qa1[2+j*4];}
         }
         }
     }
 
         /* maximum change in creep strain increment in the
            present time increment */
 
     qa[3]=qa1[3];
         for(j=1;j<num_cpus;j++){
         if(qa1[3+j*4]>0.){
         if(qa[3]<0.){
             qa[3]=qa1[3+j*4];
         }else{
             if(qa1[3+j*4]>qa[3]){qa[3]=qa1[3+j*4];}
         }
         }
     }
 
     SFREE(qa1);
     
     for(j=1;j<num_cpus;j++){
         nal[0]+=nal[j];
     }
 
     if(calcul_qa==1){
         if(nal[0]>0){
         qa[0]/=nal[0];
         }
     }
     SFREE(nal);
     }
 
     /* calculating the thermal flux and material tangent at the 
        integration points; calculating the internal point flux */
 
     if((ithermal[0]>=2)&&(intpointvart==1)){
 
     NNEW(fn1,double,num_cpus*mt**nk);
     NNEW(qa1,double,num_cpus*4);
     NNEW(nal,ITG,num_cpus);
 
     co1=co;kon1=kon;ipkon1=ipkon;lakon1=lakon;v1=v;
         elcon1=elcon;nelcon1=nelcon;rhcon1=rhcon;nrhcon1=nrhcon;
     ielmat1=ielmat;ielorien1=ielorien;norien1=norien;orab1=orab;
         ntmat1_=ntmat_;t01=t0;iperturb1=iperturb;iout1=iout;vold1=vold;
         ipompc1=ipompc;nodempc1=nodempc;coefmpc1=coefmpc;nmpc1=nmpc;
         dtime1=dtime;time1=time;ttime1=ttime;plkcon1=plkcon;
         nplkcon1=nplkcon;xstateini1=xstateini;xstiff1=xstiff;
         xstate1=xstate;npmat1_=npmat_;matname1=matname;mi1=mi;
         ncmat1_=ncmat_;nstate1_=nstate_;cocon1=cocon;ncocon1=ncocon;
         qfx1=qfx;ikmpc1=ikmpc;ilmpc1=ilmpc;istep1=istep;iinc1=iinc;
         springarea1=springarea;calcul_fn1=calcul_fn;calcul_qa1=calcul_qa;
         mt1=mt;nk1=nk;shcon1=shcon;nshcon1=nshcon;ithermal1=ithermal;
         nelemload1=nelemload;nload1=nload;nmethod1=nmethod;reltime1=reltime;
         sideload1=sideload;xload1=xload;xloadold1=xloadold;
         pslavsurf1=pslavsurf;pmastsurf1=pmastsurf;mortar1=mortar;
         clearini1=clearini;plicon1=plicon;nplicon1=nplicon;ne1=ne;
         ielprop1=ielprop,prop1=prop;iponoel1=iponoel;inoel1=inoel;
     network1=network;ipobody1=ipobody;ibody1=ibody;xbody1=xbody;
 
     /* calculating the heat flux */
     
     printf(" Using up to %" ITGFORMAT " cpu(s) for the heat flux calculation.\n\n", num_cpus);
     
     /* create threads and wait */
     
     NNEW(ithread,ITG,num_cpus);
     for(i=0; i<num_cpus; i++)  {
         ithread[i]=i;
         pthread_create(&tid[i], NULL, (void *)resultsthermmt, (void *)&ithread[i]);
     }
     for(i=0; i<num_cpus; i++)  pthread_join(tid[i], NULL);
     
     for(i=0;i<*nk;i++){
         fn[mt*i]=fn1[mt*i];
     }
     for(i=0;i<*nk;i++){
         for(j=1;j<num_cpus;j++){
         fn[mt*i]+=fn1[mt*i+j*mt**nk];
         }
     }
     SFREE(fn1);SFREE(ithread);
     
         /* determine the internal concentrated heat flux */
 
     qa[1]=qa1[1];
     for(j=1;j<num_cpus;j++){
         qa[1]+=qa1[1+j*4];
     }
     
     SFREE(qa1);
     
     for(j=1;j<num_cpus;j++){
         nal[0]+=nal[j];
     }
 
     if(calcul_qa==1){
         if(nal[0]>0){
         qa[1]/=nal[0];
         }
     }
     SFREE(nal);
     }
 
     /* calculating the matrix system internal force vector */
 
     FORTRAN(resultsforc,(nk,f,fn,nactdof,ipompc,nodempc,
         coefmpc,labmpc,nmpc,mi,fmpc,&calcul_fn,&calcul_f));
 
     /* storing results in the .dat file
        extrapolation of integration point values to the nodes
        interpolation of 3d results for 1d/2d elements */
 
     FORTRAN(resultsprint,(co,nk,kon,ipkon,lakon,ne,v,stn,inum,
        stx,ielorien,norien,orab,t1,ithermal,filab,een,iperturb,fn,
        nactdof,iout,vold,nodeboun,ndirboun,nboun,nmethod,ttime,xstate,
        epn,mi,
        nstate_,ener,enern,xstaten,eei,set,nset,istartset,iendset,
        ialset,nprint,prlab,prset,qfx,qfn,trab,inotr,ntrans,
        nelemload,nload,&ikin,ielmat,thicke,eme,emn,rhcon,nrhcon,shcon,
        nshcon,cocon,ncocon,ntmat_,sideload,icfd,inomat,pslavsurf,islavact,
        cdn,mortar,islavnode,nslavnode,ntie,islavsurf,time,ielprop,prop,
        veold,ne0,nmpc,ipompc,nodempc,labmpc,energyini,energy,orname,
        xload));
   
   return;
 
 }

◆ results_se()

void results_se	(	double *	co,
		ITG *	nk,
		ITG *	kon,
		ITG *	ipkon,
		char *	lakon,
		ITG *	ne,
		double *	v,
		double *	stn,
		ITG *	inum,
		double *	stx,
		double *	elcon,
		ITG *	nelcon,
		double *	rhcon,
		ITG *	nrhcon,
		double *	alcon,
		ITG *	nalcon,
		double *	alzero,
		ITG *	ielmat,
		ITG *	ielorien,
		ITG *	norien,
		double *	orab,
		ITG *	ntmat_,
		double *	t0,
		double *	t1,
		ITG *	ithermal,
		double *	prestr,
		ITG *	iprestr,
		char *	filab,
		double *	eme,
		double *	emn,
		double *	een,
		ITG *	iperturb,
		double *	f,
		double *	fn,
		ITG *	nactdof,
		ITG *	iout,
		double *	qa,
		double *	vold,
		double *	b,
		ITG *	nodeboun,
		ITG *	ndirboun,
		double *	xboun,
		ITG *	nboun,
		ITG *	ipompc,
		ITG *	nodempc,
		double *	coefmpc,
		char *	labmpc,
		ITG *	nmpc,
		ITG *	nmethod,
		double *	vmax,
		ITG *	neq,
		double *	veold,
		double *	accold,
		double *	beta,
		double *	gamma,
		double *	dtime,
		double *	time,
		double *	ttime,
		double *	plicon,
		ITG *	nplicon,
		double *	plkcon,
		ITG *	nplkcon,
		double *	xstateini,
		double *	xstiff,
		double *	xstate,
		ITG *	npmat_,
		double *	epl,
		char *	matname,
		ITG *	mi,
		ITG *	ielas,
		ITG *	icmd,
		ITG *	ncmat_,
		ITG *	nstate_,
		double *	stiini,
		double *	vini,
		ITG *	ikboun,
		ITG *	ilboun,
		double *	ener,
		double *	enern,
		double *	emeini,
		double *	xstaten,
		double *	eei,
		double *	enerini,
		double *	cocon,
		ITG *	ncocon,
		char *	set,
		ITG *	nset,
		ITG *	istartset,
		ITG *	iendset,
		ITG *	ialset,
		ITG *	nprint,
		char *	prlab,
		char *	prset,
		double *	qfx,
		double *	qfn,
		double *	trab,
		ITG *	inotr,
		ITG *	ntrans,
		double *	fmpc,
		ITG *	nelemload,
		ITG *	nload,
		ITG *	ikmpc,
		ITG *	ilmpc,
		ITG *	istep,
		ITG *	iinc,
		double *	springarea,
		double *	reltime,
		ITG *	ne0,
		double *	xforc,
		ITG *	nforc,
		double *	thicke,
		double *	shcon,
		ITG *	nshcon,
		char *	sideload,
		double *	xload,
		double *	xloadold,
		ITG *	icfd,
		ITG *	inomat,
		double *	pslavsurf,
		double *	pmastsurf,
		ITG *	mortar,
		ITG *	islavact,
		double *	cdn,
		ITG *	islavnode,
		ITG *	nslavnode,
		ITG *	ntie,
		double *	clearini,
		ITG *	islavsurf,
		ITG *	ielprop,
		double *	prop,
		double *	energyini,
		double *	energy,
		double *	df,
		double *	distmin,
		ITG *	ndesi,
		ITG *	nodedesi,
		double *	sti,
		ITG *	nkon,
		ITG *	jqs,
		ITG *	irows,
		ITG *	nactdofinv,
		ITG *	icoordinate,
		double *	dxstiff,
		ITG *	istartdesi,
		ITG *	ialdesi,
		double *	xdesi,
		ITG *	ieigenfrequency,
		double *	fint,
		ITG *	ishapeenergy
	)

                          {
 
     ITG intpointvarm,calcul_fn,calcul_f,calcul_qa,calcul_cauchy,nener,ikin,
         intpointvart,mt=mi[1]+1,i,j,idesvar,iorien,idir,im,
         nea,neb;
     
     double *dfn=NULL,*fn0=NULL,a[9],pgauss[3],rotvec[3],orabsav[7];
 
     /* calculating the sensitivity of the internal forces */
       
     /* variables for multithreading procedure */
     
     ITG sys_cpus,*ithread=NULL;
     char *env,*envloc,*envsys;
     
     num_cpus = 0;
     sys_cpus=0;
 
     /* explicit user declaration prevails */
 
     envsys=getenv("NUMBER_OF_CPUS");
     if(envsys){
         sys_cpus=atoi(envsys);
         if(sys_cpus<0) sys_cpus=0;
     }
 
     /* automatic detection of available number of processors */
 
     if(sys_cpus==0){
         sys_cpus = getSystemCPUs();
         if(sys_cpus<1) sys_cpus=1;
     }
 
     /* local declaration prevails, if strictly positive */
 
     envloc = getenv("CCX_NPROC_RESULTS");
     if(envloc){
         num_cpus=atoi(envloc);
         if(num_cpus<0){
             num_cpus=0;
         }else if(num_cpus>sys_cpus){
             num_cpus=sys_cpus;
         }
         
     }
 
     /* else global declaration, if any, applies */
 
     env = getenv("OMP_NUM_THREADS");
     if(num_cpus==0){
         if (env)
             num_cpus = atoi(env);
         if (num_cpus < 1) {
             num_cpus=1;
         }else if(num_cpus>sys_cpus){
             num_cpus=sys_cpus;
         }
     }
 
 // next line is to be inserted in a similar way for all other paralell parts
 
     if(*ne<num_cpus) num_cpus=*ne;
     
     pthread_t tid[num_cpus];
     
     /* 1. nodewise storage of the primary variables
        2. determination which derived variables have to be calculated */
 
     FORTRAN(resultsini,(nk,v,ithermal,filab,iperturb,f,fn,
        nactdof,iout,qa,vold,b,nodeboun,ndirboun,
        xboun,nboun,ipompc,nodempc,coefmpc,labmpc,nmpc,nmethod,cam,neq,
        veold,accold,bet,gam,dtime,mi,vini,nprint,prlab,
        &intpointvarm,&calcul_fn,&calcul_f,&calcul_qa,&calcul_cauchy,&nener,
        &ikin,&intpointvart,xforc,nforc));
 
     NNEW(fn0,double,mt**nkon);
     NNEW(dfn,double,mt**nk);
         
     if(((*nmethod!=4)&&(*nmethod!=5))||(iperturb[0]>1)){
     printf(" Using up to %" ITGFORMAT " cpu(s) for the sensitivity of the internal forces.\n\n", num_cpus);
     }
 
     /* nodal forces without perturbation */
 
     idesvar=0;
     
     /* calculating the stresses and material tangent at the 
        integration points; calculating the internal forces */
     
     if(((ithermal[0]<=1)||(ithermal[0]>=3))&&(intpointvarm==1)){
     
     NNEW(fn01,double,num_cpus*mt**nkon);
     
     co1=co;kon1=kon;ipkon1=ipkon;lakon1=lakon;ne1=ne;v1=v;
     stx1=stx;elcon1=elcon;nelcon1=nelcon;rhcon1=rhcon;
     nrhcon1=nrhcon;alcon1=alcon;nalcon1=nalcon;alzero1=alzero;
     ielmat1=ielmat;ielorien1=ielorien;norien1=norien;orab1=orab;
     ntmat1_=ntmat_;t01=t0;t11=t1;ithermal1=ithermal;prestr1=prestr;
     iprestr1=iprestr;eme1=eme;iperturb1=iperturb;iout1=iout;
     vold1=vold;nmethod1=nmethod;veold1=veold;dtime1=dtime;
     time1=time;ttime1=ttime;plicon1=plicon;nplicon1=nplicon;
     plkcon1=plkcon;nplkcon1=nplkcon;xstateini1=xstateini;
     xstiff1=xstiff;xstate1=xstate;npmat1_=npmat_;matname1=matname;
     mi1=mi;ielas1=ielas;icmd1=icmd;ncmat1_=ncmat_;nstate1_=nstate_;
     stiini1=stiini;vini1=vini;ener1=ener;eei1=eei;enerini1=enerini;
     istep1=istep;iinc1=iinc;springarea1=springarea;reltime1=reltime;
     calcul_fn1=calcul_fn;calcul_cauchy1=calcul_cauchy;
     nener1=nener;ikin1=ikin;mt1=mt;nk1=nk;ne01=ne0;thicke1=thicke;
     emeini1=emeini;pslavsurf1=pslavsurf;clearini1=clearini;
     pmastsurf1=pmastsurf;mortar1=mortar;ielprop1=ielprop;prop1=prop;
     idesvar1=idesvar;nodedesi1=nodedesi;
     sti1=sti;nkon1=nkon;icoordinate1=icoordinate;
     dxstiff1=dxstiff;ialdesi1=ialdesi;xdesi1=xdesi;
     
     /* create threads and wait */
     
     NNEW(ithread,ITG,num_cpus);
     for(i=0; i<num_cpus; i++)  {
         ithread[i]=i;
         pthread_create(&tid[i], NULL, (void *)resultsmechmt_se, (void *)&ithread[i]);
     }
     for(i=0; i<num_cpus; i++)  pthread_join(tid[i], NULL);
     
     /* Assembling fn0 and dfn */
     
     for(i=0;i<mt**nkon;i++){
         fn0[i]=fn01[i];
     }
     for(i=0;i<mt**nkon;i++){
         for(j=1;j<num_cpus;j++){
         fn0[i]+=fn01[i+j*mt**nkon];
         }
     }
     
     SFREE(fn01);
     SFREE(ithread); 
     }
     
     /* in case of nonlinear geometry calculate vector fint */
     
     if((iperturb[1]==1)&&(*ishapeenergy==1)){
        FORTRAN(createfint,(ne,ipkon,lakon,kon,nactdof,mi,fn0,fint));
     }
     
     /* loop over the design variables (perturbation) */
     
     for(idesvar=1;idesvar<=*ndesi;idesvar++){
     
     DMEMSET(dfn,0,mt**nk,0.);
        
         /* calculate a delta in the orientation
            in case the material orientation is the design variable */
     
     if(*icoordinate!=1){
         iorien=(idesvar-1)/3;
         
         /* save nominal orientation */
         
         memcpy(&orabsav[0],&orab[7*iorien],sizeof(double)*7);
         
         /* calculate the transformation matrix */
         
         FORTRAN(transformatrix,(&orab[7*iorien],pgauss,a));
         
         /* calculate the rotation vector from the transformation matrix */
         
         FORTRAN(rotationvector,(a,rotvec));
         idir=(idesvar-1)-iorien*3;
         
         /* add a small variation to the rotation vector component */
         
         rotvec[idir]+=*distmin;
         
         /* determine the new transformation matrix */
         
         FORTRAN(rotationvectorinv,(a,rotvec));
         
         /* determine two new points in the x-y plane */
         
         for(i=0;i<6;i++){orab[7*iorien+i]=a[i];}
     }
     
     /* calculating the stresses and material tangent at the 
        integration points; calculating the internal forces */
     
     if(((ithermal[0]<=1)||(ithermal[0]>=3))&&(intpointvarm==1)){
         nea=istartdesi[idesvar-1];
         neb=istartdesi[idesvar]-1;
         
         FORTRAN(resultsmech_se,(co,kon,ipkon,lakon,ne,v,
         stx,elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,
         ielmat,ielorien,norien,orab,ntmat1_,t0,t1,ithermal,prestr,
         iprestr,eme,iperturb,fn,iout,vold,nmethod,
             veold,dtime,time,ttime,plicon,nplicon,plkcon,nplkcon,
                 xstateini,xstiff,xstate,npmat1_,matname,mi,ielas,icmd,
                 ncmat1_,nstate1_,stiini,vini,ener,eei,enerini,istep,iinc,
                 springarea,reltime,&calcul_fn,&calcul_cauchy,&nener,
                 &ikin,ne0,thicke,emeini,
                 pslavsurf,pmastsurf,mortar,clearini,&nea,&neb,ielprop,prop,
                 dfn,&idesvar,nodedesi,
             fn0,sti,icoordinate,dxstiff,ialdesi,xdesi));
     }
     
     /* calculating the matrix system internal force vector
            for nonlinear geometrical calculations */
     
 //  if((iperturb[1]==1)&&(*ieigenfrequency!=1)){
     if(*ieigenfrequency!=1){
        FORTRAN(resultsforc_se,(nk,dfn,nactdofinv,ipompc,nodempc,
                 coefmpc,nmpc,mi,fmpc,&calcul_fn,&calcul_f,
                 &idesvar,df,jqs,irows,distmin));
        }
        
         /* restoring the nominal orientation (in case the design variables
            are the orientations */
     
     if(*icoordinate!=1){
         if(idesvar>0){
         memcpy(&orab[7*iorien],&orabsav[0],sizeof(double)*7);
         }
     }
     
     }   /* end loop over design variables */
     
     
     SFREE(fn0);SFREE(dfn);
     
     return;
     
 }

◆ resultsemmt()

void* resultsemmt ( ITG * i )

                          {
 
     ITG nea,neb,nedelta;
 
     nedelta=(ITG)floor(*ne1/(double)num_cpus);
     nea=*i*nedelta+1;
     neb=(*i+1)*nedelta;
 // next line! -> all parallel sections
     if((*i==num_cpus-1)&&(neb<*ne1)) neb=*ne1;
 
     FORTRAN(resultsem,(co1,kon1,ipkon1,lakon1,v1,elcon1,nelcon1,ielmat1,
        ntmat1_,vini1,dtime1,matname1,mi1,ncmat1_,&nea,&neb,sti1,alcon1,
        nalcon1,h01,istartset1,iendset1,ialset1,iactive1,fn1));
 
     return NULL;
 }

◆ resultsinduction()

void resultsinduction	(	double *	co,
		ITG *	nk,
		ITG *	kon,
		ITG *	ipkon,
		char *	lakon,
		ITG *	ne,
		double *	v,
		double *	stn,
		ITG *	inum,
		double *	elcon,
		ITG *	nelcon,
		double *	rhcon,
		ITG *	nrhcon,
		double *	alcon,
		ITG *	nalcon,
		double *	alzero,
		ITG *	ielmat,
		ITG *	ielorien,
		ITG *	norien,
		double *	orab,
		ITG *	ntmat_,
		double *	t0,
		double *	t1,
		ITG *	ithermal,
		double *	prestr,
		ITG *	iprestr,
		char *	filab,
		double *	eme,
		double *	emn,
		double *	een,
		ITG *	iperturb,
		double *	f,
		double *	fn,
		ITG *	nactdof,
		ITG *	iout,
		double *	qa,
		double *	vold,
		double *	b,
		ITG *	nodeboun,
		ITG *	ndirboun,
		double *	xboun,
		ITG *	nboun,
		ITG *	ipompc,
		ITG *	nodempc,
		double *	coefmpc,
		char *	labmpc,
		ITG *	nmpc,
		ITG *	nmethod,
		double *	vmax,
		ITG *	neq,
		double *	veold,
		double *	accold,
		double *	beta,
		double *	gamma,
		double *	dtime,
		double *	time,
		double *	ttime,
		double *	plicon,
		ITG *	nplicon,
		double *	plkcon,
		ITG *	nplkcon,
		double *	xstateini,
		double *	xstiff,
		double *	xstate,
		ITG *	npmat_,
		double *	epl,
		char *	matname,
		ITG *	mi,
		ITG *	ielas,
		ITG *	icmd,
		ITG *	ncmat_,
		ITG *	nstate_,
		double *	sti,
		double *	vini,
		ITG *	ikboun,
		ITG *	ilboun,
		double *	ener,
		double *	enern,
		double *	emeini,
		double *	xstaten,
		double *	eei,
		double *	enerini,
		double *	cocon,
		ITG *	ncocon,
		char *	set,
		ITG *	nset,
		ITG *	istartset,
		ITG *	iendset,
		ITG *	ialset,
		ITG *	nprint,
		char *	prlab,
		char *	prset,
		double *	qfx,
		double *	qfn,
		double *	trab,
		ITG *	inotr,
		ITG *	ntrans,
		double *	fmpc,
		ITG *	nelemload,
		ITG *	nload,
		ITG *	ikmpc,
		ITG *	ilmpc,
		ITG *	istep,
		ITG *	iinc,
		double *	springarea,
		double *	reltime,
		ITG *	ne0,
		double *	xforc,
		ITG *	nforc,
		double *	thicke,
		double *	shcon,
		ITG *	nshcon,
		char *	sideload,
		double *	xload,
		double *	xloadold,
		ITG *	icfd,
		ITG *	inomat,
		double *	h0,
		ITG *	islavnode,
		ITG *	nslavnode,
		ITG *	ntie,
		ITG *	ielprop,
		double *	prop,
		ITG *	iactive,
		double *	energyini,
		double *	energy,
		ITG *	iponoel,
		ITG *	inoel,
		char *	orname,
		ITG *	network,
		ITG *	ipobody,
		double *	xbody,
		ITG *	ibody
	)

                                                           {
       
     /* variables for multithreading procedure */
     
     char *env,*envloc,*envsys;
 
     ITG intpointvarm,calcul_fn,calcul_f,calcul_qa,calcul_cauchy,nener,ikin,
         intpointvart,mt=mi[1]+1,i,j,*ithread=NULL,*islavsurf=NULL,
         sys_cpus,mortar=0,*islavact=NULL;
 
     double *pmastsurf=NULL,*clearini=NULL,*pslavsurf=NULL,*cdn=NULL;
 
     /*
 
      calculating integration point values (strains, stresses,
      heat fluxes, material tangent matrices and nodal forces)
 
      storing the nodal and integration point results in the
      .dat file
 
      iout=-2: v is assumed to be known and is used to
               calculate strains, stresses..., no result output
               corresponds to iout=-1 with in addition the
               calculation of the internal energy density
      iout=-1: v is assumed to be known and is used to
               calculate strains, stresses..., no result output;
               is used to take changes in SPC's and MPC's at the
               start of a new increment or iteration into account
      iout=0: v is calculated from the system solution
              and strains, stresses.. are calculated, no result output
      iout=1:  v is calculated from the system solution and strains,
               stresses.. are calculated, requested results output
      iout=2: v is assumed to be known and is used to 
              calculate strains, stresses..., requested results output */
     
     num_cpus=0;
     sys_cpus=0;
 
     /* explicit user declaration prevails */
 
     envsys=getenv("NUMBER_OF_CPUS");
     if(envsys){
     sys_cpus=atoi(envsys);
     if(sys_cpus<0) sys_cpus=0;
     }
 
     /* automatic detection of available number of processors */
 
     if(sys_cpus==0){
     sys_cpus = getSystemCPUs();
     if(sys_cpus<1) sys_cpus=1;
     }
 
     /* local declaration prevails, if strictly positive */
 
     envloc = getenv("CCX_NPROC_RESULTS");
     if(envloc){
     num_cpus=atoi(envloc);
     if(num_cpus<0){
         num_cpus=0;
     }else if(num_cpus>sys_cpus){
         num_cpus=sys_cpus;
     }
     
     }
 
     /* else global declaration, if any, applies */
 
     env = getenv("OMP_NUM_THREADS");
     if(num_cpus==0){
     if (env)
         num_cpus = atoi(env);
     if (num_cpus < 1) {
         num_cpus=1;
     }else if(num_cpus>sys_cpus){
         num_cpus=sys_cpus;
     }
     }
 
 // next line is to be inserted in a similar way for all other paralell parts
 
     if(*ne<num_cpus) num_cpus=*ne;
     
     pthread_t tid[num_cpus];
     
     /* 1. nodewise storage of the primary variables
        2. determination which derived variables have to be calculated */
 
     FORTRAN(resultsini_em,(nk,v,ithermal,filab,iperturb,f,fn,
        nactdof,iout,qa,b,nodeboun,ndirboun,
        xboun,nboun,ipompc,nodempc,coefmpc,labmpc,nmpc,nmethod,cam,neq,
        veold,dtime,mi,vini,nprint,prlab,
        &intpointvarm,&calcul_fn,&calcul_f,&calcul_qa,&calcul_cauchy,&nener,
        &ikin,&intpointvart,xforc,nforc));
 
     /* electromagnetic calculation is linear: should not be taken
        into account in the convergence check (only thermal part
        is taken into account) */
 
     cam[0]=0.;
 
     /* next statement allows for storing the displacements in each
       iteration: for debugging purposes */
 
     if((strcmp1(&filab[3],"I")==0)&&(*iout==0)){
     FORTRAN(frditeration,(co,nk,kon,ipkon,lakon,ne,v,
         ttime,ielmat,matname,mi,istep,iinc,ithermal));
     }
 
     /* calculating the stresses and material tangent at the 
        integration points; calculating the internal forces */
 
     if(((ithermal[0]<=1)||(ithermal[0]>=3))&&(intpointvarm==1)){
 
     co1=co;kon1=kon;ipkon1=ipkon;lakon1=lakon;v1=v;elcon1=elcon;
         nelcon1=nelcon;ielmat1=ielmat;ntmat1_=ntmat_;vini1=vini;dtime1=dtime;
         matname1=matname;mi1=mi;ncmat1_=ncmat_;sti1=sti;alcon1=alcon;
     nalcon1=nalcon;h01=h0;ne1=ne;istartset1=istartset;iendset1=iendset;
         ialset1=ialset;iactive1=iactive;fn1=fn;
 
     /* calculating the magnetic field */
     
     if(((*nmethod!=4)&&(*nmethod!=5))||(iperturb[0]>1)){
         printf(" Using up to %" ITGFORMAT " cpu(s) for the magnetic field calculation.\n\n", num_cpus);
     }
     
     /* create threads and wait */
     
     NNEW(ithread,ITG,num_cpus);
     for(i=0; i<num_cpus; i++)  {
         ithread[i]=i;
         pthread_create(&tid[i], NULL, (void *)resultsemmt, (void *)&ithread[i]);
     }
     for(i=0; i<num_cpus; i++)  pthread_join(tid[i], NULL);
     SFREE(ithread);
 
     qa[0]=0.;
     }
 
     /* calculating the thermal flux and material tangent at the 
        integration points; calculating the internal point flux */
 
     if((ithermal[0]>=2)&&(intpointvart==1)){
 
     NNEW(fn1,double,num_cpus*mt**nk);
     NNEW(qa1,double,num_cpus*4);
     NNEW(nal,ITG,num_cpus);
 
     co1=co;kon1=kon;ipkon1=ipkon;lakon1=lakon;v1=v;
         elcon1=elcon;nelcon1=nelcon;rhcon1=rhcon;nrhcon1=nrhcon;
     ielmat1=ielmat;ielorien1=ielorien;norien1=norien;orab1=orab;
         ntmat1_=ntmat_;t01=t0;iperturb1=iperturb;iout1=iout;vold1=vold;
         ipompc1=ipompc;nodempc1=nodempc;coefmpc1=coefmpc;nmpc1=nmpc;
         dtime1=dtime;time1=time;ttime1=ttime;plkcon1=plkcon;
         nplkcon1=nplkcon;xstateini1=xstateini;xstiff1=xstiff;
         xstate1=xstate;npmat1_=npmat_;matname1=matname;mi1=mi;
         ncmat1_=ncmat_;nstate1_=nstate_;cocon1=cocon;ncocon1=ncocon;
         qfx1=qfx;ikmpc1=ikmpc;ilmpc1=ilmpc;istep1=istep;iinc1=iinc;
         springarea1=springarea;calcul_fn1=calcul_fn;calcul_qa1=calcul_qa;
         mt1=mt;nk1=nk;shcon1=shcon;nshcon1=nshcon;ithermal1=ithermal;
         nelemload1=nelemload;nload1=nload;nmethod1=nmethod;reltime1=reltime;
         sideload1=sideload;xload1=xload;xloadold1=xloadold;
         pslavsurf1=pslavsurf;pmastsurf1=pmastsurf;mortar1=mortar;
         clearini1=clearini;plicon1=plicon;nplicon1=nplicon;ielprop1=ielprop;
         prop1=prop;iponoel1=iponoel;inoel1=inoel;network1=network;
         ipobody1=ipobody;ibody1=ibody;xbody1=xbody;
 
     /* calculating the heat flux */
     
     printf(" Using up to %" ITGFORMAT " cpu(s) for the heat flux calculation.\n\n", num_cpus);
     
     /* create threads and wait */
     
     NNEW(ithread,ITG,num_cpus);
     for(i=0; i<num_cpus; i++)  {
         ithread[i]=i;
         pthread_create(&tid[i], NULL, (void *)resultsthermemmt, (void *)&ithread[i]);
     }
     for(i=0; i<num_cpus; i++)  pthread_join(tid[i], NULL);
     
     for(i=0;i<*nk;i++){
         fn[mt*i]=fn1[mt*i];
     }
     for(i=0;i<*nk;i++){
         for(j=1;j<num_cpus;j++){
         fn[mt*i]+=fn1[mt*i+j*mt**nk];
         }
     }
     SFREE(fn1);SFREE(ithread);
     
         /* determine the internal concentrated heat flux */
 
     qa[1]=qa1[1];
     for(j=1;j<num_cpus;j++){
         qa[1]+=qa1[1+j*4];
     }
     
     SFREE(qa1);
     
     for(j=1;j<num_cpus;j++){
         nal[0]+=nal[j];
     }
 
     if(calcul_qa==1){
         if(nal[0]>0){
         qa[1]/=nal[0];
         }
     }
     SFREE(nal);
     }
 
     /* calculating the thermal internal forces */
 
     FORTRAN(resultsforc_em,(nk,f,fn,nactdof,ipompc,nodempc,
         coefmpc,labmpc,nmpc,mi,fmpc,&calcul_fn,&calcul_f,inomat));
 
     /* storing results in the .dat file
        extrapolation of integration point values to the nodes
        interpolation of 3d results for 1d/2d elements */
 
     FORTRAN(resultsprint,(co,nk,kon,ipkon,lakon,ne,v,stn,inum,
        sti,ielorien,norien,orab,t1,ithermal,filab,een,iperturb,fn,
        nactdof,iout,vold,nodeboun,ndirboun,nboun,nmethod,ttime,xstate,
        epn,mi,
        nstate_,ener,enern,xstaten,eei,set,nset,istartset,iendset,
        ialset,nprint,prlab,prset,qfx,qfn,trab,inotr,ntrans,
        nelemload,nload,&ikin,ielmat,thicke,eme,emn,rhcon,nrhcon,shcon,
        nshcon,cocon,ncocon,ntmat_,sideload,icfd,inomat,pslavsurf,islavact,
        cdn,&mortar,islavnode,nslavnode,ntie,islavsurf,time,ielprop,prop,
        veold,ne0,nmpc,ipompc,nodempc,labmpc,energyini,energy,orname,
        xload));
   
   return;
 
 }

◆ resultsmechmt()

void* resultsmechmt ( ITG * i )

                            {
 
     ITG indexfn,indexqa,indexnal,nea,neb,nedelta;
 
     indexfn=*i*mt1**nk1;
     indexqa=*i*4;
     indexnal=*i;
     
 // ceil -> floor
 
     nedelta=(ITG)floor(*ne1/(double)num_cpus);
     nea=*i*nedelta+1;
     neb=(*i+1)*nedelta;
 // next line! -> all parallel sections
     if((*i==num_cpus-1)&&(neb<*ne1)) neb=*ne1;
 
     FORTRAN(resultsmech,(co1,kon1,ipkon1,lakon1,ne1,v1,
           stx1,elcon1,nelcon1,rhcon1,nrhcon1,alcon1,nalcon1,alzero1,
           ielmat1,ielorien1,norien1,orab1,ntmat1_,t01,t11,ithermal1,prestr1,
           iprestr1,eme1,iperturb1,&fn1[indexfn],iout1,&qa1[indexqa],vold1,
           nmethod1,
           veold1,dtime1,time1,ttime1,plicon1,nplicon1,plkcon1,nplkcon1,
           xstateini1,xstiff1,xstate1,npmat1_,matname1,mi1,ielas1,icmd1,
           ncmat1_,nstate1_,stiini1,vini1,ener1,eei1,enerini1,istep1,iinc1,
           springarea1,reltime1,&calcul_fn1,&calcul_qa1,&calcul_cauchy1,nener1,
       &ikin1,&nal[indexnal],ne01,thicke1,emeini1,
       pslavsurf1,pmastsurf1,mortar1,clearini1,&nea,&neb,ielprop1,prop1,kscale1));
 
     return NULL;
 }

◆ resultsmechmt_se()

void* resultsmechmt_se ( ITG * i )

                               {
 
     ITG indexfn0,indexdfn,nea,neb,nedelta;
 
     if(idesvar1==0){
     indexfn0=*i*mt1**nkon1;
     indexdfn=0;
     }else{
     indexfn0=0;
     indexdfn=*i*mt1**nk1;
     }
     
 // ceil -> floor
 
     nedelta=(ITG)floor(*ne1/(double)num_cpus);
     nea=*i*nedelta+1;
     neb=(*i+1)*nedelta;
 // next line! -> all parallel sections
     if((*i==num_cpus-1)&&(neb<*ne1)) neb=*ne1;
 
     FORTRAN(resultsmech_se,(co1,kon1,ipkon1,lakon1,ne1,v1,
           stx1,elcon1,nelcon1,rhcon1,nrhcon1,alcon1,nalcon1,alzero1,
           ielmat1,ielorien1,norien1,orab1,ntmat1_,t01,t11,ithermal1,prestr1,
           iprestr1,eme1,iperturb1,fn1,iout1,vold1,
           nmethod1,
           veold1,dtime1,time1,ttime1,plicon1,nplicon1,plkcon1,nplkcon1,
           xstateini1,xstiff1,xstate1,npmat1_,matname1,mi1,ielas1,icmd1,
           ncmat1_,nstate1_,stiini1,vini1,ener1,eei1,enerini1,istep1,iinc1,
           springarea1,reltime1,&calcul_fn1,&calcul_cauchy1,&nener1,
           &ikin1,ne01,thicke1,emeini1,
           pslavsurf1,pmastsurf1,mortar1,clearini1,&nea,&neb,ielprop1,prop1,
           &dfn1[indexdfn],&idesvar1,nodedesi1,
       &fn01[indexfn0],sti1,icoordinate1,dxstiff1,ialdesi1,xdesi1));
 
     return NULL;
 }

◆ resultsmechmtstr()

void* resultsmechmtstr ( ITG * i )

                               {
 
     ITG indexfn,indexqa,indexnal,nea,neb,nedelta;
 
     indexfn=*i*mt1**nk1;
     indexqa=*i*4;
     indexnal=*i;
     
 // ceil -> floor
 
     nedelta=(ITG)floor(*ne1/(double)num_cpus);
     //nea=*i*nedelta+1;
     //neb=(*i+1)*nedelta;
     
     nea=neapar1[*i]+1;
     neb=nebpar1[*i]+1;
     
 // next line! -> all parallel sections
     if((*i==num_cpus-1)&&(neb<*ne1)) neb=*ne1;
 
     FORTRAN(resultsmech,(co1,kon1,ipkon1,lakon1,ne1,v1,
           stx1,elcon1,nelcon1,rhcon1,nrhcon1,alcon1,nalcon1,alzero1,
           ielmat1,ielorien1,norien1,orab1,ntmat1_,t01,t11,ithermal1,prestr1,
           iprestr1,eme1,iperturb1,&fn1[indexfn],iout1,&qa1[indexqa],vold1,
           nmethod1,
           veold1,dtime1,time1,ttime1,plicon1,nplicon1,plkcon1,nplkcon1,
           xstateini1,xstiff1,xstate1,npmat1_,matname1,mi1,ielas1,icmd1,
           ncmat1_,nstate1_,stiini1,vini1,ener1,eei1,enerini1,istep1,iinc1,
           springarea1,reltime1,&calcul_fn1,&calcul_qa1,&calcul_cauchy1,nener1,
       &ikin1,&nal[indexnal],ne01,thicke1,emeini1,
       pslavsurf1,pmastsurf1,mortar1,clearini1,&nea,&neb,ielprop1,prop1,kscale1));
 
     return NULL;
 }

◆ resultsstr()

void resultsstr	(	double *	co,
		ITG *	nk,
		ITG *	kon,
		ITG *	ipkon,
		char *	lakon,
		ITG *	ne,
		double *	v,
		double *	stn,
		ITG *	inum,
		double *	stx,
		double *	elcon,
		ITG *	nelcon,
		double *	rhcon,
		ITG *	nrhcon,
		double *	alcon,
		ITG *	nalcon,
		double *	alzero,
		ITG *	ielmat,
		ITG *	ielorien,
		ITG *	norien,
		double *	orab,
		ITG *	ntmat_,
		double *	t0,
		double *	t1,
		ITG *	ithermal,
		double *	prestr,
		ITG *	iprestr,
		char *	filab,
		double *	eme,
		double *	emn,
		double *	een,
		ITG *	iperturb,
		double *	f,
		double *	fn,
		ITG *	nactdof,
		ITG *	iout,
		double *	qa,
		double *	vold,
		double *	b,
		ITG *	nodeboun,
		ITG *	ndirboun,
		double *	xboun,
		ITG *	nboun,
		ITG *	ipompc,
		ITG *	nodempc,
		double *	coefmpc,
		char *	labmpc,
		ITG *	nmpc,
		ITG *	nmethod,
		double *	vmax,
		ITG *	neq,
		double *	veold,
		double *	accold,
		double *	beta,
		double *	gamma,
		double *	dtime,
		double *	time,
		double *	ttime,
		double *	plicon,
		ITG *	nplicon,
		double *	plkcon,
		ITG *	nplkcon,
		double *	xstateini,
		double *	xstiff,
		double *	xstate,
		ITG *	npmat_,
		double *	epl,
		char *	matname,
		ITG *	mi,
		ITG *	ielas,
		ITG *	icmd,
		ITG *	ncmat_,
		ITG *	nstate_,
		double *	stiini,
		double *	vini,
		ITG *	ikboun,
		ITG *	ilboun,
		double *	ener,
		double *	enern,
		double *	emeini,
		double *	xstaten,
		double *	eei,
		double *	enerini,
		double *	cocon,
		ITG *	ncocon,
		char *	set,
		ITG *	nset,
		ITG *	istartset,
		ITG *	iendset,
		ITG *	ialset,
		ITG *	nprint,
		char *	prlab,
		char *	prset,
		double *	qfx,
		double *	qfn,
		double *	trab,
		ITG *	inotr,
		ITG *	ntrans,
		double *	fmpc,
		ITG *	nelemload,
		ITG *	nload,
		ITG *	ikmpc,
		ITG *	ilmpc,
		ITG *	istep,
		ITG *	iinc,
		double *	springarea,
		double *	reltime,
		ITG *	ne0,
		double *	xforc,
		ITG *	nforc,
		double *	thicke,
		double *	shcon,
		ITG *	nshcon,
		char *	sideload,
		double *	xload,
		double *	xloadold,
		ITG *	icfd,
		ITG *	inomat,
		double *	pslavsurf,
		double *	pmastsurf,
		ITG *	mortar,
		ITG *	islavact,
		double *	cdn,
		ITG *	islavnode,
		ITG *	nslavnode,
		ITG *	ntie,
		double *	clearini,
		ITG *	islavsurf,
		ITG *	ielprop,
		double *	prop,
		double *	energyini,
		double *	energy,
		ITG *	kscale,
		ITG *	nener,
		char *	orname,
		ITG *	network,
		ITG *	neapar,
		ITG *	nebpar
	)

                                                          {
 
     ITG intpointvarm,calcul_fn,calcul_f,calcul_qa,calcul_cauchy,ikin,
         intpointvart,mt=mi[1]+1,i,j;
 
     /*
 
      calculating the stress integration point values
 
      iout=2: v is assumed to be known and is used to 
              calculate strains, stresses..., requested results output */
       
     /* variables for multithreading procedure */
     
     ITG sys_cpus,*ithread=NULL;
     char *env,*envloc,*envsys;
     
     num_cpus = 0;
     sys_cpus=0;
 
     /* explicit user declaration prevails */
 
     envsys=getenv("NUMBER_OF_CPUS");
     if(envsys){
     sys_cpus=atoi(envsys);
     if(sys_cpus<0) sys_cpus=0;
     }
 
     /* automatic detection of available number of processors */
 
     if(sys_cpus==0){
     sys_cpus = getSystemCPUs();
     if(sys_cpus<1) sys_cpus=1;
     }
 
     /* local declaration prevails, if strictly positive */
 
     envloc = getenv("CCX_NPROC_RESULTS");
     if(envloc){
     num_cpus=atoi(envloc);
     if(num_cpus<0){
         num_cpus=0;
     }else if(num_cpus>sys_cpus){
         num_cpus=sys_cpus;
     }
     
     }
 
     /* else global declaration, if any, applies */
 
     env = getenv("OMP_NUM_THREADS");
     if(num_cpus==0){
     if (env)
         num_cpus = atoi(env);
     if (num_cpus < 1) {
         num_cpus=1;
     }else if(num_cpus>sys_cpus){
         num_cpus=sys_cpus;
     }
     }
 
 // next line is to be inserted in a similar way for all other paralell parts
 
     if(*ne<num_cpus) num_cpus=*ne;
     
     pthread_t tid[num_cpus];
 
     /* setting the output variables */
 
     calcul_fn=0;
     calcul_f=0;
     calcul_qa=0;
     calcul_cauchy=1;
 
     qa[0]=0.e0;
     qa[1]=0.e0;
     intpointvarm=1;
     ikin=0;
 
     /* calculating the stresses and material tangent at the 
        integration points; calculating the internal forces */
 
     if(((ithermal[0]<=1)||(ithermal[0]>=3))&&(intpointvarm==1)){
 
     NNEW(fn1,double,num_cpus*mt**nk);
     NNEW(qa1,double,num_cpus*4);
     NNEW(nal,ITG,num_cpus);
 
     co1=co;kon1=kon;ipkon1=ipkon;lakon1=lakon;ne1=ne;v1=v;
         stx1=stx;elcon1=elcon;nelcon1=nelcon;rhcon1=rhcon;
         nrhcon1=nrhcon;alcon1=alcon;nalcon1=nalcon;alzero1=alzero;
         ielmat1=ielmat;ielorien1=ielorien;norien1=norien;orab1=orab;
         ntmat1_=ntmat_;t01=t0;t11=t1;ithermal1=ithermal;prestr1=prestr;
         iprestr1=iprestr;eme1=eme;iperturb1=iperturb;iout1=iout;
         vold1=vold;nmethod1=nmethod;veold1=veold;dtime1=dtime;
         time1=time;ttime1=ttime;plicon1=plicon;nplicon1=nplicon;
         plkcon1=plkcon;nplkcon1=nplkcon;xstateini1=xstateini;
         xstiff1=xstiff;xstate1=xstate;npmat1_=npmat_;matname1=matname;
         mi1=mi;ielas1=ielas;icmd1=icmd;ncmat1_=ncmat_;nstate1_=nstate_;
         stiini1=stiini;vini1=vini;ener1=ener;eei1=eei;enerini1=enerini;
         istep1=istep;iinc1=iinc;springarea1=springarea;reltime1=reltime;
         calcul_fn1=calcul_fn;calcul_qa1=calcul_qa;calcul_cauchy1=calcul_cauchy;
         nener1=nener;ikin1=ikin;mt1=mt;nk1=nk;ne01=ne0;thicke1=thicke;
         emeini1=emeini;pslavsurf1=pslavsurf;clearini1=clearini;
         pmastsurf1=pmastsurf;mortar1=mortar;ielprop1=ielprop;prop1=prop;
         kscale1=kscale;neapar1=neapar;
     nebpar1=nebpar;
 
     /* calculating the stresses */
     
     if(((*nmethod!=4)&&(*nmethod!=5))||(iperturb[0]>1)){
         printf(" Using up to %" ITGFORMAT " cpu(s) for the stress calculation.\n\n", num_cpus);
     }
     
     /* create threads and wait */
     
     NNEW(ithread,ITG,num_cpus);
     for(i=0; i<num_cpus; i++)  {
         ithread[i]=i;
         pthread_create(&tid[i], NULL, (void *)resultsmechmtstr, (void *)&ithread[i]);
     }
     for(i=0; i<num_cpus; i++)  pthread_join(tid[i], NULL);
     
     for(i=0;i<mt**nk;i++){
         fn[i]=fn1[i];
     }
     for(i=0;i<mt**nk;i++){
         for(j=1;j<num_cpus;j++){
         fn[i]+=fn1[i+j*mt**nk];
         }
     }
     SFREE(fn1);SFREE(ithread);
     
         /* determine the internal force */
 
     qa[0]=qa1[0];
     for(j=1;j<num_cpus;j++){
         qa[0]+=qa1[j*4];
     }
 
         /* determine the decrease of the time increment in case
            the material routine diverged */
 
         for(j=0;j<num_cpus;j++){
         if(qa1[2+j*4]>0.){
         if(qa[2]<0.){
             qa[2]=qa1[2+j*4];
         }else{
             if(qa1[2+j*4]<qa[2]){qa[2]=qa1[2+j*4];}
         }
         }
     }
 
     SFREE(qa1);
     
     for(j=1;j<num_cpus;j++){
         nal[0]+=nal[j];
     }
 
     if(calcul_qa==1){
         if(nal[0]>0){
         qa[0]/=nal[0];
         }
     }
     SFREE(nal);
     }
 
     /* storing results in the .dat file
        extrapolation of integration point values to the nodes
        interpolation of 3d results for 1d/2d elements */
 
     FORTRAN(resultsprint,(co,nk,kon,ipkon,lakon,ne,v,stn,inum,
        stx,ielorien,norien,orab,t1,ithermal,filab,een,iperturb,fn,
        nactdof,iout,vold,nodeboun,ndirboun,nboun,nmethod,ttime,xstate,
        epn,mi,
        nstate_,ener,enern,xstaten,eei,set,nset,istartset,iendset,
        ialset,nprint,prlab,prset,qfx,qfn,trab,inotr,ntrans,
        nelemload,nload,&ikin,ielmat,thicke,eme,emn,rhcon,nrhcon,shcon,
        nshcon,cocon,ncocon,ntmat_,sideload,icfd,inomat,pslavsurf,islavact,
        cdn,mortar,islavnode,nslavnode,ntie,islavsurf,time,ielprop,prop,
        veold,ne0,nmpc,ipompc,nodempc,labmpc,energyini,energy,orname,
        xload));
   
   return;
 
 }

◆ resultsthermemmt()

void* resultsthermemmt ( ITG * i )

                               {
 
     ITG indexfn,indexqa,indexnal,nea,neb,nedelta;
 
     indexfn=*i*mt1**nk1;
     indexqa=*i*4;
     indexnal=*i;
     
     nedelta=(ITG)floor(*ne1/(double)num_cpus);
     nea=*i*nedelta+1;
     neb=(*i+1)*nedelta;
     if((*i==num_cpus-1)&&(neb<*ne1)) neb=*ne1;
 
     FORTRAN(resultstherm,(co1,kon1,ipkon1,lakon1,v1,
        elcon1,nelcon1,rhcon1,nrhcon1,ielmat1,ielorien1,norien1,orab1,
        ntmat1_,t01,iperturb1,&fn1[indexfn],shcon1,nshcon1,
        iout1,&qa1[indexqa],vold1,ipompc1,nodempc1,coefmpc1,nmpc1,
            dtime1,time1,ttime1,plkcon1,nplkcon1,xstateini1,xstiff1,xstate1,
            npmat1_,
            matname1,mi1,ncmat1_,nstate1_,cocon1,ncocon1,
            qfx1,ikmpc1,ilmpc1,istep1,iinc1,springarea1,
        &calcul_fn1,&calcul_qa1,&nal[indexnal],&nea,&neb,ithermal1,
            nelemload1,nload1,nmethod1,reltime1,sideload1,xload1,xloadold1,
        pslavsurf1,pmastsurf1,&mortar1,clearini1,plicon1,nplicon1,
        ielprop1,prop1,iponoel1,inoel1,network1,ipobody1,xbody1,ibody1));
 
     return NULL;
 }

◆ resultsthermmt()

void* resultsthermmt ( ITG * i )

                             {
 
     ITG indexfn,indexqa,indexnal,nea,neb,nedelta;
 
     indexfn=*i*mt1**nk1;
     indexqa=*i*4;
     indexnal=*i;
     
     nedelta=(ITG)floor(*ne1/(double)num_cpus);
     nea=*i*nedelta+1;
     neb=(*i+1)*nedelta;
     if((*i==num_cpus-1)&&(neb<*ne1)) neb=*ne1;
 
     FORTRAN(resultstherm,(co1,kon1,ipkon1,lakon1,v1,
        elcon1,nelcon1,rhcon1,nrhcon1,ielmat1,ielorien1,norien1,orab1,
        ntmat1_,t01,iperturb1,&fn1[indexfn],shcon1,nshcon1,
        iout1,&qa1[indexqa],vold1,ipompc1,nodempc1,coefmpc1,nmpc1,
            dtime1,time1,ttime1,plkcon1,nplkcon1,xstateini1,xstiff1,xstate1,
            npmat1_,matname1,mi1,ncmat1_,nstate1_,cocon1,ncocon1,
            qfx1,ikmpc1,ilmpc1,istep1,iinc1,springarea1,
        &calcul_fn1,&calcul_qa1,&nal[indexnal],&nea,&neb,ithermal1,
        nelemload1,nload1,nmethod1,reltime1,sideload1,xload1,xloadold1,
        pslavsurf1,pmastsurf1,mortar1,clearini1,plicon1,nplicon1,ielprop1,
        prop1,iponoel1,inoel1,network1,ipobody1,xbody1,ibody1));
 
     return NULL;
 }

◆ resultsthermmt_se()

void* resultsthermmt_se ( ITG * i )

◆ rhspmain()

void rhspmain	(	ITG *	ne,
		char *	lakon,
		ITG *	ipnei,
		ITG *	neifa,
		ITG *	neiel,
		double *	vfa,
		double *	area,
		double *	adfa,
		double *	xlet,
		double *	cosa,
		double *	volume,
		double *	au,
		double *	ad,
		ITG *	jq,
		ITG *	irow,
		double *	ap,
		ITG *	ielfa,
		ITG *	ifabou,
		double *	xle,
		double *	b,
		double *	xxn,
		ITG *	neq,
		ITG *	nzs,
		double *	hfa,
		double *	gradpel,
		double *	bp,
		double *	xxi,
		ITG *	neij,
		double *	xlen,
		ITG *	iatleastonepressurebc,
		double *	xxicn
	)

                                                   {
 
     ITG i,j;
       
     /* variables for multithreading procedure */
     
     ITG sys_cpus,*ithread=NULL;
     char *env,*envloc,*envsys;
 
     num_cpus = 0;
     sys_cpus=0;
 
     /* explicit user declaration prevails */
 
     envsys=getenv("NUMBER_OF_CPUS");
     if(envsys){
     sys_cpus=atoi(envsys);
     if(sys_cpus<0) sys_cpus=0;
     }
 
     /* automatic detection of available number of processors */
 
     if(sys_cpus==0){
     sys_cpus = getSystemCPUs();
     if(sys_cpus<1) sys_cpus=1;
     }
 
     /* local declaration prevails, if strictly positive */
 
     envloc = getenv("CCX_NPROC_CFD");
     if(envloc){
     num_cpus=atoi(envloc);
     if(num_cpus<0){
         num_cpus=0;
     }else if(num_cpus>sys_cpus){
         num_cpus=sys_cpus;
     }
     
     }
 
     /* else global declaration, if any, applies */
 
     env = getenv("OMP_NUM_THREADS");
     if(num_cpus==0){
     if (env)
         num_cpus = atoi(env);
     if (num_cpus < 1) {
         num_cpus=1;
     }else if(num_cpus>sys_cpus){
         num_cpus=sys_cpus;
     }
     }
 
 // next line is to be inserted in a similar way for all other paralell parts
 
     if(*nef<num_cpus) num_cpus=*nef;
     
     pthread_t tid[num_cpus];
 
     /* calculating the stiffness and/or mass matrix 
        (symmetric part) */
 
     nef1=nef;lakonf1=lakonf;ipnei1=ipnei;neifa1=neifa;neiel1=neiel;
     vfa1=vfa;area1=area;advfa1=advfa;xlet1=xlet,cosa1=cosa;volume1=volume;
     jq1=jq;irow1=irow;ap1=ap;ielfa1=ielfa;ifabou1=ifabou;xle1=xle;
     xxn1=xxn;neq1=neq;nzs1=nzs;hfa1=hfa;gradpel1=gradpel;bp1=bp;xxi1=xxi;
     neij1=neij;xlen1=xlen;ad1=ad;au1=au;b1=b;xxicn1=xxicn;
     
     /* create threads and wait */
     
     NNEW(ithread,ITG,num_cpus);
     for(i=0; i<num_cpus; i++)  {
     ithread[i]=i;
     pthread_create(&tid[i], NULL, (void *)rhspmt, (void *)&ithread[i]);
     }
     for(i=0; i<num_cpus; i++)  pthread_join(tid[i], NULL);
     
     SFREE(ithread);
 
 /*  at least one pressure bc is needed. If none is applied,
     the last dof is set to 0 
 
      a pressure bc is only recognized if not all velocity degrees of
      freedom are prescribed on the same face */
 
     if(*iatleastonepressurebc==0) b[*nef-1]=0.;
   
   return;
 
 }

◆ rhspmt()

void* rhspmt ( ITG * i )

                     {
 
     ITG indexad,indexb,nefa,nefb,nefdelta;
     long long indexau;
 
     indexad=*i**neq1;
     indexau=(long long)*i**nzs1;
     indexb=*i**neq1;
     
 // ceil -> floor
 
     nefdelta=(ITG)floor(*nef1/(double)num_cpus);
     nefa=*i*nefdelta+1;
     nefb=(*i+1)*nefdelta;
 // next line! -> all parallel sections
     if((*i==num_cpus-1)&&(nefb<*nef1)) nefb=*nef1;
 
     FORTRAN(rhsp,(nef1,lakonf1,ipnei1,neifa1,neiel1,vfa1,area1,
           advfa1,xlet1,cosa1,volume1,au1,ad1,
           jq1,irow1,ap1,ielfa1,ifabou1,xle1,b1,xxn1,
           neq1,nzs1,
           hfa1,gradpel1,bp1,xxi1,neij1,xlen1,&nefa,&nefb,
           xxicn1));
 
     return NULL;
 }

◆ sensitivity()

void sensitivity	(	double *	co,
		ITG *	nk,
		ITG **	konp,
		ITG **	ipkonp,
		char **	lakonp,
		ITG *	ne,
		ITG *	nodeboun,
		ITG *	ndirboun,
		double *	xboun,
		ITG *	nboun,
		ITG *	ipompc,
		ITG *	nodempc,
		double *	coefmpc,
		char *	labmpc,
		ITG *	nmpc,
		ITG *	nodeforc,
		ITG *	ndirforc,
		double *	xforc,
		ITG *	nforc,
		ITG *	nelemload,
		char *	sideload,
		double *	xload,
		ITG *	nload,
		ITG *	nactdof,
		ITG *	icol,
		ITG *	jq,
		ITG **	irowp,
		ITG *	neq,
		ITG *	nzl,
		ITG *	nmethod,
		ITG *	ikmpc,
		ITG *	ilmpc,
		ITG *	ikboun,
		ITG *	ilboun,
		double *	elcon,
		ITG *	nelcon,
		double *	rhcon,
		ITG *	nrhcon,
		double *	alcon,
		ITG *	nalcon,
		double *	alzero,
		ITG **	ielmatp,
		ITG **	ielorienp,
		ITG *	norien,
		double *	orab,
		ITG *	ntmat_,
		double *	t0,
		double *	t1,
		double *	t1old,
		ITG *	ithermal,
		double *	prestr,
		ITG *	iprestr,
		double *	vold,
		ITG *	iperturb,
		double *	sti,
		ITG *	nzs,
		ITG *	kode,
		char *	filab,
		double *	eme,
		ITG *	iexpl,
		double *	plicon,
		ITG *	nplicon,
		double *	plkcon,
		ITG *	nplkcon,
		double **	xstatep,
		ITG *	npmat_,
		char *	matname,
		ITG *	isolver,
		ITG *	mi,
		ITG *	ncmat_,
		ITG *	nstate_,
		double *	cs,
		ITG *	mcs,
		ITG *	nkon,
		double **	enerp,
		double *	xbounold,
		double *	xforcold,
		double *	xloadold,
		char *	amname,
		double *	amta,
		ITG *	namta,
		ITG *	nam,
		ITG *	iamforc,
		ITG *	iamload,
		ITG *	iamt1,
		ITG *	iamboun,
		double *	ttime,
		char *	output,
		char *	set,
		ITG *	nset,
		ITG *	istartset,
		ITG *	iendset,
		ITG *	ialset,
		ITG *	nprint,
		char *	prlab,
		char *	prset,
		ITG *	nener,
		double *	trab,
		ITG *	inotr,
		ITG *	ntrans,
		double *	fmpc,
		char *	cbody,
		ITG *	ibody,
		double *	xbody,
		ITG *	nbody,
		double *	xbodyold,
		double *	timepar,
		double *	thicke,
		char *	jobnamec,
		char *	tieset,
		ITG *	ntie,
		ITG *	istep,
		ITG *	nmat,
		ITG *	ielprop,
		double *	prop,
		char *	typeboun,
		ITG *	mortar,
		ITG *	mpcinfo,
		double *	tietol,
		ITG *	ics,
		ITG *	icontact,
		ITG *	nobject,
		char **	objectsetp,
		ITG *	istat,
		char *	orname,
		ITG *	nzsfreq,
		ITG *	nlabel,
		double *	physcon,
		char *	jobnamef
	)

                                                                      {
   
     char description[13]="            ",*lakon=NULL,cflag[1]=" ",fneig[132]="",
     stiffmatrix[132]="",*lakonfa=NULL,*objectset=NULL;
        
     ITG *inum=NULL,k,*irow=NULL,ielas=0,icmd=0,iinc=1,nasym=0,
       mass[2]={0,0},stiffness=1,buckling=0,rhsi=1,intscheme=0,*ncocon=NULL,
       *nshcon=NULL,mode=-1,noddiam=-1,*ipobody=NULL,inewton=0,coriolis=0,iout,
       ifreebody,*itg=NULL,ntg=0,ngraph=1,mt=mi[1]+1,ne0,*integerglob=NULL,      
       icfd=0,*inomat=NULL,*islavact=NULL,*islavnode=NULL,*nslavnode=NULL,
       *islavsurf=NULL,nmethodl,*kon=NULL,*ipkon=NULL,*ielmat=NULL,nzss,
       *mast1=NULL,*irows=NULL,*icols=NULL,*jqs=NULL,*ipointer=NULL,i,
       *nactdofinv=NULL,*nodorig=NULL,ndesi,iobject,*iponoel=NULL,node,
       *nodedesi=NULL,*ipoface=NULL,*nodface=NULL,*inoel=NULL,*ipoorel=NULL,
       icoordinate=0,iorientation=0,ishapeenergy=0,imass=0,idisplacement=0,
       *istartdesi=NULL,*ialdesi=NULL,*iorel=NULL,*ipoeldi=NULL,*ieldi=NULL,
       *istartelem=NULL,*ialelem=NULL,ieigenfrequency=0,cyclicsymmetry=0,
       nherm,nev,iev,inoelsize,*itmp=NULL,nmd,nevd,*nm=NULL,*ielorien=NULL,
       igreen=0,iglob=0,idesvar=0,inorm=0,irand=0,*nodedesiinv=NULL,
       *nnodes=NULL,index,noregion=0,*konfa=NULL,*ipkonfa=NULL,nsurfs,
       *iponor=NULL,*iponoelfa=NULL,*inoelfa=NULL,ithickness,nactive=0,nnlconst,
       *ipoacti=NULL;
       
   double *stn=NULL,*v=NULL,*een=NULL,cam[5],*xstiff=NULL,*stiini=NULL,*tper,
          *f=NULL,*fn=NULL,qa[4],*epn=NULL,*xstateini=NULL,*xdesi=NULL,
          *vini=NULL,*stx=NULL,*enern=NULL,*xbounact=NULL,*xforcact=NULL,
          *xloadact=NULL,*t1act=NULL,*ampli=NULL,*xstaten=NULL,*eei=NULL,
          *enerini=NULL,*cocon=NULL,*shcon=NULL,*qfx=NULL,
          *qfn=NULL,*cgr=NULL,*xbodyact=NULL,*springarea=NULL,*emn=NULL,         
          *clearini=NULL,ptime=0.,*emeini=NULL,*doubleglob=NULL,*au=NULL,
          *ad=NULL,*b=NULL,*aub=NULL,*adb=NULL,*pslavsurf=NULL,
          *pmastsurf=NULL,*cdn=NULL,*xstate=NULL,*fnext=NULL,*energyini=NULL,
          *energy=NULL,*ener=NULL,*dxstiff=NULL,*d=NULL,*z=NULL,
          distmin,*df=NULL,*g0=NULL,*dgdx=NULL,sigma=0,*xinterpol=NULL,
          *dgdxglob=NULL,*extnor=NULL,*veold=NULL,*accold=NULL,bet,gam,
          dtime,time,reltime=1.,*weightformgrad=NULL,*fint=NULL,*xnor=NULL;
 
   FILE *f1;
   
 #ifdef SGI
   ITG token;
 #endif
 
   irow=*irowp;ener=*enerp;xstate=*xstatep;ipkon=*ipkonp;lakon=*lakonp;
   kon=*konp;ielmat=*ielmatp;ielorien=*ielorienp;objectset=*objectsetp;
 
   tper=&timepar[1];
 
   time=*tper;
   dtime=*tper;
 
   ne0=*ne;
 
   /* determining the global values to be used as boundary conditions
      for a submodel */
 
   getglobalresults(jobnamec,&integerglob,&doubleglob,nboun,iamboun,xboun,
            nload,sideload,iamload,&iglob,nforc,iamforc,xforc,
                    ithermal,nk,t1,iamt1);
   
   /* check which design variables are active */
   
   for(i=0;i<*ntie;i++){
       if(strcmp1(&tieset[i*243+80],"D")==0){
       if(strcmp1(&tieset[i*243],"COORDINATE")==0){
           icoordinate=1;
           if(strcmp1(&tieset[i*243],"COORDINATENOREGION")==0){noregion=1;}
           break;
       }else if(strcmp1(&tieset[i*243],"ORIENTATION")==0){
           if(*norien==0){
           printf(" *ERROR in sensitivity: the ORIENTATION sensitivity was requested,\n");
           printf("        yet no orientations were defined.\n");
           FORTRAN(stop,());
           }
           iorientation=1;
           break;
       }
       }
   }
   
   /* check which targets are active */
   
   for(i=0;i<*nobject;i++){
       if(strcmp1(&objectset[i*324],"DISPLACEMENT")==0){
       idisplacement=1;
       }else if(strcmp1(&objectset[i*324],"EIGENFREQUENCY")==0){
       ieigenfrequency=1;
       }else if(strcmp1(&objectset[i*324],"GREEN")==0){
       ieigenfrequency=1;
       igreen=1;
       }else if(strcmp1(&objectset[i*324],"MASS")==0){
       imass=1;
       }else if(strcmp1(&objectset[i*324],"SHAPEENERGY")==0){
       ishapeenergy=1;
       }else if(strcmp1(&objectset[i*324],"STRESS")==0){
       idisplacement=1;
       }else if(strcmp1(&objectset[i*324],"THICKNESS")==0){
       ithickness=1;
       }
   }
 
   /* EIGENFREQUENCY as objective should not be used with any
      other objective in the same step */
 
   if(((idisplacement==1)||(imass==1)||(ishapeenergy==1))&&
      (ieigenfrequency==1)){
       printf(" *ERROR in sensitivity: the objective EIGENFREQUENCY\n");
       printf("        cannot be used with any other objective within\n");
       printf("        the same step\n");
       exit(0);
   }
 
   if(ishapeenergy==1){
       NNEW(enerini,double,mi[0]**ne);
       NNEW(emeini,double,6*mi[0]**ne); 
       NNEW(stiini,double,6*mi[0]**ne); 
       
       memcpy(&enerini[0],&ener[0],sizeof(double)*mi[0]**ne);
       memcpy(&emeini[0],&eme[0],sizeof(double)*6*mi[0]**ne);
       memcpy(&stiini[0],&sti[0],sizeof(double)*6*mi[0]**ne);
   }
 
   if(ieigenfrequency==1){
 
       /* opening the eigenvalue file and checking for cyclic symmetry */
       
       strcpy(fneig,jobnamec);
       strcat(fneig,".eig");
       
       if((f1=fopen(fneig,"rb"))==NULL){
       printf(" *ERROR in sensitivity: cannot open eigenvalue file for reading");
       printf(" *INFO  in sensitivity: if there are problems reading the .eig file this may be due to:\n");
       printf("        1) the nonexistence of the .eig file\n");
       printf("        2) other boundary conditions than in the input deck\n");
       printf("           which created the .eig file\n\n");
       exit(0);
       }
       
       if(fread(&cyclicsymmetry,sizeof(ITG),1,f1)!=1){
       printf(" *ERROR in sensitivity reading the cyclic symmetry flag in the eigenvalue file");
       printf(" *INFO  in sensitivity: if there are problems reading the .eig file this may be due to:\n");
       printf("        1) the nonexistence of the .eig file\n");
       printf("        2) other boundary conditions than in the input deck\n");
       printf("           which created the .eig file\n\n");
       exit(0);
       }
       
       if(fread(&nherm,sizeof(ITG),1,f1)!=1){
       printf(" *ERROR in sensitivity reading the Hermitian flag in the eigenvalue file");
       printf(" *INFO  in sensitivity: if there are problems reading the .eig file this may be due to:\n");
       printf("        1) the nonexistence of the .eig file\n");
       printf("        2) other boundary conditions than in the input deck\n");
       printf("           which created the .eig file\n\n");
       exit(0);
       }
       
       if(nherm!=1){
       printf(" *ERROR in sensitivity: the eigenvectors in the .eig-file result\n");
       printf("       from a non-Hermitian eigenvalue problem. The \n");
       printf("       sensitivity procedure cannot handle that yet\n\n");
       FORTRAN(stop,());
       }
   }
 
   /* determining the elements belonging to a given node */
   
   NNEW(iponoel,ITG,*nk);
   NNEW(inoel,ITG,2**nkon);
   FORTRAN(elementpernode,(iponoel,inoel,lakon,ipkon,kon,ne,&inoelsize));
 
   if(icoordinate==1){
      
       /* find the external surfaces */
 
       NNEW(ipoface,ITG,*nk);
       NNEW(nodface,ITG,5*6**ne);
       NNEW(konfa,ITG,8*6**ne);
       NNEW(ipkonfa,ITG,6**ne);
       NNEW(lakonfa,char,8*6**ne);
       NNEW(iponoelfa,ITG,*nk);
       NNEW(inoelfa,ITG,3*8*6**ne);
       
       FORTRAN(findsurface_se,(nodface,ipoface,ne,ipkon,lakon,kon,
                               konfa,ipkonfa,nk,lakonfa,&nsurfs));
       
       FORTRAN(facepernode,(iponoelfa,inoelfa,lakonfa,ipkonfa,konfa,
                               &nsurfs,&inoelsize));
       
       RENEW(konfa,ITG,8*nsurfs);
       RENEW(ipkonfa,ITG,nsurfs);
       RENEW(lakonfa,char,8*nsurfs);
       
       /* determining the information of the designvariable set */
       
       NNEW(nodedesi,ITG,*nk);
       NNEW(itmp,ITG,*nk);
       NNEW(nodedesiinv,ITG,*nk);
       
       FORTRAN(getdesiinfo,(set,istartset,iendset,ialset,nset,
                mi,nactdof,&ndesi,nodedesi,ntie,tieset,
                            itmp,nmpc,nodempc,ipompc,nodedesiinv,
                            iponoel,inoel,lakon,ipkon,
                kon,&noregion,ipoface,nodface,nk));  
       
       SFREE(itmp);
       RENEW(nodedesi,ITG,ndesi);
 
       /* storing the elements to which each design variable belongs
          in field ialdesi */
 
       NNEW(istartdesi,ITG,ndesi+1);
       NNEW(ialdesi,ITG,*nkon);
       FORTRAN(createialdesi,(&ndesi,nodedesi,iponoel,inoel,
                  istartdesi,ialdesi,lakon,ipkon,kon,
                              nodedesiinv,&icoordinate,&noregion));
       RENEW(ialdesi,ITG,istartdesi[ndesi]-1);
             
       /* calculating the normal direction for every designvariable */
       
       NNEW(extnor,double,3**nk);
       
       FORTRAN(normalsonsurface_se,(ipkon,kon,lakon,extnor,co,nk,ipoface,
                    nodface,nactdof,mi,nodedesiinv,&noregion)); 
       
       /* if the sensitivity calculation is used in a optimization script
          this script usually contains a loop consisting of:
          1. a call to CalculiX to define the sensitivities
          2. a small modification of the surface geometry in a direction which
             decrease the objective function (only the design variables)
          3. a modification of the internal mesh in order to preserve
             mesh quality
          The latter point can be done by performing a linear elastic
          calculation in which the small modification in 2. is applied
          a *boundary condition and all other nodes (on the external 
          surface but no design variables) are fixed by *equation's
          in a direction normal to the surface. At corners and edges
          there my be more than one normal. The necessary equations are
          calculated in normalsforeq_se.f and stored in jobname.equ */
 
       NNEW(iponor,ITG,8*nsurfs);
       for(i=0;i<8*nsurfs;i++) iponor[i]=-1;
       NNEW(xnor,double,24*nsurfs);
       
       FORTRAN(normalsforequ_se,(nk,co,iponoelfa,inoelfa,konfa,ipkonfa,lakonfa,
                                 &nsurfs,iponor,xnor,nodedesiinv,jobnamef));
       
       SFREE(konfa);SFREE(ipkonfa);SFREE(lakonfa);SFREE(iponor);SFREE(xnor);
       SFREE(iponoelfa);SFREE(inoelfa);
       
       /* createinum is called in order to determine the nodes belonging
      to elements; this information is needed in frd_se */
       
       NNEW(inum,ITG,*nk);
       FORTRAN(createinum,(ipkon,inum,kon,lakon,nk,ne,&cflag[0],nelemload,
           nload,nodeboun,nboun,ndirboun,ithermal,co,vold,mi,ielmat));
                        
       /* storing the normal information in the frd-file for the optimizer */
           
       ++*kode;
 
       inorm=1;
       frd_sen(co,nk,stn,inum,nmethod,kode,filab,&ptime,nstate_,
           istep,
           &iinc,&mode,&noddiam,description,mi,&ngraph,ne,cs,set,nset,
           istartset,iendset,ialset,jobnamec,output,
           extnor,&iobject,objectset,ntrans,inotr,trab,&idesvar,orname,
           &icoordinate,&inorm,&irand); 
       inorm=0;
 
       /* storing the normal direction for every design variable */
 
       NNEW(xdesi,double,3*ndesi);
       for(k=0;k<ndesi;k++){
       node=nodedesi[k]-1;
       memcpy(&xdesi[3*k],&extnor[3*node],sizeof(double)*3);
       }
       
       /* calculation of the smallest distance between nodes */
       
       FORTRAN(smalldist,(co,&distmin,lakon,ipkon,kon,ne));
 
       /* resizing xdesi to a length of distmin */
 
       for(k=0;k<3*ndesi;k++){
       xdesi[k]*=distmin;
       }
 
       /* calculation of gaussian r fields for robust optimization */
       
       if(physcon[10]>0){      
      
          randomfieldmain(kon,ipkon,lakon,ne,nmpc,nactdof,mi,nodedesi,&ndesi,
             istartdesi,ialdesi,co,physcon,isolver,ntrans,nk,inotr,trab,jobnamec,
         nboun,cs,mcs,inum,nmethod,kode,filab,nstate_,istep,description,set,
         nset,iendset,output,istartset,ialset,extnor); 
                        
       }
 
       SFREE(inum);SFREE(extnor);      
 
   }else if(iorientation==1){
       ndesi=3**norien;
       distmin=1.e-3;
 
       /* writing the design variables into the dat-file */
 
       FORTRAN(writedesi,(norien,orname));
 
       /* storing the elements with a given orientation in
          ipoorel and iorel */
 
       NNEW(ipoorel,ITG,*norien);
       NNEW(iorel,ITG,2**ne);
       FORTRAN(elementperorien,(ipoorel,iorel,ielorien,ne,mi));
 
       /* storing the orientation of the design variables
          in nodedesi (per orientation there are three design
          variables - the Euler angles) */
 
       NNEW(nodedesi,ITG,ndesi);
       for(i=0;i<ndesi;i++){
       nodedesi[i]=i/3+1;
       }
 
       /* storing the elements corresponding with a given
          design variable in istartdesi and ialdesi */
 
       NNEW(istartdesi,ITG,ndesi+1);
       NNEW(ialdesi,ITG,3**ne);
       FORTRAN(createialdesi,(&ndesi,nodedesi,ipoorel,iorel,
                  istartdesi,ialdesi,lakon,ipkon,kon,
                              nodedesiinv,&icoordinate,&noregion));
       SFREE(ipoorel);SFREE(iorel);SFREE(nodedesi);
       RENEW(ialdesi,ITG,istartdesi[ndesi]-1);
 
   }
 
   /* allocating fields for the actual external loading */
 
   NNEW(xbounact,double,*nboun);
   for(k=0;k<*nboun;++k){xbounact[k]=xbounold[k];}
   NNEW(xforcact,double,*nforc);
   NNEW(xloadact,double,2**nload);
   NNEW(xbodyact,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){
     NNEW(t1act,double,*nk);
     for(k=0;k<*nk;++k){t1act[k]=t1old[k];}
   }
   
   /* assigning the body forces to the elements */ 
 
   if(*nbody>0){
       ifreebody=*ne+1;
       NNEW(ipobody,ITG,2*ifreebody**nbody);
       for(k=1;k<=*nbody;k++){
           FORTRAN(bodyforce,(cbody,ibody,ipobody,nbody,set,istartset,
                              iendset,ialset,&inewton,nset,&ifreebody,&k));
           RENEW(ipobody,ITG,2*(*ne+ifreebody));
       }
       RENEW(ipobody,ITG,2*(ifreebody-1));
   }
 
   /* allocating a field for the instantaneous amplitude */
 
   NNEW(ampli,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,itg,&ntg,amname,ikboun,ilboun,nelemload,sideload,mi,
               ntrans,trab,inotr,veold,integerglob,doubleglob,tieset,istartset,
               iendset,ialset,ntie,nmpc,ipompc,ikmpc,ilmpc,nodempc,coefmpc,
               ipobody,iponoel,inoel));
 
   /* determining the structure of the df matrix */
 
   nzss=20000000;
   NNEW(mast1,ITG,nzss);
   NNEW(irows,ITG,1);
   NNEW(icols,ITG,ndesi);
   NNEW(jqs,ITG,ndesi+1);
   NNEW(ipointer,ITG,ndesi);
 
   mastructse(kon,ipkon,lakon,ne,ipompc,nodempc,nmpc,nactdof,icols,jqs,
              &mast1,&irows,ipointer,&nzss,mi,mortar,nodedesi,&ndesi,
              &icoordinate,ielorien,istartdesi,ialdesi);
 
   SFREE(ipointer);SFREE(mast1);
   RENEW(irows,ITG,nzss);
   
   /* invert nactdof */
   
   NNEW(nactdofinv,ITG,mt**nk);
   NNEW(nodorig,ITG,*nk);
   FORTRAN(gennactdofinv,(nactdof,nactdofinv,nk,mi,nodorig,
              ipkon,lakon,kon,ne));
   SFREE(nodorig);
 
   /* reading the stiffness matrix, mass matrix, eigenfrequencies
      and eigenmodes */
 
   if(ieigenfrequency==1){
 
       /* reading the eigenvalues / eigenmodes */
       
       if(!cyclicsymmetry){
       
       if(fread(&nev,sizeof(ITG),1,f1)!=1){
           printf(" *ERROR in sensitivity reading the number of eigenvalues in the eigenvalue file");
           printf(" *INFO  in sensitivity: if there are problems reading the .eig file this may be due to:\n");
           printf("        1) the nonexistence of the .eig file\n");
           printf("        2) other boundary conditions than in the input deck\n");
           printf("           which created the .eig file\n\n");
           exit(0);
       }
       
       NNEW(d,double,nev);
       
       if(fread(d,sizeof(double),nev,f1)!=nev){
           printf(" *ERROR in sensitivity reading the eigenvalues in the eigenvalue file");
           printf(" *INFO  in sensitivity: if there are problems reading the .eig file this may be due to:\n");
           printf("        1) the nonexistence of the .eig file\n");
           printf("        2) other boundary conditions than in the input deck\n");
           printf("           which created the .eig file\n\n");
           exit(0);
       }
       
 /*    for(i=0;i<nev;i++){
           if(d[i]>0){d[i]=sqrt(d[i]);}else{d[i]=0.;}
           }*/
       
       NNEW(ad,double,neq[1]);
       NNEW(adb,double,neq[1]);
       NNEW(au,double,nzsprevstep[2]);
       NNEW(aub,double,nzs[1]);
       
       if(fread(ad,sizeof(double),neq[1],f1)!=neq[1]){
           printf(" *ERROR in sensitivity reading the diagonal of the stiffness matrix in the eigenvalue file");
           printf(" *INFO  in sensitivity: if there are problems reading the .eig file this may be due to:\n");
           printf("        1) the nonexistence of the .eig file\n");
           printf("        2) other boundary conditions than in the input deck\n");
           printf("           which created the .eig file\n\n");
           exit(0);
       }
       
       if(fread(au,sizeof(double),nzsprevstep[2],f1)!=nzsprevstep[2]){
           printf(" *ERROR in sensitivity reading the off-diagonals of the stiffness matrix in the eigenvalue file");
           printf(" *INFO  in sensitivity: if there are problems reading the .eig file this may be due to:\n");
           printf("        1) the nonexistence of the .eig file\n");
           printf("        2) other boundary conditions than in the input deck\n");
           printf("           which created the .eig file\n\n");
           exit(0);
       }
       
       if(fread(adb,sizeof(double),neq[1],f1)!=neq[1]){
           printf(" *ERROR in sensitivity reading the diagonal of the mass matrix in the eigenvalue file");
           printf(" *INFO  in sensitivity: if there are problems reading the .eig file this may be due to:\n");
           printf("        1) the nonexistence of the .eig file\n");
           printf("        2) other boundary conditions than in the input deck\n");
           printf("           which created the .eig file\n\n");
           exit(0);
       }
       
       if(fread(aub,sizeof(double),nzs[1],f1)!=nzs[1]){
           printf(" *ERROR in sensitivity reading the off-diagonals of the mass matrix in the  eigenvalue file");
           printf(" *INFO  in sensitivity: if there are problems reading the .eig file this may be due to:\n");
           printf("        1) the nonexistence of the .eig file\n");
           printf("        2) other boundary conditions than in the input deck\n");
           printf("           which created the .eig file\n\n");
           exit(0);
       }
       
       NNEW(z,double,neq[1]*nev);
       
       if(fread(z,sizeof(double),neq[1]*nev,f1)!=neq[1]*nev){
           printf(" *ERROR in sensitivity reading the eigenvectors in the eigenvalue file");
           printf(" *INFO  in sensitivity: if there are problems reading the .eig file this may be due to:\n");
           printf("        1) the nonexistence of the .eig file\n");
           printf("        2) other boundary conditions than in the input deck\n");
           printf("           which created the .eig file\n\n");
           exit(0);
       }
       }
       else{
       nev=0;
       do{
           if(fread(&nmd,sizeof(ITG),1,f1)!=1){
           break;
           }
           if(fread(&nevd,sizeof(ITG),1,f1)!=1){
           printf(" *ERROR in sensitivity reading the number of eigenvalues for nodal diameter %" ITGFORMAT " in the eigenvalue file",nmd);
           printf(" *INFO  in sensitivity: if there are problems reading the .eig file this may be due to:\n");
           printf("        1) the nonexistence of the .eig file\n");
           printf("        2) other boundary conditions than in the input deck\n");
           printf("           which created the .eig file\n\n");
           exit(0);
           }
           if(nev==0){
           NNEW(d,double,nevd);
           NNEW(nm,ITG,nevd);
           }else{
           RENEW(d,double,nev+nevd);
           RENEW(nm,ITG,nev+nevd);
           }
           
           if(fread(&d[nev],sizeof(double),nevd,f1)!=nevd){
           printf(" *ERROR in sensitivity reading the eigenvalues for nodal diameter %" ITGFORMAT " in the eigenvalue file",nmd);
           printf(" *INFO  in sensitivity: if there are problems reading the .eig file this may be due to:\n");
           printf("        1) the nonexistence of the .eig file\n");
           printf("        2) other boundary conditions than in the input deck\n");
           printf("           which created the .eig file\n\n");
           exit(0);
           }
           
 /*        for(i=nev;i<nev+nevd;i++){
           if(d[i]>0){d[i]=sqrt(d[i]);}else{d[i]=0.;}
           }*/
           
           for(i=nev;i<nev+nevd;i++){nm[i]=nmd;}
           
           if(nev==0){
 
                   /* reading stiffness and mass matrix; these are not kept */
 
           NNEW(adb,double,neq[1]);
           NNEW(aub,double,nzs[1]);
           
           if(fread(adb,sizeof(double),neq[1],f1)!=neq[1]){
               printf(" *ERROR in sensitivity reading the diagonal of the mass matrix in the eigenvalue file");
               printf(" *INFO  in sensitivity: if there are problems reading the .eig file this may be due to:\n");
               printf("        1) the nonexistence of the .eig file\n");
               printf("        2) other boundary conditions than in the input deck\n");
               printf("           which created the .eig file\n\n");
               exit(0);
           }
           
           if(fread(aub,sizeof(double),nzs[1],f1)!=nzs[1]){
               printf(" *ERROR in sensitivity reading the off-diagonals of the mass matrix in the eigenvalue file");
               printf(" *INFO  in sensitivity: if there are problems reading the .eig file this may be due to:\n");
               printf("        1) the nonexistence of the .eig file\n");
               printf("        2) other boundary conditions than in the input deck\n");
               printf("           which created the .eig file\n\n");
               exit(0);
           }
 
           SFREE(adb);SFREE(aub);
           }
           
           if(nev==0){
           NNEW(z,double,neq[1]*nevd);
           }else{
           RENEW(z,double,(long long)neq[1]*(nev+nevd));
           }
           
           if(fread(&z[(long long)neq[1]*nev],sizeof(double),neq[1]*nevd,f1)!=neq[1]*nevd){
           printf(" *ERROR in sensitivity reading the eigenvectors for nodal diameter %" ITGFORMAT " in the eigenvalue file",nmd);
           printf(" *INFO  in sensitivity: if there are problems reading the .eig file this may be due to:\n");
           printf("        1) the nonexistence of the .eig file\n");
           printf("        2) other boundary conditions than in the input deck\n");
           printf("           which created the .eig file\n\n");
           exit(0);
           }
           nev+=nevd;
       }while(1);
       }
       fclose(f1);
   }else{
       nev=1;
       if((idisplacement==1)||((ishapeenergy==1)&&(iperturb[1]==1))){
     
     /* reading the stiffness matrix from previous step for sensitivity analysis */
     /* matrix stored in <jobname>.stm file */
 
     /* nzs,irow,jq and icol are stored too, since the static analysis
            can involve contact, whereas in the sensitivity analysis contact is not
        taken into account while determining the structure of the stiffness
        matrix (in mastruct.c)
         */
 
         /* for mass and shape energy the stiffness matrix is not needed */
     
     strcpy(stiffmatrix,jobnamec);
     strcat(stiffmatrix,".stm");
     
     if((f1=fopen(stiffmatrix,"rb"))==NULL){
         printf("*ERROR in sensitivity: cannot open stiffness-matrix file for reading");
         exit(0);
     }
     
     if(fread(&nasym,sizeof(ITG),1,f1)!=1){
         printf("*ERROR in sensitivity reading the symmetry flag of the stiffness matrix file...");
         exit(0);
     }
     
     if(fread(nzs,sizeof(ITG),3,f1)!=3){
         printf("*ERROR in sensitivity reading the number of subdiagonal nonzeros in the stiffness matrix file...");
         exit(0);
     }
     RENEW(irow,ITG,nzs[2]);
 
     if(fread(irow,sizeof(ITG),nzs[2],f1)!=nzs[2]){
         printf("*ERROR in sensitivity reading irow in the stiffness matrix file...");
         exit(0);
     }
 
     if(fread(jq,sizeof(ITG),neq[1]+1,f1)!=neq[1]+1){
         printf("*ERROR in sensitivity reading jq in the stiffness matrix file...");
         exit(0);
     }
 
     if(fread(icol,sizeof(ITG),neq[1],f1)!=neq[1]){
         printf("*ERROR in sensitivity reading icol in the stiffness matrix file...");
         exit(0);
     }
     
     NNEW(ad,double,neq[1]);
     NNEW(au,double,(nasym+1)*nzs[2]);
 
     if(fread(ad,sizeof(double),neq[1],f1)!=neq[1]){
         printf("*ERROR in sensitivity reading the diagonal of the stiffness matrix in the .stm-file");
         exit(0);
     }
     
     if(fread(au,sizeof(double),(nasym+1)*nzs[2],f1)!=(nasym+1)*nzs[2]){
         printf("*ERROR in sensitivity reading the off-diagonals of the stiffness matrix in the .stm-file");
         exit(0);
     }  
     
     fclose(f1);
       }
   }
 
   /* loop over all eigenvalues, or, if it is not an eigenvalue sensitivity study,
      loop over just one value */
 
   for(iev=0;iev<nev;iev++){
 
       /* for cyclic symmetry calculations only the odd modes are calculated
          (modes occur in phase-shifted pairs) */
 
       if(cyclicsymmetry){
       if((iev/2)*2!=iev){
           continue;
       }
       mode=iev;
       noddiam=nm[iev];
       }
 
       /* determining the internal forces and the stiffness coefficients */
       
       NNEW(f,double,*neq); /* FAKE */
       
       /* needed for nonlinear shape energy */
 
       if((iperturb[1]==1)&&(ishapeenergy==1)){
          NNEW(fint,double,*neq);
       }
       
       /* allocating a field for the stiffness matrix 
      (calculated in results_se and needed in mafillsmse */
       
       NNEW(xstiff,double,(long long)27*mi[0]**ne);
       if(iorientation==1) NNEW(dxstiff,double,(long long)3*27*mi[0]**ne);
       
       iout=-1;
       NNEW(v,double,mt**nk);
 //      memcpy(&v[0],&vold[0],sizeof(double)*mt**nk);
       if(iperturb[1]==1) memcpy(&v[0],&vold[0],sizeof(double)*mt**nk);
 
       NNEW(fn,double,mt**nk);  /* FAKE */
       if(!cyclicsymmetry){
       NNEW(df,double,nzss);
       }else{
       NNEW(df,double,2*nzss);
       }
       NNEW(stx,double,6*mi[0]**ne);
       
       results_se(co,nk,kon,ipkon,lakon,ne,v,stn,inum,stx,
           elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat,
           ielorien,norien,orab,ntmat_,t0,t1act,ithermal,
           prestr,iprestr,filab,eme,emn,een,iperturb,
           f,fn,nactdof,&iout,qa,vold,b,nodeboun,
           ndirboun,xbounact,nboun,ipompc,
           nodempc,coefmpc,labmpc,nmpc,nmethod,cam,neq,veold,accold,
           &bet,&gam,&dtime,&time,ttime,plicon,nplicon,plkcon,nplkcon,
           xstateini,xstiff,xstate,npmat_,epn,matname,mi,&ielas,
           &icmd,ncmat_,nstate_,stiini,vini,ikboun,ilboun,ener,enern,
           emeini,xstaten,eei,enerini,cocon,ncocon,set,nset,istartset,
           iendset,ialset,nprint,prlab,prset,qfx,qfn,trab,inotr,ntrans,
           fmpc,nelemload,nload,ikmpc,ilmpc,istep,&iinc,springarea,
           &reltime,&ne0,xforc,nforc,thicke,shcon,nshcon,
           sideload,xloadact,xloadold,&icfd,inomat,pslavsurf,pmastsurf,
           mortar,islavact,cdn,islavnode,nslavnode,ntie,clearini,
           islavsurf,ielprop,prop,energyini,energy,df,&distmin,
       &ndesi,nodedesi,sti,nkon,jqs,irows,nactdofinv,
       &icoordinate,dxstiff,istartdesi,ialdesi,xdesi,
       &ieigenfrequency,fint,&ishapeenergy);
       
       iout=1;SFREE(v);
       
       /* storing the design variables per element
      (including 0 for the unperturbed state) */
       
       NNEW(ipoeldi,ITG,*ne);
       NNEW(ieldi,ITG,2*(istartdesi[ndesi]-1+*ne));
       
       FORTRAN(desiperelem,(&ndesi,istartdesi,ialdesi,ipoeldi,ieldi,ne));
       
       NNEW(istartelem,ITG,*ne+1);
       NNEW(ialelem,ITG,istartdesi[ndesi]-1+*ne);
       
       FORTRAN(createialelem,(ne,istartelem,ialelem,ipoeldi,ieldi));
       
       SFREE(ipoeldi);SFREE(ieldi);
       RENEW(ialelem,ITG,istartelem[*ne]-1);
       
       nmethodl=*nmethod;
       
       /* v contains the values dK/dx has to be multiplied with */
       
       if(ieigenfrequency==0){
       NNEW(v,double,mt**nk);
       memcpy(&v[0],&vold[0],sizeof(double)*mt**nk);
       }else{
       if(!cyclicsymmetry){
           NNEW(v,double,mt**nk);
           FORTRAN(resultsnoddir,(nk,v,nactdof,&z[iev*neq[1]],ipompc,
                  nodempc,coefmpc,nmpc,mi));
       }else{
           NNEW(v,double,2*mt**nk);
           FORTRAN(resultsnoddir,(nk,v,nactdof,&z[iev*neq[1]],ipompc,
                  nodempc,coefmpc,nmpc,mi));
           FORTRAN(resultsnoddir,(nk,&v[mt**nk],nactdof,&z[iev*neq[1]+neq[1]/2],ipompc,
                  nodempc,coefmpc,nmpc,mi));
       }
       
       ptime=d[iev];
       if(ptime>0){ptime=sqrt(ptime)/6.283185308;}else{ptime=0.;}
 
           /* for an eigenfrequency objective (K-eigenvalue*M) is
              taken instead of K (not for ORIENTATION as design 
              variable since the mass does not change with orientation)*/
 
       if(icoordinate==1){
           sigma=d[iev];
           mass[0]=1;
       }
       }
 
       /* determining the system matrix and the external forces */
       
       mafillsmmain_se(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,nactdof,neq,&nmethodl,
             ikmpc,ilmpc,ikboun,ilboun,
             elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat,
             ielorien,norien,orab,ntmat_,
             t0,t1act,ithermal,prestr,iprestr,vold,iperturb,sti,
             stx,iexpl,plicon,nplicon,plkcon,nplkcon,
             xstiff,npmat_,&dtime,matname,mi,
             ncmat_,mass,&stiffness,&buckling,&rhsi,&intscheme,physcon,
             shcon,nshcon,cocon,ncocon,ttime,&time,istep,&iinc,&coriolis,
             ibody,xloadold,&reltime,veold,springarea,nstate_,
             xstateini,xstate,thicke,integerglob,doubleglob,
             tieset,istartset,iendset,ialset,ntie,&nasym,pslavsurf,
             pmastsurf,mortar,clearini,ielprop,prop,&ne0,fnext,
         &distmin,&ndesi,nodedesi,df,&nzss,jqs,irows,
         &icoordinate,dxstiff,xdesi,istartelem,ialelem,v,&sigma,
         &cyclicsymmetry,labmpc,ics,cs,mcs,&ieigenfrequency);
       
       SFREE(istartelem);SFREE(ialelem);
       
       if(iorientation==1) SFREE(dxstiff);
       
       /* determining the values and the derivatives of the objective functions */
       
       NNEW(g0,double,*nobject);
       NNEW(dgdx,double,ndesi**nobject);
       if(icoordinate==1){NNEW(dgdxglob,double,2**nk**nobject);}
             
       iout=-1; 
       objectivemain_se(co,nk,kon,ipkon,lakon,ne,v,stn,inum,stx,
           elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat,
           ielorien,norien,orab,ntmat_,t0,t1act,ithermal,
           prestr,iprestr,filab,eme,emn,een,iperturb,
           f,fn,nactdof,&iout,qa,vold,nodeboun,
           ndirboun,xbounact,nboun,ipompc,
           nodempc,coefmpc,labmpc,nmpc,nmethod,cam,neq,veold,accold,
           &bet,&gam,&dtime,&time,ttime,plicon,nplicon,plkcon,nplkcon,
           xstateini,xstiff,xstate,npmat_,epn,matname,mi,&ielas,
           &icmd,ncmat_,nstate_,stiini,vini,ikboun,ilboun,ener,enern,
           emeini,xstaten,eei,enerini,cocon,ncocon,set,nset,istartset,
           iendset,ialset,nprint,prlab,prset,qfx,qfn,trab,inotr,ntrans,
           fmpc,nelemload,nload,ikmpc,ilmpc,istep,&iinc,springarea,
           &reltime,&ne0,xforc,nforc,thicke,shcon,nshcon,
           sideload,xloadact,xloadold,&icfd,inomat,pslavsurf,pmastsurf,
           mortar,islavact,cdn,islavnode,nslavnode,ntie,clearini,
           islavsurf,ielprop,prop,energyini,energy,&distmin,
           &ndesi,nodedesi,nobject,objectset,g0,dgdx,sti,
       df,nactdofinv,jqs,irows,&idisplacement,nzs,jobnamec,
       isolver,icol,irow,jq,kode,cs,output,istartdesi,ialdesi,
       xdesi,orname,&icoordinate,&iev,d,z,au,ad,aub,adb,&cyclicsymmetry,
       &nzss,&nev,&ishapeenergy,fint,nlabel,&igreen,&nasym,
           iponoel,inoel,nodedesiinv,dgdxglob); 
       iout=1;
 
       SFREE(v);
       
       if(icoordinate==1){
 
           /* Elimination of mesh-dependency and filling of dgdxglob  */
   
       NNEW(weightformgrad,double,ndesi);
           
           FORTRAN(formgradient,(istartdesi,ialdesi,ipkon,lakon,ipoface,
           &ndesi,nodedesi,nodface,kon,co,dgdx,nobject,
           weightformgrad,nodedesiinv,&noregion,objectset,
           dgdxglob,nk));
           
       SFREE(weightformgrad);
 
       /* for quadratic elements: interpolation of midnode-sensitivity 
          to the corner nodes */
       
       NNEW(xinterpol,double,*nk**nobject);
       NNEW(nnodes,ITG,*nk);
       
           FORTRAN(formgradinterpol,(ipkon,lakon,kon,nobject,dgdxglob,
                   xinterpol,nnodes,ne,nk,nodedesiinv,objectset));
                     
           SFREE(nnodes);SFREE(xinterpol);
 
           /* Filtering of sensitivities */
   
       filtermain(co,dgdxglob,nobject,nk,nodedesi,&ndesi,objectset);
 
           /* scaling the designnodes being in the transition between 
              the designspace and the non-designspace */
      
           transitionmain(co,dgdxglob,nobject,nk,nodedesi,&ndesi,objectset,
                      ipkon,kon,lakon,ipoface,nodface,nodedesiinv);
       
       /* createinum is called in order to determine the nodes belonging
          to elements; this information is needed in frd_se */
 
       NNEW(inum,ITG,*nk);
       FORTRAN(createinum,(ipkon,inum,kon,lakon,nk,ne,&cflag[0],nelemload,
           nload,nodeboun,nboun,ndirboun,ithermal,co,vold,mi,ielmat));
 
           /* calculate projected gradient if:
              - any constraint functions are defined AND
          - at least one constraint function is active */
 
           if(*nobject>1){
       
           /* check if any constraints are active */
 
           /* in the field "ipoacti" and the variable "nnlconst" the 
                  characteristics of the N-matrix are stored:
          -nnlconst is the number of nonlinear constraints
              -in the first nnlconst entries of ipoacti the position of the 
           nonlinear constraints (e.g. mass) is inserted
          -in the following entries the position of the linear 
                   constraints (wall thickness constraints) is stored */ 
           
           NNEW(ipoacti,ITG,*nobject+ndesi);
           
           FORTRAN(checkconstraint,(nobject,objectset,g0,&nactive,&nnlconst,
                        ipoacti,&ndesi,dgdxglob,nk,nodedesi));
           
           RENEW(ipoacti,ITG,nactive);
           
           if(nactive>0){
           
                   *nobject=*nobject+1;        
           RENEW(dgdxglob,double,2**nk**nobject);
           RENEW(objectset,char,324**nobject);
           
               projectgradmain(nobject,objectset,dgdxglob,g0,&ndesi,nodedesi,
                   nk,isolver,&nactive,&nnlconst,ipoacti);
           
           }
       } 
          
       for(iobject=0;iobject<*nobject;iobject++){
 
           /* storing the sensitivities in the frd-file for visualization 
              and for optimizer */
           
           ++*kode;
               
           frd_sen(co,nk,stn,inum,nmethod,kode,filab,&ptime,nstate_,
                  istep,
          &iinc,&mode,&noddiam,description,mi,&ngraph,ne,cs,set,nset,
          istartset,iendset,ialset,jobnamec,output,
          dgdxglob,&iobject,objectset,ntrans,inotr,trab,&idesvar,orname,
          &icoordinate,&inorm,&irand);
 
           /* writing the objectives in the dat-file for optimizer */
               
           FORTRAN(writeobj,(objectset,&iobject,g0));
       }  
       
       SFREE(inum);
       
       }
       
       SFREE(fn);SFREE(stx);SFREE(f);SFREE(xstiff);SFREE(g0);SFREE(dgdx);
       SFREE(df);SFREE(dgdxglob);
       
       if(*nobject>1){SFREE(ipoacti);}
 //      if(*nobject>0){SFREE(objectset);}
       
   } // end loop over nev
 
   SFREE(iponoel);SFREE(inoel);SFREE(nodedesiinv);
 
   if((iperturb[1]==1)&&(ishapeenergy==1)){SFREE(fint);}
 
   if(ieigenfrequency==1){
       if(!cyclicsymmetry){SFREE(d);SFREE(ad);SFREE(adb);SFREE(au);
       SFREE(aub);SFREE(z);
       }else{
       SFREE(d);SFREE(z);SFREE(nm);}
   }else if(idisplacement==1){
       SFREE(ad);SFREE(au);
   }
   
   SFREE(xbounact);SFREE(xforcact);SFREE(xloadact);SFREE(t1act);SFREE(ampli);
   SFREE(xbodyact);SFREE(nactdofinv);
   if(*nbody>0) SFREE(ipobody);
 
   if(ishapeenergy==1){
       SFREE(enerini);SFREE(emeini);SFREE(stiini);
   }
 
   SFREE(istartdesi);SFREE(ialdesi);
   if(icoordinate==1){
       SFREE(nodedesi);SFREE(xdesi);SFREE(ipoface);SFREE(nodface);
   }
 
   SFREE(irows);SFREE(icols);SFREE(jqs);
 
   *irowp=irow;*enerp=ener;*xstatep=xstate;*ipkonp=ipkon;*lakonp=lakon;
   *konp=kon;*ielmatp=ielmat;*ielorienp=ielorien;*objectsetp=objectset;
 
   (*ttime)+=(*tper);
  
   return;
 }

◆ sensitivity_out()

void sensitivity_out	(	char *	jobnamec,
		double *	dgdxtotglob,
		ITG *	neq,
		ITG *	nobject,
		double *	g0
	)

                   {
             
   char sensitivities[132]="",nominal[132]="";
   
   ITG i=0,iobject=0;
       
   FILE *f1;
                  
   /* writing the sensitivities in the sen-file for optimizer */
             
   strcpy(sensitivities,jobnamec);
   strcat(sensitivities,".sen");
   
   if((f1=fopen(sensitivities,"w"))==NULL){
       printf("*ERROR in sensitivity: cannot open sensitivity vector file for writing...");
       
       exit(0);
   }
   
   /* storing the sensitivity vectors */
 
   fprintf(f1,"---------------------------------- \n");
   fprintf(f1,"Objective \n");
   fprintf(f1,"---------------------------------- \n");
   
   for(i=0;i<neq[1];i++){
      for(iobject=0;iobject<*nobject;iobject++){
         fprintf(f1,"%12.5E",(double)dgdxglob[3+5*i+(5*neq[1]+2)*iobject]);
     fprintf(f1,";  ");    
      }
      fprintf(f1,"\n"); 
   }
   
   fclose(f1);
 
   /* writing the nominal values in the nom-file for optimizer */
             
   strcpy(nominal,jobnamec);
   strcat(nominal,".nom");
   
   if((f1=fopen(nominal,"w"))==NULL){
       printf("*ERROR in sensitivity: cannot open sensitivity vector file for writing...");
       
       exit(0);
   }
   
   /* storing the sensitivity vectors */
 
   fprintf(f1,"---------------------------------- \n");
   fprintf(f1,"Objective \n");
   fprintf(f1,"---------------------------------- \n");
   
   for(iobject=0;iobject<*nobject;iobject++){
      fprintf(f1,"%12.5E",(double)g0[iobject]);
      fprintf(f1,";  ");    
   }
   fprintf(f1,"\n"); 
   
   fclose(f1);
   
   return;
 
 }

◆ spooles()

void spooles	(	double *	ad,
		double *	au,
		double *	adb,
		double *	aub,
		double *	sigma,
		double *	b,
		ITG *	icol,
		ITG *	irow,
		ITG *	neq,
		ITG *	nzs,
		ITG *	symmtryflag,
		ITG *	inputformat,
		ITG *	nzs3
	)

◆ steadystate()

void steadystate	(	double **	co,
		ITG *	nk,
		ITG **	kon,
		ITG **	ipkon,
		char **	lakon,
		ITG *	ne,
		ITG **	nodeboun,
		ITG **	ndirboun,
		double **	xboun,
		ITG *	nboun,
		ITG **	ipompcp,
		ITG **	nodempcp,
		double **	coefmpcp,
		char **	labmpcp,
		ITG *	nmpc,
		ITG *	nodeforc,
		ITG *	ndirforc,
		double *	xforc,
		ITG *	nforc,
		ITG *	nelemload,
		char *	sideload,
		double *	xload,
		ITG *	nload,
		ITG **	nactdof,
		ITG *	neq,
		ITG *	nzl,
		ITG *	icol,
		ITG *	irow,
		ITG *	nmethod,
		ITG **	ikmpcp,
		ITG **	ilmpcp,
		ITG **	ikboun,
		ITG **	ilboun,
		double *	elcon,
		ITG *	nelcon,
		double *	rhcon,
		ITG *	nrhcon,
		double *	cocon,
		ITG *	ncocon,
		double *	alcon,
		ITG *	nalcon,
		double *	alzero,
		ITG **	ielmat,
		ITG **	ielorien,
		ITG *	norien,
		double *	orab,
		ITG *	ntmat_,
		double **	t0,
		double **	t1,
		ITG *	ithermal,
		double *	prestr,
		ITG *	iprestr,
		double **	voldp,
		ITG *	iperturb,
		double *	sti,
		ITG *	nzs,
		double *	timepar,
		double *	xmodal,
		double **	veoldp,
		char *	amname,
		double *	amta,
		ITG *	namta,
		ITG *	nam,
		ITG *	iamforc,
		ITG *	iamload,
		ITG **	iamt1,
		ITG *	jout,
		ITG *	kode,
		char *	filab,
		double **	emep,
		double *	xforcold,
		double *	xloadold,
		double **	t1old,
		ITG **	iamboun,
		double **	xbounold,
		ITG *	iexpl,
		double *	plicon,
		ITG *	nplicon,
		double *	plkcon,
		ITG *	nplkcon,
		double *	xstate,
		ITG *	npmat_,
		char *	matname,
		ITG *	mi,
		ITG *	ncmat_,
		ITG *	nstate_,
		double **	enerp,
		char *	jobnamec,
		double *	ttime,
		char *	set,
		ITG *	nset,
		ITG *	istartset,
		ITG *	iendset,
		ITG *	ialset,
		ITG *	nprint,
		char *	prlab,
		char *	prset,
		ITG *	nener,
		double *	trab,
		ITG **	inotr,
		ITG *	ntrans,
		double **	fmpcp,
		char *	cbody,
		ITG *	ibody,
		double *	xbody,
		ITG *	nbody,
		double *	xbodyold,
		ITG *	istep,
		ITG *	isolver,
		ITG *	jq,
		char *	output,
		ITG *	mcs,
		ITG *	nkon,
		ITG *	ics,
		double *	cs,
		ITG *	mpcend,
		double *	ctrl,
		ITG *	ikforc,
		ITG *	ilforc,
		double *	thicke,
		ITG *	nmat,
		char *	typeboun,
		ITG *	ielprop,
		double *	prop,
		char *	orname
	)

                                                                {
 
   char fneig[132]="",description[13]="            ",*lakon=NULL,*labmpc=NULL,
     *labmpcold=NULL,cflag[1]=" ";
 
   ITG nev,i,j,k, *inum=NULL,*ipobody=NULL,inewton=0,nsectors,im,
     iinc=0,l,iout,ielas,icmd,iprescribedboundary,ndata,nmd,nevd,
     ndatatot,*iphaseforc=NULL,*iphaseload=NULL,*iphaseboun=NULL,
     *isave=NULL,nfour,ii,ir,ic,mode,noddiam=-1,*nm=NULL,*islavact=NULL,
     *kon=NULL,*ipkon=NULL,*ielmat=NULL,*ielorien=NULL,*inotr=NULL,
     *nodeboun=NULL,*ndirboun=NULL,*iamboun=NULL,*ikboun=NULL,jj,
     *ilboun=NULL,*nactdof=NULL,*ipompc=NULL,*nodempc=NULL,*ikmpc=NULL,
     *ilmpc=NULL,*ipompcold=NULL,*nodempcold=NULL,*ikmpcold=NULL,
     *ilmpcold=NULL,nmpcold,mpcendold,kflag=2,*iamt1=NULL,ifreebody,
     *itg=NULL,ntg=0,symmetryflag=0,inputformat=0,dashpot,nrhs=1,
     *ipiv=NULL,info,nev2,ngraph=1,nkg,neg,iflag=1,idummy=1,imax,
     nzse[3],mt=mi[1]+1,*ikactmech=NULL,nactmech,id,nasym=0,
     *imddof=NULL,nmddof,*imdnode=NULL,nmdnode,*imdboun=NULL,nmdboun,
     *imdmpc=NULL,nmdmpc,*izdof=NULL,nzdof,cyclicsymmetry,mortar=0,
     *ikactmechr=NULL,*ikactmechi=NULL,nactmechr,nactmechi,intpointvar,
     iforc,iload,ne0,*iponoel=NULL,*inoel=NULL,*imdelem=NULL,
     nmdelem,*integerglob=NULL,*nshcon=NULL,nherm,icfd=0,*inomat=NULL,
     *islavnode=NULL,*nslavnode=NULL,*islavsurf=NULL,iit=-1,inoelsize,
     network=0;
 
   long long i2;
 
   double *d=NULL, *z=NULL,*stiini=NULL,*vini=NULL,*freqnh=NULL,
     *xforcact=NULL, *xloadact=NULL,y,*fr=NULL,*fi=NULL,*cc=NULL,
     *t1act=NULL,*ampli=NULL, *aa=NULL,*bb=NULL,*vr=NULL,*vi=NULL,
     *stn=NULL,*stx=NULL,*een=NULL,*adb=NULL,*xstiff=NULL,ptime,
     *aub=NULL,*bjr=NULL, *bji=NULL,*xbodyr=NULL,*cdn=NULL,
     *f=NULL, *fn=NULL, *xbounact=NULL,*epn=NULL,*xstateini=NULL,
     *enern=NULL,*xstaten=NULL,*eei=NULL,*enerini=NULL,*qfn=NULL,
     *qfx=NULL, *xbodyact=NULL, *cgr=NULL, *au=NULL,*xbodyi=NULL,
     time,dtime,reltime,*co=NULL,*xboun=NULL,*xbounold=NULL,
     physcon[1],qa[4],cam[5],accold[1],bet,gam,*emn=NULL,timem,
     *ad=NULL,sigma=0.,alpham,betam,*fnr=NULL,*fni=NULL,*emeini=NULL,
     fmin,fmax,bias,*freq=NULL,*xforcr=NULL,dd,pi,vreal,constant,
     *xforci=NULL,*xloadr=NULL,*xloadi=NULL,*xbounr=NULL,*xbouni=NULL,
     *br=NULL,*bi=NULL,*ubr=NULL,*ubi=NULL,*mubr=NULL,*mubi=NULL,
     *wsave=NULL,*r=NULL,*xbounacttime=NULL,*btot=NULL,breal,tmin,tmax,
     *vold=NULL,*eme=NULL,*ener=NULL,*coefmpc=NULL,*fmpc=NULL,
     *coefmpcold=NULL,*t0=NULL,*t1=NULL,*t1old=NULL,*adc=NULL,*auc=NULL,
     *am=NULL,*bm=NULL,*zc=NULL,*e=NULL,*stnr=NULL,*stni=NULL,
     *vmax=NULL,*stnmax=NULL,*va=NULL,*vp=NULL,*fric=NULL,*springarea=NULL,
     *stna=NULL,*stnp=NULL,*bp=NULL,*eenmax=NULL,*clearini=NULL,
     *doubleglob=NULL,*shcon=NULL,*veold=NULL,*xmr=NULL,*xmi=NULL,*eig=NULL,
     *ax=NULL,*bx=NULL,*pslavsurf=NULL,*pmastsurf=NULL,xnull=0.,
     *cdnr=NULL,*cdni=NULL,*tinc,*tper,*energyini=NULL,*energy=NULL;
 
   /* dummy arguments for the call of expand*/
 
   char* tieset=NULL;
   ITG *jqe=NULL,*icole=NULL,*irowe=NULL,ntie=0;
   double *adbe=NULL,*aube=NULL;
 
   FILE *f1;
 
   ITG *ipneigh=NULL,*neigh=NULL;
 
 #ifdef SGI
   ITG token;
 #endif
 
   co=*cop;kon=*konp;ipkon=*ipkonp;lakon=*lakonp;ielmat=*ielmatp;
   ielorien=*ielorienp;inotr=*inotrp;nodeboun=*nodebounp;
   ndirboun=*ndirbounp;iamboun=*iambounp;xboun=*xbounp;veold=*veoldp;
   xbounold=*xbounoldp;ikboun=*ikbounp;ilboun=*ilbounp;nactdof=*nactdofp;
   vold=*voldp;eme=*emep;ener=*enerp;ipompc=*ipompcp;nodempc=*nodempcp;
   coefmpc=*coefmpcp;labmpc=*labmpcp;ikmpc=*ikmpcp;ilmpc=*ilmpcp;
   fmpc=*fmpcp;iamt1=*iamt1p;t0=*t0p;t1=*t1p;t1old=*t1oldp;
 
   tinc=&timepar[0];
   tper=&timepar[1];
 
   pi=4.*atan(1.);
   iout=2;
 
   alpham=xmodal[0];
   betam=xmodal[1];
 
   fmin=2.*pi*xmodal[2];
   fmax=2.*pi*xmodal[3];
   ndata=floor(xmodal[4]);
   bias=xmodal[5];
   nfour=floor(xmodal[6]);
   if(nfour>0){
       tmin=xmodal[7];
       tmax=xmodal[8];
   }
 
   /* determining nzl */
 
   *nzl=0;
   for(i=neq[1];i>0;i--){
       if(icol[i-1]>0){
       *nzl=i;
       break;
       }
   }
 
   /* opening the eigenvalue file and checking for cyclic symmetry */
 
   strcpy(fneig,jobnamec);
   strcat(fneig,".eig");
 
   if((f1=fopen(fneig,"rb"))==NULL){
     printf(" *ERROR in steadystate: cannot open eigenvalue file for reading");
     exit(0);
   }
 
   if(fread(&cyclicsymmetry,sizeof(ITG),1,f1)!=1){
        printf(" *ERROR in steadystate reading the cyclic symmetry flag in the eigenvalue file");
        printf(" *INFO  in steadystate: if there are problems reading the .eig file this may be due to:\n");
        printf("        1) the nonexistence of the .eig file\n");
        printf("        2) other boundary conditions than in the input deck\n");
        printf("           which created the .eig file\n\n");
       exit(0);
   }
 
   if(fread(&nherm,sizeof(ITG),1,f1)!=1){
       printf(" *ERROR in steadystate reading the Hermitian flag in the eigenvalue file");
       printf(" *INFO  in steadystate: if there are problems reading the .eig file this may be due to:\n");
       printf("        1) the nonexistence of the .eig file\n");
       printf("        2) other boundary conditions than in the input deck\n");
       printf("           which created the .eig file\n\n");
       exit(0);
   }
 
   /* creating imddof containing the degrees of freedom
      retained by the user and imdnode containing the nodes */
 
   nmddof=0;nmdnode=0;nmdboun=0;nmdmpc=0;nmdelem=0;
 
   NNEW(imddof,ITG,*nk*3);
   NNEW(imdnode,ITG,*nk);
   NNEW(imdboun,ITG,*nboun);
   NNEW(imdmpc,ITG,*nmpc);
   FORTRAN(createmddof,(imddof,&nmddof,istartset,iendset,
                ialset,nactdof,ithermal,mi,imdnode,&nmdnode,
                ikmpc,ilmpc,ipompc,nodempc,nmpc,
                imdmpc,&nmdmpc,imdboun,&nmdboun,ikboun,
                nboun,nset,&ntie,tieset,set,lakon,kon,ipkon,labmpc,
                ilboun,filab,prlab,prset,nprint,ne,&cyclicsymmetry));
 
   /* if results are requested in too many nodes, it is faster to 
      calculate the results in all nodes */
 
   if((nmdnode>*nk/2)&&(!cyclicsymmetry)){
       nmdnode=0;nmddof=0;nmdboun=0;nmdmpc=0;
   }
   
   if(nmdnode!=0){
       if(!cyclicsymmetry){
       for(i=0;i<*nload;i++){
           iload=i+1;
           FORTRAN(addimdnodedload,(nelemload,sideload,ipkon,kon,lakon,
               &iload,imdnode,&nmdnode,ikmpc,ilmpc,ipompc,nodempc,nmpc,
                       imddof,&nmddof,nactdof,mi,imdmpc,&nmdmpc,imdboun,&nmdboun,
               ikboun,nboun,ilboun,ithermal));
       }
       
       for(i=0;i<*nforc;i++){
           iforc=i+1;
           FORTRAN(addimdnodecload,(nodeforc,&iforc,imdnode,&nmdnode,xforc,
                    ikmpc,ilmpc,ipompc,nodempc,nmpc,imddof,&nmddof,
                    nactdof,mi,imdmpc,&nmdmpc,imdboun,&nmdboun,
            ikboun,nboun,ilboun,ithermal));
       }
       }
       
       /* determining the elements belonging to a given node */
       
       NNEW(iponoel,ITG,*nk);
       NNEW(inoel,ITG,2**nkon);
       FORTRAN(elementpernode,(iponoel,inoel,lakon,ipkon,kon,ne,&inoelsize));
       NNEW(imdelem,ITG,*ne);
 
       /* storing the elements in which integration point results
          are needed; storing the nodes which are needed to
          calculate these results */
 
       FORTRAN(createmdelem,(imdnode,&nmdnode,xforc,
                    ikmpc,ilmpc,ipompc,nodempc,nmpc,imddof,&nmddof,
                    nactdof,mi,imdmpc,&nmdmpc,imdboun,&nmdboun,
                    ikboun,nboun,ilboun,ithermal,imdelem,&nmdelem,
                    iponoel,inoel,prlab,prset,nprint,lakon,set,nset,
                    ialset,ipkon,kon,istartset,iendset,nforc,
            ikforc,ilforc));
 
       RENEW(imdelem,ITG,nmdelem);
       SFREE(iponoel);SFREE(inoel);
   }
 
   /* if results are requested in too many nodes, it is faster to 
      calculate the results in all nodes */
 
   if((nmdnode>*nk/2)&&(!cyclicsymmetry)){
       nmdnode=0;nmddof=0;nmdboun=0;nmdmpc=0;
   }
   
   /* subtracting 1 to comply with the C-convention */
 
   for(i=0;i<nmddof;i++){imddof[i]-=1;}
 
   RENEW(imddof,ITG,nmddof);
   RENEW(imdnode,ITG,nmdnode);
   RENEW(imdboun,ITG,nmdboun);
   RENEW(imdmpc,ITG,nmdmpc);
 
   nsectors=1;
 
   if(!cyclicsymmetry){
 
       nkg=*nk;
       neg=*ne;
 
       if(fread(&nev,sizeof(ITG),1,f1)!=1){
       printf(" *ERROR in steadystate reading the number of eigenvalues in the eigenvalue file");
       printf(" *INFO  in steadystate: if there are problems reading the .eig file this may be due to:\n");
       printf("        1) the nonexistence of the .eig file\n");
       printf("        2) other boundary conditions than in the input deck\n");
       printf("           which created the .eig file\n\n");
       exit(0);
       }
 
       if(nherm==1){
       NNEW(d,double,nev);
       if(fread(d,sizeof(double),nev,f1)!=nev){
           printf(" *ERROR in steadystate reading the eigenvalues in the eigenvalue file...");
           printf(" *INFO  in steadystate: if there are problems reading the .eig file this may be due to:\n");
           printf("        1) the nonexistence of the .eig file\n");
           printf("        2) other boundary conditions than in the input deck\n");
           printf("           which created the .eig file\n\n");
           exit(0);
       }
 
       for(i=0;i<nev;i++){
           if(d[i]<0){d[i]=0.;}
       }
       }else{
       NNEW(d,double,2*nev);
       if(fread(d,sizeof(double),2*nev,f1)!=2*nev){
           printf(" *ERROR in steadystate reading the eigenvalues in the eigenvalue file...");
           printf(" *INFO  in steadystate: if there are problems reading the .eig file this may be due to:\n");
           printf("        1) the nonexistence of the .eig file\n");
           printf("        2) other boundary conditions than in the input deck\n");
           printf("           which created the .eig file\n\n");
           exit(0);
       }
       }
       
       NNEW(ad,double,neq[1]);
       NNEW(adb,double,neq[1]);
       NNEW(au,double,nzs[2]);
       NNEW(aub,double,nzs[1]);
       
       /* reading the stiffness matrix */
       
       if(fread(ad,sizeof(double),neq[1],f1)!=neq[1]){
       printf(" *ERROR in steadystate reading the diagonal of the stiffness matrix in the eigenvalue file");
       printf(" *INFO  in steadystate: if there are problems reading the .eig file this may be due to:\n");
       printf("        1) the nonexistence of the .eig file\n");
       printf("        2) other boundary conditions than in the input deck\n");
       printf("           which created the .eig file\n\n");
       exit(0);
       }
       
       if(fread(au,sizeof(double),nzs[2],f1)!=nzs[2]){
       printf(" *ERROR in steadystate reading the off-diagonals of the stiffness matrix in the eigenvalue file");
       printf(" *INFO  in steadystate: if there are problems reading the .eig file this may be due to:\n");
       printf("        1) the nonexistence of the .eig file\n");
       printf("        2) other boundary conditions than in the input deck\n");
       printf("           which created the .eig file\n\n");
       exit(0);
       }
       
       /* reading the mass matrix */
       
       if(fread(adb,sizeof(double),neq[1],f1)!=neq[1]){
       printf(" *ERROR in steadystate reading the diagonal of the mass matrix in the eigenvalue file");
       printf(" *INFO  in steadystate: if there are problems reading the .eig file this may be due to:\n");
       printf("        1) the nonexistence of the .eig file\n");
       printf("        2) other boundary conditions than in the input deck\n");
       printf("           which created the .eig file\n\n");
       exit(0);
       }
       
       if(fread(aub,sizeof(double),nzs[1],f1)!=nzs[1]){
       printf(" *ERROR in steadystate reading the off-diagonals of the mass matrix in the eigenvalue file");
       printf(" *INFO  in steadystate: if there are problems reading the .eig file this may be due to:\n");
       printf("        1) the nonexistence of the .eig file\n");
       printf("        2) other boundary conditions than in the input deck\n");
       printf("           which created the .eig file\n\n");
       exit(0);
       }
       
       /* reading the eigenvectors */
 
       if(nherm==1){
       NNEW(z,double,neq[1]*nev);
       if(fread(z,sizeof(double),neq[1]*nev,f1)!=neq[1]*nev){
           printf(" *ERROR in complexfreq reading the eigenvectors in the eigenvalue file...");
           printf(" *INFO  in steadystate: if there are problems reading the .eig file this may be due to:\n");
           printf("        1) the nonexistence of the .eig file\n");
           printf("        2) other boundary conditions than in the input deck\n");
           printf("           which created the .eig file\n\n");
           exit(0);
       }
       }else{
       NNEW(z,double,2*neq[1]*nev);
       if(fread(z,sizeof(double),2*neq[1]*nev,f1)!=2*neq[1]*nev){
           printf(" *ERROR in complexfreq reading the eigenvectors in the eigenvalue file...");
           printf(" *INFO  in steadystate: if there are problems reading the .eig file this may be due to:\n");
           printf("        1) the nonexistence of the .eig file\n");
           printf("        2) other boundary conditions than in the input deck\n");
           printf("           which created the .eig file\n\n");
           exit(0);
       }
       }
 
       /* reading the orthogonality matrices */
 
       if(nherm!=1){
       NNEW(xmr,double,nev*nev);
       NNEW(xmi,double,nev*nev);
       if(fread(xmr,sizeof(double),nev*nev,f1)!=nev*nev){
           printf(" *ERROR in steadystate reading the real orthogonality matrix to the eigenvalue file...");
           printf(" *INFO  in steadystate: if there are problems reading the .eig file this may be due to:\n");
           printf("        1) the nonexistence of the .eig file\n");
           printf("        2) other boundary conditions than in the input deck\n");
           printf("           which created the .eig file\n\n");
           exit(0);
       }
       
       if(fread(xmi,sizeof(double),nev*nev,f1)!=nev*nev){
           printf(" *ERROR in steadystate reading the imaginary orthogonality matrix to the eigenvalue file...");
           printf(" *INFO  in steadystate: if there are problems reading the .eig file this may be due to:\n");
           printf("        1) the nonexistence of the .eig file\n");
           printf("        2) other boundary conditions than in the input deck\n");
           printf("           which created the .eig file\n\n");
           exit(0);
       }
       }
   }
   else{
       nev=0;
       do{
       if(fread(&nmd,sizeof(ITG),1,f1)!=1){
           break;
       }
 
       if(fread(&nevd,sizeof(ITG),1,f1)!=1){
           printf(" *ERROR in steadystate reading the number of eigenvalues for nodal diameter %" ITGFORMAT " in the eigenvalue file",nmd);
           printf(" *INFO  in steadystate: if there are problems reading the .eig file this may be due to:\n");
           printf("        1) the nonexistence of the .eig file\n");
           printf("        2) other boundary conditions than in the input deck\n");
           printf("           which created the .eig file\n\n");
           exit(0);
       }
 
           /* reading the eigenvalues (complex for non-Hermitian systems) */
 
       if(nev==0){
           if(nherm==1){NNEW(d,double,nevd);
           }else{NNEW(d,double,2*nevd);}
           NNEW(nm,ITG,nevd);
       }else{
           if(nherm!=1){
           printf(" *ERROR in steadystate: non-Hermitian systems cannot\n");
           printf("       be combined with multiple modal diameters\n");
           printf("       in cyclic symmetry calculations\n\n");
           FORTRAN(stop,());
           }
           RENEW(d,double,nev+nevd);
           RENEW(nm,ITG,nev+nevd);
       }
       
       if(nherm==1){
           if(fread(&d[nev],sizeof(double),nevd,f1)!=nevd){
           printf(" *ERROR in steadystate reading the eigenvalues for nodal diameter %" ITGFORMAT " in the eigenvalue file",nmd);
           printf(" *INFO  in steadystate: if there are problems reading the .eig file this may be due to:\n");
           printf("        1) the nonexistence of the .eig file\n");
           printf("        2) other boundary conditions than in the input deck\n");
           printf("           which created the .eig file\n\n");
           exit(0);
           }
           for(i=nev;i<nev+nevd;i++){
           if(d[i]<0){d[i]=0.;}
           }
       }else{
           if(fread(&d[nev],sizeof(double),2*nevd,f1)!=2*nevd){
           printf(" *ERROR in steadystate reading the eigenvalues in the eigenvalue file...");
           printf(" *INFO  in steadystate: if there are problems reading the .eig file this may be due to:\n");
           printf("        1) the nonexistence of the .eig file\n");
           printf("        2) other boundary conditions than in the input deck\n");
           printf("           which created the .eig file\n\n");
           exit(0);
           }
       }
 
       for(i=nev;i<nev+nevd;i++){nm[i]=nmd;}
       
       if(nev==0){
           NNEW(adb,double,neq[1]);
           NNEW(aub,double,nzs[1]);
 
           if(fread(adb,sizeof(double),neq[1],f1)!=neq[1]){
           printf(" *ERROR in steadystate reading the diagonal of the mass matrix in the eigenvalue file");
           printf(" *INFO  in steadystate: if there are problems reading the .eig file this may be due to:\n");
           printf("        1) the nonexistence of the .eig file\n");
           printf("        2) other boundary conditions than in the input deck\n");
           printf("           which created the .eig file\n\n");
           exit(0);
           }
           
           if(fread(aub,sizeof(double),nzs[1],f1)!=nzs[1]){
           printf(" *ERROR in steadystate reading the off-diagonals of the mass matrix in the eigenvalue file");
           printf(" *INFO  in steadystate: if there are problems reading the .eig file this may be due to:\n");
           printf("        1) the nonexistence of the .eig file\n");
           printf("        2) other boundary conditions than in the input deck\n");
           printf("           which created the .eig file\n\n");
           exit(0);
           }
       }
       
           /* reading the eigenvectors */
 
       if(nev==0){
           NNEW(z,double,neq[1]*nevd);
       }else{
           RENEW(z,double,(long long)neq[1]*(nev+nevd));
       }
       
       if(fread(&z[(long long)neq[1]*nev],sizeof(double),neq[1]*nevd,f1)!=neq[1]*nevd){
           printf(" *ERROR in steadystate reading the eigenvectors for nodal diameter %" ITGFORMAT " in the eigenvalue file",nmd);
           printf(" *INFO  in steadystate: if there are problems reading the .eig file this may be due to:\n");
           printf("        1) the nonexistence of the .eig file\n");
           printf("        2) other boundary conditions than in the input deck\n");
           printf("           which created the .eig file\n\n");
           exit(0);
       }
 
       /* reading the orthogonality matrices */
       
       if(nherm!=1){
           NNEW(xmr,double,nev*nev);
           NNEW(xmi,double,nev*nev);
           if(fread(xmr,sizeof(double),nev*nev,f1)!=nev*nev){
           printf(" *ERROR in steadystate reading the real orthogonality matrix to the eigenvalue file...");
           printf(" *INFO  in steadystate: if there are problems reading the .eig file this may be due to:\n");
           printf("        1) the nonexistence of the .eig file\n");
           printf("        2) other boundary conditions than in the input deck\n");
           printf("           which created the .eig file\n\n");
           exit(0);
           }
           
           if(fread(xmi,sizeof(double),nev*nev,f1)!=nev*nev){
           printf(" *ERROR in steadystate reading the imaginary orthogonality matrix to the eigenvalue file...");
           printf(" *INFO  in steadystate: if there are problems reading the .eig file this may be due to:\n");
           printf("        1) the nonexistence of the .eig file\n");
           printf("        2) other boundary conditions than in the input deck\n");
           printf("           which created the .eig file\n\n");
           exit(0);
           }
       }
 
       nev+=nevd;
       }while(1);
 
       /* determining the maximum amount of sectors */
 
       for(i=0;i<*mcs;i++){
       if(cs[17*i]>nsectors) nsectors=(ITG)(cs[17*i]+0.5);
       }
 
         /* determining the maximum number of sectors to be plotted */
 
       for(j=0;j<*mcs;j++){
       if(cs[17*j+4]>ngraph) ngraph=(ITG)cs[17*j+4];
       }
       nkg=*nk*ngraph;
       neg=*ne*ngraph;
 
       /* allocating field for the expanded structure */
 
       RENEW(co,double,3**nk*nsectors);
 
       /* next line is necessary for multiple cyclic symmetry
          conditions */
 
       for(i=3**nk;i<3**nk*nsectors;i++){co[i]=0.;}
       if(*ithermal!=0){
       RENEW(t0,double,*nk*nsectors);
       RENEW(t1old,double,*nk*nsectors);
       RENEW(t1,double,*nk*nsectors);
       if(*nam>0) RENEW(iamt1,ITG,*nk*nsectors);
       }
       RENEW(nactdof,ITG,mt**nk*nsectors);
       if(*ntrans>0) RENEW(inotr,ITG,2**nk*nsectors);
       RENEW(kon,ITG,*nkon*nsectors);
       RENEW(ipkon,ITG,*ne*nsectors);
       for(i=*ne;i<*ne*nsectors;i++){ipkon[i]=-1;}
       RENEW(lakon,char,8**ne*nsectors);
       RENEW(ielmat,ITG,mi[2]**ne*nsectors);
       if(*norien>0) RENEW(ielorien,ITG,mi[2]**ne*nsectors);
 //      RENEW(z,double,(long long)neq[1]*nev*nsectors/2);
 
       RENEW(nodeboun,ITG,*nboun*nsectors);
       RENEW(ndirboun,ITG,*nboun*nsectors);
       if(*nam>0) RENEW(iamboun,ITG,*nboun*nsectors);
       RENEW(xboun,double,*nboun*nsectors);
       RENEW(xbounold,double,*nboun*nsectors);
       RENEW(ikboun,ITG,*nboun*nsectors);
       RENEW(ilboun,ITG,*nboun*nsectors);
 
       NNEW(ipompcold,ITG,*nmpc);
       NNEW(nodempcold,ITG,3**mpcend);
       NNEW(coefmpcold,double,*mpcend);
       NNEW(labmpcold,char,20**nmpc);
       NNEW(ikmpcold,ITG,*nmpc);
       NNEW(ilmpcold,ITG,*nmpc);
 
       for(i=0;i<*nmpc;i++){ipompcold[i]=ipompc[i];}
       for(i=0;i<3**mpcend;i++){nodempcold[i]=nodempc[i];}
       for(i=0;i<*mpcend;i++){coefmpcold[i]=coefmpc[i];}
       for(i=0;i<20**nmpc;i++){labmpcold[i]=labmpc[i];}
       for(i=0;i<*nmpc;i++){ikmpcold[i]=ikmpc[i];}
       for(i=0;i<*nmpc;i++){ilmpcold[i]=ilmpc[i];}
       nmpcold=*nmpc;
       mpcendold=*mpcend;
 
       RENEW(ipompc,ITG,*nmpc*nsectors);
       RENEW(nodempc,ITG,3**mpcend*nsectors);
       RENEW(coefmpc,double,*mpcend*nsectors);
       RENEW(labmpc,char,20**nmpc*nsectors+1);
       RENEW(ikmpc,ITG,*nmpc*nsectors);
       RENEW(ilmpc,ITG,*nmpc*nsectors);
       RENEW(fmpc,double,*nmpc*nsectors);
 
       /* reallocating the fields for the nodes in which the
          solution has to be calculated */
 
       RENEW(imddof,ITG,neq[1]/2*nsectors);
       RENEW(imdnode,ITG,*nk*nsectors);
       RENEW(imdboun,ITG,*nboun*nsectors);
       RENEW(imdmpc,ITG,*nmpc*nsectors);
 
 //izdofNNEW(//      izdof,ITG,1);
 
       expand(co,nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,xboun,nboun,
     ipompc,nodempc,coefmpc,labmpc,nmpc,nodeforc,ndirforc,xforc,
         nforc,nelemload,sideload,xload,nload,nactdof,neq,
     nmethod,ikmpc,ilmpc,ikboun,ilboun,elcon,nelcon,rhcon,nrhcon,
     alcon,nalcon,alzero,ielmat,ielorien,norien,orab,ntmat_,
     t0,ithermal,prestr,iprestr,vold,iperturb,sti,nzs,
     adb,aub,filab,eme,plicon,nplicon,plkcon,nplkcon,
         xstate,npmat_,matname,mi,ics,cs,mpcend,ncmat_,
         nstate_,mcs,nkon,ener,jobnamec,output,set,nset,istartset,
         iendset,ialset,nprint,prlab,prset,nener,trab,
         inotr,ntrans,ttime,fmpc,&nev,&z,iamboun,xbounold,
     &nsectors,nm,icol,irow,nzl,nam,ipompcold,nodempcold,coefmpcold,
         labmpcold,&nmpcold,xloadold,iamload,t1old,t1,iamt1,xstiff,&icole,&jqe,
         &irowe,isolver,nzse,&adbe,&aube,iexpl,
     ibody,xbody,nbody,cocon,ncocon,tieset,&ntie,imddof,&nmddof,
     imdnode,&nmdnode,imdboun,&nmdboun,imdmpc,&nmdmpc,&izdof,&nzdof,
     &nherm,xmr,xmi,typeboun,ielprop,prop,orname);
 
       RENEW(imddof,ITG,nmddof);
       RENEW(imdnode,ITG,nmdnode);
       RENEW(imdboun,ITG,nmdboun);
       RENEW(imdmpc,ITG,nmdmpc);
 
       SFREE(vold);
       NNEW(vold,double,mt**nk);
       SFREE(veold);
       NNEW(veold,double,mt**nk);
       RENEW(eme,double,6*mi[0]**ne);
 
       if(*nener==1) RENEW(ener,double,mi[0]**ne);
   }
 
   fclose(f1);
 
   /* allocating space for the friction coefficients */
 
   if(nherm==1){
       NNEW(fric,double,nev);
   }else{
       NNEW(fric,double,2*nev);
   }
 
   /* check whether there are dashpot elements */
 
   dashpot=0;
   for(i=0;i<*ne;i++){
       if(ipkon[i]==-1) continue;
       if(strcmp1(&lakon[i*8],"ED")==0){
       dashpot=1;break;}
   }
   if(dashpot){
 
       if(cyclicsymmetry){
       printf(" *ERROR in steadystate: dashpots are not allowed in combination with cyclic symmetry\n");
       FORTRAN(stop,());
       }
 
       if(nherm!=1){
       printf("ERROR in steadystate: dashpots cannot be combined with non-Hermitian systems (in the present version of CalculiX)\n");
       FORTRAN(stop,());
       }
 
       /* cc is the reduced damping matrix (damping matrix mapped onto
          space spanned by eigenmodes) */
 
       NNEW(cc,double,nev*nev);
 /*      nev2=2*nev;
       NNEW(am,double,nev2*nev2);
       NNEW(bm,double,nev2);
       NNEW(ipiv,ITG,nev2);*/
   }
 
   NNEW(inum,ITG,*nk);
   strcpy1(&cflag[0],&filab[4],1);
   FORTRAN(createinum,(ipkon,inum,kon,lakon,nk,ne,&cflag[0],nelemload,
       nload,nodeboun,nboun,ndirboun,ithermal,co,vold,mi,ielmat));
 
   /* check whether integration point values are requested; if not,
      the stress fields do not have to be allocated */
 
   intpointvar=0;
   if(*ithermal<=1){
 
       /* mechanical */
 
       if((strcmp1(&filab[174],"S")==0)||
      (strcmp1(&filab[261],"E")==0)||
      (strcmp1(&filab[348],"RF")==0)||
      (strcmp1(&filab[435],"PEEQ")==0)||
      (strcmp1(&filab[522],"ENER")==0)||
      (strcmp1(&filab[609],"SDV")==0)||
      (strcmp1(&filab[1044],"ZZS")==0)||
      (strcmp1(&filab[1044],"ERR")==0)||
      (strcmp1(&filab[1479],"PHS")==0)||
      (strcmp1(&filab[1653],"MAXS")==0)||
      (strcmp1(&filab[2175],"CONT")==0)||
      (strcmp1(&filab[2262],"CELS")==0)) intpointvar=1;
       for(i=0;i<*nprint;i++){
       if((strcmp1(&prlab[6*i],"S")==0)||
          (strcmp1(&prlab[6*i],"E")==0)||
          (strcmp1(&prlab[6*i],"PEEQ")==0)||
          (strcmp1(&prlab[6*i],"ENER")==0)||
          (strcmp1(&prlab[6*i],"SDV")==0)||
          (strcmp1(&prlab[6*i],"RF")==0)) {intpointvar=1;break;}
       }
   }else{
 
       /* thermal */
 
       if((strcmp1(&filab[696],"HFL")==0)||
      (strcmp1(&filab[783],"RFL")==0)) intpointvar=1;
       for(i=0;i<*nprint;i++){
       if((strcmp1(&prlab[6*i],"HFL")==0)||
          (strcmp1(&prlab[6*i],"RFL")==0)) {intpointvar=1;break;}
       }
   }
    
   if(nfour<=0){
 
       /* harmonic excitation */
 
       NNEW(ikactmechr,ITG,neq[1]);
       NNEW(ikactmechi,ITG,neq[1]);
       nactmechr=0;nactmechi=0;
       
       /* result fields */
       
       if(intpointvar==1){
       NNEW(fn,double,mt**nk);
       NNEW(stnr,double,6**nk);
       NNEW(stni,double,6**nk);
       NNEW(stx,double,6*mi[0]**ne);
       NNEW(eei,double,6*mi[0]**ne);
 
       if(*ithermal>1) {NNEW(qfn,double,3**nk);
           NNEW(qfx,double,3*mi[0]**ne);}
       
       if(strcmp1(&filab[261],"E   ")==0) NNEW(een,double,6**nk);
       if(strcmp1(&filab[522],"ENER")==0) NNEW(enern,double,*nk);
       if(strcmp1(&filab[2697],"ME  ")==0) NNEW(emn,double,6**nk);
       
       if(*nener==1){
           NNEW(stiini,double,6*mi[0]**ne);
           NNEW(emeini,double,6*mi[0]**ne);
           NNEW(enerini,double,mi[0]**ne);}
       }
       
       /* determining the frequency data points */
       
       NNEW(freq,double,ndata*(nev+1));
       
       ndatatot=0.;
       freq[0]=fmin;
       if(fabs(fmax-fmin)<1.e-10){
       ndatatot=1;
       }else{
 
       /* copy the eigenvalues and sort them in ascending order
          (important for values from distinct nodal diameters */
 
       NNEW(e,double,nev);
       if(nherm==1){
           for(i=0;i<nev;i++){e[i]=sqrt(d[i]);}
       }else{
 
               /* for complex eigenvalues: sorting the real part */
 
           for(i=0;i<nev;i++){
           e[i]=sqrt(sqrt(d[2*i]*d[2*i]+d[2*i+1]*d[2*i+1])+d[2*i])/sqrt(2.);
           }
       }
       FORTRAN(dsort,(e,&idummy,&nev,&iflag));
       
       for(i=0;i<nev;i++){
           if(i!=0){
           if(fabs(e[i]-e[i-1])<1.e-5){continue;}
           }
           if(e[i]>=fmin){
           if(e[i]<=fmax){
               for(j=1;j<ndata;j++){
               y=-1.+2.*j/((double)(ndata-1));
               if(fabs(y)<1.e-10){freq[ndatatot+j]=
                                  (freq[ndatatot]+e[i])/2.;}
               else{
                   freq[ndatatot+j]=(freq[ndatatot]+e[i])/2.+
                   (e[i]-freq[ndatatot])*pow(fabs(y),1./bias)*
                                   y/(2.*fabs(y));
               }
               }
               ndatatot+=ndata-1;
           }
           else{break;}
           }
       }
 
       SFREE(e);
 
       for(j=1;j<ndata;j++){
           y=-1.+2.*j/((double)(ndata-1));
           if(fabs(y)<1.e-10){freq[ndatatot+j]=(freq[ndatatot]+fmax)/2.;}
           else{
           freq[ndatatot+j]=(freq[ndatatot]+fmax)/2.+
               (fmax-freq[ndatatot])*pow(fabs(y),1./bias)*
                       y/(2.*fabs(y));
           }
       }
       ndatatot+=ndata;
       }
       RENEW(freq,double,ndatatot);
       
       /*  check for nonzero SPC's */
       
       iprescribedboundary=0;
       for(i=0;i<*nboun;i++){
       if(fabs(xboun[i])>1.e-10){
           iprescribedboundary=1;
           nmdnode=0;nmddof=0;nmdboun=0;nmdmpc=0;
           break;
       }
       }
 
       if((iprescribedboundary)&&(cyclicsymmetry)){
       printf(" *ERROR in steadystate: prescribed boundaries are not allowed in combination with cyclic symmetry\n");
       FORTRAN(stop,());
       }
 
       /* calculating the damping coefficients = friction coefficient*2*eigenvalue */
       
       if(xmodal[10]<0){
       for(i=0;i<nev;i++){
           if(nherm==1){
           if(sqrt(d[i])>(1.e-10)){
               fric[i]=(alpham+betam*d[i]);
           }
           else {
               printf("*WARNING in steadystate: one of the frequencies is zero\n");
               printf("         no Rayleigh mass damping allowed\n");
               fric[i]=0.;
           }
           }else{
           fric[2*i]=sqrt(sqrt(d[2*i]*d[2*i]+d[2*i+1]*d[2*i+1])+d[2*i])/
                            sqrt(2.);
           fric[2*i+1]=sqrt(sqrt(d[2*i]*d[2*i]+d[2*i+1]*d[2*i+1])-d[2*i])/
                            sqrt(2.);
           if(d[2*i+1]<0.) fric[2*i+1]=-fric[2*i+1];
           fric[2*i]=alpham+betam*fric[2*i];
           fric[2*i+1]=betam*fric[2*i+1];
           }
       }
       }
       else{
       if(iprescribedboundary){
           printf(" *ERROR in steadystate: prescribed boundaries are not allowed in combination with direct modal damping\n");
           FORTRAN(stop,());
       }
           
       /*copy the damping coefficients for every eigenfrequencie from xmodal[11....] */
       if(nev<(ITG)xmodal[10]){
           imax=nev;
           printf("*WARNING in steadystate: too many modal damping coefficients applied\n");
           printf("         damping coefficients corresponding to nonexisting eigenvalues are ignored\n");
       }
       else{
           imax=(ITG)xmodal[10];
       }
       for(i=0; i<imax; i++){
           if(nherm==1){
           fric[i]=2.*sqrt(d[i])*xmodal[11+i];    
           }else{
           fric[2*i]=sqrt(sqrt(d[2*i]*d[2*i]+d[2*i+1]*d[2*i+1])+d[2*i])/
                            sqrt(2.);
           fric[2*i+1]=sqrt(sqrt(d[2*i]*d[2*i]+d[2*i+1]*d[2*i+1])-d[2*i])/
                            sqrt(2.);
           if(d[2*i+1]<0.) fric[2*i+1]=-fric[2*i+1];
           fric[2*i]=2.*fric[2*i]*xmodal[11+i];
           fric[2*i+1]=2.*fric[2*i+1]*xmodal[11+i];
           } 
       }
       
       }
       
       /* check whether the loading is real or imaginary */
       
       NNEW(iphaseforc,ITG,*nforc);
       for (i=0;i<*nforc;i++){
       if(nodeforc[2*i+1]>=nsectors){
           iphaseforc[i]=1;
       }
       }
       
       NNEW(iphaseload,ITG,*nload);
       for (i=0;i<*nload;i++){
       if(nelemload[2*i+1]>=nsectors){
           iphaseload[i]=1;
       }
       }
       
       if(iprescribedboundary){
       NNEW(iphaseboun,ITG,*nboun);
       for (i=0;i<*nboun;i++){
           if(nodeboun[i]>*nk){
           iphaseboun[i]=1;
           nodeboun[i]=nodeboun[i]-*nk;
           }
       }
       }
       
       /* allocating actual loading fields */
       
       NNEW(xforcact,double,*nforc);
       NNEW(xforcr,double,*nforc);
       NNEW(xforci,double,*nforc);
       
       NNEW(xloadact,double,2**nload);
       NNEW(xloadr,double,2**nload);
       NNEW(xloadi,double,2**nload);
       
       NNEW(xbodyact,double,7**nbody);
       NNEW(xbodyr,double,7**nbody);
       NNEW(xbodyi,double,7**nbody);
       /* copying the rotation axis and/or acceleration vector */
       for(k=0;k<7**nbody;k++){xbodyact[k]=xbody[k];}
       
       NNEW(xbounact,double,*nboun);
       
       if(*ithermal==1) NNEW(t1act,double,*nk);
       
       /* assigning the body forces to the elements */ 
 
       if(*nbody>0){
       ifreebody=*ne+1;
       NNEW(ipobody,ITG,2*ifreebody**nbody);
       for(k=1;k<=*nbody;k++){
           FORTRAN(bodyforce,(cbody,ibody,ipobody,nbody,set,istartset,
                  iendset,ialset,&inewton,nset,&ifreebody,&k));
           RENEW(ipobody,ITG,2*(*ne+ifreebody));
       }
       RENEW(ipobody,ITG,2*(ifreebody-1));
       }
       
       NNEW(br,double,neq[1]); /* load rhs vector */
       NNEW(bi,double,neq[1]); /* load rhs vector */
       
       if(iprescribedboundary){
       NNEW(xbounr,double,*nboun);
       NNEW(xbouni,double,*nboun);
       
       NNEW(fr,double,neq[1]); /* force corresponding to real particular solution */
       NNEW(fi,double,neq[1]); /* force corresponding to imaginary particular solution */
       
       NNEW(ubr,double,neq[1]); /* real particular solution */
       NNEW(ubi,double,neq[1]); /* imaginary particular solution */
       
       NNEW(mubr,double,neq[1]); /* mass times real particular solution */
       NNEW(mubi,double,neq[1]); /* mass times imaginary particular solution */
       }
       
       NNEW(bjr,double,nev); /* real response modal decomposition */
       NNEW(bji,double,nev); /* imaginary response modal decomposition */
       
       NNEW(ampli,double,*nam); /* instantaneous amplitude */
       
       if(nherm==1){
       NNEW(aa,double,nev); /* modal coefficients of the real loading */
       NNEW(bb,double,nev); /* modal coefficients of the imaginary loading */
       }else{
       NNEW(aa,double,2*nev); /* modal coefficients of the real loading */
       NNEW(bb,double,2*nev); /* modal coefficients of the imaginary loading */
       }
     
       /* result fields */
       
       NNEW(vr,double,mt**nk);
       NNEW(vi,double,mt**nk);
       
       if(iprescribedboundary){
       
       /* LU decomposition of the stiffness matrix */
       
       if(*isolver==0){
 #ifdef SPOOLES
           spooles_factor(ad,au,adb,aub,&sigma,icol,irow,&neq[1],&nzs[1],
                       &symmetryflag,&inputformat,&nzs[2]);
 #else
           printf(" *ERROR in steadystate: the SPOOLES library is not linked\n\n");
           FORTRAN(stop,());
 #endif
       }
       else if(*isolver==4){
 #ifdef SGI
           token=1;
           sgi_factor(ad,au,adb,aub,&sigma,icol,irow,&neq[1],&nzs[1],token);
 #else
           printf(" *ERROR in steadystate: the SGI library is not linked\n\n");
           FORTRAN(stop,());
 #endif
       }
       else if(*isolver==5){
 #ifdef TAUCS
           tau_factor(ad,&au,adb,aub,&sigma,icol,&irow,&neq[1],&nzs[1]);
 #else
           printf(" *ERROR in steadystate: the TAUCS library is not linked\n\n");
           FORTRAN(stop,());
 #endif
       }
       else if(*isolver==7){
 #ifdef PARDISO
           pardiso_factor(ad,au,adb,aub,&sigma,icol,irow,&neq[1],&nzs[1],
                  &symmetryflag,&inputformat,jq,&nzs[2]);
 #else
           printf(" *ERROR in steadystate: the PARDISO library is not linked\n\n");
           FORTRAN(stop,());
 #endif
       }
       }
       
       for(l=0;l<ndatatot;l=l+*jout){
       for(i=0;i<6*mi[0]**ne;i++){eme[i]=0.;}
       time=freq[l]/(2.*pi);
       timem=-time;
       ptime=time;
 
       /* calculating cc */
 
       if(dashpot){
           NNEW(adc,double,neq[1]);
           NNEW(auc,double,nzs[1]);
           FORTRAN(mafilldm,(co,nk,kon,ipkon,lakon,ne,nodeboun,
                 ndirboun,xboun,nboun,
             ipompc,nodempc,coefmpc,nmpc,nodeforc,ndirforc,xforc,
             nforc,nelemload,sideload,xload,nload,xbody,ipobody,nbody,cgr,
             adc,auc,nactdof,icol,jq,irow,neq,nzl,nmethod,
             ikmpc,ilmpc,ikboun,ilboun,
             elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat,
             ielorien,norien,orab,ntmat_,
             t0,t0,ithermal,prestr,iprestr,vold,iperturb,sti,
             nzs,stx,adb,aub,iexpl,plicon,nplicon,plkcon,nplkcon,
             xstiff,npmat_,&dtime,matname,mi,ncmat_,
             ttime,&time,istep,&iinc,ibody,clearini,&mortar,springarea,
                 pslavsurf,pmastsurf,&reltime,&nasym));
 
           /*  zc = damping matrix * eigenmodes */
           
           NNEW(zc,double,neq[1]*nev);
           for(i=0;i<nev;i++){
           FORTRAN(op,(&neq[1],&z[(long long)i*neq[1]],&zc[i*neq[1]],adc,auc,
                   jq,irow));
           }
           
           /* cc is the reduced damping matrix (damping matrix mapped onto
          space spanned by eigenmodes) */
           
           for(i=0;i<nev*nev;i++){cc[i]=0.;}
           for(i=0;i<nev;i++){
           for(j=0;j<=i;j++){
               for(k=0;k<neq[1];k++){
               cc[i*nev+j]+=z[(long long)j*neq[1]+k]*zc[i*neq[1]+k];
               }
           }
           }
           
           /* symmetric part of cc matrix */
           
           for(i=0;i<nev;i++){
           for(j=i;j<nev;j++){
               cc[i*nev+j]=cc[j*nev+i];
           }
           }
           SFREE(zc);SFREE(adc);SFREE(auc);
       }
       
       /* calculating the instantaneous loads (forces, surface loading, 
          centrifugal and gravity loading or temperature) */
       
       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,itg,&ntg,amname,
            ikboun,ilboun,nelemload,sideload,mi,
                ntrans,trab,inotr,veold,integerglob,doubleglob,tieset,istartset,
                iendset,ialset,&ntie,nmpc,ipompc,ikmpc,ilmpc,nodempc,coefmpc,
                ipobody,iponoel,inoel));
       
       /* real part of forces */
       
       for (i=0;i<*nforc;i++){
           xforcr[i]=xforcact[i]*(1-iphaseforc[i]);
       }
       
       for (i=0;i<*nload;i++){
           for(j=0;j<2;j++){
           xloadr[2*i+j]=xloadact[2*i+j]*(1-iphaseload[i]);
           }
       }
 
       for(i=0;i<*nbody;i++){
           for(j=0;j<7;j++){
           xbodyr[7*i+j]=xbodyact[7*i+j];
           }
           if(ibody[3*i+2]==2){
           xbodyr[7*i]=0.;
           }
       }
       
       /* calculating the instantaneous loading vector */
       
       FORTRAN(rhs,(co,nk,kon,ipkon,lakon,ne,
                ipompc,nodempc,coefmpc,nmpc,nodeforc,ndirforc,xforcr,
                nforc,nelemload,sideload,xloadr,nload,xbodyr,
                ipobody,nbody,cgr,br,nactdof,&neq[1],nmethod,
                ikmpc,ilmpc,elcon,nelcon,rhcon,nrhcon,
                alcon,nalcon,alzero,ielmat,ielorien,norien,orab,ntmat_,
                t0,t1act,ithermal,iprestr,vold,iperturb,iexpl,plicon,
                nplicon,plkcon,nplkcon,
                npmat_,ttime,&time,istep,&iinc,&dtime,physcon,ibody,
                        xbodyold,&reltime,veold,matname,mi,ikactmechr,
                        &nactmechr,ielprop,prop,sti,xstateini,xstate,nstate_));
       
       /* real modal coefficients */
       
       if(!iprescribedboundary){
 
           if(nherm==1){
           if(!cyclicsymmetry){
               for(i=0;i<nev;i++){
               i2=(long long)i*neq[1];
               aa[i]=0.;
               if(nactmechr<neq[1]/2){
                   for(j=0;j<nactmechr;j++){
                   aa[i]+=z[i2+ikactmechr[j]]*br[ikactmechr[j]];
                   }
               }else{
                   for(j=0;j<neq[1];j++){
                   aa[i]+=z[i2+j]*br[j];
                   }
               }
               }
           }else{
               for(i=0;i<nev;i++){aa[i]=0.;}
               for(j=0;j<nactmechr;j++){
               for(i=0;i<nev;i++){
                   FORTRAN(nident,(izdof,&ikactmechr[j],&nzdof,&id));
                   if(id!=0){
                   if(izdof[id-1]==ikactmechr[j]){
                       aa[i]+=z[(long long)i*nzdof+id-1]*br[ikactmechr[j]];
                   }else{printf(" *ERROR in steadystate\n");FORTRAN(stop,());}
                   }else{printf(" *ERROR in steadystate\n");FORTRAN(stop,());}
               }
               }
           }
           }else{
           if(!cyclicsymmetry){
               for(i=0;i<nev;i++){
               aa[2*i]=0.;aa[2*i+1]=0.;
               if(nactmechr<neq[1]/2){
                   for(j=0;j<nactmechr;j++){
                   aa[2*i]+=z[(long long)2*i*neq[1]+ikactmechr[j]]*br[ikactmechr[j]];
                   aa[2*i+1]+=z[(long long)(2*i+1)*neq[1]+ikactmechr[j]]*br[ikactmechr[j]];
                   }
               }else{
                   for(j=0;j<neq[1];j++){
                   aa[2*i]+=z[(long long)2*i*neq[1]+j]*br[j];
                   aa[2*i+1]+=z[(long long)(2*i+1)*neq[1]+j]*br[j];
                   }
               }
               }
           }else{
               for(i=0;i<nev;i++){aa[2*i]=0.;aa[2*i+1]=0.;}
               for(j=0;j<nactmechr;j++){
               for(i=0;i<nev;i++){
                   FORTRAN(nident,(izdof,&ikactmechr[j],&nzdof,&id));
                   if(id!=0){
                   if(izdof[id-1]==ikactmechr[j]){
                       aa[i]+=z[(long long)2*i*nzdof+id-1]*br[ikactmechr[j]];
                       aa[i]+=z[(long long)(2*i+1)*nzdof+id-1]*br[ikactmechr[j]];
                   }else{printf(" *ERROR in steadystate\n");FORTRAN(stop,());}
                   }else{printf(" *ERROR in steadystate\n");FORTRAN(stop,());}
               }
               }
           }
           }
       
       }else{
       
           /* correction for nonzero SPC's */
           
           /* next statement makes sure that br is reset to zero at the
                  start of rhs.f */
           nactmechr=neq[1];
 
           /* real part of boundary conditions */
           
           for (i=0;i<*nboun;i++){
           xbounr[i]=xbounact[i]*(1-iphaseboun[i]);
           }
           
           for(j=0;j<neq[1];j++){fr[j]=0.;ubr[j]=0.;}
           for(i=0;i<*nboun;i++){
           ic=neq[1]+i;
           for(j=jq[ic]-1;j<jq[ic+1]-1;j++){
               ir=irow[j]-1;
               fr[ir]=fr[ir]-au[j]*xbounr[i];
               ubr[ir]=fr[ir];
           }
           }
           if(*isolver==0){
 #ifdef SPOOLES
           spooles_solve(ubr,&neq[1]);
 #endif
           }
           else if(*isolver==4){
 #ifdef SGI
           sgi_solve(ubr,token);
 #endif
           }
           else if(*isolver==5){
 #ifdef TAUCS
           tau_solve(ubr,&neq[1]);
 #endif
           }
           else if(*isolver==7){
 #ifdef PARDISO
           pardiso_solve(ubr,&neq[1],&symmetryflag);
 #endif
           }
           FORTRAN(op,(&neq[1],ubr,mubr,adb,aub,jq,irow));
       }
       
       /* imaginary part of forces */
       
       for (i=0;i<*nforc;i++){
           xforci[i]=xforcact[i]*iphaseforc[i];
       }
       
       for (i=0;i<*nload;i++){
           for(j=0;j<2;j++){
           xloadi[2*i+j]=xloadact[2*i+j]*iphaseload[i];
           }
       }
       
       for(i=0;i<*nbody;i++){
           for(j=0;j<7;j++){
           xbodyi[7*i+j]=xbodyact[7*i+j];
           }
           if(ibody[3*i+2]==1){
           xbodyi[7*i]=0.;
           }
       }
       
       /* calculating the instantaneous loading vector */
       
       FORTRAN(rhs,(co,nk,kon,ipkon,lakon,ne,
                ipompc,nodempc,coefmpc,nmpc,nodeforc,ndirforc,xforci,
                nforc,nelemload,sideload,xloadi,nload,xbodyi,
                ipobody,nbody,cgr,bi,nactdof,&neq[1],nmethod,
                ikmpc,ilmpc,elcon,nelcon,rhcon,nrhcon,
                alcon,nalcon,alzero,ielmat,ielorien,norien,orab,ntmat_,
                t0,t1act,ithermal,iprestr,vold,iperturb,iexpl,plicon,
                nplicon,plkcon,nplkcon,
                npmat_,ttime,&time,istep,&iinc,&dtime,physcon,ibody,
                        xbodyold,&reltime,veold,matname,mi,ikactmechi,
                        &nactmechi,ielprop,prop,sti,xstateini,xstate,nstate_));
       
       /* imaginary modal coefficients */
       
       if(!iprescribedboundary){
 
           if(nherm==1){
           if(!cyclicsymmetry){
               for(i=0;i<nev;i++){
               i2=(long long)i*neq[1];
               bb[i]=0.;
               if(nactmechi<neq[1]/2){
                   for(j=0;j<nactmechi;j++){
                   bb[i]+=z[i2+ikactmechi[j]]*bi[ikactmechi[j]];
                   }
               }else{
                   for(j=0;j<neq[1];j++){
                   bb[i]+=z[i2+j]*bi[j];
                   }
               }
               }
           }else{
               for(i=0;i<nev;i++){bb[i]=0.;}
               for(j=0;j<nactmechi;j++){
               for(i=0;i<nev;i++){
                   FORTRAN(nident,(izdof,&ikactmechi[j],&nzdof,&id));
                   if(id!=0){
                   if(izdof[id-1]==ikactmechi[j]){
                       bb[i]+=z[(long long)i*nzdof+id-1]*bi[ikactmechi[j]];
                   }else{printf(" *ERROR in steadystate\n");FORTRAN(stop,());}
                   }else{printf(" *ERROR in steadystate\n");FORTRAN(stop,());}
               }
               }
           }
           }else{
           if(!cyclicsymmetry){
               for(i=0;i<nev;i++){
               bb[2*i]=0.;bb[2*i+1]=0.;
               if(nactmechi<neq[1]/2){
                   for(j=0;j<nactmechi;j++){
                   bb[2*i]+=z[(long long)2*i*neq[1]+ikactmechi[j]]*bi[ikactmechi[j]];
                   bb[2*i+1]+=z[(long long)(2*i+1)*neq[1]+ikactmechi[j]]*bi[ikactmechi[j]];
                   }
               }else{
                   for(j=0;j<neq[1];j++){
                   bb[2*i]+=z[(long long)2*i*neq[1]+j]*bi[j];
                   bb[2*i+1]+=z[(long long)(2*i+1)*neq[1]+j]*bi[j];
                   }
               }
               }
           }else{
               for(i=0;i<nev;i++){bb[2*i]=0.;bb[2*i+1]=0.;}
               for(j=0;j<nactmechi;j++){
               for(i=0;i<nev;i++){
                   FORTRAN(nident,(izdof,&ikactmechi[j],&nzdof,&id));
                   if(id!=0){
                   if(izdof[id-1]==ikactmechi[j]){
                       bb[2*i]+=z[(long long)2*i*nzdof+id-1]*bi[ikactmechi[j]];
                       bb[2*i+1]+=z[(long long)(2*i+1)*nzdof+id-1]*bi[ikactmechi[j]];
                   }else{printf(" *ERROR in steadystate\n");FORTRAN(stop,());}
                   }else{printf(" *ERROR in steadystate\n");FORTRAN(stop,());}
               }
               }
           }
           }
 
       }else{
       
       /* correction for nonzero SPC's */
           
           /* next statement makes sure that bi is reset to zero at the
                  start of rhs.f */
 
           nactmechi=neq[1];
           
           /* imaginary part of boundary conditions */
           
           for (i=0;i<*nboun;i++){
           xbouni[i]=xbounact[i]*iphaseboun[i];
           }
           
           for(j=0;j<neq[1];j++){fi[j]=0.;ubi[j]=0.;}
           for(i=0;i<*nboun;i++){
           ic=neq[1]+i;
           for(j=jq[ic]-1;j<jq[ic+1]-1;j++){
               ir=irow[j]-1;
               fi[ir]=fi[ir]-au[j]*xbouni[i];
               ubi[ir]=fi[ir];
           }
           }
           if(*isolver==0){
 #ifdef SPOOLES
           spooles_solve(ubi,&neq[1]);
 #endif
           }
           else if(*isolver==4){
 #ifdef SGI
           sgi_solve(ubi,token);
 #endif
           }
           else if(*isolver==5){
 #ifdef TAUCS
           tau_solve(ubi,&neq[1]);
 #endif
           }
           else if(*isolver==7){
 #ifdef PARDISO
           pardiso_solve(ubi,&neq[1],&symmetryflag);
 #endif
           }
           FORTRAN(op,(&neq[1],ubi,mubi,adb,aub,jq,irow));
       
           /* correction for prescribed boundary conditions */
       
           for(i=0;i<neq[1];i++){
           br[i]+=freq[l]*(freq[l]*mubr[i]+alpham*mubi[i]+betam*fi[i]);
           bi[i]+=freq[l]*(freq[l]*mubi[i]-alpham*mubr[i]-betam*fr[i]);
           }
       
           /* real and imaginary modal coefficients */
 
           for(i=0;i<nev;i++){
           aa[i]=0.;
           for(j=0;j<neq[1];j++){
               aa[i]+=z[(long long)i*neq[1]+j]*br[j];
           }
           }
           
           for(i=0;i<nev;i++){
           bb[i]=0.;
           for(j=0;j<neq[1];j++){
               bb[i]+=z[(long long)i*neq[1]+j]*bi[j];
           }
           }
           
       }
       
       /* calculating the modal coefficients */
       
       if(nherm==1){
           if(dashpot==0){
           for(i=0;i<nev;i++){
               dd=pow(d[i]-pow(freq[l],2),2)+
               pow(fric[i],2)*pow(freq[l],2);
               bjr[i]=(aa[i]*(d[i]-freq[l]*freq[l])+
                   bb[i]*fric[i]*freq[l])/dd;
               bji[i]=(bb[i]*(d[i]-freq[l]*freq[l])-
                   aa[i]*fric[i]*freq[l])/dd;
           }
           /*    printf("old l=%" ITGFORMAT ",bjr=%f,bji=%f\n",l,bjr[0],bji[0]);*/
           }else{
           nev2=2*nev;
           NNEW(am,double,nev2*nev2);
           NNEW(bm,double,nev2);
           NNEW(ipiv,ITG,nev2);
           
           for(i=0;i<nev2;i++){
               for(j=0;j<nev2;j++){
               am[i*nev2+j]=0.;
               }
               bm[i]=0.;
           }
           for(i=0;i<nev;i++){
               am[i*nev2+i]=d[i]-freq[l]*freq[l];
               am[(i+nev)*nev2+i]=-fric[i]*freq[l];
               bm[i]=aa[i];
               am[i*nev2+nev+i]=-am[(i+nev)*nev2+i];
               am[(i+nev)*nev2+nev+i]=am[i*nev2+i];
               bm[nev+i]=bb[i];
               for(j=0;j<nev;j++){
               am[(j+nev)*nev2+i]=am[(j+nev)*nev2+i]
                   -cc[i*nev+j]*freq[l];
               am[j*nev2+nev+i]=am[j*nev2+nev+i]
                   +cc[i*nev+j]*freq[l];
               }
           }
           
           /* solving the system of equations */
           
           FORTRAN(dgesv,(&nev2,&nrhs,am,&nev2,ipiv,bm,&nev2,&info));
           if(info!=0){
               printf(" *ERROR in steadystate: fatal termination of dgesv\n");
               printf("       info=%" ITGFORMAT "\n",info);
               FORTRAN(stop,());
           }
           
           /* storing the solution in bjr and bji */
           
           for(i=0;i<nev;i++){
               bjr[i]=bm[i];
               bji[i]=bm[nev+i];
           }
 
           SFREE(am);SFREE(bm);SFREE(ipiv);
           }
       }else{
           nev2=2*nev;
           NNEW(am,double,nev2*nev2);
           NNEW(bm,double,nev2);
           NNEW(ipiv,ITG,nev2);
           
           NNEW(ax,double,nev);
           NNEW(bx,double,nev);
           for(i=0;i<nev;i++){
           ax[i]=-pow(freq[l],2)-freq[l]*fric[2*i+1]+d[2*i];
           bx[i]=-freq[l]*fric[2*i]-d[2*i+1];
           }
           for(i=0;i<nev;i++){
           for(j=0;j<nev;j++){
               am[j*nev2+i]=xmr[j*nev+i]*ax[j]+xmi[j*nev+i]*bx[j];
               am[(j+nev)*nev2+i]=xmr[j*nev+i]*bx[j]-xmi[j*nev+i]*bx[j];
               am[j*nev2+nev+i]=xmi[j*nev+i]*ax[j]-xmr[j*nev+i]*bx[j];
               am[(j+nev)*nev2+nev+i]=xmi[j*nev+i]*bx[j]+xmr[j*nev+i]*ax[j];
           }
           bm[i]=aa[i]-bb[nev+i];
           bm[nev+i]=bb[i]+aa[nev+i];
           }
           SFREE(ax);SFREE(bx);
           
           /* solving the system of equations */
           
           FORTRAN(dgesv,(&nev2,&nrhs,am,&nev2,ipiv,bm,&nev2,&info));
           if(info!=0){
           printf(" *ERROR in steadystate: fatal termination of dgesv\n");
           printf("       info=%" ITGFORMAT "\n",info);
           FORTRAN(stop,());
           }
           
           /* storing the solution in bjr and bji */
           
           for(i=0;i<nev;i++){
           bjr[i]=bm[i];
           bji[i]=bm[nev+i];
           }
           
           SFREE(am);SFREE(bm);SFREE(ipiv);
       }
 
           /* storing the participation factors */
 
       if(nherm==1){
           NNEW(eig,double,nev);
           for(i=0;i<nev;i++){
           eig[i]=sqrt(d[i]);
           }
       }else{
           
           NNEW(eig,double,2*nev);
           for(i=0;i<nev;i++){
           eig[2*i]=sqrt(sqrt(d[2*i]*d[2*i]+d[2*i+1]*d[2*i+1])+d[2*i])
               /sqrt(2.);
           eig[2*i+1]=sqrt(sqrt(d[2*i]*d[2*i]+d[2*i+1]*d[2*i+1])-d[2*i])
               /sqrt(2.);
           if(d[2*i+1]<0.) eig[2*i+1]=-eig[2*i+1];
           }
       }
       
       mode=0;
       FORTRAN(writepf,(eig,bjr,bji,&time,&nev,&mode,&nherm));
       SFREE(eig);
       
       /* calculating the real response */
       
       if(iprescribedboundary){
           if(nmdnode==0){
           memcpy(&br[0],&ubr[0],sizeof(double)*neq[1]);
           }else{
           for(i=0;i<nmddof;i++){
               br[imddof[i]]=ubr[imddof[i]];
           }
           }
       }
       else{
           if(nmdnode==0){
           DMEMSET(br,0,neq[1],0.);
           }else{
           for(i=0;i<nmddof;i++){
               br[imddof[i]]=0.;
           }
           }
       }
       
       if(!cyclicsymmetry){
           if(nmdnode==0){
           for(i=0;i<neq[1];i++){
               for(j=0;j<nev;j++){
               br[i]+=bjr[j]*z[(long long)j*neq[1]+i];
               }
           }
           }else{
           for(i=0;i<nmddof;i++){
               for(j=0;j<nev;j++){
               br[imddof[i]]+=bjr[j]*z[(long long)j*neq[1]+imddof[i]];
               }
           }
           }
       }else{
           for(i=0;i<nmddof;i++){
           FORTRAN(nident,(izdof,&imddof[i],&nzdof,&id));
           if(id!=0){
               if(izdof[id-1]==imddof[i]){
               for(j=0;j<nev;j++){
                   br[imddof[i]]+=bjr[j]*z[(long long)j*nzdof+id-1];
               }
               }else{printf(" *ERROR in steadystate\n");FORTRAN(stop,());}
           }else{printf(" *ERROR in steadystate\n");FORTRAN(stop,());}
           }
       }
       
       if(nmdnode==0){
           DMEMSET(vr,0,mt**nk,0.);
       }else{
           for(jj=0;jj<nmdnode;jj++){
           i=imdnode[jj]-1;
           for(j=1;j<4;j++){
               vr[mt*i+j]=0.;
           }
           }
       }
       
       /* calculating the imaginary response */
       
       if(iprescribedboundary){
           if(nmdnode==0){
           memcpy(&bi[0],&ubi[0],sizeof(double)*neq[1]);
           }else{
           for(i=0;i<nmddof;i++){
               bi[imddof[i]]=ubi[imddof[i]];
           }
           }
       }
       else{
           if(nmdnode==0){
           DMEMSET(bi,0,neq[1],0.);
           }else{
           for(i=0;i<nmddof;i++){
               bi[imddof[i]]=0.;
           }
           }
       }
       
       if(!cyclicsymmetry){
           if(nmdnode==0){
           for(i=0;i<neq[1];i++){
               for(j=0;j<nev;j++){
               bi[i]+=bji[j]*z[(long long)j*neq[1]+i];
               }
           }
           }else{
           for(i=0;i<nmddof;i++){
               for(j=0;j<nev;j++){
               bi[imddof[i]]+=bji[j]*z[(long long)j*neq[1]+imddof[i]];
               }
           }
           }
       }else{
           for(i=0;i<nmddof;i++){
           FORTRAN(nident,(izdof,&imddof[i],&nzdof,&id));
           if(id!=0){
               if(izdof[id-1]==imddof[i]){
               for(j=0;j<nev;j++){
                   bi[imddof[i]]+=bji[j]*z[(long long)j*nzdof+id-1];
               }
               }else{printf(" *ERROR in steadystate\n");FORTRAN(stop,());}
           }else{printf(" *ERROR in steadystate\n");FORTRAN(stop,());}
           }
       }
       
       
       if(nmdnode==0){
           DMEMSET(vi,0,mt**nk,0.);
       }else{
           for(jj=0;jj<nmdnode;jj++){
           i=imdnode[jj]-1;
           for(j=1;j<4;j++){
               vi[mt*i+j]=0.;
           }
           }
       }
 
           /* real response */
 
       if(iprescribedboundary){
       
               /* calculating displacements/temperatures */
       
           FORTRAN(dynresults,(nk,vr,ithermal,nactdof,vold,nodeboun,
             ndirboun,xbounr,nboun,ipompc,nodempc,coefmpc,labmpc,nmpc,
             br,bi,veold,&dtime,mi,imdnode,&nmdnode,imdboun,&nmdboun,
             imdmpc,&nmdmpc,nmethod,&timem));
 
           results(co,nk,kon,ipkon,lakon,ne,vr,stnr,inum,
               stx,elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,
               ielmat,ielorien,norien,orab,ntmat_,t0,t1,
               ithermal,prestr,iprestr,filab,eme,emn,een,
               iperturb,f,fn,nactdof,&iout,qa,
               vold,br,nodeboun,ndirboun,xbounr,nboun,
               ipompc,nodempc,coefmpc,labmpc,nmpc,nmethod,cam,&neq[1],
               veold,accold,&bet,&gam,&dtime,&time,&xnull,
               plicon,nplicon,plkcon,nplkcon,
               xstateini,xstiff,xstate,npmat_,epn,matname,mi,&ielas,
               &icmd,ncmat_,nstate_,stiini,vini,ikboun,ilboun,ener,
               enern,emeini,xstaten,eei,enerini,cocon,ncocon,
               set,nset,istartset,iendset,ialset,nprint,prlab,prset,
               qfx,qfn,trab,inotr,ntrans,fmpc,nelemload,nload,
               ikmpc,ilmpc,istep,&iinc,springarea,&reltime,&ne0,
               xforc,nforc,thicke,shcon,nshcon,
               sideload,xload,xloadold,&icfd,inomat,pslavsurf,pmastsurf,
               &mortar,islavact,cdn,islavnode,nslavnode,&ntie,clearini,
                       islavsurf,ielprop,prop,energyini,energy,&iit,iponoel,
                       inoel,nener,orname,&network,ipobody,xbodyact,ibody);}
       else{
       
               /* calculating displacements/temperatures */
       
           FORTRAN(dynresults,(nk,vr,ithermal,nactdof,vold,nodeboun,
             ndirboun,xbounact,nboun,ipompc,nodempc,coefmpc,labmpc,nmpc,
             br,bi,veold,&dtime,mi,imdnode,&nmdnode,imdboun,&nmdboun,
             imdmpc,&nmdmpc,nmethod,&timem));
 
           results(co,nk,kon,ipkon,lakon,ne,vr,stnr,inum,
               stx,elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,
               ielmat,ielorien,norien,orab,ntmat_,t0,t1,
               ithermal,prestr,iprestr,filab,eme,emn,een,
               iperturb,f,fn,nactdof,&iout,qa,
               vold,br,nodeboun,ndirboun,xbounact,nboun,
               ipompc,nodempc,coefmpc,labmpc,nmpc,nmethod,cam,&neq[1],
               veold,accold,&bet,&gam,&dtime,&time,&xnull,
               plicon,nplicon,plkcon,nplkcon,
               xstateini,xstiff,xstate,npmat_,epn,matname,mi,&ielas,
               &icmd,ncmat_,nstate_,stiini,vini,ikboun,ilboun,ener,
               enern,emeini,xstaten,eei,enerini,cocon,ncocon,
               set,nset,istartset,iendset,ialset,nprint,prlab,prset,
               qfx,qfn,trab,inotr,ntrans,fmpc,nelemload,nload,
               ikmpc,ilmpc,istep,&iinc,springarea,&reltime,&ne0,
               xforc,nforc,thicke,shcon,nshcon,
               sideload,xload,xloadold,&icfd,inomat,pslavsurf,pmastsurf,
               &mortar,islavact,cdn,islavnode,nslavnode,&ntie,
               clearini,islavsurf,ielprop,prop,energyini,energy,&iit,
                       iponoel,inoel,nener,orname,&network,ipobody,xbodyact,
                       ibody);
           
           if(nmdnode==0){
           DMEMSET(br,0,neq[1],0.);
           }else{
           for(i=0;i<nmddof;i++){
               br[imddof[i]]=0.;
           }
           }
       }
       
       (*kode)++;
       
       mode=-1;
       if(strcmp1(&filab[1044],"ZZS")==0){
           NNEW(neigh,ITG,40**ne);
           NNEW(ipneigh,ITG,*nk);
       }
 
       frd(co,&nkg,kon,ipkon,lakon,&neg,vr,stnr,inum,nmethod,
         kode,filab,een,t1,fn,&ptime,epn,ielmat,matname,enern,xstaten,
         nstate_,istep,&iinc,ithermal,qfn,&mode,&noddiam,trab,inotr,
         ntrans,orab,ielorien,norien,description,ipneigh,neigh,
         mi,stx,vr,vi,stnr,stni,vmax,stnmax,&ngraph,veold,ener,&neg,
         cs,set,nset,istartset,iendset,ialset,eenmax,fnr,fni,emn,
         thicke,jobnamec,output,qfx,cdn,&mortar,cdnr,cdni,nmat);
 
       if(strcmp1(&filab[1044],"ZZS")==0){SFREE(ipneigh);SFREE(neigh);}
 
           /* imaginary response */
 
       if(iprescribedboundary){
       
               /* calculating displacements/temperatures */
       
           FORTRAN(dynresults,(nk,vi,ithermal,nactdof,vold,nodeboun,
             ndirboun,xbouni,nboun,ipompc,nodempc,coefmpc,labmpc,nmpc,
             bi,br,veold,&dtime,mi,imdnode,&nmdnode,imdboun,&nmdboun,
             imdmpc,&nmdmpc,nmethod,&time));
 
           results(co,nk,kon,ipkon,lakon,ne,vi,stni,inum,
               stx,elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,
               ielmat,ielorien,norien,orab,ntmat_,t0,t1,
               ithermal,prestr,iprestr,filab,eme,emn,een,
               iperturb,f,fn,nactdof,&iout,qa,
               vold,bi,nodeboun,ndirboun,xbouni,nboun,
               ipompc,nodempc,coefmpc,labmpc,nmpc,nmethod,cam,&neq[1],
               veold,accold,&bet,&gam,&dtime,&time,&xnull,
               plicon,nplicon,plkcon,nplkcon,
               xstateini,xstiff,xstate,npmat_,epn,matname,mi,&ielas,
               &icmd,ncmat_,nstate_,stiini,vini,ikboun,ilboun,ener,
               enern,emeini,xstaten,eei,enerini,cocon,ncocon,
               set,nset,istartset,iendset,ialset,nprint,prlab,prset,
               qfx,qfn,trab,inotr,ntrans,fmpc,nelemload,nload,
               ikmpc,ilmpc,istep,&iinc,springarea,&reltime,&ne0,
               xforc,nforc,thicke,shcon,nshcon,
               sideload,xload,xloadold,&icfd,inomat,pslavsurf,pmastsurf,
               &mortar,islavact,cdn,islavnode,nslavnode,&ntie,clearini,
                       islavsurf,ielprop,prop,energyini,energy,&iit,iponoel,
                       inoel,nener,orname,&network,ipobody,xbodyact,ibody);}
       else{ 
       
               /* calculating displacements/temperatures */
       
           FORTRAN(dynresults,(nk,vi,ithermal,nactdof,vold,nodeboun,
             ndirboun,xbounact,nboun,ipompc,nodempc,coefmpc,labmpc,nmpc,
             bi,br,veold,&dtime,mi,imdnode,&nmdnode,imdboun,&nmdboun,
             imdmpc,&nmdmpc,nmethod,&time));
 
           results(co,nk,kon,ipkon,lakon,ne,vi,stni,inum,
               stx,elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,
               ielmat,ielorien,norien,orab,ntmat_,t0,t1,
               ithermal,prestr,iprestr,filab,eme,emn,een,
               iperturb,f,fn,nactdof,&iout,qa,
               vold,bi,nodeboun,ndirboun,xbounact,nboun,
               ipompc,nodempc,coefmpc,labmpc,nmpc,nmethod,cam,&neq[1],
               veold,accold,&bet,&gam,&dtime,&time,&xnull,
               plicon,nplicon,plkcon,nplkcon,
               xstateini,xstiff,xstate,npmat_,epn,matname,mi,&ielas,
               &icmd,ncmat_,nstate_,stiini,vini,ikboun,ilboun,ener,
               enern,emeini,xstaten,eei,enerini,cocon,ncocon,
               set,nset,istartset,iendset,ialset,nprint,prlab,prset,
               qfx,qfn,trab,inotr,ntrans,fmpc,nelemload,nload,
               ikmpc,ilmpc,istep,&iinc,springarea,&reltime,&ne0,
               xforc,nforc,thicke,shcon,nshcon,
               sideload,xload,xloadold,&icfd,inomat,pslavsurf,pmastsurf,
               &mortar,islavact,cdn,islavnode,nslavnode,&ntie,
               clearini,islavsurf,ielprop,prop,energyini,energy,&iit,
                       iponoel,inoel,nener,orname,&network,ipobody,xbodyact,
                       ibody);
 
           if(nmdnode==0){
           DMEMSET(bi,0,neq[1],0.);
           }else{
           for(i=0;i<nmddof;i++){
               bi[imddof[i]]=0.;
           }
           }
       }
       
       /* calculating the magnitude and phase */
       
       if(strcmp1(&filab[870],"PU")==0){
           
           constant=180./pi;
           NNEW(va,double,mt**nk);
           NNEW(vp,double,mt**nk);
           
           if(*ithermal<=1){
           if(nmdnode==0){
               for(i=0;i<*nk;i++){
               for(j=1;j<4;j++){
                   vreal=vr[mt*i+j];
                   va[mt*i+j]=sqrt(vr[mt*i+j]*vr[mt*i+j]+vi[mt*i+j]*vi[mt*i+j]);
                   if(fabs(vreal)<1.e-10){
                   if(vi[mt*i+j]>0.){vp[mt*i+j]=90.;}
                   else{vp[mt*i+j]=-90.;}
                   }
                   else{
                   vp[mt*i+j]=atan(vi[mt*i+j]/vreal)*constant;
                   if(vreal<0.) vp[mt*i+j]+=180.;
                   }
               }
               }
           }else{
               for(jj=0;jj<nmdnode;jj++){
               i=imdnode[jj]-1;
               for(j=1;j<4;j++){
                   vreal=vr[mt*i+j];
                   va[mt*i+j]=sqrt(vr[mt*i+j]*vr[mt*i+j]+vi[mt*i+j]*vi[mt*i+j]);
                   if(fabs(vreal)<1.e-10){
                   if(vi[mt*i+j]>0.){vp[mt*i+j]=90.;}
                   else{vp[mt*i+j]=-90.;}
                   }
                   else{
                   vp[mt*i+j]=atan(vi[mt*i+j]/vreal)*constant;
                   if(vreal<0.) vp[mt*i+j]+=180.;
                   }
               }
               }
           }
           }
           else{
           if(nmdnode==0){
               for(i=0;i<*nk;i++){
               vreal=vr[mt*i];
               va[mt*i]=sqrt(vr[mt*i]*vr[mt*i]+vi[mt*i]*vi[mt*i]);
               if(fabs(vreal)<1.e-10){
                   if(vi[mt*i]>0){vp[mt*i]=90.;}
                   else{vp[mt*i]=-90.;}
               }
               else{
                   vp[mt*i]=atan(vi[mt*i]/vreal)*constant;
                   if(vreal<0.) vp[mt*i]+=180.;
               }
               }
           }else{
               for(jj=0;jj<nmdnode;jj++){
               i=imdnode[jj]-1;
               vreal=vr[mt*i];
               va[mt*i]=sqrt(vr[mt*i]*vr[mt*i]+vi[mt*i]*vi[mt*i]);
               if(fabs(vreal)<1.e-10){
                   if(vi[mt*i]>0){vp[mt*i]=90.;}
                   else{vp[mt*i]=-90.;}
               }
               else{
                   vp[mt*i]=atan(vi[mt*i]/vreal)*constant;
                   if(vreal<0.) vp[mt*i]+=180.;
               }
               }
           }
           }
       }
       
       if(strcmp1(&filab[1479],"PHS")==0){
           
           constant=180./pi;
           NNEW(stna,double,6**nk);
           NNEW(stnp,double,6**nk);
           
           if(*ithermal<=1){
           if(nmdnode==0){
               for(i=0;i<*nk;i++){
               for(j=0;j<6;j++){
                   vreal=stnr[6*i+j];
                   stna[6*i+j]=sqrt(stnr[6*i+j]*stnr[6*i+j]+stni[6*i+j]*stni[6*i+j]);
                   if(fabs(vreal)<1.e-10){
                   if(stni[6*i+j]>0.){stnp[6*i+j]=90.;}
                   else{stnp[6*i+j]=-90.;}
                   }
                   else{
                   stnp[6*i+j]=atan(stni[6*i+j]/vreal)*constant;
                   if(vreal<0.) stnp[6*i+j]+=180.;
                   }
               }
               }
           }else{
               for(jj=0;jj<nmdnode;jj++){
               i=imdnode[jj]-1;
               for(j=0;j<6;j++){
                   vreal=stnr[6*i+j];
                   stna[6*i+j]=sqrt(stnr[6*i+j]*stnr[6*i+j]+stni[6*i+j]*stni[6*i+j]);
                   if(fabs(vreal)<1.e-10){
                   if(stni[6*i+j]>0.){stnp[6*i+j]=90.;}
                   else{stnp[6*i+j]=-90.;}
                   }
                   else{
                   stnp[6*i+j]=atan(stni[6*i+j]/vreal)*constant;
                   if(vreal<0.) stnp[6*i+j]+=180.;
                   }
               }
               }
           }
           }
       }
  
 //    (*kode)++;
       mode=0;
       
       if(strcmp1(&filab[1044],"ZZS")==0){
           NNEW(neigh,ITG,40**ne);
           NNEW(ipneigh,ITG,*nk);
       }
 
       frd(co,&nkg,kon,ipkon,lakon,&neg,vi,stni,inum,nmethod,
         kode,filab,een,t1,fn,&ptime,epn,ielmat,matname,enern,xstaten,
         nstate_,istep,&iinc,ithermal,qfn,&mode,&noddiam,trab,inotr,
         ntrans,orab,ielorien,norien,description,ipneigh,neigh,
         mi,stx,va,vp,stna,stnp,vmax,stnmax,&ngraph,veold,ener,&neg,
         cs,set,nset,istartset,iendset,ialset,eenmax,fnr,fni,emn,
         thicke,jobnamec,output,qfx,cdn,&mortar,cdnr,cdni,nmat);
 
       if(strcmp1(&filab[1044],"ZZS")==0){SFREE(ipneigh);SFREE(neigh);}
 
       SFREE(va);SFREE(vp);SFREE(stna);SFREE(stnp);
       
       }
       
       /* restoring the imaginary loading */
       
       SFREE(iphaseforc);SFREE(xforcr);SFREE(xforci);
 
       SFREE(iphaseload);SFREE(xloadr);SFREE(xloadi);
       
       SFREE(xbodyr);SFREE(xbodyi);
       
       if(iprescribedboundary){
       for (i=0;i<*nboun;i++){
           if(iphaseboun[i]==1){
           nodeboun[i]=nodeboun[i]+*nk;
           }
       }
       SFREE(iphaseboun);
       }
       
       /* 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){xboun[k]=xbounact[k];}
       for(k=0;k<*nforc;++k){xforc[k]=xforcact[k];}
       for(k=0;k<2**nload;++k){xload[k]=xloadact[k];}
       for(k=0;k<7**nbody;k=k+7){xbody[k]=xbodyact[k];}
       if(*ithermal==1){
       for(k=0;k<*nk;++k){t1[k]=t1act[k];}
       }
       
       SFREE(br);SFREE(bi);SFREE(bjr);SFREE(bji),SFREE(freq);
       SFREE(xforcact);SFREE(xloadact);SFREE(xbounact);SFREE(aa);SFREE(bb);
       SFREE(ampli);SFREE(xbodyact);SFREE(vr);SFREE(vi);if(*nbody>0) SFREE(ipobody);
       
       if(*ithermal==1) SFREE(t1act);
       
       if(iprescribedboundary){
       if(*isolver==0){
 #ifdef SPOOLES
           spooles_cleanup();
 #endif
       }
       else if(*isolver==4){
 #ifdef SGI
           sgi_cleanup(token);
 #endif
       }
       else if(*isolver==5){
 #ifdef TAUCS
           tau_cleanup();
 #endif
       }
       else if(*isolver==7){
 #ifdef PARDISO
           pardiso_cleanup(&neq[1],&symmetryflag);
 #endif
       }
       SFREE(xbounr);SFREE(xbouni);SFREE(fr);SFREE(fi);SFREE(ubr);SFREE(ubi);
       SFREE(mubr);SFREE(mubi);
       }
 
       SFREE(ikactmechr);SFREE(ikactmechi);
       
       if(intpointvar==1){
       SFREE(fn);
       SFREE(stnr);SFREE(stni);SFREE(stx);SFREE(eei);
 
       if(*ithermal>1) {SFREE(qfn);SFREE(qfx);}
       
       if(strcmp1(&filab[261],"E   ")==0) SFREE(een);
       if(strcmp1(&filab[522],"ENER")==0) SFREE(enern);
       if(strcmp1(&filab[2697],"ME  ")==0) SFREE(emn);
       
       if(*nener==1){SFREE(stiini);SFREE(emeini);SFREE(enerini);}
       }
 
   }else{
 
       /* steady state response to a nonharmonic periodic loading */
 
       NNEW(ikactmech,ITG,neq[1]);
       nactmech=0;
       
       NNEW(xforcact,double,nfour**nforc);
       NNEW(xloadact,double,nfour*2**nload);
       NNEW(xbodyact,double,nfour*7**nbody);
       NNEW(xbounact,double,nfour**nboun);
       NNEW(xbounacttime,double,nfour**nboun);
       if(*ithermal==1) NNEW(t1act,double,*nk);
 
       NNEW(r,double,nfour);
       NNEW(wsave,double,2*nfour);
       NNEW(isave,ITG,15);
       
       /*  check for nonzero SPC's */
       
       iprescribedboundary=0;
       for(i=0;i<*nboun;i++){
       if(fabs(xboun[i])>1.e-10){
           iprescribedboundary=1;
           break;
       }
       }
 
       if((iprescribedboundary)&&(cyclicsymmetry)){
       printf(" *ERROR in steadystate: prescribed boundaries are not allowed in combination with cyclic symmetry\n");
       FORTRAN(stop,());
       }
 
       /* calculating the damping coefficients = friction coefficient*2*eigenvalue */
       
       if(xmodal[10]<0){
       for(i=0;i<nev;i++){
           if(sqrt(d[i])>(1.e-10)){
           fric[i]=(alpham+betam*d[i]);
           }
           else {
           printf("*WARNING in steadystate: one of the frequencies is zero\n");
           printf("         no Rayleigh mass damping allowed\n");
           fric[i]=0.;
           }
       }
       }
       else{
       if(iprescribedboundary){
           printf(" *ERROR in steadystate: prescribed boundaries are not allowed in combination with direct modal damping\n");
           FORTRAN(stop,());
       }
           
       /*copy the damping coefficients for every eigenfrequencie from xmodal[11....] */
       if(nev<(ITG)xmodal[10]){
           imax=nev;
           printf("*WARNING in steadystate: too many modal damping coefficients applied\n");
           printf("         damping coefficients corresponding to nonexisting eigenvalues are ignored\n");
       }
       else{
           imax=(ITG)xmodal[10];
       }
       for(i=0; i<imax; i++){
           fric[i]=2.*sqrt(d[i])*xmodal[11+i];     
       }
       
       }
 
       /* determining the load time history */
       
       NNEW(ampli,double,*nam); /* instantaneous amplitude */
 
       for(l=0;l<nfour;l++){
 
       time=tmin+(tmax-tmin)*(double)l/(double)nfour;
           
       FORTRAN(tempload,(xforcold,xforc,&xforcact[l**nforc],iamforc,nforc,
         xloadold,xload,&xloadact[l*2**nload],iamload,nload,ibody,xbody,
         nbody,xbodyold,&xbodyact[l*7**nbody],t1old,t1,t1act,
         iamt1,nk,amta,namta,nam,ampli,&time,&reltime,ttime,&dtime,
             ithermal,nmethod,xbounold,xboun,&xbounact[l**nboun],iamboun,nboun,
         nodeboun,ndirboun,nodeforc,ndirforc,istep,&iinc,co,vold,itg,&ntg,
         amname,ikboun,ilboun,nelemload,sideload,mi,
             ntrans,trab,inotr,veold,integerglob,doubleglob,tieset,istartset,
             iendset,ialset,&ntie,nmpc,ipompc,ikmpc,ilmpc,nodempc,coefmpc,
             ipobody,iponoel,inoel));
       
       }
 
       SFREE(ampli);
 
       for(i=0;i<l**nboun;i++){xbounacttime[i]=xbounact[i];}
 
       /* determining the load frequency history:
          frequency transform of the load time history */
 
       for(i=0;i<*nforc;i++){
       for(l=0;l<nfour;l++){
           r[l]=xforcact[l**nforc+i];
       }
       FORTRAN(drffti,(&nfour,wsave,isave));
       FORTRAN(drfftf,(&nfour,r,wsave,isave));
       for(l=0;l<nfour;l++){
           xforcact[l**nforc+i]=r[l]/nfour*2.;
       }
       xforcact[i]=xforcact[i]/2.;
       }
 
       for(i=0;i<*nload;i++){
       for(l=0;l<nfour;l++){
           r[l]=xloadact[l*2**nload+2*i];
       }
       FORTRAN(drffti,(&nfour,wsave,isave));
       FORTRAN(drfftf,(&nfour,r,wsave,isave));
       for(l=0;l<nfour;l++){
           xloadact[l*2**nload+2*i]=r[l]/nfour*2.;
       }
       xloadact[2*i]=xloadact[2*i]/2.;
       }
 
       for(i=0;i<*nbody;i++){
       for(l=0;l<nfour;l++){
           r[l]=xbodyact[l**nbody+7*i];
       }
       FORTRAN(drffti,(&nfour,wsave,isave));
       FORTRAN(drfftf,(&nfour,r,wsave,isave));
       for(l=0;l<nfour;l++){
           xbodyact[l**nbody+7*i]=r[l]/nfour*2.;
       }
       xbodyact[7*i]=xbodyact[7*i]/2.;
       }
 
       if(iprescribedboundary){
       for(i=0;i<*nboun;i++){
           for(l=0;l<nfour;l++){
           r[l]=xbounact[l**nboun+i];
           }
           FORTRAN(drffti,(&nfour,wsave,isave));
           FORTRAN(drfftf,(&nfour,r,wsave,isave));
           for(l=0;l<nfour;l++){
           xbounact[l**nboun+i]=r[l]/nfour*2.;
           }
           xbounact[i]=xbounact[i]/2.;
       }
       
       /* LU decomposition of the stiffness matrix */
       
       if(*isolver==0){
 #ifdef SPOOLES
           spooles_factor(ad,au,adb,aub,&sigma,icol,irow,&neq[1],&nzs[1],
                         &symmetryflag,&inputformat,&nzs[2]);
 #else
           printf(" *ERROR in steadystate: the SPOOLES library is not linked\n\n");
           FORTRAN(stop,());
 #endif
       }
       else if(*isolver==4){
 #ifdef SGI
           token=1;
           sgi_factor(ad,au,adb,aub,&sigma,icol,irow,&neq[1],&nzs[1],token);
 #else
           printf(" *ERROR in steadystate: the SGI library is not linked\n\n");
           FORTRAN(stop,());
 #endif
       }
       else if(*isolver==5){
 #ifdef TAUCS
           tau_factor(ad,&au,adb,aub,&sigma,icol,&irow,&neq[1],&nzs[1]);
 #else
           printf(" *ERROR in steadystate: the TAUCS library is not linked\n\n");
           FORTRAN(stop,());
 #endif
       }
       else if(*isolver==7){
 #ifdef PARDISO
           pardiso_factor(ad,au,adb,aub,&sigma,icol,irow,&neq[1],&nzs[1],
                  &symmetryflag,&inputformat,jq,&nzs[2]);
 #else
           printf(" *ERROR in steadystate: the PARDISO library is not linked\n\n");
           FORTRAN(stop,());
 #endif
       }
 
       }
 
       SFREE(r);SFREE(wsave);SFREE(isave);
 
       /* determining the frequency data points */
       
       NNEW(freqnh,double,ndata*(nev+1));
       
       ndatatot=0.;
       freqnh[0]=fmin;
       if(fabs(fmax-fmin)<1.e-10){
       ndatatot=1;
       }else{
 
       /* copy the eigenvalues and sort them in ascending order
          (important for values from distinct nodal diameters */
 
       NNEW(e,double,nev);
       for(i=0;i<nev;i++){e[i]=sqrt(d[i]);}
       FORTRAN(dsort,(e,&idummy,&nev,&iflag));
 
       for(i=0;i<nev;i++){
           if(i!=0){
           if(fabs(e[i]-e[i-1])<1.e-5){continue;}
           }
           if(e[i]>=fmin){
           if(e[i]<=fmax){
               for(j=1;j<ndata;j++){
               y=-1.+2.*j/((double)(ndata-1));
               if(fabs(y)<1.e-10){freqnh[ndatatot+j]=
                                  (freqnh[ndatatot]+e[i])/2.;}
               else{
                   freqnh[ndatatot+j]=(freqnh[ndatatot]+e[i])/2.+
                   (e[i]-freqnh[ndatatot])*pow(fabs(y),1./bias)
                                   *y/(2.*fabs(y));
               }
               }
               ndatatot+=ndata-1;
           }
           else{break;}
           }
       }
       SFREE(e);
       for(j=1;j<ndata;j++){
           y=-1.+2.*j/((double)(ndata-1));
           if(fabs(y)<1.e-10){freqnh[ndatatot+j]=
                          (freqnh[ndatatot]+fmax)/2.;}
           else{
           freqnh[ndatatot+j]=(freqnh[ndatatot]+fmax)/2.+
               (fmax-freqnh[ndatatot])*pow(fabs(y),1./bias)*
                       y/(2.*fabs(y));
           }
       }
       ndatatot+=ndata;
       }
       RENEW(freqnh,double,ndatatot);
 
       for(ii=0;ii<ndatatot;ii++){
       for(i=0;i<6*mi[0]**ne;i++){eme[i]=0.;}
 
       sprintf(description,"%12f",freqnh[ii]/(2.*pi));
       
       NNEW(xforcr,double,*nforc);
       NNEW(xloadr,double,2**nload);
       NNEW(xbodyr,double,7**nbody);
       for(k=0;k<7**nbody;k++){xbodyr[k]=xbody[k];}
       if(iprescribedboundary){
           NNEW(xbounr,double,*nboun);
           NNEW(fr,double,neq[1]); /* force corresponding to real particular solution */
           NNEW(ubr,double,neq[1]); /* real particular solution */
           NNEW(mubr,double,neq[1]); /* mass times real particular solution */
       }
       
       /* assigning the body forces to the elements */ 
 
       if(*nbody>0){
           ifreebody=*ne+1;
           NNEW(ipobody,ITG,2*ifreebody**nbody);
           for(k=1;k<=*nbody;k++){
           FORTRAN(bodyforce,(cbody,ibody,ipobody,nbody,set,istartset,
                 iendset,ialset,&inewton,nset,&ifreebody,&k));
           RENEW(ipobody,ITG,2*(*ne+ifreebody));
           }
           RENEW(ipobody,ITG,2*(ifreebody-1));
       }
       
       NNEW(br,double,neq[1]); /* load rhs vector (real part) */
       NNEW(bi,double,neq[1]); /* load rhs vector (imaginary part) */
       NNEW(btot,double,nfour*neq[1]);
       NNEW(bp,double,nfour*neq[1]);
       
       NNEW(bjr,double,nev); /* real response modal decomposition */
       NNEW(bji,double,nev); /* imaginary response modal decomposition */
       
       NNEW(aa,double,nev); /* modal coefficients of the real loading */
       NNEW(bb,double,nev); /* modal coefficients of the imaginary loading */
       
       /* loop over all Fourier frequencies */
       
       NNEW(freq,double,nfour);
       
       for(l=0;l<nfour;l++){
           
           /* frequency */
           
           freq[l]=freqnh[ii]*floor((l+1.)/2.+0.1);
 
       /* calculating cc */
 
           if(dashpot){
           NNEW(adc,double,neq[1]);
           NNEW(auc,double,nzs[1]);
           FORTRAN(mafilldm,(co,nk,kon,ipkon,lakon,ne,nodeboun,
                     ndirboun,xboun,nboun,
                 ipompc,nodempc,coefmpc,nmpc,nodeforc,ndirforc,xforc,
                 nforc,nelemload,sideload,xload,nload,xbody,ipobody,
                     nbody,cgr,adc,auc,nactdof,icol,jq,irow,neq,nzl,nmethod,
                 ikmpc,ilmpc,ikboun,ilboun,
                 elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,ielmat,
                 ielorien,norien,orab,ntmat_,
                 t0,t0,ithermal,prestr,iprestr,vold,iperturb,sti,
                 nzs,stx,adb,aub,iexpl,plicon,nplicon,plkcon,nplkcon,
                 xstiff,npmat_,&dtime,matname,mi,ncmat_,
                 ttime,&freq[l],istep,&iinc,ibody,clearini,&mortar,springarea,
                     pslavsurf,pmastsurf,&reltime,&nasym));
           
           /*  zc = damping matrix * eigenmodes */
           
           NNEW(zc,double,neq[1]*nev);
           for(i=0;i<nev;i++){
               FORTRAN(op,(&neq[1],&z[(long long)i*neq[1]],&zc[i*neq[1]],
                                   adc,auc,jq,irow));
           }
           
           /* cc is the reduced damping matrix (damping matrix mapped onto
              space spanned by eigenmodes) */
           
           for(i=0;i<nev*nev;i++){cc[i]=0.;}
           for(i=0;i<nev;i++){
               for(j=0;j<=i;j++){
               for(k=0;k<neq[1];k++){
                   cc[i*nev+j]+=z[(long long)j*neq[1]+k]*zc[i*neq[1]+k];
               }
               }
           }
           
           /* symmetric part of cc matrix */
           
           for(i=0;i<nev;i++){
               for(j=i;j<nev;j++){
               cc[i*nev+j]=cc[j*nev+i];
               }
           }
           SFREE(zc);SFREE(adc);SFREE(auc);
           }
           
           /* loading for this frequency */
           
           for(i=0;i<*nforc;i++){
           xforcr[i]=xforcact[l**nforc+i];
           }
           
           for(i=0;i<*nload;i++){
           xloadr[2*i]=xloadact[l*2**nload+2*i];
           }
           
           for(i=0;i<*nbody;i++){
           xbodyr[7*i]=xbodyact[l**nbody+7*i];
           }
           
           /* calculating the instantaneous loading vector */
           
           FORTRAN(rhs,(co,nk,kon,ipkon,lakon,ne,
         ipompc,nodempc,coefmpc,nmpc,nodeforc,ndirforc,xforcr,
         nforc,nelemload,sideload,xloadr,nload,xbodyr,
         ipobody,nbody,cgr,br,nactdof,&neq[1],nmethod,
         ikmpc,ilmpc,elcon,nelcon,rhcon,nrhcon,
         alcon,nalcon,alzero,ielmat,ielorien,norien,orab,ntmat_,
         t0,t1act,ithermal,iprestr,vold,iperturb,iexpl,plicon,
         nplicon,plkcon,nplkcon,
         npmat_,ttime,&time,istep,&iinc,&dtime,physcon,ibody,
         xbodyold,&reltime,veold,matname,mi,ikactmech,&nactmech,
                 ielprop,prop,sti,xstateini,xstate,nstate_));
       
           /* real modal coefficients */
       
           if(!iprescribedboundary){
           if(!cyclicsymmetry){
               for(i=0;i<nev;i++){
               i2=(long long)i*neq[1];
               aa[i]=0.;
               if(nactmech<neq[1]/2){
                   for(j=0;j<nactmech;j++){
                   aa[i]+=z[i2+ikactmech[j]]*br[ikactmech[j]];
                   }
               }else{
                   for(j=0;j<neq[1];j++){
                   aa[i]+=z[i2+j]*br[j];
                   }
               }
               }
           }else{
               for(i=0;i<nev;i++){aa[i]=0.;}
               for(j=0;j<nactmech;j++){
               for(i=0;i<nev;i++){
                   FORTRAN(nident,(izdof,&ikactmech[j],&nzdof,&id));
                   if(id!=0){
                   if(izdof[id-1]==ikactmech[j]){
                       aa[i]+=z[(long long)i*nzdof+id-1]*br[ikactmech[j]];
                   }else{printf(" *ERROR in steadystate\n");FORTRAN(stop,());}
                   }else{printf(" *ERROR in steadystate\n");FORTRAN(stop,());}
               }
               }
           }
       
           /* imaginary modal coefficients */
           
           for(i=0;i<nev;i++){
               bb[i]=0.;
           }
 
           }else{
 
           /* prescribed boundary conditions */
           
               /* next statement makes sure that br is reset to zero at the
                      start of rhs.f */
 
           nactmech=neq[1];
           
           for(i=0;i<neq[1];i++){bi[i]=0.;}
           
           for(i=0;i<*nboun;i++){
               xbounr[i]=xbounact[l**nboun+i];
           }
           
           for(j=0;j<neq[1];j++){fr[j]=0.;ubr[j]=0.;}
           for(i=0;i<*nboun;i++){
               ic=neq[1]+i;
               for(j=jq[ic]-1;j<jq[ic+1]-1;j++){
               ir=irow[j]-1;
               fr[ir]=fr[ir]-au[j]*xbounr[i];
               ubr[ir]=fr[ir];
               }
           }
           if(*isolver==0){
 #ifdef SPOOLES
               spooles_solve(ubr,&neq[1]);
 #endif
           }
           else if(*isolver==4){
 #ifdef SGI
               sgi_solve(ubr,token);
 #endif
           }
           else if(*isolver==5){
 #ifdef TAUCS
               tau_solve(ubr,&neq[1]);
 #endif
           }
           else if(*isolver==7){
 #ifdef PARDISO
               pardiso_solve(ubr,&neq[1],&symmetryflag);
 #endif
           }
           FORTRAN(op,(&neq[1],ubr,mubr,adb,aub,jq,irow));
           
           for(i=0;i<neq[1];i++){
               br[i]+=freq[l]*(freq[l]*mubr[i]);
               bi[i]+=freq[l]*(-alpham*mubr[i]-betam*fr[i]);
           }
           
           /* real and imaginary modal coefficients */
           
           for(i=0;i<nev;i++){
               aa[i]=0.;
               for(j=0;j<neq[1];j++){
               aa[i]+=z[(long long)i*neq[1]+j]*br[j];
               }
           }
           
           for(i=0;i<nev;i++){
               bb[i]=0.;
               for(j=0;j<neq[1];j++){
               bb[i]+=z[(long long)i*neq[1]+j]*bi[j];
               }
           }
           }
           
           /* calculating the modal coefficients */
           
           if(dashpot==0){
           for(i=0;i<nev;i++){
               dd=pow(d[i]-pow(freq[l],2),2)+
               pow(fric[i],2)*pow(freq[l],2);
               bjr[i]=(aa[i]*(d[i]-freq[l]*freq[l])+
                   bb[i]*fric[i]*freq[l])/dd;
               bji[i]=(bb[i]*(d[i]-freq[l]*freq[l])-
                   aa[i]*fric[i]*freq[l])/dd;
           }
           }else{
           nev2=2*nev;
           NNEW(am,double,nev2*nev2);
           NNEW(bm,double,nev2);
           NNEW(ipiv,ITG,nev2);
           
           for(i=0;i<nev2;i++){
               for(j=0;j<nev2;j++){
               am[i*nev2+j]=0.;
               }
               bm[i]=0.;
           }
           for(i=0;i<nev;i++){
               am[i*nev2+i]=d[i]-freq[l]*freq[l];
               am[(i+nev)*nev2+i]=-fric[i]*freq[l];
               bm[i]=aa[i];
               am[i*nev2+nev+i]=-am[(i+nev)*nev2+i];
               am[(i+nev)*nev2+nev+i]=am[i*nev2+i];
               bm[nev+i]=bb[i];
               for(j=0;j<nev;j++){
               am[(j+nev)*nev2+i]=am[(j+nev)*nev2+i]
                   -cc[i*nev+j]*freq[l];
               am[j*nev2+nev+i]=am[j*nev2+nev+i]
                   +cc[i*nev+j]*freq[l];
               }
           }
           
           /* solving the system of equations */
           
           FORTRAN(dgesv,(&nev2,&nrhs,am,&nev2,ipiv,bm,&nev2,&info));
           if(info!=0){
               printf(" *ERROR in steadystate: fatal termination of dgesv\n");
               printf("       info=%" ITGFORMAT "\n",info);
 /*        FORTRAN(stop,());*/
           }
           
           /* storing the solution in bjr and bji */
           
           for(i=0;i<nev;i++){
               bjr[i]=bm[i];
               bji[i]=bm[nev+i];
           }
           
           SFREE(am);SFREE(bm);SFREE(ipiv);
           }
       
           /* calculating the real response */
           
           if(iprescribedboundary){
           if(nmdnode==0){
               memcpy(&br[0],&ubr[0],sizeof(double)*neq[1]);
           }else{
               for(i=0;i<nmddof;i++){
               br[imddof[i]]=ubr[imddof[i]];
               }
           }
           }
           else{
           if(nmdnode==0){
               DMEMSET(br,0,neq[1],0.);
           }else{
               for(i=0;i<nmddof;i++){
               br[imddof[i]]=0.;
               }
           }
           }
           
           if(!cyclicsymmetry){
           if(nmdnode==0){
               for(i=0;i<neq[1];i++){
               for(j=0;j<nev;j++){
                   br[i]+=bjr[j]*z[(long long)j*neq[1]+i];
               }
               }
           }else{
               for(i=0;i<nmddof;i++){
               for(j=0;j<nev;j++){
                   br[imddof[i]]+=bjr[j]*z[(long long)j*neq[1]+imddof[i]];
               }
               }
           }
           }else{
           for(i=0;i<nmddof;i++){
               FORTRAN(nident,(izdof,&imddof[i],&nzdof,&id));
               if(id!=0){
               if(izdof[id-1]==imddof[i]){
                   for(j=0;j<nev;j++){
                   br[imddof[i]]+=bjr[j]*z[(long long)j*nzdof+id-1];
                   }
               }else{printf(" *ERROR in steadystate\n");FORTRAN(stop,());}
               }else{printf(" *ERROR in steadystate\n");FORTRAN(stop,());}
           }
           }
       
           /* calculating the imaginary response */
           
           if(nmdnode==0){
           DMEMSET(bi,0,neq[1],0.);
           }else{
           for(i=0;i<nmddof;i++){
               bi[imddof[i]]=0.;
           }
           }
       
           if(!cyclicsymmetry){
           if(nmdnode==0){
               for(i=0;i<neq[1];i++){
               for(j=0;j<nev;j++){
                   bi[i]+=bji[j]*z[(long long)j*neq[1]+i];
               }
               }
           }else{
               for(i=0;i<nmddof;i++){
               for(j=0;j<nev;j++){
                   bi[imddof[i]]+=bji[j]*z[(long long)j*neq[1]+imddof[i]];
               }
               }
           }
           }else{
           for(i=0;i<nmddof;i++){
               FORTRAN(nident,(izdof,&imddof[i],&nzdof,&id));
               if(id!=0){
               if(izdof[id-1]==imddof[i]){
                   for(j=0;j<nev;j++){
                   bi[imddof[i]]+=bji[j]*z[(long long)j*nzdof+id-1];
                   }
               }else{printf(" *ERROR in steadystate\n");FORTRAN(stop,());}
               }else{printf(" *ERROR in steadystate\n");FORTRAN(stop,());}
           }
           }
           
           if(nmdnode==0){
           
           /* magnitude and phase of the response */
 
           for(i=0;i<neq[1];i++){
               breal=br[i];
               br[i]=sqrt(br[i]*br[i]+bi[i]*bi[i]);
               if(fabs(breal)<1.e-10){
               if(bi[i]>0.){bi[i]=pi/2.;}
               else{bi[i]=-pi/2.;}
               }
               else{
               bi[i]=atan(bi[i]/breal);
               if(breal<0.){bi[i]+=pi;}
               }
           }
           
           /* correction for the sinus terms */
           
           if((l!=0)&&(2*(ITG)floor(l/2.+0.1)==l)){
               for(i=0;i<neq[1];i++){
 //            bi[i]-=pi/2.;}
               bi[i]+=pi/2.;}
           }
           
           /* contribution to the time response */
           
           for(j=0;j<nfour;j++){
               time=tmin+2.*pi/freqnh[ii]*(double)j/(double)nfour;
               for(i=0;i<neq[1];i++){
               btot[j*neq[1]+i]+=br[i]*cos(freq[l]*time+bi[i]);
               bp[j*neq[1]+i]-=freq[l]*br[i]*sin(freq[l]*time+bi[i]);
               }
           }
           }else{
           
           /* magnitude and phase of the response */
 
           for(jj=0;jj<nmddof;jj++){
               i=imddof[jj];
               breal=br[i];
               br[i]=sqrt(br[i]*br[i]+bi[i]*bi[i]);
               if(fabs(breal)<1.e-10){
               if(bi[i]>0.){bi[i]=pi/2.;}
               else{bi[i]=-pi/2.;}
               }
               else{
               bi[i]=atan(bi[i]/breal);
               if(breal<0.){bi[i]+=pi;}
               }
           }
           
           /* correction for the sinus terms */
           
           if((l!=0)&&(2*(ITG)floor(l/2.+0.1)==l)){
               for(jj=0;jj<nmddof;jj++){
               i=imddof[jj];
 //            bi[i]-=pi/2.;}
               bi[i]+=pi/2.;}
           }
           
           /* contribution to the time response */
           
           for(j=0;j<nfour;j++){
               time=tmin+2.*pi/freqnh[ii]*(double)j/(double)nfour;
               for(jj=0;jj<nmddof;jj++){
               i=imddof[jj];
               btot[j*neq[1]+i]+=br[i]*cos(freq[l]*time+bi[i]);
               bp[j*neq[1]+i]-=freq[l]*br[i]*sin(freq[l]*time+bi[i]);
               }
           }
           }
 
               /* resetting the part of br occupied by the variables to be printed
                  to zero */
 
           if(!iprescribedboundary){
           if(nmdnode==0){
               DMEMSET(br,0,neq[1],0.);
           }else{
               for(i=0;i<nmddof;i++){
               br[imddof[i]]=0.;
               }
           }
           }
           
       }
       
       SFREE(xforcr);SFREE(xloadr);SFREE(xbodyr);SFREE(br);SFREE(bi);SFREE(freq);
       SFREE(bjr);SFREE(bji);SFREE(aa);SFREE(bb);
 
           if(*nbody>0) SFREE(ipobody);
       if(iprescribedboundary) {SFREE(xbounr);SFREE(fr);SFREE(ubr);SFREE(mubr);}
       
       
       /* result fields */
       
       NNEW(vr,double,mt**nk);
 
       if(intpointvar==1){
           NNEW(fn,double,mt**nk);
           NNEW(stn,double,6**nk);
           NNEW(stx,double,6*mi[0]**ne);
 
           if(*ithermal>1) {
           NNEW(qfn,double,3**nk);
           NNEW(qfx,double,3*mi[0]**ne);}
           
           if(strcmp1(&filab[261],"E   ")==0) NNEW(een,double,6**nk);
           if(strcmp1(&filab[522],"ENER")==0) NNEW(enern,double,*nk);
           if(strcmp1(&filab[2697],"ME  ")==0) NNEW(emn,double,6**nk);
           
           NNEW(eei,double,6*mi[0]**ne);
           if(*nener==1){
           NNEW(stiini,double,6*mi[0]**ne);
           NNEW(emeini,double,6*mi[0]**ne);
           NNEW(enerini,double,mi[0]**ne);}
       }
       
       /* storing the results */
       
       for(l=0;l<nfour;l++){
           time=tmin+2.*pi/freqnh[ii]*(double)l/(double)nfour;
           ptime=time;
           
           if(nmdnode==0){
           DMEMSET(vr,0,mt**nk,0.);
           }else{
           for(jj=0;jj<nmdnode;jj++){
               i=imdnode[jj]-1;
               for(j=1;j<4;j++){
               vr[mt*i+j]=0.;
               }
           }
           }
       
               /* calculating displacements/temperatures */
 
           *nmethod=4;
           FORTRAN(dynresults,(nk,vr,ithermal,nactdof,vold,nodeboun,
             ndirboun,&xbounacttime[l**nboun],nboun,ipompc,nodempc,
                     coefmpc,labmpc,nmpc,&btot[l*neq[1]],&bp[l*neq[1]],veold,&dtime,mi,
             imdnode,&nmdnode,imdboun,&nmdboun,imdmpc,&nmdmpc,nmethod,&time));
           *nmethod=5;
 
           results(co,nk,kon,ipkon,lakon,ne,vr,stn,inum,
               stx,elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,
               ielmat,ielorien,norien,orab,ntmat_,t0,t1,
               ithermal,prestr,iprestr,filab,eme,emn,een,
               iperturb,f,fn,nactdof,&iout,qa,
               vold,&btot[l*neq[1]],nodeboun,ndirboun,
                       &xbounacttime[l**nboun],nboun,
               ipompc,nodempc,coefmpc,labmpc,nmpc,nmethod,cam,&neq[1],
               veold,accold,&bet,&gam,&dtime,&time,&xnull,
               plicon,nplicon,plkcon,nplkcon,
               xstateini,xstiff,xstate,npmat_,epn,matname,mi,&ielas,
               &icmd,ncmat_,nstate_,stiini,vini,ikboun,ilboun,ener,
               enern,emeini,xstaten,eei,enerini,cocon,ncocon,
               set,nset,istartset,iendset,ialset,nprint,prlab,prset,
               qfx,qfn,trab,inotr,ntrans,fmpc,nelemload,nload,ikmpc,
               ilmpc,istep,&iinc,springarea,&reltime,&ne0,xforc,nforc,
               thicke,shcon,nshcon,
               sideload,xload,xloadold,&icfd,inomat,pslavsurf,pmastsurf,
               &mortar,islavact,cdn,islavnode,nslavnode,&ntie,clearini,
                       islavsurf,ielprop,prop,energyini,energy,&iit,iponoel,
                       inoel,nener,orname,&network,ipobody,xbodyact,ibody);
       
           (*kode)++;
           mode=-1;
           
           if(strcmp1(&filab[1044],"ZZS")==0){
           NNEW(neigh,ITG,40**ne);
           NNEW(ipneigh,ITG,*nk);
           }
 
           frd(co,&nkg,kon,ipkon,lakon,&neg,vr,stn,inum,nmethod,
           kode,filab,een,t1,fn,&ptime,epn,ielmat,matname,enern,xstaten,
           nstate_,istep,&iinc,ithermal,qfn,&mode,&noddiam,trab,inotr,
           ntrans,orab,ielorien,norien,description,ipneigh,neigh,
           mi,stx,vr,vi,stnr,stni,vmax,stnmax,&ngraph,veold,ener,&neg,
           cs,set,nset,istartset,iendset,ialset,eenmax,fnr,fni,emn,
           thicke,jobnamec,output,qfx,cdn,&mortar,cdnr,cdni,nmat);
 
           if(strcmp1(&filab[1044],"ZZS")==0){SFREE(ipneigh);SFREE(neigh);}
 
       }
       
       SFREE(vr);SFREE(btot);SFREE(bp);
 
       if(intpointvar==1){
           SFREE(fn);SFREE(stn);SFREE(stx);SFREE(eei);
           if(*ithermal>1) {SFREE(qfn);SFREE(qfx);}
           
           if(strcmp1(&filab[261],"E   ")==0) SFREE(een);
           if(strcmp1(&filab[522],"ENER")==0) SFREE(enern);
           if(strcmp1(&filab[2697],"ME  ")==0) SFREE(emn);
           
           if(*nener==1){SFREE(stiini);SFREE(emeini);SFREE(enerini);}
       }
       
       }
       SFREE(xforcact);SFREE(xloadact);SFREE(xbodyact);SFREE(xbounact);
       SFREE(xbounacttime);SFREE(freqnh);
       if(*ithermal==1) SFREE(t1act);
       if(iprescribedboundary){
       if(*isolver==0){
 #ifdef SPOOLES
           spooles_cleanup();
 #endif
       }
       else if(*isolver==4){
 #ifdef SGI
           sgi_cleanup(token);
 #endif
       }
       else if(*isolver==5){
 #ifdef TAUCS
           tau_cleanup();
 #endif
       }
       else if(*isolver==7){
 #ifdef PARDISO
           pardiso_cleanup(&neq[1],&symmetryflag);
 #endif
       }
       }
 
       SFREE(ikactmech);
 
   }
 
   SFREE(adb);SFREE(aub);SFREE(z);SFREE(d);SFREE(inum);
 
   if(!cyclicsymmetry){
       SFREE(ad);SFREE(au);
   }else{
       SFREE(izdof);SFREE(nm);
 
       *nk/=nsectors;
       *ne/=nsectors;
       *nboun/=nsectors;
       neq[1]=neq[1]*2/nsectors;
 
       RENEW(co,double,3**nk);
       if(*ithermal!=0){
       RENEW(t0,double,*nk);
       RENEW(t1old,double,*nk);
       RENEW(t1,double,*nk);
       if(*nam>0) RENEW(iamt1,ITG,*nk);
       }
       RENEW(nactdof,ITG,mt**nk);
       if(*ntrans>0) RENEW(inotr,ITG,2**nk);
       RENEW(kon,ITG,*nkon);
       RENEW(ipkon,ITG,*ne);
       RENEW(lakon,char,8**ne);
       RENEW(ielmat,ITG,mi[2]**ne);
       if(*norien>0) RENEW(ielorien,ITG,mi[2]**ne);
       RENEW(nodeboun,ITG,*nboun);
       RENEW(ndirboun,ITG,*nboun);
       if(*nam>0) RENEW(iamboun,ITG,*nboun);
       RENEW(xboun,double,*nboun);
       RENEW(xbounold,double,*nboun);
       RENEW(ikboun,ITG,*nboun);
       RENEW(ilboun,ITG,*nboun);
 
       /* recovering the original multiple point constraints */
 
       RENEW(ipompc,ITG,*nmpc);
       RENEW(nodempc,ITG,3**mpcend);
       RENEW(coefmpc,double,*mpcend);
       RENEW(labmpc,char,20**nmpc+1);
       RENEW(ikmpc,ITG,*nmpc);
       RENEW(ilmpc,ITG,*nmpc);
       RENEW(fmpc,double,*nmpc);
 
       *nmpc=nmpcold;
       *mpcend=mpcendold;
       for(i=0;i<*nmpc;i++){ipompc[i]=ipompcold[i];}
       for(i=0;i<3**mpcend;i++){nodempc[i]=nodempcold[i];}
       for(i=0;i<*mpcend;i++){coefmpc[i]=coefmpcold[i];}
       for(i=0;i<20**nmpc;i++){labmpc[i]=labmpcold[i];}
       for(i=0;i<*nmpc;i++){ikmpc[i]=ikmpcold[i];}
       for(i=0;i<*nmpc;i++){ilmpc[i]=ilmpcold[i];}
       SFREE(ipompcold);SFREE(nodempcold);SFREE(coefmpcold);
       SFREE(labmpcold);SFREE(ikmpcold);SFREE(ilmpcold);
 
       RENEW(vold,double,mt**nk);
       RENEW(veold,double,mt**nk);
       RENEW(eme,double,6*mi[0]**ne);
       if(*nener==1)RENEW(ener,double,mi[0]**ne);
 
 /* distributed loads */
 
       for(i=0;i<*nload;i++){
       if(nelemload[2*i]<=*ne*nsectors){
           nelemload[2*i]-=*ne*nelemload[2*i+1];
       }else{
           nelemload[2*i]-=*ne*(nsectors+nelemload[2*i+1]-1);
       }
       }
 
   /*  sorting the elements with distributed loads */
 
       if(*nload>0){
       if(*nam>0){
           FORTRAN(isortiiddc,(nelemload,iamload,xload,xloadold,sideload,nload,&kflag));
       }else{
           FORTRAN(isortiddc,(nelemload,xload,xloadold,sideload,nload,&kflag));
       }
       }
       
 /* point loads */
       
       for(i=0;i<*nforc;i++){
       if(nodeforc[2*i]<=*nk*nsectors){
           nodeforc[2*i]-=*nk*nodeforc[2*i+1];
       }else{
           nodeforc[2*i]-=*nk*(nsectors+nodeforc[2*i+1]-1);
       }
       }
   }
 
   SFREE(xstiff);SFREE(fric);
 
   if(dashpot){SFREE(cc);}
 
   if(nherm!=1){SFREE(xmr);SFREE(xmi);}
 
   SFREE(imddof);SFREE(imdnode);SFREE(imdboun);SFREE(imdmpc);SFREE(imdelem);
 
   *cop=co;*konp=kon;*ipkonp=ipkon;*lakonp=lakon;*ielmatp=ielmat;
   *ielorienp=ielorien;*inotrp=inotr;*nodebounp=nodeboun;
   *ndirbounp=ndirboun;*iambounp=iamboun;*xbounp=xboun;*veoldp=veold;
   *xbounoldp=xbounold;*ikbounp=ikboun;*ilbounp=ilboun;*nactdofp=nactdof;
   *voldp=vold;*emep=eme;*enerp=ener;*ipompcp=ipompc;*nodempcp=nodempc;
   *coefmpcp=coefmpc;*labmpcp=labmpc;*ikmpcp=ikmpc;*ilmpcp=ilmpc;
   *fmpcp=fmpc;*iamt1p=iamt1;*t0p=t0;*t1oldp=t1old;*t1p=t1;
 
 //  (*ttime)+=(*tper);
 
   return;
 }

◆ storecontactdof()

void storecontactdof	(	ITG *	nope,
		ITG *	nactdof,
		ITG *	mt,
		ITG *	konl,
		ITG **	ikactcontp,
		ITG *	nactcont,
		ITG *	nactcont_,
		double *	bcont,
		double *	fnl,
		ITG *	ikmpc,
		ITG *	nmpc,
		ITG *	ilmpc,
		ITG *	ipompc,
		ITG *	nodempc,
		double *	coefmpc
	)

                           {
 
   ITG j,j1,jdof,id,k,l,ist,index,node,ndir,*ikactcont=*ikactcontp;
 
   for(j=0;j<*nope;j++){
       for(j1=0;j1<3;j1++){
       jdof=nactdof[*mt*(konl[j]-1)+j1+1];
       if(jdof>0){
           
           jdof--;
           FORTRAN(nident,(ikactcont,&jdof,nactcont,&id));
           do{
           if(id>0){
               if(ikactcont[id-1]==jdof){
               break;
               }
           }
           (*nactcont)++;
           if(*nactcont>*nactcont_){
               *nactcont_=(ITG)(1.1**nactcont_);
               RENEW(ikactcont,ITG,*nactcont_);
           }
           k=*nactcont-1;
           l=k-1;
           while(k>id){
               ikactcont[k--]=ikactcont[l--];
           }
           ikactcont[id]=jdof;
           break;
           }while(1);
           
           bcont[jdof]-=fnl[3*j+j1];
       }else{
           jdof=8*(konl[j]-1)+j1+1;
           FORTRAN(nident,(ikmpc,&jdof,nmpc,&id));
           if(id>0){
           if(ikmpc[id-1]==jdof){
               id=ilmpc[id-1];
               ist=ipompc[id-1];
               index=nodempc[3*ist-1];
               if(index==0) continue;
               do{
               node=nodempc[3*index-3];
               ndir=nodempc[3*index-2];
               jdof=nactdof[*mt*(node-1)+ndir];
               if(jdof>0){
                   
                   jdof--;
                   FORTRAN(nident,(ikactcont,&jdof,nactcont,&id));
                   do{
                   if(id>0){
                       if(ikactcont[id-1]==jdof){
                       break;
                       }
                   }
                   (*nactcont)++;
                   if(*nactcont>*nactcont_){
                       *nactcont_=(ITG)(1.1**nactcont_);
                       RENEW(ikactcont,ITG,*nactcont_);
                   }
                   k=*nactcont-1;
                   l=k-1;
                   while(k>id){
                       ikactcont[k--]=ikactcont[l--];
                   }
                   ikactcont[id]=jdof;
                   break;
                   }while(1);
                   
 /*                bcont[jdof]+=coefmpc[index-1]*
                   fnl[3*j+j1]/coefmpc[ist-1];*/
                   bcont[jdof]-=coefmpc[index-1]*
                   fnl[3*j+j1]/coefmpc[ist-1];
               }
               index=nodempc[3*index-1];
               if(index==0) break;
               }while(1);
           }
           }
       }
       }
   }
 
   *ikactcontp=ikactcont;
   
   return;
 }

◆ strcmp1()

ITG strcmp1	(	const char *	s1,
		const char *	s2
	)

 {
   ITG a,b;
 
   do {
     a=*s1++;
     b=*s2++;
 
 /* the statement if((a=='\0')||(b=='\0')) has been treated separately
    in order to avoid the first field (s1) to be defined one longer
    than required; s1 is assumed to be a variable field, s2 is
    assumed to be a fixed string */
 
     if(b=='\0'){
       a='\0';
       b='\0';
       break;
     }
     if(a=='\0'){
       a='\0';
       b='\0';
       break;
     }
   }while(a==b);
   return(a-b);
 }

◆ strcmp2()

ITG strcmp2	(	const char *	s1,
		const char *	s2,
		ITG	length
	)

 {
 
 /* comparison of the first "length" characters unless s1
    and/or s2 has less characters */
 
   ITG a,b,i;
 
   i=0;
   do {
     a=*s1++;
     b=*s2++;
 
     if(b=='\0'){
       a='\0';
       b='\0';
       break;
     }
     if(a=='\0'){
       a='\0';
       b='\0';
       break;
     }
     i++;
   }while((a==b)&&(i<length));
   return(a-b);
 }

◆ strcpy1()

ITG strcpy1	(	char *	s1,
		const char *	s2,
		ITG	length
	)

 {
   ITG b,i,blank=0;
 
   for(i=0;i<length;i++) {
       if(blank==0){
       b=*s2;
       if(b=='\0')blank=1;
       }
       if(blank==0) {*s1=*s2;s2++;}
       else *s1=' ';
       s1++;
   }
   return 0;
 }

◆ stress_sen()

void stress_sen	(	double *	co,
		ITG *	nk,
		ITG *	kon,
		ITG *	ipkon,
		char *	lakon,
		ITG *	ne,
		double *	stn,
		double *	elcon,
		ITG *	nelcon,
		double *	rhcon,
		ITG *	nrhcon,
		double *	alcon,
		ITG *	nalcon,
		double *	alzero,
		ITG *	ielmat,
		ITG *	ielorien,
		ITG *	norien,
		double *	orab,
		ITG *	ntmat_,
		double *	t0,
		double *	t1,
		ITG *	ithermal,
		double *	prestr,
		ITG *	iprestr,
		char *	filab,
		double *	emn,
		double *	een,
		ITG *	iperturb,
		double *	f,
		ITG *	nactdof,
		double *	vold,
		ITG *	nodeboun,
		ITG *	ndirboun,
		double *	xboun,
		ITG *	nboun,
		ITG *	ipompc,
		ITG *	nodempc,
		double *	coefmpc,
		char *	labmpc,
		ITG *	nmpc,
		ITG *	nmethod,
		double *	cam,
		ITG *	neq,
		double *	veold,
		double *	accold,
		double *	bet,
		double *	gam,
		double *	dtime,
		double *	time,
		double *	ttime,
		double *	plicon,
		ITG *	nplicon,
		double *	plkcon,
		ITG *	nplkcon,
		double *	xstateini,
		double *	xstate,
		ITG *	npmat_,
		double *	epn,
		char *	matname,
		ITG *	mi,
		ITG *	ielas,
		ITG *	ncmat_,
		ITG *	nstate_,
		double *	stiini,
		double *	vini,
		ITG *	ikboun,
		ITG *	ilboun,
		double *	enern,
		double *	emeini,
		double *	xstaten,
		double *	enerini,
		double *	cocon,
		ITG *	ncocon,
		char *	set,
		ITG *	nset,
		ITG *	istartset,
		ITG *	iendset,
		ITG *	ialset,
		ITG *	nprint,
		char *	prlab,
		char *	prset,
		double *	qfx,
		double *	qfn,
		double *	trab,
		ITG *	inotr,
		ITG *	ntrans,
		double *	fmpc,
		ITG *	nelemload,
		ITG *	nload,
		ITG *	ikmpc,
		ITG *	ilmpc,
		ITG *	istep,
		ITG *	iinc,
		double *	springarea,
		double *	reltime,
		ITG *	ne0,
		double *	xforc,
		ITG *	nforc,
		double *	thicke,
		double *	shcon,
		ITG *	nshcon,
		char *	sideload,
		double *	xload,
		double *	xloadold,
		ITG *	icfd,
		ITG *	inomat,
		double *	pslavsurf,
		double *	pmastsurf,
		ITG *	mortar,
		ITG *	islavact,
		double *	cdn,
		ITG *	islavnode,
		ITG *	nslavnode,
		ITG *	ntie,
		double *	clearini,
		ITG *	islavsurf,
		ITG *	ielprop,
		double *	prop,
		double *	energyini,
		double *	energy,
		ITG *	kscale,
		char *	orname,
		ITG *	network,
		ITG *	nestart,
		ITG *	neend,
		ITG *	jqs,
		ITG *	irows,
		ITG *	nodedesi,
		double *	xdesi,
		ITG *	ndesi,
		ITG *	iobject,
		ITG *	nobject,
		char *	objectset,
		double *	g0,
		double *	dgdx,
		ITG *	idesvara,
		ITG *	idesvarb,
		ITG *	nasym,
		ITG *	isolver,
		double *	distmin,
		ITG *	nodeset,
		double *	b
	)

                                                            {
 
   ITG symmetryflag=0,idesvar,mt=mi[1]+1,i,iactpos,calcul_fn,
     calcul_qa,calcul_cauchy,ikin=0,nal,iout=2,icmd=3,nener=0,
       *inum=NULL,nprintl=0;
 
   double *vnew=NULL,*conew=NULL,*dstn=NULL,*v=NULL,*fn=NULL,
     *stx=NULL,*eei=NULL,qa[4]={0.,0.,-1.,0.},*xstiff=NULL,*ener=NULL,
     *eme=NULL;
     
   if(*nasym!=0){symmetryflag=2;}
       
     NNEW(vnew,double,mt**nk);
     NNEW(conew,double,3**nk);
     NNEW(eme,double,6*mi[0]**ne);
     NNEW(inum,ITG,*nk);
     
     for(idesvar=*idesvara-1;idesvar<*idesvarb;idesvar++){
       
       /* calculating the perturbed displacements */
       
       FORTRAN(resultsnoddir,(nk,vnew,nactdof,b,ipompc,nodempc,
             coefmpc,nmpc,mi));
       
       for(i=0;i<mt**nk;i++){vnew[i]=vold[i]+(*distmin)*vnew[i];}
       
       /* copying the unperturbed coordinates */
       
       memcpy(&conew[0],&co[0],sizeof(double)*3**nk);
       
       /* if the coordinates are the design variables: 
         calculating the perturbed coordinates */
       
       iactpos=nodedesi[idesvar]-1;
       for(i=0;i<3;i++){
        conew[iactpos*3+i]=co[iactpos*3+i]+xdesi[idesvar*3+i];
       }
       
       /* calculating the stress in the perturbed state */
       
       NNEW(v,double,mt**nk);
       NNEW(fn,double,mt**nk);
       NNEW(stx,double,6*mi[0]**ne);
       NNEW(eei,double,6*mi[0]**ne);
       NNEW(dstn,double,6**nk);
       
       memcpy(&v[0],&vnew[0],sizeof(double)*mt**nk);
 
       /* setting the output variables */
       
       calcul_fn=0;
       calcul_qa=0;
       calcul_cauchy=1;
       
       FORTRAN(resultsmech,(conew,kon,ipkon,lakon,ne,v,
           stx,elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,
           ielmat,ielorien,norien,orab,ntmat_,t0,t1,ithermal,prestr,
           iprestr,eme,iperturb,fn,&iout,qa,vold,
           nmethod,
           veold,dtime,time,ttime,plicon,nplicon,plkcon,nplkcon,
           xstateini,xstiff,xstate,npmat_,matname,mi,ielas,&icmd,
           ncmat_,nstate_,stiini,vini,ener,eei,enerini,istep,iinc,
           springarea,reltime,&calcul_fn,&calcul_qa,&calcul_cauchy,&nener,
           &ikin,&nal,ne0,thicke,emeini,
           pslavsurf,pmastsurf,mortar,clearini,nestart,neend,ielprop,
           prop,kscale));
 
       /* storing results in the .dat file
         extrapolation of integration point values to the nodes
         interpolation of 3d results for 1d/2d elements */
       
       FORTRAN(resultsprint,(conew,nk,kon,ipkon,lakon,ne,v,dstn,inum,
               stx,ielorien,norien,orab,t1,ithermal,filab,een,iperturb,fn,
               nactdof,&iout,vold,nodeboun,ndirboun,nboun,nmethod,ttime,xstate,
               epn,mi,
               nstate_,ener,enern,xstaten,eei,set,nset,istartset,iendset,
               ialset,&nprintl,prlab,prset,qfx,qfn,trab,inotr,ntrans,
               nelemload,nload,&ikin,ielmat,thicke,eme,emn,rhcon,nrhcon,shcon,
               nshcon,cocon,ncocon,ntmat_,sideload,icfd,inomat,pslavsurf,islavact,
               cdn,mortar,islavnode,nslavnode,ntie,islavsurf,time,ielprop,prop,
           veold,ne0,nmpc,ipompc,nodempc,labmpc,energyini,energy,orname,
               xload));
       
       SFREE(v);SFREE(fn);SFREE(stx);SFREE(eei);
       
       /* calculate the stress sensitivity */
       
       for(i=0;i<6**nk;i++){dstn[i]=(dstn[i]-stn[i])/(*distmin);}
 
       FORTRAN(objective_stress_dx,(nodeset,istartset,iendset,
                    ialset,nk,&idesvar,iobject,dgdx,
                    ndesi,nobject,stn,dstn,objectset,g0));
       
       SFREE(dstn);
       
     }
 
     SFREE(vnew);SFREE(conew);SFREE(eme);SFREE(inum);
 
 }

◆ stress_senmt()

void* stress_senmt ( ITG * i )

                           {
   
   ITG idesvara,idesvarb,indexb;
 
   /* next design variable to tread (FORTRAN-notation) */
   
   idesvara=idesvar1+(*i)+1;
   idesvarb=idesvara;
   indexb=*i*neq1[1];
   
   stress_sen(co1,nk1,kon1,ipkon1,lakon1,ne1,stn1,
          elcon1,nelcon1,rhcon1,nrhcon1,alcon1,nalcon1,alzero1,ielmat1,
          ielorien1,norien1,orab1,ntmat1_,t01,t11,ithermal1,
          prestr1,iprestr1,filabl1,emn1,een1,iperturb1,
          f1,nactdof1,vold1,nodeboun1,
          ndirboun1,xboun1,nboun1,ipompc1,
          nodempc1,coefmpc1,labmpc1,nmpc1,nmethod1,cam1,neq1,veold1,accold1,
          bet1,gam1,dtime1,time1,ttime1,plicon1,nplicon1,plkcon1,nplkcon1,
          xstateini1,xstate1,npmat1_,epn1,matname1,mi1,ielas1,
          ncmat1_,nstate1_,stiini1,vini1,ikboun1,ilboun1,enern1,emeini1,
          xstaten1,enerini1,cocon1,ncocon1,set1,nset1,istartset1,iendset1,
          ialset1,nprint1,prlab1,prset1,qfx1,qfn1,trab1,inotr1,ntrans1,fmpc1,
          nelemload1,nload1,ikmpc1,ilmpc1,istep1,iinc1,springarea1,
          reltime1,ne01,xforc1,nforc1,thicke1,shcon1,nshcon1,
          sideload1,xload1,xloadold1,icfd1,inomat1,pslavsurf1,pmastsurf1,
          mortar1,islavact1,cdn1,islavnode1,nslavnode1,ntie1,clearini1,
          islavsurf1,ielprop1,prop1,energyini1,energy1,&kscale1,
          orname1,&network1,&nestart1,&neend1,jqs1,irows1,nodedesi1,
          xdesi1,ndesi1,&iobject1,nobject1,objectset1,g01,dgdx1,
              &idesvara,&idesvarb,nasym1,isolver1,distmin1,&nodeset1,
              &b1[indexb]);
   
   return NULL;
 }

◆ thicknessmt()

void* thicknessmt ( ITG * i )

                          {
 
     ITG indexr,ndesia,ndesib,ndesidelta;
 
     indexr=*i*ifree1;
     
     ndesidelta=(ITG)ceil(ndesiboun1/(double)num_cpus);
     ndesia=*i*ndesidelta+1;
     ndesib=(*i+1)*ndesidelta;
     if(ndesib>ndesiboun1) ndesib=ndesiboun1;
     
     //printf("indexr=%" ITGFORMAT","ndesia=%" ITGFORMAT",ndesib=%" ITGFORMAT"\n",indexr,ndesia,ndesib);
 
     FORTRAN(thickness,(dgdx1,nobject1,nodedesiboun1,&ndesiboun1,objectset1,
                         xo1,yo1,zo1,x1,yy1,z1,nx1,ny1,nz1,co1,&ifree1,
                         &ndesia,&ndesib,iobject1,ndesi1,dgdxglob1,nk1));
 
     return NULL;
 }

◆ tiedcontact()

void tiedcontact	(	ITG *	ntie,
		char *	tieset,
		ITG *	nset,
		char *	set,
		ITG *	istartset,
		ITG *	iendset,
		ITG *	ialset,
		char *	lakon,
		ITG *	ipkon,
		ITG *	kon,
		double *	tietol,
		ITG *	nmpc,
		ITG *	mpcfree,
		ITG *	memmpc_,
		ITG **	ipompcp,
		char **	labmpcp,
		ITG **	ikmpcp,
		ITG **	ilmpcp,
		double **	fmpcp,
		ITG **	nodempcp,
		double **	coefmpcp,
		ITG *	ithermal,
		double *	co,
		double *	vold,
		ITG *	cfd,
		ITG *	nmpc_,
		ITG *	mi,
		ITG *	nk,
		ITG *	istep,
		ITG *	ikboun,
		ITG *	nboun,
		char *	kind1,
		char *	kind2
	)

                                               {
 
   char *labmpc=NULL;
 
   ITG *itietri=NULL,*koncont=NULL,nconf,i,k,*nx=NULL,im,
       *ny=NULL,*nz=NULL,*ifaceslave=NULL,*istartfield=NULL,
       *iendfield=NULL,*ifield=NULL,ntrimax,index,
       ncont,ncone,*ipompc=NULL,*ikmpc=NULL,
       *ilmpc=NULL,*nodempc=NULL,ismallsliding=0,neq,neqterms,
       nmpctied,mortar=0,*ipe=NULL,*ime=NULL,*imastop=NULL,ifreeme;
 
   double *xo=NULL,*yo=NULL,*zo=NULL,*x=NULL,*y=NULL,*z=NULL,
     *cg=NULL,*straight=NULL,*fmpc=NULL,*coefmpc=NULL;
 
   ipompc=*ipompcp;labmpc=*labmpcp;ikmpc=*ikmpcp;ilmpc=*ilmpcp;
   fmpc=*fmpcp;nodempc=*nodempcp;coefmpc=*coefmpcp;
 
   /* identifying the slave surfaces as nodal or facial surfaces */
 
   NNEW(ifaceslave,ITG,*ntie);
 
   FORTRAN(identifytiedface,(tieset,ntie,set,nset,ifaceslave,kind1));
 
   /* determining the number of triangles of the triangulation
      of the master surface and the number of entities on the
      slave side */
 
   FORTRAN(allocont,(&ncont,ntie,tieset,nset,set,istartset,iendset,
       ialset,lakon,&ncone,tietol,&ismallsliding,kind1,
       kind2,&mortar,istep));
 
   if(ncont==0){
       SFREE(ifaceslave);return;
   }
 
   /* allocation of space for the triangulation; 
      koncont(1..3,i): nodes belonging to triangle i
      koncont(4,i): face label to which the triangle belongs =
      10*element+side number */
 
   NNEW(itietri,ITG,2**ntie);
   NNEW(koncont,ITG,4*ncont);
 
   /* triangulation of the master surface */
 
   FORTRAN(triangucont,(&ncont,ntie,tieset,nset,set,istartset,iendset,
       ialset,itietri,lakon,ipkon,kon,koncont,kind1,kind2,co,nk));
   
   /* catalogueing the neighbors of the master triangles */
   
   RENEW(ipe,ITG,*nk);
   RENEW(ime,ITG,12*ncont);
   DMEMSET(ipe,0,*nk,0.);
   DMEMSET(ime,0,12*ncont,0.);
   NNEW(imastop,ITG,3*ncont);
 
   FORTRAN(trianeighbor,(ipe,ime,imastop,&ncont,koncont,
                 &ifreeme));
 
   SFREE(ipe);SFREE(ime);
 
   /* allocation of space for the center of gravity of the triangles
      and the 4 describing planes */
 
   NNEW(cg,double,3*ncont);
   NNEW(straight,double,16*ncont);
   
   FORTRAN(updatecont,(koncont,&ncont,co,vold,cg,straight,mi));
   
   /* determining the nodes belonging to the slave face surfaces */
 
   NNEW(istartfield,ITG,*ntie);
   NNEW(iendfield,ITG,*ntie);
   NNEW(ifield,ITG,8*ncone);
 
   FORTRAN(nodestiedface,(tieset,ntie,ipkon,kon,lakon,set,istartset,
        iendset,ialset,nset,ifaceslave,istartfield,iendfield,ifield,
        &nconf,&ncone,kind1));
 
   /* determining the maximum number of equations neq */
 
   if(*cfd==1){
     if(ithermal[1]<=1){
       neq=4;
     }else{
       neq=5;
     }
   }else{
     if(ithermal[1]<=1){
       neq=3;
     }else if(ithermal[1]==2){
       neq=1;
     }else{
       neq=4;
     }
   }
   neq*=(ncone+nconf);
 
   /* reallocating the MPC fields for the new MPC's
      ncone: number of MPC'S due to nodal slave surfaces
      nconf: number of MPC's due to facal slave surfaces */  
 
   RENEW(ipompc,ITG,*nmpc_+neq);
   RENEW(labmpc,char,20*(*nmpc_+neq)+1);
   RENEW(ikmpc,ITG,*nmpc_+neq);
   RENEW(ilmpc,ITG,*nmpc_+neq);
   RENEW(fmpc,double,*nmpc_+neq);
 
   /* determining the maximum number of terms;
      expanding nodempc and coefmpc to accommodate
      those terms */
   
   neqterms=9*neq;
   index=*memmpc_;
   (*memmpc_)+=neqterms;
   RENEW(nodempc,ITG,3**memmpc_);
   RENEW(coefmpc,double,*memmpc_);
   for(k=index;k<*memmpc_;k++){
       nodempc[3*k-1]=k+1;
   }
   nodempc[3**memmpc_-1]=0;
 
   /* determining the size of the auxiliary fields */
   
   ntrimax=0;
   for(i=0;i<*ntie;i++){
     if(itietri[2*i+1]-itietri[2*i]+1>ntrimax)
       ntrimax=itietri[2*i+1]-itietri[2*i]+1;
   }
   NNEW(xo,double,ntrimax);
   NNEW(yo,double,ntrimax);
   NNEW(zo,double,ntrimax);
   NNEW(x,double,ntrimax);
   NNEW(y,double,ntrimax);
   NNEW(z,double,ntrimax);
   NNEW(nx,ITG,ntrimax);
   NNEW(ny,ITG,ntrimax);
   NNEW(nz,ITG,ntrimax);
   
   /* generating the tie MPC's */
 
   FORTRAN(gentiedmpc,(tieset,ntie,itietri,ipkon,kon,
       lakon,set,istartset,iendset,ialset,cg,straight,
       koncont,co,xo,yo,zo,x,y,z,nx,ny,nz,nset,
       ifaceslave,istartfield,iendfield,ifield,
       ipompc,nodempc,coefmpc,nmpc,&nmpctied,mpcfree,ikmpc,ilmpc,
       labmpc,ithermal,tietol,cfd,&ncont,imastop,ikboun,nboun,kind1));
 
   (*nmpc_)+=nmpctied;
   
   SFREE(xo);SFREE(yo);SFREE(zo);SFREE(x);SFREE(y);SFREE(z);SFREE(nx);
   SFREE(ny);SFREE(nz);SFREE(imastop);
 
   SFREE(ifaceslave);SFREE(istartfield);SFREE(iendfield);SFREE(ifield);
   SFREE(itietri);SFREE(koncont);SFREE(cg);SFREE(straight);
 
   /* reallocating the MPC fields */
 
   /*  RENEW(ipompc,ITG,nmpc_);
   RENEW(labmpc,char,20*nmpc_+1);
   RENEW(ikmpc,ITG,nmpc_);
   RENEW(ilmpc,ITG,nmpc_);
   RENEW(fmpc,double,nmpc_);*/
 
   *ipompcp=ipompc;*labmpcp=labmpc;*ikmpcp=ikmpc;*ilmpcp=ilmpc;
   *fmpcp=fmpc;*nodempcp=nodempc;*coefmpcp=coefmpc;
 
   /*  for(i=0;i<*nmpc;i++){
     j=i+1;
     FORTRAN(writempc,(ipompc,nodempc,coefmpc,labmpc,&j));
     }*/
 
   return;
 }

◆ transitionmain()

void transitionmain	(	double *	co,
		double *	dgdxglob,
		ITG *	nobject,
		ITG *	nk,
		ITG *	nodedesi,
		ITG *	ndesi,
		char *	objectset,
		ITG *	ipkon,
		ITG *	kon,
		char *	lakon,
		ITG *	ipoface,
		ITG *	nodface,
		ITG *	nodedesiinv
	)

                          {
 
     /* reduction of the sensitivities in the transition from the design
        space to the non-design space */
 
     ITG *nx=NULL,*ny=NULL,*nz=NULL,ifree,i,*ithread=NULL;
     
     double *xo=NULL,*yo=NULL,*zo=NULL,*x=NULL,*y=NULL,*z=NULL;
 
     if(*nobject==0){return;}
     if(strcmp1(&objectset[20],"                    ")!=0){
     
        /* prepare for near3d */
     
        NNEW(xo,double,*nk);
        NNEW(yo,double,*nk);
        NNEW(zo,double,*nk);
        NNEW(x,double,*nk);
        NNEW(y,double,*nk);
        NNEW(z,double,*nk);
        NNEW(nx,ITG,*nk);
        NNEW(ny,ITG,*nk);
        NNEW(nz,ITG,*nk);
     
        FORTRAN(pretransition,(ipkon,kon,lakon,co,nk,ipoface,nodface,
                            nodedesiinv,xo,yo,zo,x,y,z,nx,ny,nz,&ifree));
 
        RENEW(xo,double,ifree);
        RENEW(yo,double,ifree);
        RENEW(zo,double,ifree);
        RENEW(x,double,ifree);
        RENEW(y,double,ifree);
        RENEW(z,double,ifree);
        RENEW(nx,ITG,ifree);
        RENEW(ny,ITG,ifree);
        RENEW(nz,ITG,ifree);
 
        /* variables for multithreading procedure */
     
        ITG sys_cpus;
        char *env,*envloc,*envsys;
     
        num_cpus = 0;
        sys_cpus=0;
     
        /* explicit user declaration prevails */
     
        envsys=getenv("NUMBER_OF_CPUS");
        if(envsys){
       sys_cpus=atoi(envsys);
       if(sys_cpus<0) sys_cpus=0;
        }
     
        /* automatic detection of available number of processors */
     
        if(sys_cpus==0){
        sys_cpus = getSystemCPUs();
        if(sys_cpus<1) sys_cpus=1;
        }
     
        /* local declaration prevails, if strictly positive */
     
        envloc = getenv("CCX_NPROC_FILTER");
        if(envloc){
       num_cpus=atoi(envloc);
       if(num_cpus<0){
          num_cpus=0;
       }else if(num_cpus>sys_cpus){
          num_cpus=sys_cpus;
       }
     
        }
     
        /* else global declaration, if any, applies */
     
        env = getenv("OMP_NUM_THREADS");
        if(num_cpus==0){
       if (env)
          num_cpus = atoi(env);
       if (num_cpus < 1) {
          num_cpus=1;
       }else if(num_cpus>sys_cpus){
         num_cpus=sys_cpus;
       }
        }
     
        /* check that the number of cpus does not supercede the number
           of design variables */
     
        if(*ndesi<num_cpus) num_cpus=*ndesi;
     
        pthread_t tid[num_cpus];
 
        dgdxglob1=dgdxglob;nobject1=nobject;nk1=nk;nodedesi1=nodedesi;
        ndesi1=ndesi;objectset1=objectset;xo1=xo;yo1=yo;zo1=zo;
        x1=x;yy1=y;z1=z;nx1=nx;ny1=ny;nz1=nz;
        ifree1=ifree,co1=co;
 
        /* transition */
     
        printf(" Using up to %" ITGFORMAT " cpu(s) for transition to sensitivities.\n\n", num_cpus);
     
        /* create threads and wait */
   
        NNEW(ithread,ITG,num_cpus);
        for(i=0; i<num_cpus; i++)  {
       ithread[i]=i;
       pthread_create(&tid[i], NULL, (void *)transitionmt, (void *)&ithread[i]);
        }
        for(i=0; i<num_cpus; i++)  pthread_join(tid[i], NULL);
 
        SFREE(xo);SFREE(yo);SFREE(zo);SFREE(ithread);
        SFREE(x);SFREE(y);SFREE(z);SFREE(nx);SFREE(ny);SFREE(nz);
                    
     }
        
     FORTRAN(posttransition,(dgdxglob,nobject,nk,nodedesi,ndesi,objectset));
                                      
     return;
     
 } 

◆ transitionmt()

void* transitionmt ( ITG * i )

                           {
 
     ITG ndesia,ndesib,ndesidelta;
     
     ndesidelta=(ITG)ceil(*ndesi1/(double)num_cpus);
     ndesia=*i*ndesidelta+1;
     ndesib=(*i+1)*ndesidelta;
     if(ndesib>*ndesi1) ndesib=*ndesi1;
 
     FORTRAN(transition,(dgdxglob1,nobject1,nk1,nodedesi1,ndesi1,objectset1,
                         xo1,yo1,zo1,x1,yy1,z1,nx1,ny1,nz1,co1,&ifree1,
                         &ndesia,&ndesib));
 
     return NULL;
 }

◆ u_calloc()

void* u_calloc	(	size_t	num,
		size_t	size,
		const char *	file,
		const int	line,
		const char *	ptr_name
	)

                                                                                             {
 
     /* allocating num elements of size bytes and initializing them to zero */
 
   void *a;
   char *env;
 
   if(num==0){
     a=NULL;
     return(a);
   }
       
   a=calloc(num,size);
   if(a==NULL){
     printf("*ERROR in u_calloc: error allocating memory\n");
     printf("variable=%s, file=%s, line=%d, num=%ld, size=%ld\n",ptr_name,file,line,num,size);
     if(num<0){
     printf("\n It looks like you may need the i8 (integer*8) version of CalculiX\n");
     }
     exit(16);
   }
   else {
     if(log_realloc==-1) {
       log_realloc=0;
       env=getenv("CCX_LOG_ALLOC");
       if(env) {log_realloc=atoi(env);}
     }      
     if(log_realloc==1) {
     printf("ALLOCATION of variable %s, file %s, line=%d, num=%ld, size=%ld, address= %ld\n",ptr_name,file,line,num,size,(long int)a);
     }      
     return(a);
   }
 }

◆ u_free()

void* u_free	(	void *	num,
		const char *	file,
		const int	line,
		const char *	ptr_name
	)

                                                                              {
 
     /* freeing a field with pointer ptr  */
 
   char *env;
 
   free(ptr);
 
   if(log_realloc==-1) {
       log_realloc=0;
       env=getenv("CCX_LOG_ALLOC");
       if(env) {log_realloc=atoi(env);}
   }      
   if(log_realloc==1) {
       printf("FREEING of variable %s, file %s, line=%d: oldaddress= %ld\n",ptr_name,file,line,(long int)ptr);
   }      
   return;
 }

◆ u_realloc()

void* u_realloc	(	void *	num,
		size_t	size,
		const char *	file,
		const int	line,
		const char *	ptr_name
	)

                                                                                             {
 
     /* reallocating a field with pointer ptr to size bytes */
 
   void *a;
   char *env;
 
   a=realloc(ptr,size);
 
   if(a==NULL && ptr!=NULL && size!=0){
     printf("*ERROR in u_realloc: error allocating memory\n");
     printf("variable=%s, file=%s, line=%d, size(bytes)=%ld, oldaddress=%ld\n",ptr_name,file,line,size,(long int)ptr);
     exit(16);
   }
   else {
     if(log_realloc==-1) {
       log_realloc=0;
       env=getenv("CCX_LOG_ALLOC");
       if(env) {log_realloc=atoi(env);}
     }      
     if(log_realloc==1) {
       printf("REALLOCATION of variable %s, file %s, line=%d: size(bytes)=%ld, oldaddress= %ld,address= %ld\n",ptr_name,file,line,size,(long int)ptr,(long int)a);
     }      
     return(a);
   }
 }

◆ writeBasisParameter()

void writeBasisParameter	(	FILE *	f,
		ITG *	istep,
		ITG *	iinc
	)

◆ writeheading()

void writeheading	(	char *	jobnamec,
		char *	heading,
		ITG *	nheading
	)

                                                               {
     
     /* writes the headers in the frd-file */
     
     FILE *f1;
 
     char p1[6]="    1",fneig[132]="",c[2]="C",
          text[67]="                                                                  ";
 
     ITG i;
     
     strcpy(fneig,jobnamec);
     strcat(fneig,".frd");
     
     if((f1=fopen(fneig,"ab"))==NULL){
     printf("*ERROR in frd: cannot open frd file for writing...");
     exit(0);
     }
 
     /* first line */
 
     fprintf(f1,"%5s%1s\n",p1,c);
 
     /* header lines */
 
     for(i=0;i<*nheading_;i++){
     strcpy1(text,&heading[66*i],66);
     fprintf(f1,"%5sU%66s\n",p1,text);
     }
 
     fclose(f1);
     
     return;
 }

Macros

Functions