[calculix-ccx] 01/07: Imported Upstream version 2.10
Wolfgang Fütterer
debian at wlf-online.de
Mon Mar 7 21:33:21 UTC 2016
This is an automated email from the git hooks/post-receive script.
wlfuetter-guest pushed a commit to branch master
in repository calculix-ccx.
commit b1c541ae1a546a5e2045e2adb7464f50bba9991c
Author: Wolfgang Fütterer <debian at wlf-online.de>
Date: Mon Mar 7 20:35:31 2016 +0100
Imported Upstream version 2.10
---
{ccx_2.9 => ccx_2.10}/src/BUGS | 2 +-
{ccx_2.9 => ccx_2.10}/src/CalculiX.h | 1024 +++--
{ccx_2.9 => ccx_2.10}/src/LOGBOOK | 70 +-
{ccx_2.9 => ccx_2.10}/src/Makefile | 11 +-
{ccx_2.9 => ccx_2.10}/src/Makefile.inc | 32 +-
{ccx_2.9 => ccx_2.10}/src/Makefile_MT | 10 +-
{ccx_2.9 => ccx_2.10}/src/Makefile_i8 | 14 +-
{ccx_2.9 => ccx_2.10}/src/README.INSTALL | 94 +-
{ccx_2.9 => ccx_2.10}/src/TODO | 2 +-
{ccx_2.9 => ccx_2.10}/src/absolute_relative.f | 0
{ccx_2.9 => ccx_2.10}/src/acctube.f | 0
{ccx_2.9 => ccx_2.10}/src/acctube_one.f | 0
{ccx_2.9 => ccx_2.10}/src/add_bo_st.f | 0
{ccx_2.9 => ccx_2.10}/src/add_sm_ei.f | 0
{ccx_2.9 => ccx_2.10}/src/add_sm_fl.f | 0
{ccx_2.9 => ccx_2.10}/src/add_sm_fl_as.f | 4 +
{ccx_2.9 => ccx_2.10}/src/add_sm_st.f | 0
{ccx_2.9 => ccx_2.10}/src/add_sm_st_as.f | 0
{ccx_2.9 => ccx_2.10}/src/add_sm_st_corio.f | 0
{ccx_2.9 => ccx_2.10}/src/addimd.f | 0
{ccx_2.9 => ccx_2.10}/src/addimdnodecload.f | 0
{ccx_2.9 => ccx_2.10}/src/addimdnodedload.f | 22 +-
{ccx_2.9 => ccx_2.10}/src/addimdnodedof.f | 0
{ccx_2.9 => ccx_2.10}/src/addizdofcload.f | 0
{ccx_2.9 => ccx_2.10}/src/addizdofdload.f | 0
{ccx_2.9 => ccx_2.10}/src/adjustcontactnodes.f | 33 +-
{ccx_2.9 => ccx_2.10}/src/advecforc.f | 0
{ccx_2.9 => ccx_2.10}/src/advecstiff.f | 0
{ccx_2.9 => ccx_2.10}/src/allocation.f | 21 +-
{ccx_2.9 => ccx_2.10}/src/allocont.f | 2 -
{ccx_2.9 => ccx_2.10}/src/amplitudes.f | 0
{ccx_2.9 => ccx_2.10}/src/angsum.f | 0
ccx_2.10/src/anisomaxwavspd.f | 262 ++
{ccx_2.9 => ccx_2.10}/src/anisonl.f | 0
{ccx_2.9 => ccx_2.10}/src/anisotropic.f | 0
{ccx_2.9 => ccx_2.10}/src/applyboun.f | 6 +-
{ccx_2.9 => ccx_2.10}/src/applympc.f | 15 +-
{ccx_2.9 => ccx_2.10}/src/applympc_hfa.f | 0
{ccx_2.9 => ccx_2.10}/src/approxplane.f | 0
{ccx_2.9 => ccx_2.10}/src/arpack.c | 8 +-
{ccx_2.9 => ccx_2.10}/src/arpackbu.c | 16 +-
{ccx_2.9 => ccx_2.10}/src/arpackcs.c | 0
{ccx_2.9 => ccx_2.10}/src/assigndomtonodes.f | 0
ccx_2.10/src/attach.f | 167 +
{ccx_2.9 => ccx_2.10}/src/attach_3d.f | 0
{ccx_2.9 => ccx_2.10}/src/attachline.f | 0
{ccx_2.9 => ccx_2.10}/src/basis.f | 0
{ccx_2.9 => ccx_2.10}/src/beamextscheme.f | 32 +-
{ccx_2.9 => ccx_2.10}/src/beamgeneralsections.f | 0
{ccx_2.9 => ccx_2.10}/src/beamintscheme.f | 0
{ccx_2.9 => ccx_2.10}/src/beamsections.f | 0
{ccx_2.9 => ccx_2.10}/src/biosav.c | 0
{ccx_2.9 => ccx_2.10}/src/biotsavart.f | 0
{ccx_2.9 => ccx_2.10}/src/bodyadd.f | 0
{ccx_2.9 => ccx_2.10}/src/bodyforce.f | 0
{ccx_2.9 => ccx_2.10}/src/bounadd.f | 0
{ccx_2.9 => ccx_2.10}/src/bounaddf.f | 22 +-
{ccx_2.9 => ccx_2.10}/src/boundaryfs.f | 0
{ccx_2.9 => ccx_2.10}/src/boundarys.f | 0
{ccx_2.9 => ccx_2.10}/src/bounrem.f | 0
{ccx_2.9 => ccx_2.10}/src/bsort.f | 0
{ccx_2.9 => ccx_2.10}/src/buckles.f | 0
{ccx_2.9 => ccx_2.10}/src/calc_ider_cross_split.f | 0
{ccx_2.9 => ccx_2.10}/src/calc_ider_tee.f | 0
{ccx_2.9 => ccx_2.10}/src/calc_ider_wye.f | 0
.../src/calc_residual_cross_split.f | 0
{ccx_2.9 => ccx_2.10}/src/calc_residual_tee.f | 0
{ccx_2.9 => ccx_2.10}/src/calc_residual_wye.f | 0
{ccx_2.9 => ccx_2.10}/src/calcbody.f | 0
{ccx_2.9 => ccx_2.10}/src/calccvel.f | 0
{ccx_2.9 => ccx_2.10}/src/calccvelcomp.f | 7 +-
{ccx_2.9 => ccx_2.10}/src/calccvfa.f | 0
{ccx_2.9 => ccx_2.10}/src/calccvfacomp.f | 7 +-
{ccx_2.9 => ccx_2.10}/src/calceigenvalues.f | 0
{ccx_2.9 => ccx_2.10}/src/calcenergy.f | 26 +-
{ccx_2.9 => ccx_2.10}/src/calcgamma.f | 43 +-
{ccx_2.9 => ccx_2.10}/src/calcgammat.f | 0
{ccx_2.9 => ccx_2.10}/src/calcgradpel.f | 16 +-
{ccx_2.9 => ccx_2.10}/src/calcgradtel.f | 16 +-
{ccx_2.9 => ccx_2.10}/src/calcgradvel.f | 21 +-
{ccx_2.9 => ccx_2.10}/src/calcguesstincf.f | 0
{ccx_2.9 => ccx_2.10}/src/calch0interface.f | 0
{ccx_2.9 => ccx_2.10}/src/calchcel.f | 0
{ccx_2.9 => ccx_2.10}/src/calchcfa.f | 7 +-
{ccx_2.9 => ccx_2.10}/src/calcinitialflux.f | 0
{ccx_2.9 => ccx_2.10}/src/calcmac.f | 0
{ccx_2.9 => ccx_2.10}/src/calcmass.f | 26 +-
ccx_2.10/src/calcmatwavspeed.f | 179 +
{ccx_2.9 => ccx_2.10}/src/calcpel.f | 0
{ccx_2.9 => ccx_2.10}/src/calcresidual.c | 0
{ccx_2.9 => ccx_2.10}/src/calcresidual_em.c | 0
{ccx_2.9 => ccx_2.10}/src/calcrhoel.f | 0
{ccx_2.9 => ccx_2.10}/src/calcrhoelcomp.f | 7 +-
{ccx_2.9 => ccx_2.10}/src/calcrhofa.f | 2 -
{ccx_2.9 => ccx_2.10}/src/calcrhofacomp.f | 8 +-
.../src/calcrhofacompisen.f | 21 +-
ccx_2.10/src/calcstabletimeinccont.f | 182 +
ccx_2.10/src/calcstabletimeincvol.f | 259 ++
{ccx_2.9 => ccx_2.10}/src/calcstressheatflux.f | 0
{ccx_2.9 => ccx_2.10}/src/calctel.f | 0
{ccx_2.9 => ccx_2.10}/src/calcumel.f | 6 +
{ccx_2.9 => ccx_2.10}/src/calcumfa.f | 6 +
{ccx_2.9 => ccx_2.10}/src/calcvel.f | 0
{ccx_2.9 => ccx_2.10}/src/calcview.f | 0
{ccx_2.9 => ccx_2.10}/src/calinput.f | 41 +-
{ccx_2.9 => ccx_2.10}/src/carbon_seal.f | 0
{ccx_2.9 => ccx_2.10}/src/cascade.c | 0
{ccx_2.9 => ccx_2.10}/src/cataloguenodes.f | 0
ccx_2.9/src/ccx_2.9.c => ccx_2.10/src/ccx_2.10.c | 42 +-
{ccx_2.9 => ccx_2.10}/src/cd_Mcgreehan_Schotsch.f | 0
{ccx_2.9 => ccx_2.10}/src/cd_bleedtapping.f | 0
{ccx_2.9 => ccx_2.10}/src/cd_bragg.f | 0
{ccx_2.9 => ccx_2.10}/src/cd_chamfer.f | 0
{ccx_2.9 => ccx_2.10}/src/cd_lab_1spike.f | 0
{ccx_2.9 => ccx_2.10}/src/cd_lab_correction.f | 0
{ccx_2.9 => ccx_2.10}/src/cd_lab_honeycomb.f | 0
{ccx_2.9 => ccx_2.10}/src/cd_lab_radius.f | 0
{ccx_2.9 => ccx_2.10}/src/cd_lab_straight.f | 0
{ccx_2.9 => ccx_2.10}/src/cd_lichtarowicz.f | 0
{ccx_2.9 => ccx_2.10}/src/cd_ms_ms.f | 0
{ccx_2.9 => ccx_2.10}/src/cd_own_albers.f | 0
{ccx_2.9 => ccx_2.10}/src/cd_pk_albers.f | 0
{ccx_2.9 => ccx_2.10}/src/cd_pk_ms.f | 0
{ccx_2.9 => ccx_2.10}/src/cd_preswirlnozzle.f | 0
{ccx_2.9 => ccx_2.10}/src/cfds.f | 0
{ccx_2.9 => ccx_2.10}/src/cflux.f | 0
{ccx_2.9 => ccx_2.10}/src/cfluxs.f | 0
{ccx_2.9 => ccx_2.10}/src/changedepterm.f | 0
{ccx_2.9 => ccx_2.10}/src/changefrictions.f | 0
{ccx_2.9 => ccx_2.10}/src/changekon.f | 0
{ccx_2.9 => ccx_2.10}/src/changematerials.f | 0
{ccx_2.9 => ccx_2.10}/src/changeplastics.f | 0
{ccx_2.9 => ccx_2.10}/src/changesolidsections.f | 0
{ccx_2.9 => ccx_2.10}/src/changesurfacebehaviors.f | 0
{ccx_2.9 => ccx_2.10}/src/characteristic.f | 0
{ccx_2.9 => ccx_2.10}/src/checkconvergence.c | 177 +-
{ccx_2.9 => ccx_2.10}/src/checkconvnet.c | 0
ccx_2.10/src/checkimpacts.f | 217 ++
{ccx_2.9 => ccx_2.10}/src/checkinclength.c | 0
{ccx_2.9 => ccx_2.10}/src/checktemp.f | 0
{ccx_2.9 => ccx_2.10}/src/checktime.f | 0
{ccx_2.9 => ccx_2.10}/src/checktruecontact.f | 0
{ccx_2.9 => ccx_2.10}/src/chksurf.f | 0
{ccx_2.9 => ccx_2.10}/src/cident.f | 0
{ccx_2.9 => ccx_2.10}/src/cident20.f | 0
{ccx_2.9 => ccx_2.10}/src/clearances.f | 0
{ccx_2.9 => ccx_2.10}/src/cload.f | 0
{ccx_2.9 => ccx_2.10}/src/cloads.f | 0
{ccx_2.9 => ccx_2.10}/src/closefile.f | 0
{ccx_2.9 => ccx_2.10}/src/closefilefluid.f | 0
{ccx_2.9 => ccx_2.10}/src/compare.c | 0
{ccx_2.9 => ccx_2.10}/src/compfluid.c | 743 ++--
{ccx_2.9 => ccx_2.10}/src/complete_hel.f | 8 -
{ccx_2.9 => ccx_2.10}/src/complexfreq.c | 2 +-
{ccx_2.9 => ccx_2.10}/src/complexfrequencys.f | 0
{ccx_2.9 => ccx_2.10}/src/conductivitys.f | 0
{ccx_2.9 => ccx_2.10}/src/contact.c | 3 +-
{ccx_2.9 => ccx_2.10}/src/contactdampings.f | 0
{ccx_2.9 => ccx_2.10}/src/contactpairs.f | 0
{ccx_2.9 => ccx_2.10}/src/contactprints.f | 0
{ccx_2.9 => ccx_2.10}/src/controlss.f | 0
{ccx_2.9 => ccx_2.10}/src/convert2slapcol.f | 0
{ccx_2.9 => ccx_2.10}/src/coriolissolve.f | 0
{ccx_2.9 => ccx_2.10}/src/correctvel.f | 20 +-
{ccx_2.9 => ccx_2.10}/src/correctvfa.f | 40 +-
{ccx_2.9 => ccx_2.10}/src/couptempdisps.f | 0
{ccx_2.9 => ccx_2.10}/src/cp_corrected.f | 0
{ccx_2.9 => ccx_2.10}/src/createinterfacempcs.f | 0
{ccx_2.9 => ccx_2.10}/src/createinum.f | 0
{ccx_2.9 => ccx_2.10}/src/createmddof.f | 24 +-
{ccx_2.9 => ccx_2.10}/src/createmdelem.f | 0
{ccx_2.9 => ccx_2.10}/src/createtiedsurfs.f | 0
{ccx_2.9 => ccx_2.10}/src/creep.f | 0
ccx_2.10/src/creeps.f | 184 +
{ccx_2.9 => ccx_2.10}/src/cross_split.f | 0
{ccx_2.9 => ccx_2.10}/src/cubic.f | 0
{ccx_2.9 => ccx_2.10}/src/cubtri.f | 0
{ccx_2.9 => ccx_2.10}/src/cyclichardenings.f | 0
{ccx_2.9 => ccx_2.10}/src/cyclicsymmetrymodels.f | 28 +-
{ccx_2.9 => ccx_2.10}/src/dKdX.f | 0
{ccx_2.9 => ccx_2.10}/src/dKdm.f | 0
{ccx_2.9 => ccx_2.10}/src/dKdp.f | 0
{ccx_2.9 => ccx_2.10}/src/dKdt.f | 0
{ccx_2.9 => ccx_2.10}/src/dampings.f | 0
{ccx_2.9 => ccx_2.10}/src/dashdamp.f | 0
{ccx_2.9 => ccx_2.10}/src/dashforc.f | 0
{ccx_2.9 => ccx_2.10}/src/dashpots.f | 0
ccx_2.10/src/date.pl | 22 +
{ccx_2.9 => ccx_2.10}/src/dattime.f | 0
{ccx_2.9 => ccx_2.10}/src/ddeabm.f | 0
{ccx_2.9 => ccx_2.10}/src/ddebdf.f | 0
{ccx_2.9 => ccx_2.10}/src/deformationplasticitys.f | 0
{ccx_2.9 => ccx_2.10}/src/defplas.f | 0
{ccx_2.9 => ccx_2.10}/src/delaun.f | 0
{ccx_2.9 => ccx_2.10}/src/deltri.f | 0
{ccx_2.9 => ccx_2.10}/src/densitys.f | 0
{ccx_2.9 => ccx_2.10}/src/depvars.f | 0
{ccx_2.9 => ccx_2.10}/src/designvariabless.f | 0
{ccx_2.9 => ccx_2.10}/src/deuldlag.f | 0
{ccx_2.9 => ccx_2.10}/src/dfdbj.c | 0
{ccx_2.9 => ccx_2.10}/src/dflux.f | 22 +-
{ccx_2.9 => ccx_2.10}/src/dfluxs.f | 0
{ccx_2.9 => ccx_2.10}/src/dgesv.f | 0
{ccx_2.9 => ccx_2.10}/src/dgmres.f | 0
{ccx_2.9 => ccx_2.10}/src/dir.f | 0
ccx_2.10/src/distattach.f | 113 +
{ccx_2.9 => ccx_2.10}/src/distattach_3d.f | 0
{ccx_2.9 => ccx_2.10}/src/distattachline.f | 0
{ccx_2.9 => ccx_2.10}/src/distributingcouplings.f | 0
{ccx_2.9 => ccx_2.10}/src/dload.f | 22 +-
{ccx_2.9 => ccx_2.10}/src/dloads.f | 0
{ccx_2.9 => ccx_2.10}/src/dlz.f | 0
{ccx_2.9 => ccx_2.10}/src/dqag.f | 0
{ccx_2.9 => ccx_2.10}/src/drfftf.f | 0
{ccx_2.9 => ccx_2.10}/src/dslugm.f | 0
{ccx_2.9 => ccx_2.10}/src/dsort.f | 0
{ccx_2.9 => ccx_2.10}/src/dyna.c | 0
{ccx_2.9 => ccx_2.10}/src/dynacont.c | 0
{ccx_2.9 => ccx_2.10}/src/dynamic_viscosity.f | 0
{ccx_2.9 => ccx_2.10}/src/dynamics.f | 0
{ccx_2.9 => ccx_2.10}/src/dynboun.c | 0
{ccx_2.9 => ccx_2.10}/src/dynresults.f | 0
{ccx_2.9 => ccx_2.10}/src/e_c3d.f | 119 +-
{ccx_2.9 => ccx_2.10}/src/e_c3d_em.f | 24 +-
{ccx_2.9 => ccx_2.10}/src/e_c3d_rhs.f | 24 +-
{ccx_2.9 => ccx_2.10}/src/e_c3d_rhs_th.f | 24 +-
{ccx_2.9 => ccx_2.10}/src/e_c3d_se.f | 188 +-
{ccx_2.9 => ccx_2.10}/src/e_c3d_th.f | 120 +-
{ccx_2.9 => ccx_2.10}/src/e_corio.f | 28 +-
{ccx_2.9 => ccx_2.10}/src/e_damp.f | 0
{ccx_2.9 => ccx_2.10}/src/edg.f | 0
{ccx_2.9 => ccx_2.10}/src/effectivemodalmass.f | 0
{ccx_2.9 => ccx_2.10}/src/el.f | 0
{ccx_2.9 => ccx_2.10}/src/elastics.f | 0
.../src/electricalconductivitys.f | 0
{ccx_2.9 => ccx_2.10}/src/electromagnetics.c | 18 +-
{ccx_2.9 => ccx_2.10}/src/electromagneticss.f | 0
{ccx_2.9 => ccx_2.10}/src/elemChecker.c | 0
{ccx_2.9 => ccx_2.10}/src/elementpernode.f | 0
{ccx_2.9 => ccx_2.10}/src/elements.f | 0
{ccx_2.9 => ccx_2.10}/src/elprints.f | 0
{ccx_2.9 => ccx_2.10}/src/envtemp.f | 26 +-
{ccx_2.9 => ccx_2.10}/src/eplane.f | 0
{ccx_2.9 => ccx_2.10}/src/equationcheck.f | 0
{ccx_2.9 => ccx_2.10}/src/equationfs.f | 22 +-
{ccx_2.9 => ccx_2.10}/src/equations.f | 0
{ccx_2.9 => ccx_2.10}/src/equcons.f | 0
{ccx_2.9 => ccx_2.10}/src/errorestimator.f | 52 +-
{ccx_2.9 => ccx_2.10}/src/evalshapefunc.f | 0
{ccx_2.9 => ccx_2.10}/src/expand.c | 6 +-
{ccx_2.9 => ccx_2.10}/src/expansions.f | 0
{ccx_2.9 => ccx_2.10}/src/extrapolate.f | 30 +-
{ccx_2.9 => ccx_2.10}/src/extrapolate_ad_h.f | 7 +-
{ccx_2.9 => ccx_2.10}/src/extrapolate_ad_h_comp.f | 7 +-
{ccx_2.9 => ccx_2.10}/src/extrapolate_gradtel.f | 7 +-
{ccx_2.9 => ccx_2.10}/src/extrapolate_gradvel.f | 9 +-
{ccx_2.9 => ccx_2.10}/src/extrapolate_pel.f | 10 +-
{ccx_2.9 => ccx_2.10}/src/extrapolate_tel.f | 11 +-
{ccx_2.9 => ccx_2.10}/src/extrapolate_vel.f | 6 +
{ccx_2.9 => ccx_2.10}/src/extrapolatecontact.f | 167 +-
{ccx_2.9 => ccx_2.10}/src/extrapolatefluid.f | 0
{ccx_2.9 => ccx_2.10}/src/faceinfo.f | 0
{ccx_2.9 => ccx_2.10}/src/faceprints.f | 0
{ccx_2.9 => ccx_2.10}/src/fcrit.f | 0
{ccx_2.9 => ccx_2.10}/src/fillknotmpc.f | 0
{ccx_2.9 => ccx_2.10}/src/film.f | 0
{ccx_2.9 => ccx_2.10}/src/films.f | 0
{ccx_2.9 => ccx_2.10}/src/findsurface.f | 22 +-
{ccx_2.9 => ccx_2.10}/src/flowoutput.f | 0
{ccx_2.9 => ccx_2.10}/src/flowresult.f | 0
{ccx_2.9 => ccx_2.10}/src/fluidconstantss.f | 0
{ccx_2.9 => ccx_2.10}/src/fluidsections.f | 0
{ccx_2.9 => ccx_2.10}/src/flux.f | 0
{ccx_2.9 => ccx_2.10}/src/forcadd.f | 0
{ccx_2.9 => ccx_2.10}/src/forcesolve.f | 0
{ccx_2.9 => ccx_2.10}/src/frd.c | 2 +
ccx_2.10/src/frd_se.c | 132 +
{ccx_2.9 => ccx_2.10}/src/frdcyc.c | 0
{ccx_2.9 => ccx_2.10}/src/frdfluid.f | 60 +-
{ccx_2.9 => ccx_2.10}/src/frdheader.c | 0
{ccx_2.9 => ccx_2.10}/src/frditeration.f | 0
{ccx_2.9 => ccx_2.10}/src/frdselect.c | 0
{ccx_2.9 => ccx_2.10}/src/frdset.c | 0
{ccx_2.9 => ccx_2.10}/src/frdvector.c | 0
{ccx_2.9 => ccx_2.10}/src/frecord.c | 0
{ccx_2.9 => ccx_2.10}/src/free_convection.f | 0
{ccx_2.9 => ccx_2.10}/src/free_disc_pumping.f | 0
{ccx_2.9 => ccx_2.10}/src/frequencys.f | 0
{ccx_2.9 => ccx_2.10}/src/friction_coefficient.f | 0
{ccx_2.9 => ccx_2.10}/src/frictionheating.f | 12 +-
{ccx_2.9 => ccx_2.10}/src/frictions.f | 0
{ccx_2.9 => ccx_2.10}/src/fsub.f | 0
{ccx_2.9 => ccx_2.10}/src/fsuper.f | 0
{ccx_2.9 => ccx_2.10}/src/gapcon.f | 0
{ccx_2.9 => ccx_2.10}/src/gapconductances.f | 0
{ccx_2.9 => ccx_2.10}/src/gapheatgenerations.f | 0
{ccx_2.9 => ccx_2.10}/src/gaps.f | 0
{ccx_2.9 => ccx_2.10}/src/gasmechbc.f | 0
{ccx_2.9 => ccx_2.10}/src/gaspipe.f | 0
{ccx_2.9 => ccx_2.10}/src/gaspipe_fanno.f | 0
{ccx_2.9 => ccx_2.10}/src/gauss.f | 0
{ccx_2.9 => ccx_2.10}/src/gen3dboun.f | 4 +-
{ccx_2.9 => ccx_2.10}/src/gen3dconnect.f | 0
{ccx_2.9 => ccx_2.10}/src/gen3delem.f | 0
{ccx_2.9 => ccx_2.10}/src/gen3dforc.f | 0
{ccx_2.9 => ccx_2.10}/src/gen3dfrom1d.f | 0
{ccx_2.9 => ccx_2.10}/src/gen3dfrom2d.f | 0
{ccx_2.9 => ccx_2.10}/src/gen3dmembrane.f | 0
{ccx_2.9 => ccx_2.10}/src/gen3dmpc.f | 0
{ccx_2.9 => ccx_2.10}/src/gen3dnor.f | 0
{ccx_2.9 => ccx_2.10}/src/gen3dprop.f | 0
{ccx_2.9 => ccx_2.10}/src/gen3dsurf.f | 0
{ccx_2.9 => ccx_2.10}/src/gen3dtemp.f | 0
{ccx_2.9 => ccx_2.10}/src/gen3dtruss.f | 0
{ccx_2.9 => ccx_2.10}/src/genadvecelem.f | 22 +-
{ccx_2.9 => ccx_2.10}/src/gencontelem_f2f.f | 99 +-
{ccx_2.9 => ccx_2.10}/src/gencontelem_n2f.f | 50 +-
{ccx_2.9 => ccx_2.10}/src/generatecycmpcs.f | 0
{ccx_2.9 => ccx_2.10}/src/generateeminterfaces.f | 35 +-
{ccx_2.9 => ccx_2.10}/src/generatetet.f | 0
{ccx_2.9 => ccx_2.10}/src/genmassfloweqs.f | 22 +-
{ccx_2.9 => ccx_2.10}/src/genmodes.f | 0
{ccx_2.9 => ccx_2.10}/src/gennactdofinv.f | 6 -
{ccx_2.9 => ccx_2.10}/src/gentiedmpc.f | 22 +-
{ccx_2.9 => ccx_2.10}/src/geomview.f | 4 +-
{ccx_2.9 => ccx_2.10}/src/getSystemCPUs.c | 0
{ccx_2.9 => ccx_2.10}/src/getdesiinfo.f | 42 +-
{ccx_2.9 => ccx_2.10}/src/getglobalresults.c | 8 +
{ccx_2.9 => ccx_2.10}/src/getnewline.f | 0
{ccx_2.9 => ccx_2.10}/src/getnodel.f | 22 +-
{ccx_2.9 => ccx_2.10}/src/hcrit.f | 0
{ccx_2.9 => ccx_2.10}/src/headings.f | 0
{ccx_2.9 => ccx_2.10}/src/heattransfers.f | 0
{ccx_2.9 => ccx_2.10}/src/hgforce.f | 0
{ccx_2.9 => ccx_2.10}/src/hgstiffness.f | 0
{ccx_2.9 => ccx_2.10}/src/hns.f | 0
{ccx_2.9 => ccx_2.10}/src/hybsvd.f | 0
{ccx_2.9 => ccx_2.10}/src/hyperelastics.f | 0
{ccx_2.9 => ccx_2.10}/src/hyperfoams.f | 0
{ccx_2.9 => ccx_2.10}/src/ident.f | 0
{ccx_2.9 => ccx_2.10}/src/ident2.f | 0
{ccx_2.9 => ccx_2.10}/src/identamta.f | 0
{ccx_2.9 => ccx_2.10}/src/identifytiedface.f | 0
{ccx_2.9 => ccx_2.10}/src/identifytransform.f | 0
{ccx_2.9 => ccx_2.10}/src/includefilename.f | 0
{ccx_2.9 => ccx_2.10}/src/incplas.f | 0
{ccx_2.9 => ccx_2.10}/src/incplas_lin.f | 0
{ccx_2.9 => ccx_2.10}/src/inequcons.f | 0
{ccx_2.9 => ccx_2.10}/src/inicalcbody.f | 0
{ccx_2.9 => ccx_2.10}/src/inicont.c | 0
{ccx_2.9 => ccx_2.10}/src/init.f | 0
{ccx_2.9 => ccx_2.10}/src/initialcfd.f | 0
{ccx_2.9 => ccx_2.10}/src/initialchannel.f | 0
{ccx_2.9 => ccx_2.10}/src/initialconditionss.f | 30 +-
{ccx_2.9 => ccx_2.10}/src/initialnet.f | 0
{ccx_2.9 => ccx_2.10}/src/inputerror.f | 0
{ccx_2.9 => ccx_2.10}/src/inputinfo.f | 0
{ccx_2.9 => ccx_2.10}/src/inputwarning.f | 0
{ccx_2.9 => ccx_2.10}/src/insert.c | 16 +-
{ccx_2.9 => ccx_2.10}/src/insertfreq.c | 43 +-
{ccx_2.9 => ccx_2.10}/src/insertrad.c | 0
{ccx_2.9 => ccx_2.10}/src/interpol_alfa2.f | 0
{ccx_2.9 => ccx_2.10}/src/interpolateinface.f | 24 +-
{ccx_2.9 => ccx_2.10}/src/interpolatestate.f | 0
{ccx_2.9 => ccx_2.10}/src/interpolsubmodel.f | 0
{ccx_2.9 => ccx_2.10}/src/intersectionpoint.f | 0
{ccx_2.9 => ccx_2.10}/src/islavactive.f | 24 +-
{ccx_2.9 => ccx_2.10}/src/isorti.f | 0
{ccx_2.9 => ccx_2.10}/src/isortid.f | 0
{ccx_2.9 => ccx_2.10}/src/isortiddc.f | 0
{ccx_2.9 => ccx_2.10}/src/isortii.f | 0
{ccx_2.9 => ccx_2.10}/src/isortiid.f | 0
{ccx_2.9 => ccx_2.10}/src/isortiiddc.f | 0
{ccx_2.9 => ccx_2.10}/src/jouleheating.f | 0
{ccx_2.9 => ccx_2.10}/src/keystart.f | 0
{ccx_2.9 => ccx_2.10}/src/knotmpc.f | 0
{ccx_2.9 => ccx_2.10}/src/lab_straight_ppkrit.f | 0
{ccx_2.9 => ccx_2.10}/src/labyrinth.f | 0
ccx_2.10/src/lbfgsb.f | 3949 ++++++++++++++++++++
{ccx_2.9 => ccx_2.10}/src/limit_case_calc.f | 0
{ccx_2.9 => ccx_2.10}/src/linel.f | 0
{ccx_2.9 => ccx_2.10}/src/linkdissimilar.f | 0
ccx_2.10/src/linpack.f | 218 ++
{ccx_2.9 => ccx_2.10}/src/linscal.f | 0
{ccx_2.9 => ccx_2.10}/src/linstatic.c | 55 +-
{ccx_2.9 => ccx_2.10}/src/lintemp.f | 0
{ccx_2.9 => ccx_2.10}/src/lintemp_th.f | 0
{ccx_2.9 => ccx_2.10}/src/linvec.f | 0
{ccx_2.9 => ccx_2.10}/src/liquidchannel.f | 0
{ccx_2.9 => ccx_2.10}/src/liquidpipe.f | 0
{ccx_2.9 => ccx_2.10}/src/liquidpump.f | 0
{ccx_2.9 => ccx_2.10}/src/loadadd.f | 0
{ccx_2.9 => ccx_2.10}/src/loadaddp.f | 0
{ccx_2.9 => ccx_2.10}/src/loadaddt.f | 0
{ccx_2.9 => ccx_2.10}/src/machpi.f | 0
{ccx_2.9 => ccx_2.10}/src/mafillcorio.f | 26 +-
{ccx_2.9 => ccx_2.10}/src/mafilldm.f | 0
{ccx_2.9 => ccx_2.10}/src/mafillem.f | 0
{ccx_2.9 => ccx_2.10}/src/mafillnet.f | 22 +-
{ccx_2.9 => ccx_2.10}/src/mafillp.f | 61 +-
ccx_2.10/src/mafillpbc.f | 57 +
{ccx_2.9 => ccx_2.10}/src/mafillpcomp.f | 189 +-
ccx_2.10/src/mafillpcompmain.c | 198 +
ccx_2.10/src/mafillpmain.c | 192 +
ccx_2.9/src/mafillsm1.f => ccx_2.10/src/mafillsm.f | 10 +-
ccx_2.9/src/mafillsm.f => ccx_2.10/src/mafillsm1.f | 2 +-
{ccx_2.9 => ccx_2.10}/src/mafillsmas.f | 0
.../src/mafillsmas.f => ccx_2.10/src/mafillsmas1.f | 28 +-
.../src/mafillsmasmain.c | 216 +-
{ccx_2.9 => ccx_2.10}/src/mafillsmcs.f | 0
{ccx_2.9 => ccx_2.10}/src/mafillsmcsas.f | 0
{ccx_2.9 => ccx_2.10}/src/mafillsmforc.f | 0
{ccx_2.9 => ccx_2.10}/src/mafillsmmain.c | 60 +-
{ccx_2.9 => ccx_2.10}/src/mafillsmmain_se.c | 69 +-
.../src/mafillsm_se.f => ccx_2.10/src/mafillsmse.f | 147 +-
{ccx_2.9 => ccx_2.10}/src/mafillt.f | 32 +-
{ccx_2.9 => ccx_2.10}/src/mafilltcomp.f | 61 +-
ccx_2.10/src/mafilltcompmain.c | 202 +
ccx_2.10/src/mafilltmain.c | 202 +
{ccx_2.9 => ccx_2.10}/src/mafillv.f | 36 +-
{ccx_2.9 => ccx_2.10}/src/mafillvcomp.f | 75 +-
ccx_2.10/src/mafillvcompmain.c | 199 +
ccx_2.10/src/mafillvmain.c | 197 +
{ccx_2.9 => ccx_2.10}/src/magneticpermeabilitys.f | 0
{ccx_2.9 => ccx_2.10}/src/map3dto1d2d.f | 26 +-
{ccx_2.9 => ccx_2.10}/src/map3dto1d2d_v.f | 0
{ccx_2.9 => ccx_2.10}/src/map3dtolayer.f | 0
{ccx_2.9 => ccx_2.10}/src/massflow_percent.f | 0
{ccx_2.9 => ccx_2.10}/src/massflows.f | 0
{ccx_2.9 => ccx_2.10}/src/mastruct.c | 93 +-
{ccx_2.9 => ccx_2.10}/src/mastructcs.c | 38 +-
{ccx_2.9 => ccx_2.10}/src/mastructem.c | 61 +-
{ccx_2.9 => ccx_2.10}/src/mastructf.c | 40 +-
{ccx_2.9 => ccx_2.10}/src/mastructrad.c | 0
ccx_2.10/src/materialdata_cfd.f | 105 +
ccx_2.10/src/materialdata_cfd_comp.f | 109 +
{ccx_2.9 => ccx_2.10}/src/materialdata_cond.f | 0
{ccx_2.9 => ccx_2.10}/src/materialdata_cp.f | 0
{ccx_2.9 => ccx_2.10}/src/materialdata_cp_sec.f | 0
{ccx_2.9 => ccx_2.10}/src/materialdata_dvi.f | 0
{ccx_2.9 => ccx_2.10}/src/materialdata_em.f | 0
{ccx_2.9 => ccx_2.10}/src/materialdata_me.f | 0
{ccx_2.9 => ccx_2.10}/src/materialdata_rho.f | 0
{ccx_2.9 => ccx_2.10}/src/materialdata_sp.f | 0
{ccx_2.9 => ccx_2.10}/src/materialdata_tg.f | 0
{ccx_2.9 => ccx_2.10}/src/materialdata_th.f | 0
{ccx_2.9 => ccx_2.10}/src/materials.f | 0
{ccx_2.9 => ccx_2.10}/src/matrixstorage.c | 0
{ccx_2.9 => ccx_2.10}/src/matrixstorage.h | 0
{ccx_2.9 => ccx_2.10}/src/matvec.f | 0
{ccx_2.9 => ccx_2.10}/src/meannode.f | 0
{ccx_2.9 => ccx_2.10}/src/mechmodel.f | 0
{ccx_2.9 => ccx_2.10}/src/modaldampings.f | 0
{ccx_2.9 => ccx_2.10}/src/modaldynamics.f | 0
{ccx_2.9 => ccx_2.10}/src/modelchanges.f | 0
{ccx_2.9 => ccx_2.10}/src/modf.f | 0
{ccx_2.9 => ccx_2.10}/src/moehring.f | 0
{ccx_2.9 => ccx_2.10}/src/mpcrem.f | 0
{ccx_2.9 => ccx_2.10}/src/mpcs.f | 0
{ccx_2.9 => ccx_2.10}/src/msolve.f | 0
{ccx_2.9 => ccx_2.10}/src/mult.f | 0
{ccx_2.9 => ccx_2.10}/src/multistages.f | 0
{ccx_2.9 => ccx_2.10}/src/multvec.f | 0
{ccx_2.9 => ccx_2.10}/src/near2d.f | 0
{ccx_2.9 => ccx_2.10}/src/near3d.f | 0
{ccx_2.9 => ccx_2.10}/src/neartriangle.f | 0
{ccx_2.9 => ccx_2.10}/src/negativepressure.f | 0
{ccx_2.9 => ccx_2.10}/src/networkextrapolate.f | 0
{ccx_2.9 => ccx_2.10}/src/networkforc.f | 0
{ccx_2.9 => ccx_2.10}/src/networkinum.f | 0
{ccx_2.9 => ccx_2.10}/src/networkstiff.f | 0
{ccx_2.9 => ccx_2.10}/src/newton.f | 0
{ccx_2.9 => ccx_2.10}/src/nident.f | 0
{ccx_2.9 => ccx_2.10}/src/nident2.f | 0
{ccx_2.9 => ccx_2.10}/src/nidentk.f | 0
{ccx_2.9 => ccx_2.10}/src/nidentll.f | 0
{ccx_2.9 => ccx_2.10}/src/noanalysiss.f | 0
{ccx_2.9 => ccx_2.10}/src/nodalthicknesss.f | 0
{ccx_2.9 => ccx_2.10}/src/nodeprints.f | 0
{ccx_2.9 => ccx_2.10}/src/nodes.f | 0
{ccx_2.9 => ccx_2.10}/src/nodestiedface.f | 22 +-
{ccx_2.9 => ccx_2.10}/src/noelfiles.f | 11 +
{ccx_2.9 => ccx_2.10}/src/noelsets.f | 0
{ccx_2.9 => ccx_2.10}/src/nonlingeo.c | 603 ++-
{ccx_2.9 => ccx_2.10}/src/nonlinmpc.f | 0
{ccx_2.9 => ccx_2.10}/src/norm.f | 0
{ccx_2.9 => ccx_2.10}/src/normals.f | 0
{ccx_2.9 => ccx_2.10}/src/normalsoninterface.f | 94 +-
{ccx_2.9 => ccx_2.10}/src/norshell3.f | 0
{ccx_2.9 => ccx_2.10}/src/norshell4.f | 0
{ccx_2.9 => ccx_2.10}/src/norshell6.f | 0
{ccx_2.9 => ccx_2.10}/src/norshell8.f | 0
ccx_2.10/src/objective_mass.f | 51 +
ccx_2.10/src/objective_mass_dx.f | 398 ++
ccx_2.10/src/objective_shapeener.f | 89 +
.../src/objective_shapeener_dx.f | 306 +-
ccx_2.10/src/objective_shapeener_tot.f | 56 +
ccx_2.10/src/objectives.f | 92 +
ccx_2.10/src/objectivesmmain_se.c | 319 ++
{ccx_2.9 => ccx_2.10}/src/onedint.f | 0
{ccx_2.9 => ccx_2.10}/src/op.f | 0
{ccx_2.9 => ccx_2.10}/src/op_corio.f | 0
{ccx_2.9 => ccx_2.10}/src/opas.f | 0
{ccx_2.9 => ccx_2.10}/src/openfile.f | 0
{ccx_2.9 => ccx_2.10}/src/openfilefluid.f | 0
{ccx_2.9 => ccx_2.10}/src/orientations.f | 0
{ccx_2.9 => ccx_2.10}/src/orifice.f | 0
{ccx_2.9 => ccx_2.10}/src/orthonl.f | 0
{ccx_2.9 => ccx_2.10}/src/orthotropic.f | 0
{ccx_2.9 => ccx_2.10}/src/outputs.f | 0
{ccx_2.9 => ccx_2.10}/src/pardiso.c | 0
{ccx_2.9 => ccx_2.10}/src/pardiso.h | 0
{ccx_2.9 => ccx_2.10}/src/pardiso_as.c | 0
{ccx_2.9 => ccx_2.10}/src/patch.f | 0
{ccx_2.9 => ccx_2.10}/src/pcgsolver.c | 0
{ccx_2.9 => ccx_2.10}/src/physicalconstantss.f | 0
{ccx_2.9 => ccx_2.10}/src/pk_cdc_cl1.f | 0
{ccx_2.9 => ccx_2.10}/src/pk_cdc_cl3.f | 0
{ccx_2.9 => ccx_2.10}/src/pk_cdc_cl3a.f | 0
{ccx_2.9 => ccx_2.10}/src/pk_cdc_cl3b.f | 0
{ccx_2.9 => ccx_2.10}/src/pk_cdc_cl3d.f | 0
{ccx_2.9 => ccx_2.10}/src/pk_cdi_noz.f | 0
{ccx_2.9 => ccx_2.10}/src/pk_cdi_r.f | 0
{ccx_2.9 => ccx_2.10}/src/pk_cdi_rl.f | 0
{ccx_2.9 => ccx_2.10}/src/pk_cdi_se.f | 0
{ccx_2.9 => ccx_2.10}/src/pk_y0_yg.f | 0
{ccx_2.9 => ccx_2.10}/src/plane_eq.f | 0
{ccx_2.9 => ccx_2.10}/src/planeeq.f | 0
{ccx_2.9 => ccx_2.10}/src/planempc.f | 0
{ccx_2.9 => ccx_2.10}/src/plastics.f | 183 +-
{ccx_2.9 => ccx_2.10}/src/plcopy.f | 0
{ccx_2.9 => ccx_2.10}/src/plinterpol.f | 0
{ccx_2.9 => ccx_2.10}/src/plmix.f | 0
{ccx_2.9 => ccx_2.10}/src/pop.f | 0
{ccx_2.9 => ccx_2.10}/src/postview.f | 0
{ccx_2.9 => ccx_2.10}/src/precfd.f | 0
{ccx_2.9 => ccx_2.10}/src/precontact.c | 0
{ccx_2.9 => ccx_2.10}/src/predgmres.f | 0
{ccx_2.9 => ccx_2.10}/src/prediction.c | 0
{ccx_2.9 => ccx_2.10}/src/prediction_em.c | 0
{ccx_2.9 => ccx_2.10}/src/predir.f | 0
{ccx_2.9 => ccx_2.10}/src/preiter.c | 0
{ccx_2.9 => ccx_2.10}/src/pretensionsections.f | 22 +-
{ccx_2.9 => ccx_2.10}/src/printout.f | 10 +-
{ccx_2.9 => ccx_2.10}/src/printoutelem.f | 28 +-
{ccx_2.9 => ccx_2.10}/src/printoutface.f | 24 +-
{ccx_2.9 => ccx_2.10}/src/printoutfluid.f | 0
{ccx_2.9 => ccx_2.10}/src/printoutint.f | 12 +-
{ccx_2.9 => ccx_2.10}/src/printoutnode.f | 0
{ccx_2.9 => ccx_2.10}/src/printoutnodefluid.f | 0
{ccx_2.9 => ccx_2.10}/src/pt2_lim_calc.f | 0
{ccx_2.9 => ccx_2.10}/src/pt2zpt1_crit.f | 0
{ccx_2.9 => ccx_2.10}/src/push.f | 0
{ccx_2.9 => ccx_2.10}/src/qsorti.f | 0
{ccx_2.9 => ccx_2.10}/src/radcyc.c | 0
{ccx_2.9 => ccx_2.10}/src/radflowload.c | 0
{ccx_2.9 => ccx_2.10}/src/radiate.f | 0
{ccx_2.9 => ccx_2.10}/src/radiates.f | 0
{ccx_2.9 => ccx_2.10}/src/radmatrix.f | 22 +-
{ccx_2.9 => ccx_2.10}/src/radresult.f | 0
{ccx_2.9 => ccx_2.10}/src/rcavi.f | 0
{ccx_2.9 => ccx_2.10}/src/rcavi2.f | 0
{ccx_2.9 => ccx_2.10}/src/rcavi_cp_lt.f | 0
{ccx_2.9 => ccx_2.10}/src/rcavi_cp_nt.f | 0
{ccx_2.9 => ccx_2.10}/src/readforce.f | 0
{ccx_2.9 => ccx_2.10}/src/readfrd.c | 0
{ccx_2.9 => ccx_2.10}/src/readfrd.h | 0
{ccx_2.9 => ccx_2.10}/src/readinput.c | 4 +
{ccx_2.9 => ccx_2.10}/src/readview.f | 0
{ccx_2.9 => ccx_2.10}/src/rearrange.f | 0
{ccx_2.9 => ccx_2.10}/src/rectcyl.f | 0
{ccx_2.9 => ccx_2.10}/src/rectcylexp.f | 0
{ccx_2.9 => ccx_2.10}/src/rectcyltrfm.f | 0
{ccx_2.9 => ccx_2.10}/src/rectcylvi.f | 0
{ccx_2.9 => ccx_2.10}/src/remastruct.c | 2 +-
{ccx_2.9 => ccx_2.10}/src/remastructar.c | 0
{ccx_2.9 => ccx_2.10}/src/remastructem.c | 0
{ccx_2.9 => ccx_2.10}/src/restartread.f | 0
{ccx_2.9 => ccx_2.10}/src/restarts.f | 0
{ccx_2.9 => ccx_2.10}/src/restartshort.f | 0
{ccx_2.9 => ccx_2.10}/src/restartwrite.f | 2 +-
{ccx_2.9 => ccx_2.10}/src/restrictor.f | 0
{ccx_2.9 => ccx_2.10}/src/resultnet.f | 22 +-
{ccx_2.9 => ccx_2.10}/src/results.c | 0
{ccx_2.9 => ccx_2.10}/src/results_se.c | 309 +-
{ccx_2.9 => ccx_2.10}/src/resultsem.f | 22 +-
{ccx_2.9 => ccx_2.10}/src/resultsforc.f | 0
{ccx_2.9 => ccx_2.10}/src/resultsforc_em.f | 0
{ccx_2.9 => ccx_2.10}/src/resultsforc_se.f | 0
{ccx_2.9 => ccx_2.10}/src/resultsinduction.c | 0
{ccx_2.9 => ccx_2.10}/src/resultsini.f | 0
{ccx_2.9 => ccx_2.10}/src/resultsini_em.f | 0
{ccx_2.9 => ccx_2.10}/src/resultsmech.f | 29 +-
{ccx_2.9 => ccx_2.10}/src/resultsmech_se.f | 28 +-
{ccx_2.9 => ccx_2.10}/src/resultsprint.f | 2 +-
{ccx_2.9 => ccx_2.10}/src/resultstherm.f | 21 +-
{ccx_2.9 => ccx_2.10}/src/retainednodaldofss.f | 0
{ccx_2.9 => ccx_2.10}/src/rhs.f | 0
{ccx_2.9 => ccx_2.10}/src/rhsp.f | 45 +-
ccx_2.10/src/rhspmain.c | 198 +
{ccx_2.9 => ccx_2.10}/src/rigidbodys.f | 0
{ccx_2.9 => ccx_2.10}/src/rigidmpc.f | 0
{ccx_2.9 => ccx_2.10}/src/rimseal.f | 0
{ccx_2.9 => ccx_2.10}/src/rimseal_calc.f | 0
{ccx_2.9 => ccx_2.10}/src/rs.f | 0
{ccx_2.9 => ccx_2.10}/src/rubber.f | 0
{ccx_2.9 => ccx_2.10}/src/scavenge_pump.f | 0
{ccx_2.9 => ccx_2.10}/src/sdvini.f | 0
.../src/selectcyclicsymmetrymodess.f | 0
ccx_2.10/src/sensitivity.c | 334 ++
ccx_2.10/src/sensitivity_glob.f | 58 +
{ccx_2.9 => ccx_2.10}/src/sensitivitys.f | 0
{ccx_2.9 => ccx_2.10}/src/sgi.c | 0
{ccx_2.9 => ccx_2.10}/src/sgi.h | 0
{ccx_2.9 => ccx_2.10}/src/shape10tet.f | 0
{ccx_2.9 => ccx_2.10}/src/shape14tet.f | 0
{ccx_2.9 => ccx_2.10}/src/shape15w.f | 0
{ccx_2.9 => ccx_2.10}/src/shape20h.f | 0
{ccx_2.9 => ccx_2.10}/src/shape20h_ax.f | 0
{ccx_2.9 => ccx_2.10}/src/shape20h_pl.f | 0
{ccx_2.9 => ccx_2.10}/src/shape26h.f | 0
{ccx_2.9 => ccx_2.10}/src/shape3l.f | 0
{ccx_2.9 => ccx_2.10}/src/shape3tri.f | 4 +
{ccx_2.9 => ccx_2.10}/src/shape4q.f | 36 +-
{ccx_2.9 => ccx_2.10}/src/shape4tet.f | 0
{ccx_2.9 => ccx_2.10}/src/shape6tri.f | 24 +-
{ccx_2.9 => ccx_2.10}/src/shape6w.f | 0
{ccx_2.9 => ccx_2.10}/src/shape7tri.f | 0
{ccx_2.9 => ccx_2.10}/src/shape8h.f | 0
{ccx_2.9 => ccx_2.10}/src/shape8hr.f | 0
{ccx_2.9 => ccx_2.10}/src/shape8hu.f | 0
{ccx_2.9 => ccx_2.10}/src/shape8q.f | 98 +-
{ccx_2.9 => ccx_2.10}/src/shape9q.f | 0
{ccx_2.9 => ccx_2.10}/src/shellsections.f | 0
{ccx_2.9 => ccx_2.10}/src/sigini.f | 0
{ccx_2.9 => ccx_2.10}/src/skip.f | 0
{ccx_2.9 => ccx_2.10}/src/slavintpoints.f | 0
{ccx_2.9 => ccx_2.10}/src/smalldist.f | 6 +-
{ccx_2.9 => ccx_2.10}/src/solidsections.f | 0
{ccx_2.9 => ccx_2.10}/src/sortev.f | 0
{ccx_2.9 => ccx_2.10}/src/spcmatch.f | 0
{ccx_2.9 => ccx_2.10}/src/specificgasconstants.f | 0
{ccx_2.9 => ccx_2.10}/src/specificheats.f | 0
{ccx_2.9 => ccx_2.10}/src/splitline.f | 0
{ccx_2.9 => ccx_2.10}/src/spooles.c | 0
{ccx_2.9 => ccx_2.10}/src/spooles.h | 0
{ccx_2.9 => ccx_2.10}/src/springdamp_f2f.f | 0
{ccx_2.9 => ccx_2.10}/src/springdamp_n2f.f | 0
{ccx_2.9 => ccx_2.10}/src/springforc_f2f.f | 4 +-
{ccx_2.9 => ccx_2.10}/src/springforc_f2f_th.f | 0
{ccx_2.9 => ccx_2.10}/src/springforc_n2f.f | 54 +-
{ccx_2.9 => ccx_2.10}/src/springforc_n2f_th.f | 0
{ccx_2.9 => ccx_2.10}/src/springs.f | 0
{ccx_2.9 => ccx_2.10}/src/springstiff_f2f.f | 0
{ccx_2.9 => ccx_2.10}/src/springstiff_f2f_th.f | 0
{ccx_2.9 => ccx_2.10}/src/springstiff_n2f.f | 0
{ccx_2.9 => ccx_2.10}/src/springstiff_n2f_th.f | 0
{ccx_2.9 => ccx_2.10}/src/statics.f | 0
{ccx_2.9 => ccx_2.10}/src/steadystate.c | 0
{ccx_2.9 => ccx_2.10}/src/steadystatedynamicss.f | 0
{ccx_2.9 => ccx_2.10}/src/steps.f | 0
{ccx_2.9 => ccx_2.10}/src/stiff2mat.f | 0
{ccx_2.9 => ccx_2.10}/src/stof.c | 0
{ccx_2.9 => ccx_2.10}/src/stoi.c | 0
{ccx_2.9 => ccx_2.10}/src/stop.f | 0
{ccx_2.9 => ccx_2.10}/src/storecontactdof.c | 0
ccx_2.10/src/storecontactprop.f | 183 +
{ccx_2.9 => ccx_2.10}/src/storeresidual.f | 2 +-
{ccx_2.9 => ccx_2.10}/src/stos.c | 0
{ccx_2.9 => ccx_2.10}/src/str2mat.f | 0
{ccx_2.9 => ccx_2.10}/src/straighteq2d.f | 0
{ccx_2.9 => ccx_2.10}/src/straighteq3d.f | 0
{ccx_2.9 => ccx_2.10}/src/straighteq3dpen.f | 0
{ccx_2.9 => ccx_2.10}/src/straightmpc.f | 0
{ccx_2.9 => ccx_2.10}/src/strcmp1.c | 0
{ccx_2.9 => ccx_2.10}/src/strcmp2.c | 0
{ccx_2.9 => ccx_2.10}/src/strcpy1.c | 0
{ccx_2.9 => ccx_2.10}/src/strsplt.c | 0
{ccx_2.9 => ccx_2.10}/src/submodels.f | 0
{ccx_2.9 => ccx_2.10}/src/subspace.f | 0
{ccx_2.9 => ccx_2.10}/src/substructuregenerates.f | 0
.../src/substructurematrixoutputs.f | 0
{ccx_2.9 => ccx_2.10}/src/surfacebehaviors.f | 0
{ccx_2.9 => ccx_2.10}/src/surfaceinteractions.f | 0
{ccx_2.9 => ccx_2.10}/src/surfaces.f | 0
{ccx_2.9 => ccx_2.10}/src/sutherland_hodgman.f | 0
{ccx_2.9 => ccx_2.10}/src/swap.f | 0
{ccx_2.9 => ccx_2.10}/src/tau.c | 0
{ccx_2.9 => ccx_2.10}/src/tau.h | 0
{ccx_2.9 => ccx_2.10}/src/tee.f | 0
{ccx_2.9 => ccx_2.10}/src/temperatures.f | 0
{ccx_2.9 => ccx_2.10}/src/tempload.f | 0
{ccx_2.9 => ccx_2.10}/src/tempload_em.f | 0
{ccx_2.9 => ccx_2.10}/src/temploaddiff.f | 0
{ccx_2.9 => ccx_2.10}/src/temploadmodal.f | 0
{ccx_2.9 => ccx_2.10}/src/thermmodel.f | 0
{ccx_2.9 => ccx_2.10}/src/tiedcontact.c | 0
{ccx_2.9 => ccx_2.10}/src/tiefaccont.f | 30 +-
{ccx_2.9 => ccx_2.10}/src/ties.f | 0
{ccx_2.9 => ccx_2.10}/src/timepointss.f | 0
ccx_2.10/src/timer.f | 32 +
{ccx_2.9 => ccx_2.10}/src/transformatrix.f | 0
{ccx_2.9 => ccx_2.10}/src/transformfs.f | 0
{ccx_2.9 => ccx_2.10}/src/transforms.f | 0
{ccx_2.9 => ccx_2.10}/src/treatmasterface.f | 0
{ccx_2.9 => ccx_2.10}/src/trianeighbor.f | 0
{ccx_2.9 => ccx_2.10}/src/triangucont.f | 28 +-
{ccx_2.9 => ccx_2.10}/src/triangulate.f | 22 +-
{ccx_2.9 => ccx_2.10}/src/triloc.f | 0
{ccx_2.9 => ccx_2.10}/src/ts_calc.f | 0
{ccx_2.9 => ccx_2.10}/src/tt_calc.f | 0
{ccx_2.9 => ccx_2.10}/src/two_phase_flow.f | 0
{ccx_2.9 => ccx_2.10}/src/twodint.f | 0
{ccx_2.9 => ccx_2.10}/src/u_calloc.c | 0
{ccx_2.9 => ccx_2.10}/src/u_free.c | 0
{ccx_2.9 => ccx_2.10}/src/u_realloc.c | 0
{ccx_2.9 => ccx_2.10}/src/uamplitude.f | 0
{ccx_2.9 => ccx_2.10}/src/uboun.f | 0
{ccx_2.9 => ccx_2.10}/src/ufaceload.f | 0
{ccx_2.9 => ccx_2.10}/src/uhardening.f | 0
{ccx_2.9 => ccx_2.10}/src/umat.f | 0
{ccx_2.9 => ccx_2.10}/src/umat_abaqus.f | 0
{ccx_2.9 => ccx_2.10}/src/umat_abaqusnl.f | 0
{ccx_2.9 => ccx_2.10}/src/umat_aniso_creep.f | 0
{ccx_2.9 => ccx_2.10}/src/umat_aniso_plas.f | 0
{ccx_2.9 => ccx_2.10}/src/umat_ciarlet_el.f | 0
{ccx_2.9 => ccx_2.10}/src/umat_compression_only.f | 0
{ccx_2.9 => ccx_2.10}/src/umat_elastic_fiber.f | 0
{ccx_2.9 => ccx_2.10}/src/umat_ideal_gas.f | 0
{ccx_2.9 => ccx_2.10}/src/umat_lin_iso_el.f | 0
{ccx_2.9 => ccx_2.10}/src/umat_main.f | 0
{ccx_2.9 => ccx_2.10}/src/umat_single_crystal.f | 0
.../src/umat_single_crystal_creep.f | 0
{ccx_2.9 => ccx_2.10}/src/umat_tension_only.f | 0
{ccx_2.9 => ccx_2.10}/src/umat_user.f | 0
{ccx_2.9 => ccx_2.10}/src/umatht.f | 22 +-
{ccx_2.9 => ccx_2.10}/src/umpc_dist.f | 0
{ccx_2.9 => ccx_2.10}/src/umpc_gap.f | 0
{ccx_2.9 => ccx_2.10}/src/umpc_mean_rot.f | 0
{ccx_2.9 => ccx_2.10}/src/umpc_user.f | 0
{ccx_2.9 => ccx_2.10}/src/uncouptempdisps.f | 0
{ccx_2.9 => ccx_2.10}/src/updatecont.f | 0
{ccx_2.9 => ccx_2.10}/src/updatecont2d.f | 0
{ccx_2.9 => ccx_2.10}/src/updatecontpen.f | 94 +-
{ccx_2.9 => ccx_2.10}/src/usermaterials.f | 0
{ccx_2.9 => ccx_2.10}/src/usermpc.f | 0
{ccx_2.9 => ccx_2.10}/src/utemp.f | 0
{ccx_2.9 => ccx_2.10}/src/utemp_ccxlib.f | 0
{ccx_2.9 => ccx_2.10}/src/v_betrag.c | 0
{ccx_2.9 => ccx_2.10}/src/v_prod.c | 0
{ccx_2.9 => ccx_2.10}/src/v_result.c | 0
{ccx_2.9 => ccx_2.10}/src/valuesatinfinitys.f | 0
{ccx_2.9 => ccx_2.10}/src/varbous.f | 0
{ccx_2.9 => ccx_2.10}/src/viewfactors.f | 0
{ccx_2.9 => ccx_2.10}/src/viscos.f | 0
{ccx_2.9 => ccx_2.10}/src/vortex.f | 0
{ccx_2.9 => ccx_2.10}/src/wcoef.f | 0
{ccx_2.9 => ccx_2.10}/src/wpi.f | 0
{ccx_2.9 => ccx_2.10}/src/writeboun.f | 0
{ccx_2.9 => ccx_2.10}/src/writebv.f | 0
{ccx_2.9 => ccx_2.10}/src/writecvg.f | 0
{ccx_2.9 => ccx_2.10}/src/writeev.f | 0
{ccx_2.9 => ccx_2.10}/src/writeevcomplex.f | 0
{ccx_2.9 => ccx_2.10}/src/writeevcs.f | 0
{ccx_2.9 => ccx_2.10}/src/writeevcscomplex.f | 0
{ccx_2.9 => ccx_2.10}/src/writehe.f | 0
{ccx_2.9 => ccx_2.10}/src/writeheading.c | 0
{ccx_2.9 => ccx_2.10}/src/writeim.f | 0
{ccx_2.9 => ccx_2.10}/src/writeinput.f | 0
{ccx_2.9 => ccx_2.10}/src/writemac.f | 0
{ccx_2.9 => ccx_2.10}/src/writemaccs.f | 0
{ccx_2.9 => ccx_2.10}/src/writempc.f | 0
{ccx_2.9 => ccx_2.10}/src/writepf.f | 0
{ccx_2.9 => ccx_2.10}/src/writere.f | 0
{ccx_2.9 => ccx_2.10}/src/writesubmatrix.f | 0
{ccx_2.9 => ccx_2.10}/src/writesummary.f | 0
{ccx_2.9 => ccx_2.10}/src/writesummarydiv.f | 0
{ccx_2.9 => ccx_2.10}/src/writetetmesh.f | 0
{ccx_2.9 => ccx_2.10}/src/writevfa.f | 2 +-
{ccx_2.9 => ccx_2.10}/src/writeview.f | 0
{ccx_2.9 => ccx_2.10}/src/wye.f | 0
{ccx_2.9 => ccx_2.10}/src/xlocal.f | 0
{ccx_2.9 => ccx_2.10}/src/zeta_calc.f | 0
{ccx_2.9 => ccx_2.10}/src/zienzhu.f | 0
ccx_2.9/src/attach.f | 148 -
ccx_2.9/src/creeps.f | 357 --
ccx_2.9/src/date.pl | 14 -
ccx_2.9/src/distattach.f | 162 -
ccx_2.9/src/objectives.f | 63 -
ccx_2.9/src/sensitivity.c | 450 ---
790 files changed, 13076 insertions(+), 5174 deletions(-)
diff --git a/ccx_2.9/src/BUGS b/ccx_2.10/src/BUGS
similarity index 82%
rename from ccx_2.9/src/BUGS
rename to ccx_2.10/src/BUGS
index e477c2b..57323c6 100755
--- a/ccx_2.9/src/BUGS
+++ b/ccx_2.10/src/BUGS
@@ -1,5 +1,5 @@
====
-BUGS Version 2.9
+BUGS Version 2.10
====
- Ogden material with 2 or 3 equal eigenvalues does not work
diff --git a/ccx_2.9/src/CalculiX.h b/ccx_2.10/src/CalculiX.h
old mode 100755
new mode 100644
similarity index 81%
rename from ccx_2.9/src/CalculiX.h
rename to ccx_2.10/src/CalculiX.h
index fc1d1a5..ee81ca8
--- a/ccx_2.9/src/CalculiX.h
+++ b/ccx_2.10/src/CalculiX.h
@@ -52,7 +52,7 @@
#define ITGFORMAT "d"
#endif
-void FORTRAN(addimdnodecload,(ITG *nodeforc,ITG *i,ITG *imdnode,
+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,
@@ -95,7 +95,7 @@ void FORTRAN(allocation,(ITG *nload_,ITG *nforc_,ITG *nboun_,
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 *nintpoint,ITG *infree,ITG *nheading_,ITG *nobject_));
void FORTRAN(allocont,(ITG *ncont,ITG *ntie,char *tieset,ITG *nset,
char *set,ITG *istartset,ITG *iendset,ITG *ialset,
@@ -107,12 +107,12 @@ void FORTRAN(applyboun,(ITG *ifaext,ITG *nfaext,ITG *ielfa,ITG *ikboun,
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 *compressible,ITG *iatleastonepressurebc));
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 *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,
@@ -120,24 +120,24 @@ void FORTRAN(applympc_hfa,(ITG *nface,ITG *ielfa,ITG *is,ITG *ie,ITG *ifabou,
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 *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 *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,
+ 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 *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,
@@ -146,7 +146,7 @@ void arpack(double *co,ITG *nk,ITG **konp,ITG **ipkonp,char **lakonp,
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,
+ 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,
@@ -156,54 +156,54 @@ void arpack(double *co,ITG *nk,ITG **konp,ITG **ipkonp,char **lakonp,
ITG *nmat,char *typeboun,ITG *ielprop,double *prop);
void arpackbu(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
- ITG *ne,
- ITG *nodeboun,ITG *ndirboun,double *xboun,ITG *nboun,
+ 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 *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,
+ 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,
+ 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,
+ 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,
+ 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);
void arpackcs(double *co,ITG *nk,ITG **konp,ITG **ipkonp,char **lakonp,
- ITG *ne,
- ITG *nodeboun,ITG *ndirboun,double *xboun,ITG *nboun,
+ 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 *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,
+ 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 *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,
@@ -213,10 +213,10 @@ void arpackcs(double *co,ITG *nk,ITG **konp,ITG **ipkonp,char **lakonp,
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,
+ 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,
+ 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,
@@ -260,25 +260,25 @@ void FORTRAN(calcinitialflux,(double *area,double *vfa,double *xxn,
ITG *ipnei,ITG *nef,ITG *neifa,char *lakonf,
double *flux));
-void FORTRAN(calccpel,(ITG *nef,double *vel,double *shcon,
- ITG *nshcon,ITG *ielmat,ITG *ntmat_,
+void FORTRAN(calccvel,(ITG *nef,double *vel,double *shcon,
+ ITG *nshcon,ITG *ielmatf,ITG *ntmat_,
ITG *mi,double *cvel,double *physcon));
-void FORTRAN(calccpelcomp,(ITG *nef,double *vel,double *shcon,
- ITG *nshcon,ITG *ielmat,ITG *ntmat_,
+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 *ielmat,ITG *ntmat_,
+ 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 *ielmat,ITG *ntmat_,
+ ITG *nshcon,ITG *ielmatf,ITG *ntmat_,
ITG *mi,ITG *ielfa,double *cvfa,double *physcon));
-void FORTRAN(calcgamma,(ITG *nface,ITG *ielfa,double *vel,double *gradvfa,
+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));
+ ITG *ipnei,double *betam,ITG *nef,double *flux));
void FORTRAN(calcgammat,(ITG *nface,ITG *ielfa,double *vel,double *gradtfa,
double *gammat,double *xlet,double *xxn,double *xxj,
@@ -296,11 +296,11 @@ 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 *ielmat,
+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 *ielmat,ITG *ntmat_,
+ ITG *ncocon,ITG *ielmatf,ITG *ntmat_,
ITG *mi,ITG *ielfa,double *hcfa));
void FORTRAN(calch0interface,(ITG *nmpc,ITG *ipompc,ITG *nodempc,
@@ -314,7 +314,16 @@ void FORTRAN(calcmac,(ITG *neq,double *z,double *zz,ITG *nev,double *mac,
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 *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));
@@ -337,18 +346,27 @@ void calcresidual_em(ITG *nmethod,ITG *neq,double *b,double *fext,double *f,
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 *ielmat,ITG *ntmat_,ITG *ithermal,
+ ITG *nrhcon,ITG *ielmatf,ITG *ntmat_,ITG *ithermal,
ITG *mi));
void FORTRAN(calcrhoelcomp,(ITG *nef,double *vel,double *shcon,
- ITG *ielmat,ITG *ntmat_,ITG *mi));
+ ITG *ielmatf,ITG *ntmat_,ITG *mi));
void FORTRAN(calcrhofa,(ITG *nface,double *vfa,double *rhcon,
- ITG *nrhcon,ITG *ielmat,ITG *ntmat_,ITG *ithermal,
+ ITG *nrhcon,ITG *ielmatf,ITG *ntmat_,ITG *ithermal,
ITG *mi,ITG *ielfa));
void FORTRAN(calcrhofacomp,(ITG *nface,double *vfa,double *shcon,
- ITG *ielmat,ITG *ntmat_,ITG *mi,ITG *ielfa));
+ ITG *ielmatf,ITG *ntmat_,ITG *mi,ITG *ielfa));
+
+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,
@@ -357,11 +375,11 @@ void FORTRAN(calcstressheatflux,(double *sti,double *umel,double *gradvel,
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 *ielmat,ITG *ntmat_,ITG *ithermal,
+ ITG *nshcon,ITG *ielmatf,ITG *ntmat_,ITG *ithermal,
ITG *mi,double *umel));
void FORTRAN(calcumfa,(ITG *nface,double *vfa,double *shcon,
- ITG *nshcon,ITG *ielmat,ITG *ntmat_,ITG *ithermal,
+ 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,
@@ -371,7 +389,7 @@ 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 *irowrad,ITG *nzsrad,double *sidemean,ITG *ntria,
ITG *ntrib));
void *calcviewmt(ITG *i);
@@ -384,7 +402,7 @@ void FORTRAN(calinput,(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
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 *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,
@@ -392,7 +410,7 @@ void FORTRAN(calinput,(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
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 *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,
@@ -409,7 +427,7 @@ void FORTRAN(calinput,(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
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,
+ ITG *maxlenmpc,ITG *ne1d,ITG *ne2d,ITG *nener,
double *vold,ITG *nodebounold,
ITG *ndirbounold,double *xbounold,double *xforcold,
double *xloadold,double *t1old,double *eme,
@@ -417,7 +435,7 @@ void FORTRAN(calinput,(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
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 *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,
@@ -426,8 +444,7 @@ void FORTRAN(calinput,(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
ITG *cyclicsymmetry,ITG *idefforc,ITG *idefload,
ITG *idefbody,ITG *mortar,ITG *ifacecount,ITG *islavsurf,
double *pslavsurf,double *clearini,char *heading,
- ITG *iaxial,char *objective,char *equcon,char *inequcon,
- double *desvarbou,double* inequbou,double *equbou));
+ ITG *iaxial,ITG *nobject,char *objectset));
void cascade(ITG *ipompc,double **coefmpcp,ITG **nodempcp,ITG *nmpc,
ITG *mpcfree,ITG *nodeboun,ITG *ndirboun,ITG*nboun,ITG*ikmpc,
@@ -438,11 +455,11 @@ void cascade(ITG *ipompc,double **coefmpcp,ITG **nodempcp,ITG *nmpc,
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,
+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 *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,
@@ -454,7 +471,7 @@ void checkconvergence(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
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,
+ 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,
@@ -462,10 +479,14 @@ void checkconvergence(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
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);
+ 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 *qamt,double *qamf,double *qamp,
+ double *qamt,double *qamf,double *qamp,
double *ram1t,double *ram1f,double *ram1p,
double *ram2t,double *ram2f,double *ram2p,
double *ramt,double *ramf,double *ramp,
@@ -475,9 +496,18 @@ void checkconvnet(ITG *icutb,ITG *iin,
double *qa);
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 *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(checktime,(ITG *itpamp,ITG *namta,double *tinc,double *ttime,
double *amta,double *tmin,ITG *inext,ITG *itp,ITG *istep));
@@ -490,16 +520,16 @@ void FORTRAN(closefile,());
void FORTRAN(closefilefluid,());
void compfluid(double **cop,ITG *nk,ITG **ipkonp,ITG **konp,char **lakonp,
- char **sideface,ITG *ifreestream,
+ char **sideface,ITG *ifreestream,
ITG *nfreestream,ITG *isolidsurf,ITG *neighsolidsurf,
ITG *nsolidsurf,ITG **iponoel,ITG **inoel,ITG *nshcon,double *shcon,
- ITG *nrhcon,double *rhcon,double **voldp,ITG *ntmat_,ITG *nodeboun,
+ ITG *nrhcon,double *rhcon,double **voldp,ITG *ntmat_,ITG *nodeboun,
ITG *ndirboun,ITG *nboun,ITG **ipompcp,ITG **nodempcp,ITG *nmpc,
ITG **ikmpcp,ITG **ilmpcp,ITG *ithermal,ITG *ikboun,ITG *ilboun,
ITG *turbulent,ITG *isolver,ITG *iexpl,double *vcontu,double *ttime,
double *time,double *dtime,ITG *nodeforc,ITG *ndirforc,double *xforc,
ITG *nforc,ITG *nelemload,char *sideload,double *xload,ITG *nload,
- double *xbody,ITG *ipobody,ITG *nbody,ITG *ielmat,char *matname,
+ double *xbody,ITG *ipobody,ITG *nbody,ITG *ielmatf,char *matname,
ITG *mi,ITG *ncmat_,double *physcon,ITG *istep,ITG *iinc,
ITG *ibody,double *xloadold,double *xboun,
double **coefmpcp,ITG *nmethod,double *xforcold,double *xforcact,
@@ -522,26 +552,26 @@ void compfluid(double **cop,ITG *nk,ITG **ipkonp,ITG **konp,char **lakonp,
void FORTRAN(complete_hel,(ITG *neq,double *b,double *hel,double *ad,
double *au,ITG *jq,ITG *irow,ITG *nzs));
-void complexfreq(double **cop,ITG *nk,ITG **konp,ITG **ipkonp,char **lakonp,ITG *ne,
+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 *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 *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 *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,
+ 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,
@@ -549,7 +579,7 @@ void complexfreq(double **cop,ITG *nk,ITG **konp,ITG **ipkonp,char **lakonp,ITG
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,
+ 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,
@@ -645,10 +675,10 @@ void dfdbj(double *bcont,double **dbcontp,ITG *neq,ITG *nope,
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,
+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,
+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));
@@ -667,39 +697,39 @@ void FORTRAN(dsaupd,(ITG *ido,char *bmat,ITG *n,char *which,ITG *nev,
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,
+ 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 *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,
+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 *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 *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 *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,
+ 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,
@@ -707,7 +737,7 @@ void dyna(double **cop,ITG *nk,ITG **konp,ITG **ipkonp,char **lakonp,ITG *ne,
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,
+ 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,
@@ -717,25 +747,25 @@ void dyna(double **cop,ITG *nk,ITG **konp,ITG **ipkonp,char **lakonp,ITG *ne,
ITG *ikforc,ITG *ilforc,double *thicke,
ITG *nslavs,ITG *nmat,char *typeboun,ITG *ielprop,double *prop);
-void dynacont(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,ITG *ne,
+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 *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 *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 *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,
+ 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,
@@ -743,7 +773,7 @@ void dynacont(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,ITG *ne,
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,
+ 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,
@@ -757,10 +787,10 @@ void dynacont(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,ITG *ne,
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,
+ 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 *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,
@@ -801,18 +831,18 @@ void FORTRAN(effectivemodalmass,(ITG *neq,ITG *nactdof,ITG *mi,double *adb,
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 *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 *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,
+ 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,
+ 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,
@@ -824,10 +854,10 @@ void electromagnetics(double **co,ITG *nk,ITG **konp,ITG **ipkonp,char **lakonp,
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,
+ 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,
+ 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,
@@ -860,17 +890,17 @@ void FORTRAN(errorestimator,(double *yi,double *yn,ITG *ipkon,
ITG *nterms));
void expand(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
- ITG *ne,ITG *nodeboun,ITG *ndirboun,double *xboun,ITG *nboun,
+ 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 *nmpc,ITG *nodeforc,ITG *ndirforc,double *xforc,
ITG *nforc,ITG *nelemload,char *sideload,double *xload,
- ITG *nload,ITG *nactdof,ITG *neq,
+ 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 *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,
@@ -878,7 +908,7 @@ void expand(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
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,
+ 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,
@@ -911,7 +941,7 @@ void FORTRAN(extrapolate_ad_h_comp,(ITG *nface,ITG *ielfa,double *xrlfa,
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 *ielmat,
+ double *shcon,ITG *nshcon,ITG *ntmat_,ITG *ielmatf,
double *physcon,ITG *mi));
void FORTRAN(extrapolate_gradtel,(ITG *nface,ITG *ielfa,double *xrlfa,
@@ -979,7 +1009,7 @@ void frd(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,ITG *ne0,
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 *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,
@@ -991,15 +1021,22 @@ void frdcyc(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,ITG *ne,double *v
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,
+ char *set,ITG *nset,double *emn,double *thicke,char *jobnamec,
ITG *ne0,double *cdn,ITG *mortar,ITG *nmat);
+void frd_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);
+
void FORTRAN(frdfluid,(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
ITG *ne,double *v,ITG *kode,double *time,
- ITG *ielmat,char *matname,char *filab,
+ 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 *xmach,double *xkappa,double *physcon));
void frdheader(ITG *icounter,double *oner,double *time,double *pi,
ITG *noddiam,double *cs,ITG *null,ITG *mode,
@@ -1013,7 +1050,7 @@ void FORTRAN(frditeration,(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
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);
+ 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,
@@ -1056,7 +1093,7 @@ void FORTRAN(gencontelem_f2f,(char *tieset,ITG *ntie,ITG *itietri,ITG *ne,
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 *ne0,ITG *icutb,ITG *ialeatoric,ITG *nmethod));
void FORTRAN(gencontelem_n2f,(char *tieset,ITG *ntie,ITG *itietri,ITG *ne,
ITG *ipkon,ITG *kon,char *lakon,
@@ -1099,11 +1136,11 @@ void FORTRAN(geomview,(double *vold,double *co,double *pmid,double *e1,
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 *istep,ITG *mi,ITG *nactdof,ITG *ndesi,
+ ITG *nset,ITG *mi,ITG *nactdof,ITG *ndesi,
ITG *ndirdesi,ITG *nodedesi,ITG *ntie,char *tieset));
void getglobalresults (char *jobnamec,ITG **integerglobp,double **doubleglobp,
- ITG *nboun,ITG *iamboun,double *xboun, ITG *nload,
+ 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);
@@ -1199,10 +1236,10 @@ 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,
+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,
+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,
@@ -1216,22 +1253,22 @@ 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 *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 *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 *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 *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,
+ 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,
@@ -1241,27 +1278,27 @@ void linstatic(double *co,ITG *nk,ITG **konp,ITG **ipkonp,char **lakonp,
double *xforcold,double *xloadold,
char *amname,double *amta,ITG *namta,
ITG *nam,ITG *iamforc,ITG *iamload,
- ITG *iamt1,ITG *iamboun,double *ttime,char *output,
+ 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,
+ 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,
+ 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);
-void FORTRAN(mafillcorio,(double *co,ITG *nk,ITG *kon,ITG *ipkon,
+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 *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,
+ 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,
@@ -1271,21 +1308,21 @@ void FORTRAN(mafillcorio,(double *co,ITG *nk,ITG *kon,ITG *ipkon,
ITG *iperturb,double *sti,ITG *nzs,double *stx,
double *adb,double *aub,ITG *iexpl,
double *plicon,ITG *nplicon,double *plkcon,ITG *nplkcon,
- double *xstiff,
+ double *xstiff,
ITG *npmat_,double *dtime,char *matname,ITG *mi,
ITG *ncmat_,double *ttime,double *time,
- ITG *istep,ITG *kinc,ITG *ibody));
+ 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 *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,
+ 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,
@@ -1295,7 +1332,7 @@ void FORTRAN(mafilldm,(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
ITG *iperturb,double *sti,ITG *nzs,double *stx,
double *adb,double *aub,ITG *iexpl,
double *plicon,ITG *nplicon,double *plkcon,ITG *nplkcon,
- double *xstiff,
+ double *xstiff,
ITG *npmat_,double *dtime,char *matname,ITG *mi,
ITG *ncmat_,double *ttime,double *time,
ITG *istep,ITG *kinc,ITG *ibody,double *clearini,
@@ -1303,15 +1340,15 @@ void FORTRAN(mafilldm,(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
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 *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,
+ 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,
@@ -1321,7 +1358,7 @@ void FORTRAN(mafillem,(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
ITG *iperturb,double *sti,ITG *nzs,double *stx,
double *adb,double *aub,ITG *iexpl,
double *plicon,ITG *nplicon,double *plkcon,ITG *nplkcon,
- double *xstiff,
+ 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,
@@ -1352,35 +1389,63 @@ void FORTRAN(mafillnet,(ITG *itg,ITG *ieg,ITG *ntg,
ITG *nodempc,ITG *ipompc,double *coefmpc,
char *labmpc,ITG *iaxial));
-void FORTRAN(mafillp,(ITG *ne,char *lakon,ITG *ipnei,
+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 *compressible,
+ double *xle,double *b,double *xxn,
ITG *neq,ITG *nzs,double *hfa,double *gradpel,
- double *bp,double *xxi,ITG *neij,double *xlen,double *cosb));
+ double *bp,double *xxi,ITG *neij,double *xlen,double *cosb,
+ ITG *nefa,ITG *nefb));
-void FORTRAN(mafillpcomp,(ITG *ne,char *lakon,ITG *ipnei,
+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,
+ 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));
+
+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 *ielmat,ITG *mi,double *a1,double *a2,double *a3,double *velo,
+ 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));
+ ITG *nactdohinv,double *xrlfa,double *flux);
+
+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);
+
+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 *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,
+ 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,
@@ -1390,7 +1455,7 @@ void FORTRAN(mafillsm,(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
ITG *iperturb,double *sti,ITG *nzs,double *stx,
double *adb,double *aub,ITG *iexpl,
double *plicon,ITG *nplicon,double *plkcon,ITG *nplkcon,
- double *xstiff,
+ 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,
@@ -1403,18 +1468,48 @@ void FORTRAN(mafillsm,(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
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));
+ double *fnext,ITG *nea,ITG *neb,ITG *kscale));
-void FORTRAN(mafillsm1,(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,
+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,ITG *ndirdesi,double *dfextminds));
+
+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,
+ 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,
@@ -1424,7 +1519,7 @@ void FORTRAN(mafillsm1,(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
ITG *iperturb,double *sti,ITG *nzs,double *stx,
double *adb,double *aub,ITG *iexpl,
double *plicon,ITG *nplicon,double *plkcon,ITG *nplkcon,
- double *xstiff,
+ 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,
@@ -1437,18 +1532,18 @@ void FORTRAN(mafillsm1,(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
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));
+ double *fnext,ITG *kscale);
-void FORTRAN(mafillsm_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,
+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,
- double *ad,double *au,ITG *nactdof,
- ITG *icol,ITG *jq,ITG *irow,ITG *neq,ITG *nzl,
- ITG *nmethod,ITG *ikmpc,ITG *ilmpc,ITG *ikboun,
+ 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,
@@ -1458,7 +1553,7 @@ void FORTRAN(mafillsm_se,(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
ITG *iperturb,double *sti,ITG *nzs,double *stx,
double *adb,double *aub,ITG *iexpl,
double *plicon,ITG *nplicon,double *plkcon,ITG *nplkcon,
- double *xstiff,
+ 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,
@@ -1471,23 +1566,19 @@ void FORTRAN(mafillsm_se,(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
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,double *distmin,ITG *ndesi,
- ITG *nodedesi,ITG *ndirdesi,double *dfextminds));
-
-void *mafillsmmt(ITG *i);
-
-void *mafillsm_semt(ITG *i);
+ double *fnext,double *distmin,ITG *ndesi,ITG *nodedesi,
+ ITG *ndirdesi,double *dfextminds);
-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,
+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,
+ 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,
@@ -1497,7 +1588,7 @@ void mafillsmmain(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
ITG *iperturb,double *sti,ITG *nzs,double *stx,
double *adb,double *aub,ITG *iexpl,
double *plicon,ITG *nplicon,double *plkcon,ITG *nplkcon,
- double *xstiff,
+ 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,
@@ -1509,19 +1600,19 @@ void mafillsmmain(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
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);
+ double *clearini,ITG *ielprop,double *prop,ITG *ne0,
+ ITG *kscale));
-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,
+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,ITG *nactdof,
- ITG *icol,ITG *jq,ITG *irow,ITG *neq,ITG *nzl,
- ITG *nmethod,ITG *ikmpc,ITG *ilmpc,ITG *ikboun,
+ 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,
@@ -1531,7 +1622,7 @@ void mafillsmmain_se(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
ITG *iperturb,double *sti,ITG *nzs,double *stx,
double *adb,double *aub,ITG *iexpl,
double *plicon,ITG *nplicon,double *plkcon,ITG *nplkcon,
- double *xstiff,
+ 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,
@@ -1544,19 +1635,18 @@ void mafillsmmain_se(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
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,
- ITG *ndirdesi,double *dfextminds);
+ ITG *nea,ITG *neb,ITG *kscale));
-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,
+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,
+ 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,
@@ -1566,7 +1656,7 @@ void FORTRAN(mafillsmas,(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
ITG *iperturb,double *sti,ITG *nzs,double *stx,
double *adb,double *aub,ITG *iexpl,
double *plicon,ITG *nplicon,double *plkcon,ITG *nplkcon,
- double *xstiff,
+ 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,
@@ -1579,19 +1669,21 @@ void FORTRAN(mafillsmas,(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
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 *kscale);
+
+void *mafillsmasmt(ITG *i);
-void FORTRAN(mafillsmcs,(double *co,ITG *nk,ITG *kon,ITG *ipkon,
+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 *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 *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,
@@ -1600,7 +1692,7 @@ void FORTRAN(mafillsmcs,(double *co,ITG *nk,ITG *kon,ITG *ipkon,
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 *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,
@@ -1613,17 +1705,17 @@ void FORTRAN(mafillsmcs,(double *co,ITG *nk,ITG *kon,ITG *ipkon,
double *clearini,ITG *ielprop,double *prop,ITG *ne0,
ITG *kscale));
-void FORTRAN(mafillsmcsas,(double *co,ITG *nk,ITG *kon,ITG *ipkon,
+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 *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 *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,
@@ -1632,7 +1724,7 @@ void FORTRAN(mafillsmcsas,(double *co,ITG *nk,ITG *kon,ITG *ipkon,
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 *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,
@@ -1656,46 +1748,100 @@ void FORTRAN(mafillt,(ITG *nef,ITG *ipnei,ITG *neifa,
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 *compressible,ITG *ielfa,char *lakon,
+ double *volume,ITG *ielfa,char *lakonf,
ITG *ifabou,ITG *nbody,ITG *neq,double *dtimef,double *velo,
- double *veloo,double *cpfa,double *hcfa,double *cpel,
+ 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));
+ double *flux,ITG *nefa,ITG *nefb));
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 *compressible,ITG *ielfa,char *lakon,
+ double *volume,ITG *ielfa,char *lakonf,
ITG *ifabou,ITG *nbody,ITG *neq,double *dtimef,double *velo,
- double *veloo,double *cpfa,double *hcfa,double *cpel,
+ 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));
+ double *flux,ITG *nefa,ITG *nefb));
+
+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);
+
+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);
+
+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 *lakon,ITG *ifabou,ITG *nbody,ITG *neq,
+ ITG *ielfa,char *lakonf,ITG *ifabou,ITG *nbody,ITG *neq,
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 *nactdohinv,double *a1,double *a2,double *a3,double *flux,
+ ITG *nefa,ITG *nefb));
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 *lakon,ITG *ifabou,ITG *nbody,ITG *neq,
+ double *xxi,double *body,double *volume,
+ ITG *ielfa,char *lakonf,ITG *ifabou,ITG *nbody,ITG *neq,
+ 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));
+
+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,ITG *neq,
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 *nactdohinv,double *a1,double *a2,double *a3,double *flux);
-void mastruct(ITG *nk,ITG *kon,ITG *ipkon,char*lakon,ITG *ne,
+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,ITG *neq,
+ double *dtimef,double *velo,double *veloo,
+ double *sel,double *xrlfa,double *gamma,double *xxj,
+ ITG *nactdohinv,double *a1,double *a2,double *a3,double *flux);
+
+void *mafillvmt(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,
@@ -1713,23 +1859,36 @@ void mastructcs(ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
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_,
+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);
void mastructf(ITG *nk,ITG *kon,ITG *ipkon,char *lakon,ITG *ne,
- ITG *icol,ITG *jq, ITG **mast1p, ITG **irowp,
- ITG *isolver, ITG *neq,ITG *ipointer, ITG *nzs,
+ ITG *icol,ITG *jq,ITG **mast1p,ITG **irowp,
+ ITG *isolver,ITG *neq,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 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,
@@ -1753,29 +1912,29 @@ void FORTRAN(nodestiedface,(char *tieset,ITG *ntie,ITG *ipkon,ITG *kon,
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 *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 **icolp,ITG *jq,ITG **irowp,ITG *neq,ITG *nzl,
- ITG *nmethod,ITG **ikmpcp,ITG **ilmpcp,ITG *ikboun,
+ 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,
+ 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 *iamload,
+ ITG *iamforc,ITG **iamloadp,
ITG *iamt1,double *alpha,ITG *iexpl,
ITG *iamboun,double *plicon,ITG *nplicon,double *plkcon,
ITG *nplkcon,
@@ -1785,10 +1944,10 @@ void nonlingeo(double **co,ITG *nk,ITG **konp,ITG **ipkonp,char **lakonp,
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,
+ 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,
+ 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,
@@ -1813,6 +1972,50 @@ 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 objectivesmmain_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 *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 *ndirdesi,ITG *nobject,
+ char *objectset,double *g0,double *dgdx,double *dgdv,double *sti,
+ double *dgdxtot,double *dfextminds,double *df);
+
+void *objectivemt_shapeener(ITG *i);
+
+void *objectivemt_mass(ITG *i);
+
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,
@@ -1838,14 +2041,14 @@ void FORTRAN(precfd,(ITG *ne,ITG *ipkon,ITG *kon,char *lakon,ITG *ipnei,
ITG *nactdoh,ITG *ipkonf,char *lakonf,ITG *ielmatf,
ITG *ielmat,ITG *ielorienf,ITG *ielorien,ITG *norien));
-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,
+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 *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);
@@ -1857,7 +2060,7 @@ void prediction_em(double *uam,ITG *nmethod,double *bet,double *gam,double *dtim
ITG *ithermal,ITG *nk,double *veold,double *v,
ITG *iinc,ITG *idiscon,double *vold,ITG *nactdof,ITG *mi);
-void preiter(double *ad,double **aup,double *b,ITG **icolp,ITG **irowp,
+void preiter(double *ad,double **aup,double *b,ITG **icolp,ITG **irowp,
ITG *neq,ITG *nzs,ITG *isolver,ITG *iperturb);
void FORTRAN(printout,(char *set,ITG *nset,ITG *istartset,ITG *iendset,
@@ -1879,7 +2082,7 @@ void FORTRAN(printoutfluid,(char *set,ITG *nset,ITG *istartset,ITG *iendset,
double *co,ITG *kon,double *qfx,double *ttime,double *trab,
ITG *inotr,ITG *ntrans,double *orab,ITG *ielorien,
ITG *norien,ITG *nk,ITG *ne,ITG *inum,char *filab,double *vold,
- ITG *ielmat,double *thicke,double *eme,double *vcontu,
+ ITG *ielmatf,double *thicke,double *eme,double *vcontu,
double *physcon,ITG *nactdoh,ITG *ielpropf,double *prop));
void FORTRAN(printoutface,(double *co,double *rhcon,ITG *nrhcon,ITG *ntmat_,
@@ -1889,10 +2092,10 @@ void FORTRAN(printoutface,(double *co,double *rhcon,ITG *nrhcon,ITG *ntmat_,
double *timef,ITG *nset,char *set,ITG *nprint,char *prlab,
ITG *ielmat,ITG *mi));
-int pthread_create (pthread_t *thread_id, const pthread_attr_t *attributes,
- void *(*thread_function)(void *), void *arguments);
+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);
+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,
@@ -1935,11 +2138,11 @@ void FORTRAN (radmatrix,(ITG *ntr,double *adrad,double *aurad,double *bcr,
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,
+ double *auview,double *fenv,ITG *irowrad,ITG *jqrad,
ITG *nzsrad,double *q));
void FORTRAN(readforce,(double *zc,ITG *neq,ITG *nev,ITG *nactdof,
- ITG *ikmpc,ITG *nmpc,ITG *ipompc,ITG *nodempc,ITG *mi,
+ ITG *ikmpc,ITG *nmpc,ITG *ipompc,ITG *nodempc,ITG *mi,
double *coefmpc,char *jobnamec,double *aa,
ITG *igeneralizedforce));
@@ -1952,12 +2155,12 @@ void FORTRAN(readview,(ITG *ntr,double *adview,double *auview,double *fenv,
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,
+ 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,
+ 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));
@@ -1966,7 +2169,7 @@ 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,
+ double *qfn,double *een,double *cs,ITG *nk,
ITG *icntrl,double *t,char *filab,ITG *imag,ITG *mi,
double *emn));
@@ -2017,31 +2220,31 @@ void FORTRAN(restartshort,(ITG *nset,ITG *nload,ITG *nbody,ITG *nforc,
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,
+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,
@@ -2073,18 +2276,18 @@ void FORTRAN(resultnet,(ITG *itg,ITG *ieg,ITG *ntg,
char *labmpc,ITG *iaxial));
void results(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
- ITG *ne,double *v,double *stn,ITG *inum,
+ 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,
+ 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 *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,
@@ -2094,7 +2297,7 @@ void results(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
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,
+ 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,
@@ -2191,7 +2394,7 @@ void FORTRAN(resultsmech_se,(double *co,ITG *kon,ITG *ipkon,char *lakon,ITG *ne,
double *emeini,double *pslavsurf,double *pmastsurf,ITG *mortar,
double *clearini,ITG *nea,ITG *neb,ITG *ielprop,double *prop,
double *dfn,double *distmin,ITG *ndesi,ITG *nodedesi,
- ITG *ndirdesi,double *fn0));
+ ITG *ndirdesi,double *fn0,double *sti));
void FORTRAN(resultsprint,(double *co,ITG *nk,ITG *kon,ITG *ipkon,
char *lakon,ITG *ne,double *v,double *stn,ITG *inum,double *stx,
@@ -2212,18 +2415,18 @@ void FORTRAN(resultsprint,(double *co,ITG *nk,ITG *kon,ITG *ipkon,
char *labmpc,double *energyini,double *energy));
void results_se(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
- ITG *ne,double *v,double *stn,ITG *inum,
+ 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,
+ 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 *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,
@@ -2233,7 +2436,7 @@ void results_se(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
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,
+ 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,
@@ -2246,8 +2449,8 @@ void results_se(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
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,ITG *ndirdesi);
+ double *energy,double *df,double *distmin,
+ ITG *ndesi,ITG *nodedesi,ITG *ndirdesi,double *sti);
void FORTRAN(resultstherm,(double *co,ITG *kon,ITG *ipkon,
char *lakon,double *v,
@@ -2273,17 +2476,17 @@ 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,
+ 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,
+ 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 *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,
@@ -2293,7 +2496,7 @@ void resultsinduction(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
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,
+ 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,
@@ -2307,16 +2510,16 @@ void resultsinduction(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
double *prop,ITG *iactive,double *energy,double *energyini);
void FORTRAN(rhs,(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
- ITG *ne,ITG *ipompc,ITG *nodempc,double *coefmpc,
+ 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 *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,
+ 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,
@@ -2325,31 +2528,41 @@ void FORTRAN(rhs,(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
char *matname,ITG *mi,ITG *ikactmech,ITG *nactmech,
ITG *ielprop,double *prop));
-void FORTRAN(rhsp,(ITG *ne,char *lakon,ITG *nactdoh,ITG *ipnei,
+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 *compressible,
- ITG *neq,ITG *nzs,double *hfa,double *bp,
- ITG *neij,double *xxi,double *gradpel,double *xlen));
+ 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));
+
+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);
+
+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 *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 *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 *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 *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,
+ 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,
@@ -2359,16 +2572,20 @@ void sensitivity(double *co,ITG *nk,ITG **konp,ITG **ipkonp,char **lakonp,
double *xforcold,double *xloadold,
char *amname,double *amta,ITG *namta,
ITG *nam,ITG *iamforc,ITG *iamload,
- ITG *iamt1,ITG *iamboun,double *ttime,char *output,
+ 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,
+ 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,
+ 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 *mortar,ITG *mpcinfo,double *tietol,ITG *ics,
+ ITG *icontact,ITG *nobject,char *objectset,ITG *istat);
+void sensitivity_glob(double *dgdxtot,double *dgdxtotglob,ITG *nobject,
+ ITG *ndesi,ITG *nodedesi,ITG *ndirdesi,ITG *nk);
+
void FORTRAN(shape3tri,(double *xi,double *et,double *xl,double *xsj,
double *xs,double *shp,ITG *iflag));
@@ -2441,22 +2658,22 @@ void FORTRAN(springstiff_n2f,(double *xl,double *elas,ITG *konl,double *voldl,
ITG *nstate_,double *xstateini,double *xstate,double *reltime,
ITG *nasym));
-void steadystate(double **co,ITG *nk,ITG **kon,ITG **ipkon,char **lakon,ITG *ne,
+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 **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 *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 **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,
@@ -2469,7 +2686,7 @@ void steadystate(double **co,ITG *nk,ITG **kon,ITG **ipkon,char **lakon,ITG *ne,
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,
+ 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,
@@ -2479,10 +2696,10 @@ void steadystate(double **co,ITG *nk,ITG **kon,ITG **ipkon,char **lakon,ITG *ne,
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,
+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,
@@ -2490,13 +2707,18 @@ void FORTRAN(storeresidual,(ITG *nactdof,double *b,double *fn,char *filab,
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));
+ 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 strcmp1(const char *s1,const char *s2);
-ITG strcmp2(const char *s1, const char *s2,ITG length);
+ITG strcmp2(const char *s1,const char *s2,ITG length);
-ITG strcpy1(char *s1, const char *s2,ITG length);
+ITG strcpy1(char *s1,const char *s2,ITG length);
void FORTRAN(subspace,(double *d,double *aa,double *bb,double *cc,
double *alpham,double *betam,ITG *nev,
@@ -2507,7 +2729,7 @@ void FORTRAN(subspace,(double *d,double *aa,double *bb,double *cc,
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 *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,
@@ -2526,7 +2748,7 @@ void FORTRAN(tempload,(double *xforcold,double *xforc,double *xforcact,
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 *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,
@@ -2546,7 +2768,7 @@ void FORTRAN(tempload_em,(double *xforcold,double *xforc,double *xforcact,
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 *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,
@@ -2600,7 +2822,7 @@ void FORTRAN(uexternaldb,(ITG *lop,ITG *lrestart,double *time,double *dtime,
#endif
void FORTRAN(ufaceload,(double *co,ITG *ipkon,ITG *kon,char *lakon,
- ITG *nboun, ITG *nodeboun,
+ ITG *nboun,ITG *nodeboun,
ITG *nelemload,char *sideload,ITG *nload,
ITG *ne,ITG *nk));
@@ -2661,13 +2883,13 @@ void FORTRAN(writemaccs,(double *mac,ITG *nev,ITG* nm));
void FORTRAN(writempc,(ITG *,ITG *,double *,char *,ITG *));
-void FORTRAN(writepf,(double *d,double *bjr,double *bji,double *freq ,
+void FORTRAN(writepf,(double *d,double *bjr,double *bji,double *freq ,
ITG *nev,ITG *mode,ITG *nherm));
void FORTRAN(writere,());
void FORTRAN(writesubmatrix,(double *submatrix,ITG *noderetain,
- ITG *ndirretain,ITG *nretain, char *jobnamec));
+ ITG *ndirretain,ITG *nretain,char *jobnamec));
void FORTRAN(writesummary,(ITG *istep,ITG *j,ITG *icutb,ITG *l,double *ttime,
double *time,double *dtime));
@@ -2676,7 +2898,7 @@ 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));
+ ITG *nktet,double *field,ITG *nfield));
void FORTRAN(writeview,(ITG *ntr,double *adview,double *auview,double *fenv,
ITG *nzsrad,char *jobnamef));
@@ -2692,7 +2914,7 @@ void FORTRAN(znaupd,(ITG *ido,char *bmat,ITG *n,char *which,ITG *nev,
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,
+ 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));
diff --git a/ccx_2.9/src/LOGBOOK b/ccx_2.10/src/LOGBOOK
similarity index 97%
rename from ccx_2.9/src/LOGBOOK
rename to ccx_2.10/src/LOGBOOK
index 93cf33d..4c18e98 100755
--- a/ccx_2.9/src/LOGBOOK
+++ b/ccx_2.10/src/LOGBOOK
@@ -1,5 +1,5 @@
========
-LOG-BOOK Version 2.9
+LOG-BOOK Version 2.10
========
09 Nov 1998 - removed mistake from anisotropic.f
@@ -2592,3 +2592,71 @@ Dec 2002 - started to work on single crystal plasticity
14 Nov 2015 - introduced several code-accelerations in mastruct.c
(especially for contact)
+
+ 19 Nov 2015 - posted version 2.9
+
+ 20 Nov 2015 - changed insert.c and mastruct.c
+
+ 26 Nov 2015 - accelerated attach.f and distattach.f
+
+ 29 Nov 2015 - supersonic flow works
+
+ 30 Nov 2015 - supersonic flow works (II), slightly different version
+
+ 1 Dec 2015 - parallellized the asymmetric stiffness contributions
+
+ 5 Dec 2015 - continued to work on compressible laminar flow
+ major improvement of stability
+
+ 7 Dec 2015 - no line search for dynamic contact
+
+ 10 Dec 2015 - modified explicit dynamics
+
+ 19 Dec 2015 - viscous compressible stationary flow seems to work
+ (finite volume method)
+
+ 7 Jan 2016 - changed ifaceq(9.. into ifaceq(8.. and
+ ifacet(7.. into ifacet(6.. (i.e. no 26-node
+ hex or 14-node tet anymore).
+
+ 9 Jan 2016 - removed an error in beamextscheme.f
+
+ 13 Jan 2016 - creep and viscoplasticity in combination with an
+ anisotropic material is addressed by material user
+ subroutines only.
+ - removed an error in compfluid for compressible
+ materials: correctvfa should never be called twice
+ without calling mafillpcomp in between (recalculation
+ of ap(i))
+
+ 21 Jan 2016 - removed the requirement for 1.d-6 relative time
+ increments for implicit dynamics in combination with
+ contact (checkconvergence.c)
+
+ 24 Jan 2016 - introduced the gamma-method in mafillvcomp with
+ Central Difference replaced by 0.4*Upwind Difference +
+ 0.6*Central Difference
+
+ 27 Jan 2016 - reset compressible CFD to UD (Upwind Difference)
+ - started to parallellize nearly every CFD-routine (openMP)
+
+ 30 Jan 2016 - worked on parallellization of mafillpcomp.f
+
+ 31 Jan 2016 - finished parallellization of compressible cfd
+
+ 1 Feb 2016 - worked on parallellization of incompressible cfd
+
+ 2 Feb 2016 - unified the calculation of material properties in
+ compfluid.c
+
+ 3 Feb 2016 - made some corrections to frictionheating
+ - parallellized mafillp.f
+
+ 6 Feb 2016 - changed in mafilltcomp from CD to UD (forgotten on
+ the 27th of Jan) => bumpsuperfineshallow results
+ are smooth again now
+
+ 13 Feb 2016 - worked on explicit dynamics (Carlo Monjaraz)
+
+ 3 March 2016 - updated implicit dynamics (Matteo Pacher)
+ - switched everything to mafillsmmain
diff --git a/ccx_2.9/src/Makefile b/ccx_2.10/src/Makefile
similarity index 55%
rename from ccx_2.9/src/Makefile
rename to ccx_2.10/src/Makefile
index a76759b..9335028 100755
--- a/ccx_2.9/src/Makefile
+++ b/ccx_2.10/src/Makefile
@@ -1,6 +1,5 @@
-CFLAGS = -Wall -O3 -I ../../../SPOOLES.2.2 -DARCH="Linux" -DSPOOLES -DARPACK -DMATRIXSTORAGE
-#FFLAGS = -Wall -O3 -fopenmp -fmax-stack-var-size=80000
+CFLAGS = -Wall -O3 -fopenmp -I ../../../SPOOLES.2.2 -DARCH="Linux" -DSPOOLES -DARPACK -DMATRIXSTORAGE
FFLAGS = -Wall -O3 -fopenmp
CC=cc
@@ -13,7 +12,7 @@ FC=gfortran
include Makefile.inc
-SCCXMAIN = ccx_2.9.c
+SCCXMAIN = ccx_2.10.c
OCCXF = $(SCCXF:.f=.o)
OCCXC = $(SCCXC:.c=.o)
@@ -26,9 +25,9 @@ LIBS = \
../../../ARPACK/libarpack_INTEL.a \
-lpthread -lm -lc
-ccx_2.9: $(OCCXMAIN) ccx_2.9.a $(LIBS)
- ./date.pl; $(CC) $(CFLAGS) -c ccx_2.9.c; $(FC) -fopenmp -Wall -O3 -o $@ $(OCCXMAIN) ccx_2.9.a $(LIBS)
+ccx_2.10: $(OCCXMAIN) ccx_2.10.a $(LIBS)
+ ./date.pl; $(CC) $(CFLAGS) -c ccx_2.10.c; $(FC) -fopenmp -Wall -O3 -o $@ $(OCCXMAIN) ccx_2.10.a $(LIBS)
-ccx_2.9.a: $(OCCXF) $(OCCXC)
+ccx_2.10.a: $(OCCXF) $(OCCXC)
ar vr $@ $?
diff --git a/ccx_2.9/src/Makefile.inc b/ccx_2.10/src/Makefile.inc
similarity index 95%
rename from ccx_2.9/src/Makefile.inc
rename to ccx_2.10/src/Makefile.inc
index 7aedcd7..2cfa237 100644
--- a/ccx_2.9/src/Makefile.inc
+++ b/ccx_2.10/src/Makefile.inc
@@ -22,6 +22,7 @@ allocation.f \
allocont.f \
amplitudes.f \
angsum.f \
+anisomaxwavspd.f \
anisonl.f \
anisotropic.f \
applyboun.f \
@@ -66,11 +67,15 @@ calch0interface.f \
calcinitialflux.f \
calcmac.f \
calcmass.f \
+calcmatwavspeed.f \
calcpel.f \
calcrhoel.f \
calcrhoelcomp.f \
calcrhofa.f \
calcrhofacomp.f \
+calcrhofacompisen.f \
+calcstabletimeinccont.f \
+calcstabletimeincvol.f \
calcstressheatflux.f \
calctel.f \
calcumel.f \
@@ -112,6 +117,7 @@ changesolidsections.f \
changesurfacebehaviors.f \
changekon.f \
characteristic.f \
+checkimpacts.f \
checktemp.f \
checktime.f \
checktruecontact.f \
@@ -323,9 +329,11 @@ keystart.f \
knotmpc.f \
labyrinth.f \
lab_straight_ppkrit.f \
+lbfgsb.f \
limit_case_calc.f \
linel.f \
linkdissimilar.f \
+linpack.f \
linscal.f \
linvec.f \
lintemp.f \
@@ -342,14 +350,16 @@ mafilldm.f \
mafillem.f \
mafillnet.f \
mafillp.f \
+mafillpbc.f \
mafillpcomp.f \
mafillsm.f \
mafillsm1.f \
mafillsmas.f \
+mafillsmas1.f \
mafillsmcs.f \
mafillsmcsas.f \
mafillsmforc.f \
-mafillsm_se.f \
+mafillsmse.f \
mafillt.f \
mafilltcomp.f \
mafillv.f \
@@ -360,6 +370,8 @@ map3dtolayer.f \
map3dto1d2d_v.f \
massflow_percent.f \
massflows.f \
+materialdata_cfd.f \
+materialdata_cfd_comp.f \
materialdata_cond.f \
materialdata_cp.f \
materialdata_cp_sec.f \
@@ -414,6 +426,11 @@ norshell4.f \
norshell6.f \
norshell8.f \
objectives.f \
+objective_mass.f \
+objective_mass_dx.f \
+objective_shapeener.f \
+objective_shapeener_dx.f \
+objective_shapeener_tot.f \
onedint.f \
op.f \
opas.f \
@@ -505,6 +522,7 @@ scavenge_pump.f \
sdvini.f \
selectcyclicsymmetrymodess.f \
sensitivitys.f \
+sensitivity_glob.f \
shape3l.f \
shape3tri.f \
shape4q.f \
@@ -551,6 +569,7 @@ steadystatedynamicss.f \
steps.f \
stiff2mat.f \
stop.f \
+storecontactprop.f \
storeresidual.f \
str2mat.f \
straighteq2d.f \
@@ -576,6 +595,7 @@ thermmodel.f \
tiefaccont.f \
ties.f \
timepointss.f \
+timer.f \
transformatrix.f \
transformfs.f \
transforms.f \
@@ -680,6 +700,7 @@ frdheader.c \
frdselect.c \
frdset.c \
frdvector.c \
+frd_se.c \
frecord.c \
getglobalresults.c \
getSystemCPUs.c \
@@ -688,8 +709,15 @@ insert.c \
insertfreq.c \
insertrad.c \
linstatic.c \
+mafillpcompmain.c \
+mafillpmain.c \
+mafillsmasmain.c \
mafillsmmain.c \
mafillsmmain_se.c \
+mafilltcompmain.c \
+mafilltmain.c \
+mafillvcompmain.c \
+mafillvmain.c \
mastruct.c \
mastructcs.c \
mastructem.c \
@@ -697,6 +725,7 @@ mastructf.c \
mastructrad.c \
matrixstorage.c \
nonlingeo.c \
+objectivesmmain_se.c \
pardiso.c \
pardiso_as.c \
pcgsolver.c \
@@ -714,6 +743,7 @@ remastructem.c \
results.c \
resultsinduction.c \
results_se.c \
+rhspmain.c \
sensitivity.c \
sgi.c \
spooles.c \
diff --git a/ccx_2.9/src/Makefile_MT b/ccx_2.10/src/Makefile_MT
similarity index 58%
rename from ccx_2.9/src/Makefile_MT
rename to ccx_2.10/src/Makefile_MT
index 9eb1a4e..2cf567d 100755
--- a/ccx_2.9/src/Makefile_MT
+++ b/ccx_2.10/src/Makefile_MT
@@ -1,5 +1,5 @@
-CFLAGS = -Wall -O3 -I ../../../SPOOLES.2.2 -DARCH="Linux" -DSPOOLES -DARPACK -DMATRIXSTORAGE -DUSE_MT=1
+CFLAGS = -Wall -O3 -fopenmp -I ../../../SPOOLES.2.2 -DARCH="Linux" -DSPOOLES -DARPACK -DMATRIXSTORAGE -DUSE_MT=1
FFLAGS = -Wall -O3 -fopenmp
CC=cc
@@ -12,7 +12,7 @@ FC=gfortran
include Makefile.inc
-SCCXMAIN = ccx_2.9.c
+SCCXMAIN = ccx_2.10.c
OCCXF = $(SCCXF:.f=.o)
OCCXC = $(SCCXC:.c=.o)
@@ -26,9 +26,9 @@ LIBS = \
../../../ARPACK/libarpack_INTEL.a \
-lpthread -lm
-ccx_2.9_MT: $(OCCXMAIN) ccx_2.9_MT.a $(LIBS)
- ./date.pl; $(CC) $(CFLAGS) -c ccx_2.9.c; $(FC) -fopenmp -Wall -O3 -o $@ $(OCCXMAIN) ccx_2.9_MT.a $(LIBS)
+ccx_2.10_MT: $(OCCXMAIN) ccx_2.10_MT.a $(LIBS)
+ ./date.pl; $(CC) $(CFLAGS) -c ccx_2.10.c; $(FC) -fopenmp -Wall -O3 -o $@ $(OCCXMAIN) ccx_2.10_MT.a $(LIBS)
-ccx_2.9_MT.a: $(OCCXF) $(OCCXC)
+ccx_2.10_MT.a: $(OCCXF) $(OCCXC)
ar vr $@ $?
diff --git a/ccx_2.9/src/Makefile_i8 b/ccx_2.10/src/Makefile_i8
similarity index 53%
rename from ccx_2.9/src/Makefile_i8
rename to ccx_2.10/src/Makefile_i8
index 0d50f0b..55b26c9 100755
--- a/ccx_2.9/src/Makefile_i8
+++ b/ccx_2.10/src/Makefile_i8
@@ -1,6 +1,6 @@
-CFLAGS = -Wall -O3 -I ../../../SPOOLES.2.2 -DARCH="Linux" -DSPOOLES -DARPACK -DMATRIXSTORAGE -DLONGLONG
-FFLAGS = -Wall -O3 -fdefault-integer-8
+CFLAGS = -Wall -O3 -fopenmp -I ../../../SPOOLES.2.2 -DARCH="Linux" -DSPOOLES -DARPACK -DMATRIXSTORAGE -DLONGLONG
+FFLAGS = -Wall -O3 -fopenmp -fdefault-integer-8
CC=cc
FC=gfortran
@@ -12,7 +12,7 @@ FC=gfortran
include Makefile.inc
-SCCXMAIN = ccx_2.9.c
+SCCXMAIN = ccx_2.10.c
OCCXF = $(SCCXF:.f=.o)
OCCXC = $(SCCXC:.c=.o)
@@ -25,11 +25,11 @@ LIBS = \
../../../ARPACK_i8/libarpack_INTEL_i8.a \
-lpthread -lm -lc
-ccx_2.9: $(OCCXMAIN) ccx_2.9.a $(LIBS)
- ./date.pl; $(CC) $(CFLAGS) -c ccx_2.9.c; $(FC) -Wall -O3 -o $@ \
- $(OCCXMAIN) ccx_2.9.a $(LIBS)
+ccx_2.10: $(OCCXMAIN) ccx_2.10.a $(LIBS)
+ ./date.pl; $(CC) $(CFLAGS) -c ccx_2.10.c; $(FC) -Wall -O3 -o $@ \
+ $(OCCXMAIN) ccx_2.10.a $(LIBS)
-ccx_2.9.a: $(OCCXF) $(OCCXC)
+ccx_2.10.a: $(OCCXF) $(OCCXC)
ar vr $@ $?
diff --git a/ccx_2.9/src/README.INSTALL b/ccx_2.10/src/README.INSTALL
similarity index 83%
rename from ccx_2.9/src/README.INSTALL
rename to ccx_2.10/src/README.INSTALL
index d7d3cda..4967b51 100755
--- a/ccx_2.9/src/README.INSTALL
+++ b/ccx_2.10/src/README.INSTALL
@@ -1,19 +1,19 @@
This is a short overview of the installation procedure of CalculiX CrunchiX
-Version 2.9
+Version 2.10
***************************************************************************
A. IF YOU WOULD LIKE TO GENERATE THE EXECUTABLE FROM SCRATCH:
-1. copy ccx_2.9.src.tar.bz2, ccx_2.9.doc.tar.bz2,
- ccx_2.9.test.tar.bz2 and ccx_2.9.README.INSTALL to
+1. copy ccx_2.10.src.tar.bz2, ccx_2.10.doc.tar.bz2,
+ ccx_2.10.test.tar.bz2 and ccx_2.10.README.INSTALL to
directory /usr/local
-2. bunzip2 and untar ccx_2.9.src.tar.bz2, ccx_2.9.doc.tar.bz2 and
- ccx_2.9.test.tar.bz2; the following directory tree is generated:
- /usr/local/CalculiX/ccx_2.9/src
- /usr/local/CalculiX/ccx_2.9/doc
- /usr/local/CalculiX/ccx_2.9/test
+2. bunzip2 and untar ccx_2.10.src.tar.bz2, ccx_2.10.doc.tar.bz2 and
+ ccx_2.10.test.tar.bz2; the following directory tree is generated:
+ /usr/local/CalculiX/ccx_2.10/src
+ /usr/local/CalculiX/ccx_2.10/doc
+ /usr/local/CalculiX/ccx_2.10/test
3. get SPOOLES.2.2 and ARPACK from the internet
(e.g.
@@ -32,7 +32,7 @@ A. IF YOU WOULD LIKE TO GENERATE THE EXECUTABLE FROM SCRATCH:
If you like to use TAUCS as solver, install TAUCS in /usr/local/taucs
(and lapack, blas and metis in /usr/local/taucs/external/lib/linux)
and change the Makefile in
- /usr/local/CalculiX/ccx_2.9/src as follows:
+ /usr/local/CalculiX/ccx_2.10/src as follows:
a) add "-I ../../../taucs/src -I ../../../taucs/build/linux -DTAUCS" to
the CFLAGS (without double quotes)
b) add
@@ -50,10 +50,10 @@ A. IF YOU WOULD LIKE TO GENERATE THE EXECUTABLE FROM SCRATCH:
changed in file tau.c (for instance the location of the scratch file).
If you have access to the SGI scientific library, change the Makefile in
- /usr/local/CalculiX/ccx_2.9/src as follows:
+ /usr/local/CalculiX/ccx_2.10/src as follows:
a) add "-DSGI" to the CFLAGS (without double quotes)
b) add -lscs to
- g77 -Wall -O -o $@ $(OCCXMAIN) ccx_2.9.a $(LIBS)
+ g77 -Wall -O -o $@ $(OCCXMAIN) ccx_2.10.a $(LIBS)
The linear equation solver in the SGI library is about twice as
fast as SPOOLES and comes in an out-of-core version as well. For
details look at file sgi.c. The out-of-core is automatically
@@ -67,7 +67,7 @@ A. IF YOU WOULD LIKE TO GENERATE THE EXECUTABLE FROM SCRATCH:
If you do not want to link SPOOLES and/or ARPACK, delete -DSPOOLES
and/or -DARPACK in the CFLAGS in the Makefile in
- /usr/local/CalculiX/ccx_2.9/src.
+ /usr/local/CalculiX/ccx_2.10/src.
If you would like to use PARDISO, add the flag -DPARDISO to the CFLAGS. You
can find more information on PARDISO and its license on
@@ -79,15 +79,15 @@ A. IF YOU WOULD LIKE TO GENERATE THE EXECUTABLE FROM SCRATCH:
code (CalculiX.c) such that you get the message: "You are using an
executable made on (actual date)" on the screen each time you execute
CalculiX CrunchiX. If you do not want this, or if you do not have Perl,
- delete "./date.pl; $(CC) $(CFLAGS) -c ccx_2.9.c; " near
+ delete "./date.pl; $(CC) $(CFLAGS) -c ccx_2.10.c; " near
the end of the Makefile. Remember that the Makefile syntax requires
this line to start with a TAB, no blanks, so be careful if you change
that line.
-4. change to /usr/local/CalculiX/ccx_2.9/src and type make;
- ccx_2.9 is made; put the executable in /usr/local/bin.
+4. change to /usr/local/CalculiX/ccx_2.10/src and type make;
+ ccx_2.10 is made; put the executable in /usr/local/bin.
Make sure the file access permissions are set by typing
- "chmod a+rx ccx_2.9" in directory
+ "chmod a+rx ccx_2.10" in directory
/usr/local bin. Make sure /usr/local/bin is in your $PATH variable
(check by typing "echo $PATH". If /usr/local/bin is not in the
path, add it in your start script (e.g. .bashrc) by adding a line
@@ -114,17 +114,17 @@ CFLAGS = -DARCH="HP"
FFLAGS = +e +es -C +A3 -K +ppu -g
LD = c89
-5. change to /usr/local/CalculiX/ccx_2.9/doc and type "latex
+5. change to /usr/local/CalculiX/ccx_2.10/doc and type "latex
ccx.tex" at least three times, followed by "dvips ccx.dvi". A
postscript version of the documentation is made. Type "mv ccx.ps
- ccx_2.9.ps" to get the version attached. If available, use
+ ccx_2.10.ps" to get the version attached. If available, use
latex2html to create a html version by typing "latex2html ccx.tex".
A new directory is generated with the name
- /usr/local/CalculiX/ccx_2.9/doc/ccx. This way it can be
+ /usr/local/CalculiX/ccx_2.10/doc/ccx. This way it can be
called from CalculiX GraphiX.
-6. change to /usr/local/CalculiX/ccx_2.9/test, and type
- " ccx_2.9 beamp"; check whether a beamp.dat file has been
+6. change to /usr/local/CalculiX/ccx_2.10/test, and type
+ " ccx_2.10 beamp"; check whether a beamp.dat file has been
created and compare with beamp.dat.ref. Minor differences can occur
depending on the machine type you are using. Check whether a
beamp.frd file has been created and look at the results with
@@ -140,32 +140,32 @@ LD = c89
*****************************************************************************
B. IF YOU WOULD LIKE TO RUN THE EXECUTABLE YOU COPIED FROM THE
-HOMEPAGE (ccx_2.9.tar.bz2):
+HOMEPAGE (ccx_2.10.tar.bz2):
-1. copy ccx_2.9.tar.bz2 to /usr/local. Bunzip2 and untar the
- executable; the file ccx_2.9 is
- generated and put into /usr/local/CalculiX/ccx_2.9/src. Move
+1. copy ccx_2.10.tar.bz2 to /usr/local. Bunzip2 and untar the
+ executable; the file ccx_2.10 is
+ generated and put into /usr/local/CalculiX/ccx_2.10/src. Move
the executable to /usr/local/bin.
-2. to run examples, get ccx_2.9.test.tar.bz2 from the homepage
+2. to run examples, get ccx_2.10.test.tar.bz2 from the homepage
and follow the instructions under A.
-3. to get the documentation, get ccx_2.9.ps.tar.bz2 and
- ccx_2.9.htm.tar.bz2, copy them to /usr/local and bunzip2 and
+3. to get the documentation, get ccx_2.10.ps.tar.bz2 and
+ ccx_2.10.htm.tar.bz2, copy them to /usr/local and bunzip2 and
untar them. Alternatively, create the documentation from the tex
- original ccx_2.9.doc.tar.bz2 and proceed as explained under A.
+ original ccx_2.10.doc.tar.bz2 and proceed as explained under A.
******************************************************************************
If you like a slower pace, here some more information:
-You should have obtained four files: ccx_2.9.src.tar.bz2,
-ccx_2.9.doc.tar.bz2, ccx_2.9.htm.tar.bz2,
-ccx_2.9.test.tar.bz2 and the present file
-ccx_2.9.README.INSTALL. By typing "bunzip2 ccx_2.9.src.tar.bz2"
-and "tar -xvf ccx_2.9.src.tar" you extract the source code and some
-other useful files into a subdirectory ./CalculiX/ccx_2.9/src of
-the directory in which you copied ccx_2.9.src.tar.bz2, preferably /usr/local.
+You should have obtained four files: ccx_2.10.src.tar.bz2,
+ccx_2.10.doc.tar.bz2, ccx_2.10.htm.tar.bz2,
+ccx_2.10.test.tar.bz2 and the present file
+ccx_2.10.README.INSTALL. By typing "bunzip2 ccx_2.10.src.tar.bz2"
+and "tar -xvf ccx_2.10.src.tar" you extract the source code and some
+other useful files into a subdirectory ./CalculiX/ccx_2.10/src of
+the directory in which you copied ccx_2.10.src.tar.bz2, preferably /usr/local.
The source files include .c, .f and .h files.
@@ -192,21 +192,21 @@ for ARPACK: http://www.caam.rice.edu/software/ARPACK/
The current version of CalculiX assumes you install and use the serial
version of SPOOLES 2.2 and the serial double precision version of
ARPACK. The Makefile of CalculiX assumes that, if CalculiX is
-installed in ./CalculiX/ccx_2.9/src, SPOOLES 2.2 is installed in
+installed in ./CalculiX/ccx_2.10/src, SPOOLES 2.2 is installed in
./SPOOLES.2.2 and ARPACK in ./ARPACK (and their
subdirectories). Change the Makefile if you wish not to comply with
this procedure, or if you want to use TAUCS or the SGI solver (see
A). This also applies if you want to suppress the renumbering (see A).
-The file ccx_2.9.doc.tar.bz2 can be unzipped and untarred in a
-similar way as ccx_2.9.src.tar.bz2. The files are expanded in a
-subdirectory ./CalculiX/ccx_2.9/doc/, and contain a User's
-Manual in the form of the tex-file ccx_2.9.tex, in which several
+The file ccx_2.10.doc.tar.bz2 can be unzipped and untarred in a
+similar way as ccx_2.10.src.tar.bz2. The files are expanded in a
+subdirectory ./CalculiX/ccx_2.10/doc/, and contain a User's
+Manual in the form of the tex-file ccx_2.10.tex, in which several
*.eps and *.ps pictures are included.
-The file ccx_2.9.test.tar.bz2 can be unzipped and untarred in a
-similar way as ccx_2.9.src.tar.bz2. The files are expanded in a
-subdirectory ./CalculiX/ccx_2.9/test/, and contain the input
+The file ccx_2.10.test.tar.bz2 can be unzipped and untarred in a
+similar way as ccx_2.10.src.tar.bz2. The files are expanded in a
+subdirectory ./CalculiX/ccx_2.10/test/, and contain the input
files (*.inp) and result files (*.dat.ref) of several small sample
problems, each of them testing a specific property of
CalculiX. Running the script "compare" runs all problems and compares
@@ -219,9 +219,9 @@ you machine or other compile options.
Summarizing, after unpacking the above .tar.bz2 files, you obtain the
following directory structure:
-./CalculiX/ccx_2.9/src
-./CalculiX/ccx_2.9/doc
-./CalculiX/ccx_2.9/test
+./CalculiX/ccx_2.10/src
+./CalculiX/ccx_2.10/doc
+./CalculiX/ccx_2.10/test
SPOOLES.2.2 and ARPACK are assumed to be in
./SPOOLES.2.2
./ARPACK
diff --git a/ccx_2.9/src/TODO b/ccx_2.10/src/TODO
similarity index 74%
rename from ccx_2.9/src/TODO
rename to ccx_2.10/src/TODO
index a5d6139..49d4e9b 100755
--- a/ccx_2.9/src/TODO
+++ b/ccx_2.10/src/TODO
@@ -1,5 +1,5 @@
===================================================
-Things which might be useful if built into CalculiX Version 2.9
+Things which might be useful if built into CalculiX Version 2.10
===================================================
- compressible CFD based on the finite volume method
diff --git a/ccx_2.9/src/absolute_relative.f b/ccx_2.10/src/absolute_relative.f
similarity index 100%
rename from ccx_2.9/src/absolute_relative.f
rename to ccx_2.10/src/absolute_relative.f
diff --git a/ccx_2.9/src/acctube.f b/ccx_2.10/src/acctube.f
similarity index 100%
rename from ccx_2.9/src/acctube.f
rename to ccx_2.10/src/acctube.f
diff --git a/ccx_2.9/src/acctube_one.f b/ccx_2.10/src/acctube_one.f
similarity index 100%
rename from ccx_2.9/src/acctube_one.f
rename to ccx_2.10/src/acctube_one.f
diff --git a/ccx_2.9/src/add_bo_st.f b/ccx_2.10/src/add_bo_st.f
similarity index 100%
rename from ccx_2.9/src/add_bo_st.f
rename to ccx_2.10/src/add_bo_st.f
diff --git a/ccx_2.9/src/add_sm_ei.f b/ccx_2.10/src/add_sm_ei.f
similarity index 100%
rename from ccx_2.9/src/add_sm_ei.f
rename to ccx_2.10/src/add_sm_ei.f
diff --git a/ccx_2.9/src/add_sm_fl.f b/ccx_2.10/src/add_sm_fl.f
similarity index 100%
rename from ccx_2.9/src/add_sm_fl.f
rename to ccx_2.10/src/add_sm_fl.f
diff --git a/ccx_2.9/src/add_sm_fl_as.f b/ccx_2.10/src/add_sm_fl_as.f
similarity index 96%
rename from ccx_2.9/src/add_sm_fl_as.f
rename to ccx_2.10/src/add_sm_fl_as.f
index 95a2d3a..d7c5da6 100644
--- a/ccx_2.9/src/add_sm_fl_as.f
+++ b/ccx_2.10/src/add_sm_fl_as.f
@@ -28,6 +28,10 @@
!
real*8 ad(*),au(*),value
!
+ intent(in) jq,irow,i,j,value,nzs
+!
+ intent(inout) au,ad
+!
if(i.eq.j) then
ad(i)=ad(i)+value
return
diff --git a/ccx_2.9/src/add_sm_st.f b/ccx_2.10/src/add_sm_st.f
similarity index 100%
rename from ccx_2.9/src/add_sm_st.f
rename to ccx_2.10/src/add_sm_st.f
diff --git a/ccx_2.9/src/add_sm_st_as.f b/ccx_2.10/src/add_sm_st_as.f
similarity index 100%
rename from ccx_2.9/src/add_sm_st_as.f
rename to ccx_2.10/src/add_sm_st_as.f
diff --git a/ccx_2.9/src/add_sm_st_corio.f b/ccx_2.10/src/add_sm_st_corio.f
similarity index 100%
rename from ccx_2.9/src/add_sm_st_corio.f
rename to ccx_2.10/src/add_sm_st_corio.f
diff --git a/ccx_2.9/src/addimd.f b/ccx_2.10/src/addimd.f
similarity index 100%
rename from ccx_2.9/src/addimd.f
rename to ccx_2.10/src/addimd.f
diff --git a/ccx_2.9/src/addimdnodecload.f b/ccx_2.10/src/addimdnodecload.f
similarity index 100%
rename from ccx_2.9/src/addimdnodecload.f
rename to ccx_2.10/src/addimdnodecload.f
diff --git a/ccx_2.9/src/addimdnodedload.f b/ccx_2.10/src/addimdnodedload.f
similarity index 92%
rename from ccx_2.9/src/addimdnodedload.f
rename to ccx_2.10/src/addimdnodedload.f
index 76adebc..fa44171 100644
--- a/ccx_2.9/src/addimdnodedload.f
+++ b/ccx_2.10/src/addimdnodedload.f
@@ -31,22 +31,22 @@
!
integer nelemload(2,*),ipkon(*),kon(*),iload,ii,nopes,node,
& indexe,
- & ifaceq(9,6),ifacew(8,5),ifacet(7,4),ig,ielem,nope,imdnode(*),
+ & ifaceq(8,6),ifacew(8,5),ifacet(6,4),ig,ielem,nope,imdnode(*),
& nmdnode,ikmpc(*),
& ilmpc(*),ipompc(*),nodempc(3,*),nmpc,imddof(*),nmddof,
& mi(*),nactdof(0:mi(2),*),imdmpc(*),nmdmpc,imdboun(*),nmdboun,
& ikboun(*),nboun,ilboun(*),ithermal,k
!
- data ifaceq /4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/
- data ifacet /1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/
+ data ifaceq /4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/
+ data ifacet /1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/
data ifacew /1,3,2,9,8,7,0,0,
& 4,5,6,10,11,12,0,0,
& 1,2,5,4,7,14,10,13,
diff --git a/ccx_2.9/src/addimdnodedof.f b/ccx_2.10/src/addimdnodedof.f
similarity index 100%
rename from ccx_2.9/src/addimdnodedof.f
rename to ccx_2.10/src/addimdnodedof.f
diff --git a/ccx_2.9/src/addizdofcload.f b/ccx_2.10/src/addizdofcload.f
similarity index 100%
rename from ccx_2.9/src/addizdofcload.f
rename to ccx_2.10/src/addizdofcload.f
diff --git a/ccx_2.9/src/addizdofdload.f b/ccx_2.10/src/addizdofdload.f
similarity index 100%
rename from ccx_2.9/src/addizdofdload.f
rename to ccx_2.10/src/addizdofdload.f
diff --git a/ccx_2.9/src/adjustcontactnodes.f b/ccx_2.10/src/adjustcontactnodes.f
similarity index 92%
rename from ccx_2.9/src/adjustcontactnodes.f
rename to ccx_2.10/src/adjustcontactnodes.f
index ebeca7f..7de41fd 100644
--- a/ccx_2.9/src/adjustcontactnodes.f
+++ b/ccx_2.10/src/adjustcontactnodes.f
@@ -36,7 +36,7 @@
& ntriangle_,itriold,itrinew,id,nslavnode(*),islavnode(*),
& ipos,nset,istartset(*),iendset(*),ialset(*),iclear,
& istart,ilength,nope,nopes,nelems,jj,ifaces,itiefac(2,*),
- & jfaces,islavsurf(2,*),ifaceq(9,6),ifacet(7,4),ifacew1(4,5),
+ & jfaces,islavsurf(2,*),ifaceq(8,6),ifacet(6,4),ifacew1(4,5),
& ifacew2(8,5),ipkon(*),kon(*)
!
real*8 cg(3,*),straight(16,*),co(3,*),vold(0:mi(2),*),p(3),
@@ -45,19 +45,19 @@
!
! nodes per face for hex elements
!
- data ifaceq /4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/
+ data ifaceq /4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/
!
! nodes per face for tet elements
!
- data ifacet /1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/
+ data ifacet /1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/
!
! nodes per face for linear wedge elements
!
@@ -273,18 +273,9 @@ c write(*,*) '**regular solution'
elseif(lakon(nelems)(4:5).eq.'20') then
nopes=8
nope=20
- elseif(lakon(nelems)(4:6).eq.'26R') then
- nopes=9
- nope=26
- elseif(lakon(nelems)(4:4).eq.'2') then
- nopes=9
- nope=26
elseif(lakon(nelems)(4:5).eq.'10') then
nopes=6
nope=10
- elseif(lakon(nelems)(4:5).eq.'14') then
- nopes=7
- nope=14
elseif(lakon(nelems)(4:4).eq.'4') then
nopes=3
nope=4
@@ -314,7 +305,7 @@ c write(*,*) '**regular solution'
ilength=nslavnode(i+1)-nslavnode(i)
!
do m=1,nopes
- if((nope.eq.26).or.(nope.eq.20).or.(nope.eq.8))then
+ if((nope.eq.20).or.(nope.eq.8))then
node=kon(ipkon(nelems)+ifaceq(m,jfaces))
elseif((nope.eq.10).or.(nope.eq.4).or.(nope.eq.14))
& then
diff --git a/ccx_2.9/src/advecforc.f b/ccx_2.10/src/advecforc.f
similarity index 100%
rename from ccx_2.9/src/advecforc.f
rename to ccx_2.10/src/advecforc.f
diff --git a/ccx_2.9/src/advecstiff.f b/ccx_2.10/src/advecstiff.f
similarity index 100%
rename from ccx_2.9/src/advecstiff.f
rename to ccx_2.10/src/advecstiff.f
diff --git a/ccx_2.9/src/allocation.f b/ccx_2.10/src/allocation.f
similarity index 98%
rename from ccx_2.9/src/allocation.f
rename to ccx_2.10/src/allocation.f
index a9ff34f..3786823 100644
--- a/ccx_2.9/src/allocation.f
+++ b/ccx_2.10/src/allocation.f
@@ -22,7 +22,7 @@
& namtot,ncmat,memmpc,ne1d,ne2d,nflow,jobnamec,irstrt,
& ithermal,nener,nstate,irestartstep,inpc,ipoinp,inp,
& ntie,nbody,nprop,ipoinpc,nevdamp,npt,nslavs,nkon,mcs,
- & mortar,ifacecount,nintpoint,infree,nheading)
+ & mortar,ifacecount,nintpoint,infree,nheading,nobject)
!
! calculates a conservative estimate of the size of the
! fields to be allocated
@@ -59,7 +59,7 @@
& ntie,nbody,nprop,ipoinpc(0:*),nevdamp,npt,nentries,
& iposs,iposm,nslavs,nlayer,nkon,nopeexp,k,iremove,mcs,
& ifacecount,nintpoint,mortar,infree(4),nheading,icfd,
- & multslav,multmast
+ & multslav,multmast,nobject
!
real*8 temperature,tempact,xfreq,tpinc,tpmin,tpmax
!
@@ -428,6 +428,10 @@
if(istat.lt.0) exit
nstate=max(l,nstate)
enddo
+ elseif(textpart(1)(1:16).eq.'*DESIGNVARIABLES') then
+ ntie=ntie+1
+ call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
+ & ipoinp,inp,ipoinpc)
elseif(textpart(1)(1:21).eq.'*DISTRIBUTINGCOUPLING') then
nmpc=nmpc+3
memmpc=memmpc+3
@@ -993,6 +997,8 @@ c ncmat=max(7,ncmat)
enddo
elseif(textpart(1)(1:18).eq.'*GAPHEATGENERATION') then
ncmat=max(11,ncmat)
+ call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
+ & ipoinp,inp,ipoinpc)
elseif(textpart(1)(1:8).eq.'*HEADING') then
if(nheading.ne.0) then
write(*,*) '*ERROR in allocation: more than 1'
@@ -1247,6 +1253,13 @@ c ncmat=max(7,ncmat)
if((istat.lt.0).or.(key.eq.1)) exit
nprint=nprint+n
enddo
+ elseif(textpart(1)(1:10).eq.'*OBJECTIVE') then
+ do
+ call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
+ & ipoinp,inp,ipoinpc)
+ if((istat.lt.0).or.(key.eq.1)) exit
+ nobject=nobject+1
+ enddo
elseif(textpart(1)(1:12).eq.'*ORIENTATION') then
norien=norien+1
do
@@ -1690,9 +1703,11 @@ c memmpc=memmpc+96*meminset(i)+48*meminset(i)+1
nmat=nmat+1
call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
& ipoinp,inp,ipoinpc)
- elseif(textpart(1)(1:11).eq.'*TEMPERATURE') then
+ elseif(textpart(1)(1:12).eq.'*TEMPERATURE') then
nam=nam+1
namtot=namtot+1
+ call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
+ & ipoinp,inp,ipoinpc)
elseif(textpart(1)(1:4).eq.'*TIE') then
ntie=ntie+1
cyclicsymmetry=.false.
diff --git a/ccx_2.9/src/allocont.f b/ccx_2.10/src/allocont.f
similarity index 98%
rename from ccx_2.9/src/allocont.f
rename to ccx_2.10/src/allocont.f
index 9339011..366d7fc 100644
--- a/ccx_2.9/src/allocont.f
+++ b/ccx_2.10/src/allocont.f
@@ -107,8 +107,6 @@
ncont=ncont+2
elseif(lakon(nelem)(4:5).eq.'10') then
ncont=ncont+4
- elseif(lakon(nelem)(4:5).eq.'14') then
- ncont=ncont+6
elseif(lakon(nelem)(4:4).eq.'4') then
ncont=ncont+1
elseif(lakon(nelem)(4:5).eq.'15') then
diff --git a/ccx_2.9/src/amplitudes.f b/ccx_2.10/src/amplitudes.f
similarity index 100%
rename from ccx_2.9/src/amplitudes.f
rename to ccx_2.10/src/amplitudes.f
diff --git a/ccx_2.9/src/angsum.f b/ccx_2.10/src/angsum.f
similarity index 100%
rename from ccx_2.9/src/angsum.f
rename to ccx_2.10/src/angsum.f
diff --git a/ccx_2.10/src/anisomaxwavspd.f b/ccx_2.10/src/anisomaxwavspd.f
new file mode 100644
index 0000000..a1bb9bf
--- /dev/null
+++ b/ccx_2.10/src/anisomaxwavspd.f
@@ -0,0 +1,262 @@
+!
+! CalculiX - A 3-dimensional finite element program
+! Copyright (C) 1998-2007 Guido Dhondt
+!
+! This program is free software; you can redistribute it and/or
+! modify it under the terms of the GNU General Public License as
+! published by the Free Software Foundation(version 2);
+!
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program; if not, write to the Free Software
+! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+!
+ subroutine anisomaxwavspd(elas,rho,iorth,maxwavspd)
+!
+! Calculates the propagation wave speed in a material, up to its 21
+! constants. Subroutine for calcmatwavsps.f
+
+! Based on the procedure in:
+! C. Lane. The Development of a 2D Ultrasonic Array Inspection
+! for Single Crystal Turbine Blades.
+! Switzerland: Springer International Publishing, 2014.
+!
+! CARLO MONJARAZ TEC (CMT)
+!
+! INPUT:
+!
+! elas: double(21) - The elasticity vector, containing 21 entries.
+! Non used are zero. If material is iorthtropic, values are
+! rearranged in middle step to match indexes from anisotropic
+! material card.
+!
+! rho: double - Density of the material
+!
+! iorth: INTEGER - if the value is 1 : material is iorthtropic
+! for other vaules: material is anisotropic
+!
+! maxwavspd: double(*) - contains the list of maximum wave speeds
+! per each material defined in the model. Only materials
+! that are used in the model are updated, else are left
+! as -1.0
+!
+! OUTPUT:
+!
+! maxwavspd
+!
+ implicit none
+!
+ real*8 elas(21),c(3,3,3,3),rho,n(3),cm(3,3,3),
+ & cmm(3,3),dd,al(3),alz(3,3),fv1(3),fv2(3),
+ & theta(2*100+1),phi(100+1),pi,p1(3),p2(3),p3(3),v(3),
+ & maxwavspd,speed,nmax(3)
+!
+ integer i,j,k,l,it,jt,kt,lt,imax,jmax,itheta,jphi,
+ & itensor(4,21),ier,matz,ndim,iorth
+!
+ data itensor /1,1,1,1,
+ & 1,1,2,2,
+ & 2,2,2,2,
+ & 1,1,3,3,
+ & 2,2,3,3,
+ & 3,3,3,3,
+ & 1,1,1,2,
+ & 2,2,1,2,
+ & 3,3,1,2,
+ & 1,2,1,2,
+ & 1,1,1,3,
+ & 2,2,1,3,
+ & 3,3,1,3,
+ & 1,2,1,3,
+ & 1,3,1,3,
+ & 1,1,2,3,
+ & 2,2,2,3,
+ & 3,3,2,3,
+ & 1,2,2,3,
+ & 1,3,2,3,
+ & 2,3,2,3/
+!
+ pi=4.d0*datan(1.d0)
+!
+ speed=-1.d0
+ maxwavspd=-1.d0
+!
+ write(*,*)'++cMT: calculating max. speed in ANISOTROPIc...'
+!
+!--------IF IORTHTROPIc-----------------------------
+ if(iorth.eq.1)then
+!
+ elas(10)=elas(9)
+ elas(15)=elas(8)
+ elas(21)=elas(7)
+ elas(9)=0.d0
+ elas(8)=0.d0
+ elas(7)=0.d0
+!
+ endif
+!
+ maxwavspd=-1.d0
+ do i=1,101
+ phi(i)=(i-1.d0)/100.d0*pi
+ enddo
+!
+ do i=1,201
+ theta(i)=((i-1.d0)/100.d0-1.d0 )*pi
+ enddo
+!--------FIlling c voigt Matrix-----------------------------
+ do i=1,21
+ it=itensor(1,i)
+ jt=itensor(2,i)
+ kt=itensor(3,i)
+ lt=itensor(4,i)
+!
+ c(lt,kt,jt,it)=elas(i)
+ c(lt,kt,it,jt)=elas(i)
+ c(kt,lt,jt,it)=elas(i)
+ c(jt,it,lt,kt)=elas(i)
+! 2/3, 1/2, 1/3 swap
+ it=itensor(2,i)
+ jt=itensor(1,i)
+ kt=itensor(4,i)
+ lt=itensor(3,i)
+ c(lt,kt,jt,it)=elas(i)
+ c(lt,kt,it,jt)=elas(i)
+ c(kt,lt,jt,it)=elas(i)
+ c(jt,it,lt,kt)=elas(i)
+ enddo
+!
+!-----for each direction in the unit sphere------------------
+!
+ itheta=170
+ jphi=30
+ do itheta=1,201
+ do jphi=1,101
+!
+ do l=1,3
+ n(l)=0.
+ v(l)=0.
+ do k=1,3
+ cmm(k,l)=0.
+ do j=1,3
+ cm(j,l,k)=0.
+ enddo
+ enddo
+ enddo
+!
+ n(1)=cos(theta(itheta))*Sin(phi(jphi))
+ n(2)=Sin(theta(itheta))*Sin(phi(jphi))
+ n(3)=cos(phi(jphi))
+!
+! c ------------ PER EAcH DIREcTION find wave speed-----------------------
+!
+ dd=dsqrt(n(1)*n(1)+n(2)*n(2) +n(3)*n(3))
+
+ n(1)=n(1) / dd
+ n(2)=n(2) / dd
+ n(3)=n(3) / dd
+!
+ do l=1,3
+ do k=1,3
+ do i=1,3
+ do j=1,3
+ cm(l,k,i)=cm(l,k,i)+c(l,k,j,i)*n(j)
+ enddo
+ enddo
+ enddo
+ enddo
+!
+ do k=1,3
+ do i=1,3
+ do l=1,3
+ cmm(k,i)=cmm(k,i)+cm(l,k,i)*n(l)
+ enddo
+ enddo
+ enddo
+!
+ ndim=3
+ matz=1
+ ier=0
+!
+! ---------reset vars for EIGvALUES
+!
+ do j=1,3
+ al(j)=0.
+ fv1(j)=0.
+ fv2(j)=0.
+ do i=1,3
+ alz(j,i)=0.
+ enddo
+ enddo
+!
+ call rs(ndim,ndim,cmm,al,matz,alz,fv1,fv2,ier)
+!
+! ------normalizing eigenvectors to P vectors----------
+!
+ dd=dsqrt(alz(1,1)**2+alz(2,1)**2+alz(3,1)**2)
+ p1(1)=alz(1,1) / dd
+ p1(2)=alz(2,1) / dd
+ p1(3)=alz(3,1) / dd
+ dd=dsqrt(alz(1,2)**2+alz(2,2)**2+alz(3,2)**2)
+ p2(1)=alz(1,2) / dd
+ p2(2)=alz(2,2) / dd
+ p2(3)=alz(3,2) / dd
+ dd=dsqrt(alz(1,3)**2+alz(2,3)**2+alz(3,3)**2)
+ p3(1)=alz(1,3) / dd
+ p3(2)=alz(2,3) / dd
+ p3(3)=alz(3,3) / dd
+!
+ do l=1,3
+ do k=1,3
+ cmm(k,l)=0.
+ do j=1,3
+ cm(j,l,k)=0.
+ enddo
+ enddo
+ enddo
+!
+ do l=1,3
+ do j=1,3
+ do i=1,3
+ do k=1,3
+ cm(l,j,i)=cm(l,j,i)+c(l,k,j,i)*n(k);
+ enddo
+ enddo
+ enddo
+ enddo
+!
+ do l=1,3
+ do j=1,3
+ do i=1,3
+ cmm(l,j)=cmm(l,j)+cm(l,j,i)*p3(i);
+ enddo
+ enddo
+ enddo
+!
+ do j=1,3
+ do i=1,3
+ v(j)=v(j)+cmm(j,i)*p3(i)
+ enddo
+ enddo
+!
+ dd=dsqrt(v(1)**2+v(2)**2+v(3)**2)
+ speed=dsqrt(dd/rho)
+!
+ if(speed.gt.maxwavspd)then
+ maxwavspd=speed
+ imax=itheta
+ jmax=jphi
+ nmax=n
+ endif
+
+ enddo
+ enddo
+!-------END for each direction in the unit sphere-------------
+!
+ return
+ end
+
diff --git a/ccx_2.9/src/anisonl.f b/ccx_2.10/src/anisonl.f
similarity index 100%
rename from ccx_2.9/src/anisonl.f
rename to ccx_2.10/src/anisonl.f
diff --git a/ccx_2.9/src/anisotropic.f b/ccx_2.10/src/anisotropic.f
similarity index 100%
rename from ccx_2.9/src/anisotropic.f
rename to ccx_2.10/src/anisotropic.f
diff --git a/ccx_2.9/src/applyboun.f b/ccx_2.10/src/applyboun.f
similarity index 97%
rename from ccx_2.9/src/applyboun.f
rename to ccx_2.10/src/applyboun.f
index 6b42bbd..f10b979 100644
--- a/ccx_2.9/src/applyboun.f
+++ b/ccx_2.10/src/applyboun.f
@@ -19,7 +19,7 @@
subroutine applyboun(ifaext,nfaext,ielfa,ikboun,ilboun,
& nboun,typeboun,nelemload,nload,sideload,isolidsurf,nsolidsurf,
& ifabou,nfabou,nface,nodeboun,ndirboun,ikmpc,ilmpc,labmpc,nmpc,
- & nactdohinv,compressible)
+ & nactdohinv,compressible,iatleastonepressurebc)
!
! stores pointers to ifabou in ielfa(2,*) at those locations
! which are zero (external faces)
@@ -34,9 +34,10 @@
& j,idof,ikboun(*),nboun,id,ilboun(*),iboun,nelemload(2,*),
& nload,isolidsurf(*),nsolidsurf,ifabou(*),i,nface,indexb,
& nodeboun(*),ndirboun(*),jsum,ig,ikmpc(*),ilmpc(*),nmpc,mpc,
- & nactdohinv(*),compressible
+ & nactdohinv(*),compressible,iatleastonepressurebc
!
nfabou=1
+ iatleastonepressurebc=0
!
do i=1,nfaext
!
@@ -83,6 +84,7 @@
write(*,*)
exit
endif
+ iatleastonepressurebc=1
endif
endif
jsum=jsum+j
diff --git a/ccx_2.9/src/applympc.f b/ccx_2.10/src/applympc.f
similarity index 87%
rename from ccx_2.9/src/applympc.f
rename to ccx_2.10/src/applympc.f
index 1948545..b7f563c 100644
--- a/ccx_2.9/src/applympc.f
+++ b/ccx_2.10/src/applympc.f
@@ -17,7 +17,7 @@
! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
!
subroutine applympc(nface,ielfa,is,ie,ifabou,ipompc,vfa,coefmpc,
- & nodempc,ipnei,neifa,labmpc,xbounact,nactdoh)
+ & nodempc,ipnei,neifa,labmpc,xbounact,nactdoh,ifaext,nfaext)
!
! applies MPC's to the faces
!
@@ -27,12 +27,19 @@
!
integer i,j,nface,ielfa(4,*),ipointer,is,ie,ifabou(*),mpc,
& ipompc(*),index,iel,iface,nodempc(3,*),ipnei(*),neifa(*),
- & nactdoh(*),ielorig
+ & nactdoh(*),ielorig,ifaext(*),nfaext,k
!
real*8 coefmpc(*),denominator,vfa(0:5,*),sum,xbounact(*),
& coefnorm
!
- do i=1,nface
+c do i=1,nface
+c$omp parallel default(none)
+c$omp& shared(nfaext,ifaext,ielfa,ifabou,ipompc,nodempc,coefmpc,
+c$omp& xbounact,nactdoh,neifa,ipnei,vfa,is,ie)
+c$omp& private(k,i,ipointer,mpc,index,sum,coefnorm,ielorig,iel,iface)
+c$omp do
+ do k=1,nfaext
+ i=ifaext(k)
if(ielfa(2,i).ge.0) cycle
ipointer=-ielfa(2,i)
do j=is,ie
@@ -83,6 +90,8 @@
enddo
enddo
enddo
+c$omp end do
+c$omp end parallel
!
return
end
diff --git a/ccx_2.9/src/applympc_hfa.f b/ccx_2.10/src/applympc_hfa.f
similarity index 100%
rename from ccx_2.9/src/applympc_hfa.f
rename to ccx_2.10/src/applympc_hfa.f
diff --git a/ccx_2.9/src/approxplane.f b/ccx_2.10/src/approxplane.f
similarity index 100%
rename from ccx_2.9/src/approxplane.f
rename to ccx_2.10/src/approxplane.f
diff --git a/ccx_2.9/src/arpack.c b/ccx_2.10/src/arpack.c
similarity index 99%
rename from ccx_2.9/src/arpack.c
rename to ccx_2.10/src/arpack.c
index e4a37ce..337a329 100644
--- a/ccx_2.9/src/arpack.c
+++ b/ccx_2.10/src/arpack.c
@@ -419,7 +419,7 @@ void arpack(double *co, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
NNEW(fext,double,neq[1]);
if(*iperturb==0){
- FORTRAN(mafillsm,(co,nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,xboun,nboun,
+ mafillsmmain(co,nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,xboun,nboun,
ipompc,nodempc,coefmpc,nmpc,nodeforc,ndirforc,xforc,
nforc,nelemload,sideload,xload,nload,xbody,ipobody,nbody,cgr,
ad,au,fext,nactdof,icol,jq,irow,neq,nzl,nmethod,
@@ -434,10 +434,10 @@ void arpack(double *co, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
&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));
+ pmastsurf,mortar,clearini,ielprop,prop,&ne0,fnext,&kscale);
}
else{
- FORTRAN(mafillsm,(co,nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,xboun,nboun,
+ mafillsmmain(co,nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,xboun,nboun,
ipompc,nodempc,coefmpc,nmpc,nodeforc,ndirforc,xforc,
nforc,nelemload,sideload,xload,nload,xbody,ipobody,nbody,cgr,
ad,au,fext,nactdof,icol,jq,irow,neq,nzl,nmethod,
@@ -452,7 +452,7 @@ void arpack(double *co, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
&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));
+ pmastsurf,mortar,clearini,ielprop,prop,&ne0,fnext,&kscale);
if(nasym==1){
RENEW(au,double,nzs[2]+nzs[1]);
diff --git a/ccx_2.9/src/arpackbu.c b/ccx_2.10/src/arpackbu.c
similarity index 98%
rename from ccx_2.9/src/arpackbu.c
rename to ccx_2.10/src/arpackbu.c
index 396982a..96b6c29 100644
--- a/ccx_2.9/src/arpackbu.c
+++ b/ccx_2.10/src/arpackbu.c
@@ -191,7 +191,7 @@ void arpackbu(double *co, ITG *nk, ITG *kon, ITG *ipkon, char *lakon,
NNEW(fext,double,neq[0]);
if(*iperturb==0){
- FORTRAN(mafillsm,(co,nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,xboun,nboun,
+ mafillsmmain(co,nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,xboun,nboun,
ipompc,nodempc,coefmpc,nmpc,nodeforc,ndirforc,xforc,
nforc,nelemload,sideload,xload,nload,xbody,ipobody,nbody,cgr,
ad,au,fext,nactdof,icol,jq,irow,neq,nzl,nmethod,
@@ -206,10 +206,10 @@ void arpackbu(double *co, ITG *nk, ITG *kon, ITG *ipkon, char *lakon,
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));
+ &mortar,clearini,ielprop,prop,&ne0,fnext,&kscale);
}
else{
- FORTRAN(mafillsm,(co,nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,xboun,nboun,
+ mafillsmmain(co,nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,xboun,nboun,
ipompc,nodempc,coefmpc,nmpc,nodeforc,ndirforc,xforc,
nforc,nelemload,sideload,xload,nload,xbody,ipobody,nbody,cgr,
ad,au,fext,nactdof,icol,jq,irow,neq,nzl,nmethod,
@@ -224,7 +224,7 @@ void arpackbu(double *co, ITG *nk, ITG *kon, ITG *ipkon, char *lakon,
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));
+ pmastsurf,&mortar,clearini,ielprop,prop,&ne0,fnext,&kscale);
}
/* determining the right hand side */
@@ -395,7 +395,7 @@ void arpackbu(double *co, ITG *nk, ITG *kon, ITG *ipkon, char *lakon,
NNEW(fext,double,neq[0]);
if(*iperturb==0){
- FORTRAN(mafillsm,(co,nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,xboun,nboun,
+ mafillsmmain(co,nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,xboun,nboun,
ipompc,nodempc,coefmpc,nmpc,nodeforc,ndirforc,xforc,
nforc,nelemload,sideload,xload,nload,xbody,ipobody,nbody,cgr,
ad,au,fext,nactdof,icol,jq,irow,neq,nzl,nmethod,
@@ -410,10 +410,10 @@ void arpackbu(double *co, ITG *nk, ITG *kon, ITG *ipkon, char *lakon,
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));
+ pmastsurf,&mortar,clearini,ielprop,prop,&ne0,fnext,&kscale);
}
else{
- FORTRAN(mafillsm,(co,nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,xboun,nboun,
+ mafillsmmain(co,nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,xboun,nboun,
ipompc,nodempc,coefmpc,nmpc,nodeforc,ndirforc,xforc,
nforc,nelemload,sideload,xload,nload,xbody,ipobody,nbody,cgr,
ad,au,fext,nactdof,icol,jq,irow,neq,nzl,nmethod,
@@ -428,7 +428,7 @@ void arpackbu(double *co, ITG *nk, ITG *kon, ITG *ipkon, char *lakon,
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));
+ pmastsurf,&mortar,clearini,ielprop,prop,&ne0,fnext,&kscale);
}
SFREE(stx);SFREE(fext);if(*nbody>0) SFREE(ipobody);
diff --git a/ccx_2.9/src/arpackcs.c b/ccx_2.10/src/arpackcs.c
similarity index 100%
rename from ccx_2.9/src/arpackcs.c
rename to ccx_2.10/src/arpackcs.c
diff --git a/ccx_2.9/src/assigndomtonodes.f b/ccx_2.10/src/assigndomtonodes.f
similarity index 100%
rename from ccx_2.9/src/assigndomtonodes.f
rename to ccx_2.10/src/assigndomtonodes.f
diff --git a/ccx_2.10/src/attach.f b/ccx_2.10/src/attach.f
new file mode 100644
index 0000000..ccf5e5b
--- /dev/null
+++ b/ccx_2.10/src/attach.f
@@ -0,0 +1,167 @@
+!
+! CalculiX - A 3-dimensional finite element program
+! Copyright (C) 1998-2015 Guido Dhondt
+!
+! This program is free software; you can redistribute it and/or
+! modify it under the terms of the GNU General Public License as
+! published by the Free Software Foundation(version 2);
+!
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program; if not, write to the Free Software
+! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+!
+ subroutine attach(pneigh,pnode,nterms,ratio,dist,xil,etl)
+!
+! ataches node with coordinates in "pnode" to the face containing
+! "nterms" nodes with coordinates in field "pneigh" (nterms < 9).
+! cave: the coordinates are stored in pneigh(1..3,*)
+!
+ implicit none
+!
+ integer nterms,i,j,k,imin,jmin,im,jm
+!
+ real*8 ratio(9),pneigh(3,9),pnode(3),a,xi(-1:1,-1:1),
+ & et(-1:1,-1:1),p(3),distmin,d1,dist,xil,etl
+!
+ intent(in) pneigh,nterms
+!
+ intent(inout) xil,etl,pnode,dist,ratio
+!
+ d1=1.d0
+!
+ xi(0,0)=0.d0
+ et(0,0)=0.d0
+ call distattach(xi(0,0),et(0,0),pneigh,pnode,a,p,
+ & ratio,nterms)
+ distmin=a
+ imin=0
+ jmin=0
+!
+ do k=1,8
+!
+! initialisation
+!
+ d1=d1/10.d0
+!
+ do i=-1,1
+ do j=-1,1
+ if((i.eq.0).and.(j.eq.0)) cycle
+!
+ xi(i,j)=xi(0,0)+i*d1
+ et(i,j)=et(0,0)+j*d1
+!
+! check whether inside the (-1,1)x(-1,1) domain
+!
+ if((xi(i,j).le.1.d0).and.
+ & (xi(i,j).ge.-1.d0).and.
+ & (et(i,j).le.1.d0).and.
+ & (et(i,j).ge.-1.d0)) then
+ call distattach(xi(i,j),et(i,j),pneigh,pnode,a,p,
+ & ratio,nterms)
+!
+! checking for smallest initial distance
+!
+ if(a.lt.distmin) then
+ distmin=a
+ imin=i
+ jmin=j
+ endif
+ endif
+!
+ enddo
+ enddo
+!
+! minimizing the distance from the face to the node
+!
+ do
+!
+! exit if minimum found
+!
+ if((imin.eq.0).and.(jmin.eq.0)) exit
+!
+! new center of 3x3 matrix
+!
+ xi(0,0)=xi(imin,jmin)
+ et(0,0)=et(imin,jmin)
+!
+ im=imin
+ jm=jmin
+!
+ imin=0
+ jmin=0
+!
+ do i=-1,1
+ do j=-1,1
+ if((i+im.lt.-1).or.(i+im.gt.1).or.
+ & (j+jm.lt.-1).or.(j+jm.gt.1)) then
+!
+ xi(i,j)=xi(0,0)+i*d1
+ et(i,j)=et(0,0)+j*d1
+!
+! check whether inside the (-1,1)x(-1,1) domain
+!
+ if((xi(i,j).le.1.d0).and.
+ & (xi(i,j).ge.-1.d0).and.
+ & (et(i,j).le.1.d0).and.
+ & (et(i,j).ge.-1.d0)) then
+ call distattach(xi(i,j),et(i,j),pneigh,
+ & pnode,a,p,ratio,nterms)
+!
+! check for new minimum
+!
+ if(a.lt.distmin) then
+ distmin=a
+ imin=i
+ jmin=j
+ endif
+ endif
+!
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+!
+ call distattach(xi(0,0),et(0,0),pneigh,pnode,a,p,
+ & ratio,nterms)
+!
+ do i=1,3
+ pnode(i)=p(i)
+ enddo
+!
+ dist=dsqrt(a)
+!
+ if(nterms.eq.3) then
+ if(xi(0,0)+et(0,0).le.0.d0) then
+ xil=(xi(0,0)+1.d0)/2.d0
+ etl=(et(0,0)+1.d0)/2.d0
+ else
+ xil=(1.d0-et(0,0))/2.d0
+ etl=(1.d0-xi(0,0))/2.d0
+ endif
+ elseif(nterms.eq.4) then
+ xil=xi(0,0)
+ etl=et(0,0)
+ elseif(nterms.eq.6) then
+ if(xi(0,0)+et(0,0).le.0.d0) then
+ xil=(xi(0,0)+1.d0)/2.d0
+ etl=(et(0,0)+1.d0)/2.d0
+ else
+ xil=(1.d0-et(0,0))/2.d0
+ etl=(1.d0-xi(0,0))/2.d0
+ endif
+ elseif(nterms.eq.8) then
+ xil=xi(0,0)
+ etl=et(0,0)
+ endif
+!
+c write(*,*) 'end attach.f'
+ return
+ end
+
diff --git a/ccx_2.9/src/attach_3d.f b/ccx_2.10/src/attach_3d.f
similarity index 100%
rename from ccx_2.9/src/attach_3d.f
rename to ccx_2.10/src/attach_3d.f
diff --git a/ccx_2.9/src/attachline.f b/ccx_2.10/src/attachline.f
similarity index 100%
rename from ccx_2.9/src/attachline.f
rename to ccx_2.10/src/attachline.f
diff --git a/ccx_2.9/src/basis.f b/ccx_2.10/src/basis.f
similarity index 100%
rename from ccx_2.9/src/basis.f
rename to ccx_2.10/src/basis.f
diff --git a/ccx_2.9/src/beamextscheme.f b/ccx_2.10/src/beamextscheme.f
similarity index 71%
rename from ccx_2.9/src/beamextscheme.f
rename to ccx_2.10/src/beamextscheme.f
index a52e574..936869b 100644
--- a/ccx_2.9/src/beamextscheme.f
+++ b/ccx_2.10/src/beamextscheme.f
@@ -29,7 +29,7 @@
integer npropstart,mi(*),ndim,nfield,j,k,l
!
real*8 prop(*),ratio,ratio2,yil(ndim,mi(1)),yig(nfield,mi(1)),
- & field(999,20*mi(3)),r,scal,a8(8,8)
+ & field(999,20*mi(3)),r,scal,a8(8,8),pmean1(nfield),pmean2(nfield)
!
! extrapolation from a 2x2x2=8 integration point scheme in a hex to
! the vertex nodes
@@ -50,6 +50,13 @@
!
! pipe cross section
!
+! the axis of the pipe is along the local xi-direction
+! the integration points are at positions +-0.57 along
+! the xi-axis. At each of these positions there are 8
+! integration points in the eta-zeta plane at one radial
+! position and
+! equally spaced along the circumferential direction
+!
! ratio of inner radius to outer radius
!
ratio=(prop(npropstart+1)-prop(npropstart+2))/
@@ -65,18 +72,25 @@
!
scal=dsqrt(2.d0/3.d0)/r
!
+! calculating the mean values at each of the two xi-positions
+!
+ do k=1,nfield
+ pmean1(k)=(yil(k,2)+yil(k,4)+yil(k,6)+yil(k,8))/4.d0
+ pmean2(k)=(yil(k,10)+yil(k,12)+yil(k,14)+yil(k,16))/4.d0
+ enddo
+!
! translating the results from the integration points of the
! pipe section to the integration points of the C3D20R element
!
do k=1,nfield
- yig(k,1)=yil(k,6)*scal
- yig(k,2)=yil(k,14)*scal
- yig(k,3)=yil(k,8)*scal
- yig(k,4)=yil(k,16)*scal
- yig(k,5)=yil(k,4)*scal
- yig(k,6)=yil(k,12)*scal
- yig(k,7)=yil(k,2)*scal
- yig(k,8)=yil(k,10)*scal
+ yig(k,1)=pmean1(k)+(yil(k,6)-pmean1(k))*scal
+ yig(k,2)=pmean2(k)+(yil(k,14)-pmean2(k))*scal
+ yig(k,3)=pmean1(k)+(yil(k,8)-pmean1(k))*scal
+ yig(k,4)=pmean2(k)+(yil(k,16)-pmean2(k))*scal
+ yig(k,5)=pmean1(k)+(yil(k,4)-pmean1(k))*scal
+ yig(k,6)=pmean2(k)+(yil(k,12)-pmean2(k))*scal
+ yig(k,7)=pmean1(k)+(yil(k,2)-pmean1(k))*scal
+ yig(k,8)=pmean2(k)+(yil(k,10)-pmean2(k))*scal
enddo
!
! standard extrapolation for the C3D20R element
diff --git a/ccx_2.9/src/beamgeneralsections.f b/ccx_2.10/src/beamgeneralsections.f
similarity index 100%
rename from ccx_2.9/src/beamgeneralsections.f
rename to ccx_2.10/src/beamgeneralsections.f
diff --git a/ccx_2.9/src/beamintscheme.f b/ccx_2.10/src/beamintscheme.f
similarity index 100%
rename from ccx_2.9/src/beamintscheme.f
rename to ccx_2.10/src/beamintscheme.f
diff --git a/ccx_2.9/src/beamsections.f b/ccx_2.10/src/beamsections.f
similarity index 100%
rename from ccx_2.9/src/beamsections.f
rename to ccx_2.10/src/beamsections.f
diff --git a/ccx_2.9/src/biosav.c b/ccx_2.10/src/biosav.c
similarity index 100%
rename from ccx_2.9/src/biosav.c
rename to ccx_2.10/src/biosav.c
diff --git a/ccx_2.9/src/biotsavart.f b/ccx_2.10/src/biotsavart.f
similarity index 100%
rename from ccx_2.9/src/biotsavart.f
rename to ccx_2.10/src/biotsavart.f
diff --git a/ccx_2.9/src/bodyadd.f b/ccx_2.10/src/bodyadd.f
similarity index 100%
rename from ccx_2.9/src/bodyadd.f
rename to ccx_2.10/src/bodyadd.f
diff --git a/ccx_2.9/src/bodyforce.f b/ccx_2.10/src/bodyforce.f
similarity index 100%
rename from ccx_2.9/src/bodyforce.f
rename to ccx_2.10/src/bodyforce.f
diff --git a/ccx_2.9/src/bounadd.f b/ccx_2.10/src/bounadd.f
similarity index 100%
rename from ccx_2.9/src/bounadd.f
rename to ccx_2.10/src/bounadd.f
diff --git a/ccx_2.9/src/bounaddf.f b/ccx_2.10/src/bounaddf.f
similarity index 95%
rename from ccx_2.9/src/bounaddf.f
rename to ccx_2.10/src/bounaddf.f
index 160a7bf..4190dd4 100644
--- a/ccx_2.9/src/bounaddf.f
+++ b/ccx_2.10/src/bounaddf.f
@@ -41,21 +41,21 @@
& ilmpc(*),itr,idof,newnode,number,id,idofnew,idnew,nk,nk_,
& mpcfreenew,nmethod,iperturb,ii,mi(*),three,kflag,
& iy(3),inumber,iface,nload,nelemload(2,*),nopes,kon(*),nope,
- & nelem,loadid,ifacel,ifaceq(9,6),ifacet(7,4),ifacew(8,5)
+ & nelem,loadid,ifacel,ifaceq(8,6),ifacet(6,4),ifacew(8,5)
!
real*8 xboun(*),val,coefmpc(*),trab(7,*),a(3,3),co(3,*),cg(3),
& vold(0:mi(2),*),dx(3),xload(2,*)
!
- data ifaceq /4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/
- data ifacet /1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/
+ data ifaceq /4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/
+ data ifacet /1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/
data ifacew /1,3,2,9,8,7,0,0,
& 4,5,6,10,11,12,0,0,
& 1,2,5,4,7,14,10,13,
diff --git a/ccx_2.9/src/boundaryfs.f b/ccx_2.10/src/boundaryfs.f
similarity index 100%
rename from ccx_2.9/src/boundaryfs.f
rename to ccx_2.10/src/boundaryfs.f
diff --git a/ccx_2.9/src/boundarys.f b/ccx_2.10/src/boundarys.f
similarity index 100%
rename from ccx_2.9/src/boundarys.f
rename to ccx_2.10/src/boundarys.f
diff --git a/ccx_2.9/src/bounrem.f b/ccx_2.10/src/bounrem.f
similarity index 100%
rename from ccx_2.9/src/bounrem.f
rename to ccx_2.10/src/bounrem.f
diff --git a/ccx_2.9/src/bsort.f b/ccx_2.10/src/bsort.f
similarity index 100%
rename from ccx_2.9/src/bsort.f
rename to ccx_2.10/src/bsort.f
diff --git a/ccx_2.9/src/buckles.f b/ccx_2.10/src/buckles.f
similarity index 100%
rename from ccx_2.9/src/buckles.f
rename to ccx_2.10/src/buckles.f
diff --git a/ccx_2.9/src/calc_ider_cross_split.f b/ccx_2.10/src/calc_ider_cross_split.f
similarity index 100%
rename from ccx_2.9/src/calc_ider_cross_split.f
rename to ccx_2.10/src/calc_ider_cross_split.f
diff --git a/ccx_2.9/src/calc_ider_tee.f b/ccx_2.10/src/calc_ider_tee.f
similarity index 100%
rename from ccx_2.9/src/calc_ider_tee.f
rename to ccx_2.10/src/calc_ider_tee.f
diff --git a/ccx_2.9/src/calc_ider_wye.f b/ccx_2.10/src/calc_ider_wye.f
similarity index 100%
rename from ccx_2.9/src/calc_ider_wye.f
rename to ccx_2.10/src/calc_ider_wye.f
diff --git a/ccx_2.9/src/calc_residual_cross_split.f b/ccx_2.10/src/calc_residual_cross_split.f
similarity index 100%
rename from ccx_2.9/src/calc_residual_cross_split.f
rename to ccx_2.10/src/calc_residual_cross_split.f
diff --git a/ccx_2.9/src/calc_residual_tee.f b/ccx_2.10/src/calc_residual_tee.f
similarity index 100%
rename from ccx_2.9/src/calc_residual_tee.f
rename to ccx_2.10/src/calc_residual_tee.f
diff --git a/ccx_2.9/src/calc_residual_wye.f b/ccx_2.10/src/calc_residual_wye.f
similarity index 100%
rename from ccx_2.9/src/calc_residual_wye.f
rename to ccx_2.10/src/calc_residual_wye.f
diff --git a/ccx_2.9/src/calcbody.f b/ccx_2.10/src/calcbody.f
similarity index 100%
rename from ccx_2.9/src/calcbody.f
rename to ccx_2.10/src/calcbody.f
diff --git a/ccx_2.9/src/calccvel.f b/ccx_2.10/src/calccvel.f
similarity index 100%
rename from ccx_2.9/src/calccvel.f
rename to ccx_2.10/src/calccvel.f
diff --git a/ccx_2.9/src/calccvelcomp.f b/ccx_2.10/src/calccvelcomp.f
similarity index 89%
rename from ccx_2.9/src/calccvelcomp.f
rename to ccx_2.10/src/calccvelcomp.f
index 87e672a..f301171 100644
--- a/ccx_2.9/src/calccvelcomp.f
+++ b/ccx_2.10/src/calccvelcomp.f
@@ -30,6 +30,10 @@
real*8 t1l,vel(nef,0:5),cp,shcon(0:3,ntmat_,*),cvel(*),
& physcon(*)
!
+c$omp parallel default(none)
+c$omp& shared(nef,vel,ielmat,ntmat_,shcon,nshcon,physcon,cvel)
+c$omp& private(i,t1l,imat,cp)
+c$omp do
do i=1,nef
t1l=vel(i,0)
imat=ielmat(1,i)
@@ -39,8 +43,9 @@
! cv=cp-r
!
cvel(i)=cp-shcon(3,1,imat)
-c cvel(i)=cp
enddo
+c$omp end do
+c$omp end parallel
!
return
end
diff --git a/ccx_2.9/src/calccvfa.f b/ccx_2.10/src/calccvfa.f
similarity index 100%
rename from ccx_2.9/src/calccvfa.f
rename to ccx_2.10/src/calccvfa.f
diff --git a/ccx_2.9/src/calccvfacomp.f b/ccx_2.10/src/calccvfacomp.f
similarity index 89%
rename from ccx_2.9/src/calccvfacomp.f
rename to ccx_2.10/src/calccvfacomp.f
index ec10fef..68c4c0b 100644
--- a/ccx_2.9/src/calccvfacomp.f
+++ b/ccx_2.10/src/calccvfacomp.f
@@ -29,6 +29,10 @@
!
real*8 t1l,vfa(0:5,*),cp,shcon(0:3,ntmat_,*),cvfa(*),physcon(*)
!
+c$omp parallel default(none)
+c$omp& shared(nface,vfa,ielmat,ielfa,ntmat_,shcon,nshcon,physcon,cvfa)
+c$omp& private(i,t1l,imat,cp)
+c$omp do
do i=1,nface
t1l=vfa(0,i)
!
@@ -41,8 +45,9 @@
! cv=cp-r
!
cvfa(i)=cp-shcon(3,1,imat)
-c cvfa(i)=cp
enddo
+c$omp end do
+c$omp end parallel
!
return
end
diff --git a/ccx_2.9/src/calceigenvalues.f b/ccx_2.10/src/calceigenvalues.f
similarity index 100%
rename from ccx_2.9/src/calceigenvalues.f
rename to ccx_2.10/src/calceigenvalues.f
diff --git a/ccx_2.9/src/calcenergy.f b/ccx_2.10/src/calcenergy.f
similarity index 89%
rename from ccx_2.9/src/calcenergy.f
rename to ccx_2.10/src/calcenergy.f
index 5029820..0bc02a4 100644
--- a/ccx_2.9/src/calcenergy.f
+++ b/ccx_2.10/src/calcenergy.f
@@ -17,7 +17,7 @@
! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
!
subroutine calcenergy(ipkon,lakon,kon,co,ener,mi,ne,
- & thicke,ielmat,energyini,energy)
+ & thicke,ielmat,energyini,energy,ielprop,prop)
!
! calculates the energy in a *DYNAMIC calculation
!
@@ -27,9 +27,9 @@
!
integer ipkon(*),nelem,kon(*),mi(*),nope,indexe,i,j,k,
& konl(20),mint3d,jj,iflag,ne,ki,kl,ilayer,nlayer,kk,
- & nopes,ielmat(mi(3),*),mint2d
+ & nopes,ielmat(mi(3),*),mint2d,null,ielprop(*)
!
- real*8 ener(mi(1),*),enerinttot,enerint,co(3,*),
+ real*8 ener(mi(1),*),enerinttot,enerint,co(3,*),prop(*),
& xl(3,20),xi,et,ze,xsj,shp(4,20),weight,enerkintot,enerkin,
& a,gs(8,4),dlayer(4),tlayer(4),thickness,energyini(*),
& thicke(mi(3),*),xlayer(mi(3),4),shp2(7,8),xs2(3,7),xsj2(3),
@@ -38,6 +38,7 @@
include "gauss.f"
!
data iflag /2/
+ null=0
!
enerinttot=0.d0
enerkintot=0.d0
@@ -125,6 +126,13 @@
!
if(lakonl(4:5).eq.'8R') then
mint3d=1
+ elseif(lakonl(4:7).eq.'20RB') then
+ if((lakonl(8:8).eq.'R').or.(lakonl(8:8).eq.'C')) then
+ mint3d=50
+ else
+ call beamintscheme(lakonl,mint3d,ielprop(nelem),prop,
+ & null,xi,et,ze,weight)
+ endif
elseif((lakonl(4:4).eq.'8').or.
& (lakonl(4:6).eq.'20R')) then
if(lakonl(7:8).eq.'LC') then
@@ -150,6 +158,8 @@
enerint=ener(1,nelem)
endif
mint3d=0
+ else
+ cycle
endif
!
do jj=1,mint3d
@@ -158,6 +168,16 @@
et=gauss3d1(2,jj)
ze=gauss3d1(3,jj)
weight=weight3d1(jj)
+ elseif(lakonl(4:7).eq.'20RB') then
+ if((lakonl(8:8).eq.'R').or.(lakonl(8:8).eq.'C')) then
+ xi=gauss3d13(1,kk)
+ et=gauss3d13(2,kk)
+ ze=gauss3d13(3,kk)
+ weight=weight3d13(kk)
+ else
+ call beamintscheme(lakonl,mint3d,ielprop(nelem),prop,
+ & kk,xi,et,ze,weight)
+ endif
elseif((lakonl(4:4).eq.'8').or.
& (lakonl(4:6).eq.'20R'))
& then
diff --git a/ccx_2.9/src/calcgamma.f b/ccx_2.10/src/calcgamma.f
similarity index 57%
rename from ccx_2.9/src/calcgamma.f
rename to ccx_2.10/src/calcgamma.f
index 2ced8d9..ce42cf2 100644
--- a/ccx_2.9/src/calcgamma.f
+++ b/ccx_2.10/src/calcgamma.f
@@ -16,8 +16,8 @@
! along with this program; if not, write to the Free Software
! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
!
- subroutine calcgamma(nface,ielfa,vel,gradvfa,gamma,xlet,
- & xxn,xxj,ipnei,betam,nef)
+ subroutine calcgamma(nface,ielfa,vel,gradvel,gamma,xlet,
+ & xxn,xxj,ipnei,betam,nef,flux)
!
! determine gamma:
! upwind difference: gamma=0
@@ -27,8 +27,8 @@
!
integer nface,ielfa(4,*),i,j,indexf,ipnei(*),iel1,iel2,nef
!
- real*8 vel(nef,0:5),gradvfa(3,3,*),xxn(3,*),xxj(3,*),vud,vcd,
- & gamma(*),phic,xlet(*),betam
+ real*8 vel(nef,0:5),gradvel(3,3,*),xxn(3,*),xxj(3,*),vud,vcd,
+ & gamma(*),phic,xlet(*),betam,flux(*),xflux
!
do i=1,nface
iel2=ielfa(2,i)
@@ -39,21 +39,36 @@
iel1=ielfa(1,i)
j=ielfa(4,i)
indexf=ipnei(iel1)+j
+ xflux=flux(indexf)
!
vcd=(vel(iel2,1)-vel(iel1,1))*xxn(1,indexf)+
& (vel(iel2,2)-vel(iel1,2))*xxn(2,indexf)+
& (vel(iel2,3)-vel(iel1,3))*xxn(3,indexf)
!
- vud=2.d0*xlet(indexf)*
- & (xxn(1,indexf)*(gradvfa(1,1,i)*xxj(1,indexf)+
- & gradvfa(1,2,i)*xxj(2,indexf)+
- & gradvfa(1,3,i)*xxj(3,indexf))+
- & xxn(2,indexf)*(gradvfa(2,1,i)*xxj(1,indexf)+
- & gradvfa(2,2,i)*xxj(2,indexf)+
- & gradvfa(2,3,i)*xxj(3,indexf))+
- & xxn(3,indexf)*(gradvfa(3,1,i)*xxj(1,indexf)+
- & gradvfa(3,2,i)*xxj(2,indexf)+
- & gradvfa(3,3,i)*xxj(3,indexf)))
+ if(xflux.ge.0.d0) then
+!
+ vud=2.d0*xlet(indexf)*
+ & (xxn(1,indexf)*(gradvel(1,1,iel1)*xxj(1,indexf)+
+ & gradvel(1,2,iel1)*xxj(2,indexf)+
+ & gradvel(1,3,iel1)*xxj(3,indexf))+
+ & xxn(2,indexf)*(gradvel(2,1,iel1)*xxj(1,indexf)+
+ & gradvel(2,2,iel1)*xxj(2,indexf)+
+ & gradvel(2,3,iel1)*xxj(3,indexf))+
+ & xxn(3,indexf)*(gradvel(3,1,iel1)*xxj(1,indexf)+
+ & gradvel(3,2,iel1)*xxj(2,indexf)+
+ & gradvel(3,3,iel1)*xxj(3,indexf)))
+ else
+ vud=2.d0*xlet(indexf)*
+ & (xxn(1,indexf)*(gradvel(1,1,iel2)*xxj(1,indexf)+
+ & gradvel(1,2,iel2)*xxj(2,indexf)+
+ & gradvel(1,3,iel2)*xxj(3,indexf))+
+ & xxn(2,indexf)*(gradvel(2,1,iel2)*xxj(1,indexf)+
+ & gradvel(2,2,iel2)*xxj(2,indexf)+
+ & gradvel(2,3,iel2)*xxj(3,indexf))+
+ & xxn(3,indexf)*(gradvel(3,1,iel2)*xxj(1,indexf)+
+ & gradvel(3,2,iel2)*xxj(2,indexf)+
+ & gradvel(3,3,iel2)*xxj(3,indexf)))
+ endif
c write(*,*) xlet(indexf)
c write(*,*) xxn(1,indexf),xxn(2,indexf),xxn(3,indexf)
c write(*,*) xxj(1,indexf),xxj(2,indexf),xxj(3,indexf)
diff --git a/ccx_2.9/src/calcgammat.f b/ccx_2.10/src/calcgammat.f
similarity index 100%
rename from ccx_2.9/src/calcgammat.f
rename to ccx_2.10/src/calcgammat.f
diff --git a/ccx_2.9/src/calcgradpel.f b/ccx_2.10/src/calcgradpel.f
similarity index 81%
rename from ccx_2.9/src/calcgradpel.f
rename to ccx_2.10/src/calcgradpel.f
index 280b425..46cd644 100644
--- a/ccx_2.9/src/calcgradpel.f
+++ b/ccx_2.10/src/calcgradpel.f
@@ -16,8 +16,8 @@
! along with this program; if not, write to the Free Software
! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
!
- subroutine calcgradpel(nef,lakon,ipnei,vfa,area,xxn,gradpel,neifa,
- & volume)
+ subroutine calcgradpel(nef,lakonf,ipnei,vfa,area,xxn,gradpel,
+ & neifa,volume)
!
! calculation of the gradient of the velocity at the center
! of the elements from the velocity values at the neighboring
@@ -25,17 +25,21 @@
!
implicit none
!
- character*8 lakon(*)
+ character*8 lakonf(*)
!
integer nef,ipnei(*),neifa(*),i,j,l,indexf,ifa,numfaces
!
real*8 vfa(0:5,*),area(*),xxn(3,*),gradpel(3,*),volume(*)
!
+c$omp parallel default(none)
+c$omp& shared(nef,ipnei,lakonf,neifa,gradpel,vfa,area,xxn,volume)
+c$omp& private(i,indexf,numfaces,j,ifa)
+c$omp do
do i=1,nef
indexf=ipnei(i)
- if(lakon(i)(4:4).eq.'8') then
+ if(lakonf(i)(4:4).eq.'8') then
numfaces=6
- elseif(lakon(i)(4:4).eq.'6') then
+ elseif(lakonf(i)(4:4).eq.'6') then
numfaces=5
else
numfaces=4
@@ -55,6 +59,8 @@
gradpel(l,i)=gradpel(l,i)/volume(i)
enddo
enddo
+c$omp end do
+c$omp end parallel
!
return
end
diff --git a/ccx_2.9/src/calcgradtel.f b/ccx_2.10/src/calcgradtel.f
similarity index 81%
rename from ccx_2.9/src/calcgradtel.f
rename to ccx_2.10/src/calcgradtel.f
index 5d54441..b3ef926 100644
--- a/ccx_2.9/src/calcgradtel.f
+++ b/ccx_2.10/src/calcgradtel.f
@@ -16,8 +16,8 @@
! along with this program; if not, write to the Free Software
! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
!
- subroutine calcgradtel(nef,lakon,ipnei,vfa,area,xxn,gradtel,neifa,
- & volume)
+ subroutine calcgradtel(nef,lakonf,ipnei,vfa,area,xxn,gradtel,
+ & neifa,volume)
!
! calculation of the gradient of the velocity at the center
! of the elements from the velocity values at the neighboring
@@ -25,17 +25,21 @@
!
implicit none
!
- character*8 lakon(*)
+ character*8 lakonf(*)
!
integer nef,ipnei(*),neifa(*),i,j,l,indexf,ifa,numfaces
!
real*8 vfa(0:5,*),area(*),xxn(3,*),gradtel(3,*),volume(*)
!
+c$omp parallel default(none)
+c$omp& shared(nef,ipnei,lakonf,neifa,gradtel,vfa,area,xxn,volume)
+c$omp& private(i,indexf,numfaces,j,ifa)
+c$omp do
do i=1,nef
indexf=ipnei(i)
- if(lakon(i)(4:4).eq.'8') then
+ if(lakonf(i)(4:4).eq.'8') then
numfaces=6
- elseif(lakon(i)(4:4).eq.'6') then
+ elseif(lakonf(i)(4:4).eq.'6') then
numfaces=5
else
numfaces=4
@@ -55,6 +59,8 @@
gradtel(l,i)=gradtel(l,i)/volume(i)
enddo
enddo
+c$omp end do
+c$omp end parallel
!
return
end
diff --git a/ccx_2.9/src/calcgradvel.f b/ccx_2.10/src/calcgradvel.f
similarity index 78%
rename from ccx_2.9/src/calcgradvel.f
rename to ccx_2.10/src/calcgradvel.f
index 375803b..b75b748 100644
--- a/ccx_2.9/src/calcgradvel.f
+++ b/ccx_2.10/src/calcgradvel.f
@@ -16,8 +16,8 @@
! along with this program; if not, write to the Free Software
! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
!
- subroutine calcgradvel(ne,lakon,ipnei,vfa,area,xxn,gradvel,neifa,
- & volume)
+ subroutine calcgradvel(nef,lakonf,ipnei,vfa,area,xxn,gradvel,
+ & neifa,volume)
!
! calculation of the gradient of the velocity at the center
! of the elements from the velocity values at the neighboring
@@ -25,17 +25,21 @@
!
implicit none
!
- character*8 lakon(*)
+ character*8 lakonf(*)
!
- integer ne,ipnei(*),neifa(*),i,j,k,l,indexf,ifa,numfaces
+ integer nef,ipnei(*),neifa(*),i,j,k,l,indexf,ifa,numfaces
!
real*8 vfa(0:5,*),area(*),xxn(3,*),gradvel(3,3,*),volume(*)
!
- do i=1,ne
+c$omp parallel default(none)
+c$omp& shared(nef,ipnei,lakonf,neifa,gradvel,vfa,area,xxn,volume)
+c$omp& private(i,indexf,numfaces,j,ifa,k,l)
+c$omp do
+ do i=1,nef
indexf=ipnei(i)
- if(lakon(i)(4:4).eq.'8') then
+ if(lakonf(i)(4:4).eq.'8') then
numfaces=6
- elseif(lakon(i)(4:4).eq.'6') then
+ elseif(lakonf(i)(4:4).eq.'6') then
numfaces=5
else
numfaces=4
@@ -56,10 +60,11 @@
do k=1,3
do l=1,3
gradvel(k,l,i)=gradvel(k,l,i)/volume(i)
-c write(*,*) 'calcgradvel ',i,k,l,gradvel(k,l,i)
enddo
enddo
enddo
+c$omp end do
+c$omp end parallel
!
return
end
diff --git a/ccx_2.9/src/calcguesstincf.f b/ccx_2.10/src/calcguesstincf.f
similarity index 100%
rename from ccx_2.9/src/calcguesstincf.f
rename to ccx_2.10/src/calcguesstincf.f
diff --git a/ccx_2.9/src/calch0interface.f b/ccx_2.10/src/calch0interface.f
similarity index 100%
rename from ccx_2.9/src/calch0interface.f
rename to ccx_2.10/src/calch0interface.f
diff --git a/ccx_2.9/src/calchcel.f b/ccx_2.10/src/calchcel.f
similarity index 100%
rename from ccx_2.9/src/calchcel.f
rename to ccx_2.10/src/calchcel.f
diff --git a/ccx_2.9/src/calchcfa.f b/ccx_2.10/src/calchcfa.f
similarity index 89%
rename from ccx_2.9/src/calchcfa.f
rename to ccx_2.10/src/calchcfa.f
index 3d9bf9b..7ba6e0a 100644
--- a/ccx_2.9/src/calchcfa.f
+++ b/ccx_2.10/src/calchcfa.f
@@ -28,6 +28,10 @@
!
real*8 t1l,vfa(0:5,*),cond,cocon(0:6,ntmat_,*),hcfa(*)
!
+c$omp parallel default(none)
+c$omp& shared(nface,vfa,ielmat,ielfa,ntmat_,cocon,ncocon,hcfa)
+c$omp& private(i,t1l,imat,cond)
+c$omp do
do i=1,nface
t1l=vfa(0,i)
!
@@ -35,9 +39,10 @@
!
imat=ielmat(1,ielfa(1,i))
call materialdata_cond(imat,ntmat_,t1l,cocon,ncocon,cond)
-c write(*,*) 'calchcfa ',i,cond
hcfa(i)=cond
enddo
+c$omp end do
+c$omp end parallel
!
return
end
diff --git a/ccx_2.9/src/calcinitialflux.f b/ccx_2.10/src/calcinitialflux.f
similarity index 100%
rename from ccx_2.9/src/calcinitialflux.f
rename to ccx_2.10/src/calcinitialflux.f
diff --git a/ccx_2.9/src/calcmac.f b/ccx_2.10/src/calcmac.f
similarity index 100%
rename from ccx_2.9/src/calcmac.f
rename to ccx_2.10/src/calcmac.f
diff --git a/ccx_2.9/src/calcmass.f b/ccx_2.10/src/calcmass.f
similarity index 89%
rename from ccx_2.9/src/calcmass.f
rename to ccx_2.10/src/calcmass.f
index 627a7eb..b027af1 100644
--- a/ccx_2.9/src/calcmass.f
+++ b/ccx_2.10/src/calcmass.f
@@ -18,7 +18,7 @@
!
subroutine calcmass(ipkon,lakon,kon,co,
& mi,nelem,ne,thicke,ielmat,nope,t0,t1,rhcon,nrhcon,ntmat_,
- & ithermal,csmasstot)
+ & ithermal,csmasstot,ielprop,prop)
!
! calculates the mass of element "nelem"
!
@@ -28,9 +28,9 @@
!
integer ipkon(*),nelem,kon(*),mi(*),nope,indexe,i,j,k,konl(20),
& mint3d,jj,iflag,ne,ki,kl,ilayer,nlayer,kk,ntmat_,i1,imat,
- & nopes,ielmat(mi(3),*),mint2d,nrhcon(*),ithermal
+ & nopes,ielmat(mi(3),*),mint2d,nrhcon(*),ithermal,null,ielprop(*)
!
- real*8 csmasstot,csmass,co(3,*),
+ real*8 csmasstot,csmass,co(3,*),prop(*),
& xl(3,20),xi,et,ze,xsj,shp(4,20),weight,
& a,gs(8,4),dlayer(4),tlayer(4),thickness,t0l,t1l,rho,
& thicke(mi(3),*),xlayer(mi(3),4),shp2(7,8),xs2(3,7),xsj2(3),
@@ -39,6 +39,7 @@
include "gauss.f"
!
data iflag /2/
+ null=0
!
if(ipkon(nelem).lt.0) return
!
@@ -118,6 +119,14 @@
!
if(lakon(nelem)(4:5).eq.'8R') then
mint3d=1
+ elseif(lakon(nelem)(4:7).eq.'20RB') then
+ if((lakon(nelem)(8:8).eq.'R').or.
+ & (lakon(nelem)(8:8).eq.'C')) then
+ mint3d=50
+ else
+ call beamintscheme(lakon(nelem),mint3d,ielprop(nelem),prop,
+ & null,xi,et,ze,weight)
+ endif
elseif((lakon(nelem)(4:4).eq.'8').or.
& (lakon(nelem)(4:6).eq.'20R')) then
if(lakon(nelem)(7:8).eq.'LC') then
@@ -145,6 +154,17 @@
et=gauss3d1(2,jj)
ze=gauss3d1(3,jj)
weight=weight3d1(jj)
+ elseif(lakon(nelem)(4:7).eq.'20RB') then
+ if((lakon(nelem)(8:8).eq.'R').or.
+ & (lakon(nelem)(8:8).eq.'C')) then
+ xi=gauss3d13(1,kk)
+ et=gauss3d13(2,kk)
+ ze=gauss3d13(3,kk)
+ weight=weight3d13(kk)
+ else
+ call beamintscheme(lakon(nelem),mint3d,ielprop(nelem),
+ & prop,kk,xi,et,ze,weight)
+ endif
elseif((lakon(nelem)(4:4).eq.'8').or.
& (lakon(nelem)(4:6).eq.'20R'))
& then
diff --git a/ccx_2.10/src/calcmatwavspeed.f b/ccx_2.10/src/calcmatwavspeed.f
new file mode 100644
index 0000000..3237ff5
--- /dev/null
+++ b/ccx_2.10/src/calcmatwavspeed.f
@@ -0,0 +1,179 @@
+!
+! CalculiX - A 3-dimensional finite element program
+! Copyright (C) 1998-2007 Guido Dhondt
+!
+! This program is free software; you can redistribute it and/or
+! modify it under the terms of the GNU General Public License as
+! published by the Free Software Foundation(version 2);
+!
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program; if not, write to the Free Software
+! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+!
+ subroutine calcmatwavspeed(ne0,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)
+!
+! **************
+! Calculates the propagation wave speed in a material, selecting
+! appropiate procedure between isotropic, single crystals, and
+! anisotropic materials. All other cases of orthotropy are treated
+! as anisotropic.
+
+! Based on the procedure in:
+! C. Lane. The Development of a 2D Ultrasonic Array Inspection
+! for Single Crystal Turbine Blades.
+! Switzerland: Springer International Publishing, 2014.
+!
+ implicit none
+!
+ character*80 matname(*),amat
+ character*8 lakon(*),lakonl
+!
+ integer i,i1,nelem,ne0,nelcon(2,*),nrhcon(*),nalcon(2,*),imat,
+ & ntmat_,ithermal,mattyp,ihyper,istiff,kode,mi(*),kk,
+ & nplicon(0:ntmat_,*),nplkcon(0:ntmat_,*),ncmat_,iorth,
+ & ielmat(mi(3),*),nope,iorien,ipkon(*),
+ & konl(26),nopered,npmat_,nmat
+!
+ real*8 elas(21),wavespeed(*),rhcon(0:1,ntmat_,*) ,
+ & alcon(0:6,ntmat_,*),coords(3),orab(7,*),rho,alzero(*),
+ & t0l,t1l,elconloc(21),eth(6),plicon(0:2*npmat_,ntmat_,*),
+ & plkcon(0:2*npmat_,ntmat_,*),plconloc(802),dtime,
+ & xstiff(27,mi(1),*),elcon(0:ncmat_,ntmat_,*),
+ & t0(*),t1(*),shp(4,26),vold(0:mi(2),*),tt,
+ & e,un,um,al,wavspd
+!
+ write(*,*)'++CMT: Calculating Material Wave Speeds...'
+ write(*,*)
+!
+! initialization of wavespeed
+!
+ do i=1,nmat
+ wavespeed(i)=-1.d0
+ enddo
+!
+! ** DO per element
+!
+ do nelem=1,ne0
+ if(ipkon(nelem).lt.0) cycle
+!
+ lakonl=lakon(nelem)
+ imat=ielmat(1,nelem)
+ amat=matname(imat)
+ wavspd=wavespeed(imat)
+!
+ if(lakonl(1:2).ne.'ES') then
+!
+! orientation is not important for the wave speed
+!
+ iorien=0
+!
+ if(nelcon(1,imat).lt.0) then
+ ihyper=1
+ else
+ ihyper=0
+ endif
+!
+! calculating the temperature in the integration
+! point
+!
+ kk=1 ! Only 1 integration point is considered, CENTER
+ t0l=0.d0
+ t1l=0.d0
+ if(ithermal.eq.1) then
+ if(lakonl(4:5).eq.'8 ') then
+ do i1=1,nope
+ t0l=t0l+t0(konl(i1))/8.d0
+ t1l=t1l+t1(konl(i1))/8.d0
+ enddo
+ elseif(lakonl(4:6).eq.'20 ')then
+ nopered=20
+ call lintemp(t0,t1,konl,nopered,kk,t0l,t1l)
+ else
+ do i1=1,nope
+ t0l=t0l+shp(4,i1)*t0(konl(i1))
+ t1l=t1l+shp(4,i1)*t1(konl(i1))
+ enddo
+ endif
+ elseif(ithermal.ge.2) then
+ if(lakonl(4:5).eq.'8 ') then
+ do i1=1,nope
+ t0l=t0l+t0(konl(i1))/8.d0
+ t1l=t1l+vold(0,konl(i1))/8.d0
+ enddo
+ elseif(lakonl(4:6).eq.'20 ')then
+ nopered=20
+ call lintemp_th(t0,vold,konl,nopered,kk,t0l,t1l,mi)
+ else
+ do i1=1,nope
+ t0l=t0l+shp(4,i1)*t0(konl(i1))
+ t1l=t1l+shp(4,i1)*vold(0,konl(i1))
+ enddo
+ endif
+ endif
+ tt=t1l-t0l
+!
+ kode=nelcon(1,imat)
+
+! material data and local stiffness matrix
+!
+ istiff=1
+ call materialdata_me(elcon,nelcon,rhcon,nrhcon,alcon,nalcon,
+ & imat,amat,iorien,coords,orab,ntmat_,elas,rho,
+ & nelem,ithermal,alzero,mattyp,t0l,t1l,
+ & ihyper,istiff,elconloc,eth,kode,plicon,
+ & nplicon,plkcon,nplkcon,npmat_,
+ & plconloc,mi(1),dtime,nelem,kk,
+ & xstiff,ncmat_)
+!
+ if(mattyp.eq.1) then
+ e=elas(1)
+ un=elas(2)
+ um=e/(1.d0+un)
+ al=un*um/(1.d0-2.d0*un)
+ um=um/2.d0
+ wavspd=max(wavspd,
+ & dsqrt((e*(1-un))/((1+un)*(1-2*un)*rho)))
+ elseif(mattyp.eq.2) then
+!
+! single crystal
+!
+ if(((elas(1).eq.elas(3)).and.(elas(1).eq.elas(6)).and.
+ & (elas(3).eq.elas(6))).and.
+ & ((elas(2).eq.elas(4)).and.(elas(2).eq.elas(5)).and.
+ & (elas(4).eq.elas(5))).and.
+ & ((elas(7).eq.elas(8)).and.(elas(7).eq.elas(9)).and.
+ & (elas(8).eq.elas(9)))) then
+ wavspd=max(wavspd,dsqrt((1/3.)*(elas(1)+2.0*elas(2)+
+ & 4.0*elas(7))/rho))
+ wavspd=max(wavspd,dsqrt((1/2.)*
+ & (elas(1)+elas(2)+2.0*elas(7))/rho))
+ wavspd=max(wavspd,dsqrt(elas(1)/rho))
+ else
+ iorth=1
+ call anisomaxwavspd(elas,rho,iorth,wavspd )
+ endif
+ elseif(mattyp.eq.3) then
+ iorth=0
+ call anisomaxwavspd(elas,rho,iorth,wavspd)
+ endif
+ wavespeed(imat)=wavspd
+ endif
+ enddo
+!
+ do i=1,nmat
+ write(*,*) 'Wave Speed for mat. ',i,wavespeed(i)
+ enddo
+ write(*,*)
+!
+ return
+ end
diff --git a/ccx_2.9/src/calcpel.f b/ccx_2.10/src/calcpel.f
similarity index 100%
rename from ccx_2.9/src/calcpel.f
rename to ccx_2.10/src/calcpel.f
diff --git a/ccx_2.9/src/calcresidual.c b/ccx_2.10/src/calcresidual.c
similarity index 100%
rename from ccx_2.9/src/calcresidual.c
rename to ccx_2.10/src/calcresidual.c
diff --git a/ccx_2.9/src/calcresidual_em.c b/ccx_2.10/src/calcresidual_em.c
similarity index 100%
rename from ccx_2.9/src/calcresidual_em.c
rename to ccx_2.10/src/calcresidual_em.c
diff --git a/ccx_2.9/src/calcrhoel.f b/ccx_2.10/src/calcrhoel.f
similarity index 100%
rename from ccx_2.9/src/calcrhoel.f
rename to ccx_2.10/src/calcrhoel.f
diff --git a/ccx_2.9/src/calcrhoelcomp.f b/ccx_2.10/src/calcrhoelcomp.f
similarity index 90%
rename from ccx_2.9/src/calcrhoelcomp.f
rename to ccx_2.10/src/calcrhoelcomp.f
index be57489..679266d 100644
--- a/ccx_2.9/src/calcrhoelcomp.f
+++ b/ccx_2.10/src/calcrhoelcomp.f
@@ -29,12 +29,17 @@
!
real*8 t1l,vel(nef,0:5),shcon(0:3,ntmat_,*)
!
+c$omp parallel default(none)
+c$omp& shared(nef,vel,ielmat,shcon)
+c$omp& private(i,t1l,imat)
+c$omp do
do i=1,nef
t1l=vel(i,0)
imat=ielmat(1,i)
vel(i,5)=vel(i,4)/(shcon(3,1,imat)*t1l)
-c vel(i,5)=1.d0
enddo
+c$omp end do
+c$omp end parallel
!
return
end
diff --git a/ccx_2.9/src/calcrhofa.f b/ccx_2.10/src/calcrhofa.f
similarity index 95%
rename from ccx_2.9/src/calcrhofa.f
rename to ccx_2.10/src/calcrhofa.f
index 2d5f307..ab6bb68 100644
--- a/ccx_2.9/src/calcrhofa.f
+++ b/ccx_2.10/src/calcrhofa.f
@@ -38,9 +38,7 @@
call materialdata_rho(rhcon,nrhcon,imat,rho,t1l,ntmat_,
& ithermal)
vfa(5,i)=rho
-c write(*,*) 'calcrhofa rho',i,rho
enddo
-c write(*,*)
!
return
end
diff --git a/ccx_2.9/src/calcrhofacomp.f b/ccx_2.10/src/calcrhofacomp.f
similarity index 90%
copy from ccx_2.9/src/calcrhofacomp.f
copy to ccx_2.10/src/calcrhofacomp.f
index c9df37d..b9a432c 100644
--- a/ccx_2.9/src/calcrhofacomp.f
+++ b/ccx_2.10/src/calcrhofacomp.f
@@ -29,6 +29,10 @@
!
real*8 t1l,vfa(0:5,*),shcon(0:3,ntmat_,*)
!
+c$omp parallel default(none)
+c$omp& shared(nface,vfa,ielmat,ielfa,shcon)
+c$omp& private(i,t1l,imat)
+c$omp do
do i=1,nface
t1l=vfa(0,i)
!
@@ -36,9 +40,9 @@
!
imat=ielmat(1,ielfa(1,i))
vfa(5,i)=vfa(4,i)/(shcon(3,1,imat)*t1l)
-c write(*,*) 'calcrhofacomp ',i,vfa(5,i)
-c vfa(5,i)=1.d0
enddo
+c$omp end do
+c$omp end parallel
!
return
end
diff --git a/ccx_2.9/src/calcrhofacomp.f b/ccx_2.10/src/calcrhofacompisen.f
similarity index 60%
rename from ccx_2.9/src/calcrhofacomp.f
rename to ccx_2.10/src/calcrhofacompisen.f
index c9df37d..81be944 100644
--- a/ccx_2.9/src/calcrhofacomp.f
+++ b/ccx_2.10/src/calcrhofacompisen.f
@@ -16,28 +16,33 @@
! along with this program; if not, write to the Free Software
! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
!
- subroutine calcrhofacomp(nface,vfa,shcon,ielmat,ntmat_,
- & mi,ielfa)
+ subroutine calcrhofacompisen(nface,vfa,shcon,ielmat,ntmat_,
+ & mi,ielfa,cvfa,velo,nef)
!
! calculation of the density at the face centers
! (compressible fluids)
!
implicit none
!
- integer nface,i,imat,ntmat_,mi(*),
- & ielmat(mi(3),*),ielfa(4,*)
+ integer nface,i,imat,ntmat_,mi(*),nef,velo(nef,0:5),
+ & ielmat(mi(3),*),ielfa(4,*),j
!
- real*8 t1l,vfa(0:5,*),shcon(0:3,ntmat_,*)
+ real*8 t1l,vfa(0:5,*),shcon(0:3,ntmat_,*),cvfa(*)
!
do i=1,nface
t1l=vfa(0,i)
+ j=ielfa(1,i)
!
! take the material of the first adjacent element
!
imat=ielmat(1,ielfa(1,i))
- vfa(5,i)=vfa(4,i)/(shcon(3,1,imat)*t1l)
-c write(*,*) 'calcrhofacomp ',i,vfa(5,i)
-c vfa(5,i)=1.d0
+ vfa(5,i)=vfa(4,i)/(shcon(3,1,imat)*
+c & (10.5d0-(vfa(1,i)**2+vfa(2,i)**2+vfa(3,i)**2)/2.d0))
+ & (5.98696d0-(vfa(1,i)**2+vfa(2,i)**2+vfa(3,i)**2)/2.d0))
+c & (1.41827d0-(vfa(1,i)**2+vfa(2,i)**2+vfa(3,i)**2)/2.d0))
+c vfa(5,i)=vfa(4,i)/(shcon(3,1,imat)*
+c & (velo(j,0)+(velo(j,1)**2+velo(j,2)**2+velo(j,3)**2)/2.d0-
+c &(vfa(1,i)**2+vfa(2,i)**2+vfa(3,i)**2)/2.d0))
enddo
!
return
diff --git a/ccx_2.10/src/calcstabletimeinccont.f b/ccx_2.10/src/calcstabletimeinccont.f
new file mode 100644
index 0000000..be19462
--- /dev/null
+++ b/ccx_2.10/src/calcstabletimeinccont.f
@@ -0,0 +1,182 @@
+!
+! CalculiX - A 3-dimensional finite element program
+! Copyright (C) 1998-2007 Guido Dhondt
+!
+! This program is free software; you can redistribute it and/or
+! modify it under the terms of the GNU General Public License as
+! published by the Free Software Foundation(version 2);
+!
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program; if not, write to the Free Software
+! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+!
+ subroutine calcstabletimeinccont(ne,lakon,kon,ipkon,mi,
+ & ielmat,elcon,mortar,adb,alpha,nactdof,springarea,
+ & ne0,ntmat_,ncmat_,dtcont)
+!
+! Calculates the critical time increment (CTI) for contact
+! spring elements based on the Courant
+! Criterion for Explicit Dynamics calculations.
+!
+ implicit none
+!
+ character*8 lakon(*),lakonl
+!
+ integer j,ne,nope,kon(*),ipkon(*),indexe,nelem,
+ & ncmat_,ntmat_,mi(*),ielmat(mi(3),*),imat,mortar,
+ & indexn,nactdof(0:mi(2),*),ne0,nopem
+!
+ real*8 elcon(0:ncmat_,ntmat_,*),safefac,xk,adb(*),alpha,bet,gam,
+ & critom,damping,springms,springmm,springfac,dtcont,xmacont,
+ & springarea(2,*),areaslav
+!
+ dtcont=1.d30
+ safefac=0.80d0
+!
+ xmacont=0.0d0
+!
+ damping=0
+!
+ bet=(1.-alpha)*(1.-alpha)/4.
+ gam=0.5-alpha
+!
+! Omega Critical
+! Om_cr=dt*freq_max
+!
+ critom=dsqrt(damping*damping*(1+2*alpha*(1-gam))
+ & *(1+2*alpha*(1-gam))
+ & + 2*(gam+2*alpha*(gam-bet)))
+ critom=0.98*(-damping*(1+2*alpha*(1-gam))+critom)
+ & /(gam+2*alpha*(gam-bet)) !eq 25 miranda
+!
+! ** DO per element
+!
+ do nelem=ne0+1,ne
+ indexe=ipkon(nelem)
+ lakonl=lakon(nelem)
+ imat=ielmat(1,nelem)
+!
+ xk=elcon(2,1,imat)
+!
+ springmm=0.0d0
+ springms=0.0d0
+!
+ if(mortar.eq.0) then
+!
+! node-to-face
+!
+! nope is the total number of nodes:
+! master nodes+1 slave node
+! (notice -47 instead of -48)
+!
+ nope=ichar(lakonl(8:8))-47
+ springfac=1.d0
+!
+ do indexn=1,nope
+ xmacont=0.0d0
+!
+ do j=1,3
+ if(nactdof(j,kon(indexe+indexn)).ne.0)then
+ xmacont=adb(nactdof(j,kon(indexe+indexn)))
+ exit
+ endif
+ enddo
+!
+ if(indexn.eq.nope)then
+ springms=springms+xmacont
+!
+! mean mass at master nodes
+!
+ springmm=springmm/(nope-1.0d0)
+ else
+ springmm=springmm+xmacont
+ endif
+ enddo
+!
+ areaslav=springarea(1,kon(indexe+nope+1))
+ xk=xk*areaslav
+!
+! checking whether mass or slave side is constrained
+!
+ if((springmm.le.0.d0).and.(springms.le.0.d0)) then
+ cycle
+ elseif(springmm.le.0.d0) then
+ springmm=springms
+ elseif(springms.le.0.d0) then
+ springms=springmm
+ endif
+!
+ elseif(mortar.eq.1) then
+!
+! face-to-face
+!
+ nopem=ichar(lakonl(8:8))-48
+ springfac=0.1d0
+!
+ do indexn=1,kon(indexe)
+!
+ xmacont=0.0d0
+ do j=1,3
+ if(nactdof(j,kon(indexe+indexn)).ne.0)then
+ xmacont=adb(nactdof(j,kon(indexe+indexn)))
+ exit
+ endif
+ enddo
+ if(indexn.gt.nopem)then !slave
+ springms=springms+xmacont
+ else !master
+ springmm=springmm+xmacont
+ endif
+ enddo
+!
+! mean mass at slave and master nodes
+!
+ springms=springms/(kon(indexe)-nopem)
+ springmm=springmm/nopem
+!
+ areaslav=springarea(1,kon(1+indexe+kon(indexe)))
+ xk=xk*areaslav
+!
+! checking whether mass or slave side is constrained
+!
+ if((springmm.le.0.d0).and.(springms.le.0.d0)) then
+ cycle
+ elseif(springmm.le.0.d0) then
+ springmm=springms
+ elseif(springms.le.0.d0) then
+ springms=springmm
+ endif
+ endif
+!
+! linear pressure-overclosure
+!
+ if(int(elcon(3,1,imat)).eq.2) then
+!
+ springmm=springmm/2.0d0
+ springms=springms/2.0d0
+!
+ dtcont =
+ & min(dtcont,
+ & springfac*critom*dsqrt((springmm*springms)/
+ & ((springmm+springms)*xk)))
+!
+ else
+ write(*,*) '*ERROR in calcstabletimeinccont:'
+ write(*,*) ' in explicit dynamic calculations'
+ write(*,*) ' only linear pressure-overclosure'
+ write(*,*) ' is allowed'
+ call exit(201)
+ endif
+ enddo
+! ** ENDDO per element
+!
+ dtcont=dtcont* safefac
+!
+ return
+ end
diff --git a/ccx_2.10/src/calcstabletimeincvol.f b/ccx_2.10/src/calcstabletimeincvol.f
new file mode 100644
index 0000000..c9dd32c
--- /dev/null
+++ b/ccx_2.10/src/calcstabletimeincvol.f
@@ -0,0 +1,259 @@
+!
+! CalculiX - A 3-dimensional finite element program
+! Copyright (C) 1998-2007 Guido Dhondt
+!
+! This program is free software; you can redistribute it and/or
+! modify it under the terms of the GNU General Public License as
+! published by the Free Software Foundation(version 2);
+!
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program; if not, write to the Free Software
+! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+!
+ subroutine calcstabletimeincvol(ne0,lakon,co,kon,ipkon,mi,
+ & ielmat,dtvol,alpha,wavespeed)
+!
+! Calculates the critical time increment (CTI) based on the Courant
+! Criterion for Explicit Dynamics calculations. Temperature is
+! assumed averaged from the centroid of the element and material
+! wave propagation speeds must be calculated before.
+!
+ implicit none
+!
+ character*8 lakon(*),lakonl
+!
+ integer i,j,ne0,nope,kon(*),ipkon(*),indexe,konl(26),nelem,
+ & iflag,nopes,nfaces,ig,ifaceq(8,6),ifacet(6,4),ifacew(8,5),
+ & mi(*),ielmat(mi(3),*),imat,elemmin
+!
+ real*8 xi,et,ze,weight,co(3,*),xl(3,26),xsj,shp(4,26),xl2(3,9),
+ & xsj2(3),xs2(3,7),shp2(7,9),hmin,area,volume,
+ & wavspd,dtvol,safefac,alpha,bet,gam,critom,damping,
+ & wavespeed(*),geomfac,quadfac
+!
+ data ifaceq /4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/
+ data ifacet /1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/
+ data ifacew /1,3,2,9,8,7,0,0,
+ & 4,5,6,10,11,12,0,0,
+ & 1,2,5,4,7,14,10,13,
+ & 2,3,6,5,8,15,11,14,
+ & 4,6,3,1,12,15,9,13/
+!
+ include "gauss.f"
+!
+ iflag=2
+ dtvol=1.d30
+ safefac=0.80d0
+ quadfac=0.3d0
+!
+ damping=0
+!
+ bet=(1.d0-alpha)*(1.d0-alpha)/4.d0
+ gam=0.5d0-alpha
+!
+! Omega Critical
+! Om_cr=dt*freq_max
+!
+ critom=dsqrt(damping*damping*(1+2*alpha*(1-gam))
+ & *(1+2*alpha*(1-gam))
+ & +2*(gam+2*alpha*(gam-bet)) )
+ critom=0.98*(-damping*(1+2*alpha*(1-gam))+critom)
+ & /(gam+2*alpha*(gam-bet)) !eq 25 miranda
+!
+! ** DO per element
+ do nelem=1,ne0
+ if(ipkon(nelem).lt.0) cycle
+ indexe=ipkon(nelem)
+!
+ lakonl=lakon(nelem)
+ imat=ielmat(1,nelem)
+!
+ geomfac=1.d0
+!
+ if(lakon(nelem)(4:5).eq.'20')then
+!
+ nope=20
+ nopes=8
+ nfaces=6
+ geomfac=quadfac
+ elseif(lakon(nelem)(4:4).eq.'8') then
+ nope=8
+ nopes=4
+ nfaces=6
+ elseif(lakon(nelem)(4:5).eq.'10')then
+ nope=10
+ nopes=6
+ nfaces=4
+ geomfac=quadfac
+ elseif(lakon(nelem)(4:4).eq.'4') then
+ nope=4
+ nopes=3
+ nfaces=4
+ elseif(lakon(nelem)(4:5).eq.'15')then
+ nope=15
+ nfaces=5
+ geomfac=quadfac
+ elseif(lakon(nelem)(4:4).eq.'6') then
+ nope=6
+ nfaces=5
+ else
+ cycle
+ endif
+!
+! Find center of the element for avg temp value on the element to
+! get properties later
+! if HEX
+ if((lakon(nelem)(4:5).eq.'20').or.
+ & (lakon(nelem)(4:4).eq.'8')) then
+ xi=0.d0
+ et=0.d0
+ ze=0.d0
+ weight=8.d0
+! if TET
+ elseif((lakon(nelem)(4:5).eq.'10').or.
+ & (lakon(nelem)(4:4).eq.'4')) then
+ xi=gauss3d4(1,1)
+ et=gauss3d4(2,1)
+ ze=gauss3d4(3,1)
+ weight=weight3d4(1)
+! elseif WEDGES
+ elseif((lakonl(4:5).eq.'15').or.
+ & (lakonl(4:4).eq.'6'))then
+ xi=1.d0/3.d0
+ et=1.d0/3.d0
+ ze=0.d0
+ weight=1.d0
+ endif
+!
+ do i=1,nope
+ konl(i)=kon(indexe+i)
+ do j=1,3
+ xl(j,i)=co(j,konl(i))
+ enddo
+ enddo
+!
+ if (nope.eq.20)then
+ call shape20h(xi,et,ze,xl,xsj,shp,iflag)
+ elseif(nope.eq.8) then
+ call shape8h(xi,et,ze,xl,xsj,shp,iflag)
+ elseif(nope.eq.10)then
+ call shape10tet(xi,et,ze,xl,xsj,shp,iflag)
+ elseif(nope.eq.4) then
+ call shape4tet (xi,et,ze,xl,xsj,shp,iflag)
+ elseif(nope.eq.15)then
+ call shape15w(xi,et,ze,xl,xsj,shp,iflag)
+ else
+ call shape6w(xi,et,ze,xl,xsj,shp,iflag)
+ endif
+!
+ wavspd=wavespeed(imat)
+!
+! Divides volume accordingly per geometry of element
+! Carlo MT proposal
+! if HEX
+ if((lakon(nelem)(4:5).eq.'20').or.
+ & (lakon(nelem)(4:4).eq.'8')) then
+ volume=weight*xsj
+! if TET
+ elseif((lakon(nelem)(4:5).eq.'10').or.
+ & (lakon(nelem)(4:4).eq.'4')) then
+ volume=weight*xsj/3.d0
+! if WEDGES
+ elseif ( (lakonl(4:5).eq.'15').or.
+ & (lakonl(4:4).eq.'6'))then
+ volume=weight*xsj/2.d0
+ endif
+!
+ hmin=1.d30
+!
+! DO over sides
+ do ig=1,nfaces
+ if(lakon(nelem)(4:4).eq.'6')then
+ if(ig.le.2)then
+ nopes=3
+ else
+ nopes=4
+ endif
+ elseif(lakon(nelem)(4:5).eq.'15')then
+ if(ig.le.2)then
+ nopes=6
+ else
+ nopes=8
+ endif
+ endif
+!
+ if((nope.eq.20).or.(nope.eq.8))then
+ do i=1,nopes
+ do j=1,3
+ xl2(j,i)=co(j,konl(ifaceq(i,ig)))
+ enddo
+ enddo
+ elseif((nope.eq.10).or.(nope.eq.4))then
+ do i=1,nopes
+ do j=1,3
+ xl2(j,i)=co(j,konl(ifacet(i,ig)))
+ enddo
+ enddo
+ else
+ do i=1,nopes
+ do j=1,3
+ xl2(j,i)=co(j,konl(ifacew(i,ig)))
+ enddo
+ enddo
+ endif
+!
+ if((nopes.eq.4).or.(nopes.eq.8))then
+ xi=0.d0
+ et=0.d0
+ weight=4.d0
+ else
+ xi=1.d0/3.d0
+ et=1.d0/3.d0
+ weight=0.5d0
+ endif
+!
+ if (nopes.eq.8) then
+ call shape8q(xi,et,xl2,xsj2,xs2,shp2,iflag)
+ elseif(nopes.eq.4) then
+ call shape4q(xi,et,xl2,xsj2,xs2,shp2,iflag)
+ elseif(nopes.eq.6) then
+ call shape6tri(xi,et,xl2,xsj2,xs2,shp2,iflag)
+ elseif(nopes.eq.7) then
+ call shape7tri(xi,et,xl2,xsj2,xs2,shp2,iflag)
+ else
+ call shape3tri(xi,et,xl2,xsj2,xs2,shp2,iflag)
+ endif
+!
+ area=weight*dsqrt(xsj2(1)*xsj2(1)+xsj2(2)*xsj2(2)+
+ & xsj2(3)*xsj2(3))
+ hmin=min(hmin,(volume/area))
+!
+ enddo
+! ENDDO over sides
+!
+ if(critom/2*hmin/wavspd*geomfac.lt.dtvol)then
+ elemmin=nelem
+ endif
+
+ dtvol=min(dtvol,critom/2* hmin/wavspd*geomfac)
+ enddo
+! ** ENDDO per element
+!
+ dtvol=dtvol* safefac
+!
+ return
+ end
diff --git a/ccx_2.9/src/calcstressheatflux.f b/ccx_2.10/src/calcstressheatflux.f
similarity index 100%
rename from ccx_2.9/src/calcstressheatflux.f
rename to ccx_2.10/src/calcstressheatflux.f
diff --git a/ccx_2.9/src/calctel.f b/ccx_2.10/src/calctel.f
similarity index 100%
rename from ccx_2.9/src/calctel.f
rename to ccx_2.10/src/calctel.f
diff --git a/ccx_2.9/src/calcumel.f b/ccx_2.10/src/calcumel.f
similarity index 89%
rename from ccx_2.9/src/calcumel.f
rename to ccx_2.10/src/calcumel.f
index a564df5..c380d7f 100644
--- a/ccx_2.9/src/calcumel.f
+++ b/ccx_2.10/src/calcumel.f
@@ -28,6 +28,10 @@
!
real*8 t1l,vel(nef,0:5),dvi,shcon(0:3,ntmat_,*),umel(*)
!
+c$omp parallel default(none)
+c$omp& shared(nef,vel,ielmat,shcon,nshcon,ntmat_,ithermal,umel)
+c$omp& private(i,t1l,imat,dvi)
+c$omp do
do i=1,nef
t1l=vel(i,0)
imat=ielmat(1,i)
@@ -35,6 +39,8 @@
& ithermal)
umel(i)=dvi
enddo
+c$omp end do
+c$omp end parallel
!
return
end
diff --git a/ccx_2.9/src/calcumfa.f b/ccx_2.10/src/calcumfa.f
similarity index 89%
rename from ccx_2.9/src/calcumfa.f
rename to ccx_2.10/src/calcumfa.f
index 8d676e8..67c2b06 100644
--- a/ccx_2.9/src/calcumfa.f
+++ b/ccx_2.10/src/calcumfa.f
@@ -28,6 +28,10 @@
!
real*8 t1l,vfa(0:5,*),dvi,shcon(0:3,ntmat_,*) ,umfa(*)
!
+c$omp parallel default(none)
+c$omp& shared(nface,vfa,ielmat,ielfa,shcon,nshcon,ntmat_,ithermal,umfa)
+c$omp& private(i,t1l,imat,dvi)
+c$omp do
do i=1,nface
t1l=vfa(0,i)
!
@@ -38,6 +42,8 @@
& ithermal)
umfa(i)=dvi
enddo
+c$omp end do
+c$omp end parallel
!
return
end
diff --git a/ccx_2.9/src/calcvel.f b/ccx_2.10/src/calcvel.f
similarity index 100%
rename from ccx_2.9/src/calcvel.f
rename to ccx_2.10/src/calcvel.f
diff --git a/ccx_2.9/src/calcview.f b/ccx_2.10/src/calcview.f
similarity index 100%
rename from ccx_2.9/src/calcview.f
rename to ccx_2.10/src/calcview.f
diff --git a/ccx_2.9/src/calinput.f b/ccx_2.10/src/calinput.f
similarity index 97%
rename from ccx_2.9/src/calinput.f
rename to ccx_2.10/src/calinput.f
index 2409a92..fe44e3b 100644
--- a/ccx_2.9/src/calinput.f
+++ b/ccx_2.10/src/calinput.f
@@ -41,8 +41,7 @@
& nbody,nbody_,xbodyold,nam_,ielprop,nprop,nprop_,prop,itpamp,
& iviewfile,ipoinpc,cfd,nslavs,t0g,t1g,network,cyclicsymmetry,
& idefforc,idefload,idefbody,mortar,ifacecount,islavsurf,
- & pslavsurf,clearini,heading,iaxial,objective,equcon,inequcon,
- & desvarbou,inequbou,equbou)
+ & pslavsurf,clearini,heading,iaxial,nobject,objectset)
!
implicit none
!
@@ -60,7 +59,6 @@
! 10:electromegnetic eigenvalue problems
! 11:superelement creation
! 12:sensitivity
-! ithermal(1): 0:no thermal stresses; 1:thermal stresses;
! iprestr: 0: no residual stresses; 1: residual stresses;
! iperturb: 0:no perturbation; 1:perturbation; 2: nonlinear
! geometric analysis; 3: material and geometrical
@@ -80,8 +78,7 @@
character*20 labmpc(*),sideload(*)
character*66 heading(*)
character*80 matname(*),orname(*),amname(*)
- character*81 set(*),prset(*),tieset(3,*),cbody(*),objective(3),
- & inequcon(3),equcon(2)
+ character*81 set(*),prset(*),tieset(3,*),cbody(*),objectset(3,*)
character*87 filab(*)
character*132 jobnamec(*),textpart(16)
!
@@ -108,7 +105,7 @@
& ne1d,ne2d,nener,irstrt,ii,maxlenmpc,inl,ipol,network,
& iline,mcs,ntie,ntie_,lprev,newstep,nbody,nbody_,ibody(3,*),
& cyclicsymmetry,idefforc(*),idefload(*),idefbody(*),
- & ichangesurfacebehavior
+ & ichangesurfacebehavior,nobject
!
real*8 co(3,*),xboun(*),coefmpc(*),xforc(*),fmpc(*),
& xload(2,*),alzero(*),offset(2,*),prop(*),pslavsurf(3,*),
@@ -123,7 +120,7 @@
& xstate(nstate_,mi(1),*),ttime,qaold(2),cs(17,*),tietol(2,*),
& xbody(7,*),xbodyold(7,*),t0g(2,*),t1g(2,*),
& fei(3),tinc,tper,xmodal(*),tmin,tmax,tincf,
- & alpha,physcon(*),desvarbou(2),inequbou,equbou
+ & alpha,physcon(*)
!
save solid,ianisoplas,out3d,pretension
!
@@ -410,7 +407,7 @@ c iaxial=0
call creeps(inpc,textpart,nelcon,imat,ntmat_,npmat_,
& plicon,nplicon,elcon,iplas,iperturb,nstate_,ncmat_,
& matname,irstrt,istep,istat,n,iline,ipol,inl,ipoinp,inp,
- & ipoinpc,ianisoplas)
+ & ipoinpc)
!
elseif(textpart(1)(1:16).eq.'*CYCLICHARDENING') then
call cyclichardenings(inpc,textpart,nelcon,imat,ntmat_,
@@ -551,10 +548,6 @@ c
elseif(textpart(1)(1:8).eq.'*ENDSTEP') then
exit
!
- elseif(textpart(1)(1:20).eq.'*EQUALITYCONSTRAINTS') then
- call equcons(inpc,textpart,istep,istat,n,iline,ipol,inl,
- & ipoinp,inp,ipoinpc,equcon,equbou)
-!
elseif(textpart(1)(1:10).eq.'*EQUATIONF') then
M_or_SPC=1
call equationfs(inpc,textpart,ipompc,nodempc,coefmpc,
@@ -649,16 +642,12 @@ c
& imat,ntmat_,ncmat_,irstrt,istep,istat,n,iperturb,iline,
& ipol,inl,ipoinp,inp,ipoinpc)
!
- elseif(textpart(1)(1:22).eq.'*INEQUALITYCONSTRAINTS') then
- call inequcons(inpc,textpart,istep,istat,n,iline,ipol,inl,
- & ipoinp,inp,ipoinpc,inequcon,inequbou)
-!
elseif(textpart(1)(1:18).eq.'*INITIALCONDITIONS') then
call initialconditionss(inpc,textpart,set,istartset,iendset,
& ialset,nset,t0,t1,prestr,iprestr,ithermal,veold,inoelfree,
& nk_,mi(1),istep,istat,n,iline,ipol,inl,ipoinp,inp,lakon,
& kon,co,ne,ipkon,vold,ipoinpc,xstate,nstate_,nk,t0g,
- & t1g,iaxial)
+ & t1g,iaxial,ielprop,prop)
!
elseif(textpart(1)(1:21).eq.'*MAGNETICPERMEABILITY') then
call magneticpermeabilitys(inpc,textpart,elcon,nelcon,
@@ -751,7 +740,7 @@ c
!
elseif(textpart(1)(1:10).eq.'*OBJECTIVE') then
call objectives(inpc,textpart,istep,istat,n,iline,ipol,inl,
- & ipoinp,inp,ipoinpc,objective)
+ & ipoinp,inp,ipoinpc,nener,nobject,objectset)
!
elseif(textpart(1)(1:12).eq.'*ORIENTATION') then
call orientations(inpc,textpart,orname,orab,norien,
@@ -769,7 +758,7 @@ c
call plastics(inpc,textpart,nelcon,imat,ntmat_,npmat_,
& plicon,nplicon,plkcon,nplkcon,iplas,iperturb,nstate_,
& ncmat_,elcon,matname,irstrt,istep,istat,n,iline,ipol,
- & inl,ipoinp,inp,ipoinpc,ianisoplas)
+ & inl,ipoinp,inp,ipoinpc)
!
elseif(textpart(1)(1:19).eq.'*PRE-TENSIONSECTION') then
call pretensionsections(inpc,textpart,ipompc,nodempc,
@@ -980,10 +969,6 @@ c
call valuesatinfinitys(inpc,textpart,physcon,
& istep,istat,n,iline,ipol,inl,ipoinp,inp,ipoinpc)
!
- elseif(textpart(1)(1:15).eq.'*VARIABLEBOUNDS') then
- call varbous(inpc,textpart,istep,istat,n,iline,ipol,inl,
- & ipoinp,inp,ipoinpc,desvarbou)
-!
elseif(textpart(1)(1:11).eq.'*VIEWFACTOR') then
call viewfactors(textpart,iviewfile,istep,inpc,
& istat,n,key,iline,ipol,inl,ipoinp,inp,jobnamec,ipoinpc)
@@ -1092,11 +1077,11 @@ c
!
! generating the MPC's for zero mass flow in CFD-calculations
!
- if(cfd.eq.1) then
- call genmassfloweqs(ipompc,nodempc,coefmpc,
- & nmpc,nmpc_,mpcfree,co,ikmpc,ilmpc,labmpc,
- & lakon,nload,sideload,ipkon,kon,nelemload)
- endif
+c if(cfd.eq.1) then
+c call genmassfloweqs(ipompc,nodempc,coefmpc,
+c & nmpc,nmpc_,mpcfree,co,ikmpc,ilmpc,labmpc,
+c & lakon,nload,sideload,ipkon,kon,nelemload)
+c endif
!
infree(1)=ixfree
infree(2)=ikfree
diff --git a/ccx_2.9/src/carbon_seal.f b/ccx_2.10/src/carbon_seal.f
similarity index 100%
rename from ccx_2.9/src/carbon_seal.f
rename to ccx_2.10/src/carbon_seal.f
diff --git a/ccx_2.9/src/cascade.c b/ccx_2.10/src/cascade.c
similarity index 100%
rename from ccx_2.9/src/cascade.c
rename to ccx_2.10/src/cascade.c
diff --git a/ccx_2.9/src/cataloguenodes.f b/ccx_2.10/src/cataloguenodes.f
similarity index 100%
rename from ccx_2.9/src/cataloguenodes.f
rename to ccx_2.10/src/cataloguenodes.f
diff --git a/ccx_2.9/src/ccx_2.9.c b/ccx_2.10/src/ccx_2.10.c
similarity index 98%
rename from ccx_2.9/src/ccx_2.9.c
rename to ccx_2.10/src/ccx_2.10.c
index ceb3180..8e082c0 100644
--- a/ccx_2.9/src/ccx_2.9.c
+++ b/ccx_2.10/src/ccx_2.10.c
@@ -1,5 +1,5 @@
/* CalculiX - A 3-dimensional finite element program */
-/* Copyright (C) 1998-2015 Guido Dhondt */
+/* Copyright (C) 1998-2016 Guido Dhondt */
/* This program is free software; you can redistribute it and/or */
/* modify it under the terms of the GNU General Public License as */
@@ -63,7 +63,7 @@ double *co=NULL, *xboun=NULL, *coefmpc=NULL, *xforc=NULL,*clearini=NULL,
*t1old=NULL, *eme=NULL, *plicon=NULL, *pslavsurf=NULL, *plkcon=NULL,
*xstate=NULL, *trab=NULL, *ener=NULL, *shcon=NULL, *cocon=NULL,
*cs=NULL,*tietol=NULL,*fmpc=NULL,*prop=NULL,*t0g=NULL,*t1g=NULL,
- *xbody=NULL,*xbodyold=NULL,desvarbou[2],*inequbou=NULL,*equbou=NULL;
+ *xbody=NULL,*xbodyold=NULL;
double ctrl[32]={4.5,8.5,9.5,16.5,10.5,4.5,0.,5.5,0.,0.,0.25,0.5,0.75,0.85,0.,0.,1.5,0.,0.005,0.01,0.,0.,0.02,1.e-5,1.e-3,1.e-8,1.e30,1.5,0.25,1.01,1.,1.};
@@ -71,8 +71,7 @@ char *sideload=NULL, *set=NULL, *matname=NULL, *orname=NULL, *amname=NULL,
*filab=NULL, *lakon=NULL, *labmpc=NULL, *prlab=NULL, *prset=NULL,
jobnamec[660]="",jobnamef[132]="",output[4]="asc", *typeboun=NULL,
*inpc=NULL,*tieset=NULL,*cbody=NULL,fneig[132]="",*sideloadtemp=NULL,
- kind1[2]="T",kind2[2]="T",*heading=NULL,objective[243]="",equcon[162]="",
- inequcon[162]="";
+ kind1[2]="T",kind2[2]="T",*heading=NULL,*objectset=NULL;
ITG nk,ne,nboun,nmpc,nforc,nload,nprint,nset,nalset,nentries=15,
nmethod,neq[3]={0,0,0},i,mpcfree=1,mei[4],j,nzl,nam,nbounold=0,
@@ -86,7 +85,7 @@ ITG nk,ne,nboun,nmpc,nforc,nload,nprint,nset,nalset,nentries=15,
callfrommain,nflow=0,jin=0,irstrt=0,nener=0,jrstrt=0,nenerold,
nline,ipoinp[2*nentries],*inp=NULL,ntie,ntie_=0,mcs=0,nprop_=0,
nprop=0,itpamp=0,iviewfile,nkold,nevdamp_=0,npt_=0,cyclicsymmetry,
- nmethodl,iaxial=1,inext=0,icontact=0,iit=-1;
+ nmethodl,iaxial=1,inext=0,icontact=0,nobject,nobject_=0,iit=-1;
ITG *meminset=NULL,*rmeminset=NULL;
@@ -108,7 +107,7 @@ else{
if(strcmp1(argv[i],"-i")==0) {
strcpy(jobnamec,argv[i+1]);strcpy1(jobnamef,argv[i+1],132);jin++;break;}
if(strcmp1(argv[i],"-v")==0) {
- printf("\nThis is Version 2.9\n\n");
+ printf("\nThis is Version 2.10\n\n");
FORTRAN(stop,());
}
}
@@ -129,12 +128,12 @@ FORTRAN(uexternaldb,(&lop,&lrestart,time,&dtime,&kstep,&kinc));
FORTRAN(openfile,(jobnamef,output));
printf("\n************************************************************\n\n");
-printf("CalculiX Version 2.9, Copyright(C) 1998-2015 Guido Dhondt\n");
+printf("CalculiX Version 2.10, Copyright(C) 1998-2015 Guido Dhondt\n");
printf("CalculiX comes with ABSOLUTELY NO WARRANTY. This is free\n");
printf("software, and you are welcome to redistribute it under\n");
printf("certain conditions, see gpl.htm\n\n");
printf("************************************************************\n\n");
-printf("You are using an executable made on Sa 21. Nov 10:01:09 CET 2015\n");
+printf("You are using an executable made on Sa 5. Mär 12:23:33 CET 2016\n");
fflush(stdout);
istep=0;
@@ -169,7 +168,7 @@ FORTRAN(allocation,(&nload_,&nforc_,&nboun_,&nk_,&ne_,&nmpc_,&nset_,&nalset_,
set,meminset,rmeminset,&ncs_,&namtot_,&ncmat_,&memmpc_,&ne1d,
&ne2d,&nflow,jobnamec,&irstrt,ithermal,&nener,&nstate_,&istep,
inpc,ipoinp,inp,&ntie_,&nbody_,&nprop_,ipoinpc,&nevdamp_,&npt_,&nslavs,
- &nkon_,&mcs,&mortar,&ifacecount,&nintpoint,infree,&nheading_));
+ &nkon_,&mcs,&mortar,&ifacecount,&nintpoint,infree,&nheading_,&nobject_));
SFREE(set);SFREE(meminset);SFREE(rmeminset);mt=mi[1]+1;
NNEW(heading,char,66*nheading_);
@@ -182,9 +181,10 @@ nload=0;nbody=0;nforc=0;nboun=0;nk=0;nmpc=0;nam=0;
- change noelfiles appropriately
- change nlabel in geomview.f, expand.c, storeresidual.f
and createmddof.f
- - change the dimension of label in geomview.f */
+ - change the dimension of label in geomview.f
+ - change the documentation (tex-file) */
-nlabel=46;
+nlabel=47;
while(istat>=0) {
@@ -205,6 +205,7 @@ while(istat>=0) {
norien=norien_;
ntrans=ntrans_;
ntie=ntie_;
+ nobject=nobject_;
/* allocating space before the first step */
@@ -412,6 +413,12 @@ while(istat>=0) {
NNEW(cs,double,17*ntie_);
}
+ /* objectives for sensitivity analysis */
+
+ if(nobject_>0){
+ NNEW(objectset,char,243*nobject_);
+ }
+
/* temporary fields for cyclic symmetry calculations */
if((ncs_>0)||(npt_>0)){
@@ -573,8 +580,8 @@ while(istat>=0) {
ielprop,&nprop,&nprop_,prop,&itpamp,&iviewfile,ipoinpc,&icfd,
&nslavs,t0g,t1g,&network,&cyclicsymmetry,idefforc,idefload,
idefbody,&mortar,&ifacecount,islavsurf,pslavsurf,clearini,
- heading,&iaxial,objective,equcon,inequcon,desvarbou,
- inequbou,equbou));
+ heading,&iaxial,&nobject,objectset));
+
if((istep==1)&&(mortar==-1)){mortar=0;}else{icontact=1;}
nload0=nload;SFREE(idefforc);SFREE(idefload);SFREE(idefbody);
@@ -1001,7 +1008,7 @@ while(istat>=0) {
nodempc,&nmpc,nactdof,icol,jq,&mast1,&irow,&isolver,neq,
ikmpc,ilmpc,ipointer,nzs,&nmethodl,ithermal,
ikboun,ilboun,iperturb,mi,&mortar,typeboun,labmpc,
- &iit,&icascade);
+ &iit,&icascade);
}
else{neq[0]=1;neq[1]=1;neq[2]=1;}
}
@@ -1070,7 +1077,7 @@ while(istat>=0) {
nonlingeo(&co,&nk,&kon,&ipkon,&lakon,&ne,nodeboun,ndirboun,xboun,&nboun,
&ipompc,&nodempc,&coefmpc,&labmpc,&nmpc,nodeforc,ndirforc,xforc,
- &nforc, nelemload,sideload,xload,&nload,
+ &nforc,&nelemload,&sideload,xload,&nload,
nactdof,&icol,jq,&irow,neq,&nzl,&nmethod,&ikmpc,
&ilmpc,ikboun,ilboun,elcon,nelcon,rhcon,nrhcon,
alcon,nalcon,alzero,&ielmat,&ielorien,&norien,orab,&ntmat_,
@@ -1078,7 +1085,7 @@ while(istat>=0) {
&vold,iperturb,sti,nzs,&kode,filab,&idrct,jmax,
jout,timepar,eme,xbounold,xforcold,xloadold,
veold,accold,amname,amta,namta,
- &nam,iamforc,iamload,iamt1,&alpha,
+ &nam,iamforc,&iamload,iamt1,&alpha,
&iexpl,iamboun,plicon,nplicon,plkcon,nplkcon,
&xstate,&npmat_,&istep,&ttime,matname,qaold,mi,
&isolver,&ncmat_,&nstate_,&iumat,cs,&mcs,&nkon,&ener,
@@ -1319,7 +1326,8 @@ while(istat>=0) {
output,set,&nset,istartset,iendset,ialset,&nprint,prlab,
prset,&nener,trab,inotr,&ntrans,fmpc,cbody,ibody,xbody,&nbody,
xbodyold,timepar,thicke,jobnamec,tieset,&ntie,&istep,&nmat,
- ielprop,prop,typeboun,&mortar,mpcinfo,tietol,ics,&icontact);
+ ielprop,prop,typeboun,&mortar,mpcinfo,tietol,ics,&icontact,
+ &nobject,objectset,&istat);
}
SFREE(nactdof);
diff --git a/ccx_2.9/src/cd_Mcgreehan_Schotsch.f b/ccx_2.10/src/cd_Mcgreehan_Schotsch.f
similarity index 100%
rename from ccx_2.9/src/cd_Mcgreehan_Schotsch.f
rename to ccx_2.10/src/cd_Mcgreehan_Schotsch.f
diff --git a/ccx_2.9/src/cd_bleedtapping.f b/ccx_2.10/src/cd_bleedtapping.f
similarity index 100%
rename from ccx_2.9/src/cd_bleedtapping.f
rename to ccx_2.10/src/cd_bleedtapping.f
diff --git a/ccx_2.9/src/cd_bragg.f b/ccx_2.10/src/cd_bragg.f
similarity index 100%
rename from ccx_2.9/src/cd_bragg.f
rename to ccx_2.10/src/cd_bragg.f
diff --git a/ccx_2.9/src/cd_chamfer.f b/ccx_2.10/src/cd_chamfer.f
similarity index 100%
rename from ccx_2.9/src/cd_chamfer.f
rename to ccx_2.10/src/cd_chamfer.f
diff --git a/ccx_2.9/src/cd_lab_1spike.f b/ccx_2.10/src/cd_lab_1spike.f
similarity index 100%
rename from ccx_2.9/src/cd_lab_1spike.f
rename to ccx_2.10/src/cd_lab_1spike.f
diff --git a/ccx_2.9/src/cd_lab_correction.f b/ccx_2.10/src/cd_lab_correction.f
similarity index 100%
rename from ccx_2.9/src/cd_lab_correction.f
rename to ccx_2.10/src/cd_lab_correction.f
diff --git a/ccx_2.9/src/cd_lab_honeycomb.f b/ccx_2.10/src/cd_lab_honeycomb.f
similarity index 100%
rename from ccx_2.9/src/cd_lab_honeycomb.f
rename to ccx_2.10/src/cd_lab_honeycomb.f
diff --git a/ccx_2.9/src/cd_lab_radius.f b/ccx_2.10/src/cd_lab_radius.f
similarity index 100%
rename from ccx_2.9/src/cd_lab_radius.f
rename to ccx_2.10/src/cd_lab_radius.f
diff --git a/ccx_2.9/src/cd_lab_straight.f b/ccx_2.10/src/cd_lab_straight.f
similarity index 100%
rename from ccx_2.9/src/cd_lab_straight.f
rename to ccx_2.10/src/cd_lab_straight.f
diff --git a/ccx_2.9/src/cd_lichtarowicz.f b/ccx_2.10/src/cd_lichtarowicz.f
similarity index 100%
rename from ccx_2.9/src/cd_lichtarowicz.f
rename to ccx_2.10/src/cd_lichtarowicz.f
diff --git a/ccx_2.9/src/cd_ms_ms.f b/ccx_2.10/src/cd_ms_ms.f
similarity index 100%
rename from ccx_2.9/src/cd_ms_ms.f
rename to ccx_2.10/src/cd_ms_ms.f
diff --git a/ccx_2.9/src/cd_own_albers.f b/ccx_2.10/src/cd_own_albers.f
similarity index 100%
rename from ccx_2.9/src/cd_own_albers.f
rename to ccx_2.10/src/cd_own_albers.f
diff --git a/ccx_2.9/src/cd_pk_albers.f b/ccx_2.10/src/cd_pk_albers.f
similarity index 100%
rename from ccx_2.9/src/cd_pk_albers.f
rename to ccx_2.10/src/cd_pk_albers.f
diff --git a/ccx_2.9/src/cd_pk_ms.f b/ccx_2.10/src/cd_pk_ms.f
similarity index 100%
rename from ccx_2.9/src/cd_pk_ms.f
rename to ccx_2.10/src/cd_pk_ms.f
diff --git a/ccx_2.9/src/cd_preswirlnozzle.f b/ccx_2.10/src/cd_preswirlnozzle.f
similarity index 100%
rename from ccx_2.9/src/cd_preswirlnozzle.f
rename to ccx_2.10/src/cd_preswirlnozzle.f
diff --git a/ccx_2.9/src/cfds.f b/ccx_2.10/src/cfds.f
similarity index 100%
rename from ccx_2.9/src/cfds.f
rename to ccx_2.10/src/cfds.f
diff --git a/ccx_2.9/src/cflux.f b/ccx_2.10/src/cflux.f
similarity index 100%
rename from ccx_2.9/src/cflux.f
rename to ccx_2.10/src/cflux.f
diff --git a/ccx_2.9/src/cfluxs.f b/ccx_2.10/src/cfluxs.f
similarity index 100%
rename from ccx_2.9/src/cfluxs.f
rename to ccx_2.10/src/cfluxs.f
diff --git a/ccx_2.9/src/changedepterm.f b/ccx_2.10/src/changedepterm.f
similarity index 100%
rename from ccx_2.9/src/changedepterm.f
rename to ccx_2.10/src/changedepterm.f
diff --git a/ccx_2.9/src/changefrictions.f b/ccx_2.10/src/changefrictions.f
similarity index 100%
rename from ccx_2.9/src/changefrictions.f
rename to ccx_2.10/src/changefrictions.f
diff --git a/ccx_2.9/src/changekon.f b/ccx_2.10/src/changekon.f
similarity index 100%
rename from ccx_2.9/src/changekon.f
rename to ccx_2.10/src/changekon.f
diff --git a/ccx_2.9/src/changematerials.f b/ccx_2.10/src/changematerials.f
similarity index 100%
rename from ccx_2.9/src/changematerials.f
rename to ccx_2.10/src/changematerials.f
diff --git a/ccx_2.9/src/changeplastics.f b/ccx_2.10/src/changeplastics.f
similarity index 100%
rename from ccx_2.9/src/changeplastics.f
rename to ccx_2.10/src/changeplastics.f
diff --git a/ccx_2.9/src/changesolidsections.f b/ccx_2.10/src/changesolidsections.f
similarity index 100%
rename from ccx_2.9/src/changesolidsections.f
rename to ccx_2.10/src/changesolidsections.f
diff --git a/ccx_2.9/src/changesurfacebehaviors.f b/ccx_2.10/src/changesurfacebehaviors.f
similarity index 100%
rename from ccx_2.9/src/changesurfacebehaviors.f
rename to ccx_2.10/src/changesurfacebehaviors.f
diff --git a/ccx_2.9/src/characteristic.f b/ccx_2.10/src/characteristic.f
similarity index 100%
rename from ccx_2.9/src/characteristic.f
rename to ccx_2.10/src/characteristic.f
diff --git a/ccx_2.9/src/checkconvergence.c b/ccx_2.10/src/checkconvergence.c
similarity index 76%
rename from ccx_2.9/src/checkconvergence.c
rename to ccx_2.10/src/checkconvergence.c
index bc63c72..678d715 100644
--- a/ccx_2.9/src/checkconvergence.c
+++ b/ccx_2.10/src/checkconvergence.c
@@ -29,6 +29,7 @@
#include "tau.h"
#endif
+#define max(a,b) ((a) >= (b) ? (a) : (b))
void checkconvergence(double *co, ITG *nk, ITG *kon, ITG *ipkon, char *lakon,
ITG *ne, double *stn, ITG *nmethod,
@@ -51,16 +52,22 @@ void checkconvergence(double *co, ITG *nk, ITG *kon, ITG *ipkon, char *lakon,
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){
+ ITG *ialeatoric,ITG *kscale,
+ double *energy, double *allwk, double *energyref, double *emax,
+ double *enres, double *enetoll, double *energyini, double *allwkini,
+ double *temax, double *sizemaxinc, 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;
+ 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;
+ *cdnr=NULL,*cdni=NULL,
+ tmp, maxdecay=0.0, r_hat;
/* reset ialeatoric to zero */
@@ -85,10 +92,17 @@ void checkconvergence(double *co, ITG *nk, ITG *kon, ITG *ipkon, char *lakon,
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;}else{idivergence=0;}
+ if(qa[2]>0.){idivergence=1;}
if(*ithermal!=2){
if(qa[0]>ea*qam[0]){
@@ -163,7 +177,128 @@ void checkconvergence(double *co, ITG *nk, ITG *kon, ITG *ipkon, char *lakon,
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_hat : modified energy conservation criterion
+ emax : maximum value of the energy over the time history
+ enres : 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)&&(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
+
+ *enres=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(*enres)>=*enetoll/4) {
+
+ // Normal strategy: Relative error
+
+ /* Compute admissible decay*/
+
+ maxdecay=*enetoll/2*(1+sqrt(*theta));
+
+ /* modified r_hat criterion */
+
+ r_hat=*enres/(*emax);
+ if(r_hat<=-maxdecay) {
+ idivergence=1;
+ }else{
+
+ /* Check if the residual is too close to the boundary */
+
+ if(r_hat*0.9<=-0.90*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)&&(iconvergence==1)&&((*ne!=*ne0)||(*neini!=*ne0))){
+
+ /* store temporarly the value of emax: in case of forced divergence
+ emax has to be resetted. */
+
+ 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,enres,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)){
+ *enres=fabs(energy[0]+energy[1]+energy[2]+energy[3]-*energyref-*allwk-*dampwk);
+ tmp=1.3*(2.0* *enres/(*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>*enres){
+ *enres=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)){
@@ -200,10 +335,18 @@ void checkconvergence(double *co, ITG *nk, ITG *kon, ITG *ipkon, char *lakon,
}
}
}
+
+ /* 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 */
- if((*iit>il)&&(*idrct==0)){
+ else if((*iit>il)&&(*idrct==0)){
if(*mortar==0){
*dtheta=*dthetaref*db;
*dthetaref=*dtheta;
@@ -258,8 +401,10 @@ void checkconvergence(double *co, ITG *nk, ITG *kon, ITG *ipkon, char *lakon,
/* check whether new increment size exceeds maximum increment
size allowed (by the user) */
- if((*dtheta>*tmax)&&(*idrct==0)){
- *dtheta=*tmax;
+// if((*dtheta>*tmax)&&(*idrct==0)){
+// *dtheta=*tmax;
+ if((*dtheta>*sizemaxinc)&&(*idrct==0)){
+ *dtheta=*sizemaxinc;
*dthetaref=*dtheta;
printf(" the increment size exceeds thetamax and is decreased to %e\n\n",*dtheta**tper);
}
@@ -345,9 +490,16 @@ void checkconvergence(double *co, ITG *nk, ITG *kon, ITG *ipkon, char *lakon,
/* check for diverging residuals */
+// 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]>*deltmx)||(qa[2]>0.)){
+// 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]>*deltmx)||(idivergence==1)){
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]>*deltmx)||(qa[2]>0.)){
+ (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;
@@ -436,7 +588,14 @@ void checkconvergence(double *co, ITG *nk, ITG *kon, ITG *ipkon, char *lakon,
printf("increment size decrease requested by a material user routine (through pnewdt)\n\n");
}else{
if(idivergence==1){
- if((*mortar!=1)||(*icutb!=0)) *dtheta=*dtheta*df;
+ if((*mortar!=1)||(*icutb!=0)){ // MPADD
+ if(iforceincsize != 1){ // MPADD
+ *dtheta=*dtheta*df; // MPADD
+ }else{ // MPADD
+ *dtheta=*sizemaxinc; // MPADD
+ } // MPADD
+ } // MPADD
+// if((*mortar!=1)||(*icutb!=0)) *dtheta=*dtheta*df;
}else{
*dtheta=*dtheta**deltmx/cam[2]*da;
}
diff --git a/ccx_2.9/src/checkconvnet.c b/ccx_2.10/src/checkconvnet.c
similarity index 100%
rename from ccx_2.9/src/checkconvnet.c
rename to ccx_2.10/src/checkconvnet.c
diff --git a/ccx_2.10/src/checkimpacts.f b/ccx_2.10/src/checkimpacts.f
new file mode 100644
index 0000000..e08a78b
--- /dev/null
+++ b/ccx_2.10/src/checkimpacts.f
@@ -0,0 +1,217 @@
+!
+! CalculiX - A 3-dimensional finite element program
+! Copyright (C) 1998-2007 Guido Dhondt
+!
+! This program is free software; you can redistribute it and/or
+! modify it under the terms of the GNU General Public License as
+! published by the Free Software Foundation(version 2);
+!
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program; if not, write to the Free Software
+! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+!
+ subroutine checkimpacts(ne,neini,temax,sizemaxinc,
+ & energyref,tmin,tper,idivergence,
+ & iforceincsize,istab,dtheta,enres,energy,energyini,allwk,
+ & allwkini,dampwk,dampwkini,emax,mortar,maxdecay,enetoll)
+!
+! # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
+! Routine that contains the implementation of the logic to
+! rule the increment size during contact conditions.
+! The values of tolerances have been tested for the ball
+! model, the two sliding blades (simplified model of
+! blade from Mr. Wittig) and the real blade model.
+! Friction has not been tested deeply.
+!
+! Main variables and meaning
+!
+! sizemaxinc : maximum size of the current increment
+! iforceincsize : flag to set "dtheta=sizemaxinc" in
+! checkconvergence.
+! cstate : vector containing contact data
+! temax : max. natural period of oscillation
+! icase : flag to print debug informations
+! emax : maximum energy of the system over the ti-
+! me history
+! enres : energy residual before contact (or re-
+! adapted)
+! delta : eneres normalized
+! fact : factor to set sizemaxinc according to the
+! contact formulation
+! stab_th : \hat{r}_{e}(t_n) -> mod belytschko before
+! contact (or initial value). This is the
+! stability threshold
+! delta_r_hat : \hat{r}_{e}(t) - \hat{r}_{e}(t-1) -> varia-
+! tion of the modified belitschko criterion
+! used to control jumps
+! r_hat : \hat{r}_{e}(t) actual value of the modified
+! belitschko criterion
+!
+! Proposed by Matteo Pacher
+!
+! # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
+!
+ implicit none
+!
+ integer idivergence,
+ & iforceincsize,ne,neini,istab,mortar
+!
+ real*8 temax,energyref,sizemaxinc,tmin,tper,dtheta,
+ & delta_r_hat,r_hat,delta,allwk,allwkini,energy(4),
+ & energyini(4),dampwk,dampwkini,emax,fact,
+ & r_hat_bc,maxdecay,enres,enetoll
+!
+ intent(in) ne,neini,tmin,tper,energyref,dtheta,
+ & temax,mortar,allwk,allwkini,energy,energyini,dampwk,
+ & dampwkini,emax
+!
+ intent(out) sizemaxinc,idivergence,iforceincsize,
+ & istab
+!
+! Initialization
+!
+c icase=0
+ iforceincsize=0
+!
+! Adaption of the energy residual (absolute/relative check)
+!
+ if((enres.ne.0.0).and.(dabs(enres).lt.(enetoll/4.0)))then
+ delta=enres*emax
+ else
+ delta=enres
+ endif
+!
+ if(mortar.eq.0)then
+ fact=10.0
+ else
+ fact=1.0
+ endif
+!
+! Compute thresholds and energy values
+!
+ delta_r_hat=energy(1)+energy(2)+energy(3)+energy(4)-allwk-
+ & dampwk-(energyini(1)+energyini(2)+energyini(3)+
+ & energyini(4)-allwkini-dampwkini)
+!
+ if(emax.le.0.0)then
+!
+! No kinetic energy in the structure: energyref is the internal energy
+! this happens at the beginning of the calculation
+!
+ r_hat=(energy(1)+energy(2)+energy(3)+energy(4)-allwk-
+ & dampwk-energyref)/energyref
+ delta_r_hat=delta_r_hat/energyref
+ r_hat_bc=delta/energyref
+ else
+ r_hat=(energy(1)+energy(2)+energy(3)+energy(4)-allwk-
+ & dampwk-energyref)/emax
+ delta_r_hat=delta_r_hat/emax
+ r_hat_bc=delta/emax
+ endif
+!
+! Logic to adapt the increment size
+!
+ if(mortar.eq.0)then
+!
+! Energy conservation rules for NODE TO SURFACE penalty contact
+!
+ if((delta_r_hat.lt.(-0.008)).and.(ne.ge.neini))then
+!
+! Impact (or too high variation during pers. contact)
+! delta_r_hat = r_hat-r_hat_ini
+!
+ idivergence=1
+ sizemaxinc=dtheta*0.25
+ iforceincsize=1
+c icase=1
+ elseif((r_hat-r_hat_bc.gt.0.0025).and.(ne.le.neini))then
+!
+! Rebound (or too high variation during pers. contact)
+! r_hat_bc is r_hat before contact
+!
+ idivergence=1
+ sizemaxinc=dtheta*0.5
+ iforceincsize=1
+c icase=3
+ else
+!
+! Persistent Contact
+!
+c icase=2
+ if(r_hat.gt.(-0.9*maxdecay))then
+ sizemaxinc=max(fact*temax/tper,1.01*dtheta)
+ sizemaxinc=min(sizemaxinc,100.0*temax/tper)
+ else
+ sizemaxinc=max(temax/tper/10.0,0.5*dtheta)
+ istab=1
+ endif
+
+ endif
+!
+ elseif(mortar.eq.1)then
+!
+! Energy conservation rules for SURFACE TO SURFACE penalty contact
+!
+ if((delta_r_hat.lt.(-0.008)).and.(ne.ge.neini))then
+!
+! Impact (or too high variation during pers. contact)
+! delta_r_hat = r_hat-r_hat_ini
+!
+ idivergence=1
+ sizemaxinc=dtheta*0.25
+ iforceincsize=1
+c icase=1
+!
+ elseif((r_hat-r_hat_bc.gt.0.0025).and.(ne.le.neini))then
+!
+! Rebound (or too high variation during pers. contact)
+! r_hat_bc is r_hat before contact
+!
+ idivergence=1
+ sizemaxinc=dtheta*0.5
+ iforceincsize=1
+c icase=3
+!
+ else
+!
+! Persistent Contact
+!
+c icase=2
+ if(r_hat.gt.(-0.9*maxdecay))then
+ sizemaxinc=min(fact*temax/tper,1.1*dtheta)
+ sizemaxinc=min(sizemaxinc,100.0*temax/tper)
+ else
+ sizemaxinc=max(temax/tper/10.0,0.5*dtheta)
+ istab=1
+ endif
+ endif
+ endif !(mortar)
+!
+ if(sizemaxinc.lt.tmin)then
+ sizemaxinc=tmin
+ endif
+!
+! Debug prints
+!
+c if(icase.eq.1)then
+c write(*,*)"# # # # # # # # # # # # # # # # # # # # # # # # # #"
+c write(*,*)"icase=1"
+c write(*,*)"Impact detected, increment reattempted"
+c elseif(icase.eq.2)then
+c write(*,*)"# # # # # # # # # # # # # # # # # # # # # # # # # #"
+c write(*,*)"icase=2"
+c write(*,*)"Persistent Contact conditions"
+c elseif(icase.eq.3)then
+c write(*,*)"# # # # # # # # # # # # # # # # # # # # # # # # # #"
+c write(*,*)"icase=3"
+c write(*,*)"Rebound, the increment is reattempted (stability)"
+c endif
+!
+ return
+ end
diff --git a/ccx_2.9/src/checkinclength.c b/ccx_2.10/src/checkinclength.c
similarity index 100%
rename from ccx_2.9/src/checkinclength.c
rename to ccx_2.10/src/checkinclength.c
diff --git a/ccx_2.9/src/checktemp.f b/ccx_2.10/src/checktemp.f
similarity index 100%
rename from ccx_2.9/src/checktemp.f
rename to ccx_2.10/src/checktemp.f
diff --git a/ccx_2.9/src/checktime.f b/ccx_2.10/src/checktime.f
similarity index 100%
rename from ccx_2.9/src/checktime.f
rename to ccx_2.10/src/checktime.f
diff --git a/ccx_2.9/src/checktruecontact.f b/ccx_2.10/src/checktruecontact.f
similarity index 100%
rename from ccx_2.9/src/checktruecontact.f
rename to ccx_2.10/src/checktruecontact.f
diff --git a/ccx_2.9/src/chksurf.f b/ccx_2.10/src/chksurf.f
similarity index 100%
rename from ccx_2.9/src/chksurf.f
rename to ccx_2.10/src/chksurf.f
diff --git a/ccx_2.9/src/cident.f b/ccx_2.10/src/cident.f
similarity index 100%
rename from ccx_2.9/src/cident.f
rename to ccx_2.10/src/cident.f
diff --git a/ccx_2.9/src/cident20.f b/ccx_2.10/src/cident20.f
similarity index 100%
rename from ccx_2.9/src/cident20.f
rename to ccx_2.10/src/cident20.f
diff --git a/ccx_2.9/src/clearances.f b/ccx_2.10/src/clearances.f
similarity index 100%
rename from ccx_2.9/src/clearances.f
rename to ccx_2.10/src/clearances.f
diff --git a/ccx_2.9/src/cload.f b/ccx_2.10/src/cload.f
similarity index 100%
rename from ccx_2.9/src/cload.f
rename to ccx_2.10/src/cload.f
diff --git a/ccx_2.9/src/cloads.f b/ccx_2.10/src/cloads.f
similarity index 100%
rename from ccx_2.9/src/cloads.f
rename to ccx_2.10/src/cloads.f
diff --git a/ccx_2.9/src/closefile.f b/ccx_2.10/src/closefile.f
similarity index 100%
rename from ccx_2.9/src/closefile.f
rename to ccx_2.10/src/closefile.f
diff --git a/ccx_2.9/src/closefilefluid.f b/ccx_2.10/src/closefilefluid.f
similarity index 100%
rename from ccx_2.9/src/closefilefluid.f
rename to ccx_2.10/src/closefilefluid.f
diff --git a/ccx_2.9/src/compare.c b/ccx_2.10/src/compare.c
similarity index 100%
rename from ccx_2.9/src/compare.c
rename to ccx_2.10/src/compare.c
diff --git a/ccx_2.9/src/compfluid.c b/ccx_2.10/src/compfluid.c
similarity index 69%
rename from ccx_2.9/src/compfluid.c
rename to ccx_2.10/src/compfluid.c
index 5177f80..55aa22e 100644
--- a/ccx_2.9/src/compfluid.c
+++ b/ccx_2.10/src/compfluid.c
@@ -80,7 +80,7 @@ void compfluid(double **cop, ITG *nk, ITG **ipkonfp, ITG **konp, char **lakonfp,
iconvergence=0,symmetryflag,inputformat,i,*inum=NULL,iitf,ifreefa,
*iponofa=NULL,*inofa=NULL,is,ie,*ia=NULL,nstate_,*ielpropf=NULL,
icent=0,isti=0,iqfx=0,nfield,ndim,iorienglob,force=0,icfdout=1,
- imach=0,ikappa=0,iit;
+ imach=0,ikappa=0,iit,jit,iatleastonepressurebc;
ITG nelt,isym,itol,itmax,iunit,lrgw,*igwk=NULL,ligw,ierr,*iwork=NULL,iter,
nsave,lenw,leniw;
@@ -98,7 +98,7 @@ void compfluid(double **cop, ITG *nk, ITG **ipkonfp, ITG **konp, char **lakonfp,
ptimef,*stn=NULL,*qfn=NULL,*hcel=NULL,*aua=NULL,a1,a2,a3,beta,
*prop=NULL,*dp=NULL,alphatime,betatime,gammatime,dtimefold,
*xmach=NULL,*xkappa=NULL,urelax,*flux=NULL,velnormo[5],velnorm[5],
- relnormt,relnormv,relnormp,relnormmax;
+ relnormt,relnormv,relnormp,relnormmax=1.e30;
double tol,*rgwk=NULL,err,*sb=NULL,*sx=NULL,*rwork=NULL;
@@ -114,11 +114,11 @@ void compfluid(double **cop, ITG *nk, ITG **ipkonfp, ITG **konp, char **lakonfp,
ITG token;
#endif
-// strcpy(fncvg,jobnamec);
-// strcat(fncvg,"f.cvg");
+ strcpy(fncvg,jobnamec);
+ strcat(fncvg,"f.cvg");
-// if((f1=fopen(fncvg,"w"))==NULL){
- if((f1=fopen("fluidconvergence","w"))==NULL){
+ if((f1=fopen(fncvg,"w"))==NULL){
+// if((f1=fopen("fluidconvergence","w"))==NULL){
printf("*ERROR in compfluid: cannot open cvg file for writing...");
exit(0);
}
@@ -221,15 +221,10 @@ void compfluid(double **cop, ITG *nk, ITG **ipkonfp, ITG **konp, char **lakonfp,
NNEW(icol,ITG,*nef);
NNEW(jq,ITG,*nef+1);
NNEW(ja,ITG,*nef+1);
-// NNEW(nactdoh,ITG,*nef);
mastructf(nk,kon,ipkonf,lakonf,nef,icol,jq,&mast1,&irow,
isolver,&neq,ipointer,&nzs,ipnei,neiel,mi);
-// printf("Unterschied start\n");
-// for(i=0;i<*ne;i++){if(i+1!=nactdoh[i]){printf("Unterschied i=%d,nactdoh[i]=%d\n",i+1,nactdoh[i]);}}
-// printf("Unterschied end\n");
-
SFREE(ipointer);SFREE(mast1);
/* calculation geometric data */
@@ -258,7 +253,7 @@ void compfluid(double **cop, ITG *nk, ITG **ipkonfp, ITG **konp, char **lakonfp,
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));
+ nactdohinv,&compressible,&iatleastonepressurebc));
RENEW(ifabou,ITG,nfabou);
/* catalogueing the nodes for output purposes (interpolation at
@@ -345,8 +340,9 @@ void compfluid(double **cop, ITG *nk, ITG **ipkonfp, ITG **konp, char **lakonfp,
if(*nmpc>0){
is=1;ie=3;
FORTRAN(applympc,(nface,ielfa,&is,&ie,ifabou,ipompc,vfa,coefmpc,
- nodempc,ipnei,neifa,labmpc,xbounact,nactdoh));
- }
+ nodempc,ipnei,neifa,labmpc,xbounact,nactdoh,
+ ifaext,nfaext));
+ }
/* extrapolation of the pressure at the element centers
to the face centers */
@@ -359,7 +355,8 @@ void compfluid(double **cop, ITG *nk, ITG **ipkonfp, ITG **konp, char **lakonfp,
if(*nmpc>0){
is=4;ie=4;
FORTRAN(applympc,(nface,ielfa,&is,&ie,ifabou,ipompc,vfa,coefmpc,
- nodempc,ipnei,neifa,labmpc,xbounact,nactdoh));
+ nodempc,ipnei,neifa,labmpc,xbounact,nactdoh,
+ ifaext,nfaext));
}
/* extrapolation of the temperature at the element centers
@@ -374,7 +371,8 @@ void compfluid(double **cop, ITG *nk, ITG **ipkonfp, ITG **konp, char **lakonfp,
if(*nmpc>0){
is=0;ie=0;
FORTRAN(applympc,(nface,ielfa,&is,&ie,ifabou,ipompc,vfa,coefmpc,
- nodempc,ipnei,neifa,labmpc,xbounact,nactdoh));
+ nodempc,ipnei,neifa,labmpc,xbounact,nactdoh,
+ ifaext,nfaext));
}
/* calculating the heat conduction at the face centers */
@@ -413,6 +411,11 @@ void compfluid(double **cop, ITG *nk, ITG **ipkonfp, ITG **konp, char **lakonfp,
FORTRAN(calcrhofacomp,(nface,vfa,shcon,ielmatf,ntmat_,
mi,ielfa));
+ /* calculating the density at the element centers */
+
+ FORTRAN(calcrhoelcomp,(nef,vel,shcon,ielmatf,ntmat_,
+ mi));
+
}
/* calculating the initial mass flux */
@@ -464,19 +467,15 @@ void compfluid(double **cop, ITG *nk, ITG **ipkonfp, ITG **konp, char **lakonfp,
NNEW(inum,ITG,*nk);
NNEW(velo,double,6**nef);
- NNEW(veloo,double,6**nef);
+ if(compressible==0) NNEW(veloo,double,6**nef);
/* initializing velo and veloo */
- memcpy(&veloo[0],&vel[0],sizeof(double)*6**nef);
+ if(compressible==0) memcpy(&veloo[0],&vel[0],sizeof(double)*6**nef);
memcpy(&velo[0],&vel[0],sizeof(double)*6**nef);
iincf=0;
-/* a1=1.5;
- a2=-2.;
- a3=0.5;*/
-
if(*tincf<=0.) *tincf=tincfguess;
printf("time increment for the CFD-calculations = %e\n\n",*tincf);
@@ -492,23 +491,6 @@ void compfluid(double **cop, ITG *nk, ITG **ipkonfp, ITG **konp, char **lakonfp,
iincf++;
- if(compressible==10){
- /* calculating the time increment */
-
- FORTRAN(calcguesstincf,(nface,&dmin,vfa,umfa,cvfa,hcfa,ithermal,
- &tincfguess,&compressible));
- dtimefold=dtimef;
- dtimef=tincfguess;
-
- betatime=-(dtimef+dtimefold)*(dtimef+dtimefold)/(dtimef*dtimef);
- alphatime=1.-betatime;
- gammatime=(1.+betatime)*dtimef+dtimefold;
-
- a1=-alphatime/gammatime;
- a2=-betatime/gammatime;
- a3=-1./gammatime;
- }
-
printf("fluid increment = %d\n",iincf);
timef+=dtimef;
@@ -573,67 +555,102 @@ void compfluid(double **cop, ITG *nk, ITG **ipkonfp, ITG **konp, char **lakonfp,
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));
+
/* calculating the density at the element centers */
- FORTRAN(calcrhoel,(nef,vel,rhcon,nrhcon,ielmatf,ntmat_,
- ithermal,mi));
+// 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));
+// FORTRAN(calcrhofa,(nface,vfa,rhcon,nrhcon,ielmatf,ntmat_,
+//// ithermal,mi,ielfa));
/* calculating the specific heat at constant volume at the
element centers (secant value) */
- FORTRAN(calccvel,(nef,vel,shcon,nshcon,ielmatf,ntmat_,
- mi,cvel,physcon));
+// FORTRAN(calccvel,(nef,vel,shcon,nshcon,ielmatf,ntmat_,
+// mi,cvel,physcon));
/* 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));
+// FORTRAN(calccvfa,(nface,vfa,shcon,nshcon,ielmatf,ntmat_,
+// mi,ielfa,cvfa,physcon));
+
+ /* calculating the dynamic viscosity at the face centers */
+
+// FORTRAN(calcumfa,(nface,vfa,shcon,nshcon,ielmatf,ntmat_,
+// ithermal,mi,ielfa,umfa));
+
+ /* calculating the dynamic viscosity at the element centers */
+
+// FORTRAN(calcumel,(nef,vel,shcon,nshcon,ielmatf,ntmat_,
+// ithermal,mi,umel));
+
+ /* calculating the heat conduction at the face centers */
+
+// FORTRAN(calchcfa,(nface,vfa,cocon,ncocon,ielmatf,ntmat_,
+// mi,ielfa,hcfa));
}else{
+ /* calculating material data
+ density (elements+faces)
+ 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));
+
/* calculating the density at the element centers */
- FORTRAN(calcrhoelcomp,(nef,vel,shcon,ielmatf,ntmat_,
- mi));
+// FORTRAN(calcrhoelcomp,(nef,vel,shcon,ielmatf,ntmat_,
+// mi));
/* calculating the density at the face centers */
- FORTRAN(calcrhofacomp,(nface,vfa,shcon,ielmatf,ntmat_,
- mi,ielfa));
+// FORTRAN(calcrhofacomp,(nface,vfa,shcon,ielmatf,ntmat_,
+// mi,ielfa));
/* calculating the specific heat at constant volume at the
element centers (secant value) */
- FORTRAN(calccvelcomp,(nef,vel,shcon,nshcon,ielmatf,ntmat_,
- mi,cvel,physcon));
+// FORTRAN(calccvelcomp,(nef,vel,shcon,nshcon,ielmatf,ntmat_,
+// mi,cvel,physcon));
/* 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));
- }
+// FORTRAN(calccvfacomp,(nface,vfa,shcon,nshcon,ielmatf,ntmat_,
+// mi,ielfa,cvfa,physcon));
- /* calculating the dynamic viscosity at the face centers */
-
- FORTRAN(calcumfa,(nface,vfa,shcon,nshcon,ielmatf,ntmat_,
- ithermal,mi,ielfa,umfa));
+ /* calculating the dynamic viscosity at the face centers */
+
+// FORTRAN(calcumfa,(nface,vfa,shcon,nshcon,ielmatf,ntmat_,
+// ithermal,mi,ielfa,umfa));
- /* calculating the dynamic viscosity at the element centers */
-
- FORTRAN(calcumel,(nef,vel,shcon,nshcon,ielmatf,ntmat_,
- ithermal,mi,umel));
+ /* calculating the dynamic viscosity at the element centers */
+
+// FORTRAN(calcumel,(nef,vel,shcon,nshcon,ielmatf,ntmat_,
+// ithermal,mi,umel));
- /* calculating the heat conduction at the face centers */
+ /* calculating the heat conduction at the face centers */
- FORTRAN(calchcfa,(nface,vfa,cocon,ncocon,ielmatf,ntmat_,
- mi,ielfa,hcfa));
+// FORTRAN(calchcfa,(nface,vfa,cocon,ncocon,ielmatf,ntmat_,
+// mi,ielfa,hcfa));
+ }
}
@@ -648,13 +665,6 @@ void compfluid(double **cop, ITG *nk, ITG **ipkonfp, ITG **konp, char **lakonfp,
centers to the face centers */
FORTRAN(extrapolate_gradvel,(nface,ielfa,xrlfa,gradvel,gradvfa));
-
- /* calculate gamma (Ph.D. Thesis Jasak) */
-
-/* betam=0.1;
- NNEW(gamma,double,*nface);
- FORTRAN(calcgamma,(nface,ielfa,vel,gradvfa,gamma,xlet,xxn,xxj,
- ipnei,&betam,nef));*/
/* filling the lhs and rhs's for the balance of momentum
equations */
@@ -664,73 +674,26 @@ void compfluid(double **cop, ITG *nk, ITG **ipkonfp, ITG **konp, char **lakonfp,
DMEMSET(bv,0,3*neq,0.);
if(compressible==0){
- FORTRAN(mafillv,(nef,ipnei,neifa,neiel,vfa,xxn,area,
+ mafillvmain(nef,ipnei,neifa,neiel,vfa,xxn,area,
auv,adv,jq,irow,&nzs,bv,vel,cosa,umfa,xlet,xle,gradvfa,xxi,
body,volume,ielfa,lakonf,ifabou,nbody,&neq,
&dtimef,velo,veloo,sel,xrlfa,gamma,xxj,nactdohinv,&a1,
- &a2,&a3,flux));
+ &a2,&a3,flux);
}else{
- FORTRAN(mafillvcomp,(nef,ipnei,neifa,neiel,vfa,xxn,area,
+
+ /* calculate gamma (Ph.D. Thesis Jasak) */
+
+/* betam=0.1;
+ NNEW(gamma,double,*nface);
+ FORTRAN(calcgamma,(nface,ielfa,vel,gradvel,gamma,xlet,xxn,xxj,
+ ipnei,&betam,nef,flux));*/
+ mafillvcompmain(nef,ipnei,neifa,neiel,vfa,xxn,area,
auv,adv,jq,irow,&nzs,bv,vel,cosa,umfa,xlet,xle,gradvfa,xxi,
body,volume,ielfa,lakonf,ifabou,nbody,&neq,
&dtimef,velo,veloo,sel,xrlfa,gamma,xxj,nactdohinv,&a1,
- &a2,&a3,flux));
- }
- // SFREE(gamma);
-
- /* LU decomposition (asymmetric system) */
-
-/* inputformat=1;
- symmetryflag=2;
-
- if(*isolver==0){
-#ifdef SPOOLES
- spooles_factor(adv,auv,adb,aub,&sigma,icol,irow,&neq,&nzs,
- &symmetryflag,&inputformat,&nzs);
-#else
- printf("*ERROR in compfluid: the SPOOLES library is not linked\n\n");
- FORTRAN(stop,());
-#endif
+ &a2,&a3,flux);
+// SFREE(gamma);
}
- else if(*isolver==7){
-#ifdef PARDISO
- pardiso_factor(adv,auv,adb,aub,&sigma,icol,irow,&neq,&nzs,
- &symmetryflag,&inputformat,jq,&nzs);
-#else
- printf("*ERROR in compfluid: the PARDISO library is not linked\n\n");
- FORTRAN(stop,());
-#endif
-}*/
-
- /* solving the system of equations (for x, y and z
- separately */
-
-/* for(i=0;i<3;i++){
-
- if(*isolver==0){
-#ifdef SPOOLES
- spooles_solve(&bv[i*neq],&neq);
-#endif
- }
- else if(*isolver==7){
-#ifdef PARDISO
- pardiso_solve(&bv[i*neq],&neq,&symmetryflag);
-#endif
- }
- }*/
-
- /* free memory */
-
-/* if(*isolver==0){
-#ifdef SPOOLES
- spooles_cleanup();
-#endif
- }
- else if(*isolver==7){
-#ifdef PARDISO
- pardiso_cleanup(&neq,&symmetryflag);
-#endif
-}*/
memcpy(&auv[2*nzs],adv,sizeof(double)*neq);
nelt=2*nzs+neq;
@@ -772,23 +735,17 @@ void compfluid(double **cop, ITG *nk, ITG **ipkonfp, ITG **konp, char **lakonfp,
}
SFREE(rgwk);SFREE(igwk);
- /* if(compressible==1){
- for(i=0;i<neq;i++){
- vel[neq+i]-=(1.-urelax)*(vel[neq+i]-velo[neq+i]);
- vel[2*neq+i]-=(1.-urelax)*(vel[2*neq+i]-velo[2*neq+i]);
- vel[3*neq+i]-=(1.-urelax)*(vel[3*neq+i]-velo[3*neq+i]);
- }
- }*/
-
- /* storing the solution into vel */
-
-// FORTRAN(calcpel,(ne,nactdoh,vel,bv,&neq,ne));
-
/* calculating the pressure gradient at the element
centers */
- for(iitf=0;iitf<2;iitf++){
-// for(iitf=0;iitf<1;iitf++){
+ if(compressible==1){
+ jit=100;
+// jit=3;
+ }else{
+ jit=2;
+ }
+
+ for(iitf=0;iitf<jit;iitf++){
memcpy(&hel[0],&sel[0],sizeof(double)*(3*neq));
@@ -803,14 +760,6 @@ void compfluid(double **cop, ITG *nk, ITG **ipkonfp, ITG **konp, char **lakonfp,
}else{
FORTRAN(extrapolate_ad_h_comp,(nface,ielfa,xrlfa,adv,advfa,hel,hfa));
}
-
- /* applying MPC's to the faces for the pseudo-velocity hfa */
-
-// if(*nmpc>0){
-// is=1;ie=3;
-// FORTRAN(applympc_hfa,(nface,ielfa,&is,&ie,ifabou,ipompc,hfa,coefmpc,
-// nodempc,ipnei,neifa,labmpc,xbounact,nactdoh));
-// }
/* calculating the lhs and rhs of the equation system to determine
p (balance of mass) */
@@ -832,36 +781,14 @@ void compfluid(double **cop, ITG *nk, ITG **ipkonfp, ITG **konp, char **lakonfp,
DMEMSET(ad,0,neq,0.);
DMEMSET(au,0,nzs,0.);
- FORTRAN(mafillp,(nef,lakonf,ipnei,neifa,neiel,vfa,area,
+ mafillpmain(nef,lakonf,ipnei,neifa,neiel,vfa,area,
advfa,xlet,cosa,volume,au,ad,jq,irow,ap,
- ielfa,ifabou,xle,b,xxn,&compressible,&neq,
- &nzs,hfa,gradpel,bp,xxi,neij,xlen,cosb));
+ ielfa,ifabou,xle,b,xxn,&neq,
+ &nzs,hfa,gradpel,bp,xxi,neij,xlen,cosb,
+ &iatleastonepressurebc);
FORTRAN(convert2slapcol,(au,ad,irow,ia,jq,ja,&nzs,&neq,aua));
- /* LU decomposition of the p system (symmetric system) */
-
-/* inputformat=0;
- symmetryflag=0;
-
- if(*isolver==0){
-#ifdef SPOOLES
- spooles_factor(ad,au,adb,aub,&sigma,icol,irow,&neq,&nzs,
- &symmetryflag,&inputformat,&nzs);
-#else
- printf("*ERROR in compfluid: 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);
-#else
- printf("*ERROR in compfluid: the PARDISO library is not linked\n\n");
- FORTRAN(stop,());
-#endif
- }*/
}else{
/* calculating the pressure gradient at the element
@@ -873,30 +800,13 @@ void compfluid(double **cop, ITG *nk, ITG **ipkonfp, ITG **konp, char **lakonfp,
/* second, third.. iteration: calculate the rhs only */
- FORTRAN(rhsp,(nef,lakonf,nactdoh,ipnei,neifa,neiel,vfa,area,
- advfa,xlet,cosa,volume,au,ad,jq,irow,ap,ielfa,ifabou,xle,
- b,xxn,&compressible,&neq,&nzs,hfa,bp,neij,xxi,
- gradpel,xlen));
+ rhspmain(nef,lakonf,ipnei,neifa,neiel,vfa,area,
+ advfa,xlet,cosa,volume,au,ad,jq,irow,ap,ielfa,ifabou,xle,
+ b,xxn,&neq,&nzs,hfa,gradpel,bp,xxi,neij,xlen,
+ &iatleastonepressurebc);
}
- /* solving the system of equations for p */
-
-/* if(*isolver==0){
- #ifdef SPOOLES
- spooles_solve(b,&neq);
- #endif
- }
- else if(*isolver==7){
- #ifdef PARDISO
- pardiso_solve(b,&neq,&symmetryflag);
- #endif
- }*/
-
- /* dslugm; attention: convert2slapcol changes au! */
-
-// FORTRAN(convert2slapcol,(au,ad,irow,ia,jq,ja,&nzs,&neq,aua));
-
nelt=nzs+neq;
isym=1;
nsave=10;
@@ -919,10 +829,6 @@ void compfluid(double **cop, ITG *nk, ITG **ipkonfp, ITG **konp, char **lakonfp,
printf(" err=%e\n",err);
}
- /* storing the solution p into vel(4,*) */
-
-// FORTRAN(calcvel,(nef,nactdoh,vel,b,nef));
-
/* extrapolation of the pressure at the element centers
to the face centers */
@@ -936,70 +842,19 @@ void compfluid(double **cop, ITG *nk, ITG **ipkonfp, ITG **konp, char **lakonfp,
DMEMSET(ad,0,neq,0.);
DMEMSET(au,0,2*nzs,0.);
+
+// printf("before mafillpcompmain \n");
- FORTRAN(mafillpcomp,(nef,lakonf,ipnei,neifa,neiel,vfa,area,
- advfa,xlet,cosa,volume,au,ad,jq,irow,ap,
- ielfa,ifabou,xle,b,xxn,
- &nzs,hfa,gradpel,bp,xxi,neij,xlen,cosb,
- ielmatf,mi,&a1,&a2,&a3,velo,veloo,&dtimef,shcon,
- ntmat_,vel,nactdohinv,xrlfa));
-
- /* LU decomposition (asymmetric system) */
-
-/* inputformat=1;
- symmetryflag=2;
-
- if(*isolver==0){
-#ifdef SPOOLES
- spooles_factor(ad,au,adb,aub,&sigma,icol,irow,&neq,&nzs,
- &symmetryflag,&inputformat,&nzs);
-#else
- printf("*ERROR in compfluid: 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);
-#else
- printf("*ERROR in compfluid: the PARDISO library is not linked\n\n");
- FORTRAN(stop,());
-#endif
-}*/
-
- /* solving the system of equations (for x, y and z
- separately */
-
-/* if(*isolver==0){
-#ifdef SPOOLES
- spooles_solve(b,&neq);
-#endif
- }
- else if(*isolver==7){
-#ifdef PARDISO
- pardiso_solve(b,&neq,&symmetryflag);
-#endif
-}*/
-
- /* free memory */
-
- /* if(*isolver==0){
-#ifdef SPOOLES
- spooles_cleanup();
-#endif
- }
- else if(*isolver==7){
-#ifdef PARDISO
- pardiso_cleanup(&neq,&symmetryflag);
-#endif
-}*/
-
- /* adding the solution dp to vel(4,*) */
-
-// FORTRAN(calcpel,(nef,nactdoh,vel,b,nef));
+ mafillpcompmain(nef,lakonf,ipnei,neifa,neiel,vfa,area,
+ advfa,xlet,cosa,volume,au,ad,jq,irow,ap,
+ ielfa,ifabou,xle,b,xxn,&neq,
+ &nzs,hfa,gradpel,bp,xxi,neij,xlen,cosb,
+ ielmatf,mi,&a1,&a2,&a3,velo,veloo,&dtimef,shcon,
+ ntmat_,vel,nactdohinv,xrlfa,flux);
+
+// printf("after mafillpcompmain \n");
- memcpy(&au[2*nzs],ad,sizeof(double)*neq);
+ memcpy(&au[2*nzs],ad,sizeof(double)*neq);
nelt=2*nzs+neq;
isym=0;
itol=0;
@@ -1024,29 +879,10 @@ void compfluid(double **cop, ITG *nk, ITG **ipkonfp, ITG **konp, char **lakonfp,
&ligw,rwork,iwork));
for(i=0;i<neq;i++){
-/* if(fabs(dp[i])<0.01*vel[4*neq+i]){*/
-// vel[4*neq+i]+=dp[i];
-/* }else{
- vel[4*neq+i]+=0.01*vel[4*neq+1]*dp[i]/fabs(dp[i]);
- }*/
-
-// vel[4*neq+i]+=0.2*dp[i];
-// vel[4*neq+i]=velo[4*neq+i]+dp[i];
-// printf("dp/p= %e\n",dp[i]/vel[4*neq+i]);
- vel[4*neq+i]=velo[4*neq+i]+0.2*dp[i];
-
-/* if(fabs(dp[i])<0.01*velo[4*neq+i]){
- velo[4*neq+i]+=dp[i];
- }else{
- velo[4*neq+i]+=0.01*velo[4*neq+1]*dp[i]/fabs(dp[i]);
- }*/
+ vel[4*neq+i]+=0.2*dp[i];
}
SFREE(dp);
-/* FORTRAN(predgmres,(&neq,&b[0],&vel[4*neq],&nelt,irow,jq,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 (p)=%d\n",ierr);
@@ -1062,15 +898,9 @@ void compfluid(double **cop, ITG *nk, ITG **ipkonfp, ITG **konp, char **lakonfp,
if(*nmpc>0){
is=4;ie=4;
FORTRAN(applympc,(nface,ielfa,&is,&ie,ifabou,ipompc,vfa,coefmpc,
- nodempc,ipnei,neifa,labmpc,xbounact,nactdoh));
+ nodempc,ipnei,neifa,labmpc,xbounact,nactdoh,
+ ifaext,nfaext));
}
-
- /* calculating the density at the face centers */
-
- if(compressible!=0){
- FORTRAN(calcrhofacomp,(nface,vfa,shcon,ielmatf,ntmat_,
- mi,ielfa));
- }
/* correction of the velocity at the element centers due
to the pressure change */
@@ -1078,136 +908,121 @@ void compfluid(double **cop, ITG *nk, ITG **ipkonfp, ITG **konp, char **lakonfp,
FORTRAN(correctvel,(hel,adv,vfa,ipnei,area,&vel[neq],xxn,neifa,
lakonf,nef,&neq));
- /* correction of the temperature for iitf=0 */
-
- if((iitf<1)&&(compressible==10)){
-
- /* 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));
-
- /* extrapolating the velocity from the elements centers to the face
- centers, thereby taking the boundary conditions into account */
-
- FORTRAN(extrapolate_vel,(nface,ielfa,xrlfa,vel,vfa,
- ifabou,xbounact,ipnei,nef));
-
- /* applying MPC's to the faces */
-
- if(*nmpc>0){
- is=1;ie=3;
- FORTRAN(applympc,(nface,ielfa,&is,&ie,ifabou,ipompc,vfa,coefmpc,
- nodempc,ipnei,neifa,labmpc,xbounact,nactdoh));
- }
-
- /* calculating the temperature gradient at the element
- centers */
-
- DMEMSET(gradtel,0,3**nef,0.);
- FORTRAN(calcgradtel,(nef,lakonf,ipnei,vfa,area,xxn,gradtel,neifa,
- volume));
-
- /* extrapolating the temperature gradient from the element
- centers to the face centers */
-
- FORTRAN(extrapolate_gradtel,(nface,ielfa,xrlfa,gradtel,gradtfa));
-
- /* calculating the gradient of the velocity at the element
- centers */
-
- DMEMSET(gradvel,0,9**nef,0.);
- FORTRAN(calcgradvel,(nef,lakonf,ipnei,vfa,area,xxn,gradvel,neifa,
- volume));
-
- /* calculating the lhs and rhs of the energy equation */
-
- DMEMSET(ad,0,neq,0.);
- DMEMSET(au,0,2*nzs,0.);
- DMEMSET(b,0,neq,0.);
-
- if(compressible==0){
- FORTRAN(mafillt,(nef,ipnei,neifa,neiel,vfa,xxn,area,
- au,ad,jq,irow,&nzs,b,vel,umel,xlet,xle,gradtfa,xxi,
- body,volume,&compressible,ielfa,lakonf,ifabou,nbody,&neq,
- &dtimef,velo,veloo,cvfa,hcfa,cvel,gradvel,xload,gammat,
- xrlfa,xxj,nactdohinv,&a1,&a2,&a3,flux));
- }else{
- FORTRAN(mafilltcomp,(nef,ipnei,neifa,neiel,vfa,xxn,area,
- au,ad,jq,irow,&nzs,b,vel,umel,xlet,xle,gradtfa,xxi,
- body,volume,&compressible,ielfa,lakonf,ifabou,nbody,&neq,
- &dtimef,velo,veloo,cvfa,hcfa,cvel,gradvel,xload,gammat,
- xrlfa,xxj,nactdohinv,&a1,&a2,&a3,flux));
- }
-
- memcpy(&au[2*nzs],ad,sizeof(double)*neq);
- nelt=2*nzs+neq;
- isym=0;
- itol=0;
- tol=0.;
- itmax=0;
- iunit=0;
- lrgw=131+16*neq;
- NNEW(rgwk,double,lrgw);
- NNEW(igwk,ITG,20);
- igwk[0]=10;
- igwk[1]=10;
- igwk[2]=0;
- igwk[3]=1;
- igwk[4]=10;
- ligw=20;
- for(i=0;i<neq;i++){rwork[i]=1./ad[i];}
- FORTRAN(predgmres,(&neq,&b[0],&vel[0],&nelt,irow,jq,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(extrapolate_tel,(nface,ielfa,xrlfa,vel,vfa,
- ifabou,xbounact,ipnei,nef));
-
- /* applying MPC's to the faces */
-
- if(*nmpc>0){
- is=0;ie=0;
- FORTRAN(applympc,(nface,ielfa,&is,&ie,ifabou,ipompc,vfa,coefmpc,
- nodempc,ipnei,neifa,labmpc,xbounact,nactdoh));
- }
-
- /* calculating the density at the face centers */
-
- FORTRAN(calcrhofacomp,(nface,vfa,shcon,ielmatf,ntmat_,
+ 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 temperature gradient at the element
+ centers */
+
+ DMEMSET(gradtel,0,3**nef,0.);
+ FORTRAN(calcgradtel,(nef,lakonf,ipnei,vfa,area,xxn,gradtel,neifa,
+ volume));
+
+ /* extrapolating the temperature gradient from the element
+ centers to the face centers */
+
+ FORTRAN(extrapolate_gradtel,(nface,ielfa,xrlfa,gradtel,gradtfa));
+
+ /* calculating the lhs and rhs of the energy equation */
+
+ DMEMSET(ad,0,neq,0.);
+ DMEMSET(au,0,2*nzs,0.);
+ DMEMSET(b,0,neq,0.);
+
+ mafilltcompmain(nef,ipnei,neifa,neiel,vfa,xxn,area,
+ au,ad,jq,irow,&nzs,b,vel,umel,xlet,xle,gradtfa,xxi,
+ body,volume,ielfa,lakonf,ifabou,nbody,&neq,
+ &dtimef,velo,veloo,cvfa,hcfa,cvel,gradvel,xload,gammat,
+ xrlfa,xxj,nactdohinv,&a1,&a2,&a3,flux);
+
+// SFREE(gammat);
+
+ memcpy(&au[2*nzs],ad,sizeof(double)*neq);
+ nelt=2*nzs+neq;
+ isym=0;
+ itol=0;
+ tol=0.;
+ itmax=0;
+ iunit=0;
+ lrgw=131+16*neq;
+ NNEW(rgwk,double,lrgw);
+ NNEW(igwk,ITG,20);
+ igwk[0]=10;
+ igwk[1]=10;
+ igwk[2]=0;
+ igwk[3]=1;
+ igwk[4]=10;
+ ligw=20;
+ for(i=0;i<neq;i++){rwork[i]=1./ad[i];}
+ FORTRAN(predgmres,(&neq,&b[0],&vel[0],&nelt,irow,jq,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(extrapolate_tel,(nface,ielfa,xrlfa,vel,vfa,
+ ifabou,xbounact,ipnei,nef));
+
+ /* applying MPC's to the faces */
+
+ if(*nmpc>0){
+ is=0;ie=0;
+ FORTRAN(applympc,(nface,ielfa,&is,&ie,ifabou,ipompc,vfa,coefmpc,
+ nodempc,ipnei,neifa,labmpc,xbounact,nactdoh,
+ ifaext,nfaext));
+ }
+
+ /* calculating the density at the face centers */
+
+ FORTRAN(calcrhofacomp,(nface,vfa,shcon,ielmatf,ntmat_,
mi,ielfa));
-
- }
-
- }
-
- /* free memory */
-
- /* if(*isolver==0){
-#ifdef SPOOLES
- spooles_cleanup();
-#endif
+
+ /* calculating the density at the element centers */
+
+ FORTRAN(calcrhoelcomp,(nef,vel,shcon,ielmatf,ntmat_,
+ mi));
+
+ 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;}
+ }
+
}
- else if(*isolver==7){
-#ifdef PARDISO
- pardiso_cleanup(&neq,&symmetryflag);
-#endif
-}*/
/* adding the velocity correction at the face centers
due to the balance of mass =>
@@ -1249,57 +1064,20 @@ void compfluid(double **cop, ITG *nk, ITG **ipkonfp, ITG **konp, char **lakonfp,
DMEMSET(b,0,neq,0.);
if(compressible==0){
- FORTRAN(mafillt,(nef,ipnei,neifa,neiel,vfa,xxn,area,
+ mafilltmain(nef,ipnei,neifa,neiel,vfa,xxn,area,
au,ad,jq,irow,&nzs,b,vel,umel,xlet,xle,gradtfa,xxi,
- body,volume,&compressible,ielfa,lakonf,ifabou,nbody,&neq,
+ body,volume,ielfa,lakonf,ifabou,nbody,&neq,
&dtimef,velo,veloo,cvfa,hcfa,cvel,gradvel,xload,gammat,
- xrlfa,xxj,nactdohinv,&a1,&a2,&a3,flux));
+ xrlfa,xxj,nactdohinv,&a1,&a2,&a3,flux);
}else{
- FORTRAN(mafilltcomp,(nef,ipnei,neifa,neiel,vfa,xxn,area,
+ mafilltcompmain(nef,ipnei,neifa,neiel,vfa,xxn,area,
au,ad,jq,irow,&nzs,b,vel,umel,xlet,xle,gradtfa,xxi,
- body,volume,&compressible,ielfa,lakonf,ifabou,nbody,&neq,
+ body,volume,ielfa,lakonf,ifabou,nbody,&neq,
&dtimef,velo,veloo,cvfa,hcfa,cvel,gradvel,xload,gammat,
- xrlfa,xxj,nactdohinv,&a1,&a2,&a3,flux));
+ xrlfa,xxj,nactdohinv,&a1,&a2,&a3,flux);
}
// SFREE(gammat);
-
- /* solving the asymmetric system of equations */
-
- /* inputformat=1;
- symmetryflag=2;
-
- if(*isolver==0){
-#ifdef SPOOLES
- spooles(ad,au,adb,aub,&sigma,b,icol,irow,&neq,&nzs,
- &symmetryflag,&inputformat,&nzs);
-#else
- printf("*ERROR in compfluid: the SPOOLES 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);
-#else
- printf("*ERROR in compfluid: the PARDISO library is not linked\n\n");
- FORTRAN(stop,());
-#endif
-}*/
-
- /* free memory */
-
- /* if(*isolver==0){
-#ifdef SPOOLES
- spooles_cleanup();
-#endif
- }
- else if(*isolver==7){
-#ifdef PARDISO
- pardiso_cleanup(&neq,&symmetryflag);
-#endif
-}*/
memcpy(&au[2*nzs],ad,sizeof(double)*neq);
nelt=2*nzs+neq;
@@ -1326,10 +1104,6 @@ void compfluid(double **cop, ITG *nk, ITG **ipkonfp, ITG **konp, char **lakonfp,
if(ierr>0){
printf("*WARNING in compfluid: error message from predgmres (T)=%d\n",ierr);
}
-
- /* storing the solution t into vel(0,*) */
-
-// FORTRAN(calctel,(ne,nactdoh,vel,b,ne));
/* extrapolation of the temperature at the element centers
to the face centers */
@@ -1342,14 +1116,11 @@ void compfluid(double **cop, ITG *nk, ITG **ipkonfp, ITG **konp, char **lakonfp,
if(*nmpc>0){
is=0;ie=0;
FORTRAN(applympc,(nface,ielfa,&is,&ie,ifabou,ipompc,vfa,coefmpc,
- nodempc,ipnei,neifa,labmpc,xbounact,nactdoh));
+ nodempc,ipnei,neifa,labmpc,xbounact,nactdoh,
+ ifaext,nfaext));
}
}
-
- /* storing the solution into vel */
-
-// FORTRAN(calcvel,(ne,nactdoh,vel,bv,&neq,ne));
/* extrapolating the velocity from the elements centers to the face
centers, thereby taking the boundary conditions into account */
@@ -1362,7 +1133,8 @@ void compfluid(double **cop, ITG *nk, ITG **ipkonfp, ITG **konp, char **lakonfp,
if(*nmpc>0){
is=1;ie=3;
FORTRAN(applympc,(nface,ielfa,&is,&ie,ifabou,ipompc,vfa,coefmpc,
- nodempc,ipnei,neifa,labmpc,xbounact,nactdoh));
+ nodempc,ipnei,neifa,labmpc,xbounact,nactdoh,
+ ifaext,nfaext));
}
// FORTRAN(writevfa,(vfa,nface,nactdohinv,ielfa));
@@ -1381,20 +1153,16 @@ void compfluid(double **cop, ITG *nk, ITG **ipkonfp, ITG **konp, char **lakonfp,
if(velnorm[0]/(*nef)>1.e-10){
relnormt=fabs(velnorm[0]-velnormo[0])/(velnormo[0]);
if(relnormt>relnormmax) relnormmax=relnormt;
-// printf("relative temperature norm = %d,%e\n",iit,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;
-// printf("relative velocity norm = %d,%e\n",iit,relnormv);
}
if(velnorm[4]/(*nef)>1.e-10){
relnormp=fabs(velnorm[4]-velnormo[4])/(velnormo[4]);
if(relnormp>relnormmax) relnormmax=relnormp;
-// printf("relative pressure norm = %d,%e\n",iit,relnormp);
}
-// printf("\n");
if(iit==1){
fprintf(f1,"%11.4e %11.4e %11.4e\n",relnormt,relnormv,relnormp);
}
@@ -1402,11 +1170,14 @@ void compfluid(double **cop, ITG *nk, ITG **ipkonfp, ITG **konp, char **lakonfp,
memcpy(velnormo,velnorm,sizeof(double)*5);
if((*nmethod==1)&&(compressible!=1)){
+
+ /* steady state incompressible flow */
+
if(relnormmax<1.e-5) iconvergence=1;
break;
}else{
if(relnormmax<1.e-3)break;
-// if((relnormmax<1.e-3)||(compressible==1))break;
+ if((compressible==1)&&(iit==1))break;
}
}while(1);
@@ -1516,7 +1287,9 @@ void compfluid(double **cop, ITG *nk, ITG **ipkonfp, ITG **konp, char **lakonfp,
FORTRAN(frdfluid,(co,nk,kon,ipkonf,lakonf,nef,vold,&kode,&timef,ielmatf,
matname,filab,inum,ntrans,inotr,trab,mi,istep,
- stn,qfn,nactdohinv,xmach,xkappa));
+ stn,qfn,nactdohinv,xmach,xkappa,physcon));
+
+// FORTRAN(writevfa,(vfa,nface,nactdohinv,ielfa));
if((strcmp1(&filab[3306],"SF ")==0)||
(strcmp1(&filab[3480],"SVF ")==0)){SFREE(stn);}
@@ -1544,7 +1317,7 @@ void compfluid(double **cop, ITG *nk, ITG **ipkonfp, ITG **konp, char **lakonfp,
}
- memcpy(&veloo[0],&velo[0],sizeof(double)*6**nef);
+ if(compressible==0) memcpy(&veloo[0],&velo[0],sizeof(double)*6**nef);
memcpy(&velo[0],&vel[0],sizeof(double)*6**nef);
}while(1);
@@ -1569,7 +1342,7 @@ void compfluid(double **cop, ITG *nk, ITG **ipkonfp, ITG **konp, char **lakonfp,
SFREE(gradtel);SFREE(gradtfa);SFREE(hcfa);SFREE(cvel);SFREE(cvfa);
}
- SFREE(inum);SFREE(v);SFREE(velo);SFREE(veloo);
+ SFREE(inum);SFREE(v);SFREE(velo);if(compressible==0) SFREE(veloo);
SFREE(iponofa);SFREE(inofa);
diff --git a/ccx_2.9/src/complete_hel.f b/ccx_2.10/src/complete_hel.f
similarity index 84%
rename from ccx_2.9/src/complete_hel.f
rename to ccx_2.10/src/complete_hel.f
index 46af914..e6f4c49 100644
--- a/ccx_2.9/src/complete_hel.f
+++ b/ccx_2.10/src/complete_hel.f
@@ -28,10 +28,6 @@
!
integer irow(*),neq,nzs,j,l,jdof1,jq(*)
real*8 hel(3,*),bv(neq,3),auv(*),adv(*)
-c write(*,*) 'complete_hel1 ',hel(1,1),hel(2,1),hel(3,1)
-c do j=1,neq
-c write(*,*) 'complete_hel_1 ',j,hel(1,j),hel(2,j),hel(3,j)
-c enddo
!
! off-diagonal terms
!
@@ -52,10 +48,6 @@ c enddo
hel(3,j)=hel(3,j)-auv(l+nzs)*bv(jdof1,3)
enddo
enddo
-c write(*,*) 'complete_hel2 ',hel(1,1),hel(2,1),hel(3,1)
-c do j=1,neq
-c write(*,*) 'complete_hel ',j,bv(j,1),bv(j,2),bv(j,3)
-c enddo
!
return
end
diff --git a/ccx_2.9/src/complexfreq.c b/ccx_2.10/src/complexfreq.c
similarity index 99%
rename from ccx_2.9/src/complexfreq.c
rename to ccx_2.10/src/complexfreq.c
index 6dc5f7d..bdd2e39 100644
--- a/ccx_2.9/src/complexfreq.c
+++ b/ccx_2.10/src/complexfreq.c
@@ -512,7 +512,7 @@ void complexfreq(double **cop, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
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));
+ ttime,&time0,istep,&iinc,ibody,ielprop,prop));
/* zc = damping matrix * eigenmodes */
diff --git a/ccx_2.9/src/complexfrequencys.f b/ccx_2.10/src/complexfrequencys.f
similarity index 100%
rename from ccx_2.9/src/complexfrequencys.f
rename to ccx_2.10/src/complexfrequencys.f
diff --git a/ccx_2.9/src/conductivitys.f b/ccx_2.10/src/conductivitys.f
similarity index 100%
rename from ccx_2.9/src/conductivitys.f
rename to ccx_2.10/src/conductivitys.f
diff --git a/ccx_2.9/src/contact.c b/ccx_2.10/src/contact.c
similarity index 98%
rename from ccx_2.9/src/contact.c
rename to ccx_2.10/src/contact.c
index 46616c8..8e878dc 100644
--- a/ccx_2.9/src/contact.c
+++ b/ccx_2.10/src/contact.c
@@ -101,7 +101,8 @@ void contact(ITG *ncont, ITG *ntie, char *tieset,ITG *nset,char *set,
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));
+ clearini,theta,xstateini,xstate,nstate_,ne0,icutb,ialeatoric,
+ nmethod));
}
diff --git a/ccx_2.9/src/contactdampings.f b/ccx_2.10/src/contactdampings.f
similarity index 100%
rename from ccx_2.9/src/contactdampings.f
rename to ccx_2.10/src/contactdampings.f
diff --git a/ccx_2.9/src/contactpairs.f b/ccx_2.10/src/contactpairs.f
similarity index 100%
rename from ccx_2.9/src/contactpairs.f
rename to ccx_2.10/src/contactpairs.f
diff --git a/ccx_2.9/src/contactprints.f b/ccx_2.10/src/contactprints.f
similarity index 100%
rename from ccx_2.9/src/contactprints.f
rename to ccx_2.10/src/contactprints.f
diff --git a/ccx_2.9/src/controlss.f b/ccx_2.10/src/controlss.f
similarity index 100%
rename from ccx_2.9/src/controlss.f
rename to ccx_2.10/src/controlss.f
diff --git a/ccx_2.9/src/convert2slapcol.f b/ccx_2.10/src/convert2slapcol.f
similarity index 100%
rename from ccx_2.9/src/convert2slapcol.f
rename to ccx_2.10/src/convert2slapcol.f
diff --git a/ccx_2.9/src/coriolissolve.f b/ccx_2.10/src/coriolissolve.f
similarity index 100%
rename from ccx_2.9/src/coriolissolve.f
rename to ccx_2.10/src/coriolissolve.f
diff --git a/ccx_2.9/src/correctvel.f b/ccx_2.10/src/correctvel.f
similarity index 81%
rename from ccx_2.9/src/correctvel.f
rename to ccx_2.10/src/correctvel.f
index 1052bee..f8e275a 100644
--- a/ccx_2.9/src/correctvel.f
+++ b/ccx_2.10/src/correctvel.f
@@ -17,7 +17,7 @@
! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
!
subroutine correctvel(hel,adv,vfa,ipnei,area,bv,xxn,neifa,
- & lakon,ne,neq)
+ & lakonf,nef,neq)
!
! correction of the velocity at the element centers due to the
! pressure change (balance of mass)
@@ -26,14 +26,18 @@
!
implicit none
!
- character*8 lakon(*)
+ character*8 lakonf(*)
!
- integer i,j,k,ne,jdof1,indexf,ipnei(*),neifa(*),ifa,
+ integer i,j,k,nef,jdof1,indexf,ipnei(*),neifa(*),ifa,
& neq,numfaces
!
real*8 bv(neq,3),hel(3,*),adv(*),xxn(3,*),area(*),vfa(0:5,*)
!
- do i=1,ne
+c$omp parallel default(none)
+c$omp& shared(nef,bv,ipnei,lakonf,neifa,vfa,area,xxn,hel,adv)
+c$omp& private(i,jdof1,k,indexf,numfaces,j,ifa)
+c$omp do
+ do i=1,nef
!
jdof1=i
do k=1,3
@@ -41,9 +45,9 @@
enddo
indexf=ipnei(i)
!
- if(lakon(i)(4:4).eq.'8') then
+ if(lakonf(i)(4:4).eq.'8') then
numfaces=6
- elseif(lakon(i)(4:4).eq.'6') then
+ elseif(lakonf(i)(4:4).eq.'6') then
numfaces=5
else
numfaces=4
@@ -56,13 +60,13 @@
& +vfa(4,ifa)*area(ifa)*xxn(k,indexf)
enddo
enddo
-c write(*,*) 'correctvel1 ',i,bv(jdof1,1),bv(jdof1,2),bv(jdof1,3)
!
do k=1,3
bv(jdof1,k)=(hel(k,jdof1)-bv(jdof1,k))/adv(jdof1)
enddo
-c write(*,*) 'correctvel2 ',i,bv(jdof1,1),bv(jdof1,2),bv(jdof1,3)
enddo
+c$omp end do
+c$omp end parallel
!
return
end
diff --git a/ccx_2.9/src/correctvfa.f b/ccx_2.10/src/correctvfa.f
similarity index 83%
rename from ccx_2.9/src/correctvfa.f
rename to ccx_2.10/src/correctvfa.f
index 0a801d6..c826a18 100644
--- a/ccx_2.9/src/correctvfa.f
+++ b/ccx_2.10/src/correctvfa.f
@@ -32,6 +32,10 @@
real*8 ap(*),bp(*),area(*),vfa(0:5,*),xxn(3,*),flux(*),
& hfa(3,*),vel(nef,0:5),dh,xboun(*),totflux
!
+c$omp parallel default(none)
+c$omp& shared(nface,ielfa,ipnei,area,ap,vfa,hfa,xxn,vel,bp,ifabou,xboun)
+c$omp& private(i,iel1,j,indexf,iel2,dh,k,indexb)
+c$omp do
do i=1,nface
!
! first neighboring element
@@ -56,7 +60,7 @@
& hfa(3,i)*xxn(3,indexf)
do k=1,3
!
-! bp applies if the neighbor element has a lower
+! bp applies if the neighbor element has a higher
! number than the observer element, else a negative
! sign has to be appended
!
@@ -80,11 +84,6 @@
& (ifabou(-iel2+3).eq.0)).and.
& (ifabou(-iel2+5).eq.0)) then
indexb=ifabou(-iel2+4)
-ccccc
-c dh=hfa(1,i)*xxn(1,indexf)+
-c & hfa(2,i)*xxn(2,indexf)+
-c & hfa(3,i)*xxn(3,indexf)
-ccccc
if(indexb.ne.0) then
!
! external face with pressure boundary condition
@@ -97,23 +96,21 @@ ccccc
& (xboun(indexb)-vel(iel1,4)+bp(i)))
& *xxn(k,indexf)
enddo
-ccccc
-c else
-c do k=1,3
-c vfa(k,i)=(dh)
-c & *xxn(k,indexf)
-c enddo
-ccccc
endif
endif
endif
-c write(*,*) 'correctvfa ',iel1,j,hfa(1,i),hfa(2,i),hfa(3,i),dh
enddo
+c$omp end do
+c$omp end parallel
!
! check conservation of mass
!
+c$omp parallel default(none)
+c$omp& shared(nef,ipnei,lakonf,neifa,ielfa,ifabou,flux,area,vfa,xxn)
+c$omp& private(i,totflux,indexf,numfaces,j,ifa)
+c$omp do
do i=1,nef
- totflux=0.d0
+c totflux=0.d0
indexf=ipnei(i)
if(lakonf(i)(4:4).eq.'8') then
numfaces=6
@@ -129,7 +126,6 @@ c write(*,*) 'correctvfa ',iel1,j,hfa(1,i),hfa(2,i),hfa(3,i),dh
if(ielfa(2,ifa).lt.0) then
if(ifabou(-ielfa(2,ifa)+5).eq.2) then
flux(indexf)=0.d0
-c write(*,*) 'correctvfa ',i,j,flux(indexf)
cycle
endif
endif
@@ -138,11 +134,19 @@ c write(*,*) 'correctvfa ',i,j,flux(indexf)
& (vfa(1,ifa)*xxn(1,indexf)+
& vfa(2,ifa)*xxn(2,indexf)+
& vfa(3,ifa)*xxn(3,indexf))
-c write(*,*) 'correctvfa ',i,j,flux(indexf)
- totflux=totflux+flux(indexf)
+c write(*,*) 'correctvfa ',i,j,ifa
+c write(*,*) vfa(5,ifa)
+c write(*,*) vfa(1,ifa)
+c write(*,*) vfa(2,ifa)
+c write(*,*) vfa(3,ifa)
+c write(*,*) flux(ifa)
+c totflux=totflux+flux(indexf)
enddo
c write(*,*) 'correctvfa mass check ',i,totflux
enddo
+c$omp end do
+c$omp end parallel
+c write(*,*)
!
return
end
diff --git a/ccx_2.9/src/couptempdisps.f b/ccx_2.10/src/couptempdisps.f
similarity index 100%
rename from ccx_2.9/src/couptempdisps.f
rename to ccx_2.10/src/couptempdisps.f
diff --git a/ccx_2.9/src/cp_corrected.f b/ccx_2.10/src/cp_corrected.f
similarity index 100%
rename from ccx_2.9/src/cp_corrected.f
rename to ccx_2.10/src/cp_corrected.f
diff --git a/ccx_2.9/src/createinterfacempcs.f b/ccx_2.10/src/createinterfacempcs.f
similarity index 100%
rename from ccx_2.9/src/createinterfacempcs.f
rename to ccx_2.10/src/createinterfacempcs.f
diff --git a/ccx_2.9/src/createinum.f b/ccx_2.10/src/createinum.f
similarity index 100%
rename from ccx_2.9/src/createinum.f
rename to ccx_2.10/src/createinum.f
diff --git a/ccx_2.9/src/createmddof.f b/ccx_2.10/src/createmddof.f
similarity index 97%
rename from ccx_2.9/src/createmddof.f
rename to ccx_2.10/src/createmddof.f
index d26aec8..7aa46ca 100644
--- a/ccx_2.9/src/createmddof.f
+++ b/ccx_2.10/src/createmddof.f
@@ -44,24 +44,24 @@
& imdnode(*),nmdnode,imdmpc(*),nmdmpc,nprint,ipos,
& imdboun(*),nmdboun,ikboun(*),nboun,indexe1,indexe,islav,
& jface,nset,ntie,nnodelem,nope,nodef(8),nelem,nface,imast,
- & ifaceq(9,6),ifacet(7,4),ifacew1(4,5),ifacew2(8,5),kon(*),
+ & ifaceq(8,6),ifacet(6,4),ifacew1(4,5),ifacew2(8,5),kon(*),
& ipkon(*),i,ilboun(*),nlabel,ne,cyclicsymmetry
!
! nodes per face for hex elements
!
- data ifaceq /4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/
+ data ifaceq /4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/
!
! nodes per face for tet elements
!
- data ifacet /1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/
+ data ifacet /1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/
!
! nodes per face for linear wedge elements
!
@@ -79,7 +79,7 @@
& 2,3,6,5,8,15,11,14,
& 3,1,4,6,9,13,12,15/
!
- data nlabel /46/
+ data nlabel /47/
!
! if 1d/2d elements are part of the mesh, no node selection
! is performed (because of the renumbering due to the
diff --git a/ccx_2.9/src/createmdelem.f b/ccx_2.10/src/createmdelem.f
similarity index 100%
rename from ccx_2.9/src/createmdelem.f
rename to ccx_2.10/src/createmdelem.f
diff --git a/ccx_2.9/src/createtiedsurfs.f b/ccx_2.10/src/createtiedsurfs.f
similarity index 100%
rename from ccx_2.9/src/createtiedsurfs.f
rename to ccx_2.10/src/createtiedsurfs.f
diff --git a/ccx_2.9/src/creep.f b/ccx_2.10/src/creep.f
similarity index 100%
rename from ccx_2.9/src/creep.f
rename to ccx_2.10/src/creep.f
diff --git a/ccx_2.10/src/creeps.f b/ccx_2.10/src/creeps.f
new file mode 100644
index 0000000..3a8185b
--- /dev/null
+++ b/ccx_2.10/src/creeps.f
@@ -0,0 +1,184 @@
+!
+! CalculiX - A 3-dimensional finite element program
+! Copyright (C) 1998-2015 Guido Dhondt
+!
+! This program is free software; you can redistribute it and/or
+! modify it under the terms of the GNU General Public License as
+! published by the Free Software Foundation(version 2);
+!
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program; if not, write to the Free Software
+! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+!
+ subroutine creeps(inpc,textpart,nelcon,nmat,ntmat_,npmat_,
+ & plicon,nplicon,elcon,iplas,iperturb,nstate_,ncmat_,
+ & matname,irstrt,istep,istat,n,iline,ipol,inl,ipoinp,inp,
+ & ipoinpc)
+!
+! reading the input deck: *CREEP
+!
+ implicit none
+!
+ logical iso
+!
+ character*1 inpc(*)
+ character*80 matname(*)
+ character*132 textpart(16)
+!
+ integer nelcon(2,*),nmat,ntmat_,ntmat,istep,npmat_,nstate_,
+ & n,key,i,j,iplas,iperturb(*),istat,nplicon(0:ntmat_,*),ncmat_,
+ & k,id,irstrt,iline,ipol,inl,ipoinp(2,*),inp(3,*),ipoinpc(0:*)
+!
+ real*8 temperature,elcon(0:ncmat_,ntmat_,*),t1l,
+ & plicon(0:2*npmat_,ntmat_,*)
+!
+ iso=.true.
+ ntmat=0
+!
+ if((istep.gt.0).and.(irstrt.ge.0)) then
+ write(*,*) '*ERROR reading *CREEP: *CREEP should be placed'
+ write(*,*) ' before all step definitions'
+ call exit(201)
+ endif
+!
+ if(nmat.eq.0) then
+ write(*,*) '*ERROR reading *CREEP: *CREEP should be preceded'
+ write(*,*) ' by a *MATERIAL card'
+ call exit(201)
+ endif
+!
+! check for anisotropic creep: assumes a ucreep routine
+!
+ if((nelcon(1,nmat).ne.2).and.(nelcon(1,nmat).ne.-51)) then
+ write(*,*) '*ERROR reading *CREEP: *CREEP should be'
+ write(*,*) ' preceded by an *ELASTIC,TYPE=ISO card'
+ call exit(201)
+ endif
+!
+! if the *CREEP card is not preceded by a *PLASTIC card, a zero
+! yield surface is assumed
+!
+! elastic isotropic
+! plasticity or no plasticity
+! creep (Norton or user): -52
+!
+ if(nelcon(1,nmat).ne.-51) then
+!
+! elastic isotropic
+! no plasticity -> zero yield plasticity
+! creep (Norton or user)
+!
+ nplicon(0,nmat)=1
+ nplicon(1,nmat)=2
+ plicon(0,1,nmat)=0.d0
+ plicon(1,1,nmat)=0.d0
+ plicon(2,1,nmat)=0.d0
+ plicon(3,1,nmat)=0.d0
+ plicon(4,1,nmat)=10.d10
+ endif
+!
+ iperturb(1)=3
+ iplas=1
+ nelcon(1,nmat)=-52
+ nstate_=max(nstate_,13)
+!
+ do i=2,n
+ if(textpart(i)(1:8).eq.'LAW=USER') then
+ do j=1,nelcon(2,nmat)
+ elcon(3,j,nmat)=-1.d0
+ enddo
+ call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
+ & ipoinp,inp,ipoinpc)
+ return
+ else
+ write(*,*)
+ & '*WARNING reading *CREEP: parameter not recognized:'
+ write(*,*) ' ',
+ & textpart(i)(1:index(textpart(i),' ')-1)
+ call inputwarning(inpc,ipoinpc,iline,
+ &"*CREEP%")
+ endif
+ enddo
+!
+! before interpolation: data are stored in positions 6-9:
+! A,n,m,temperature
+! after interpolation: data are stored in positions 3-5:
+! A,n,m
+!
+ do
+ call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
+ & ipoinp,inp,ipoinpc)
+ if((istat.lt.0).or.(key.eq.1)) exit
+ ntmat=ntmat+1
+ if(ntmat.gt.ntmat_) then
+ write(*,*) '*ERROR reading *CREEP: increase ntmat_'
+ call exit(201)
+ endif
+ do i=1,3
+ read(textpart(i)(1:20),'(f20.0)',iostat=istat)
+ & elcon(i+5,ntmat,nmat)
+ if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
+ &"*CREEP%")
+ enddo
+ if(elcon(6,ntmat,nmat).le.0.d0) then
+ write(*,*) '*ERROR reading *CREEP: parameter A'
+ write(*,*) ' in the Norton law is nonpositive'
+ call exit(201)
+ endif
+ if(elcon(7,ntmat,nmat).le.0.d0) then
+ write(*,*) '*ERROR reading *CREEP: parameter n'
+ write(*,*) ' in the Norton law is nonpositive'
+ call exit(201)
+ endif
+ if(textpart(4)(1:1).ne.' ') then
+ read(textpart(4)(1:20),'(f20.0)',iostat=istat)
+ & temperature
+ if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
+ &"*CREEP%")
+ else
+ temperature=0.d0
+ endif
+ elcon(9,ntmat,nmat)=temperature
+ enddo
+!
+ if(ntmat.eq.0) then
+ write(*,*) '*ERROR reading *CREEP: Norton law assumed,'
+ write(*,*) ' yet no constants given'
+ call exit(201)
+ endif
+!
+! interpolating the creep data at the elastic temperature
+! data points
+!
+ do i=1,nelcon(2,nmat)
+ t1l=elcon(0,i,nmat)
+ call ident2(elcon(9,1,nmat),t1l,ntmat,ncmat_+1,id)
+ if(ntmat.eq.0) then
+ continue
+ elseif((ntmat.eq.1).or.(id.eq.0)) then
+ elcon(3,i,nmat)=elcon(6,1,nmat)
+ elcon(4,i,nmat)=elcon(7,1,nmat)
+ elcon(5,i,nmat)=elcon(8,1,nmat)
+ elseif(id.eq.ntmat) then
+ elcon(3,i,nmat)=elcon(6,id,nmat)
+ elcon(4,i,nmat)=elcon(7,id,nmat)
+ elcon(5,i,nmat)=elcon(8,id,nmat)
+ else
+ do k=3,5
+ elcon(k,i,nmat)=elcon(k+3,id,nmat)+
+ & (elcon(k+3,id+1,nmat)-elcon(k+3,id,nmat))*
+ & (t1l-elcon(9,id,nmat))/
+ & (elcon(9,id+1,nmat)-elcon(9,id,nmat))
+ enddo
+ endif
+ enddo
+!
+ return
+ end
+
diff --git a/ccx_2.9/src/cross_split.f b/ccx_2.10/src/cross_split.f
similarity index 100%
rename from ccx_2.9/src/cross_split.f
rename to ccx_2.10/src/cross_split.f
diff --git a/ccx_2.9/src/cubic.f b/ccx_2.10/src/cubic.f
similarity index 100%
rename from ccx_2.9/src/cubic.f
rename to ccx_2.10/src/cubic.f
diff --git a/ccx_2.9/src/cubtri.f b/ccx_2.10/src/cubtri.f
similarity index 100%
rename from ccx_2.9/src/cubtri.f
rename to ccx_2.10/src/cubtri.f
diff --git a/ccx_2.9/src/cyclichardenings.f b/ccx_2.10/src/cyclichardenings.f
similarity index 100%
rename from ccx_2.9/src/cyclichardenings.f
rename to ccx_2.10/src/cyclichardenings.f
diff --git a/ccx_2.9/src/cyclicsymmetrymodels.f b/ccx_2.10/src/cyclicsymmetrymodels.f
similarity index 97%
rename from ccx_2.9/src/cyclicsymmetrymodels.f
rename to ccx_2.10/src/cyclicsymmetrymodels.f
index caab6d5..31c5179 100644
--- a/ccx_2.9/src/cyclicsymmetrymodels.f
+++ b/ccx_2.10/src/cyclicsymmetrymodels.f
@@ -63,7 +63,7 @@
& inp(3,*),itie,iset,ipos,mcs,lprev,ntie,ithermal,ncounter,
& nrcg(*),nzcg(*),jcs(*),kontri(3,*),ne,ipkon(*),kon(*),nodei,
& ifacetet(*),inodface(*),ipoinpc(0:*),maxsectors,id,jfaces,
- & noden(2),ntrans,ntrans_,cfd,mi(*),ifaceq(9,6),ifacet(7,4),
+ & noden(2),ntrans,ntrans_,cfd,mi(*),ifaceq(8,6),ifacet(6,4),
& ifacew1(4,5),ifacew2(8,5),idof
!
real*8 tolloc,co(3,*),coefmpc(*),rcs(*),zcs(*),rcs0(*),zcs0(*),
@@ -74,19 +74,19 @@
!
! nodes per face for hex elements
!
- data ifaceq /4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/
+ data ifaceq /4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/
!
! nodes per face for tet elements
!
- data ifacet /1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/
+ data ifacet /1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/
!
! nodes per face for linear wedge elements
!
@@ -352,8 +352,6 @@ c iaxial=max(iaxial,maxsectors)
nopes=4
elseif(lakon(nelems)(4:5).eq.'10') then
nopes=6
- elseif(lakon(nelems)(4:5).eq.'14') then
- nopes=7
elseif(lakon(nelems)(4:4).eq.'4') then
nopes=3
endif
@@ -550,8 +548,6 @@ c iaxial=max(iaxial,maxsectors)
nopes=4
elseif(lakon(nelems)(4:5).eq.'10') then
nopes=6
- elseif(lakon(nelems)(4:5).eq.'14') then
- nopes=7
elseif(lakon(nelems)(4:4).eq.'4') then
nopes=3
endif
@@ -775,8 +771,6 @@ c enddo
nopes=4
elseif(lakon(nelems)(4:5).eq.'10') then
nopes=6
- elseif(lakon(nelems)(4:5).eq.'14') then
- nopes=7
elseif(lakon(nelems)(4:4).eq.'4') then
nopes=3
endif
diff --git a/ccx_2.9/src/dKdX.f b/ccx_2.10/src/dKdX.f
similarity index 100%
rename from ccx_2.9/src/dKdX.f
rename to ccx_2.10/src/dKdX.f
diff --git a/ccx_2.9/src/dKdm.f b/ccx_2.10/src/dKdm.f
similarity index 100%
rename from ccx_2.9/src/dKdm.f
rename to ccx_2.10/src/dKdm.f
diff --git a/ccx_2.9/src/dKdp.f b/ccx_2.10/src/dKdp.f
similarity index 100%
rename from ccx_2.9/src/dKdp.f
rename to ccx_2.10/src/dKdp.f
diff --git a/ccx_2.9/src/dKdt.f b/ccx_2.10/src/dKdt.f
similarity index 100%
rename from ccx_2.9/src/dKdt.f
rename to ccx_2.10/src/dKdt.f
diff --git a/ccx_2.9/src/dampings.f b/ccx_2.10/src/dampings.f
similarity index 100%
rename from ccx_2.9/src/dampings.f
rename to ccx_2.10/src/dampings.f
diff --git a/ccx_2.9/src/dashdamp.f b/ccx_2.10/src/dashdamp.f
similarity index 100%
rename from ccx_2.9/src/dashdamp.f
rename to ccx_2.10/src/dashdamp.f
diff --git a/ccx_2.9/src/dashforc.f b/ccx_2.10/src/dashforc.f
similarity index 100%
rename from ccx_2.9/src/dashforc.f
rename to ccx_2.10/src/dashforc.f
diff --git a/ccx_2.9/src/dashpots.f b/ccx_2.10/src/dashpots.f
similarity index 100%
rename from ccx_2.9/src/dashpots.f
rename to ccx_2.10/src/dashpots.f
diff --git a/ccx_2.10/src/date.pl b/ccx_2.10/src/date.pl
new file mode 100755
index 0000000..2eca35f
--- /dev/null
+++ b/ccx_2.10/src/date.pl
@@ -0,0 +1,22 @@
+#!/usr/bin/perl
+
+chomp($date=`date`);
+
+# inserting the date into ccx_2.10.c
+
+ at ARGV="ccx_2.10.c";
+$^I=".old";
+while(<>){
+ s/You are using an executable made on.*/You are using an executable made on $date\\n");/g;
+ print;
+}
+
+ at ARGV="frd.c";
+$^I=".old";
+while(<>){
+ s/COMPILETIME.*/COMPILETIME $date \\n\",p1);/g;
+ print;
+}
+
+system "rm -f ccx_2.10.c.old";
+system "rm -f frd.c.old";
diff --git a/ccx_2.9/src/dattime.f b/ccx_2.10/src/dattime.f
similarity index 100%
rename from ccx_2.9/src/dattime.f
rename to ccx_2.10/src/dattime.f
diff --git a/ccx_2.9/src/ddeabm.f b/ccx_2.10/src/ddeabm.f
similarity index 100%
rename from ccx_2.9/src/ddeabm.f
rename to ccx_2.10/src/ddeabm.f
diff --git a/ccx_2.9/src/ddebdf.f b/ccx_2.10/src/ddebdf.f
similarity index 100%
rename from ccx_2.9/src/ddebdf.f
rename to ccx_2.10/src/ddebdf.f
diff --git a/ccx_2.9/src/deformationplasticitys.f b/ccx_2.10/src/deformationplasticitys.f
similarity index 100%
rename from ccx_2.9/src/deformationplasticitys.f
rename to ccx_2.10/src/deformationplasticitys.f
diff --git a/ccx_2.9/src/defplas.f b/ccx_2.10/src/defplas.f
similarity index 100%
rename from ccx_2.9/src/defplas.f
rename to ccx_2.10/src/defplas.f
diff --git a/ccx_2.9/src/delaun.f b/ccx_2.10/src/delaun.f
similarity index 100%
rename from ccx_2.9/src/delaun.f
rename to ccx_2.10/src/delaun.f
diff --git a/ccx_2.9/src/deltri.f b/ccx_2.10/src/deltri.f
similarity index 100%
rename from ccx_2.9/src/deltri.f
rename to ccx_2.10/src/deltri.f
diff --git a/ccx_2.9/src/densitys.f b/ccx_2.10/src/densitys.f
similarity index 100%
rename from ccx_2.9/src/densitys.f
rename to ccx_2.10/src/densitys.f
diff --git a/ccx_2.9/src/depvars.f b/ccx_2.10/src/depvars.f
similarity index 100%
rename from ccx_2.9/src/depvars.f
rename to ccx_2.10/src/depvars.f
diff --git a/ccx_2.9/src/designvariabless.f b/ccx_2.10/src/designvariabless.f
similarity index 100%
rename from ccx_2.9/src/designvariabless.f
rename to ccx_2.10/src/designvariabless.f
diff --git a/ccx_2.9/src/deuldlag.f b/ccx_2.10/src/deuldlag.f
similarity index 100%
rename from ccx_2.9/src/deuldlag.f
rename to ccx_2.10/src/deuldlag.f
diff --git a/ccx_2.9/src/dfdbj.c b/ccx_2.10/src/dfdbj.c
similarity index 100%
rename from ccx_2.9/src/dfdbj.c
rename to ccx_2.10/src/dfdbj.c
diff --git a/ccx_2.9/src/dflux.f b/ccx_2.10/src/dflux.f
similarity index 96%
rename from ccx_2.9/src/dflux.f
rename to ccx_2.10/src/dflux.f
index 4b2563c..25aa0b9 100644
--- a/ccx_2.9/src/dflux.f
+++ b/ccx_2.10/src/dflux.f
@@ -107,7 +107,7 @@
! an example for combined mechanical-lubrication problems.
! Please replace it by your own code for your concrete application.
!
- integer ifaceq(9,6),ifacet(7,4),ifacew(8,5),ig,nelem,nopes,
+ integer ifaceq(8,6),ifacet(6,4),ifacew(8,5),ig,nelem,nopes,
& iflag,i,j,k,nope
!
real*8 xl21(3,9),xi,et,al,rho,um,h,pnode1(3),pnode2(3),
@@ -122,16 +122,16 @@
!
include "gauss.f"
!
- ifaceq=reshape((/4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/),(/9,6/))
- ifacet=reshape((/1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/),(/7,4/))
+ ifaceq=reshape((/4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/),(/8,6/))
+ ifacet=reshape((/1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/),(/6,4/))
ifacew=reshape((/1,3,2,9,8,7,0,0,
& 4,5,6,10,11,12,0,0,
& 1,2,5,4,7,14,10,13,
diff --git a/ccx_2.9/src/dfluxs.f b/ccx_2.10/src/dfluxs.f
similarity index 100%
rename from ccx_2.9/src/dfluxs.f
rename to ccx_2.10/src/dfluxs.f
diff --git a/ccx_2.9/src/dgesv.f b/ccx_2.10/src/dgesv.f
similarity index 100%
rename from ccx_2.9/src/dgesv.f
rename to ccx_2.10/src/dgesv.f
diff --git a/ccx_2.9/src/dgmres.f b/ccx_2.10/src/dgmres.f
similarity index 100%
rename from ccx_2.9/src/dgmres.f
rename to ccx_2.10/src/dgmres.f
diff --git a/ccx_2.9/src/dir.f b/ccx_2.10/src/dir.f
similarity index 100%
rename from ccx_2.9/src/dir.f
rename to ccx_2.10/src/dir.f
diff --git a/ccx_2.10/src/distattach.f b/ccx_2.10/src/distattach.f
new file mode 100644
index 0000000..caf0a7b
--- /dev/null
+++ b/ccx_2.10/src/distattach.f
@@ -0,0 +1,113 @@
+!
+! CalculiX - A 3-dimensional finite element program
+! Copyright (C) 1998-2015 Guido Dhondt
+!
+! This program is free software; you can redistribute it and/or
+! modify it under the terms of the GNU General Public License as
+! published by the Free Software Foundation(version 2);
+!
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program; if not, write to the Free Software
+! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+!
+ subroutine distattach(xig,etg,pneigh,pnode,a,p,ratio,nterms)
+!
+! calculates the distance between the node with coordinates
+! in "pnode" and the node with local coordinates xig and etg
+! in a face described by "nterms" nodes with coordinates
+! in pneigh
+!
+ implicit none
+!
+ integer nterms,i,j
+!
+ real*8 ratio(9),pneigh(3,*),pnode(3),a,xi,et,xig,etg,p(3),
+ & dummy,fxi1,fxi2,fxi3,fet1,fet2,fet3,b,xip,xim,etp,etm,
+ & xim2,etm2,a2,xi2,et2
+!
+ intent(in) xig,etg,pneigh,pnode,nterms
+!
+ intent(inout) ratio,a,p
+!
+ if(nterms.eq.3) then
+ if(xig+etg.le.0.d0) then
+ ratio(2)=(xig+1.d0)/2.d0
+ ratio(3)=(etg+1.d0)/2.d0
+ else
+ ratio(2)=(1.d0-etg)/2.d0
+ ratio(3)=(1.d0-xig)/2.d0
+ endif
+ ratio(1)=1.d0-ratio(2)-ratio(3)
+ elseif(nterms.eq.4) then
+ xip=(1.d0+xig)/4.d0
+ xim=(1.d0-xig)/4.d0
+ etp=1.d0+etg
+ etm=1.d0-etg
+ ratio(1)=xim*etm
+ ratio(2)=xip*etm
+ ratio(3)=xip*etp
+ ratio(4)=xim*etp
+ elseif(nterms.eq.6) then
+ if(xig+etg.le.0.d0) then
+ xi=(xig+1.d0)/2.d0
+ et=(etg+1.d0)/2.d0
+ else
+ xi=(1.d0-etg)/2.d0
+ et=(1.d0-xig)/2.d0
+ endif
+ a=1.d0-xi-et
+ a2=2.d0*a
+ xi2=2.d0*xi
+ et2=2.d0*et
+ ratio(1)=a*(a2-1.d0)
+ ratio(2)=xi*(xi2-1.d0)
+ ratio(3)=et*(et2-1.d0)
+ ratio(4)=xi2*a2
+ ratio(5)=xi2*et2
+ ratio(6)=et2*a2
+ elseif(nterms.eq.8) then
+ xip=1.d0+xig
+ xim=1.d0-xig
+ xim2=xip*xim/2.d0
+ etp=1.d0+etg
+ etm=1.d0-etg
+ etm2=etp*etm/2.d0
+ ratio(5)=xim2*etm
+ ratio(6)=xip*etm2
+ ratio(7)=xim2*etp
+ ratio(8)=xim*etm2
+ xim=xim/4.d0
+ xip=xip/4.d0
+ ratio(1)=xim*etm*(-xig-etp)
+ ratio(2)=xip*etm*(xig-etp)
+ ratio(3)=xip*etp*(xig-etm)
+ ratio(4)=xim*etp*(-xig-etm)
+ else
+ write(*,*) '*ERROR in distattach: case with ',nterms
+ write(*,*) ' terms is not covered'
+ call exit(201)
+ endif
+!
+! calculating the position in the face
+!
+ do i=1,3
+ p(i)=0.d0
+ do j=1,nterms
+ p(i)=p(i)+ratio(j)*pneigh(i,j)
+ enddo
+ enddo
+!
+! calculating the distance
+!
+ a=(pnode(1)-p(1))**2+(pnode(2)-p(2))**2+(pnode(3)-p(3))**2
+!
+c write(*,*) 'distattach.f xi,et,dist**2',xig,etg,a
+ return
+ end
+
diff --git a/ccx_2.9/src/distattach_3d.f b/ccx_2.10/src/distattach_3d.f
similarity index 100%
rename from ccx_2.9/src/distattach_3d.f
rename to ccx_2.10/src/distattach_3d.f
diff --git a/ccx_2.9/src/distattachline.f b/ccx_2.10/src/distattachline.f
similarity index 100%
rename from ccx_2.9/src/distattachline.f
rename to ccx_2.10/src/distattachline.f
diff --git a/ccx_2.9/src/distributingcouplings.f b/ccx_2.10/src/distributingcouplings.f
similarity index 100%
rename from ccx_2.9/src/distributingcouplings.f
rename to ccx_2.10/src/distributingcouplings.f
diff --git a/ccx_2.9/src/dload.f b/ccx_2.10/src/dload.f
similarity index 95%
rename from ccx_2.9/src/dload.f
rename to ccx_2.10/src/dload.f
index 56e4f3f..a787e86 100644
--- a/ccx_2.9/src/dload.f
+++ b/ccx_2.10/src/dload.f
@@ -116,7 +116,7 @@
! an example for combined mechanical-lubrication problems.
! Please replace it by your own code for your concrete application.
!
- integer ifaceq(9,6),ifacet(7,4),ifacew(8,5),ig,nelem,nopes,
+ integer ifaceq(8,6),ifacet(6,4),ifacew(8,5),ig,nelem,nopes,
& iflag,i,j,nope,ipompc(*),nodempc(3,*),nmpc,ikmpc(*),ilmpc(*),
& node,idof,id
!
@@ -125,16 +125,16 @@
!
include "gauss.f"
!
- ifaceq=reshape((/4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/),(/9,6/))
- ifacet=reshape((/1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/),(/7,4/))
+ ifaceq=reshape((/4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/),(/8,6/))
+ ifacet=reshape((/1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/),(/6,4/))
ifacew=reshape((/1,3,2,9,8,7,0,0,
& 4,5,6,10,11,12,0,0,
& 1,2,5,4,7,14,10,13,
diff --git a/ccx_2.9/src/dloads.f b/ccx_2.10/src/dloads.f
similarity index 100%
rename from ccx_2.9/src/dloads.f
rename to ccx_2.10/src/dloads.f
diff --git a/ccx_2.9/src/dlz.f b/ccx_2.10/src/dlz.f
similarity index 100%
rename from ccx_2.9/src/dlz.f
rename to ccx_2.10/src/dlz.f
diff --git a/ccx_2.9/src/dqag.f b/ccx_2.10/src/dqag.f
similarity index 100%
rename from ccx_2.9/src/dqag.f
rename to ccx_2.10/src/dqag.f
diff --git a/ccx_2.9/src/drfftf.f b/ccx_2.10/src/drfftf.f
similarity index 100%
rename from ccx_2.9/src/drfftf.f
rename to ccx_2.10/src/drfftf.f
diff --git a/ccx_2.9/src/dslugm.f b/ccx_2.10/src/dslugm.f
similarity index 100%
rename from ccx_2.9/src/dslugm.f
rename to ccx_2.10/src/dslugm.f
diff --git a/ccx_2.9/src/dsort.f b/ccx_2.10/src/dsort.f
similarity index 100%
rename from ccx_2.9/src/dsort.f
rename to ccx_2.10/src/dsort.f
diff --git a/ccx_2.9/src/dyna.c b/ccx_2.10/src/dyna.c
similarity index 100%
rename from ccx_2.9/src/dyna.c
rename to ccx_2.10/src/dyna.c
diff --git a/ccx_2.9/src/dynacont.c b/ccx_2.10/src/dynacont.c
similarity index 100%
rename from ccx_2.9/src/dynacont.c
rename to ccx_2.10/src/dynacont.c
diff --git a/ccx_2.9/src/dynamic_viscosity.f b/ccx_2.10/src/dynamic_viscosity.f
similarity index 100%
rename from ccx_2.9/src/dynamic_viscosity.f
rename to ccx_2.10/src/dynamic_viscosity.f
diff --git a/ccx_2.9/src/dynamics.f b/ccx_2.10/src/dynamics.f
similarity index 100%
rename from ccx_2.9/src/dynamics.f
rename to ccx_2.10/src/dynamics.f
diff --git a/ccx_2.9/src/dynboun.c b/ccx_2.10/src/dynboun.c
similarity index 100%
rename from ccx_2.9/src/dynboun.c
rename to ccx_2.10/src/dynboun.c
diff --git a/ccx_2.9/src/dynresults.f b/ccx_2.10/src/dynresults.f
similarity index 100%
rename from ccx_2.9/src/dynresults.f
rename to ccx_2.10/src/dynresults.f
diff --git a/ccx_2.9/src/e_c3d.f b/ccx_2.10/src/e_c3d.f
similarity index 94%
rename from ccx_2.9/src/e_c3d.f
rename to ccx_2.10/src/e_c3d.f
index 9ca77f2..c7f33c2 100644
--- a/ccx_2.9/src/e_c3d.f
+++ b/ccx_2.10/src/e_c3d.f
@@ -50,14 +50,14 @@
character*80 matname(*),amat
character*81 tieset(3,*)
!
- integer konl(26),ifaceq(9,6),nelemload(2,*),nbody,nelem,
+ integer konl(26),ifaceq(8,6),nelemload(2,*),nbody,nelem,
& mi(*),iloc,jfaces,igauss,mortar,kon(*),ielprop(*),null,
& mattyp,ithermal,iperturb(*),nload,idist,i,j,k,l,i1,i2,j1,
& nmethod,k1,l1,ii,jj,ii1,jj1,id,ipointer,ig,m1,m2,m3,m4,kk,
& nelcon(2,*),nrhcon(*),nalcon(2,*),ielmat(mi(3),*),six,
& ielorien(mi(3),*),ilayer,nlayer,ki,kl,ipkon(*),indexe,
& ntmat_,nope,nopes,norien,ihyper,iexpl,kode,imat,mint2d,
- & mint3d,ifacet(7,4),nopev,iorien,istiff,ncmat_,iface,
+ & mint3d,ifacet(6,4),nopev,iorien,istiff,ncmat_,iface,
& ifacew(8,5),intscheme,n,ipointeri,ipointerj,istep,iinc,
& layer,kspt,jltyp,iflag,iperm(60),m,ipompc(*),nodempc(3,*),
& nmpc,ikmpc(*),ilmpc(*),iscale,nstate_,ne0,iselect(6),kscale,
@@ -101,16 +101,16 @@
!
include "gauss.f"
!
- ifaceq=reshape((/4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/),(/9,6/))
- ifacet=reshape((/1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/),(/7,4/))
+ ifaceq=reshape((/4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/),(/8,6/))
+ ifacet=reshape((/1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/),(/6,4/))
ifacew=reshape((/1,3,2,9,8,7,0,0,
& 4,5,6,10,11,12,0,0,
& 1,2,5,4,7,14,10,13,
@@ -140,14 +140,6 @@ c Bernhardi end
nope=20
nopev=8
nopes=8
- elseif(lakonl(4:4).eq.'2') then
-!
-! nopes for C3D26 is a default value which can be overwritten
-! while integrating over the element faces
-!
- nope=26
- nopev=8
- nopes=8
elseif(lakonl(4:4).eq.'8') then
nope=8
nopev=8
@@ -156,14 +148,6 @@ c Bernhardi end
nope=10
nopev=4
nopes=6
- elseif(lakonl(4:5).eq.'14') then
-!
-! nopes for C3D14 is a default value which can be overwritten
-! while integrating over the element faces
-!
- nope=14
- nopev=4
- nopes=6
elseif(lakonl(4:4).eq.'4') then
nope=4
nopev=4
@@ -258,10 +242,9 @@ c Bernhardi end
call beamintscheme(lakonl,mint3d,ielprop(nelem),prop,
& null,xi,et,ze,weight)
endif
- elseif((lakonl(4:4).eq.'8').or.(lakonl(4:6).eq.'20R').or.
- & (lakonl(4:6).eq.'26R')) then
- if(((lakonl(7:7).eq.'A').or.(lakonl(7:7).eq.'S').or.
- & (lakonl(7:7).eq.'E')).and.(lakonl(4:6).ne.'26R')) then
+ elseif((lakonl(4:4).eq.'8').or.(lakonl(4:6).eq.'20R')) then
+ if((lakonl(7:7).eq.'A').or.(lakonl(7:7).eq.'S').or.
+ & (lakonl(7:7).eq.'E')) then
mint2d=2
mint3d=4
else
@@ -275,7 +258,7 @@ c Bernhardi end
elseif(lakonl(4:4).eq.'2') then
mint2d=9
mint3d=27
- elseif((lakonl(4:5).eq.'10').or.(lakonl(4:5).eq.'14')) then
+ elseif(lakonl(4:5).eq.'10') then
mint2d=3
mint3d=4
elseif(lakonl(4:4).eq.'4') then
@@ -304,10 +287,9 @@ c Bernhardi end
mint2d=9
endif
endif
- elseif((lakonl(4:5).eq.'10').or.(lakonl(4:4).eq.'4').or.
- & (lakonl(4:5).eq.'14')) then
+ elseif((lakonl(4:5).eq.'10').or.(lakonl(4:4).eq.'4')) then
mint3d=15
- if((lakonl(4:5).eq.'10').or.(lakonl(4:5).eq.'14')) then
+ if(lakonl(4:5).eq.'10') then
mint2d=3
else
mint2d=1
@@ -439,8 +421,7 @@ c Bernhardi end
call beamintscheme(lakonl,mint3d,ielprop(nelem),prop,
& kk,xi,et,ze,weight)
endif
- elseif((lakonl(4:4).eq.'8').or.(lakonl(4:6).eq.'20R').or.
- & (lakonl(4:6).eq.'26R'))
+ elseif((lakonl(4:4).eq.'8').or.(lakonl(4:6).eq.'20R'))
& then
if(lakonl(7:8).ne.'LC') then
xi=gauss3d2(1,kk)
@@ -492,7 +473,7 @@ c Bernhardi end
et=gauss3d3(2,kk)
ze=gauss3d3(3,kk)
weight=weight3d3(kk)
- elseif((lakonl(4:5).eq.'10').or.(lakonl(4:5).eq.'14')) then
+ elseif(lakonl(4:5).eq.'10') then
xi=gauss3d5(1,kk)
et=gauss3d5(2,kk)
ze=gauss3d5(3,kk)
@@ -555,14 +536,10 @@ c Bernhardi end
else
call shape20h(xi,et,ze,xl,xsj,shp,iflag)
endif
- elseif(nope.eq.26) then
- call shape26h(xi,et,ze,xl,xsj,shp,iflag,konl)
elseif(nope.eq.8) then
call shape8h(xi,et,ze,xl,xsj,shp,iflag)
elseif(nope.eq.10) then
call shape10tet(xi,et,ze,xl,xsj,shp,iflag)
- elseif(nope.eq.14) then
- call shape14tet(xi,et,ze,xl,xsj,shp,iflag,konl)
elseif(nope.eq.4) then
call shape4tet(xi,et,ze,xl,xsj,shp,iflag)
elseif(nope.eq.15) then
@@ -606,7 +583,7 @@ c if((iperturb(1).ne.0).and.stiffness.and.(.not.buckling))
t0l=t0l+t0(konl(i1))/8.d0
t1l=t1l+t1(konl(i1))/8.d0
enddo
- elseif((lakonl(4:6).eq.'20 ').or.(lakonl(4:6).eq.'26 '))then
+ elseif(lakonl(4:6).eq.'20 ')then
nopered=20
call lintemp(t0,t1,konl,nopered,kk,t0l,t1l)
else
@@ -621,7 +598,7 @@ c if((iperturb(1).ne.0).and.stiffness.and.(.not.buckling))
t0l=t0l+t0(konl(i1))/8.d0
t1l=t1l+vold(0,konl(i1))/8.d0
enddo
- elseif((lakonl(4:6).eq.'20 ').or.(lakonl(4:6).eq.'26 '))then
+ elseif(lakonl(4:6).eq.'20 ')then
nopered=20
call lintemp_th(t0,vold,konl,nopered,kk,t0l,t1l,mi)
else
@@ -720,6 +697,15 @@ c call orthotropic(elas,anisox)
!
if(((iperturb(1).ne.1).and.(iperturb(2).ne.1)).or.
& (buckling.eq.1)) then
+!
+! calculating the total mass of the element for
+! lumping purposes: only for explicit
+! dynamic calculations
+!
+ if((mass.eq.1).and.(iexpl.gt.1)) then
+ summass=summass+rho*xsj
+ endif
+!
jj1=1
do jj=1,nope
!
@@ -868,7 +854,7 @@ c call orthotropic(elas,anisox)
endif
!
! calculating the total mass of the element for
-! lumping purposes: only for explicit nonlinear
+! lumping purposes: only for explicit
! dynamic calculations
!
if((mass.eq.1).and.(iexpl.gt.1)) then
@@ -1094,21 +1080,6 @@ c
c read(sideload(id)(2:2),'(i1)') ig
ig=ichar(sideload(id)(2:2))-48
!
-! check whether 8 or 9-nodes face
-!
- if(nope.eq.26) then
- if(konl(20+ig).eq.konl(20)) then
- nopes=8
- else
- nopes=9
- endif
- elseif(nope.eq.14) then
- if(konl(10+ig).eq.konl(10)) then
- nopes=6
- else
- nopes=7
- endif
- endif
!
! treatment of wedge faces
!
@@ -1131,7 +1102,7 @@ c read(sideload(id)(2:2),'(i1)') ig
endif
!
c Bernhardi start
- if((nope.eq.26).or.(nope.eq.20).or.(nope.eq.8).or.
+ if((nope.eq.20).or.(nope.eq.8).or.
& (nope.eq.11)) then
c Bernhardi end
c if(iperturb(1).eq.0) then
@@ -1211,7 +1182,7 @@ c if(iperturb(1).eq.0) then
et=gauss2d1(2,i)
weight=weight2d1(i)
elseif((lakonl(4:4).eq.'8').or.
- & (lakonl(4:6).eq.'20R').or.(lakonl(4:6).eq.'26R').or.
+ & (lakonl(4:6).eq.'20R').or.
& ((lakonl(4:5).eq.'15').and.(nopes.eq.8))) then
xi=gauss2d2(1,i)
et=gauss2d2(2,i)
@@ -1220,7 +1191,7 @@ c if(iperturb(1).eq.0) then
xi=gauss2d3(1,i)
et=gauss2d3(2,i)
weight=weight2d3(i)
- elseif((lakonl(4:5).eq.'10').or.(lakonl(4:5).eq.'14').or.
+ elseif((lakonl(4:5).eq.'10').or.
& ((lakonl(4:5).eq.'15').and.(nopes.eq.6))) then
xi=gauss2d5(1,i)
et=gauss2d5(2,i)
@@ -1310,7 +1281,7 @@ c write(*,*) 'e_c3d ',(stress(k),k=1,6)
!
do k=1,nopes
c Bernhardi start
- if((nope.eq.26).or.(nope.eq.20).or.(nope.eq.8).or.
+ if((nope.eq.20).or.(nope.eq.8).or.
& (nope.eq.11)) then
c Bernhardi end
ipointer=(ifaceq(k,ig)-1)*3
@@ -1419,24 +1390,22 @@ c write(*,*) 'e_c3d ',(stress(k),k=1,6)
!
do ii=1,nopes
c Bernhardi start
- if((nope.eq.26).or.(nope.eq.20).or.(nope.eq.8).or.
+ if((nope.eq.20).or.(nope.eq.8).or.
& (nope.eq.11)) then
c Bernhardi end
ipointeri=(ifaceq(ii,ig)-1)*3
- elseif((nope.eq.10).or.(nope.eq.4).or.
- & (nope.eq.14))then
+ elseif((nope.eq.10).or.(nope.eq.4))then
ipointeri=(ifacet(ii,ig)-1)*3
else
ipointeri=(ifacew(ii,ig)-1)*3
endif
do jj=1,nopes
c Bernhardi start
- if((nope.eq.26).or.(nope.eq.20).or.(nope.eq.8)
+ if((nope.eq.20).or.(nope.eq.8)
& .or.(nope.eq.11)) then
c Bernhardi end
ipointerj=(ifaceq(jj,ig)-1)*3
- elseif((nope.eq.10).or.(nope.eq.4).or.
- & (nope.eq.14)) then
+ elseif((nope.eq.10).or.(nope.eq.4)) then
ipointerj=(ifacet(jj,ig)-1)*3
else
ipointerj=(ifacew(jj,ig)-1)*3
@@ -1587,18 +1556,18 @@ c Bernhardi end
summ=summ+sm(i,i)
enddo
!
- if((nope.eq.26).or.(nope.eq.20)) then
+ if(nope.eq.20) then
c alp=.2215d0
alp=.2917d0
! maybe alp=.2917d0 is better??
- elseif((nope.eq.10).or.(nope.eq.14)) then
+ elseif(nope.eq.10) then
alp=0.1203d0
elseif(nope.eq.15) then
alp=0.2141d0
endif
!
- if((nope.eq.26).or.(nope.eq.20).or.(nope.eq.10).or.
- & (nope.eq.15).or.(nope.eq.14)) then
+ if((nope.eq.20).or.(nope.eq.10).or.
+ & (nope.eq.15)) then
factore=summass*alp/(1.d0+alp)/sume
factorm=summass/(1.d0+alp)/summ
else
diff --git a/ccx_2.9/src/e_c3d_em.f b/ccx_2.10/src/e_c3d_em.f
similarity index 97%
rename from ccx_2.9/src/e_c3d_em.f
rename to ccx_2.10/src/e_c3d_em.f
index 09bde10..cbc2511 100644
--- a/ccx_2.9/src/e_c3d_em.f
+++ b/ccx_2.10/src/e_c3d_em.f
@@ -41,10 +41,10 @@
character*8 lakonl
character*80 matname(*),amat
!
- integer konl(26),ifaceq(9,6),nelem,nmethod,iactive(3),
+ integer konl(26),ifaceq(8,6),nelem,nmethod,iactive(3),
& ithermal,idist,i,j,k,i1,m,one,ii,jj,id,ipointer,ig,kk,mi(*),
& ielmat(mi(3),*),ntmat_,nope,nopes,imat,mint2d,mint3d,
- & ifacet(7,4),nopev,ifacew(8,5),ipointeri,ipointerj,iflag,
+ & ifacet(6,4),nopev,ifacew(8,5),ipointeri,ipointerj,iflag,
& nelcon(2,*),ncmat_,nalcon(2,*),iel,ii1,ilength,istart,iset,
& isurf,jj1,istartset(*),iendset(*),ialset(*),three,nfaces
!
@@ -57,16 +57,16 @@
!
include "gauss.f"
!
- data ifaceq /4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/
- data ifacet /1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/
+ data ifaceq /4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/
+ data ifacet /1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/
data ifacew /1,3,2,9,8,7,0,0,
& 4,5,6,10,11,12,0,0,
& 1,2,5,4,7,14,10,13,
diff --git a/ccx_2.9/src/e_c3d_rhs.f b/ccx_2.10/src/e_c3d_rhs.f
similarity index 97%
rename from ccx_2.9/src/e_c3d_rhs.f
rename to ccx_2.10/src/e_c3d_rhs.f
index 2a814a5..a63af34 100644
--- a/ccx_2.9/src/e_c3d_rhs.f
+++ b/ccx_2.10/src/e_c3d_rhs.f
@@ -39,11 +39,11 @@
character*20 sideload(*)
character*80 matname(*),amat
!
- integer mi(*),nk,konl(20),ielmat(mi(3),*),nbody,ifaceq(9,6),
+ integer mi(*),nk,konl(20),ielmat(mi(3),*),nbody,ifaceq(8,6),
& nelemload(2,*),ielprop(*),null,
& nelem,nmethod,iperturb,nload,idist,i,i1,j1,jj,jj1,id,kk,
& ipointer,nope,nopes,j,k,ntmat_,i2,imat,ii,ig,mint2d,mint3d,
- & ifacet(7,4),ifacew(8,5),istep,iinc,layer,kspt,jltyp,iflag,
+ & ifacet(6,4),ifacew(8,5),istep,iinc,layer,kspt,jltyp,iflag,
& ipompc(*),nodempc(3,*),nmpc,ikmpc(*),ilmpc(*),iscale
!
real*8 co(3,*),p1(3,2),p2(3,2),omx(2),bodyfx(3),veold(0:mi(2),*),
@@ -56,16 +56,16 @@
!
include "gauss.f"
!
- data ifaceq /4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/
- data ifacet /1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/
+ data ifaceq /4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/
+ data ifacet /1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/
data ifacew /1,3,2,9,8,7,0,0,
& 4,5,6,10,11,12,0,0,
& 1,2,5,4,7,14,10,13,
diff --git a/ccx_2.9/src/e_c3d_rhs_th.f b/ccx_2.10/src/e_c3d_rhs_th.f
similarity index 96%
rename from ccx_2.9/src/e_c3d_rhs_th.f
rename to ccx_2.10/src/e_c3d_rhs_th.f
index 6a0e3f7..59af294 100644
--- a/ccx_2.9/src/e_c3d_rhs_th.f
+++ b/ccx_2.10/src/e_c3d_rhs_th.f
@@ -35,10 +35,10 @@
character*8 lakonl
character*20 sideload(*)
!
- integer konl(20),ifaceq(9,6),nelemload(2,*),nk,nelem,nmethod,
+ integer konl(20),ifaceq(8,6),nelemload(2,*),nk,nelem,nmethod,
& nload,idist,i,j,k,i1,iflag,ipompc(*),nodempc(3,*),nmpc,
& jj,id,ipointer,ig,kk,nope,nopes,mint2d,ikmpc(*),ilmpc(*),
- & mint3d,ifacet(7,4),nopev,ifacew(8,5),iinc,istep,jltyp,
+ & mint3d,ifacet(6,4),nopev,ifacew(8,5),iinc,istep,jltyp,
& iscale,mi(*),ielprop(*),null
!
real*8 co(3,*),xl(3,20),shp(4,20),xs2(3,7),xloadold(2,*),
@@ -51,16 +51,16 @@
!
include "gauss.f"
!
- data ifaceq /4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/
- data ifacet /1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/
+ data ifaceq /4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/
+ data ifacet /1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/
data ifacew /1,3,2,9,8,7,0,0,
& 4,5,6,10,11,12,0,0,
& 1,2,5,4,7,14,10,13,
diff --git a/ccx_2.9/src/e_c3d_se.f b/ccx_2.10/src/e_c3d_se.f
similarity index 93%
rename from ccx_2.9/src/e_c3d_se.f
rename to ccx_2.10/src/e_c3d_se.f
index 842cc4f..1cb21a0 100644
--- a/ccx_2.9/src/e_c3d_se.f
+++ b/ccx_2.10/src/e_c3d_se.f
@@ -51,23 +51,23 @@
character*80 matname(*),amat
character*81 tieset(3,*)
!
- integer konl(26),ifaceq(9,6),nelemload(2,*),nbody,nelem,
+ integer konl(26),ifaceq(8,6),nelemload(2,*),nbody,nelem,
& mi(*),iloc,jfaces,igauss,mortar,kon(*),ielprop(*),null,
& mattyp,ithermal,iperturb(*),nload,idist,i,j,k,l,i1,i2,j1,
& nmethod,k1,l1,ii,jj,ii1,jj1,id,ipointer,ig,m1,m2,m3,m4,kk,
& nelcon(2,*),nrhcon(*),nalcon(2,*),ielmat(mi(3),*),six,
& ielorien(mi(3),*),ilayer,nlayer,ki,kl,ipkon(*),indexe,
& ntmat_,nope,nopes,norien,ihyper,iexpl,kode,imat,mint2d,
- & mint3d,ifacet(7,4),nopev,iorien,istiff,ncmat_,iface,
+ & mint3d,ifacet(6,4),nopev,iorien,istiff,ncmat_,iface,
& ifacew(8,5),intscheme,n,ipointeri,ipointerj,istep,iinc,
& layer,kspt,jltyp,iflag,iperm(60),m,ipompc(*),nodempc(3,*),
& nmpc,ikmpc(*),ilmpc(*),iscale,nstate_,ne0,iselect(6),
& istartset(*),iendset(*),ialset(*),ntie,integerglob(*),nasym,
& nplicon(0:ntmat_,*),nplkcon(0:ntmat_,*),npmat_,nopered,
- & ndesi,nodedesi(*),ndirdesi(*),desvar,actnode,kscale
+ & ndesi,nodedesi(*),ndirdesi(*),idesva,iactnod,kscale
!
real*8 co(3,*),xl(3,26),shp(4,26),xs2(3,7),veold(0:mi(2),*),
- & s(100,100),sf(100,100),w(3,3),p1(3),p2(3),bodyf(3),bodyfx(3),
+ & s(100,100),w(3,3),p1(3),p2(3),bodyf(3),bodyfx(3),
& ff(100),bf(3),q(3),shpj(4,26),elcon(0:ncmat_,ntmat_,*),t(3),
& rhcon(0:1,ntmat_,*),xkl(3,3),eknlsign,reltime,prop(*),
& alcon(0:6,ntmat_,*),alzero(*),orab(7,*),t0(*),t1(*),
@@ -106,16 +106,16 @@
!
include "gauss.f"
!
- ifaceq=reshape((/4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/),(/9,6/))
- ifacet=reshape((/1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/),(/7,4/))
+ ifaceq=reshape((/4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/),(/8,6/))
+ ifacet=reshape((/1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/),(/6,4/))
ifacew=reshape((/1,3,2,9,8,7,0,0,
& 4,5,6,10,11,12,0,0,
& 1,2,5,4,7,14,10,13,
@@ -145,14 +145,6 @@ c Bernhardi end
nope=20
nopev=8
nopes=8
- elseif(lakonl(4:4).eq.'2') then
-!
-! nopes for C3D26 is a default value which can be overwritten
-! while integrating over the element faces
-!
- nope=26
- nopev=8
- nopes=8
elseif(lakonl(4:4).eq.'8') then
nope=8
nopev=8
@@ -161,14 +153,6 @@ c Bernhardi end
nope=10
nopev=4
nopes=6
- elseif(lakonl(4:5).eq.'14') then
-!
-! nopes for C3D14 is a default value which can be overwritten
-! while integrating over the element faces
-!
- nope=14
- nopev=4
- nopes=6
elseif(lakonl(4:4).eq.'4') then
nope=4
nopev=4
@@ -263,10 +247,9 @@ c Bernhardi end
call beamintscheme(lakonl,mint3d,ielprop(nelem),prop,
& null,xi,et,ze,weight)
endif
- elseif((lakonl(4:4).eq.'8').or.(lakonl(4:6).eq.'20R').or.
- & (lakonl(4:6).eq.'26R')) then
- if(((lakonl(7:7).eq.'A').or.(lakonl(7:7).eq.'S').or.
- & (lakonl(7:7).eq.'E')).and.(lakonl(4:6).ne.'26R')) then
+ elseif((lakonl(4:4).eq.'8').or.(lakonl(4:6).eq.'20R')) then
+ if((lakonl(7:7).eq.'A').or.(lakonl(7:7).eq.'S').or.
+ & (lakonl(7:7).eq.'E')) then
mint2d=2
mint3d=4
else
@@ -280,7 +263,7 @@ c Bernhardi end
elseif(lakonl(4:4).eq.'2') then
mint2d=9
mint3d=27
- elseif((lakonl(4:5).eq.'10').or.(lakonl(4:5).eq.'14')) then
+ elseif(lakonl(4:5).eq.'10') then
mint2d=3
mint3d=4
elseif(lakonl(4:4).eq.'4') then
@@ -309,10 +292,9 @@ c Bernhardi end
mint2d=9
endif
endif
- elseif((lakonl(4:5).eq.'10').or.(lakonl(4:4).eq.'4').or.
- & (lakonl(4:5).eq.'14')) then
+ elseif((lakonl(4:5).eq.'10').or.(lakonl(4:4).eq.'4')) then
mint3d=15
- if((lakonl(4:5).eq.'10').or.(lakonl(4:5).eq.'14')) then
+ if(lakonl(4:5).eq.'10') then
mint2d=3
else
mint2d=1
@@ -367,7 +349,7 @@ c Bernhardi end
! the stiffness matrix
! -------------------------------------------------------------
!
- do desvar=0,ndesi
+ do idesva=0,ndesi
! Ertl end
!
! initialisation of the local coordinates
@@ -375,6 +357,7 @@ c Bernhardi end
do i=1,nope
konl(i)=kon(indexe+i)
do j=1,3
+ voldl(j,i)=vold(j,konl(i))
xl(j,i)=co(j,konl(i))
enddo
enddo
@@ -383,11 +366,11 @@ c Bernhardi end
! if the designnode belongs to the considered element
!
! Ertl end
- if(desvar.gt.0) then
+ if(idesva.gt.0) then
do i=1,nope
- actnode=kon(indexe+i)
- if(actnode.eq.nodedesi(desvar)) then
- xl(ndirdesi(desvar),i)=xl(ndirdesi(desvar),i)+distmin
+ iactnod=kon(indexe+i)
+ if(iactnod.eq.nodedesi(idesva)) then
+ xl(ndirdesi(idesva),i)=xl(ndirdesi(idesva),i)+distmin
exit
endif
enddo
@@ -412,6 +395,12 @@ c Bernhardi end
enddo
enddo
!
+! initialisation of ff
+!
+ do i=1,3*nope
+ ff(i)=0.d0
+ enddo
+!
! calculating the stiffness matrix for the contact spring elements
!
if(mint3d.eq.0) then
@@ -484,8 +473,7 @@ c Bernhardi end
call beamintscheme(lakonl,mint3d,ielprop(nelem),prop,
& kk,xi,et,ze,weight)
endif
- elseif((lakonl(4:4).eq.'8').or.(lakonl(4:6).eq.'20R').or.
- & (lakonl(4:6).eq.'26R'))
+ elseif((lakonl(4:4).eq.'8').or.(lakonl(4:6).eq.'20R'))
& then
if(lakonl(7:8).ne.'LC') then
xi=gauss3d2(1,kk)
@@ -537,7 +525,7 @@ c Bernhardi end
et=gauss3d3(2,kk)
ze=gauss3d3(3,kk)
weight=weight3d3(kk)
- elseif((lakonl(4:5).eq.'10').or.(lakonl(4:5).eq.'14')) then
+ elseif(lakonl(4:5).eq.'10') then
xi=gauss3d5(1,kk)
et=gauss3d5(2,kk)
ze=gauss3d5(3,kk)
@@ -600,14 +588,10 @@ c Bernhardi end
else
call shape20h(xi,et,ze,xl,xsj,shp,iflag)
endif
- elseif(nope.eq.26) then
- call shape26h(xi,et,ze,xl,xsj,shp,iflag,konl)
elseif(nope.eq.8) then
call shape8h(xi,et,ze,xl,xsj,shp,iflag)
elseif(nope.eq.10) then
call shape10tet(xi,et,ze,xl,xsj,shp,iflag)
- elseif(nope.eq.14) then
- call shape14tet(xi,et,ze,xl,xsj,shp,iflag,konl)
elseif(nope.eq.4) then
call shape4tet(xi,et,ze,xl,xsj,shp,iflag)
elseif(nope.eq.15) then
@@ -651,7 +635,7 @@ c if((iperturb(1).ne.0).and.stiffness.and.(.not.buckling))
t0l=t0l+t0(konl(i1))/8.d0
t1l=t1l+t1(konl(i1))/8.d0
enddo
- elseif((lakonl(4:6).eq.'20 ').or.(lakonl(4:6).eq.'26 '))then
+ elseif(lakonl(4:6).eq.'20 ')then
nopered=20
call lintemp(t0,t1,konl,nopered,kk,t0l,t1l)
else
@@ -666,7 +650,7 @@ c if((iperturb(1).ne.0).and.stiffness.and.(.not.buckling))
t0l=t0l+t0(konl(i1))/8.d0
t1l=t1l+vold(0,konl(i1))/8.d0
enddo
- elseif((lakonl(4:6).eq.'20 ').or.(lakonl(4:6).eq.'26 '))then
+ elseif(lakonl(4:6).eq.'20 ')then
nopered=20
call lintemp_th(t0,vold,konl,nopered,kk,t0l,t1l,mi)
else
@@ -1139,21 +1123,6 @@ c if(iperturb(1).eq.0) then
c read(sideload(id)(2:2),'(i1)') ig
ig=ichar(sideload(id)(2:2))-48
!
-! check whether 8 or 9-nodes face
-!
- if(nope.eq.26) then
- if(konl(20+ig).eq.konl(20)) then
- nopes=8
- else
- nopes=9
- endif
- elseif(nope.eq.14) then
- if(konl(10+ig).eq.konl(10)) then
- nopes=6
- else
- nopes=7
- endif
- endif
!
! treatment of wedge faces
!
@@ -1176,7 +1145,7 @@ c read(sideload(id)(2:2),'(i1)') ig
endif
!
c Bernhardi start
- if((nope.eq.26).or.(nope.eq.20).or.(nope.eq.8).or.
+ if((nope.eq.20).or.(nope.eq.8).or.
& (nope.eq.11)) then
c Bernhardi end
c if(iperturb(1).eq.0) then
@@ -1201,6 +1170,22 @@ c if(iperturb(1).eq.0) then
enddo
enddo
endif
+!
+! ---------------------------------------------------------
+! variation of xl2 and xl1 (quads) for sensitivity analysis
+! ---------------------------------------------------------
+!
+ if(idesva.gt.0) then
+ do i=1,nopes
+ iactnod=konl(ifaceq(i,ig))
+ if(iactnod.eq.nodedesi(idesva)) then
+ xl2(ndirdesi(idesva),i)=
+ & xl2(ndirdesi(idesva),i)+distmin
+ exit
+ endif
+ enddo
+ endif
+!
elseif((nope.eq.10).or.(nope.eq.4)) then
c if(iperturb(1).eq.0) then
if((iperturb(1).ne.1).and.(iperturb(2).ne.1)) then
@@ -1225,6 +1210,22 @@ c if(iperturb(1).eq.0) then
enddo
endif
else
+!
+! ---------------------------------------------------------
+! variation of xl2 and xl1 (thets) for sensitivity analysis
+! ---------------------------------------------------------
+!
+ if(idesva.gt.0) then
+ do i=1,nopes
+ iactnod=konl(ifacet(i,ig))
+ if(iactnod.eq.nodedesi(idesva)) then
+ xl2(ndirdesi(idesva),i)=
+ & xl2(ndirdesi(idesva),i)+distmin
+ exit
+ endif
+ enddo
+ endif
+
c if(iperturb(1).eq.0) then
if((iperturb(1).ne.1).and.(iperturb(2).ne.1)) then
do i=1,nopes
@@ -1249,6 +1250,21 @@ c if(iperturb(1).eq.0) then
endif
endif
!
+! ---------------------------------------------------------
+! variation of xl2 and xl1 (wedge) for sensitivity analysis
+! ---------------------------------------------------------
+!
+ if(idesva.gt.0) then
+ do i=1,nopes
+ iactnod=konl(ifacew(i,ig))
+ if(iactnod.eq.nodedesi(idesva)) then
+ xl2(ndirdesi(idesva),i)=
+ & xl2(ndirdesi(idesva),i)+distmin
+ exit
+ endif
+ enddo
+ endif
+!
do i=1,mint2d
if((lakonl(4:5).eq.'8R').or.
& ((lakonl(4:4).eq.'6').and.(nopes.eq.4))) then
@@ -1256,7 +1272,7 @@ c if(iperturb(1).eq.0) then
et=gauss2d1(2,i)
weight=weight2d1(i)
elseif((lakonl(4:4).eq.'8').or.
- & (lakonl(4:6).eq.'20R').or.(lakonl(4:6).eq.'26R').or.
+ & (lakonl(4:6).eq.'20R').or.
& ((lakonl(4:5).eq.'15').and.(nopes.eq.8))) then
xi=gauss2d2(1,i)
et=gauss2d2(2,i)
@@ -1265,7 +1281,7 @@ c if(iperturb(1).eq.0) then
xi=gauss2d3(1,i)
et=gauss2d3(2,i)
weight=weight2d3(i)
- elseif((lakonl(4:5).eq.'10').or.(lakonl(4:5).eq.'14').or.
+ elseif((lakonl(4:5).eq.'10').or.
& ((lakonl(4:5).eq.'15').and.(nopes.eq.6))) then
xi=gauss2d5(1,i)
et=gauss2d5(2,i)
@@ -1355,7 +1371,7 @@ c write(*,*) 'e_c3d ',(stress(k),k=1,6)
!
do k=1,nopes
c Bernhardi start
- if((nope.eq.26).or.(nope.eq.20).or.(nope.eq.8).or.
+ if((nope.eq.20).or.(nope.eq.8).or.
& (nope.eq.11)) then
c Bernhardi end
ipointer=(ifaceq(k,ig)-1)*3
@@ -1464,24 +1480,22 @@ c write(*,*) 'e_c3d ',(stress(k),k=1,6)
!
do ii=1,nopes
c Bernhardi start
- if((nope.eq.26).or.(nope.eq.20).or.(nope.eq.8).or.
+ if((nope.eq.20).or.(nope.eq.8).or.
& (nope.eq.11)) then
c Bernhardi end
ipointeri=(ifaceq(ii,ig)-1)*3
- elseif((nope.eq.10).or.(nope.eq.4).or.
- & (nope.eq.14))then
+ elseif((nope.eq.10).or.(nope.eq.4))then
ipointeri=(ifacet(ii,ig)-1)*3
else
ipointeri=(ifacew(ii,ig)-1)*3
endif
do jj=1,nopes
c Bernhardi start
- if((nope.eq.26).or.(nope.eq.20).or.(nope.eq.8)
+ if((nope.eq.20).or.(nope.eq.8)
& .or.(nope.eq.11)) then
c Bernhardi end
ipointerj=(ifaceq(jj,ig)-1)*3
- elseif((nope.eq.10).or.(nope.eq.4).or.
- & (nope.eq.14)) then
+ elseif((nope.eq.10).or.(nope.eq.4)) then
ipointerj=(ifacet(jj,ig)-1)*3
else
ipointerj=(ifacew(jj,ig)-1)*3
@@ -1632,18 +1646,18 @@ c Bernhardi end
summ=summ+sm(i,i)
enddo
!
- if((nope.eq.26).or.(nope.eq.20)) then
+ if(nope.eq.20) then
c alp=.2215d0
alp=.2917d0
! maybe alp=.2917d0 is better??
- elseif((nope.eq.10).or.(nope.eq.14)) then
+ elseif(nope.eq.10) then
alp=0.1203d0
elseif(nope.eq.15) then
alp=0.2141d0
endif
!
- if((nope.eq.26).or.(nope.eq.20).or.(nope.eq.10).or.
- & (nope.eq.15).or.(nope.eq.14)) then
+ if((nope.eq.20).or.(nope.eq.10).or.
+ & (nope.eq.15)) then
factore=summass*alp/(1.d0+alp)/sume
factorm=summass/(1.d0+alp)/summ
else
@@ -1666,7 +1680,7 @@ c alp=.2215d0
! Assigning the element stiffness matrix and the external load
! vector to the corresponding matrices/vectors
!
- if(desvar.eq.0) then
+ if(idesva.eq.0) then
! Stiffness matrix
do i=1,3*nope
do j=1,3*nope
@@ -1686,26 +1700,26 @@ c alp=.2215d0
enddo
do i=1,3*nope
l=0
- ds(desvar,i)=0.d0
+ ds(idesva,i)=0.d0
do j=1,nope
do k=1,3
l=l+1
if ((l.eq.i).or.(l.gt.i)) then
- ds(desvar,i)=ds(desvar,i)+ds1(i,l)*voldl(k,j)
+ ds(idesva,i)=ds(idesva,i)+ds1(i,l)*voldl(k,j)
else
- ds(desvar,i)=ds(desvar,i)+ds1(l,i)*voldl(k,j)
+ ds(idesva,i)=ds(idesva,i)+ds1(l,i)*voldl(k,j)
endif
enddo
enddo
enddo
! load vector
do i=1,3*nope
- dff(desvar,i)=(ff(i)-ff0(i))/distmin
+ dff(idesva,i)=(ff(i)-ff0(i))/distmin
enddo
endif
!
do i=1,3*nope
- dfminds(desvar,i)=dff(desvar,i)-ds(desvar,i)
+ dfminds(idesva,i)=dff(idesva,i)-ds(idesva,i)
enddo
enddo
diff --git a/ccx_2.9/src/e_c3d_th.f b/ccx_2.10/src/e_c3d_th.f
similarity index 88%
rename from ccx_2.9/src/e_c3d_th.f
rename to ccx_2.10/src/e_c3d_th.f
index cb9dcce..f4c0b0b 100644
--- a/ccx_2.9/src/e_c3d_th.f
+++ b/ccx_2.10/src/e_c3d_th.f
@@ -47,12 +47,12 @@
character*20 sideload(*)
character*80 matname(*),amat
!
- integer konl(26),ifaceq(9,6),nelemload(2,*),nk,nelem,nmethod,
+ integer konl(26),ifaceq(8,6),nelemload(2,*),nk,nelem,nmethod,
& mattyp,ithermal(2),iperturb,nload,idist,i,j,k,i1,j1,l,m,
& ii,jj,id,ipointer,ig,kk,istiff,iperm(20),ipompc(*),mi(*),
& nrhcon(*),ielmat(mi(3),*),ielorien(mi(3),*),nodempc(3,*),nmpc,
& ntmat_,nope,nopes,norien,iexpl,imat,mint2d,ikmpc(*),iloc,
- & mint3d,ifacet(7,4),nopev,iorien,ilmpc(*),kode,jfaces,null,
+ & mint3d,ifacet(6,4),nopev,iorien,ilmpc(*),kode,jfaces,null,
& ifacew(8,5),intscheme,ipointeri,ipointerj,ncocon(2,*),
& nshcon(*),iinc,istep,jltyp,nfield,node,iflag,iscale,ielprop(*),
& nplkcon(0:ntmat_,*),nelcon(2,*),npmat_,ncmat_,i2,ipkon(*),
@@ -89,34 +89,16 @@
!
include "gauss.f"
!
-c data ifaceq /4,3,2,1,11,10,9,12,21,
-c & 5,6,7,8,13,14,15,16,22,
-c & 1,2,6,5,9,18,13,17,23,
-c & 2,3,7,6,10,19,14,18,24,
-c & 3,4,8,7,11,20,15,19,25,
-c & 4,1,5,8,12,17,16,20,26/
-c data ifacet /1,3,2,7,6,5,11,
-c & 1,2,4,5,9,8,12,
-c & 2,3,4,6,10,9,13,
-c & 1,4,3,8,10,7,14/
-c data ifacew /1,3,2,9,8,7,0,0,
-c & 4,5,6,10,11,12,0,0,
-c & 1,2,5,4,7,14,10,13,
-c & 2,3,6,5,8,15,11,14,
-c & 4,6,3,1,12,15,9,13/
-c data null /0/
-c data iperm /5,6,7,8,1,2,3,4,13,14,15,16,9,10,11,12,17,18,19,20/
-!
- ifaceq=reshape((/4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/),(/9,6/))
- ifacet=reshape((/1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/),(/7,4/))
+ ifaceq=reshape((/4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/),(/8,6/))
+ ifacet=reshape((/1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/),(/6,4/))
ifacew=reshape((/1,3,2,9,8,7,0,0,
& 4,5,6,10,11,12,0,0,
& 1,2,5,4,7,14,10,13,
@@ -145,10 +127,6 @@ c data iperm /5,6,7,8,1,2,3,4,13,14,15,16,9,10,11,12,17,18,19,20/
nope=20
nopev=8
nopes=8
- elseif(lakonl(4:4).eq.'2') then
- nope=26
- nopev=8
- nopes=8
elseif(lakonl(4:4).eq.'8') then
nope=8
nopev=8
@@ -157,10 +135,6 @@ c data iperm /5,6,7,8,1,2,3,4,13,14,15,16,9,10,11,12,17,18,19,20/
nope=10
nopev=4
nopes=6
- elseif(lakonl(4:5).eq.'14') then
- nope=14
- nopev=4
- nopes=6
elseif(lakonl(4:4).eq.'4') then
nope=4
nopev=4
@@ -206,10 +180,8 @@ c nope=nope+1
call beamintscheme(lakonl,mint3d,ielprop(nelem),prop,
& null,xi,et,ze,weight)
endif
- elseif((lakonl(4:4).eq.'8').or.(lakonl(4:6).eq.'20R').or.
- & (lakonl(4:6).eq.'26R')) then
- if(((lakonl(7:7).eq.'A').or.(lakonl(7:7).eq.'E')).and.
- & (lakonl(4:6).ne.'26R')) then
+ elseif((lakonl(4:4).eq.'8').or.(lakonl(4:6).eq.'20R')) then
+ if((lakonl(7:7).eq.'A').or.(lakonl(7:7).eq.'E')) then
mint2d=2
mint3d=4
else
@@ -219,7 +191,7 @@ c nope=nope+1
elseif(lakonl(4:4).eq.'2') then
mint2d=9
mint3d=27
- elseif((lakonl(4:5).eq.'10').or.(lakonl(4:5).eq.'14')) then
+ elseif(lakonl(4:5).eq.'10') then
mint2d=3
mint3d=4
elseif(lakonl(4:4).eq.'4') then
@@ -238,8 +210,7 @@ c nope=nope+1
!
if((lakonl(4:4).eq.'8').or.(lakonl(4:4).eq.'2')) then
mint3d=27
- elseif((lakonl(4:5).eq.'10').or.(lakonl(4:4).eq.'4').or.
- & (lakonl(4:5).eq.'14')) then
+ elseif((lakonl(4:5).eq.'10').or.(lakonl(4:4).eq.'4')) then
mint3d=15
elseif((lakonl(4:5).eq.'15').or.(lakonl(4:4).eq.'6')) then
mint3d=18
@@ -251,8 +222,7 @@ c nope=nope+1
!
if(lakonl(4:5).eq.'8R') then
mint2d=1
- elseif((lakonl(4:4).eq.'8').or.(lakonl(4:6).eq.'20R').or.
- & (lakonl(4:6).eq.'26R')) then
+ elseif((lakonl(4:4).eq.'8').or.(lakonl(4:6).eq.'20R')) then
if((lakonl(7:7).eq.'A').or.(lakonl(7:7).eq.'E')) then
mint2d=2
else
@@ -260,7 +230,7 @@ c nope=nope+1
endif
elseif(lakonl(4:4).eq.'2') then
mint2d=9
- elseif((lakonl(4:5).eq.'10').or.(lakonl(4:5).eq.'14')) then
+ elseif(lakonl(4:5).eq.'10') then
mint2d=3
elseif(lakonl(4:4).eq.'4') then
mint2d=1
@@ -378,8 +348,7 @@ c nope=nope+1
call beamintscheme(lakonl,mint3d,ielprop(nelem),prop,
& kk,xi,et,ze,weight)
endif
- elseif((lakonl(4:4).eq.'8').or.(lakonl(4:6).eq.'20R').or.
- & (lakonl(4:6).eq.'26R'))
+ elseif((lakonl(4:4).eq.'8').or.(lakonl(4:6).eq.'20R'))
& then
xi=gauss3d2(1,kk)
et=gauss3d2(2,kk)
@@ -390,7 +359,7 @@ c nope=nope+1
et=gauss3d3(2,kk)
ze=gauss3d3(3,kk)
weight=weight3d3(kk)
- elseif((lakonl(4:5).eq.'10').or.(lakonl(4:5).eq.'14')) then
+ elseif(lakonl(4:5).eq.'10') then
xi=gauss3d5(1,kk)
et=gauss3d5(2,kk)
ze=gauss3d5(3,kk)
@@ -441,14 +410,10 @@ c nope=nope+1
else
call shape20h(xi,et,ze,xl,xsj,shp,iflag)
endif
- elseif(nope.eq.26) then
- call shape26h(xi,et,ze,xl,xsj,shp,iflag,konl)
elseif(nope.eq.8) then
call shape8h(xi,et,ze,xl,xsj,shp,iflag)
elseif(nope.eq.10) then
call shape10tet(xi,et,ze,xl,xsj,shp,iflag)
- elseif(nope.eq.14) then
- call shape14tet(xi,et,ze,xl,xsj,shp,iflag,konl)
elseif(nope.eq.4) then
call shape4tet(xi,et,ze,xl,xsj,shp,iflag)
elseif(nope.eq.15) then
@@ -473,8 +438,7 @@ c nope=nope+1
t1l=0.d0
!
if((lakonl(4:7).eq.'20RA').or.(lakonl(4:7).eq.'20RS').or.
- & (lakonl(4:7).eq.'20RE').or.(lakonl(4:7).eq.'26RA').or.
- & (lakonl(4:7).eq.'26RS').or.(lakonl(4:7).eq.'26RE')) then
+ & (lakonl(4:7).eq.'20RE')) then
t1l=vold(0,konl(1))*(shp(4,1)+shp(4,5)+shp(4,17))
& +vold(0,konl(2))*(shp(4,2)+shp(4,6)+shp(4,18))
& +vold(0,konl(3))*(shp(4,3)+shp(4,7)+shp(4,19))
@@ -645,21 +609,6 @@ c nope=nope+1
c read(sideload(id)(2:2),'(i1)') ig
ig=ichar(sideload(id)(2:2))-48
!
-! check whether 8 or 9-nodes face
-!
- if(nope.eq.26) then
- if(konl(20+ig).eq.konl(20)) then
- nopes=8
- else
- nopes=9
- endif
- elseif(nope.eq.14) then
- if(konl(10+ig).eq.konl(10)) then
- nopes=6
- else
- nopes=7
- endif
- endif
!
! treatment of wedge faces
!
@@ -681,7 +630,7 @@ c read(sideload(id)(2:2),'(i1)') ig
endif
endif
!
- if((nope.eq.26).or.(nope.eq.20).or.(nope.eq.8)) then
+ if((nope.eq.20).or.(nope.eq.8)) then
do i=1,nopes
tl2(i)=vold(0,konl(ifaceq(i,ig)))
if(ithermal(2).eq.2) then
@@ -749,7 +698,7 @@ c read(sideload(id)(2:2),'(i1)') ig
et=gauss2d1(2,i)
weight=weight2d1(i)
elseif((lakonl(4:4).eq.'8').or.
- & (lakonl(4:6).eq.'20R').or.(lakonl(4:6).eq.'26R').or.
+ & (lakonl(4:6).eq.'20R').or.
& ((lakonl(4:5).eq.'15').and.(nopes.eq.8))) then
xi=gauss2d2(1,i)
et=gauss2d2(2,i)
@@ -758,7 +707,7 @@ c read(sideload(id)(2:2),'(i1)') ig
xi=gauss2d3(1,i)
et=gauss2d3(2,i)
weight=weight2d3(i)
- elseif((lakonl(4:5).eq.'10').or.(lakonl(4:5).eq.'14').or.
+ elseif((lakonl(4:5).eq.'10').or.
& ((lakonl(4:5).eq.'15').and.(nopes.eq.6))) then
xi=gauss2d5(1,i)
et=gauss2d5(2,i)
@@ -834,9 +783,9 @@ c read(sideload(id)(2:2),'(i1)') jltyp
!
do k=1,nopes
- if((nope.eq.26).or.(nope.eq.20).or.(nope.eq.8)) then
+ if((nope.eq.20).or.(nope.eq.8)) then
ipointer=ifaceq(k,ig)
- elseif((nope.eq.10).or.(nope.eq.4).or.(nope.eq.14)) then
+ elseif((nope.eq.10).or.(nope.eq.4)) then
ipointer=ifacet(k,ig)
else
ipointer=ifacew(k,ig)
@@ -860,18 +809,17 @@ c read(sideload(id)(2:2),'(i1)') jltyp
enddo
!
do ii=1,nopes
- if((nope.eq.26).or.(nope.eq.20).or.(nope.eq.8)) then
+ if((nope.eq.20).or.(nope.eq.8)) then
ipointeri=ifaceq(ii,ig)
- elseif((nope.eq.10).or.(nope.eq.4).or.(nope.eq.14)) then
+ elseif((nope.eq.10).or.(nope.eq.4)) then
ipointeri=ifacet(ii,ig)
else
ipointeri=ifacew(ii,ig)
endif
do jj=1,nopes
- if((nope.eq.26).or.(nope.eq.20).or.(nope.eq.8)) then
+ if((nope.eq.20).or.(nope.eq.8)) then
ipointerj=ifaceq(jj,ig)
- elseif((nope.eq.10).or.(nope.eq.4).or.
- & (nope.eq.14)) then
+ elseif((nope.eq.10).or.(nope.eq.4)) then
ipointerj=ifacet(jj,ig)
else
ipointerj=ifacew(jj,ig)
@@ -966,16 +914,16 @@ c read(sideload(id)(2:2),'(i1)') jltyp
summ=summ+sm(i,i)
enddo
!
- if((nope.eq.26).or.(nope.eq.20)) then
+ if(nope.eq.20) then
alp=.2917d0
- elseif((nope.eq.10).or.(nope.eq.14)) then
+ elseif(nope.eq.10) then
alp=0.1203d0
elseif(nope.eq.15) then
alp=0.2141d0
endif
!
- if((nope.eq.26).or.(nope.eq.20).or.(nope.eq.10).or.
- & (nope.eq.15).or.(nope.eq.14)) then
+ if((nope.eq.20).or.(nope.eq.10).or.
+ & (nope.eq.15)) then
factore=summass*alp/(1.d0+alp)/sume
factorm=summass/(1.d0+alp)/summ
else
diff --git a/ccx_2.9/src/e_corio.f b/ccx_2.10/src/e_corio.f
similarity index 91%
rename from ccx_2.9/src/e_corio.f
rename to ccx_2.10/src/e_corio.f
index cd03262..0b8af6d 100644
--- a/ccx_2.9/src/e_corio.f
+++ b/ccx_2.10/src/e_corio.f
@@ -22,7 +22,7 @@
& t0,t1,ithermal,vold,iperturb,nelemload,
& sideload,xload,nload,idist,sti,stx,iexpl,plicon,
& nplicon,plkcon,nplkcon,xstiff,npmat_,dtime,
- & matname,mi,ncmat_,ttime,time,istep,iinc,nmethod)
+ & matname,mi,ncmat_,ttime,time,istep,iinc,nmethod,ielprop,prop)
!
! computation of the element matrix and rhs for the element with
! the topology in konl
@@ -44,18 +44,17 @@
character*80 matname(*),amat
!
integer konl(20),ifaceq(8,6),nelemload(2,*),nk,nbody,nelem,
- & mi(*),
- & mattyp,ithermal,iperturb(*),nload,idist,i,j,k,l,i1,i2,j1,
+ & mi(*),mattyp,ithermal,iperturb(*),nload,idist,i,j,k,l,i1,i2,j1,
& nmethod,k1,l1,ii,jj,ii1,jj1,id,ipointer,ig,m1,m2,m3,m4,kk,
& nelcon(2,*),nrhcon(*),nalcon(2,*),ielmat(mi(3),*),
- & ielorien(mi(3),*),
+ & ielorien(mi(3),*),null,ielprop(*),
& ntmat_,nope,nopes,norien,ihyper,iexpl,kode,imat,mint2d,
& mint3d,ifacet(7,4),nopev,iorien,istiff,ncmat_,
& ifacew(8,5),intscheme,n,ipointeri,ipointerj,istep,iinc,
& layer,kspt,jltyp,iflag,iperm(60),m,iscale,ne0,
& nplicon(0:ntmat_,*),nplkcon(0:ntmat_,*),npmat_
!
- real*8 co(3,*),xl(3,20),shp(4,20),xs2(3,7),
+ real*8 co(3,*),xl(3,20),shp(4,20),xs2(3,7),prop(*),
& s(100,100),w(3,3),p1(3),p2(3),bodyf(3),bodyfx(3),ff(100),
& bf(3),q(3),shpj(4,20),elcon(0:ncmat_,ntmat_,*),
& rhcon(0:1,ntmat_,*),xkl(3,3),eknlsign,reltime,
@@ -83,6 +82,8 @@
!
include "gauss.f"
!
+ null=0
+!
imat=ielmat(1,nelem)
amat=matname(imat)
!
@@ -109,6 +110,13 @@ c Bernhardi end
!
if(lakonl(4:5).eq.'8R') then
mint3d=1
+ elseif(lakonl(4:7).eq.'20RB') then
+ if((lakonl(8:8).eq.'R').or.(lakonl(8:8).eq.'C')) then
+ mint3d=50
+ else
+ call beamintscheme(lakonl,mint3d,ielprop(nelem),prop,
+ & null,xi,et,ze,weight)
+ endif
elseif((lakonl(4:4).eq.'8').or.(lakonl(4:6).eq.'20R')) then
if((lakonl(7:7).eq.'A').or.(lakonl(7:7).eq.'S').or.
& (lakonl(7:7).eq.'E')) then
@@ -154,6 +162,16 @@ c Bernhardi end
et=gauss3d1(2,kk)
ze=gauss3d1(3,kk)
weight=weight3d1(kk)
+ elseif(lakonl(4:7).eq.'20RB') then
+ if((lakonl(8:8).eq.'R').or.(lakonl(8:8).eq.'C')) then
+ xi=gauss3d13(1,kk)
+ et=gauss3d13(2,kk)
+ ze=gauss3d13(3,kk)
+ weight=weight3d13(kk)
+ else
+ call beamintscheme(lakonl,mint3d,ielprop(nelem),prop,
+ & kk,xi,et,ze,weight)
+ endif
elseif((lakonl(4:4).eq.'8').or.(lakonl(4:6).eq.'20R'))
& then
xi=gauss3d2(1,kk)
diff --git a/ccx_2.9/src/e_damp.f b/ccx_2.10/src/e_damp.f
similarity index 100%
rename from ccx_2.9/src/e_damp.f
rename to ccx_2.10/src/e_damp.f
diff --git a/ccx_2.9/src/edg.f b/ccx_2.10/src/edg.f
similarity index 100%
rename from ccx_2.9/src/edg.f
rename to ccx_2.10/src/edg.f
diff --git a/ccx_2.9/src/effectivemodalmass.f b/ccx_2.10/src/effectivemodalmass.f
similarity index 100%
rename from ccx_2.9/src/effectivemodalmass.f
rename to ccx_2.10/src/effectivemodalmass.f
diff --git a/ccx_2.9/src/el.f b/ccx_2.10/src/el.f
similarity index 100%
rename from ccx_2.9/src/el.f
rename to ccx_2.10/src/el.f
diff --git a/ccx_2.9/src/elastics.f b/ccx_2.10/src/elastics.f
similarity index 100%
rename from ccx_2.9/src/elastics.f
rename to ccx_2.10/src/elastics.f
diff --git a/ccx_2.9/src/electricalconductivitys.f b/ccx_2.10/src/electricalconductivitys.f
similarity index 100%
rename from ccx_2.9/src/electricalconductivitys.f
rename to ccx_2.10/src/electricalconductivitys.f
diff --git a/ccx_2.9/src/electromagnetics.c b/ccx_2.10/src/electromagnetics.c
similarity index 98%
rename from ccx_2.9/src/electromagnetics.c
rename to ccx_2.10/src/electromagnetics.c
index e7f141a..37fd2ea 100644
--- a/ccx_2.9/src/electromagnetics.c
+++ b/ccx_2.10/src/electromagnetics.c
@@ -92,7 +92,7 @@ void electromagnetics(double **cop, ITG *nk, ITG **konp, ITG **ipkonp,
*nactdog=NULL,nteq,network,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,
+ 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,
@@ -442,7 +442,7 @@ void electromagnetics(double **cop, ITG *nk, ITG **konp, ITG **ipkonp,
NNEW(ad,double,neq[1]);
NNEW(au,double,nzs[1]);
- FORTRAN(mafillsm,(co,nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,xbounold,nboun,
+ 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,
@@ -457,7 +457,7 @@ void electromagnetics(double **cop, ITG *nk, ITG **konp, ITG **ipkonp,
&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));
+ pmastsurf,&mortar,clearini,ielprop,prop,&ne0,fnext,&kscale);
if(nmethodact==0){
@@ -1267,7 +1267,14 @@ void electromagnetics(double **cop, ITG *nk, ITG **konp, ITG **ipkonp,
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,
@@ -1279,7 +1286,10 @@ void electromagnetics(double **cop, ITG *nk, ITG **konp, ITG **ipkonp,
&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);
+ &mortar,nmat,ielprop,prop,&ialeatoric,&kscale,
+ energy, &allwk, &energyref,&emax, &enres, &enetoll, //MPADD
+ energyini, &allwkini ,&allwk, &reswk, &ne0, &ne0, &dampwk, //MPADD
+ &dampwk, energy); //MPADD
}
/*********************************************************/
diff --git a/ccx_2.9/src/electromagneticss.f b/ccx_2.10/src/electromagneticss.f
similarity index 100%
rename from ccx_2.9/src/electromagneticss.f
rename to ccx_2.10/src/electromagneticss.f
diff --git a/ccx_2.9/src/elemChecker.c b/ccx_2.10/src/elemChecker.c
similarity index 100%
rename from ccx_2.9/src/elemChecker.c
rename to ccx_2.10/src/elemChecker.c
diff --git a/ccx_2.9/src/elementpernode.f b/ccx_2.10/src/elementpernode.f
similarity index 100%
rename from ccx_2.9/src/elementpernode.f
rename to ccx_2.10/src/elementpernode.f
diff --git a/ccx_2.9/src/elements.f b/ccx_2.10/src/elements.f
similarity index 100%
rename from ccx_2.9/src/elements.f
rename to ccx_2.10/src/elements.f
diff --git a/ccx_2.9/src/elprints.f b/ccx_2.10/src/elprints.f
similarity index 100%
rename from ccx_2.9/src/elprints.f
rename to ccx_2.10/src/elprints.f
diff --git a/ccx_2.9/src/envtemp.f b/ccx_2.10/src/envtemp.f
similarity index 97%
rename from ccx_2.9/src/envtemp.f
rename to ccx_2.10/src/envtemp.f
index d372dbb..fe3c369 100644
--- a/ccx_2.9/src/envtemp.f
+++ b/ccx_2.10/src/envtemp.f
@@ -38,8 +38,8 @@
!
integer itg(*),ntg,ntr,nelemload(2,*),ipkon(*),network,mi(*),
& kon(*),ielmat(mi(3),*),ne,i,j,k,l,index,id,node,nload,
- & ifaceq(9,6),ider,nasym,indexe,iaxial,
- & ifacet(7,4),ifacew(8,5),kontri3(3,1),kontri4(3,2),
+ & ifaceq(8,6),ider,nasym,indexe,iaxial,
+ & ifacet(6,4),ifacew(8,5),kontri3(3,1),kontri4(3,2),
& kontri6(3,4),kontri8(3,6),kontri(4,*),ntri,
& konf(8),nloadtr(*),nelem,nope,nopes,ig,nflow,ieg(*),
& ndirboun(*),nactdog(0:3,*),nboun,nodeboun(*),ntmat_,
@@ -52,16 +52,16 @@
& cp,r,physcon(*),shcon(0:3,ntmat_,*),rho,
& co(3,*),dvi,vold(0:mi(2),*),rhcon(*)
!
- data ifaceq /4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/
- data ifacet /1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/
+ data ifaceq /4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/
+ data ifacet /1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/
data ifacew /1,3,2,9,8,7,0,0,
& 4,5,6,10,11,12,0,0,
& 1,2,5,4,7,14,10,13,
@@ -520,7 +520,7 @@ c enddo
! purely thermal
!
network=0
- do i=1, nflow
+ do i=1,nflow
nelem=ieg(i)
index=ipkon(nelem)
node1=kon(index+1)
diff --git a/ccx_2.9/src/eplane.f b/ccx_2.10/src/eplane.f
similarity index 100%
rename from ccx_2.9/src/eplane.f
rename to ccx_2.10/src/eplane.f
diff --git a/ccx_2.9/src/equationcheck.f b/ccx_2.10/src/equationcheck.f
similarity index 100%
rename from ccx_2.9/src/equationcheck.f
rename to ccx_2.10/src/equationcheck.f
diff --git a/ccx_2.9/src/equationfs.f b/ccx_2.10/src/equationfs.f
similarity index 96%
rename from ccx_2.9/src/equationfs.f
rename to ccx_2.10/src/equationfs.f
index b5128b5..5ae8746 100644
--- a/ccx_2.9/src/equationfs.f
+++ b/ccx_2.10/src/equationfs.f
@@ -34,21 +34,21 @@
& n,i,j,ii,key,nterm,number,ntrans,ndir,indexe,
& mpcfreeold,ikmpc(*),ilmpc(*),id,idof,itr,iline,ipol,inl,
& ipoinp(2,*),inp(3,*),ipoinpc(0:*),
- & k,m,iface,ifacel,nelem,ifaceq(9,6),ifacet(7,4),ifacew(8,5),
+ & k,m,iface,ifacel,nelem,ifaceq(8,6),ifacet(6,4),ifacew(8,5),
& loadid,ne,nope,nopes,ipkon(*),nload,nelemload(2,*),kon(*)
!
real*8 coefmpc(*),co(3,*),trab(7,*),a(3,3),x,cg(3)
!
- data ifaceq /4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/
- data ifacet /1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/
+ data ifaceq /4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/
+ data ifacet /1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/
data ifacew /1,3,2,9,8,7,0,0,
& 4,5,6,10,11,12,0,0,
& 1,2,5,4,7,14,10,13,
diff --git a/ccx_2.9/src/equations.f b/ccx_2.10/src/equations.f
similarity index 100%
rename from ccx_2.9/src/equations.f
rename to ccx_2.10/src/equations.f
diff --git a/ccx_2.9/src/equcons.f b/ccx_2.10/src/equcons.f
similarity index 100%
rename from ccx_2.9/src/equcons.f
rename to ccx_2.10/src/equcons.f
diff --git a/ccx_2.9/src/errorestimator.f b/ccx_2.10/src/errorestimator.f
similarity index 88%
rename from ccx_2.9/src/errorestimator.f
rename to ccx_2.10/src/errorestimator.f
index 54c50bd..f2e5c81 100644
--- a/ccx_2.9/src/errorestimator.f
+++ b/ccx_2.10/src/errorestimator.f
@@ -28,11 +28,10 @@
!
character*8 lakon(*),lakonl
!
- integer ipkon(*),kon(*),mi(*),ne,indexe,
+ integer ipkon(*),kon(*),mi(*),ne,indexe,null,
& nonei20(3,12),nonei10(3,6),nk,i,j,k,
& nonei15(3,9),nopev,nterms,ishift,mint3d,
- & m,jj,ielmat(mi(3),*),
- & nlayer,nopeexp
+ & m,jj,ielmat(mi(3),*),nlayer,nopeexp
!
real*8 yi(nterms,mi(1),*),yn(nterms,*),size,wpsmin,wpsmax,
& absdiff,reldiff,sizemax,al(3),sizemin,firstprin,c(3,3)
@@ -46,6 +45,8 @@
& 13,5,6,14,6,7,15,7,8,16,8,5,
& 17,1,5,18,2,6,19,3,7,20,4,8/
!
+ null=0
+!
do i=1,nk
do j=1,nterms
yn(j,i)=0.d0
@@ -76,27 +77,34 @@
cycle
endif
!
-c Bernhardi start
- if((lakonl(4:6).eq.'20R').or.
- & (lakonl(4:5).eq.'8 ').or.(lakonl(4:5).eq.'8I')) then
-c Bernhardi end
- if(lakonl(7:8).ne.'LC') then
- mint3d=8
+ if(lakonl(4:5).eq.'8R') then
+ mint3d=1
+c elseif(lakonl(4:7).eq.'20RB') then
+c if((lakonl(8:8).eq.'R').or.(lakonl(8:8).eq.'C')) then
+c mint3d=50
+c else
+c call beamintscheme(lakonl,mint3d,ielprop(i),prop,
+c & null,xi,et,ze,weight)
+c endif
+ elseif((lakonl(4:4).eq.'8').or.
+ & (lakonl(4:6).eq.'20R')) then
+ if(lakonl(7:8).eq.'LC') then
+ cycle
else
- mint3d=0
+ mint3d=8
endif
- elseif(lakonl(4:4).eq.'8') then
- mint3d=1
- elseif(lakonl(4:5).eq.'10') then
- mint3d=4
elseif(lakonl(4:4).eq.'2') then
mint3d=27
+ elseif(lakonl(4:5).eq.'10') then
+ mint3d=4
elseif(lakonl(4:4).eq.'4') then
mint3d=1
- elseif(lakonl(4:4).eq.'1') then
+ elseif(lakonl(4:5).eq.'15') then
mint3d=9
- else
+ elseif(lakonl(4:5).eq.'6') then
mint3d=2
+ elseif(lakonl(1:2).eq.'ES') then
+ cycle
endif
!
! calculating the maximal differences of first principal
@@ -123,12 +131,12 @@ c Bernhardi end
!
call calceigenvalues(c,al)
!
- if(dabs(al(3)).gt.dabs(al(1))) then
- firstprin=al(3)
- else
- firstprin=al(1)
- endif
-c firstprin=al(3)
+c if(dabs(al(3)).gt.dabs(al(1))) then
+c firstprin=al(3)
+c else
+c firstprin=al(1)
+c endif
+ firstprin=al(3)
!
wpsmin=min(wpsmin,firstprin)
wpsmax=max(wpsmax,firstprin)
diff --git a/ccx_2.9/src/evalshapefunc.f b/ccx_2.10/src/evalshapefunc.f
similarity index 100%
rename from ccx_2.9/src/evalshapefunc.f
rename to ccx_2.10/src/evalshapefunc.f
diff --git a/ccx_2.9/src/expand.c b/ccx_2.10/src/expand.c
similarity index 99%
rename from ccx_2.9/src/expand.c
rename to ccx_2.10/src/expand.c
index ef740ad..e67363d 100644
--- a/ccx_2.9/src/expand.c
+++ b/ccx_2.10/src/expand.c
@@ -112,7 +112,7 @@ void expand(double *co, ITG *nk, ITG *kon, ITG *ipkon, char *lakon,
NNEW(inum,ITG,*nk);
NNEW(stx,double,6*mi[0]**ne);
- nlabel=46;
+ nlabel=47;
NNEW(filabt,char,87*nlabel);
for(i=1;i<87*nlabel;i++) filabt[i]=' ';
filabt[0]='U';
@@ -160,7 +160,7 @@ void expand(double *co, ITG *nk, ITG *kon, ITG *ipkon, char *lakon,
nelem=iel+1;
FORTRAN(calcmass,(ipkon,lakon,kon,co,mi,&nelem,ne,thicke,
ielmat,&nope,t0,t1,rhcon,nrhcon,ntmat_,
- ithermal,&csmass[i]));
+ ithermal,&csmass[i],ielprop,prop));
}
for(i2=0;i2<nope;++i2){
node=kon[indexe+i2]-1;
@@ -186,7 +186,7 @@ void expand(double *co, ITG *nk, ITG *kon, ITG *ipkon, char *lakon,
nelem=iel+1;
FORTRAN(calcmass,(ipkon,lakon,kon,co,mi,&nelem,ne,thicke,
ielmat,&nope,t0,t1,rhcon,nrhcon,ntmat_,
- ithermal,&csmass[i]));
+ ithermal,&csmass[i],ielprop,prop));
}
for(i2=0;i2<nope;++i2){
node=kon[indexe+i2]-1;
diff --git a/ccx_2.9/src/expansions.f b/ccx_2.10/src/expansions.f
similarity index 100%
rename from ccx_2.9/src/expansions.f
rename to ccx_2.10/src/expansions.f
diff --git a/ccx_2.9/src/extrapolate.f b/ccx_2.10/src/extrapolate.f
similarity index 96%
rename from ccx_2.9/src/extrapolate.f
rename to ccx_2.10/src/extrapolate.f
index 203c8ea..da7c738 100644
--- a/ccx_2.9/src/extrapolate.f
+++ b/ccx_2.10/src/extrapolate.f
@@ -25,8 +25,8 @@
!
! the C3D20RB element has 50 integration points, however, the
! first 8 integration points coincide with those of a C3D20R
-! element. In this routine and in errorestimator.f the C3D20RB
-! element is treated as an ordinary C3D20R element
+! element. In this routine the C3D20RBR and C3D20RBC
+! elements are treated as an ordinary C3D20R element
!
! the number of internal state variables is limited to 999
! (cfr. array field)
@@ -285,7 +285,7 @@
nope=20
elseif(lakonl(4:4).eq.'8') then
nope=8
- elseif((lakonl(4:5).eq.'10').or.(lakonl(4:5).eq.'14')) then
+ elseif(lakonl(4:5).eq.'10') then
nope=10
elseif(lakonl(4:4).eq.'4') then
nope=4
@@ -365,8 +365,7 @@
call beamintscheme(lakon(i),mint3d,ielprop(i),prop,
& null,xi,et,ze,weight)
elseif((lakon(i)(4:4).eq.'8').or.
- & (lakon(i)(4:6).eq.'20R').or.
- & (lakon(i)(4:6).eq.'26R')) then
+ & (lakon(i)(4:6).eq.'20R')) then
if(lakonl(7:8).eq.'LC') then
mint3d=8*nlayer
else
@@ -374,8 +373,7 @@
endif
elseif(lakon(i)(4:4).eq.'2') then
mint3d=27
- elseif((lakon(i)(4:5).eq.'10').or.
- & (lakon(i)(4:5).eq.'14')) then
+ elseif((lakon(i)(4:5).eq.'10')) then
mint3d=4
elseif(lakon(i)(4:4).eq.'4') then
mint3d=1
@@ -405,8 +403,7 @@
call beamintscheme(lakon(i),mint3d,ielprop(i),prop,
& j,xi,et,ze,weight)
elseif((lakon(i)(4:4).eq.'8').or.
- & (lakon(i)(4:6).eq.'20R').or.
- & (lakon(i)(4:6).eq.'26R'))
+ & (lakon(i)(4:6).eq.'20R'))
& then
if(lakonl(7:8).ne.'LC') then
xi=gauss3d2(1,j)
@@ -446,8 +443,7 @@
et=gauss3d3(2,j)
ze=gauss3d3(3,j)
weight=weight3d3(j)
- elseif((lakon(i)(4:5).eq.'10').or.
- & (lakon(i)(4:5).eq.'14')) then
+ elseif(lakon(i)(4:5).eq.'10') then
xi=gauss3d5(1,j)
et=gauss3d5(2,j)
ze=gauss3d5(3,j)
@@ -566,7 +562,7 @@
call beamextscheme(yi(1,1,i),ndim,nfield,lakonl,
& ielprop(i),prop,field,mi)
c Bernhardi start
- elseif((lakonl(4:6).eq.'20R').or.(lakonl(4:6).eq.'26R').or.
+ elseif((lakonl(4:6).eq.'20R').or.
& (lakonl(4:5).eq.'8 ').or.(lakonl(4:5).eq.'8I')) then
c Bernhardi end
if(lakonl(7:8).ne.'LC') then
@@ -599,7 +595,7 @@ c Bernhardi end
field(k,j)=yiloc(k,1)
enddo
enddo
- elseif((lakonl(4:5).eq.'10').or.(lakonl(4:5).eq.'14')) then
+ elseif(lakonl(4:5).eq.'10') then
do j=1,4
do k=1,nfield
field(k,j)=0.d0
@@ -668,7 +664,7 @@ c Bernhardi end
& ielprop(i),prop,field,mi)
!
c Bernhardi start
- elseif((lakonl(4:6).eq.'20R').or.(lakonl(4:6).eq.'26R').or.
+ elseif((lakonl(4:6).eq.'20R').or.
& (lakonl(4:5).eq.'8 ').or.(lakonl(4:5).eq.'8I')) then
c Bernhardi end
if(lakonl(7:8).ne.'LC') then
@@ -701,7 +697,7 @@ c Bernhardi end
field(k,j)=yi(k,1,i)
enddo
enddo
- elseif((lakonl(4:5).eq.'10').or.(lakonl(4:5).eq.'14')) then
+ elseif(lakonl(4:5).eq.'10') then
do j=1,4
do k=1,nfield
field(k,j)=0.d0
@@ -748,7 +744,7 @@ c Bernhardi end
!
! determining the field values in the midside nodes
!
- if((lakonl(4:6).eq.'20R').or.(lakonl(4:6).eq.'26R')) then
+ if(lakonl(4:6).eq.'20R') then
if(lakonl(7:8).ne.'LC') then
do j=9,20
do k=1,nfield
@@ -767,7 +763,7 @@ c Bernhardi end
enddo
enddo
endif
- elseif((lakonl(4:5).eq.'10').or.(lakonl(4:5).eq.'14')) then
+ elseif(lakonl(4:5).eq.'10') then
do j=5,10
do k=1,nfield
field(k,j)=(field(k,nonei10(2,j-4))+
diff --git a/ccx_2.9/src/extrapolate_ad_h.f b/ccx_2.10/src/extrapolate_ad_h.f
similarity index 93%
rename from ccx_2.9/src/extrapolate_ad_h.f
rename to ccx_2.10/src/extrapolate_ad_h.f
index 23dd634..a1dd466 100644
--- a/ccx_2.9/src/extrapolate_ad_h.f
+++ b/ccx_2.10/src/extrapolate_ad_h.f
@@ -32,6 +32,10 @@
!
real*8 xrlfa(3,*),xl1,advfa(*),adv(*),hel(3,*),hfa(3,*)
!
+c$omp parallel default(none)
+c$omp& shared(nface,ielfa,xrlfa,advfa,adv,hfa,hel)
+c$omp& private(i,ipo1,xl1,iel2,j,ipo3)
+c$omp do
do i=1,nface
ipo1=ielfa(1,i)
xl1=xrlfa(1,i)
@@ -65,8 +69,9 @@
hfa(j,i)=hel(j,ipo1)/advfa(i)
enddo
endif
-c write(*,*) 'extrapolate_ad ',ielfa(1,i),ielfa(4,i),advfa(i)
enddo
+c$omp end do
+c$omp end parallel
!
return
end
diff --git a/ccx_2.9/src/extrapolate_ad_h_comp.f b/ccx_2.10/src/extrapolate_ad_h_comp.f
similarity index 93%
rename from ccx_2.9/src/extrapolate_ad_h_comp.f
rename to ccx_2.10/src/extrapolate_ad_h_comp.f
index 00bbc56..58006f6 100644
--- a/ccx_2.9/src/extrapolate_ad_h_comp.f
+++ b/ccx_2.10/src/extrapolate_ad_h_comp.f
@@ -32,6 +32,10 @@
!
real*8 xrlfa(3,*),xl1,advfa(*),adv(*),hel(3,*),hfa(3,*)
!
+c$omp parallel default(none)
+c$omp& shared(nface,ielfa,xrlfa,advfa,adv,hfa,hel)
+c$omp& private(i,ipo1,xl1,iel2,j,ipo3)
+c$omp do
do i=1,nface
ipo1=ielfa(1,i)
xl1=xrlfa(1,i)
@@ -65,8 +69,9 @@
hfa(j,i)=hel(j,ipo1)/adv(ipo1)
enddo
endif
-c write(*,*) 'extrapolate_ad ',ielfa(1,i),ielfa(4,i),advfa(i)
enddo
+c$omp end do
+c$omp end parallel
!
return
end
diff --git a/ccx_2.9/src/extrapolate_gradtel.f b/ccx_2.10/src/extrapolate_gradtel.f
similarity index 92%
rename from ccx_2.9/src/extrapolate_gradtel.f
rename to ccx_2.10/src/extrapolate_gradtel.f
index 10c93cf..464db53 100644
--- a/ccx_2.9/src/extrapolate_gradtel.f
+++ b/ccx_2.10/src/extrapolate_gradtel.f
@@ -26,6 +26,10 @@
!
real*8 xrlfa(3,*),gradtel(3,*),gradtfa(3,*),xl1
!
+c$omp parallel default(none)
+c$omp& shared(nface,ielfa,xrlfa,gradtfa,gradtel)
+c$omp& private(i,iel1,xl1,iel2,l)
+c$omp do
do i=1,nface
iel1=ielfa(1,i)
xl1=xrlfa(1,i)
@@ -54,8 +58,9 @@
gradtfa(l,i)=gradtel(l,iel1)
enddo
endif
-c write(*,*) 'extrapolate_gradtel ',(gradtfa(l,i),l=1,3)
enddo
+c$omp end do
+c$omp end parallel
!
return
end
diff --git a/ccx_2.9/src/extrapolate_gradvel.f b/ccx_2.10/src/extrapolate_gradvel.f
similarity index 91%
rename from ccx_2.9/src/extrapolate_gradvel.f
rename to ccx_2.10/src/extrapolate_gradvel.f
index 75cddc2..7e69b78 100644
--- a/ccx_2.9/src/extrapolate_gradvel.f
+++ b/ccx_2.10/src/extrapolate_gradvel.f
@@ -26,6 +26,10 @@
!
real*8 xrlfa(3,*),gradvel(3,3,*),gradvfa(3,3,*),xl1
!
+c$omp parallel default(none)
+c$omp& shared(nface,ielfa,xrlfa,gradvfa,gradvel)
+c$omp& private(i,iel1,xl1,iel2,k,l)
+c$omp do
do i=1,nface
iel1=ielfa(1,i)
xl1=xrlfa(1,i)
@@ -38,7 +42,6 @@
do l=1,3
gradvfa(k,l,i)=xl1*gradvel(k,l,iel1)+
& xrlfa(2,i)*gradvel(k,l,iel2)
-c write(*,*) 'extrapolate_gradvel1',i,xrlfa(1,i),xrlfa(2,i)
enddo
enddo
elseif(ielfa(3,i).gt.0) then
@@ -49,8 +52,6 @@ c write(*,*) 'extrapolate_gradvel1',i,xrlfa(1,i),xrlfa(2,i)
do l=1,3
gradvfa(k,l,i)=xl1*gradvel(k,l,iel1)+
& xrlfa(3,i)*gradvel(k,l,ielfa(3,i))
-c write(*,*) 'extrapolate_gradvel2',i,iel1,iel2,
-c & xrlfa(1,i),xrlfa(3,i)
enddo
enddo
else
@@ -64,6 +65,8 @@ c & xrlfa(1,i),xrlfa(3,i)
enddo
endif
enddo
+c$omp end do
+c$omp end parallel
!
return
end
diff --git a/ccx_2.9/src/extrapolate_pel.f b/ccx_2.10/src/extrapolate_pel.f
similarity index 90%
rename from ccx_2.9/src/extrapolate_pel.f
rename to ccx_2.10/src/extrapolate_pel.f
index e86b547..08bf3c0 100644
--- a/ccx_2.9/src/extrapolate_pel.f
+++ b/ccx_2.10/src/extrapolate_pel.f
@@ -27,6 +27,11 @@
!
real*8 xrlfa(3,*),vel(nef,0:5),vfa(0:5,*),xboun(*),xl1
!
+c write(*,*) 'extrapolate_pel ',vel(1,4),vel(2,4)
+c$omp parallel default(none)
+c$omp& shared(nface,ielfa,xrlfa,vfa,vel,ifabou,xboun)
+c$omp& private(i,iel1,xl1,iel2)
+c$omp do
do i=1,nface
iel1=ielfa(1,i)
xl1=xrlfa(1,i)
@@ -61,10 +66,9 @@
!
vfa(4,i)=vel(iel1,4)
endif
-c write(*,*) 'extrapolate_pel pressure ',iel1,ielfa(4,i),
-c & vfa(4,i)
enddo
+c$omp end do
+c$omp end parallel
!
-c write(*,*)
return
end
diff --git a/ccx_2.9/src/extrapolate_tel.f b/ccx_2.10/src/extrapolate_tel.f
similarity index 92%
rename from ccx_2.9/src/extrapolate_tel.f
rename to ccx_2.10/src/extrapolate_tel.f
index 012987a..d10edad 100644
--- a/ccx_2.9/src/extrapolate_tel.f
+++ b/ccx_2.10/src/extrapolate_tel.f
@@ -29,10 +29,10 @@
!
real*8 xrlfa(3,*),vel(nef,0:5),vfa(0:5,*),xboun(*),xl1,xl2
!
-c do i=1,nef
-c write(*,*) 'extrapolate_tel ',i,vel(i,0)
-c enddo
-!
+c$omp parallel default(none)
+c$omp& shared(nface,ielfa,xrlfa,vel,vfa,ipnei,ifabou,xboun)
+c$omp& private(i,iel1,xl1,iel2,xl2,indexf,iel3,ipointer)
+c$omp do
do i=1,nface
iel1=ielfa(1,i)
xl1=xrlfa(1,i)
@@ -70,8 +70,9 @@ c enddo
vfa(0,i)=vel(iel1,0)
endif
endif
-c write(*,*) 'extrapolate_tel ',i,ielfa(1,i),ielfa(4,i),vfa(0,i)
enddo
+c$omp end do
+c$omp end parallel
!
return
end
diff --git a/ccx_2.9/src/extrapolate_vel.f b/ccx_2.10/src/extrapolate_vel.f
similarity index 94%
rename from ccx_2.9/src/extrapolate_vel.f
rename to ccx_2.10/src/extrapolate_vel.f
index 1430a38..4d18def 100644
--- a/ccx_2.9/src/extrapolate_vel.f
+++ b/ccx_2.10/src/extrapolate_vel.f
@@ -29,6 +29,10 @@
!
real*8 xrlfa(3,*),vel(nef,0:5),vfa(0:5,*),xboun(*),xl1,xl2
!
+c$omp parallel default(none)
+c$omp& shared(nface,ielfa,xrlfa,vfa,vel,ipnei,ifabou,xboun)
+c$omp& private(i,iel1,xl1,iel2,xl2,j,iel3,ipointer,indexf)
+c$omp do
do i=1,nface
iel1=ielfa(1,i)
xl1=xrlfa(1,i)
@@ -111,6 +115,8 @@
endif
endif
enddo
+c$omp end do
+c$omp end parallel
!
return
end
diff --git a/ccx_2.9/src/extrapolatecontact.f b/ccx_2.10/src/extrapolatecontact.f
similarity index 77%
rename from ccx_2.9/src/extrapolatecontact.f
rename to ccx_2.10/src/extrapolatecontact.f
index 30ede4d..6837a0f 100644
--- a/ccx_2.9/src/extrapolatecontact.f
+++ b/ccx_2.10/src/extrapolatecontact.f
@@ -23,11 +23,6 @@
! extrapolates contact values at the integration points to the
! nodes (for face-to-face penalty contact)
!
-! the C3D20RB element has 50 integration points, however, the
-! first 8 integration points coincide with those of a C3D20R
-! element. In this routine and in errorestimator.f the C3D20RB
-! element is treated as an ordinary C3D20R element
-!
implicit none
!
logical force
@@ -39,7 +34,7 @@
& nonei20(3,12),nfield,nonei10(3,6),nk,i,j,k,l,ndim,
& nonei15(3,9),m,iflag,jj,indexc,islavsurf(2,*),ll,
& indexcj,ifacew1(4,5),islavnode(*),nslavnode(*),ntie,
- & nlayer,nopeexp,ifacew2(8,5),ifaceq(9,6),ifacet(7,4),
+ & nlayer,nopeexp,ifacew2(8,5),ifaceq(8,6),ifacet(6,4),
& nopespring,ifaces,nopespringj,ifacej,jfaces,n,nelems,
& idgn,idgnr,idglda,idgip(4),idgldb,idginfo,igauss,islavact(*),
& konl(26),node,nopes,ielprop(*),ielmat(mi(3),*),ne0,
@@ -64,19 +59,19 @@
!
! nodes per face for hex elements
!
- data ifaceq /4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/
+ data ifaceq /4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/
!
! nodes per face for tet elements
!
- data ifacet /1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/
+ data ifacet /1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/
!
! nodes per face for linear wedge elements
!
@@ -95,140 +90,6 @@
& 3,1,4,6,9,13,12,15/
!
data iflag /2/
-c!
-c! local coordinates of the element nodes
-c!
-c data xquad /-1.d0,-1.d0,
-c & 1.d0,-1.d0,
-c & 1.d0,1.d0,
-c & -1.d0,1.d0,
-c & 0.d0,-1.d0,
-c & 1.d0,0.d0,
-c & 0.d0,1.d0,
-c & -1.d0,0.d0,
-c & 0.d0,0.d0/
-c!
-c data xtri /0.d0,0.d0,
-c & 1.d0,0.d0,
-c & 0.d0,1.d0,
-c & .5d0,0.d0,
-c & .5d0,.5d0,
-c & 0.d0,.5d0,
-c & 0.333333333333333d0,0.333333333333333d0/
-c!
-c data a2 / 1.1455,-0.1455,1.1455,-0.1455,1.1455,-0.1455,
-c & -0.1455,1.1455,-0.1455,1.1455,-0.1455,1.1455/
-c data a4 / 1.92705, -0.30902, -0.30902, -0.30902,
-c & -0.30902, 1.92705, -0.30902, -0.30902,
-c & -0.30902, -0.30902, 1.92705, -0.30902,
-c & -0.30902, -0.30902, -0.30902, 1.92705/
-c data a9 / 1.63138,-0.32628,-0.32628,-0.52027, 0.10405, 0.10405,
-c & -0.32628, 1.63138,-0.32628, 0.10405,-0.52027, 0.10405,
-c & -0.32628,-0.32628, 1.63138, 0.10405, 0.10405,-0.52027,
-c & 0.55556,-0.11111,-0.11111, 0.55556,-0.11111,-0.11111,
-c & -0.11111, 0.55556,-0.11111,-0.11111, 0.55556,-0.11111,
-c & -0.11111,-0.11111, 0.55556,-0.11111,-0.11111, 0.55556,
-c & -0.52027, 0.10405, 0.10405, 1.63138,-0.32628,-0.32628,
-c & 0.10405,-0.52027, 0.10405,-0.32628, 1.63138,-0.32628,
-c & 0.10405, 0.10405,-0.52027,-0.32628,-0.32628, 1.63138/
-c!
-c! extrapolation from a 2x2x2=8 integration point scheme in a hex to
-c! the vertex nodes
-c!
-c data a8 /2.549,-.683,.183,-.683,-.683,.183,
-c & -.04904,.183,-.683,2.549,-.683,.183,
-c & .183,-.683,.183,-.04904,-.683,.183,
-c & -.683,2.549,.183,-.04904,.183,-.683,
-c & .183,-.683,2.549,-.683,-.04904,.183,
-c & -.683,.183,-.683,.183,-.04904,.183,
-c & 2.549,-.683,.183,-.683,.183,-.683,
-c & .183,-.04904,-.683,2.549,-.683,.183,
-c & .183,-.04904,.183,-.683,-.683,.183,
-c & -.683,2.549,-.04904,.183,-.683,.183,
-c & .183,-.683,2.549,-.683/
-c!
-c! extrapolation from a 3x3x3=27 integration point scheme in a hex to
-c! the all nodes in a 20-node element
-c!
-c data a27 /
-c & 2.37499,-0.12559,-0.16145,-0.12559,-0.12559,-0.16145, 0.11575,
-c & -0.16145, 0.32628, 0.11111, 0.11111, 0.32628, 0.11111,-0.10405,
-c & -0.10405, 0.11111, 0.32628, 0.11111,-0.10405, 0.11111,-0.31246,
-c & -0.31246, 0.31481, 0.31481, 0.31481, 0.31481,-0.16902,-0.16902,
-c & 1.28439,-0.27072,-0.19444,-0.27072,-0.19444, 0.15961,-0.00661,
-c & 0.15961,-0.27072,-0.27072, 0.15961, 0.15961,-0.12559, 2.37499,
-c & -0.12559,-0.16145,-0.16145,-0.12559,-0.16145, 0.11575, 0.32628,
-c & 0.32628, 0.11111, 0.11111, 0.11111, 0.11111,-0.10405,-0.10405,
-c & 0.11111, 0.32628, 0.11111,-0.10405,-0.31246, 0.31481, 0.31481,
-c & -0.31246, 0.31481,-0.16902,-0.16902, 0.31481,-0.27072,-0.19444,
-c & -0.27072, 1.28439, 0.15961,-0.00661, 0.15961,-0.19444,-0.27072,
-c & 0.15961, 0.15961,-0.27072,-0.48824,-0.48824,-0.48824,-0.48824,
-c & 0.22898, 0.22898, 0.22898, 0.22898, 0.05556, 0.05556, 0.05556,
-c & 0.05556, 0.05556, 0.05556, 0.05556, 0.05556,-0.22222,-0.22222,
-c & -0.22222,-0.22222, 0.31481,-0.31246,-0.31246, 0.31481,-0.16902,
-c & 0.31481, 0.31481,-0.16902,-0.27072, 1.28439,-0.27072,-0.19444,
-c & 0.15961,-0.19444, 0.15961,-0.00661, 0.15961,-0.27072,-0.27072,
-c & 0.15961,-0.12559,-0.16145,-0.12559, 2.37499,-0.16145, 0.11575,
-c & -0.16145,-0.12559, 0.11111, 0.11111, 0.32628, 0.32628,-0.10405,
-c & -0.10405, 0.11111, 0.11111, 0.11111,-0.10405, 0.11111, 0.32628,
-c & 0.31481, 0.31481,-0.31246,-0.31246,-0.16902,-0.16902, 0.31481,
-c & 0.31481,-0.19444,-0.27072, 1.28439,-0.27072,-0.00661, 0.15961,
-c & -0.19444, 0.15961, 0.15961, 0.15961,-0.27072,-0.27072,-0.16145,
-c & -0.12559, 2.37499,-0.12559, 0.11575,-0.16145,-0.12559,-0.16145,
-c & 0.11111, 0.32628, 0.32628, 0.11111,-0.10405, 0.11111, 0.11111,
-c & -0.10405,-0.10405, 0.11111, 0.32628, 0.11111,-0.31246, 0.31481,
-c & -0.16902, 0.31481,-0.31246, 0.31481,-0.16902, 0.31481,-0.27072,
-c & 0.15961, 0.15961,-0.27072,-0.27072, 0.15961, 0.15961,-0.27072,
-c & 1.28439,-0.19444,-0.00661,-0.19444,-0.48824,-0.48824, 0.22898,
-c & 0.22898,-0.48824,-0.48824, 0.22898, 0.22898, 0.05556,-0.22222,
-c & 0.05556,-0.22222, 0.05556,-0.22222, 0.05556,-0.22222, 0.05556,
-c & 0.05556, 0.05556, 0.05556, 0.31481,-0.31246, 0.31481,-0.16902,
-c & 0.31481,-0.31246, 0.31481,-0.16902,-0.27072,-0.27072, 0.15961,
-c & 0.15961,-0.27072,-0.27072, 0.15961, 0.15961,-0.19444, 1.28439,
-c & -0.19444,-0.00661,-0.48824, 0.22898, 0.22898,-0.48824,-0.48824,
-c & 0.22898, 0.22898,-0.48824,-0.22222, 0.05556,-0.22222, 0.05556,
-c & -0.22222, 0.05556,-0.22222, 0.05556, 0.05556, 0.05556, 0.05556,
-c & 0.05556,-0.29630,-0.29630,-0.29630,-0.29630,-0.29630,-0.29630,
-c & -0.29630,-0.29630,-0.11111,-0.11111,-0.11111,-0.11111,-0.11111,
-c & -0.11111,-0.11111,-0.11111,-0.11111,-0.11111,-0.11111,-0.11111,
-c & 0.22898,-0.48824,-0.48824, 0.22898, 0.22898,-0.48824,-0.48824,
-c & 0.22898,-0.22222, 0.05556,-0.22222, 0.05556,-0.22222, 0.05556,
-c & -0.22222, 0.05556, 0.05556, 0.05556, 0.05556, 0.05556, 0.31481,
-c & -0.16902, 0.31481,-0.31246, 0.31481,-0.16902, 0.31481,-0.31246,
-c & 0.15961, 0.15961,-0.27072,-0.27072, 0.15961, 0.15961,-0.27072,
-c & -0.27072,-0.19444,-0.00661,-0.19444, 1.28439, 0.22898, 0.22898,
-c & -0.48824,-0.48824, 0.22898, 0.22898,-0.48824,-0.48824, 0.05556,
-c & -0.22222, 0.05556,-0.22222, 0.05556,-0.22222, 0.05556,-0.22222,
-c & 0.05556, 0.05556, 0.05556, 0.05556,-0.16902, 0.31481,-0.31246,
-c & 0.31481,-0.16902, 0.31481,-0.31246, 0.31481, 0.15961,-0.27072,
-c & -0.27072, 0.15961, 0.15961,-0.27072,-0.27072, 0.15961,-0.00661,
-c & -0.19444, 1.28439,-0.19444,-0.12559,-0.16145, 0.11575,-0.16145,
-c & 2.37499,-0.12559,-0.16145,-0.12559, 0.11111,-0.10405,-0.10405,
-c & 0.11111, 0.32628, 0.11111, 0.11111, 0.32628, 0.32628, 0.11111,
-c & -0.10405, 0.11111, 0.31481, 0.31481,-0.16902,-0.16902,-0.31246,
-c & -0.31246, 0.31481, 0.31481,-0.19444, 0.15961,-0.00661, 0.15961,
-c & 1.28439,-0.27072,-0.19444,-0.27072,-0.27072,-0.27072, 0.15961,
-c & 0.15961,-0.16145,-0.12559,-0.16145, 0.11575,-0.12559, 2.37499,
-c & -0.12559,-0.16145, 0.11111, 0.11111,-0.10405,-0.10405, 0.32628,
-c & 0.32628, 0.11111, 0.11111, 0.11111, 0.32628, 0.11111,-0.10405,
-c & 0.31481,-0.16902,-0.16902, 0.31481,-0.31246, 0.31481, 0.31481,
-c & -0.31246, 0.15961,-0.00661, 0.15961,-0.19444,-0.27072,-0.19444,
-c & -0.27072, 1.28439,-0.27072, 0.15961, 0.15961,-0.27072, 0.22898,
-c & 0.22898, 0.22898, 0.22898,-0.48824,-0.48824,-0.48824,-0.48824,
-c & 0.05556, 0.05556, 0.05556, 0.05556, 0.05556, 0.05556, 0.05556,
-c & 0.05556,-0.22222,-0.22222,-0.22222,-0.22222,-0.16902, 0.31481,
-c & 0.31481,-0.16902, 0.31481,-0.31246,-0.31246, 0.31481, 0.15961,
-c & -0.19444, 0.15961,-0.00661,-0.27072, 1.28439,-0.27072,-0.19444,
-c & 0.15961,-0.27072,-0.27072, 0.15961,-0.16145, 0.11575,-0.16145,
-c & -0.12559,-0.12559,-0.16145,-0.12559, 2.37499,-0.10405,-0.10405,
-c & 0.11111, 0.11111, 0.11111, 0.11111, 0.32628, 0.32628, 0.11111,
-c & -0.10405, 0.11111, 0.32628,-0.16902,-0.16902, 0.31481, 0.31481,
-c & 0.31481, 0.31481,-0.31246,-0.31246,-0.00661, 0.15961,-0.19444,
-c & 0.15961,-0.19444,-0.27072, 1.28439,-0.27072, 0.15961, 0.15961,
-c & -0.27072,-0.27072, 0.11575,-0.16145,-0.12559,-0.16145,-0.16145,
-c & -0.12559, 2.37499,-0.12559,-0.10405, 0.11111, 0.11111,-0.10405,
-c & 0.11111, 0.32628, 0.32628, 0.11111,-0.10405, 0.11111, 0.32628,
-c & 0.11111/
!
if(nfield.eq.0) return
!
@@ -278,7 +139,7 @@ c & 0.11111/
nope=20
elseif(lakonl(4:4).eq.'8') then
nope=8
- elseif((lakonl(4:5).eq.'10').or.(lakonl(4:5).eq.'14')) then
+ elseif(lakonl(4:5).eq.'10') then
nope=10
elseif(lakonl(4:4).eq.'4') then
nope=4
@@ -545,7 +406,7 @@ c & 0.11111/
! determining the field values in the midside nodes of the
! slave face
!
- if((lakonl(4:5).eq.'20').or.(lakonl(4:6).eq.'26R')) then
+ if(lakonl(4:5).eq.'20') then
if(lakonl(7:8).ne.'LC') then
do j=5,8
do k=1,nfield
@@ -565,7 +426,7 @@ c & 0.11111/
enddo
enddo
endif
- elseif((lakonl(4:5).eq.'10').or.(lakonl(4:5).eq.'14')) then
+ elseif(lakonl(4:5).eq.'10') then
do j=4,6
do k=1,nfield
field(k,ifacet(j,jfaces))=
diff --git a/ccx_2.9/src/extrapolatefluid.f b/ccx_2.10/src/extrapolatefluid.f
similarity index 100%
rename from ccx_2.9/src/extrapolatefluid.f
rename to ccx_2.10/src/extrapolatefluid.f
diff --git a/ccx_2.9/src/faceinfo.f b/ccx_2.10/src/faceinfo.f
similarity index 100%
rename from ccx_2.9/src/faceinfo.f
rename to ccx_2.10/src/faceinfo.f
diff --git a/ccx_2.9/src/faceprints.f b/ccx_2.10/src/faceprints.f
similarity index 100%
rename from ccx_2.9/src/faceprints.f
rename to ccx_2.10/src/faceprints.f
diff --git a/ccx_2.9/src/fcrit.f b/ccx_2.10/src/fcrit.f
similarity index 100%
rename from ccx_2.9/src/fcrit.f
rename to ccx_2.10/src/fcrit.f
diff --git a/ccx_2.9/src/fillknotmpc.f b/ccx_2.10/src/fillknotmpc.f
similarity index 100%
rename from ccx_2.9/src/fillknotmpc.f
rename to ccx_2.10/src/fillknotmpc.f
diff --git a/ccx_2.9/src/film.f b/ccx_2.10/src/film.f
similarity index 100%
rename from ccx_2.9/src/film.f
rename to ccx_2.10/src/film.f
diff --git a/ccx_2.9/src/films.f b/ccx_2.10/src/films.f
similarity index 100%
rename from ccx_2.9/src/films.f
rename to ccx_2.10/src/films.f
diff --git a/ccx_2.9/src/findsurface.f b/ccx_2.10/src/findsurface.f
similarity index 95%
rename from ccx_2.9/src/findsurface.f
rename to ccx_2.10/src/findsurface.f
index 94147bc..d1730b1 100644
--- a/ccx_2.9/src/findsurface.f
+++ b/ccx_2.10/src/findsurface.f
@@ -28,22 +28,22 @@
character*81 tieset(3,*),slavset
!
integer ipoface(*),nodface(5,*),nodes(4),
- & ne,ipkon(*),kon(*),indexe,ifaceq(9,6),ifacet(7,4),index1,
+ & ne,ipkon(*),kon(*),indexe,ifaceq(8,6),ifacet(6,4),index1,
& ifacew(8,5),ithree,ifour,iaux,kflag,i,j,k,m,
& ifree,index1old,ifreenew,ntie,ipos
!
! nodes belonging to the element faces
!
- data ifaceq /4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/
- data ifacet /1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/
+ data ifaceq /4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/
+ data ifacet /1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/
data ifacew /1,3,2,9,8,7,0,0,
& 4,5,6,10,11,12,0,0,
& 1,2,5,4,7,14,10,13,
diff --git a/ccx_2.9/src/flowoutput.f b/ccx_2.10/src/flowoutput.f
similarity index 100%
rename from ccx_2.9/src/flowoutput.f
rename to ccx_2.10/src/flowoutput.f
diff --git a/ccx_2.9/src/flowresult.f b/ccx_2.10/src/flowresult.f
similarity index 100%
rename from ccx_2.9/src/flowresult.f
rename to ccx_2.10/src/flowresult.f
diff --git a/ccx_2.9/src/fluidconstantss.f b/ccx_2.10/src/fluidconstantss.f
similarity index 100%
rename from ccx_2.9/src/fluidconstantss.f
rename to ccx_2.10/src/fluidconstantss.f
diff --git a/ccx_2.9/src/fluidsections.f b/ccx_2.10/src/fluidsections.f
similarity index 100%
rename from ccx_2.9/src/fluidsections.f
rename to ccx_2.10/src/fluidsections.f
diff --git a/ccx_2.9/src/flux.f b/ccx_2.10/src/flux.f
similarity index 100%
rename from ccx_2.9/src/flux.f
rename to ccx_2.10/src/flux.f
diff --git a/ccx_2.9/src/forcadd.f b/ccx_2.10/src/forcadd.f
similarity index 100%
rename from ccx_2.9/src/forcadd.f
rename to ccx_2.10/src/forcadd.f
diff --git a/ccx_2.9/src/forcesolve.f b/ccx_2.10/src/forcesolve.f
similarity index 100%
rename from ccx_2.9/src/forcesolve.f
rename to ccx_2.10/src/forcesolve.f
diff --git a/ccx_2.9/src/frd.c b/ccx_2.10/src/frd.c
similarity index 99%
rename from ccx_2.9/src/frd.c
rename to ccx_2.10/src/frd.c
index 02c784f..5d8a4b5 100644
--- a/ccx_2.9/src/frd.c
+++ b/ccx_2.10/src/frd.c
@@ -186,6 +186,8 @@ void frd(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,ITG *ne0,
fprintf(f1,"%5sUTIME %8s \n",p1,newclock);
fprintf(f1,"%5sUHOST \n",p1);
fprintf(f1,"%5sUPGM CalculiX \n",p1);
+ fprintf(f1,"%5sUVERSION Version 2.10 \n",p1);
+ fprintf(f1,"%5sUCOMPILETIME Sa 5. Mär 12:23:33 CET 2016 \n",p1);
fprintf(f1,"%5sUDIR \n",p1);
fprintf(f1,"%5sUDBN \n",p1);
diff --git a/ccx_2.10/src/frd_se.c b/ccx_2.10/src/frd_se.c
new file mode 100644
index 0000000..6c8c03b
--- /dev/null
+++ b/ccx_2.10/src/frd_se.c
@@ -0,0 +1,132 @@
+/* CalculiX - A 3-dimensional finite element program */
+/* Copyright (C) 1998-2015 Guido Dhondt */
+
+/* This program is free software; you can redistribute it and/or */
+/* modify it under the terms of the GNU General Public License as */
+/* published by the Free Software Foundation(version 2); */
+/* */
+
+/* This program is distributed in the hope that it will be useful, */
+/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
+/* GNU General Public License for more details. */
+
+/* You should have received a copy of the GNU General Public License */
+/* along with this program; if not, write to the Free Software */
+/* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+#include <stdlib.h>
+#include <math.h>
+#include <stdio.h>
+#include <string.h>
+#include "CalculiX.h"
+
+#define min(a,b) ((a) <= (b) ? (a) : (b))
+#define max(a,b) ((a) >= (b) ? (a) : (b))
+
+void frd_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){
+
+ /* 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 ncomptensor=4,ifieldtensor[4]={1,1,1,1},icomptensor[4]={0,1,2,4},
+ nfieldtensor[2]={4,0};
+
+ int iw;
+
+ float ifl;
+
+ 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;
+
+ /* storing the sensitivities in the nodes */
+
+ //if(strcmp1(filab,"SEN ")==0){
+ 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 SEN 4 1\n");
+ fprintf(f1," -5 SENDX 1 2 1 0\n");
+ fprintf(f1," -5 SENDY 1 2 2 0\n");
+ fprintf(f1," -5 SENDZ 1 2 3 0\n");
+ fprintf(f1," -5 SENNORM 1 2 4 0\n");
+
+ frdselect(dgdxtotglob,dgdxtotglob,&iset,&nkcoords,inum,m1,istartset,
+ iendset,ialset,ngraph,&ncomptensor,ifieldtensor,icomptensor,
+ nfieldtensor,&iselect,m2,f1,output,m3);
+ // }
+
+
+ fclose(f1);
+ return;
+
+}
diff --git a/ccx_2.9/src/frdcyc.c b/ccx_2.10/src/frdcyc.c
similarity index 100%
rename from ccx_2.9/src/frdcyc.c
rename to ccx_2.10/src/frdcyc.c
diff --git a/ccx_2.9/src/frdfluid.f b/ccx_2.10/src/frdfluid.f
similarity index 94%
rename from ccx_2.9/src/frdfluid.f
rename to ccx_2.10/src/frdfluid.f
index 097014b..5834844 100644
--- a/ccx_2.9/src/frdfluid.f
+++ b/ccx_2.10/src/frdfluid.f
@@ -18,7 +18,7 @@
!
subroutine frdfluid(co,nk,kon,ipkonf,lakonf,nef,vold,
& kode,time,ielmat,matname,filab,inum,ntrans,inotr,trab,mi,
- & istep,stn,qfn,nactdohinv,xmach,xkappa)
+ & istep,stn,qfn,nactdohinv,xmach,xkappa,physcon)
!
! stores the results in frd format
!
@@ -39,7 +39,7 @@
& nactdohinv(*)
!
real*8 co(3,*),vold(0:mi(2),*),time,pi,oner,trab(7,*),
- & a(3,3),stn(6,*),qfn(3,*),xmach(*),xkappa(*)
+ & a(3,3),stn(6,*),qfn(3,*),xmach(*),xkappa(*),physcon(10)
!
save nout
!
@@ -505,34 +505,34 @@
enddo
write(13,'(a3)') m3
endif
-c!
-c if(filab(24)(1:4).eq.'CP ') then
-c text=' 1PSTEP'
-c write(text(25:36),'(i12)') kode
-c write(13,'(a132)') text
-c!
-c text=
-c & ' 100CL .00000E+00 3 1'
-c text(75:75)='1'
-c write(text(25:36),'(i12)') nout
-c write(text(8:12),'(i5)') 100+kode
-c write(text(13:24),fmat) time
-c write(text(59:63),'(i5)') kode
-c write(13,'(a132)') text
-c text=' -4 CP3DF 1 1'
-c write(13,'(a132)') text
-c text=' -5 CP 1 1 0 0'
-c write(13,'(a132)') text
-c!
-c do i=1,nk
-c if(inum(i).le.0) cycle
-c write(13,100) m1,i,(vold(4,i)-physcon(6))*2.d0/
-c & (physcon(7)*physcon(5)**2)
-c enddo
-c!
-c write(13,'(a3)') m3
-c endif
-c!
+!
+ if(filab(24)(1:4).eq.'CP ') then
+ text=' 1PSTEP'
+ write(text(25:36),'(i12)') kode
+ write(13,'(a132)') text
+!
+ text=
+ & ' 100CL .00000E+00 3 1'
+ text(75:75)='1'
+ write(text(25:36),'(i12)') nout
+ write(text(8:12),'(i5)') 100+kode
+ write(text(13:24),fmat) time
+ write(text(59:63),'(i5)') kode
+ write(13,'(a132)') text
+ text=' -4 CP3DF 1 1'
+ write(13,'(a132)') text
+ text=' -5 CP 1 1 0 0'
+ write(13,'(a132)') text
+!
+ do i=1,nk
+ if(inum(i).le.0) cycle
+ write(13,100) m1,i,(vold(4,i)-physcon(6))*2.d0/
+ & (physcon(7)*physcon(5)**2)
+ enddo
+!
+ write(13,'(a3)') m3
+ endif
+!
c if(filab(25)(1:4).eq.'TURB') then
c text=' 1PSTEP'
c write(text(25:36),'(i12)') kode
diff --git a/ccx_2.9/src/frdheader.c b/ccx_2.10/src/frdheader.c
similarity index 100%
rename from ccx_2.9/src/frdheader.c
rename to ccx_2.10/src/frdheader.c
diff --git a/ccx_2.9/src/frditeration.f b/ccx_2.10/src/frditeration.f
similarity index 100%
rename from ccx_2.9/src/frditeration.f
rename to ccx_2.10/src/frditeration.f
diff --git a/ccx_2.9/src/frdselect.c b/ccx_2.10/src/frdselect.c
similarity index 100%
rename from ccx_2.9/src/frdselect.c
rename to ccx_2.10/src/frdselect.c
diff --git a/ccx_2.9/src/frdset.c b/ccx_2.10/src/frdset.c
similarity index 100%
rename from ccx_2.9/src/frdset.c
rename to ccx_2.10/src/frdset.c
diff --git a/ccx_2.9/src/frdvector.c b/ccx_2.10/src/frdvector.c
similarity index 100%
rename from ccx_2.9/src/frdvector.c
rename to ccx_2.10/src/frdvector.c
diff --git a/ccx_2.9/src/frecord.c b/ccx_2.10/src/frecord.c
similarity index 100%
rename from ccx_2.9/src/frecord.c
rename to ccx_2.10/src/frecord.c
diff --git a/ccx_2.9/src/free_convection.f b/ccx_2.10/src/free_convection.f
similarity index 100%
rename from ccx_2.9/src/free_convection.f
rename to ccx_2.10/src/free_convection.f
diff --git a/ccx_2.9/src/free_disc_pumping.f b/ccx_2.10/src/free_disc_pumping.f
similarity index 100%
rename from ccx_2.9/src/free_disc_pumping.f
rename to ccx_2.10/src/free_disc_pumping.f
diff --git a/ccx_2.9/src/frequencys.f b/ccx_2.10/src/frequencys.f
similarity index 100%
rename from ccx_2.9/src/frequencys.f
rename to ccx_2.10/src/frequencys.f
diff --git a/ccx_2.9/src/friction_coefficient.f b/ccx_2.10/src/friction_coefficient.f
similarity index 100%
rename from ccx_2.9/src/friction_coefficient.f
rename to ccx_2.10/src/friction_coefficient.f
diff --git a/ccx_2.9/src/frictionheating.f b/ccx_2.10/src/frictionheating.f
similarity index 98%
rename from ccx_2.9/src/frictionheating.f
rename to ccx_2.10/src/frictionheating.f
index f67bd1a..54f7792 100644
--- a/ccx_2.9/src/frictionheating.f
+++ b/ccx_2.10/src/frictionheating.f
@@ -18,7 +18,7 @@
!
subroutine frictionheating(ne0,ne,ipkon,lakon,ielmat,mi,elcon,
& ncmat_,ntmat_,kon,islavsurf,pmastsurf,springarea,co,vold,
- & veold,pslavsurf,xload,nload,nload_,nelemload,iamload,
+ & veold,pslavsurf,xloadact,nload,nload_,nelemload,iamload,
& idefload,sideload,stx,nam)
!
! determines the effect of friction heating
@@ -38,7 +38,7 @@
& pmastsurf(6,*),area,springarea(2,*),pl(3,20),co(3,*),
& vold(0:mi(2),*),areaslav,xi,et,vels(3),veold(0:mi(2),*),
& xsj2m(3),xs2m(3,7),shp2m(7,9),xsj2s(3),xs2s(3,7),shp2s(7,9),
- & areamast,pslavsurf(3,*),value,velm(3),um,xload(2,*),weight,
+ & areamast,pslavsurf(3,*),value,velm(3),um,xloadact(2,*),weight,
& shear,vnorm,f,eta
!
include "gauss.f"
@@ -49,7 +49,7 @@
iamplitude=0
isector=0
!
- do i=ne0,ne
+ do i=ne0+1,ne
imat=ielmat(1,i)
!
! heat conversion factor
@@ -171,7 +171,7 @@
!
if(vnorm.gt.0.d0) then
value=um*pressure*vnorm*eta*f*area/areaslav
- call loadadd(nelems,label,value,nelemload,sideload,xload,
+ call loadadd(nelems,label,value,nelemload,sideload,xloadact,
& nload,nload_,iamload,iamplitude,nam,isector,
& idefload)
else
@@ -230,7 +230,7 @@
& (vels(2)-velm(2))**2+
& (vels(3)-velm(3))**2)
value=um*pressure*vnorm*eta*f*area/areaslav
- call loadadd(nelems,label,value,nelemload,sideload,xload,
+ call loadadd(nelems,label,value,nelemload,sideload,xloadact,
& nload,nload_,iamload,iamplitude,nam,isector,
& idefload)
endif
@@ -293,7 +293,7 @@
! calculated for the slave surface (differential velocity)
!
value=um*pressure*vnorm*eta*(1.d0-f)*area/areamast
- call loadadd(nelemm,label,value,nelemload,sideload,xload,
+ call loadadd(nelemm,label,value,nelemload,sideload,xloadact,
& nload,nload_,iamload,iamplitude,nam,isector,
& idefload)
enddo
diff --git a/ccx_2.9/src/frictions.f b/ccx_2.10/src/frictions.f
similarity index 100%
rename from ccx_2.9/src/frictions.f
rename to ccx_2.10/src/frictions.f
diff --git a/ccx_2.9/src/fsub.f b/ccx_2.10/src/fsub.f
similarity index 100%
rename from ccx_2.9/src/fsub.f
rename to ccx_2.10/src/fsub.f
diff --git a/ccx_2.9/src/fsuper.f b/ccx_2.10/src/fsuper.f
similarity index 100%
rename from ccx_2.9/src/fsuper.f
rename to ccx_2.10/src/fsuper.f
diff --git a/ccx_2.9/src/gapcon.f b/ccx_2.10/src/gapcon.f
similarity index 100%
rename from ccx_2.9/src/gapcon.f
rename to ccx_2.10/src/gapcon.f
diff --git a/ccx_2.9/src/gapconductances.f b/ccx_2.10/src/gapconductances.f
similarity index 100%
rename from ccx_2.9/src/gapconductances.f
rename to ccx_2.10/src/gapconductances.f
diff --git a/ccx_2.9/src/gapheatgenerations.f b/ccx_2.10/src/gapheatgenerations.f
similarity index 100%
rename from ccx_2.9/src/gapheatgenerations.f
rename to ccx_2.10/src/gapheatgenerations.f
diff --git a/ccx_2.9/src/gaps.f b/ccx_2.10/src/gaps.f
similarity index 100%
rename from ccx_2.9/src/gaps.f
rename to ccx_2.10/src/gaps.f
diff --git a/ccx_2.9/src/gasmechbc.f b/ccx_2.10/src/gasmechbc.f
similarity index 100%
rename from ccx_2.9/src/gasmechbc.f
rename to ccx_2.10/src/gasmechbc.f
diff --git a/ccx_2.9/src/gaspipe.f b/ccx_2.10/src/gaspipe.f
similarity index 100%
rename from ccx_2.9/src/gaspipe.f
rename to ccx_2.10/src/gaspipe.f
diff --git a/ccx_2.9/src/gaspipe_fanno.f b/ccx_2.10/src/gaspipe_fanno.f
similarity index 100%
rename from ccx_2.9/src/gaspipe_fanno.f
rename to ccx_2.10/src/gaspipe_fanno.f
diff --git a/ccx_2.9/src/gauss.f b/ccx_2.10/src/gauss.f
similarity index 100%
rename from ccx_2.9/src/gauss.f
rename to ccx_2.10/src/gauss.f
diff --git a/ccx_2.9/src/gen3dboun.f b/ccx_2.10/src/gen3dboun.f
similarity index 99%
rename from ccx_2.9/src/gen3dboun.f
rename to ccx_2.10/src/gen3dboun.f
index fe6187b..8a58f39 100644
--- a/ccx_2.9/src/gen3dboun.f
+++ b/ccx_2.10/src/gen3dboun.f
@@ -664,7 +664,7 @@ c enddo
! rotation vector is projected on the tangential
! plane
!
- if(dot.gt.0.05) then
+ if(dabs(dot).gt.0.05) then
if(xboun(i).gt.1.d-10) then
write(*,*) '*ERROR in gen3dboun: rotation'
write(*,*) ' vector in node ',node
@@ -682,7 +682,7 @@ c enddo
! rotation vectors closer than 45 degrees with the normal
! (= drilling direction) are not taken into account
!
- if(dot.gt.0.70710678d0) cycle
+ if(dabs(dot).gt.0.70710678d0) cycle
!
! projecting the rotation vector on the tangent plane
!
diff --git a/ccx_2.9/src/gen3dconnect.f b/ccx_2.10/src/gen3dconnect.f
similarity index 100%
rename from ccx_2.9/src/gen3dconnect.f
rename to ccx_2.10/src/gen3dconnect.f
diff --git a/ccx_2.9/src/gen3delem.f b/ccx_2.10/src/gen3delem.f
similarity index 100%
rename from ccx_2.9/src/gen3delem.f
rename to ccx_2.10/src/gen3delem.f
diff --git a/ccx_2.9/src/gen3dforc.f b/ccx_2.10/src/gen3dforc.f
similarity index 100%
rename from ccx_2.9/src/gen3dforc.f
rename to ccx_2.10/src/gen3dforc.f
diff --git a/ccx_2.9/src/gen3dfrom1d.f b/ccx_2.10/src/gen3dfrom1d.f
similarity index 100%
rename from ccx_2.9/src/gen3dfrom1d.f
rename to ccx_2.10/src/gen3dfrom1d.f
diff --git a/ccx_2.9/src/gen3dfrom2d.f b/ccx_2.10/src/gen3dfrom2d.f
similarity index 100%
rename from ccx_2.9/src/gen3dfrom2d.f
rename to ccx_2.10/src/gen3dfrom2d.f
diff --git a/ccx_2.9/src/gen3dmembrane.f b/ccx_2.10/src/gen3dmembrane.f
similarity index 100%
rename from ccx_2.9/src/gen3dmembrane.f
rename to ccx_2.10/src/gen3dmembrane.f
diff --git a/ccx_2.9/src/gen3dmpc.f b/ccx_2.10/src/gen3dmpc.f
similarity index 100%
rename from ccx_2.9/src/gen3dmpc.f
rename to ccx_2.10/src/gen3dmpc.f
diff --git a/ccx_2.9/src/gen3dnor.f b/ccx_2.10/src/gen3dnor.f
similarity index 100%
rename from ccx_2.9/src/gen3dnor.f
rename to ccx_2.10/src/gen3dnor.f
diff --git a/ccx_2.9/src/gen3dprop.f b/ccx_2.10/src/gen3dprop.f
similarity index 100%
rename from ccx_2.9/src/gen3dprop.f
rename to ccx_2.10/src/gen3dprop.f
diff --git a/ccx_2.9/src/gen3dsurf.f b/ccx_2.10/src/gen3dsurf.f
similarity index 100%
rename from ccx_2.9/src/gen3dsurf.f
rename to ccx_2.10/src/gen3dsurf.f
diff --git a/ccx_2.9/src/gen3dtemp.f b/ccx_2.10/src/gen3dtemp.f
similarity index 100%
rename from ccx_2.9/src/gen3dtemp.f
rename to ccx_2.10/src/gen3dtemp.f
diff --git a/ccx_2.9/src/gen3dtruss.f b/ccx_2.10/src/gen3dtruss.f
similarity index 100%
rename from ccx_2.9/src/gen3dtruss.f
rename to ccx_2.10/src/gen3dtruss.f
diff --git a/ccx_2.9/src/genadvecelem.f b/ccx_2.10/src/genadvecelem.f
similarity index 92%
rename from ccx_2.9/src/genadvecelem.f
rename to ccx_2.10/src/genadvecelem.f
index cc1afc9..42f619a 100644
--- a/ccx_2.9/src/genadvecelem.f
+++ b/ccx_2.10/src/genadvecelem.f
@@ -28,25 +28,25 @@
character*20 sideload(*)
!
integer inodesd(*),nnodesd,ipkon(*),ne,i,j,indexe,node,id,kon(*),
- & nload,ifaceq(9,6),ifacet(7,4),ifacew1(4,5),ifacew2(8,5),
+ & nload,ifaceq(8,6),ifacet(6,4),ifacew1(4,5),ifacew2(8,5),
& nodef(8),nelemload(2,*),nope,jface,k,nopes,nkon,nelem,
& nface
!
! nodes per face for hex elements
!
- data ifaceq /4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/
+ data ifaceq /4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/
!
! nodes per face for tet elements
!
- data ifacet /1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/
+ data ifacet /1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/
!
! nodes per face for linear wedge elements
!
diff --git a/ccx_2.9/src/gencontelem_f2f.f b/ccx_2.10/src/gencontelem_f2f.f
similarity index 91%
rename from ccx_2.9/src/gencontelem_f2f.f
rename to ccx_2.10/src/gencontelem_f2f.f
index af24cbb..d0b31b5 100644
--- a/ccx_2.9/src/gencontelem_f2f.f
+++ b/ccx_2.10/src/gencontelem_f2f.f
@@ -21,7 +21,7 @@
& 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)
+ & ialeatoric,nmethod)
!
! generate contact elements for the slave contact nodes
!
@@ -36,13 +36,13 @@
& itietri(2,ntie),ipkon(*),kon(*),koncont(4,*),ne,
& neigh(1),iflag,kneigh,i,j,k,l,jj,nn,isol,icutb,
& itri,ll,kflag,n,nx(*),ny(*),istep,iinc,mi(*),
- & nz(*),nstart,ielmat(mi(3),*),imat,ifaceq(9,6),ifacet(7,4),
+ & nz(*),nstart,ielmat(mi(3),*),imat,ifaceq(8,6),ifacet(6,4),
& ifacew1(4,5),ifacew2(8,5),nelemm,jfacem,indexe,iit,
& nface,nope,nodefm(9),ncmat_,ntmat_,number(4),lenset,
& iteller,ifaces,jfaces,ifacem,indexel,iloop,iprev,iact,
& imastop(3,*), itriangle(100),ntriangle,ntriangle_,itriold,
& itrinew,id,islavsurf(2,*),itiefac(2,*),nelems,m,mint2d,nopes,
- & iloc,nopem,nodefs(9),indexf,ialeatoric
+ & iloc,nopem,nodefs(9),indexf,ialeatoric,nmethod
!
real*8 cg(3,*),straight(16,*),co(3,*),vold(0:mi(2),*),p(3),
& dist,xo(*),yo(*),zo(*),x(*),y(*),z(*),clearini(3,9,*),
@@ -54,19 +54,19 @@
!
! nodes per face for hex elements
!
- data ifaceq /4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/
+ data ifaceq /4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/
!
! nodes per face for tet elements
!
- data ifacet /1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/
+ data ifacet /1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/
!
! nodes per face for linear wedge elements
!
@@ -205,22 +205,10 @@
mint2d=9
nopes=8
nope=20
- elseif(lakon(nelems)(4:6).eq.'26R') then
- mint2d=4
- nopes=9
- nope=26
- elseif(lakon(nelems)(4:4).eq.'2') then
- mint2d=9
- nopes=9
- nope=26
elseif(lakon(nelems)(4:5).eq.'10') then
mint2d=3
nopes=6
nope=10
- elseif(lakon(nelems)(4:5).eq.'14') then
- mint2d=3
- nopes=7
- nope=14
elseif(lakon(nelems)(4:4).eq.'4') then
mint2d=1
nopes=3
@@ -250,7 +238,7 @@
! actual position of the nodes belonging to the
! slave surface
!
- if((nope.eq.26).or.(nope.eq.20).or.(nope.eq.8)) then
+ if((nope.eq.20).or.(nope.eq.8)) then
do m=1,nopes
nodefs(m)=kon(ipkon(nelems)+ifaceq(m,jfaces))
do j=1,3
@@ -258,7 +246,7 @@
& *reltime+vold(j,nodefs(m))
enddo
enddo
- elseif((nope.eq.10).or.(nope.eq.4).or.(nope.eq.14)) then
+ elseif((nope.eq.10).or.(nope.eq.4)) then
do m=1,nopes
nodefs(m)=kon(ipkon(nelems)+ifacet(m,jfaces))
do j=1,3
@@ -441,18 +429,12 @@ c write(*,*) '**regular solution'
if(lakon(nelemm)(4:5).eq.'20') then
nopem=8
nface=6
- elseif(lakon(nelemm)(4:4).eq.'2') then
- nopem=9
- nface=6
elseif(lakon(nelemm)(4:4).eq.'8') then
nopem=4
nface=6
elseif(lakon(nelemm)(4:5).eq.'10') then
nopem=6
nface=4
- elseif(lakon(nelemm)(4:5).eq.'14') then
- nopem=7
- nface=4
elseif(lakon(nelemm)(4:4).eq.'4') then
nopem=3
nface=4
@@ -569,6 +551,20 @@ c write(*,*) '**regular solution'
! distance from surface along normal (= clearance)
!
clear=al(1)*xn(1)+al(2)*xn(2)+al(3)*xn(3)
+!
+ if(nmethod.eq.4) then
+!
+! dynamic calculation
+!
+ if((clear.gt.0.d0).and.
+ & (int(elcon(3,1,imat)).ne.4)) then
+ isol=0
+ endif
+ else
+!
+! static calculation: more sophisticated
+! algorithm to detect contact
+!
if((istep.eq.1).and.(iit.le.0.d0)) then
if(clear.lt.0.d0) then
springarea(2,iloc)=clear/(1.d0-theta)
@@ -577,34 +573,6 @@ c write(*,*) '**regular solution'
endif
endif
clear=clear-springarea(2,iloc)*(1.d0-reltime)
-c!
-c! at the start of a new increment: look at the internal
-c! variables to determine the contact springs
-c!
-c if((isol.ne.0).and.(int(elcon(3,1,imat)).ne.4)) then
-c if(((istep.gt.1).and.(iinc.eq.1)).and.(iit.le.0)
-c & .and.(ncmat_.ge.7).and.(elcon(6,1,imat).gt.0.d0))
-c & then
-c!
-c! internal variables only exist for friction
-c!
-c! if no initial values -> no contact element
-c!
-c if(dsqrt(xstateini(4,1,ne0+iloc)**2+
-c & xstateini(5,1,ne0+iloc)**2+
-c & xstateini(6,1,ne0+iloc)**2)
-c & .lt.1.d-30) isol=0
-cc .and.(clear.gt.0.d0)
-c else
-c!
-c! no contact element for positive gap unless tied contact
-c!
-c if(clear.gt.0.d0) then
-c isol=0
-c endif
-c endif
-c endif
-c
!
! if iloop=1 AND a new increment was started the
! number of contact elements at the end of the
@@ -634,10 +602,13 @@ c
endif
!
if(isol.ne.0) then
- if(icutb.eq.0) then
+ if((icutb.eq.0).or.(ncmat_.lt.7).or.
+ & (elcon(6,1,imat).le.0.)) then
!
! this is no cut-back: only use a negative
! clearance as contact criterion
+! (this also applies if no friction is
+! defined)
!
if(clear.gt.0.d0) then
isol=0
@@ -679,6 +650,8 @@ c
& .lt.1.d-30) isol=0
endif
endif
+!
+ endif
!
endif
!
@@ -790,7 +763,7 @@ c
!
enddo
enddo
- if((iact.ne.0).or.(iprev.eq.0)) exit
+ if((iact.ne.0).or.(iprev.eq.0).or.(nmethod.eq.4)) exit
write(*,*)'*INFO in gencontelem_f2f: contact lost at the'
write(*,*)' start of a new increment; contact'
write(*,*)' elements from end of previous increment'
diff --git a/ccx_2.9/src/gencontelem_n2f.f b/ccx_2.10/src/gencontelem_n2f.f
similarity index 93%
rename from ccx_2.9/src/gencontelem_n2f.f
rename to ccx_2.10/src/gencontelem_n2f.f
index 5e09e0d..49a8e13 100644
--- a/ccx_2.9/src/gencontelem_n2f.f
+++ b/ccx_2.10/src/gencontelem_n2f.f
@@ -37,7 +37,7 @@
& itietri(2,ntie),ipkon(*),kon(*),koncont(4,*),ne,node,
& neigh(1),iflag,kneigh,i,j,k,l,isol,iset,idummy,
& itri,ll,kflag,n,nx(*),ny(*),istep,iinc,mi(*),
- & nz(*),nstart,ielmat(mi(3),*),imat,ifaceq(9,6),ifacet(7,4),
+ & nz(*),nstart,ielmat(mi(3),*),imat,ifaceq(8,6),ifacet(6,4),
& ifacew1(4,5),ifacew2(8,5),nelem,jface,indexe,iit,
& nface,nope,nodef(9),ncmat_,ntmat_,index1,indexel,
& nmethod,iteller,ifaces,jfaces,irelslavface,number(4),lenset,
@@ -57,19 +57,19 @@
!
! nodes per face for hex elements
!
- data ifaceq /4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/
+ data ifaceq /4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/
!
! nodes per face for tet elements
!
- data ifacet /1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/
+ data ifacet /1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/
!
! nodes per face for linear wedge elements
!
@@ -193,22 +193,10 @@ c if((istep.eq.1).and.(iinc.eq.1).and.(iit.le.0)) then
mint2d=9
nopes=8
nope=20
- elseif(lakon(nelems)(4:6).eq.'26R') then
- mint2d=4
- nopes=9
- nope=26
- elseif(lakon(nelems)(4:4).eq.'2') then
- mint2d=9
- nopes=9
- nope=26
elseif(lakon(nelems)(4:5).eq.'10') then
mint2d=3
nopes=6
nope=10
- elseif(lakon(nelems)(4:5).eq.'14') then
- mint2d=3
- nopes=7
- nope=14
elseif(lakon(nelems)(4:4).eq.'4') then
mint2d=1
nopes=3
@@ -242,14 +230,14 @@ c if((istep.eq.1).and.(iinc.eq.1).and.(iit.le.0)) then
konl(j)=kon(ipkon(nelems)+j)
enddo
!
- if((nope.eq.26).or.(nope.eq.20).or.(nope.eq.8)) then
+ if((nope.eq.20).or.(nope.eq.8)) then
do m=1,nopes
do j=1,3
xl2(j,m)=co(j,konl(ifaceq(m,jfaces)))+
& vold(j,konl(ifaceq(m,jfaces)))
enddo
enddo
- elseif((nope.eq.10).or.(nope.eq.4).or.(nope.eq.14)) then
+ elseif((nope.eq.10).or.(nope.eq.4)) then
do m=1,nopes
do j=1,3
xl2(j,m)=co(j,konl(ifacet(m,jfaces)))+
@@ -283,7 +271,6 @@ c if((istep.eq.1).and.(iinc.eq.1).and.(iit.le.0)) then
weight=weight2d1(m)
elseif((lakon(nelems)(4:4).eq.'8').or.
& (lakon(nelems)(4:6).eq.'20R').or.
- & (lakon(nelems)(4:6).eq.'26R').or.
& ((lakon(nelems)(4:5).eq.'15').and.
& (nopes.eq.8))) then
xi=gauss2d2(1,m)
@@ -294,7 +281,6 @@ c if((istep.eq.1).and.(iinc.eq.1).and.(iit.le.0)) then
et=gauss2d3(2,m)
weight=weight2d3(m)
elseif((lakon(nelems)(4:5).eq.'10').or.
- & (lakon(nelems)(4:5).eq.'14').or.
& ((lakon(nelems)(4:5).eq.'15').and.
& (nopes.eq.6))) then
xi=gauss2d5(1,m)
@@ -446,10 +432,6 @@ c write(*,*) '**regular solution'
! no element is generated
!
if(isol.ne.0) then
-c clear=straight(13,itri)*p(1)+
-c & straight(14,itri)*p(2)+
-c & straight(15,itri)*p(3)+
-c & straight(16,itri)
!
! determining the clearance
!
@@ -463,18 +445,12 @@ c & straight(16,itri)
if(lakon(nelem)(4:5).eq.'20') then
nopes=8
nface=6
- elseif(lakon(nelem)(4:4).eq.'2') then
- nopes=9
- nface=6
elseif(lakon(nelem)(4:4).eq.'8') then
nopes=4
nface=6
elseif(lakon(nelem)(4:5).eq.'10') then
nopes=6
nface=4
- elseif(lakon(nelem)(4:5).eq.'14') then
- nopes=7
- nface=4
elseif(lakon(nelem)(4:4).eq.'4') then
nopes=3
nface=4
diff --git a/ccx_2.9/src/generatecycmpcs.f b/ccx_2.10/src/generatecycmpcs.f
similarity index 100%
rename from ccx_2.9/src/generatecycmpcs.f
rename to ccx_2.10/src/generatecycmpcs.f
diff --git a/ccx_2.9/src/generateeminterfaces.f b/ccx_2.10/src/generateeminterfaces.f
similarity index 87%
rename from ccx_2.9/src/generateeminterfaces.f
rename to ccx_2.10/src/generateeminterfaces.f
index d113adf..76b1a9c 100644
--- a/ccx_2.9/src/generateeminterfaces.f
+++ b/ccx_2.10/src/generateeminterfaces.f
@@ -33,7 +33,7 @@
!
integer istartset(*),iendset(*),ialset(*),iactive(3),
& ipkon(*),kon(*),iset,ntotal,nope,nopes,indexe,nodef(9),
- & ifaceq(9,6),ifacet(7,4),ifacew1(4,5),ifacew2(8,5),m,
+ & ifaceq(8,6),ifacet(6,4),ifacew1(4,5),ifacew2(8,5),m,
& node,idof,jdof(3),idummy,nlength,kflag,ikmpc(*),nmpc,id,
& iface,nelem,jface,i,j,k,nafaces
!
@@ -41,19 +41,19 @@
!
! nodes per face for hex elements
!
- data ifaceq /4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/
+ data ifaceq /4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/
!
! nodes per face for tet elements
!
- data ifacet /1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/
+ data ifacet /1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/
!
! nodes per face for linear wedge elements
!
@@ -115,18 +115,9 @@
elseif(lakon(nelem)(4:5).eq.'20') then
nopes=8
nope=20
- elseif(lakon(nelem)(4:6).eq.'26R') then
- nopes=9
- nope=26
- elseif(lakon(nelem)(4:4).eq.'2') then
- nopes=9
- nope=26
elseif(lakon(nelem)(4:5).eq.'10') then
nopes=6
nope=10
- elseif(lakon(nelem)(4:5).eq.'14') then
- nopes=7
- nope=14
elseif(lakon(nelem)(4:4).eq.'4') then
nopes=3
nope=4
@@ -152,11 +143,11 @@
! nodes belonging to the face
!
indexe=ipkon(nelem)
- if((nope.eq.26).or.(nope.eq.20).or.(nope.eq.8)) then
+ if((nope.eq.20).or.(nope.eq.8)) then
do k=1,nopes
nodef(k)=kon(indexe+ifaceq(k,jface))
enddo
- elseif((nope.eq.10).or.(nope.eq.4).or.(nope.eq.14)) then
+ elseif((nope.eq.10).or.(nope.eq.4)) then
do k=1,nopes
nodef(k)=kon(indexe+ifacet(k,jface))
enddo
diff --git a/ccx_2.9/src/generatetet.f b/ccx_2.10/src/generatetet.f
similarity index 100%
rename from ccx_2.9/src/generatetet.f
rename to ccx_2.10/src/generatetet.f
diff --git a/ccx_2.9/src/genmassfloweqs.f b/ccx_2.10/src/genmassfloweqs.f
similarity index 92%
rename from ccx_2.9/src/genmassfloweqs.f
rename to ccx_2.10/src/genmassfloweqs.f
index b217618..2ffa6da 100644
--- a/ccx_2.9/src/genmassfloweqs.f
+++ b/ccx_2.10/src/genmassfloweqs.f
@@ -31,22 +31,22 @@
integer ipompc(*),nodempc(3,*),nmpc,nmpc_,mpcfree,
& i,j,number,indexe,iel1,nodes(4),
& mpcfreeold,ikmpc(*),ilmpc(*),id,idof,nf(5),kflag,j1,
- & k,iface,ifaceq(9,6),ifacet(7,4),ifacew(8,5),
+ & k,iface,ifaceq(8,6),ifacet(6,4),ifacew(8,5),
& ipkon(*),nload,nelemload(2,*),kon(*)
!
real*8 coefmpc(*),co(3,*),xl2(3,8),
& xn(3),xsj2(3),dxsj2,shp2(7,4),xs2(3,7),xi,et
!
- data ifaceq /4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/
- data ifacet /1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/
+ data ifaceq /4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/
+ data ifacet /1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/
data ifacew /1,3,2,9,8,7,0,0,
& 4,5,6,10,11,12,0,0,
& 1,2,5,4,7,14,10,13,
diff --git a/ccx_2.9/src/genmodes.f b/ccx_2.10/src/genmodes.f
similarity index 100%
rename from ccx_2.9/src/genmodes.f
rename to ccx_2.10/src/genmodes.f
diff --git a/ccx_2.9/src/gennactdofinv.f b/ccx_2.10/src/gennactdofinv.f
similarity index 95%
rename from ccx_2.9/src/gennactdofinv.f
rename to ccx_2.10/src/gennactdofinv.f
index 13b4d99..0e3a65e 100644
--- a/ccx_2.9/src/gennactdofinv.f
+++ b/ccx_2.10/src/gennactdofinv.f
@@ -87,9 +87,6 @@
elseif(lakonl(4:5).eq.'20') then
indexe2d=indexe+20
jmax=3
- elseif(lakonl(4:5).eq.'26') then
- indexe2d=indexe+26
- jmax=3
endif
!
! 2-noded beam element
@@ -132,9 +129,6 @@ c elseif(lakonl(4:5).eq.'8R') then
elseif(lakonl(4:5).eq.'20') then
indexe2d=indexe+20
jmax=8
- elseif(lakonl(4:5).eq.'26') then
- indexe2d=indexe+26
- jmax=8
endif
do j=1,jmax
node2d=kon(indexe2d+j)
diff --git a/ccx_2.9/src/gentiedmpc.f b/ccx_2.10/src/gentiedmpc.f
similarity index 98%
rename from ccx_2.9/src/gentiedmpc.f
rename to ccx_2.10/src/gentiedmpc.f
index 361a8b0..c583e4d 100644
--- a/ccx_2.9/src/gentiedmpc.f
+++ b/ccx_2.10/src/gentiedmpc.f
@@ -35,7 +35,7 @@
integer ntie,nset,istartset(*),iendset(*),ialset(*),
& itietri(2,ntie),ipkon(*),kon(*),koncont(4,*),node,
& neigh(1),iflag,kneigh,i,j,k,l,isol,itri,ll,kflag,n,nx(*),
- & ny(*),nz(*),nstart,ifaceq(9,6),ifacet(7,4),nboun,
+ & ny(*),nz(*),nstart,ifaceq(8,6),ifacet(6,4),nboun,
& ifacew1(4,5),ifacew2(8,5),nelem,jface,indexe,imastop(3,*),
& nnodelem,nface,nope,nodef(8),idof,kstart,kend,jstart,id,
& jend,ifield(*),istartfield(*),iendfield(*),ifaceslave(*),
@@ -49,19 +49,19 @@
!
! nodes per face for hex elements
!
- data ifaceq /4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/
+ data ifaceq /4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/
!
! nodes per face for tet elements
!
- data ifacet /1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/
+ data ifacet /1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/
!
! nodes per face for linear wedge elements
!
diff --git a/ccx_2.9/src/geomview.f b/ccx_2.10/src/geomview.f
similarity index 98%
rename from ccx_2.9/src/geomview.f
rename to ccx_2.10/src/geomview.f
index 54b8ad7..a64000a 100644
--- a/ccx_2.9/src/geomview.f
+++ b/ccx_2.10/src/geomview.f
@@ -30,7 +30,7 @@
!
! change following line if nlabel is increased
!
- character*87 label(46)
+ character*87 label(47)
!
integer i,j,l,mi(*),kontri(4,*),i1,mcs,inocs(*),i2,i3,
& ntrit,jj,is,m,nkt,icntrl,imag,nk,nlabel
@@ -46,7 +46,7 @@
! change following line if nlabel is increased and the dimension
! of field label above!
!
- nlabel=46
+ nlabel=47
!
! updating the displacements for cyclic symmetric structures
!
diff --git a/ccx_2.9/src/getSystemCPUs.c b/ccx_2.10/src/getSystemCPUs.c
similarity index 100%
rename from ccx_2.9/src/getSystemCPUs.c
rename to ccx_2.10/src/getSystemCPUs.c
diff --git a/ccx_2.9/src/getdesiinfo.f b/ccx_2.10/src/getdesiinfo.f
similarity index 65%
rename from ccx_2.9/src/getdesiinfo.f
rename to ccx_2.10/src/getdesiinfo.f
index befc590..42aef15 100644
--- a/ccx_2.9/src/getdesiinfo.f
+++ b/ccx_2.10/src/getdesiinfo.f
@@ -16,7 +16,7 @@
! along with this program; if not, write to the Free Software
! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
!
- subroutine getdesiinfo(set,istartset,iendset,ialset,nset,istep,
+ subroutine getdesiinfo(set,istartset,iendset,ialset,nset,
& mi,nactdof,ndesi,ndirdesi,nodedesi,ntie,tieset)
!
! reading the input deck: *DESIGNVARIABLES
@@ -27,12 +27,12 @@
character*81 set(*)
character*81 tieset(3,*)
!
- integer mi(*),istartset(*),iendset(*),ialset(*),indexe,ndesi,
- & node,nodedesi(*),ndirdesi(*),nset,ntie,istep,key,i,j,k,l,
+ integer mi(*),istartset(*),iendset(*),ialset(*),ndesi,
+ & node,nodedesi(*),ndirdesi(*),nset,ntie,i,j,k,l,
& ipos,nactdof(0:mi(2),*)
!
nodeset='
- & '
+ & '
ipos=0
ndesi=0
!
@@ -40,18 +40,18 @@
!
do i=1,ntie
if(tieset(1,i)(81:81).eq.'D') then
- setname=tieset(2,i)
- ipos=index(setname,' ')
- setname(ipos:ipos)='N'
- endif
+ setname=tieset(2,i)
+ ipos=index(setname,' ')
+ setname(ipos:ipos)='N'
+ endif
enddo
!
! Check for the existence of the name
!
if(setname.eq.' ') then
- write(*,*) '*ERROR in getdesiinfo: name of node set '
- write(*,*) ' has not yet been defined. '
- call exit(201)
+ write(*,*) '*ERROR in getdesiinfo: name of node set '
+ write(*,*) ' has not yet been defined. '
+ call exit(201)
endif
!
! Search the name of the node set in "set(i)" and
@@ -59,17 +59,17 @@
!
do j=1,nset
if(setname.eq.set(j)) then
- do k=istartset(j),iendset(j)
- node=ialset(k)
- do l=1,3
- if(nactdof(l,node).ne.0) then
- ndesi=ndesi+1
- nodedesi(ndesi)=node
- ndirdesi(ndesi)=l
- endif
+ do k=istartset(j),iendset(j)
+ node=ialset(k)
+ do l=1,3
+ if(nactdof(l,node).ne.0) then
+ ndesi=ndesi+1
+ nodedesi(ndesi)=node
+ ndirdesi(ndesi)=l
+ endif
enddo
- enddo
- endif
+ enddo
+ endif
enddo
!
return
diff --git a/ccx_2.9/src/getglobalresults.c b/ccx_2.10/src/getglobalresults.c
similarity index 97%
rename from ccx_2.9/src/getglobalresults.c
rename to ccx_2.10/src/getglobalresults.c
index aa143eb..8143197 100644
--- a/ccx_2.9/src/getglobalresults.c
+++ b/ccx_2.10/src/getglobalresults.c
@@ -409,6 +409,8 @@ void getglobalresults (char *jobnamec,ITG **integerglobp,double **doubleglobp,
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 */
@@ -450,6 +452,8 @@ void getglobalresults (char *jobnamec,ITG **integerglobp,double **doubleglobp,
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 */
@@ -493,6 +497,8 @@ void getglobalresults (char *jobnamec,ITG **integerglobp,double **doubleglobp,
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 */
@@ -532,6 +538,8 @@ void getglobalresults (char *jobnamec,ITG **integerglobp,double **doubleglobp,
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);
diff --git a/ccx_2.9/src/getnewline.f b/ccx_2.10/src/getnewline.f
similarity index 100%
rename from ccx_2.9/src/getnewline.f
rename to ccx_2.10/src/getnewline.f
diff --git a/ccx_2.9/src/getnodel.f b/ccx_2.10/src/getnodel.f
similarity index 79%
rename from ccx_2.9/src/getnodel.f
rename to ccx_2.10/src/getnodel.f
index 0173d31..b5c09a3 100644
--- a/ccx_2.9/src/getnodel.f
+++ b/ccx_2.10/src/getnodel.f
@@ -27,20 +27,20 @@
implicit none
!
integer ii,jface,nope,
- & ifaceq(9,6),ifacet(7,4),ifacew1(4,5),ifacew2(8,5)
+ & ifaceq(8,6),ifacet(6,4),ifacew1(4,5),ifacew2(8,5)
!
include "gauss.f"
!
- data ifaceq /4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/
- data ifacet /1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/
+ data ifaceq /4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/
+ data ifacet /1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/
!
data ifacew1 /1,3,2,0,
& 4,5,6,0,
diff --git a/ccx_2.9/src/hcrit.f b/ccx_2.10/src/hcrit.f
similarity index 100%
rename from ccx_2.9/src/hcrit.f
rename to ccx_2.10/src/hcrit.f
diff --git a/ccx_2.9/src/headings.f b/ccx_2.10/src/headings.f
similarity index 100%
rename from ccx_2.9/src/headings.f
rename to ccx_2.10/src/headings.f
diff --git a/ccx_2.9/src/heattransfers.f b/ccx_2.10/src/heattransfers.f
similarity index 100%
rename from ccx_2.9/src/heattransfers.f
rename to ccx_2.10/src/heattransfers.f
diff --git a/ccx_2.9/src/hgforce.f b/ccx_2.10/src/hgforce.f
similarity index 100%
rename from ccx_2.9/src/hgforce.f
rename to ccx_2.10/src/hgforce.f
diff --git a/ccx_2.9/src/hgstiffness.f b/ccx_2.10/src/hgstiffness.f
similarity index 100%
rename from ccx_2.9/src/hgstiffness.f
rename to ccx_2.10/src/hgstiffness.f
diff --git a/ccx_2.9/src/hns.f b/ccx_2.10/src/hns.f
similarity index 100%
rename from ccx_2.9/src/hns.f
rename to ccx_2.10/src/hns.f
diff --git a/ccx_2.9/src/hybsvd.f b/ccx_2.10/src/hybsvd.f
similarity index 100%
rename from ccx_2.9/src/hybsvd.f
rename to ccx_2.10/src/hybsvd.f
diff --git a/ccx_2.9/src/hyperelastics.f b/ccx_2.10/src/hyperelastics.f
similarity index 100%
rename from ccx_2.9/src/hyperelastics.f
rename to ccx_2.10/src/hyperelastics.f
diff --git a/ccx_2.9/src/hyperfoams.f b/ccx_2.10/src/hyperfoams.f
similarity index 100%
rename from ccx_2.9/src/hyperfoams.f
rename to ccx_2.10/src/hyperfoams.f
diff --git a/ccx_2.9/src/ident.f b/ccx_2.10/src/ident.f
similarity index 100%
rename from ccx_2.9/src/ident.f
rename to ccx_2.10/src/ident.f
diff --git a/ccx_2.9/src/ident2.f b/ccx_2.10/src/ident2.f
similarity index 100%
rename from ccx_2.9/src/ident2.f
rename to ccx_2.10/src/ident2.f
diff --git a/ccx_2.9/src/identamta.f b/ccx_2.10/src/identamta.f
similarity index 100%
rename from ccx_2.9/src/identamta.f
rename to ccx_2.10/src/identamta.f
diff --git a/ccx_2.9/src/identifytiedface.f b/ccx_2.10/src/identifytiedface.f
similarity index 100%
rename from ccx_2.9/src/identifytiedface.f
rename to ccx_2.10/src/identifytiedface.f
diff --git a/ccx_2.9/src/identifytransform.f b/ccx_2.10/src/identifytransform.f
similarity index 100%
rename from ccx_2.9/src/identifytransform.f
rename to ccx_2.10/src/identifytransform.f
diff --git a/ccx_2.9/src/includefilename.f b/ccx_2.10/src/includefilename.f
similarity index 100%
rename from ccx_2.9/src/includefilename.f
rename to ccx_2.10/src/includefilename.f
diff --git a/ccx_2.9/src/incplas.f b/ccx_2.10/src/incplas.f
similarity index 100%
rename from ccx_2.9/src/incplas.f
rename to ccx_2.10/src/incplas.f
diff --git a/ccx_2.9/src/incplas_lin.f b/ccx_2.10/src/incplas_lin.f
similarity index 100%
rename from ccx_2.9/src/incplas_lin.f
rename to ccx_2.10/src/incplas_lin.f
diff --git a/ccx_2.9/src/inequcons.f b/ccx_2.10/src/inequcons.f
similarity index 100%
rename from ccx_2.9/src/inequcons.f
rename to ccx_2.10/src/inequcons.f
diff --git a/ccx_2.9/src/inicalcbody.f b/ccx_2.10/src/inicalcbody.f
similarity index 100%
rename from ccx_2.9/src/inicalcbody.f
rename to ccx_2.10/src/inicalcbody.f
diff --git a/ccx_2.9/src/inicont.c b/ccx_2.10/src/inicont.c
similarity index 100%
rename from ccx_2.9/src/inicont.c
rename to ccx_2.10/src/inicont.c
diff --git a/ccx_2.9/src/init.f b/ccx_2.10/src/init.f
similarity index 100%
rename from ccx_2.9/src/init.f
rename to ccx_2.10/src/init.f
diff --git a/ccx_2.9/src/initialcfd.f b/ccx_2.10/src/initialcfd.f
similarity index 100%
rename from ccx_2.9/src/initialcfd.f
rename to ccx_2.10/src/initialcfd.f
diff --git a/ccx_2.9/src/initialchannel.f b/ccx_2.10/src/initialchannel.f
similarity index 100%
rename from ccx_2.9/src/initialchannel.f
rename to ccx_2.10/src/initialchannel.f
diff --git a/ccx_2.9/src/initialconditionss.f b/ccx_2.10/src/initialconditionss.f
similarity index 96%
rename from ccx_2.9/src/initialconditionss.f
rename to ccx_2.10/src/initialconditionss.f
index 1be6efc..fcd7766 100644
--- a/ccx_2.9/src/initialconditionss.f
+++ b/ccx_2.10/src/initialconditionss.f
@@ -19,7 +19,8 @@
subroutine initialconditionss(inpc,textpart,set,istartset,iendset,
& ialset,nset,t0,t1,prestr,iprestr,ithermal,veold,inoelfree,nk_,
& mi,istep,istat,n,iline,ipol,inl,ipoinp,inp,lakon,kon,co,ne,
- & ipkon,vold,ipoinpc,xstate,nstate_,nk,t0g,t1g,iaxial)
+ & ipkon,vold,ipoinpc,xstate,nstate_,nk,t0g,t1g,iaxial,ielprop,
+ & prop)
!
! reading the input deck: *INITIAL CONDITIONS
!
@@ -38,16 +39,18 @@
& iline,ipol,inl,ipoinp(2,*),inp(3,*),ij,jj,ntens,ncrds,layer,
& kspt,lrebar,iflag,i1,mint3d,nope,kon(*),konl(20),indexe,
& ipkon(*),ne,ipoinpc(0:*),nstate_,nk,jmax,ntot,numberoflines,
- & iaxial
+ & iaxial,null,ielprop(*)
!
real*8 t0(*),t1(*),beta(8),prestr(6,mi(1),*),veold(0:mi(2),*),
& temperature,velocity,tempgrad1,tempgrad2,pgauss(3),
& shp(4,20),xsj,xl(3,20),xi,et,ze,weight,co(3,*),pressure,
& vold(0:mi(2),*),xstate(nstate_,mi(1),*),dispvelo,totpres,
- & xmassflow,t0g(2,*),t1g(2,*)
+ & xmassflow,t0g(2,*),t1g(2,*),prop(*)
!
include "gauss.f"
!
+ null=0
+!
if(istep.gt.0) then
write(*,*)
& '*ERROR reading *INITIAL CONDITIONS: *INITIAL CONDITIONS'
@@ -186,6 +189,15 @@
!
if(lakon(i)(4:5).eq.'8R') then
mint3d=1
+ elseif(lakon(i)(4:7).eq.'20RB') then
+ if((lakon(i)(8:8).eq.'R').or.
+ & (lakon(i)(8:8).eq.'C')) then
+ mint3d=50
+ else
+ call beamintscheme(lakon(i),mint3d,
+ & ielprop(i),prop,
+ & null,xi,et,ze,weight)
+ endif
elseif((lakon(i)(4:4).eq.'8').or.
& (lakon(i)(4:6).eq.'20R')) then
mint3d=8
@@ -214,6 +226,18 @@
et=gauss3d1(2,j)
ze=gauss3d1(3,j)
weight=weight3d1(j)
+ elseif(lakon(i)(4:7).eq.'20RB') then
+ if((lakon(i)(8:8).eq.'R').or.
+ & (lakon(i)(8:8).eq.'C')) then
+ xi=gauss3d13(1,j)
+ et=gauss3d13(2,j)
+ ze=gauss3d13(3,j)
+ weight=weight3d13(j)
+ else
+ call beamintscheme(lakon(i),mint3d,
+ & ielprop(i),prop,
+ & j,xi,et,ze,weight)
+ endif
elseif((lakon(i)(4:4).eq.'8').or.
& (lakon(i)(4:6).eq.'20R'))
& then
diff --git a/ccx_2.9/src/initialnet.f b/ccx_2.10/src/initialnet.f
similarity index 100%
rename from ccx_2.9/src/initialnet.f
rename to ccx_2.10/src/initialnet.f
diff --git a/ccx_2.9/src/inputerror.f b/ccx_2.10/src/inputerror.f
similarity index 100%
rename from ccx_2.9/src/inputerror.f
rename to ccx_2.10/src/inputerror.f
diff --git a/ccx_2.9/src/inputinfo.f b/ccx_2.10/src/inputinfo.f
similarity index 100%
rename from ccx_2.9/src/inputinfo.f
rename to ccx_2.10/src/inputinfo.f
diff --git a/ccx_2.9/src/inputwarning.f b/ccx_2.10/src/inputwarning.f
similarity index 100%
rename from ccx_2.9/src/inputwarning.f
rename to ccx_2.10/src/inputwarning.f
diff --git a/ccx_2.9/src/insert.c b/ccx_2.10/src/insert.c
similarity index 89%
rename from ccx_2.9/src/insert.c
rename to ccx_2.10/src/insert.c
index ed4c447..e9d0385 100644
--- a/ccx_2.9/src/insert.c
+++ b/ccx_2.10/src/insert.c
@@ -39,7 +39,7 @@ void insert(ITG *ipointer, ITG **mast1p, ITG **nextp, ITG *i1,
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;
+ ITG idof1,idof2,istart,*mast1=NULL,*next=NULL;
mast1=*mast1p;
next=*nextp;
@@ -54,7 +54,17 @@ void insert(ITG *ipointer, ITG **mast1p, ITG **nextp, ITG *i1,
idof2=*i2-1;
}
- if(ipointer[idof2]==0){
+// index=ipointer[idof2];
+ 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;
+
+/* if(ipointer[idof2]==0){
if(*ifree>=*nzs_){
*nzs_=(ITG)(1.1**nzs_);
RENEW(mast1,ITG,*nzs_);
@@ -83,7 +93,7 @@ void insert(ITG *ipointer, ITG **mast1p, ITG **nextp, ITG *i1,
istart=next[istart]-1;
}
}
- }
+ }*/
*mast1p=mast1;
*nextp=next;
diff --git a/ccx_2.9/src/insertfreq.c b/ccx_2.10/src/insertfreq.c
similarity index 73%
rename from ccx_2.9/src/insertfreq.c
rename to ccx_2.10/src/insertfreq.c
index 77ee308..458513f 100644
--- a/ccx_2.9/src/insertfreq.c
+++ b/ccx_2.10/src/insertfreq.c
@@ -21,69 +21,76 @@
#include <string.h>
#include "CalculiX.h"
-void insertfreq(ITG *ipointer, ITG **irowp, ITG **nextp, ITG *i1,
+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 irow containing
+ - 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 irow containing
+ 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 irow containing the momentarily last
+ 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,*irow=NULL,*next=NULL;
+ ITG idof1,idof2,istart,*mast1=NULL,*next=NULL;
- irow=*irowp;
+ mast1=*mast1p;
next=*nextp;
idof1=*i1;
- idof2=*i2;
-// printf("insertfreq ,idof1=%d,idof2=%d\n",idof1,idof2);
+ idof2=*i2-1;
- if(ipointer[idof2-1]==0){
+// index=ipointer[idof2];
+ 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;
+
+/* if(ipointer[idof2-1]==0){
++*ifree;
if(*ifree>*nzs_){
*nzs_=(ITG)(1.1**nzs_);
- RENEW(irow,ITG,*nzs_);
+ RENEW(mast1,ITG,*nzs_);
RENEW(next,ITG,*nzs_);
}
ipointer[idof2-1]=*ifree;
- irow[*ifree-1]=idof1;
+ mast1[*ifree-1]=idof1;
next[*ifree-1]=0;
-// if(idof2==721) printf("insertfreq idof1=%d,idof2=%d,ifree=%d\n",idof1,idof2,*ifree);
}
else{
istart=ipointer[idof2-1];
while(1){
- if(irow[istart-1]==idof1) break;
+ if(mast1[istart-1]==idof1) break;
if(next[istart-1]==0){
++*ifree;
if(*ifree>*nzs_){
*nzs_=(ITG)(1.1**nzs_);
- RENEW(irow,ITG,*nzs_);
+ RENEW(mast1,ITG,*nzs_);
RENEW(next,ITG,*nzs_);
}
next[istart-1]=*ifree;
- irow[*ifree-1]=idof1;
+ mast1[*ifree-1]=idof1;
next[*ifree-1]=0;
-// if(idof2==721) printf("insertfreq idof1=%d,idof2=%d,ifree=%d\n",idof1,idof2,*ifree);
break;
}
else{
istart=next[istart-1];
}
}
- }
+ }*/
- *irowp=irow;
+ *mast1p=mast1;
*nextp=next;
return;
diff --git a/ccx_2.9/src/insertrad.c b/ccx_2.10/src/insertrad.c
similarity index 100%
rename from ccx_2.9/src/insertrad.c
rename to ccx_2.10/src/insertrad.c
diff --git a/ccx_2.9/src/interpol_alfa2.f b/ccx_2.10/src/interpol_alfa2.f
similarity index 100%
rename from ccx_2.9/src/interpol_alfa2.f
rename to ccx_2.10/src/interpol_alfa2.f
diff --git a/ccx_2.9/src/interpolateinface.f b/ccx_2.10/src/interpolateinface.f
similarity index 93%
rename from ccx_2.9/src/interpolateinface.f
rename to ccx_2.10/src/interpolateinface.f
index b651c8e..f4dc157 100644
--- a/ccx_2.9/src/interpolateinface.f
+++ b/ccx_2.10/src/interpolateinface.f
@@ -35,8 +35,8 @@
& koncont(3,2*numpts+1),itri,kflag,neigh(1),kneigh,
& imastop(3,2*numpts+1),indexcj,nopespringj,list(numpts),
& igauss,mi(*),nstate_,itriangle(100),itriold,
- & ifaceq(9,6),ip(numpts),ne0,iloc,itrinew,ntriangle,
- & ifacet(7,4),ifacew1(4,5),ifacew2(8,5),n,islavsurf(2,*),
+ & ifaceq(8,6),ip(numpts),ne0,iloc,itrinew,ntriangle,
+ & ifacet(6,4),ifacew1(4,5),ifacew2(8,5),n,islavsurf(2,*),
& ibin(numpts),ivert1,ntriangle_,nterms,m,islavsurfold(2,*),
& nx(2*numpts+1),ny(2*numpts+1),isol,id
!
@@ -48,19 +48,19 @@
!
! nodes per face for hex elements
!
- data ifaceq /4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/
+ data ifaceq /4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/
!
! nodes per face for tet elements
!
- data ifacet /1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/
+ data ifacet /1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/
!
! nodes per face for linear wedge elements
!
diff --git a/ccx_2.9/src/interpolatestate.f b/ccx_2.10/src/interpolatestate.f
similarity index 100%
rename from ccx_2.9/src/interpolatestate.f
rename to ccx_2.10/src/interpolatestate.f
diff --git a/ccx_2.9/src/interpolsubmodel.f b/ccx_2.10/src/interpolsubmodel.f
similarity index 100%
rename from ccx_2.9/src/interpolsubmodel.f
rename to ccx_2.10/src/interpolsubmodel.f
diff --git a/ccx_2.9/src/intersectionpoint.f b/ccx_2.10/src/intersectionpoint.f
similarity index 100%
rename from ccx_2.9/src/intersectionpoint.f
rename to ccx_2.10/src/intersectionpoint.f
diff --git a/ccx_2.9/src/islavactive.f b/ccx_2.10/src/islavactive.f
similarity index 91%
rename from ccx_2.9/src/islavactive.f
rename to ccx_2.10/src/islavactive.f
index da8f475..72ed611 100644
--- a/ccx_2.9/src/islavactive.f
+++ b/ccx_2.10/src/islavactive.f
@@ -32,27 +32,27 @@
& isol,itri,ll,kflag,n,nx(*),ny(*),mi(*),nz(*),nstart,
& ifacew1(4,5),iloc,ifacew2(8,5),imastop(3,*),
& itriangle(100),ntriangle,ntriangle_,itriold,itrinew,id,
- & nslavnode(*),islavnode(*),islavact(*),ifaceq(9,6),
- & ifacet(7,4)
+ & nslavnode(*),islavnode(*),islavact(*),ifaceq(8,6),
+ & ifacet(6,4)
!
real*8 cg(3,*),straight(16,*),co(3,*),vold(0:mi(2),*),p(3),
& dist,xo(*),yo(*),zo(*),x(*),y(*),z(*)
!
! nodes per face for hex elements
!
- data ifaceq /4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/
+ data ifaceq /4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/
!
! nodes per face for tet elements
!
- data ifacet /1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/
+ data ifacet /1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/
!
! nodes per face for linear wedge elements
!
diff --git a/ccx_2.9/src/isorti.f b/ccx_2.10/src/isorti.f
similarity index 100%
rename from ccx_2.9/src/isorti.f
rename to ccx_2.10/src/isorti.f
diff --git a/ccx_2.9/src/isortid.f b/ccx_2.10/src/isortid.f
similarity index 100%
rename from ccx_2.9/src/isortid.f
rename to ccx_2.10/src/isortid.f
diff --git a/ccx_2.9/src/isortiddc.f b/ccx_2.10/src/isortiddc.f
similarity index 100%
rename from ccx_2.9/src/isortiddc.f
rename to ccx_2.10/src/isortiddc.f
diff --git a/ccx_2.9/src/isortii.f b/ccx_2.10/src/isortii.f
similarity index 100%
rename from ccx_2.9/src/isortii.f
rename to ccx_2.10/src/isortii.f
diff --git a/ccx_2.9/src/isortiid.f b/ccx_2.10/src/isortiid.f
similarity index 100%
rename from ccx_2.9/src/isortiid.f
rename to ccx_2.10/src/isortiid.f
diff --git a/ccx_2.9/src/isortiiddc.f b/ccx_2.10/src/isortiiddc.f
similarity index 100%
rename from ccx_2.9/src/isortiiddc.f
rename to ccx_2.10/src/isortiiddc.f
diff --git a/ccx_2.9/src/jouleheating.f b/ccx_2.10/src/jouleheating.f
similarity index 100%
rename from ccx_2.9/src/jouleheating.f
rename to ccx_2.10/src/jouleheating.f
diff --git a/ccx_2.9/src/keystart.f b/ccx_2.10/src/keystart.f
similarity index 100%
rename from ccx_2.9/src/keystart.f
rename to ccx_2.10/src/keystart.f
diff --git a/ccx_2.9/src/knotmpc.f b/ccx_2.10/src/knotmpc.f
similarity index 100%
rename from ccx_2.9/src/knotmpc.f
rename to ccx_2.10/src/knotmpc.f
diff --git a/ccx_2.9/src/lab_straight_ppkrit.f b/ccx_2.10/src/lab_straight_ppkrit.f
similarity index 100%
rename from ccx_2.9/src/lab_straight_ppkrit.f
rename to ccx_2.10/src/lab_straight_ppkrit.f
diff --git a/ccx_2.9/src/labyrinth.f b/ccx_2.10/src/labyrinth.f
similarity index 100%
rename from ccx_2.9/src/labyrinth.f
rename to ccx_2.10/src/labyrinth.f
diff --git a/ccx_2.10/src/lbfgsb.f b/ccx_2.10/src/lbfgsb.f
new file mode 100644
index 0000000..9c9e7d9
--- /dev/null
+++ b/ccx_2.10/src/lbfgsb.f
@@ -0,0 +1,3949 @@
+c
+c L-BFGS-B is released under the “New BSD License” (aka “Modified BSD License”
+c or “3-clause license”)
+c Please read attached file License.txt
+c
+c=========== L-BFGS-B (version 3.0. April 25, 2011 ===================
+c
+c This is a modified version of L-BFGS-B. Minor changes in the updated
+c code appear preceded by a line comment as follows
+c
+c c-jlm-jn
+c
+c Major changes are described in the accompanying paper:
+c
+c Jorge Nocedal and Jose Luis Morales, Remark on "Algorithm 778:
+c L-BFGS-B: Fortran Subroutines for Large-Scale Bound Constrained
+c Optimization" (2011). To appear in ACM Transactions on
+c Mathematical Software,
+c
+c The paper describes an improvement and a correction to Algorithm 778.
+c It is shown that the performance of the algorithm can be improved
+c significantly by making a relatively simple modication to the subspace
+c minimization phase. The correction concerns an error caused by the use
+c of routine dpmeps to estimate machine precision.
+c
+c The total work space **wa** required by the new version is
+c
+c 2*m*n + 11m*m + 5*n + 8*m
+c
+c the old version required
+c
+c 2*m*n + 12m*m + 4*n + 12*m
+c
+c
+c J. Nocedal Department of Electrical Engineering and
+c Computer Science.
+c Northwestern University. Evanston, IL. USA
+c
+c
+c J.L Morales Departamento de Matematicas,
+c Instituto Tecnologico Autonomo de Mexico
+c Mexico D.F. Mexico.
+c
+c March 2011
+c
+c=============================================================================
+ subroutine setulb(n, m, x, l, u, nbd, f, g, factr, pgtol, wa, iwa,
+ + task, iprint, csave, lsave, isave, dsave)
+
+ character*60 task, csave
+ logical lsave(4)
+ integer n, m, iprint,
+ + nbd(n), iwa(3*n), isave(44)
+ double precision f, factr, pgtol, x(n), l(n), u(n), g(n),
+c
+c-jlm-jn
+ + wa(2*m*n + 5*n + 11*m*m + 8*m), dsave(29)
+
+c ************
+c
+c Subroutine setulb
+c
+c This subroutine partitions the working arrays wa and iwa, and
+c then uses the limited memory BFGS method to solve the bound
+c constrained optimization problem by calling mainlb.
+c (The direct method will be used in the subspace minimization.)
+c
+c n is an integer variable.
+c On entry n is the dimension of the problem.
+c On exit n is unchanged.
+c
+c m is an integer variable.
+c On entry m is the maximum number of variable metric corrections
+c used to define the limited memory matrix.
+c On exit m is unchanged.
+c
+c x is a double precision array of dimension n.
+c On entry x is an approximation to the solution.
+c On exit x is the current approximation.
+c
+c l is a double precision array of dimension n.
+c On entry l is the lower bound on x.
+c On exit l is unchanged.
+c
+c u is a double precision array of dimension n.
+c On entry u is the upper bound on x.
+c On exit u is unchanged.
+c
+c nbd is an integer array of dimension n.
+c On entry nbd represents the type of bounds imposed on the
+c variables, and must be specified as follows:
+c nbd(i)=0 if x(i) is unbounded,
+c 1 if x(i) has only a lower bound,
+c 2 if x(i) has both lower and upper bounds, and
+c 3 if x(i) has only an upper bound.
+c On exit nbd is unchanged.
+c
+c f is a double precision variable.
+c On first entry f is unspecified.
+c On final exit f is the value of the function at x.
+c
+c g is a double precision array of dimension n.
+c On first entry g is unspecified.
+c On final exit g is the value of the gradient at x.
+c
+c factr is a double precision variable.
+c On entry factr >= 0 is specified by the user. The iteration
+c will stop when
+c
+c (f^k - f^{k+1})/max{|f^k|,|f^{k+1}|,1} <= factr*epsmch
+c
+c where epsmch is the machine precision, which is automatically
+c generated by the code. Typical values for factr: 1.d+12 for
+c low accuracy; 1.d+7 for moderate accuracy; 1.d+1 for extremely
+c high accuracy.
+c On exit factr is unchanged.
+c
+c pgtol is a double precision variable.
+c On entry pgtol >= 0 is specified by the user. The iteration
+c will stop when
+c
+c max{|proj g_i | i = 1, ..., n} <= pgtol
+c
+c where pg_i is the ith component of the projected gradient.
+c On exit pgtol is unchanged.
+c
+c wa is a double precision working array of length
+c (2mmax + 5)nmax + 12mmax^2 + 12mmax.
+c
+c iwa is an integer working array of length 3nmax.
+c
+c task is a working string of characters of length 60 indicating
+c the current job when entering and quitting this subroutine.
+c
+c iprint is an integer variable that must be set by the user.
+c It controls the frequency and type of output generated:
+c iprint<0 no output is generated;
+c iprint=0 print only one line at the last iteration;
+c 0<iprint<99 print also f and |proj g| every iprint iterations;
+c iprint=99 print details of every iteration except n-vectors;
+c iprint=100 print also the changes of active set and final x;
+c iprint>100 print details of every iteration including x and g;
+c When iprint > 0, the file iterate.dat will be created to
+c summarize the iteration.
+c
+c csave is a working string of characters of length 60.
+c
+c lsave is a logical working array of dimension 4.
+c On exit with 'task' = NEW_X, the following information is
+c available:
+c If lsave(1) = .true. then the initial X has been replaced by
+c its projection in the feasible set;
+c If lsave(2) = .true. then the problem is constrained;
+c If lsave(3) = .true. then each variable has upper and lower
+c bounds;
+c
+c isave is an integer working array of dimension 44.
+c On exit with 'task' = NEW_X, the following information is
+c available:
+c isave(22) = the total number of intervals explored in the
+c search of Cauchy points;
+c isave(26) = the total number of skipped BFGS updates before
+c the current iteration;
+c isave(30) = the number of current iteration;
+c isave(31) = the total number of BFGS updates prior the current
+c iteration;
+c isave(33) = the number of intervals explored in the search of
+c Cauchy point in the current iteration;
+c isave(34) = the total number of function and gradient
+c evaluations;
+c isave(36) = the number of function value or gradient
+c evaluations in the current iteration;
+c if isave(37) = 0 then the subspace argmin is within the box;
+c if isave(37) = 1 then the subspace argmin is beyond the box;
+c isave(38) = the number of free variables in the current
+c iteration;
+c isave(39) = the number of active constraints in the current
+c iteration;
+c n + 1 - isave(40) = the number of variables leaving the set of
+c active constraints in the current iteration;
+c isave(41) = the number of variables entering the set of active
+c constraints in the current iteration.
+c
+c dsave is a double precision working array of dimension 29.
+c On exit with 'task' = NEW_X, the following information is
+c available:
+c dsave(1) = current 'theta' in the BFGS matrix;
+c dsave(2) = f(x) in the previous iteration;
+c dsave(3) = factr*epsmch;
+c dsave(4) = 2-norm of the line search direction vector;
+c dsave(5) = the machine precision epsmch generated by the code;
+c dsave(7) = the accumulated time spent on searching for
+c Cauchy points;
+c dsave(8) = the accumulated time spent on
+c subspace minimization;
+c dsave(9) = the accumulated time spent on line search;
+c dsave(11) = the slope of the line search function at
+c the current point of line search;
+c dsave(12) = the maximum relative step length imposed in
+c line search;
+c dsave(13) = the infinity norm of the projected gradient;
+c dsave(14) = the relative step length in the line search;
+c dsave(15) = the slope of the line search function at
+c the starting point of the line search;
+c dsave(16) = the square of the 2-norm of the line search
+c direction vector.
+c
+c Subprograms called:
+c
+c L-BFGS-B Library ... mainlb.
+c
+c
+c References:
+c
+c [1] R. H. Byrd, P. Lu, J. Nocedal and C. Zhu, ``A limited
+c memory algorithm for bound constrained optimization'',
+c SIAM J. Scientific Computing 16 (1995), no. 5, pp. 1190--1208.
+c
+c [2] C. Zhu, R.H. Byrd, P. Lu, J. Nocedal, ``L-BFGS-B: a
+c limited memory FORTRAN code for solving bound constrained
+c optimization problems'', Tech. Report, NAM-11, EECS Department,
+c Northwestern University, 1994.
+c
+c (Postscript files of these papers are available via anonymous
+c ftp to eecs.nwu.edu in the directory pub/lbfgs/lbfgs_bcm.)
+c
+c * * *
+c
+c NEOS, November 1994. (Latest revision June 1996.)
+c Optimization Technology Center.
+c Argonne National Laboratory and Northwestern University.
+c Written by
+c Ciyou Zhu
+c in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.
+c
+c
+c ************
+c-jlm-jn
+ integer lws,lr,lz,lt,ld,lxp,lwa,
+ + lwy,lsy,lss,lwt,lwn,lsnd
+
+ if (task .eq. 'START') then
+ isave(1) = m*n
+ isave(2) = m**2
+ isave(3) = 4*m**2
+ isave(4) = 1 ! ws m*n
+ isave(5) = isave(4) + isave(1) ! wy m*n
+ isave(6) = isave(5) + isave(1) ! wsy m**2
+ isave(7) = isave(6) + isave(2) ! wss m**2
+ isave(8) = isave(7) + isave(2) ! wt m**2
+ isave(9) = isave(8) + isave(2) ! wn 4*m**2
+ isave(10) = isave(9) + isave(3) ! wsnd 4*m**2
+ isave(11) = isave(10) + isave(3) ! wz n
+ isave(12) = isave(11) + n ! wr n
+ isave(13) = isave(12) + n ! wd n
+ isave(14) = isave(13) + n ! wt n
+ isave(15) = isave(14) + n ! wxp n
+ isave(16) = isave(15) + n ! wa 8*m
+ endif
+ lws = isave(4)
+ lwy = isave(5)
+ lsy = isave(6)
+ lss = isave(7)
+ lwt = isave(8)
+ lwn = isave(9)
+ lsnd = isave(10)
+ lz = isave(11)
+ lr = isave(12)
+ ld = isave(13)
+ lt = isave(14)
+ lxp = isave(15)
+ lwa = isave(16)
+
+ call mainlb(n,m,x,l,u,nbd,f,g,factr,pgtol,
+ + wa(lws),wa(lwy),wa(lsy),wa(lss), wa(lwt),
+ + wa(lwn),wa(lsnd),wa(lz),wa(lr),wa(ld),wa(lt),wa(lxp),
+ + wa(lwa),
+ + iwa(1),iwa(n+1),iwa(2*n+1),task,iprint,
+ + csave,lsave,isave(22),dsave)
+
+ return
+
+ end
+
+c======================= The end of setulb =============================
+
+ subroutine mainlb(n, m, x, l, u, nbd, f, g, factr, pgtol, ws, wy,
+ + sy, ss, wt, wn, snd, z, r, d, t, xp, wa,
+ + index, iwhere, indx2, task,
+ + iprint, csave, lsave, isave, dsave)
+ implicit none
+ character*60 task, csave
+ logical lsave(4)
+ integer n, m, iprint, nbd(n), index(n),
+ + iwhere(n), indx2(n), isave(23)
+ double precision f, factr, pgtol,
+ + x(n), l(n), u(n), g(n), z(n), r(n), d(n), t(n),
+c-jlm-jn
+ + xp(n),
+ + wa(8*m),
+ + ws(n, m), wy(n, m), sy(m, m), ss(m, m),
+ + wt(m, m), wn(2*m, 2*m), snd(2*m, 2*m), dsave(29)
+
+c ************
+c
+c Subroutine mainlb
+c
+c This subroutine solves bound constrained optimization problems by
+c using the compact formula of the limited memory BFGS updates.
+c
+c n is an integer variable.
+c On entry n is the number of variables.
+c On exit n is unchanged.
+c
+c m is an integer variable.
+c On entry m is the maximum number of variable metric
+c corrections allowed in the limited memory matrix.
+c On exit m is unchanged.
+c
+c x is a double precision array of dimension n.
+c On entry x is an approximation to the solution.
+c On exit x is the current approximation.
+c
+c l is a double precision array of dimension n.
+c On entry l is the lower bound of x.
+c On exit l is unchanged.
+c
+c u is a double precision array of dimension n.
+c On entry u is the upper bound of x.
+c On exit u is unchanged.
+c
+c nbd is an integer array of dimension n.
+c On entry nbd represents the type of bounds imposed on the
+c variables, and must be specified as follows:
+c nbd(i)=0 if x(i) is unbounded,
+c 1 if x(i) has only a lower bound,
+c 2 if x(i) has both lower and upper bounds,
+c 3 if x(i) has only an upper bound.
+c On exit nbd is unchanged.
+c
+c f is a double precision variable.
+c On first entry f is unspecified.
+c On final exit f is the value of the function at x.
+c
+c g is a double precision array of dimension n.
+c On first entry g is unspecified.
+c On final exit g is the value of the gradient at x.
+c
+c factr is a double precision variable.
+c On entry factr >= 0 is specified by the user. The iteration
+c will stop when
+c
+c (f^k - f^{k+1})/max{|f^k|,|f^{k+1}|,1} <= factr*epsmch
+c
+c where epsmch is the machine precision, which is automatically
+c generated by the code.
+c On exit factr is unchanged.
+c
+c pgtol is a double precision variable.
+c On entry pgtol >= 0 is specified by the user. The iteration
+c will stop when
+c
+c max{|proj g_i | i = 1, ..., n} <= pgtol
+c
+c where pg_i is the ith component of the projected gradient.
+c On exit pgtol is unchanged.
+c
+c ws, wy, sy, and wt are double precision working arrays used to
+c store the following information defining the limited memory
+c BFGS matrix:
+c ws, of dimension n x m, stores S, the matrix of s-vectors;
+c wy, of dimension n x m, stores Y, the matrix of y-vectors;
+c sy, of dimension m x m, stores S'Y;
+c ss, of dimension m x m, stores S'S;
+c yy, of dimension m x m, stores Y'Y;
+c wt, of dimension m x m, stores the Cholesky factorization
+c of (theta*S'S+LD^(-1)L'); see eq.
+c (2.26) in [3].
+c
+c wn is a double precision working array of dimension 2m x 2m
+c used to store the LEL^T factorization of the indefinite matrix
+c K = [-D -Y'ZZ'Y/theta L_a'-R_z' ]
+c [L_a -R_z theta*S'AA'S ]
+c
+c where E = [-I 0]
+c [ 0 I]
+c
+c snd is a double precision working array of dimension 2m x 2m
+c used to store the lower triangular part of
+c N = [Y' ZZ'Y L_a'+R_z']
+c [L_a +R_z S'AA'S ]
+c
+c z(n),r(n),d(n),t(n), xp(n),wa(8*m) are double precision working arrays.
+c z is used at different times to store the Cauchy point and
+c the Newton point.
+c xp is used to safeguard the projected Newton direction
+c
+c sg(m),sgo(m),yg(m),ygo(m) are double precision working arrays.
+c
+c index is an integer working array of dimension n.
+c In subroutine freev, index is used to store the free and fixed
+c variables at the Generalized Cauchy Point (GCP).
+c
+c iwhere is an integer working array of dimension n used to record
+c the status of the vector x for GCP computation.
+c iwhere(i)=0 or -3 if x(i) is free and has bounds,
+c 1 if x(i) is fixed at l(i), and l(i) .ne. u(i)
+c 2 if x(i) is fixed at u(i), and u(i) .ne. l(i)
+c 3 if x(i) is always fixed, i.e., u(i)=x(i)=l(i)
+c -1 if x(i) is always free, i.e., no bounds on it.
+c
+c indx2 is an integer working array of dimension n.
+c Within subroutine cauchy, indx2 corresponds to the array iorder.
+c In subroutine freev, a list of variables entering and leaving
+c the free set is stored in indx2, and it is passed on to
+c subroutine formk with this information.
+c
+c task is a working string of characters of length 60 indicating
+c the current job when entering and leaving this subroutine.
+c
+c iprint is an INTEGER variable that must be set by the user.
+c It controls the frequency and type of output generated:
+c iprint<0 no output is generated;
+c iprint=0 print only one line at the last iteration;
+c 0<iprint<99 print also f and |proj g| every iprint iterations;
+c iprint=99 print details of every iteration except n-vectors;
+c iprint=100 print also the changes of active set and final x;
+c iprint>100 print details of every iteration including x and g;
+c When iprint > 0, the file iterate.dat will be created to
+c summarize the iteration.
+c
+c csave is a working string of characters of length 60.
+c
+c lsave is a logical working array of dimension 4.
+c
+c isave is an integer working array of dimension 23.
+c
+c dsave is a double precision working array of dimension 29.
+c
+c
+c Subprograms called
+c
+c L-BFGS-B Library ... cauchy, subsm, lnsrlb, formk,
+c
+c errclb, prn1lb, prn2lb, prn3lb, active, projgr,
+c
+c freev, cmprlb, matupd, formt.
+c
+c Minpack2 Library ... timer
+c
+c Linpack Library ... dcopy, ddot.
+c
+c
+c References:
+c
+c [1] R. H. Byrd, P. Lu, J. Nocedal and C. Zhu, ``A limited
+c memory algorithm for bound constrained optimization'',
+c SIAM J. Scientific Computing 16 (1995), no. 5, pp. 1190--1208.
+c
+c [2] C. Zhu, R.H. Byrd, P. Lu, J. Nocedal, ``L-BFGS-B: FORTRAN
+c Subroutines for Large Scale Bound Constrained Optimization''
+c Tech. Report, NAM-11, EECS Department, Northwestern University,
+c 1994.
+c
+c [3] R. Byrd, J. Nocedal and R. Schnabel "Representations of
+c Quasi-Newton Matrices and their use in Limited Memory Methods'',
+c Mathematical Programming 63 (1994), no. 4, pp. 129-156.
+c
+c (Postscript files of these papers are available via anonymous
+c ftp to eecs.nwu.edu in the directory pub/lbfgs/lbfgs_bcm.)
+c
+c * * *
+c
+c NEOS, November 1994. (Latest revision June 1996.)
+c Optimization Technology Center.
+c Argonne National Laboratory and Northwestern University.
+c Written by
+c Ciyou Zhu
+c in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.
+c
+c
+c ************
+
+ logical prjctd,cnstnd,boxed,updatd,wrk
+ character*3 word
+ integer i,k,nintol,itfile,iback,nskip,
+ + head,col,iter,itail,iupdat,
+ + nseg,nfgv,info,ifun,
+ + iword,nfree,nact,ileave,nenter
+ double precision theta,fold,ddot,dr,rr,tol,
+ + xstep,sbgnrm,ddum,dnorm,dtd,epsmch,
+ + cpu1,cpu2,cachyt,sbtime,lnscht,time1,time2,
+ + gd,gdold,stp,stpmx,time
+ double precision one,zero
+ parameter (one=1.0d0,zero=0.0d0)
+
+ if (task .eq. 'START') then
+
+ epsmch = epsilon(one)
+
+ call timer(time1)
+
+c Initialize counters and scalars when task='START'.
+
+c for the limited memory BFGS matrices:
+ col = 0
+ head = 1
+ theta = one
+ iupdat = 0
+ updatd = .false.
+ iback = 0
+ itail = 0
+ iword = 0
+ nact = 0
+ ileave = 0
+ nenter = 0
+ fold = zero
+ dnorm = zero
+ cpu1 = zero
+ gd = zero
+ stpmx = zero
+ sbgnrm = zero
+ stp = zero
+ gdold = zero
+ dtd = zero
+
+c for operation counts:
+ iter = 0
+ nfgv = 0
+ nseg = 0
+ nintol = 0
+ nskip = 0
+ nfree = n
+ ifun = 0
+c for stopping tolerance:
+ tol = factr*epsmch
+
+c for measuring running time:
+ cachyt = 0
+ sbtime = 0
+ lnscht = 0
+
+c 'word' records the status of subspace solutions.
+ word = '---'
+
+c 'info' records the termination information.
+ info = 0
+
+ itfile = 8
+ if (iprint .ge. 1) then
+c open a summary file 'iterate.dat'
+ open (8, file = 'iterate.dat', status = 'unknown')
+ endif
+
+c Check the input arguments for errors.
+
+ call errclb(n,m,factr,l,u,nbd,task,info,k)
+ if (task(1:5) .eq. 'ERROR') then
+ call prn3lb(n,x,f,task,iprint,info,itfile,
+ + iter,nfgv,nintol,nskip,nact,sbgnrm,
+ + zero,nseg,word,iback,stp,xstep,k,
+ + cachyt,sbtime,lnscht)
+ return
+ endif
+
+ call prn1lb(n,m,l,u,x,iprint,itfile,epsmch)
+
+c Initialize iwhere & project x onto the feasible set.
+
+ call active(n,l,u,nbd,x,iwhere,iprint,prjctd,cnstnd,boxed)
+
+c The end of the initialization.
+
+ else
+c restore local variables.
+
+ prjctd = lsave(1)
+ cnstnd = lsave(2)
+ boxed = lsave(3)
+ updatd = lsave(4)
+
+ nintol = isave(1)
+ itfile = isave(3)
+ iback = isave(4)
+ nskip = isave(5)
+ head = isave(6)
+ col = isave(7)
+ itail = isave(8)
+ iter = isave(9)
+ iupdat = isave(10)
+ nseg = isave(12)
+ nfgv = isave(13)
+ info = isave(14)
+ ifun = isave(15)
+ iword = isave(16)
+ nfree = isave(17)
+ nact = isave(18)
+ ileave = isave(19)
+ nenter = isave(20)
+
+ theta = dsave(1)
+ fold = dsave(2)
+ tol = dsave(3)
+ dnorm = dsave(4)
+ epsmch = dsave(5)
+ cpu1 = dsave(6)
+ cachyt = dsave(7)
+ sbtime = dsave(8)
+ lnscht = dsave(9)
+ time1 = dsave(10)
+ gd = dsave(11)
+ stpmx = dsave(12)
+ sbgnrm = dsave(13)
+ stp = dsave(14)
+ gdold = dsave(15)
+ dtd = dsave(16)
+
+c After returning from the driver go to the point where execution
+c is to resume.
+
+ if (task(1:5) .eq. 'FG_LN') goto 666
+ if (task(1:5) .eq. 'NEW_X') goto 777
+ if (task(1:5) .eq. 'FG_ST') goto 111
+ if (task(1:4) .eq. 'STOP') then
+ if (task(7:9) .eq. 'CPU') then
+c restore the previous iterate.
+ call dcopy(n,t,1,x,1)
+ call dcopy(n,r,1,g,1)
+ f = fold
+ endif
+ goto 999
+ endif
+ endif
+
+c Compute f0 and g0.
+
+ task = 'FG_START'
+c return to the driver to calculate f and g; reenter at 111.
+ goto 1000
+ 111 continue
+ nfgv = 1
+
+c Compute the infinity norm of the (-) projected gradient.
+
+ call projgr(n,l,u,nbd,x,g,sbgnrm)
+
+ if (iprint .ge. 1) then
+ write (6,1002) iter,f,sbgnrm
+ write (itfile,1003) iter,nfgv,sbgnrm,f
+ endif
+ if (sbgnrm .le. pgtol) then
+c terminate the algorithm.
+ task = 'CONVERGENCE: NORM_OF_PROJECTED_GRADIENT_<=_PGTOL'
+ goto 999
+ endif
+
+c ----------------- the beginning of the loop --------------------------
+
+ 222 continue
+ if (iprint .ge. 99) write (6,1001) iter + 1
+ iword = -1
+c
+ if (.not. cnstnd .and. col .gt. 0) then
+c skip the search for GCP.
+ call dcopy(n,x,1,z,1)
+ wrk = updatd
+ nseg = 0
+ goto 333
+ endif
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+c Compute the Generalized Cauchy Point (GCP).
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+ call timer(cpu1)
+ call cauchy(n,x,l,u,nbd,g,indx2,iwhere,t,d,z,
+ + m,wy,ws,sy,wt,theta,col,head,
+ + wa(1),wa(2*m+1),wa(4*m+1),wa(6*m+1),nseg,
+ + iprint, sbgnrm, info, epsmch)
+ if (info .ne. 0) then
+c singular triangular system detected; refresh the lbfgs memory.
+ if(iprint .ge. 1) write (6, 1005)
+ info = 0
+ col = 0
+ head = 1
+ theta = one
+ iupdat = 0
+ updatd = .false.
+ call timer(cpu2)
+ cachyt = cachyt + cpu2 - cpu1
+ goto 222
+ endif
+ call timer(cpu2)
+ cachyt = cachyt + cpu2 - cpu1
+ nintol = nintol + nseg
+
+c Count the entering and leaving variables for iter > 0;
+c find the index set of free and active variables at the GCP.
+
+ call freev(n,nfree,index,nenter,ileave,indx2,
+ + iwhere,wrk,updatd,cnstnd,iprint,iter)
+ nact = n - nfree
+
+ 333 continue
+
+c If there are no free variables or B=theta*I, then
+c skip the subspace minimization.
+
+ if (nfree .eq. 0 .or. col .eq. 0) goto 555
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+c Subspace minimization.
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+ call timer(cpu1)
+
+c Form the LEL^T factorization of the indefinite
+c matrix K = [-D -Y'ZZ'Y/theta L_a'-R_z' ]
+c [L_a -R_z theta*S'AA'S ]
+c where E = [-I 0]
+c [ 0 I]
+
+ if (wrk) call formk(n,nfree,index,nenter,ileave,indx2,iupdat,
+ + updatd,wn,snd,m,ws,wy,sy,theta,col,head,info)
+ if (info .ne. 0) then
+c nonpositive definiteness in Cholesky factorization;
+c refresh the lbfgs memory and restart the iteration.
+ if(iprint .ge. 1) write (6, 1006)
+ info = 0
+ col = 0
+ head = 1
+ theta = one
+ iupdat = 0
+ updatd = .false.
+ call timer(cpu2)
+ sbtime = sbtime + cpu2 - cpu1
+ goto 222
+ endif
+
+c compute r=-Z'B(xcp-xk)-Z'g (using wa(2m+1)=W'(xcp-x)
+c from 'cauchy').
+ call cmprlb(n,m,x,g,ws,wy,sy,wt,z,r,wa,index,
+ + theta,col,head,nfree,cnstnd,info)
+ if (info .ne. 0) goto 444
+
+c-jlm-jn call the direct method.
+
+ call subsm( n, m, nfree, index, l, u, nbd, z, r, xp, ws, wy,
+ + theta, x, g, col, head, iword, wa, wn, iprint, info)
+ 444 continue
+ if (info .ne. 0) then
+c singular triangular system detected;
+c refresh the lbfgs memory and restart the iteration.
+ if(iprint .ge. 1) write (6, 1005)
+ info = 0
+ col = 0
+ head = 1
+ theta = one
+ iupdat = 0
+ updatd = .false.
+ call timer(cpu2)
+ sbtime = sbtime + cpu2 - cpu1
+ goto 222
+ endif
+
+ call timer(cpu2)
+ sbtime = sbtime + cpu2 - cpu1
+ 555 continue
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+c Line search and optimality tests.
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+c Generate the search direction d:=z-x.
+
+ do 40 i = 1, n
+ d(i) = z(i) - x(i)
+ 40 continue
+ call timer(cpu1)
+ 666 continue
+ call lnsrlb(n,l,u,nbd,x,f,fold,gd,gdold,g,d,r,t,z,stp,dnorm,
+ + dtd,xstep,stpmx,iter,ifun,iback,nfgv,info,task,
+ + boxed,cnstnd,csave,isave(22),dsave(17))
+ if (info .ne. 0 .or. iback .ge. 20) then
+c restore the previous iterate.
+ call dcopy(n,t,1,x,1)
+ call dcopy(n,r,1,g,1)
+ f = fold
+ if (col .eq. 0) then
+c abnormal termination.
+ if (info .eq. 0) then
+ info = -9
+c restore the actual number of f and g evaluations etc.
+ nfgv = nfgv - 1
+ ifun = ifun - 1
+ iback = iback - 1
+ endif
+ task = 'ABNORMAL_TERMINATION_IN_LNSRCH'
+ iter = iter + 1
+ goto 999
+ else
+c refresh the lbfgs memory and restart the iteration.
+ if(iprint .ge. 1) write (6, 1008)
+ if (info .eq. 0) nfgv = nfgv - 1
+ info = 0
+ col = 0
+ head = 1
+ theta = one
+ iupdat = 0
+ updatd = .false.
+ task = 'RESTART_FROM_LNSRCH'
+ call timer(cpu2)
+ lnscht = lnscht + cpu2 - cpu1
+ goto 222
+ endif
+ else if (task(1:5) .eq. 'FG_LN') then
+c return to the driver for calculating f and g; reenter at 666.
+ goto 1000
+ else
+c calculate and print out the quantities related to the new X.
+ call timer(cpu2)
+ lnscht = lnscht + cpu2 - cpu1
+ iter = iter + 1
+
+c Compute the infinity norm of the projected (-)gradient.
+
+ call projgr(n,l,u,nbd,x,g,sbgnrm)
+
+c Print iteration information.
+
+ call prn2lb(n,x,f,g,iprint,itfile,iter,nfgv,nact,
+ + sbgnrm,nseg,word,iword,iback,stp,xstep)
+ goto 1000
+ endif
+ 777 continue
+
+c Test for termination.
+
+ if (sbgnrm .le. pgtol) then
+c terminate the algorithm.
+ task = 'CONVERGENCE: NORM_OF_PROJECTED_GRADIENT_<=_PGTOL'
+ goto 999
+ endif
+
+ ddum = max(abs(fold), abs(f), one)
+ if ((fold - f) .le. tol*ddum) then
+c terminate the algorithm.
+ task = 'CONVERGENCE: REL_REDUCTION_OF_F_<=_FACTR*EPSMCH'
+ if (iback .ge. 10) info = -5
+c i.e., to issue a warning if iback>10 in the line search.
+ goto 999
+ endif
+
+c Compute d=newx-oldx, r=newg-oldg, rr=y'y and dr=y's.
+
+ do 42 i = 1, n
+ r(i) = g(i) - r(i)
+ 42 continue
+ rr = ddot(n,r,1,r,1)
+ if (stp .eq. one) then
+ dr = gd - gdold
+ ddum = -gdold
+ else
+ dr = (gd - gdold)*stp
+ call dscal(n,stp,d,1)
+ ddum = -gdold*stp
+ endif
+
+ if (dr .le. epsmch*ddum) then
+c skip the L-BFGS update.
+ nskip = nskip + 1
+ updatd = .false.
+ if (iprint .ge. 1) write (6,1004) dr, ddum
+ goto 888
+ endif
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+c Update the L-BFGS matrix.
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+ updatd = .true.
+ iupdat = iupdat + 1
+
+c Update matrices WS and WY and form the middle matrix in B.
+
+ call matupd(n,m,ws,wy,sy,ss,d,r,itail,
+ + iupdat,col,head,theta,rr,dr,stp,dtd)
+
+c Form the upper half of the pds T = theta*SS + L*D^(-1)*L';
+c Store T in the upper triangular of the array wt;
+c Cholesky factorize T to J*J' with
+c J' stored in the upper triangular of wt.
+
+ call formt(m,wt,sy,ss,col,theta,info)
+
+ if (info .ne. 0) then
+c nonpositive definiteness in Cholesky factorization;
+c refresh the lbfgs memory and restart the iteration.
+ if(iprint .ge. 1) write (6, 1007)
+ info = 0
+ col = 0
+ head = 1
+ theta = one
+ iupdat = 0
+ updatd = .false.
+ goto 222
+ endif
+
+c Now the inverse of the middle matrix in B is
+
+c [ D^(1/2) O ] [ -D^(1/2) D^(-1/2)*L' ]
+c [ -L*D^(-1/2) J ] [ 0 J' ]
+
+ 888 continue
+
+c -------------------- the end of the loop -----------------------------
+
+ goto 222
+ 999 continue
+ call timer(time2)
+ time = time2 - time1
+ call prn3lb(n,x,f,task,iprint,info,itfile,
+ + iter,nfgv,nintol,nskip,nact,sbgnrm,
+ + time,nseg,word,iback,stp,xstep,k,
+ + cachyt,sbtime,lnscht)
+ 1000 continue
+
+c Save local variables.
+
+ lsave(1) = prjctd
+ lsave(2) = cnstnd
+ lsave(3) = boxed
+ lsave(4) = updatd
+
+ isave(1) = nintol
+ isave(3) = itfile
+ isave(4) = iback
+ isave(5) = nskip
+ isave(6) = head
+ isave(7) = col
+ isave(8) = itail
+ isave(9) = iter
+ isave(10) = iupdat
+ isave(12) = nseg
+ isave(13) = nfgv
+ isave(14) = info
+ isave(15) = ifun
+ isave(16) = iword
+ isave(17) = nfree
+ isave(18) = nact
+ isave(19) = ileave
+ isave(20) = nenter
+
+ dsave(1) = theta
+ dsave(2) = fold
+ dsave(3) = tol
+ dsave(4) = dnorm
+ dsave(5) = epsmch
+ dsave(6) = cpu1
+ dsave(7) = cachyt
+ dsave(8) = sbtime
+ dsave(9) = lnscht
+ dsave(10) = time1
+ dsave(11) = gd
+ dsave(12) = stpmx
+ dsave(13) = sbgnrm
+ dsave(14) = stp
+ dsave(15) = gdold
+ dsave(16) = dtd
+
+ 1001 format (//,'ITERATION ',i5)
+ 1002 format
+ + (/,'At iterate',i5,4x,'f= ',1p,d12.5,4x,'|proj g|= ',1p,d12.5)
+ 1003 format (2(1x,i4),5x,'-',5x,'-',3x,'-',5x,'-',5x,'-',8x,'-',3x,
+ + 1p,2(1x,d10.3))
+ 1004 format (' ys=',1p,e10.3,' -gs=',1p,e10.3,' BFGS update SKIPPED')
+ 1005 format (/,
+ +' Singular triangular system detected;',/,
+ +' refresh the lbfgs memory and restart the iteration.')
+ 1006 format (/,
+ +' Nonpositive definiteness in Cholesky factorization in formk;',/,
+ +' refresh the lbfgs memory and restart the iteration.')
+ 1007 format (/,
+ +' Nonpositive definiteness in Cholesky factorization in formt;',/,
+ +' refresh the lbfgs memory and restart the iteration.')
+ 1008 format (/,
+ +' Bad direction in the line search;',/,
+ +' refresh the lbfgs memory and restart the iteration.')
+
+ return
+
+ end
+
+c======================= The end of mainlb =============================
+
+ subroutine active(n, l, u, nbd, x, iwhere, iprint,
+ + prjctd, cnstnd, boxed)
+
+ logical prjctd, cnstnd, boxed
+ integer n, iprint, nbd(n), iwhere(n)
+ double precision x(n), l(n), u(n)
+
+c ************
+c
+c Subroutine active
+c
+c This subroutine initializes iwhere and projects the initial x to
+c the feasible set if necessary.
+c
+c iwhere is an integer array of dimension n.
+c On entry iwhere is unspecified.
+c On exit iwhere(i)=-1 if x(i) has no bounds
+c 3 if l(i)=u(i)
+c 0 otherwise.
+c In cauchy, iwhere is given finer gradations.
+c
+c
+c * * *
+c
+c NEOS, November 1994. (Latest revision June 1996.)
+c Optimization Technology Center.
+c Argonne National Laboratory and Northwestern University.
+c Written by
+c Ciyou Zhu
+c in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.
+c
+c
+c ************
+
+ integer nbdd,i
+ double precision zero
+ parameter (zero=0.0d0)
+
+c Initialize nbdd, prjctd, cnstnd and boxed.
+
+ nbdd = 0
+ prjctd = .false.
+ cnstnd = .false.
+ boxed = .true.
+
+c Project the initial x to the easible set if necessary.
+
+ do 10 i = 1, n
+ if (nbd(i) .gt. 0) then
+ if (nbd(i) .le. 2 .and. x(i) .le. l(i)) then
+ if (x(i) .lt. l(i)) then
+ prjctd = .true.
+ x(i) = l(i)
+ endif
+ nbdd = nbdd + 1
+ else if (nbd(i) .ge. 2 .and. x(i) .ge. u(i)) then
+ if (x(i) .gt. u(i)) then
+ prjctd = .true.
+ x(i) = u(i)
+ endif
+ nbdd = nbdd + 1
+ endif
+ endif
+ 10 continue
+
+c Initialize iwhere and assign values to cnstnd and boxed.
+
+ do 20 i = 1, n
+ if (nbd(i) .ne. 2) boxed = .false.
+ if (nbd(i) .eq. 0) then
+c this variable is always free
+ iwhere(i) = -1
+
+c otherwise set x(i)=mid(x(i), u(i), l(i)).
+ else
+ cnstnd = .true.
+ if (nbd(i) .eq. 2 .and. u(i) - l(i) .le. zero) then
+c this variable is always fixed
+ iwhere(i) = 3
+ else
+ iwhere(i) = 0
+ endif
+ endif
+ 20 continue
+
+ if (iprint .ge. 0) then
+ if (prjctd) write (6,*)
+ + 'The initial X is infeasible. Restart with its projection.'
+ if (.not. cnstnd)
+ + write (6,*) 'This problem is unconstrained.'
+ endif
+
+ if (iprint .gt. 0) write (6,1001) nbdd
+
+ 1001 format (/,'At X0 ',i9,' variables are exactly at the bounds')
+
+ return
+
+ end
+
+c======================= The end of active =============================
+
+ subroutine bmv(m, sy, wt, col, v, p, info)
+
+ integer m, col, info
+ double precision sy(m, m), wt(m, m), v(2*col), p(2*col)
+
+c ************
+c
+c Subroutine bmv
+c
+c This subroutine computes the product of the 2m x 2m middle matrix
+c in the compact L-BFGS formula of B and a 2m vector v;
+c it returns the product in p.
+c
+c m is an integer variable.
+c On entry m is the maximum number of variable metric corrections
+c used to define the limited memory matrix.
+c On exit m is unchanged.
+c
+c sy is a double precision array of dimension m x m.
+c On entry sy specifies the matrix S'Y.
+c On exit sy is unchanged.
+c
+c wt is a double precision array of dimension m x m.
+c On entry wt specifies the upper triangular matrix J' which is
+c the Cholesky factor of (thetaS'S+LD^(-1)L').
+c On exit wt is unchanged.
+c
+c col is an integer variable.
+c On entry col specifies the number of s-vectors (or y-vectors)
+c stored in the compact L-BFGS formula.
+c On exit col is unchanged.
+c
+c v is a double precision array of dimension 2col.
+c On entry v specifies vector v.
+c On exit v is unchanged.
+c
+c p is a double precision array of dimension 2col.
+c On entry p is unspecified.
+c On exit p is the product Mv.
+c
+c info is an integer variable.
+c On entry info is unspecified.
+c On exit info = 0 for normal return,
+c = nonzero for abnormal return when the system
+c to be solved by dtrsl is singular.
+c
+c Subprograms called:
+c
+c Linpack ... dtrsl.
+c
+c
+c * * *
+c
+c NEOS, November 1994. (Latest revision June 1996.)
+c Optimization Technology Center.
+c Argonne National Laboratory and Northwestern University.
+c Written by
+c Ciyou Zhu
+c in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.
+c
+c
+c ************
+
+ integer i,k,i2
+ double precision sum
+
+ if (col .eq. 0) return
+
+c PART I: solve [ D^(1/2) O ] [ p1 ] = [ v1 ]
+c [ -L*D^(-1/2) J ] [ p2 ] [ v2 ].
+
+c solve Jp2=v2+LD^(-1)v1.
+ p(col + 1) = v(col + 1)
+ do 20 i = 2, col
+ i2 = col + i
+ sum = 0.0d0
+ do 10 k = 1, i - 1
+ sum = sum + sy(i,k)*v(k)/sy(k,k)
+ 10 continue
+ p(i2) = v(i2) + sum
+ 20 continue
+c Solve the triangular system
+ call dtrsl(wt,m,col,p(col+1),11,info)
+ if (info .ne. 0) return
+
+c solve D^(1/2)p1=v1.
+ do 30 i = 1, col
+ p(i) = v(i)/sqrt(sy(i,i))
+ 30 continue
+
+c PART II: solve [ -D^(1/2) D^(-1/2)*L' ] [ p1 ] = [ p1 ]
+c [ 0 J' ] [ p2 ] [ p2 ].
+
+c solve J^Tp2=p2.
+ call dtrsl(wt,m,col,p(col+1),01,info)
+ if (info .ne. 0) return
+
+c compute p1=-D^(-1/2)(p1-D^(-1/2)L'p2)
+c =-D^(-1/2)p1+D^(-1)L'p2.
+ do 40 i = 1, col
+ p(i) = -p(i)/sqrt(sy(i,i))
+ 40 continue
+ do 60 i = 1, col
+ sum = 0.d0
+ do 50 k = i + 1, col
+ sum = sum + sy(k,i)*p(col+k)/sy(i,i)
+ 50 continue
+ p(i) = p(i) + sum
+ 60 continue
+
+ return
+
+ end
+
+c======================== The end of bmv ===============================
+
+ subroutine cauchy(n, x, l, u, nbd, g, iorder, iwhere, t, d, xcp,
+ + m, wy, ws, sy, wt, theta, col, head, p, c, wbp,
+ + v, nseg, iprint, sbgnrm, info, epsmch)
+ implicit none
+ integer n, m, head, col, nseg, iprint, info,
+ + nbd(n), iorder(n), iwhere(n)
+ double precision theta, epsmch,
+ + x(n), l(n), u(n), g(n), t(n), d(n), xcp(n),
+ + wy(n, col), ws(n, col), sy(m, m),
+ + wt(m, m), p(2*m), c(2*m), wbp(2*m), v(2*m)
+
+c ************
+c
+c Subroutine cauchy
+c
+c For given x, l, u, g (with sbgnrm > 0), and a limited memory
+c BFGS matrix B defined in terms of matrices WY, WS, WT, and
+c scalars head, col, and theta, this subroutine computes the
+c generalized Cauchy point (GCP), defined as the first local
+c minimizer of the quadratic
+c
+c Q(x + s) = g's + 1/2 s'Bs
+c
+c along the projected gradient direction P(x-tg,l,u).
+c The routine returns the GCP in xcp.
+c
+c n is an integer variable.
+c On entry n is the dimension of the problem.
+c On exit n is unchanged.
+c
+c x is a double precision array of dimension n.
+c On entry x is the starting point for the GCP computation.
+c On exit x is unchanged.
+c
+c l is a double precision array of dimension n.
+c On entry l is the lower bound of x.
+c On exit l is unchanged.
+c
+c u is a double precision array of dimension n.
+c On entry u is the upper bound of x.
+c On exit u is unchanged.
+c
+c nbd is an integer array of dimension n.
+c On entry nbd represents the type of bounds imposed on the
+c variables, and must be specified as follows:
+c nbd(i)=0 if x(i) is unbounded,
+c 1 if x(i) has only a lower bound,
+c 2 if x(i) has both lower and upper bounds, and
+c 3 if x(i) has only an upper bound.
+c On exit nbd is unchanged.
+c
+c g is a double precision array of dimension n.
+c On entry g is the gradient of f(x). g must be a nonzero vector.
+c On exit g is unchanged.
+c
+c iorder is an integer working array of dimension n.
+c iorder will be used to store the breakpoints in the piecewise
+c linear path and free variables encountered. On exit,
+c iorder(1),...,iorder(nleft) are indices of breakpoints
+c which have not been encountered;
+c iorder(nleft+1),...,iorder(nbreak) are indices of
+c encountered breakpoints; and
+c iorder(nfree),...,iorder(n) are indices of variables which
+c have no bound constraits along the search direction.
+c
+c iwhere is an integer array of dimension n.
+c On entry iwhere indicates only the permanently fixed (iwhere=3)
+c or free (iwhere= -1) components of x.
+c On exit iwhere records the status of the current x variables.
+c iwhere(i)=-3 if x(i) is free and has bounds, but is not moved
+c 0 if x(i) is free and has bounds, and is moved
+c 1 if x(i) is fixed at l(i), and l(i) .ne. u(i)
+c 2 if x(i) is fixed at u(i), and u(i) .ne. l(i)
+c 3 if x(i) is always fixed, i.e., u(i)=x(i)=l(i)
+c -1 if x(i) is always free, i.e., it has no bounds.
+c
+c t is a double precision working array of dimension n.
+c t will be used to store the break points.
+c
+c d is a double precision array of dimension n used to store
+c the Cauchy direction P(x-tg)-x.
+c
+c xcp is a double precision array of dimension n used to return the
+c GCP on exit.
+c
+c m is an integer variable.
+c On entry m is the maximum number of variable metric corrections
+c used to define the limited memory matrix.
+c On exit m is unchanged.
+c
+c ws, wy, sy, and wt are double precision arrays.
+c On entry they store information that defines the
+c limited memory BFGS matrix:
+c ws(n,m) stores S, a set of s-vectors;
+c wy(n,m) stores Y, a set of y-vectors;
+c sy(m,m) stores S'Y;
+c wt(m,m) stores the
+c Cholesky factorization of (theta*S'S+LD^(-1)L').
+c On exit these arrays are unchanged.
+c
+c theta is a double precision variable.
+c On entry theta is the scaling factor specifying B_0 = theta I.
+c On exit theta is unchanged.
+c
+c col is an integer variable.
+c On entry col is the actual number of variable metric
+c corrections stored so far.
+c On exit col is unchanged.
+c
+c head is an integer variable.
+c On entry head is the location of the first s-vector (or y-vector)
+c in S (or Y).
+c On exit col is unchanged.
+c
+c p is a double precision working array of dimension 2m.
+c p will be used to store the vector p = W^(T)d.
+c
+c c is a double precision working array of dimension 2m.
+c c will be used to store the vector c = W^(T)(xcp-x).
+c
+c wbp is a double precision working array of dimension 2m.
+c wbp will be used to store the row of W corresponding
+c to a breakpoint.
+c
+c v is a double precision working array of dimension 2m.
+c
+c nseg is an integer variable.
+c On exit nseg records the number of quadratic segments explored
+c in searching for the GCP.
+c
+c sg and yg are double precision arrays of dimension m.
+c On entry sg and yg store S'g and Y'g correspondingly.
+c On exit they are unchanged.
+c
+c iprint is an INTEGER variable that must be set by the user.
+c It controls the frequency and type of output generated:
+c iprint<0 no output is generated;
+c iprint=0 print only one line at the last iteration;
+c 0<iprint<99 print also f and |proj g| every iprint iterations;
+c iprint=99 print details of every iteration except n-vectors;
+c iprint=100 print also the changes of active set and final x;
+c iprint>100 print details of every iteration including x and g;
+c When iprint > 0, the file iterate.dat will be created to
+c summarize the iteration.
+c
+c sbgnrm is a double precision variable.
+c On entry sbgnrm is the norm of the projected gradient at x.
+c On exit sbgnrm is unchanged.
+c
+c info is an integer variable.
+c On entry info is 0.
+c On exit info = 0 for normal return,
+c = nonzero for abnormal return when the the system
+c used in routine bmv is singular.
+c
+c Subprograms called:
+c
+c L-BFGS-B Library ... hpsolb, bmv.
+c
+c Linpack ... dscal dcopy, daxpy.
+c
+c
+c References:
+c
+c [1] R. H. Byrd, P. Lu, J. Nocedal and C. Zhu, ``A limited
+c memory algorithm for bound constrained optimization'',
+c SIAM J. Scientific Computing 16 (1995), no. 5, pp. 1190--1208.
+c
+c [2] C. Zhu, R.H. Byrd, P. Lu, J. Nocedal, ``L-BFGS-B: FORTRAN
+c Subroutines for Large Scale Bound Constrained Optimization''
+c Tech. Report, NAM-11, EECS Department, Northwestern University,
+c 1994.
+c
+c (Postscript files of these papers are available via anonymous
+c ftp to eecs.nwu.edu in the directory pub/lbfgs/lbfgs_bcm.)
+c
+c * * *
+c
+c NEOS, November 1994. (Latest revision June 1996.)
+c Optimization Technology Center.
+c Argonne National Laboratory and Northwestern University.
+c Written by
+c Ciyou Zhu
+c in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.
+c
+c
+c ************
+
+ logical xlower,xupper,bnded
+ integer i,j,col2,nfree,nbreak,pointr,
+ + ibp,nleft,ibkmin,iter
+ double precision f1,f2,dt,dtm,tsum,dibp,zibp,dibp2,bkmin,
+ + tu,tl,wmc,wmp,wmw,ddot,tj,tj0,neggi,sbgnrm,
+ + f2_org
+ double precision one,zero
+ parameter (one=1.0d0,zero=0.0d0)
+
+c Check the status of the variables, reset iwhere(i) if necessary;
+c compute the Cauchy direction d and the breakpoints t; initialize
+c the derivative f1 and the vector p = W'd (for theta = 1).
+
+ if (sbgnrm .le. zero) then
+ if (iprint .ge. 0) write (6,*) 'Subgnorm = 0. GCP = X.'
+ call dcopy(n,x,1,xcp,1)
+ return
+ endif
+ bnded = .true.
+ nfree = n + 1
+ nbreak = 0
+ ibkmin = 0
+ bkmin = zero
+ col2 = 2*col
+ f1 = zero
+ if (iprint .ge. 99) write (6,3010)
+
+c We set p to zero and build it up as we determine d.
+
+ do 20 i = 1, col2
+ p(i) = zero
+ 20 continue
+
+c In the following loop we determine for each variable its bound
+c status and its breakpoint, and update p accordingly.
+c Smallest breakpoint is identified.
+
+ do 50 i = 1, n
+ neggi = -g(i)
+ if (iwhere(i) .ne. 3 .and. iwhere(i) .ne. -1) then
+c if x(i) is not a constant and has bounds,
+c compute the difference between x(i) and its bounds.
+ if (nbd(i) .le. 2) tl = x(i) - l(i)
+ if (nbd(i) .ge. 2) tu = u(i) - x(i)
+
+c If a variable is close enough to a bound
+c we treat it as at bound.
+ xlower = nbd(i) .le. 2 .and. tl .le. zero
+ xupper = nbd(i) .ge. 2 .and. tu .le. zero
+
+c reset iwhere(i).
+ iwhere(i) = 0
+ if (xlower) then
+ if (neggi .le. zero) iwhere(i) = 1
+ else if (xupper) then
+ if (neggi .ge. zero) iwhere(i) = 2
+ else
+ if (abs(neggi) .le. zero) iwhere(i) = -3
+ endif
+ endif
+ pointr = head
+ if (iwhere(i) .ne. 0 .and. iwhere(i) .ne. -1) then
+ d(i) = zero
+ else
+ d(i) = neggi
+ f1 = f1 - neggi*neggi
+c calculate p := p - W'e_i* (g_i).
+ do 40 j = 1, col
+ p(j) = p(j) + wy(i,pointr)* neggi
+ p(col + j) = p(col + j) + ws(i,pointr)*neggi
+ pointr = mod(pointr,m) + 1
+ 40 continue
+ if (nbd(i) .le. 2 .and. nbd(i) .ne. 0
+ + .and. neggi .lt. zero) then
+c x(i) + d(i) is bounded; compute t(i).
+ nbreak = nbreak + 1
+ iorder(nbreak) = i
+ t(nbreak) = tl/(-neggi)
+ if (nbreak .eq. 1 .or. t(nbreak) .lt. bkmin) then
+ bkmin = t(nbreak)
+ ibkmin = nbreak
+ endif
+ else if (nbd(i) .ge. 2 .and. neggi .gt. zero) then
+c x(i) + d(i) is bounded; compute t(i).
+ nbreak = nbreak + 1
+ iorder(nbreak) = i
+ t(nbreak) = tu/neggi
+ if (nbreak .eq. 1 .or. t(nbreak) .lt. bkmin) then
+ bkmin = t(nbreak)
+ ibkmin = nbreak
+ endif
+ else
+c x(i) + d(i) is not bounded.
+ nfree = nfree - 1
+ iorder(nfree) = i
+ if (abs(neggi) .gt. zero) bnded = .false.
+ endif
+ endif
+ 50 continue
+
+c The indices of the nonzero components of d are now stored
+c in iorder(1),...,iorder(nbreak) and iorder(nfree),...,iorder(n).
+c The smallest of the nbreak breakpoints is in t(ibkmin)=bkmin.
+
+ if (theta .ne. one) then
+c complete the initialization of p for theta not= one.
+ call dscal(col,theta,p(col+1),1)
+ endif
+
+c Initialize GCP xcp = x.
+
+ call dcopy(n,x,1,xcp,1)
+
+ if (nbreak .eq. 0 .and. nfree .eq. n + 1) then
+c is a zero vector, return with the initial xcp as GCP.
+ if (iprint .gt. 100) write (6,1010) (xcp(i), i = 1, n)
+ return
+ endif
+
+c Initialize c = W'(xcp - x) = 0.
+
+ do 60 j = 1, col2
+ c(j) = zero
+ 60 continue
+
+c Initialize derivative f2.
+
+ f2 = -theta*f1
+ f2_org = f2
+ if (col .gt. 0) then
+ call bmv(m,sy,wt,col,p,v,info)
+ if (info .ne. 0) return
+ f2 = f2 - ddot(col2,v,1,p,1)
+ endif
+ dtm = -f1/f2
+ tsum = zero
+ nseg = 1
+ if (iprint .ge. 99)
+ + write (6,*) 'There are ',nbreak,' breakpoints '
+
+c If there are no breakpoints, locate the GCP and return.
+
+ if (nbreak .eq. 0) goto 888
+
+ nleft = nbreak
+ iter = 1
+
+
+ tj = zero
+
+c------------------- the beginning of the loop -------------------------
+
+ 777 continue
+
+c Find the next smallest breakpoint;
+c compute dt = t(nleft) - t(nleft + 1).
+
+ tj0 = tj
+ if (iter .eq. 1) then
+c Since we already have the smallest breakpoint we need not do
+c heapsort yet. Often only one breakpoint is used and the
+c cost of heapsort is avoided.
+ tj = bkmin
+ ibp = iorder(ibkmin)
+ else
+ if (iter .eq. 2) then
+c Replace the already used smallest breakpoint with the
+c breakpoint numbered nbreak > nlast, before heapsort call.
+ if (ibkmin .ne. nbreak) then
+ t(ibkmin) = t(nbreak)
+ iorder(ibkmin) = iorder(nbreak)
+ endif
+c Update heap structure of breakpoints
+c (if iter=2, initialize heap).
+ endif
+ call hpsolb(nleft,t,iorder,iter-2)
+ tj = t(nleft)
+ ibp = iorder(nleft)
+ endif
+
+ dt = tj - tj0
+
+ if (dt .ne. zero .and. iprint .ge. 100) then
+ write (6,4011) nseg,f1,f2
+ write (6,5010) dt
+ write (6,6010) dtm
+ endif
+
+c If a minimizer is within this interval, locate the GCP and return.
+
+ if (dtm .lt. dt) goto 888
+
+c Otherwise fix one variable and
+c reset the corresponding component of d to zero.
+
+ tsum = tsum + dt
+ nleft = nleft - 1
+ iter = iter + 1
+ dibp = d(ibp)
+ d(ibp) = zero
+ if (dibp .gt. zero) then
+ zibp = u(ibp) - x(ibp)
+ xcp(ibp) = u(ibp)
+ iwhere(ibp) = 2
+ else
+ zibp = l(ibp) - x(ibp)
+ xcp(ibp) = l(ibp)
+ iwhere(ibp) = 1
+ endif
+ if (iprint .ge. 100) write (6,*) 'Variable ',ibp,' is fixed.'
+ if (nleft .eq. 0 .and. nbreak .eq. n) then
+c all n variables are fixed,
+c return with xcp as GCP.
+ dtm = dt
+ goto 999
+ endif
+
+c Update the derivative information.
+
+ nseg = nseg + 1
+ dibp2 = dibp**2
+
+c Update f1 and f2.
+
+c temporarily set f1 and f2 for col=0.
+ f1 = f1 + dt*f2 + dibp2 - theta*dibp*zibp
+ f2 = f2 - theta*dibp2
+
+ if (col .gt. 0) then
+c update c = c + dt*p.
+ call daxpy(col2,dt,p,1,c,1)
+
+c choose wbp,
+c the row of W corresponding to the breakpoint encountered.
+ pointr = head
+ do 70 j = 1,col
+ wbp(j) = wy(ibp,pointr)
+ wbp(col + j) = theta*ws(ibp,pointr)
+ pointr = mod(pointr,m) + 1
+ 70 continue
+
+c compute (wbp)Mc, (wbp)Mp, and (wbp)M(wbp)'.
+ call bmv(m,sy,wt,col,wbp,v,info)
+ if (info .ne. 0) return
+ wmc = ddot(col2,c,1,v,1)
+ wmp = ddot(col2,p,1,v,1)
+ wmw = ddot(col2,wbp,1,v,1)
+
+c update p = p - dibp*wbp.
+ call daxpy(col2,-dibp,wbp,1,p,1)
+
+c complete updating f1 and f2 while col > 0.
+ f1 = f1 + dibp*wmc
+ f2 = f2 + 2.0d0*dibp*wmp - dibp2*wmw
+ endif
+
+ f2 = max(epsmch*f2_org,f2)
+ if (nleft .gt. 0) then
+ dtm = -f1/f2
+ goto 777
+c to repeat the loop for unsearched intervals.
+ else if(bnded) then
+ f1 = zero
+ f2 = zero
+ dtm = zero
+ else
+ dtm = -f1/f2
+ endif
+
+c------------------- the end of the loop -------------------------------
+
+ 888 continue
+ if (iprint .ge. 99) then
+ write (6,*)
+ write (6,*) 'GCP found in this segment'
+ write (6,4010) nseg,f1,f2
+ write (6,6010) dtm
+ endif
+ if (dtm .le. zero) dtm = zero
+ tsum = tsum + dtm
+
+c Move free variables (i.e., the ones w/o breakpoints) and
+c the variables whose breakpoints haven't been reached.
+
+ call daxpy(n,tsum,d,1,xcp,1)
+
+ 999 continue
+
+c Update c = c + dtm*p = W'(x^c - x)
+c which will be used in computing r = Z'(B(x^c - x) + g).
+
+ if (col .gt. 0) call daxpy(col2,dtm,p,1,c,1)
+ if (iprint .gt. 100) write (6,1010) (xcp(i),i = 1,n)
+ if (iprint .ge. 99) write (6,2010)
+
+ 1010 format ('Cauchy X = ',/,(4x,1p,6(1x,d11.4)))
+ 2010 format (/,'---------------- exit CAUCHY----------------------',/)
+ 3010 format (/,'---------------- CAUCHY entered-------------------')
+ 4010 format ('Piece ',i3,' --f1, f2 at start point ',1p,2(1x,d11.4))
+ 4011 format (/,'Piece ',i3,' --f1, f2 at start point ',
+ + 1p,2(1x,d11.4))
+ 5010 format ('Distance to the next break point = ',1p,d11.4)
+ 6010 format ('Distance to the stationary point = ',1p,d11.4)
+
+ return
+
+ end
+
+c====================== The end of cauchy ==============================
+
+ subroutine cmprlb(n, m, x, g, ws, wy, sy, wt, z, r, wa, index,
+ + theta, col, head, nfree, cnstnd, info)
+
+ logical cnstnd
+ integer n, m, col, head, nfree, info, index(n)
+ double precision theta,
+ + x(n), g(n), z(n), r(n), wa(4*m),
+ + ws(n, m), wy(n, m), sy(m, m), wt(m, m)
+
+c ************
+c
+c Subroutine cmprlb
+c
+c This subroutine computes r=-Z'B(xcp-xk)-Z'g by using
+c wa(2m+1)=W'(xcp-x) from subroutine cauchy.
+c
+c Subprograms called:
+c
+c L-BFGS-B Library ... bmv.
+c
+c
+c * * *
+c
+c NEOS, November 1994. (Latest revision June 1996.)
+c Optimization Technology Center.
+c Argonne National Laboratory and Northwestern University.
+c Written by
+c Ciyou Zhu
+c in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.
+c
+c
+c ************
+
+ integer i,j,k,pointr
+ double precision a1,a2
+
+ if (.not. cnstnd .and. col .gt. 0) then
+ do 26 i = 1, n
+ r(i) = -g(i)
+ 26 continue
+ else
+ do 30 i = 1, nfree
+ k = index(i)
+ r(i) = -theta*(z(k) - x(k)) - g(k)
+ 30 continue
+ call bmv(m,sy,wt,col,wa(2*m+1),wa(1),info)
+ if (info .ne. 0) then
+ info = -8
+ return
+ endif
+ pointr = head
+ do 34 j = 1, col
+ a1 = wa(j)
+ a2 = theta*wa(col + j)
+ do 32 i = 1, nfree
+ k = index(i)
+ r(i) = r(i) + wy(k,pointr)*a1 + ws(k,pointr)*a2
+ 32 continue
+ pointr = mod(pointr,m) + 1
+ 34 continue
+ endif
+
+ return
+
+ end
+
+c======================= The end of cmprlb =============================
+
+ subroutine errclb(n, m, factr, l, u, nbd, task, info, k)
+
+ character*60 task
+ integer n, m, info, k, nbd(n)
+ double precision factr, l(n), u(n)
+
+c ************
+c
+c Subroutine errclb
+c
+c This subroutine checks the validity of the input data.
+c
+c
+c * * *
+c
+c NEOS, November 1994. (Latest revision June 1996.)
+c Optimization Technology Center.
+c Argonne National Laboratory and Northwestern University.
+c Written by
+c Ciyou Zhu
+c in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.
+c
+c
+c ************
+
+ integer i
+ double precision one,zero
+ parameter (one=1.0d0,zero=0.0d0)
+
+c Check the input arguments for errors.
+
+ if (n .le. 0) task = 'ERROR: N .LE. 0'
+ if (m .le. 0) task = 'ERROR: M .LE. 0'
+ if (factr .lt. zero) task = 'ERROR: FACTR .LT. 0'
+
+c Check the validity of the arrays nbd(i), u(i), and l(i).
+
+ do 10 i = 1, n
+ if (nbd(i) .lt. 0 .or. nbd(i) .gt. 3) then
+c return
+ task = 'ERROR: INVALID NBD'
+ info = -6
+ k = i
+ endif
+ if (nbd(i) .eq. 2) then
+ if (l(i) .gt. u(i)) then
+c return
+ task = 'ERROR: NO FEASIBLE SOLUTION'
+ info = -7
+ k = i
+ endif
+ endif
+ 10 continue
+
+ return
+
+ end
+
+c======================= The end of errclb =============================
+
+ subroutine formk(n, nsub, ind, nenter, ileave, indx2, iupdat,
+ + updatd, wn, wn1, m, ws, wy, sy, theta, col,
+ + head, info)
+
+ integer n, nsub, m, col, head, nenter, ileave, iupdat,
+ + info, ind(n), indx2(n)
+ double precision theta, wn(2*m, 2*m), wn1(2*m, 2*m),
+ + ws(n, m), wy(n, m), sy(m, m)
+ logical updatd
+
+c ************
+c
+c Subroutine formk
+c
+c This subroutine forms the LEL^T factorization of the indefinite
+c
+c matrix K = [-D -Y'ZZ'Y/theta L_a'-R_z' ]
+c [L_a -R_z theta*S'AA'S ]
+c where E = [-I 0]
+c [ 0 I]
+c The matrix K can be shown to be equal to the matrix M^[-1]N
+c occurring in section 5.1 of [1], as well as to the matrix
+c Mbar^[-1] Nbar in section 5.3.
+c
+c n is an integer variable.
+c On entry n is the dimension of the problem.
+c On exit n is unchanged.
+c
+c nsub is an integer variable
+c On entry nsub is the number of subspace variables in free set.
+c On exit nsub is not changed.
+c
+c ind is an integer array of dimension nsub.
+c On entry ind specifies the indices of subspace variables.
+c On exit ind is unchanged.
+c
+c nenter is an integer variable.
+c On entry nenter is the number of variables entering the
+c free set.
+c On exit nenter is unchanged.
+c
+c ileave is an integer variable.
+c On entry indx2(ileave),...,indx2(n) are the variables leaving
+c the free set.
+c On exit ileave is unchanged.
+c
+c indx2 is an integer array of dimension n.
+c On entry indx2(1),...,indx2(nenter) are the variables entering
+c the free set, while indx2(ileave),...,indx2(n) are the
+c variables leaving the free set.
+c On exit indx2 is unchanged.
+c
+c iupdat is an integer variable.
+c On entry iupdat is the total number of BFGS updates made so far.
+c On exit iupdat is unchanged.
+c
+c updatd is a logical variable.
+c On entry 'updatd' is true if the L-BFGS matrix is updatd.
+c On exit 'updatd' is unchanged.
+c
+c wn is a double precision array of dimension 2m x 2m.
+c On entry wn is unspecified.
+c On exit the upper triangle of wn stores the LEL^T factorization
+c of the 2*col x 2*col indefinite matrix
+c [-D -Y'ZZ'Y/theta L_a'-R_z' ]
+c [L_a -R_z theta*S'AA'S ]
+c
+c wn1 is a double precision array of dimension 2m x 2m.
+c On entry wn1 stores the lower triangular part of
+c [Y' ZZ'Y L_a'+R_z']
+c [L_a+R_z S'AA'S ]
+c in the previous iteration.
+c On exit wn1 stores the corresponding updated matrices.
+c The purpose of wn1 is just to store these inner products
+c so they can be easily updated and inserted into wn.
+c
+c m is an integer variable.
+c On entry m is the maximum number of variable metric corrections
+c used to define the limited memory matrix.
+c On exit m is unchanged.
+c
+c ws, wy, sy, and wtyy are double precision arrays;
+c theta is a double precision variable;
+c col is an integer variable;
+c head is an integer variable.
+c On entry they store the information defining the
+c limited memory BFGS matrix:
+c ws(n,m) stores S, a set of s-vectors;
+c wy(n,m) stores Y, a set of y-vectors;
+c sy(m,m) stores S'Y;
+c wtyy(m,m) stores the Cholesky factorization
+c of (theta*S'S+LD^(-1)L')
+c theta is the scaling factor specifying B_0 = theta I;
+c col is the number of variable metric corrections stored;
+c head is the location of the 1st s- (or y-) vector in S (or Y).
+c On exit they are unchanged.
+c
+c info is an integer variable.
+c On entry info is unspecified.
+c On exit info = 0 for normal return;
+c = -1 when the 1st Cholesky factorization failed;
+c = -2 when the 2st Cholesky factorization failed.
+c
+c Subprograms called:
+c
+c Linpack ... dcopy, dpofa, dtrsl.
+c
+c
+c References:
+c [1] R. H. Byrd, P. Lu, J. Nocedal and C. Zhu, ``A limited
+c memory algorithm for bound constrained optimization'',
+c SIAM J. Scientific Computing 16 (1995), no. 5, pp. 1190--1208.
+c
+c [2] C. Zhu, R.H. Byrd, P. Lu, J. Nocedal, ``L-BFGS-B: a
+c limited memory FORTRAN code for solving bound constrained
+c optimization problems'', Tech. Report, NAM-11, EECS Department,
+c Northwestern University, 1994.
+c
+c (Postscript files of these papers are available via anonymous
+c ftp to eecs.nwu.edu in the directory pub/lbfgs/lbfgs_bcm.)
+c
+c * * *
+c
+c NEOS, November 1994. (Latest revision June 1996.)
+c Optimization Technology Center.
+c Argonne National Laboratory and Northwestern University.
+c Written by
+c Ciyou Zhu
+c in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.
+c
+c
+c ************
+
+ integer m2,ipntr,jpntr,iy,is,jy,js,is1,js1,k1,i,k,
+ + col2,pbegin,pend,dbegin,dend,upcl
+ double precision ddot,temp1,temp2,temp3,temp4
+ double precision one,zero
+ parameter (one=1.0d0,zero=0.0d0)
+
+c Form the lower triangular part of
+c WN1 = [Y' ZZ'Y L_a'+R_z']
+c [L_a+R_z S'AA'S ]
+c where L_a is the strictly lower triangular part of S'AA'Y
+c R_z is the upper triangular part of S'ZZ'Y.
+
+ if (updatd) then
+ if (iupdat .gt. m) then
+c shift old part of WN1.
+ do 10 jy = 1, m - 1
+ js = m + jy
+ call dcopy(m-jy,wn1(jy+1,jy+1),1,wn1(jy,jy),1)
+ call dcopy(m-jy,wn1(js+1,js+1),1,wn1(js,js),1)
+ call dcopy(m-1,wn1(m+2,jy+1),1,wn1(m+1,jy),1)
+ 10 continue
+ endif
+
+c put new rows in blocks (1,1), (2,1) and (2,2).
+ pbegin = 1
+ pend = nsub
+ dbegin = nsub + 1
+ dend = n
+ iy = col
+ is = m + col
+ ipntr = head + col - 1
+ if (ipntr .gt. m) ipntr = ipntr - m
+ jpntr = head
+ do 20 jy = 1, col
+ js = m + jy
+ temp1 = zero
+ temp2 = zero
+ temp3 = zero
+c compute element jy of row 'col' of Y'ZZ'Y
+ do 15 k = pbegin, pend
+ k1 = ind(k)
+ temp1 = temp1 + wy(k1,ipntr)*wy(k1,jpntr)
+ 15 continue
+c compute elements jy of row 'col' of L_a and S'AA'S
+ do 16 k = dbegin, dend
+ k1 = ind(k)
+ temp2 = temp2 + ws(k1,ipntr)*ws(k1,jpntr)
+ temp3 = temp3 + ws(k1,ipntr)*wy(k1,jpntr)
+ 16 continue
+ wn1(iy,jy) = temp1
+ wn1(is,js) = temp2
+ wn1(is,jy) = temp3
+ jpntr = mod(jpntr,m) + 1
+ 20 continue
+
+c put new column in block (2,1).
+ jy = col
+ jpntr = head + col - 1
+ if (jpntr .gt. m) jpntr = jpntr - m
+ ipntr = head
+ do 30 i = 1, col
+ is = m + i
+ temp3 = zero
+c compute element i of column 'col' of R_z
+ do 25 k = pbegin, pend
+ k1 = ind(k)
+ temp3 = temp3 + ws(k1,ipntr)*wy(k1,jpntr)
+ 25 continue
+ ipntr = mod(ipntr,m) + 1
+ wn1(is,jy) = temp3
+ 30 continue
+ upcl = col - 1
+ else
+ upcl = col
+ endif
+
+c modify the old parts in blocks (1,1) and (2,2) due to changes
+c in the set of free variables.
+ ipntr = head
+ do 45 iy = 1, upcl
+ is = m + iy
+ jpntr = head
+ do 40 jy = 1, iy
+ js = m + jy
+ temp1 = zero
+ temp2 = zero
+ temp3 = zero
+ temp4 = zero
+ do 35 k = 1, nenter
+ k1 = indx2(k)
+ temp1 = temp1 + wy(k1,ipntr)*wy(k1,jpntr)
+ temp2 = temp2 + ws(k1,ipntr)*ws(k1,jpntr)
+ 35 continue
+ do 36 k = ileave, n
+ k1 = indx2(k)
+ temp3 = temp3 + wy(k1,ipntr)*wy(k1,jpntr)
+ temp4 = temp4 + ws(k1,ipntr)*ws(k1,jpntr)
+ 36 continue
+ wn1(iy,jy) = wn1(iy,jy) + temp1 - temp3
+ wn1(is,js) = wn1(is,js) - temp2 + temp4
+ jpntr = mod(jpntr,m) + 1
+ 40 continue
+ ipntr = mod(ipntr,m) + 1
+ 45 continue
+
+c modify the old parts in block (2,1).
+ ipntr = head
+ do 60 is = m + 1, m + upcl
+ jpntr = head
+ do 55 jy = 1, upcl
+ temp1 = zero
+ temp3 = zero
+ do 50 k = 1, nenter
+ k1 = indx2(k)
+ temp1 = temp1 + ws(k1,ipntr)*wy(k1,jpntr)
+ 50 continue
+ do 51 k = ileave, n
+ k1 = indx2(k)
+ temp3 = temp3 + ws(k1,ipntr)*wy(k1,jpntr)
+ 51 continue
+ if (is .le. jy + m) then
+ wn1(is,jy) = wn1(is,jy) + temp1 - temp3
+ else
+ wn1(is,jy) = wn1(is,jy) - temp1 + temp3
+ endif
+ jpntr = mod(jpntr,m) + 1
+ 55 continue
+ ipntr = mod(ipntr,m) + 1
+ 60 continue
+
+c Form the upper triangle of WN = [D+Y' ZZ'Y/theta -L_a'+R_z' ]
+c [-L_a +R_z S'AA'S*theta]
+
+ m2 = 2*m
+ do 70 iy = 1, col
+ is = col + iy
+ is1 = m + iy
+ do 65 jy = 1, iy
+ js = col + jy
+ js1 = m + jy
+ wn(jy,iy) = wn1(iy,jy)/theta
+ wn(js,is) = wn1(is1,js1)*theta
+ 65 continue
+ do 66 jy = 1, iy - 1
+ wn(jy,is) = -wn1(is1,jy)
+ 66 continue
+ do 67 jy = iy, col
+ wn(jy,is) = wn1(is1,jy)
+ 67 continue
+ wn(iy,iy) = wn(iy,iy) + sy(iy,iy)
+ 70 continue
+
+c Form the upper triangle of WN= [ LL' L^-1(-L_a'+R_z')]
+c [(-L_a +R_z)L'^-1 S'AA'S*theta ]
+
+c first Cholesky factor (1,1) block of wn to get LL'
+c with L' stored in the upper triangle of wn.
+ call dpofa(wn,m2,col,info)
+ if (info .ne. 0) then
+ info = -1
+ return
+ endif
+c then form L^-1(-L_a'+R_z') in the (1,2) block.
+ col2 = 2*col
+ do 71 js = col+1 ,col2
+ call dtrsl(wn,m2,col,wn(1,js),11,info)
+ 71 continue
+
+c Form S'AA'S*theta + (L^-1(-L_a'+R_z'))'L^-1(-L_a'+R_z') in the
+c upper triangle of (2,2) block of wn.
+
+
+ do 72 is = col+1, col2
+ do 74 js = is, col2
+ wn(is,js) = wn(is,js) + ddot(col,wn(1,is),1,wn(1,js),1)
+ 74 continue
+ 72 continue
+
+c Cholesky factorization of (2,2) block of wn.
+
+ call dpofa(wn(col+1,col+1),m2,col,info)
+ if (info .ne. 0) then
+ info = -2
+ return
+ endif
+
+ return
+
+ end
+
+c======================= The end of formk ==============================
+
+ subroutine formt(m, wt, sy, ss, col, theta, info)
+
+ integer m, col, info
+ double precision theta, wt(m, m), sy(m, m), ss(m, m)
+
+c ************
+c
+c Subroutine formt
+c
+c This subroutine forms the upper half of the pos. def. and symm.
+c T = theta*SS + L*D^(-1)*L', stores T in the upper triangle
+c of the array wt, and performs the Cholesky factorization of T
+c to produce J*J', with J' stored in the upper triangle of wt.
+c
+c Subprograms called:
+c
+c Linpack ... dpofa.
+c
+c
+c * * *
+c
+c NEOS, November 1994. (Latest revision June 1996.)
+c Optimization Technology Center.
+c Argonne National Laboratory and Northwestern University.
+c Written by
+c Ciyou Zhu
+c in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.
+c
+c
+c ************
+
+ integer i,j,k,k1
+ double precision ddum
+ double precision zero
+ parameter (zero=0.0d0)
+
+
+c Form the upper half of T = theta*SS + L*D^(-1)*L',
+c store T in the upper triangle of the array wt.
+
+ do 52 j = 1, col
+ wt(1,j) = theta*ss(1,j)
+ 52 continue
+ do 55 i = 2, col
+ do 54 j = i, col
+ k1 = min(i,j) - 1
+ ddum = zero
+ do 53 k = 1, k1
+ ddum = ddum + sy(i,k)*sy(j,k)/sy(k,k)
+ 53 continue
+ wt(i,j) = ddum + theta*ss(i,j)
+ 54 continue
+ 55 continue
+
+c Cholesky factorize T to J*J' with
+c J' stored in the upper triangle of wt.
+
+ call dpofa(wt,m,col,info)
+ if (info .ne. 0) then
+ info = -3
+ endif
+
+ return
+
+ end
+
+c======================= The end of formt ==============================
+
+ subroutine freev(n, nfree, index, nenter, ileave, indx2,
+ + iwhere, wrk, updatd, cnstnd, iprint, iter)
+
+ integer n, nfree, nenter, ileave, iprint, iter,
+ + index(n), indx2(n), iwhere(n)
+ logical wrk, updatd, cnstnd
+
+c ************
+c
+c Subroutine freev
+c
+c This subroutine counts the entering and leaving variables when
+c iter > 0, and finds the index set of free and active variables
+c at the GCP.
+c
+c cnstnd is a logical variable indicating whether bounds are present
+c
+c index is an integer array of dimension n
+c for i=1,...,nfree, index(i) are the indices of free variables
+c for i=nfree+1,...,n, index(i) are the indices of bound variables
+c On entry after the first iteration, index gives
+c the free variables at the previous iteration.
+c On exit it gives the free variables based on the determination
+c in cauchy using the array iwhere.
+c
+c indx2 is an integer array of dimension n
+c On entry indx2 is unspecified.
+c On exit with iter>0, indx2 indicates which variables
+c have changed status since the previous iteration.
+c For i= 1,...,nenter, indx2(i) have changed from bound to free.
+c For i= ileave+1,...,n, indx2(i) have changed from free to bound.
+c
+c
+c * * *
+c
+c NEOS, November 1994. (Latest revision June 1996.)
+c Optimization Technology Center.
+c Argonne National Laboratory and Northwestern University.
+c Written by
+c Ciyou Zhu
+c in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.
+c
+c
+c ************
+
+ integer iact,i,k
+
+ nenter = 0
+ ileave = n + 1
+ if (iter .gt. 0 .and. cnstnd) then
+c count the entering and leaving variables.
+ do 20 i = 1, nfree
+ k = index(i)
+
+c write(6,*) ' k = index(i) ', k
+c write(6,*) ' index = ', i
+
+ if (iwhere(k) .gt. 0) then
+ ileave = ileave - 1
+ indx2(ileave) = k
+ if (iprint .ge. 100) write (6,*)
+ + 'Variable ',k,' leaves the set of free variables'
+ endif
+ 20 continue
+ do 22 i = 1 + nfree, n
+ k = index(i)
+ if (iwhere(k) .le. 0) then
+ nenter = nenter + 1
+ indx2(nenter) = k
+ if (iprint .ge. 100) write (6,*)
+ + 'Variable ',k,' enters the set of free variables'
+ endif
+ 22 continue
+ if (iprint .ge. 99) write (6,*)
+ + n+1-ileave,' variables leave; ',nenter,' variables enter'
+ endif
+ wrk = (ileave .lt. n+1) .or. (nenter .gt. 0) .or. updatd
+
+c Find the index set of free and active variables at the GCP.
+
+ nfree = 0
+ iact = n + 1
+ do 24 i = 1, n
+ if (iwhere(i) .le. 0) then
+ nfree = nfree + 1
+ index(nfree) = i
+ else
+ iact = iact - 1
+ index(iact) = i
+ endif
+ 24 continue
+ if (iprint .ge. 99) write (6,*)
+ + nfree,' variables are free at GCP ',iter + 1
+
+ return
+
+ end
+
+c======================= The end of freev ==============================
+
+ subroutine hpsolb(n, t, iorder, iheap)
+ integer iheap, n, iorder(n)
+ double precision t(n)
+
+c ************
+c
+c Subroutine hpsolb
+c
+c This subroutine sorts out the least element of t, and puts the
+c remaining elements of t in a heap.
+c
+c n is an integer variable.
+c On entry n is the dimension of the arrays t and iorder.
+c On exit n is unchanged.
+c
+c t is a double precision array of dimension n.
+c On entry t stores the elements to be sorted,
+c On exit t(n) stores the least elements of t, and t(1) to t(n-1)
+c stores the remaining elements in the form of a heap.
+c
+c iorder is an integer array of dimension n.
+c On entry iorder(i) is the index of t(i).
+c On exit iorder(i) is still the index of t(i), but iorder may be
+c permuted in accordance with t.
+c
+c iheap is an integer variable specifying the task.
+c On entry iheap should be set as follows:
+c iheap .eq. 0 if t(1) to t(n) is not in the form of a heap,
+c iheap .ne. 0 if otherwise.
+c On exit iheap is unchanged.
+c
+c
+c References:
+c Algorithm 232 of CACM (J. W. J. Williams): HEAPSORT.
+c
+c * * *
+c
+c NEOS, November 1994. (Latest revision June 1996.)
+c Optimization Technology Center.
+c Argonne National Laboratory and Northwestern University.
+c Written by
+c Ciyou Zhu
+c in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.
+c
+c ************
+
+ integer i,j,k,indxin,indxou
+ double precision ddum,out
+
+ if (iheap .eq. 0) then
+
+c Rearrange the elements t(1) to t(n) to form a heap.
+
+ do 20 k = 2, n
+ ddum = t(k)
+ indxin = iorder(k)
+
+c Add ddum to the heap.
+ i = k
+ 10 continue
+ if (i.gt.1) then
+ j = i/2
+ if (ddum .lt. t(j)) then
+ t(i) = t(j)
+ iorder(i) = iorder(j)
+ i = j
+ goto 10
+ endif
+ endif
+ t(i) = ddum
+ iorder(i) = indxin
+ 20 continue
+ endif
+
+c Assign to 'out' the value of t(1), the least member of the heap,
+c and rearrange the remaining members to form a heap as
+c elements 1 to n-1 of t.
+
+ if (n .gt. 1) then
+ i = 1
+ out = t(1)
+ indxou = iorder(1)
+ ddum = t(n)
+ indxin = iorder(n)
+
+c Restore the heap
+ 30 continue
+ j = i+i
+ if (j .le. n-1) then
+ if (t(j+1) .lt. t(j)) j = j+1
+ if (t(j) .lt. ddum ) then
+ t(i) = t(j)
+ iorder(i) = iorder(j)
+ i = j
+ goto 30
+ endif
+ endif
+ t(i) = ddum
+ iorder(i) = indxin
+
+c Put the least member in t(n).
+
+ t(n) = out
+ iorder(n) = indxou
+ endif
+
+ return
+
+ end
+
+c====================== The end of hpsolb ==============================
+
+ subroutine lnsrlb(n, l, u, nbd, x, f, fold, gd, gdold, g, d, r, t,
+ + z, stp, dnorm, dtd, xstep, stpmx, iter, ifun,
+ + iback, nfgv, info, task, boxed, cnstnd, csave,
+ + isave, dsave)
+
+ character*60 task, csave
+ logical boxed, cnstnd
+ integer n, iter, ifun, iback, nfgv, info,
+ + nbd(n), isave(2)
+ double precision f, fold, gd, gdold, stp, dnorm, dtd, xstep,
+ + stpmx, x(n), l(n), u(n), g(n), d(n), r(n), t(n),
+ + z(n), dsave(13)
+c **********
+c
+c Subroutine lnsrlb
+c
+c This subroutine calls subroutine dcsrch from the Minpack2 library
+c to perform the line search. Subroutine dscrch is safeguarded so
+c that all trial points lie within the feasible region.
+c
+c Subprograms called:
+c
+c Minpack2 Library ... dcsrch.
+c
+c Linpack ... dtrsl, ddot.
+c
+c
+c * * *
+c
+c NEOS, November 1994. (Latest revision June 1996.)
+c Optimization Technology Center.
+c Argonne National Laboratory and Northwestern University.
+c Written by
+c Ciyou Zhu
+c in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.
+c
+c
+c **********
+
+ integer i
+ double precision ddot,a1,a2
+ double precision one,zero,big
+ parameter (one=1.0d0,zero=0.0d0,big=1.0d+10)
+ double precision ftol,gtol,xtol
+ parameter (ftol=1.0d-3,gtol=0.9d0,xtol=0.1d0)
+
+ if (task(1:5) .eq. 'FG_LN') goto 556
+
+ dtd = ddot(n,d,1,d,1)
+ dnorm = sqrt(dtd)
+
+c Determine the maximum step length.
+
+ stpmx = big
+ if (cnstnd) then
+ if (iter .eq. 0) then
+ stpmx = one
+ else
+ do 43 i = 1, n
+ a1 = d(i)
+ if (nbd(i) .ne. 0) then
+ if (a1 .lt. zero .and. nbd(i) .le. 2) then
+ a2 = l(i) - x(i)
+ if (a2 .ge. zero) then
+ stpmx = zero
+ else if (a1*stpmx .lt. a2) then
+ stpmx = a2/a1
+ endif
+ else if (a1 .gt. zero .and. nbd(i) .ge. 2) then
+ a2 = u(i) - x(i)
+ if (a2 .le. zero) then
+ stpmx = zero
+ else if (a1*stpmx .gt. a2) then
+ stpmx = a2/a1
+ endif
+ endif
+ endif
+ 43 continue
+ endif
+ endif
+
+ if (iter .eq. 0 .and. .not. boxed) then
+ stp = min(one/dnorm, stpmx)
+ else
+ stp = one
+ endif
+
+ call dcopy(n,x,1,t,1)
+ call dcopy(n,g,1,r,1)
+ fold = f
+ ifun = 0
+ iback = 0
+ csave = 'START'
+ 556 continue
+ gd = ddot(n,g,1,d,1)
+ if (ifun .eq. 0) then
+ gdold=gd
+ if (gd .ge. zero) then
+c the directional derivative >=0.
+c Line search is impossible.
+ write(6,*)' ascent direction in projection gd = ', gd
+ info = -4
+ return
+ endif
+ endif
+
+ call dcsrch(f,gd,stp,ftol,gtol,xtol,zero,stpmx,csave,isave,dsave)
+
+ xstep = stp*dnorm
+ if (csave(1:4) .ne. 'CONV' .and. csave(1:4) .ne. 'WARN') then
+ task = 'FG_LNSRCH'
+ ifun = ifun + 1
+ nfgv = nfgv + 1
+ iback = ifun - 1
+ if (stp .eq. one) then
+ call dcopy(n,z,1,x,1)
+ else
+ do 41 i = 1, n
+ x(i) = stp*d(i) + t(i)
+ 41 continue
+ endif
+ else
+ task = 'NEW_X'
+ endif
+
+ return
+
+ end
+
+c======================= The end of lnsrlb =============================
+
+ subroutine matupd(n, m, ws, wy, sy, ss, d, r, itail,
+ + iupdat, col, head, theta, rr, dr, stp, dtd)
+
+ integer n, m, itail, iupdat, col, head
+ double precision theta, rr, dr, stp, dtd, d(n), r(n),
+ + ws(n, m), wy(n, m), sy(m, m), ss(m, m)
+
+c ************
+c
+c Subroutine matupd
+c
+c This subroutine updates matrices WS and WY, and forms the
+c middle matrix in B.
+c
+c Subprograms called:
+c
+c Linpack ... dcopy, ddot.
+c
+c
+c * * *
+c
+c NEOS, November 1994. (Latest revision June 1996.)
+c Optimization Technology Center.
+c Argonne National Laboratory and Northwestern University.
+c Written by
+c Ciyou Zhu
+c in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.
+c
+c
+c ************
+
+ integer j,pointr
+ double precision ddot
+ double precision one
+ parameter (one=1.0d0)
+
+c Set pointers for matrices WS and WY.
+
+ if (iupdat .le. m) then
+ col = iupdat
+ itail = mod(head+iupdat-2,m) + 1
+ else
+ itail = mod(itail,m) + 1
+ head = mod(head,m) + 1
+ endif
+
+c Update matrices WS and WY.
+
+ call dcopy(n,d,1,ws(1,itail),1)
+ call dcopy(n,r,1,wy(1,itail),1)
+
+c Set theta=yy/ys.
+
+ theta = rr/dr
+
+c Form the middle matrix in B.
+
+c update the upper triangle of SS,
+c and the lower triangle of SY:
+ if (iupdat .gt. m) then
+c move old information
+ do 50 j = 1, col - 1
+ call dcopy(j,ss(2,j+1),1,ss(1,j),1)
+ call dcopy(col-j,sy(j+1,j+1),1,sy(j,j),1)
+ 50 continue
+ endif
+c add new information: the last row of SY
+c and the last column of SS:
+ pointr = head
+ do 51 j = 1, col - 1
+ sy(col,j) = ddot(n,d,1,wy(1,pointr),1)
+ ss(j,col) = ddot(n,ws(1,pointr),1,d,1)
+ pointr = mod(pointr,m) + 1
+ 51 continue
+ if (stp .eq. one) then
+ ss(col,col) = dtd
+ else
+ ss(col,col) = stp*stp*dtd
+ endif
+ sy(col,col) = dr
+
+ return
+
+ end
+
+c======================= The end of matupd =============================
+
+ subroutine prn1lb(n, m, l, u, x, iprint, itfile, epsmch)
+
+ integer n, m, iprint, itfile
+ double precision epsmch, x(n), l(n), u(n)
+
+c ************
+c
+c Subroutine prn1lb
+c
+c This subroutine prints the input data, initial point, upper and
+c lower bounds of each variable, machine precision, as well as
+c the headings of the output.
+c
+c
+c * * *
+c
+c NEOS, November 1994. (Latest revision June 1996.)
+c Optimization Technology Center.
+c Argonne National Laboratory and Northwestern University.
+c Written by
+c Ciyou Zhu
+c in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.
+c
+c
+c ************
+
+ integer i
+
+ if (iprint .ge. 0) then
+ write (6,7001) epsmch
+ write (6,*) 'N = ',n,' M = ',m
+ if (iprint .ge. 1) then
+ write (itfile,2001) epsmch
+ write (itfile,*)'N = ',n,' M = ',m
+ write (itfile,9001)
+ if (iprint .gt. 100) then
+ write (6,1004) 'L =',(l(i),i = 1,n)
+ write (6,1004) 'X0 =',(x(i),i = 1,n)
+ write (6,1004) 'U =',(u(i),i = 1,n)
+ endif
+ endif
+ endif
+
+ 1004 format (/,a4, 1p, 6(1x,d11.4),/,(4x,1p,6(1x,d11.4)))
+ 2001 format ('RUNNING THE L-BFGS-B CODE',/,/,
+ + 'it = iteration number',/,
+ + 'nf = number of function evaluations',/,
+ + 'nseg = number of segments explored during the Cauchy search',/,
+ + 'nact = number of active bounds at the generalized Cauchy point'
+ + ,/,
+ + 'sub = manner in which the subspace minimization terminated:'
+ + ,/,' con = converged, bnd = a bound was reached',/,
+ + 'itls = number of iterations performed in the line search',/,
+ + 'stepl = step length used',/,
+ + 'tstep = norm of the displacement (total step)',/,
+ + 'projg = norm of the projected gradient',/,
+ + 'f = function value',/,/,
+ + ' * * *',/,/,
+ + 'Machine precision =',1p,d10.3)
+ 7001 format ('RUNNING THE L-BFGS-B CODE',/,/,
+ + ' * * *',/,/,
+ + 'Machine precision =',1p,d10.3)
+ 9001 format (/,3x,'it',3x,'nf',2x,'nseg',2x,'nact',2x,'sub',2x,'itls',
+ + 2x,'stepl',4x,'tstep',5x,'projg',8x,'f')
+
+ return
+
+ end
+
+c======================= The end of prn1lb =============================
+
+ subroutine prn2lb(n, x, f, g, iprint, itfile, iter, nfgv, nact,
+ + sbgnrm, nseg, word, iword, iback, stp, xstep)
+
+ character*3 word
+ integer n, iprint, itfile, iter, nfgv, nact, nseg,
+ + iword, iback
+ double precision f, sbgnrm, stp, xstep, x(n), g(n)
+
+c ************
+c
+c Subroutine prn2lb
+c
+c This subroutine prints out new information after a successful
+c line search.
+c
+c
+c * * *
+c
+c NEOS, November 1994. (Latest revision June 1996.)
+c Optimization Technology Center.
+c Argonne National Laboratory and Northwestern University.
+c Written by
+c Ciyou Zhu
+c in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.
+c
+c
+c ************
+
+ integer i,imod
+
+c 'word' records the status of subspace solutions.
+ if (iword .eq. 0) then
+c the subspace minimization converged.
+ word = 'con'
+ else if (iword .eq. 1) then
+c the subspace minimization stopped at a bound.
+ word = 'bnd'
+ else if (iword .eq. 5) then
+c the truncated Newton step has been used.
+ word = 'TNT'
+ else
+ word = '---'
+ endif
+ if (iprint .ge. 99) then
+ write (6,*) 'LINE SEARCH',iback,' times; norm of step = ',xstep
+ write (6,2001) iter,f,sbgnrm
+ if (iprint .gt. 100) then
+ write (6,1004) 'X =',(x(i), i = 1, n)
+ write (6,1004) 'G =',(g(i), i = 1, n)
+ endif
+ else if (iprint .gt. 0) then
+ imod = mod(iter,iprint)
+ if (imod .eq. 0) write (6,2001) iter,f,sbgnrm
+ endif
+ if (iprint .ge. 1) write (itfile,3001)
+ + iter,nfgv,nseg,nact,word,iback,stp,xstep,sbgnrm,f
+
+ 1004 format (/,a4, 1p, 6(1x,d11.4),/,(4x,1p,6(1x,d11.4)))
+ 2001 format
+ + (/,'At iterate',i5,4x,'f= ',1p,d12.5,4x,'|proj g|= ',1p,d12.5)
+ 3001 format(2(1x,i4),2(1x,i5),2x,a3,1x,i4,1p,2(2x,d7.1),1p,2(1x,d10.3))
+
+ return
+
+ end
+
+c======================= The end of prn2lb =============================
+
+ subroutine prn3lb(n, x, f, task, iprint, info, itfile,
+ + iter, nfgv, nintol, nskip, nact, sbgnrm,
+ + time, nseg, word, iback, stp, xstep, k,
+ + cachyt, sbtime, lnscht)
+
+ character*60 task
+ character*3 word
+ integer n, iprint, info, itfile, iter, nfgv, nintol,
+ + nskip, nact, nseg, iback, k
+ double precision f, sbgnrm, time, stp, xstep, cachyt, sbtime,
+ + lnscht, x(n)
+
+c ************
+c
+c Subroutine prn3lb
+c
+c This subroutine prints out information when either a built-in
+c convergence test is satisfied or when an error message is
+c generated.
+c
+c
+c * * *
+c
+c NEOS, November 1994. (Latest revision June 1996.)
+c Optimization Technology Center.
+c Argonne National Laboratory and Northwestern University.
+c Written by
+c Ciyou Zhu
+c in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.
+c
+c
+c ************
+
+ integer i
+
+ if (task(1:5) .eq. 'ERROR') goto 999
+
+ if (iprint .ge. 0) then
+ write (6,3003)
+ write (6,3004)
+ write(6,3005) n,iter,nfgv,nintol,nskip,nact,sbgnrm,f
+ if (iprint .ge. 100) then
+ write (6,1004) 'X =',(x(i),i = 1,n)
+ endif
+ if (iprint .ge. 1) write (6,*) ' F =',f
+ endif
+ 999 continue
+ if (iprint .ge. 0) then
+ write (6,3009) task
+ if (info .ne. 0) then
+ if (info .eq. -1) write (6,9011)
+ if (info .eq. -2) write (6,9012)
+ if (info .eq. -3) write (6,9013)
+ if (info .eq. -4) write (6,9014)
+ if (info .eq. -5) write (6,9015)
+ if (info .eq. -6) write (6,*)' Input nbd(',k,') is invalid.'
+ if (info .eq. -7)
+ + write (6,*)' l(',k,') > u(',k,'). No feasible solution.'
+ if (info .eq. -8) write (6,9018)
+ if (info .eq. -9) write (6,9019)
+ endif
+ if (iprint .ge. 1) write (6,3007) cachyt,sbtime,lnscht
+ write (6,3008) time
+ if (iprint .ge. 1) then
+ if (info .eq. -4 .or. info .eq. -9) then
+ write (itfile,3002)
+ + iter,nfgv,nseg,nact,word,iback,stp,xstep
+ endif
+ write (itfile,3009) task
+ if (info .ne. 0) then
+ if (info .eq. -1) write (itfile,9011)
+ if (info .eq. -2) write (itfile,9012)
+ if (info .eq. -3) write (itfile,9013)
+ if (info .eq. -4) write (itfile,9014)
+ if (info .eq. -5) write (itfile,9015)
+ if (info .eq. -8) write (itfile,9018)
+ if (info .eq. -9) write (itfile,9019)
+ endif
+ write (itfile,3008) time
+ endif
+ endif
+
+ 1004 format (/,a4, 1p, 6(1x,d11.4),/,(4x,1p,6(1x,d11.4)))
+ 3002 format(2(1x,i4),2(1x,i5),2x,a3,1x,i4,1p,2(2x,d7.1),6x,'-',10x,'-')
+ 3003 format (/,
+ + ' * * *',/,/,
+ + 'Tit = total number of iterations',/,
+ + 'Tnf = total number of function evaluations',/,
+ + 'Tnint = total number of segments explored during',
+ + ' Cauchy searches',/,
+ + 'Skip = number of BFGS updates skipped',/,
+ + 'Nact = number of active bounds at final generalized',
+ + ' Cauchy point',/,
+ + 'Projg = norm of the final projected gradient',/,
+ + 'F = final function value',/,/,
+ + ' * * *')
+ 3004 format (/,3x,'N',4x,'Tit',5x,'Tnf',2x,'Tnint',2x,
+ + 'Skip',2x,'Nact',5x,'Projg',8x,'F')
+ 3005 format (i5,2(1x,i6),(1x,i6),(2x,i4),(1x,i5),1p,2(2x,d10.3))
+ 3007 format (/,' Cauchy time',1p,e10.3,' seconds.',/
+ + ' Subspace minimization time',1p,e10.3,' seconds.',/
+ + ' Line search time',1p,e10.3,' seconds.')
+ 3008 format (/,' Total User time',1p,e10.3,' seconds.',/)
+ 3009 format (/,a60)
+ 9011 format (/,
+ +' Matrix in 1st Cholesky factorization in formk is not Pos. Def.')
+ 9012 format (/,
+ +' Matrix in 2st Cholesky factorization in formk is not Pos. Def.')
+ 9013 format (/,
+ +' Matrix in the Cholesky factorization in formt is not Pos. Def.')
+ 9014 format (/,
+ +' Derivative >= 0, backtracking line search impossible.',/,
+ +' Previous x, f and g restored.',/,
+ +' Possible causes: 1 error in function or gradient evaluation;',/,
+ +' 2 rounding errors dominate computation.')
+ 9015 format (/,
+ +' Warning: more than 10 function and gradient',/,
+ +' evaluations in the last line search. Termination',/,
+ +' may possibly be caused by a bad search direction.')
+ 9018 format (/,' The triangular system is singular.')
+ 9019 format (/,
+ +' Line search cannot locate an adequate point after 20 function',/
+ +,' and gradient evaluations. Previous x, f and g restored.',/,
+ +' Possible causes: 1 error in function or gradient evaluation;',/,
+ +' 2 rounding error dominate computation.')
+
+ return
+
+ end
+
+c======================= The end of prn3lb =============================
+
+ subroutine projgr(n, l, u, nbd, x, g, sbgnrm)
+
+ integer n, nbd(n)
+ double precision sbgnrm, x(n), l(n), u(n), g(n)
+
+c ************
+c
+c Subroutine projgr
+c
+c This subroutine computes the infinity norm of the projected
+c gradient.
+c
+c
+c * * *
+c
+c NEOS, November 1994. (Latest revision June 1996.)
+c Optimization Technology Center.
+c Argonne National Laboratory and Northwestern University.
+c Written by
+c Ciyou Zhu
+c in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.
+c
+c
+c ************
+
+ integer i
+ double precision gi
+ double precision one,zero
+ parameter (one=1.0d0,zero=0.0d0)
+
+ sbgnrm = zero
+ do 15 i = 1, n
+ gi = g(i)
+ if (nbd(i) .ne. 0) then
+ if (gi .lt. zero) then
+ if (nbd(i) .ge. 2) gi = max((x(i)-u(i)),gi)
+ else
+ if (nbd(i) .le. 2) gi = min((x(i)-l(i)),gi)
+ endif
+ endif
+ sbgnrm = max(sbgnrm,abs(gi))
+ 15 continue
+
+ return
+
+ end
+
+c======================= The end of projgr =============================
+
+ subroutine subsm ( n, m, nsub, ind, l, u, nbd, x, d, xp, ws, wy,
+ + theta, xx, gg,
+ + col, head, iword, wv, wn, iprint, info )
+ implicit none
+ integer n, m, nsub, col, head, iword, iprint, info,
+ + ind(nsub), nbd(n)
+ double precision theta,
+ + l(n), u(n), x(n), d(n), xp(n), xx(n), gg(n),
+ + ws(n, m), wy(n, m),
+ + wv(2*m), wn(2*m, 2*m)
+
+c **********************************************************************
+c
+c This routine contains the major changes in the updated version.
+c The changes are described in the accompanying paper
+c
+c Jose Luis Morales, Jorge Nocedal
+c "Remark On Algorithm 788: L-BFGS-B: Fortran Subroutines for Large-Scale
+c Bound Constrained Optimization". Decemmber 27, 2010.
+c
+c J.L. Morales Departamento de Matematicas,
+c Instituto Tecnologico Autonomo de Mexico
+c Mexico D.F.
+c
+c J, Nocedal Department of Electrical Engineering and
+c Computer Science.
+c Northwestern University. Evanston, IL. USA
+c
+c January 17, 2011
+c
+c **********************************************************************
+c
+c
+c Subroutine subsm
+c
+c Given xcp, l, u, r, an index set that specifies
+c the active set at xcp, and an l-BFGS matrix B
+c (in terms of WY, WS, SY, WT, head, col, and theta),
+c this subroutine computes an approximate solution
+c of the subspace problem
+c
+c (P) min Q(x) = r'(x-xcp) + 1/2 (x-xcp)' B (x-xcp)
+c
+c subject to l<=x<=u
+c x_i=xcp_i for all i in A(xcp)
+c
+c along the subspace unconstrained Newton direction
+c
+c d = -(Z'BZ)^(-1) r.
+c
+c The formula for the Newton direction, given the L-BFGS matrix
+c and the Sherman-Morrison formula, is
+c
+c d = (1/theta)r + (1/theta*2) Z'WK^(-1)W'Z r.
+c
+c where
+c K = [-D -Y'ZZ'Y/theta L_a'-R_z' ]
+c [L_a -R_z theta*S'AA'S ]
+c
+c Note that this procedure for computing d differs
+c from that described in [1]. One can show that the matrix K is
+c equal to the matrix M^[-1]N in that paper.
+c
+c n is an integer variable.
+c On entry n is the dimension of the problem.
+c On exit n is unchanged.
+c
+c m is an integer variable.
+c On entry m is the maximum number of variable metric corrections
+c used to define the limited memory matrix.
+c On exit m is unchanged.
+c
+c nsub is an integer variable.
+c On entry nsub is the number of free variables.
+c On exit nsub is unchanged.
+c
+c ind is an integer array of dimension nsub.
+c On entry ind specifies the coordinate indices of free variables.
+c On exit ind is unchanged.
+c
+c l is a double precision array of dimension n.
+c On entry l is the lower bound of x.
+c On exit l is unchanged.
+c
+c u is a double precision array of dimension n.
+c On entry u is the upper bound of x.
+c On exit u is unchanged.
+c
+c nbd is a integer array of dimension n.
+c On entry nbd represents the type of bounds imposed on the
+c variables, and must be specified as follows:
+c nbd(i)=0 if x(i) is unbounded,
+c 1 if x(i) has only a lower bound,
+c 2 if x(i) has both lower and upper bounds, and
+c 3 if x(i) has only an upper bound.
+c On exit nbd is unchanged.
+c
+c x is a double precision array of dimension n.
+c On entry x specifies the Cauchy point xcp.
+c On exit x(i) is the minimizer of Q over the subspace of
+c free variables.
+c
+c d is a double precision array of dimension n.
+c On entry d is the reduced gradient of Q at xcp.
+c On exit d is the Newton direction of Q.
+c
+c xp is a double precision array of dimension n.
+c used to safeguard the projected Newton direction
+c
+c xx is a double precision array of dimension n
+c On entry it holds the current iterate
+c On output it is unchanged
+
+c gg is a double precision array of dimension n
+c On entry it holds the gradient at the current iterate
+c On output it is unchanged
+c
+c ws and wy are double precision arrays;
+c theta is a double precision variable;
+c col is an integer variable;
+c head is an integer variable.
+c On entry they store the information defining the
+c limited memory BFGS matrix:
+c ws(n,m) stores S, a set of s-vectors;
+c wy(n,m) stores Y, a set of y-vectors;
+c theta is the scaling factor specifying B_0 = theta I;
+c col is the number of variable metric corrections stored;
+c head is the location of the 1st s- (or y-) vector in S (or Y).
+c On exit they are unchanged.
+c
+c iword is an integer variable.
+c On entry iword is unspecified.
+c On exit iword specifies the status of the subspace solution.
+c iword = 0 if the solution is in the box,
+c 1 if some bound is encountered.
+c
+c wv is a double precision working array of dimension 2m.
+c
+c wn is a double precision array of dimension 2m x 2m.
+c On entry the upper triangle of wn stores the LEL^T factorization
+c of the indefinite matrix
+c
+c K = [-D -Y'ZZ'Y/theta L_a'-R_z' ]
+c [L_a -R_z theta*S'AA'S ]
+c where E = [-I 0]
+c [ 0 I]
+c On exit wn is unchanged.
+c
+c iprint is an INTEGER variable that must be set by the user.
+c It controls the frequency and type of output generated:
+c iprint<0 no output is generated;
+c iprint=0 print only one line at the last iteration;
+c 0<iprint<99 print also f and |proj g| every iprint iterations;
+c iprint=99 print details of every iteration except n-vectors;
+c iprint=100 print also the changes of active set and final x;
+c iprint>100 print details of every iteration including x and g;
+c When iprint > 0, the file iterate.dat will be created to
+c summarize the iteration.
+c
+c info is an integer variable.
+c On entry info is unspecified.
+c On exit info = 0 for normal return,
+c = nonzero for abnormal return
+c when the matrix K is ill-conditioned.
+c
+c Subprograms called:
+c
+c Linpack dtrsl.
+c
+c
+c References:
+c
+c [1] R. H. Byrd, P. Lu, J. Nocedal and C. Zhu, ``A limited
+c memory algorithm for bound constrained optimization'',
+c SIAM J. Scientific Computing 16 (1995), no. 5, pp. 1190--1208.
+c
+c
+c
+c * * *
+c
+c NEOS, November 1994. (Latest revision June 1996.)
+c Optimization Technology Center.
+c Argonne National Laboratory and Northwestern University.
+c Written by
+c Ciyou Zhu
+c in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.
+c
+c
+c ************
+
+ integer pointr,m2,col2,ibd,jy,js,i,j,k
+ double precision alpha, xk, dk, temp1, temp2
+ double precision one,zero
+ parameter (one=1.0d0,zero=0.0d0)
+c
+ double precision dd_p
+
+ if (nsub .le. 0) return
+ if (iprint .ge. 99) write (6,1001)
+
+c Compute wv = W'Zd.
+
+ pointr = head
+ do 20 i = 1, col
+ temp1 = zero
+ temp2 = zero
+ do 10 j = 1, nsub
+ k = ind(j)
+ temp1 = temp1 + wy(k,pointr)*d(j)
+ temp2 = temp2 + ws(k,pointr)*d(j)
+ 10 continue
+ wv(i) = temp1
+ wv(col + i) = theta*temp2
+ pointr = mod(pointr,m) + 1
+ 20 continue
+
+c Compute wv:=K^(-1)wv.
+
+ m2 = 2*m
+ col2 = 2*col
+ call dtrsl(wn,m2,col2,wv,11,info)
+ if (info .ne. 0) return
+ do 25 i = 1, col
+ wv(i) = -wv(i)
+ 25 continue
+ call dtrsl(wn,m2,col2,wv,01,info)
+ if (info .ne. 0) return
+
+c Compute d = (1/theta)d + (1/theta**2)Z'W wv.
+
+ pointr = head
+ do 40 jy = 1, col
+ js = col + jy
+ do 30 i = 1, nsub
+ k = ind(i)
+ d(i) = d(i) + wy(k,pointr)*wv(jy)/theta
+ + + ws(k,pointr)*wv(js)
+ 30 continue
+ pointr = mod(pointr,m) + 1
+ 40 continue
+
+ call dscal( nsub, one/theta, d, 1 )
+c
+c-----------------------------------------------------------------
+c Let us try the projection, d is the Newton direction
+
+ iword = 0
+
+ call dcopy ( n, x, 1, xp, 1 )
+c
+ do 50 i=1, nsub
+ k = ind(i)
+ dk = d(i)
+ xk = x(k)
+ if ( nbd(k) .ne. 0 ) then
+c
+ if ( nbd(k).eq.1 ) then ! lower bounds only
+ x(k) = max( l(k), xk + dk )
+ if ( x(k).eq.l(k) ) iword = 1
+ else
+c
+ if ( nbd(k).eq.2 ) then ! upper and lower bounds
+ xk = max( l(k), xk + dk )
+ x(k) = min( u(k), xk )
+ if ( x(k).eq.l(k) .or. x(k).eq.u(k) ) iword = 1
+ else
+c
+ if ( nbd(k).eq.3 ) then ! upper bounds only
+ x(k) = min( u(k), xk + dk )
+ if ( x(k).eq.u(k) ) iword = 1
+ end if
+ end if
+ end if
+c
+ else ! free variables
+ x(k) = xk + dk
+ end if
+ 50 continue
+c
+ if ( iword.eq.0 ) then
+ go to 911
+ end if
+c
+c check sign of the directional derivative
+c
+ dd_p = zero
+ do 55 i=1, n
+ dd_p = dd_p + (x(i) - xx(i))*gg(i)
+ 55 continue
+ if ( dd_p .gt.zero ) then
+ call dcopy( n, xp, 1, x, 1 )
+ write(6,*) ' Positive dir derivative in projection '
+ write(6,*) ' Using the backtracking step '
+ else
+ go to 911
+ endif
+c
+c-----------------------------------------------------------------
+c
+ alpha = one
+ temp1 = alpha
+ ibd = 0
+ do 60 i = 1, nsub
+ k = ind(i)
+ dk = d(i)
+ if (nbd(k) .ne. 0) then
+ if (dk .lt. zero .and. nbd(k) .le. 2) then
+ temp2 = l(k) - x(k)
+ if (temp2 .ge. zero) then
+ temp1 = zero
+ else if (dk*alpha .lt. temp2) then
+ temp1 = temp2/dk
+ endif
+ else if (dk .gt. zero .and. nbd(k) .ge. 2) then
+ temp2 = u(k) - x(k)
+ if (temp2 .le. zero) then
+ temp1 = zero
+ else if (dk*alpha .gt. temp2) then
+ temp1 = temp2/dk
+ endif
+ endif
+ if (temp1 .lt. alpha) then
+ alpha = temp1
+ ibd = i
+ endif
+ endif
+ 60 continue
+
+ if (alpha .lt. one) then
+ dk = d(ibd)
+ k = ind(ibd)
+ if (dk .gt. zero) then
+ x(k) = u(k)
+ d(ibd) = zero
+ else if (dk .lt. zero) then
+ x(k) = l(k)
+ d(ibd) = zero
+ endif
+ endif
+ do 70 i = 1, nsub
+ k = ind(i)
+ x(k) = x(k) + alpha*d(i)
+ 70 continue
+cccccc
+ 911 continue
+
+ if (iprint .ge. 99) write (6,1004)
+
+ 1001 format (/,'----------------SUBSM entered-----------------',/)
+ 1004 format (/,'----------------exit SUBSM --------------------',/)
+
+ return
+
+ end
+c====================== The end of subsm ===============================
+
+ subroutine dcsrch(f,g,stp,ftol,gtol,xtol,stpmin,stpmax,
+ + task,isave,dsave)
+ character*(*) task
+ integer isave(2)
+ double precision f,g,stp,ftol,gtol,xtol,stpmin,stpmax
+ double precision dsave(13)
+c **********
+c
+c Subroutine dcsrch
+c
+c This subroutine finds a step that satisfies a sufficient
+c decrease condition and a curvature condition.
+c
+c Each call of the subroutine updates an interval with
+c endpoints stx and sty. The interval is initially chosen
+c so that it contains a minimizer of the modified function
+c
+c psi(stp) = f(stp) - f(0) - ftol*stp*f'(0).
+c
+c If psi(stp) <= 0 and f'(stp) >= 0 for some step, then the
+c interval is chosen so that it contains a minimizer of f.
+c
+c The algorithm is designed to find a step that satisfies
+c the sufficient decrease condition
+c
+c f(stp) <= f(0) + ftol*stp*f'(0),
+c
+c and the curvature condition
+c
+c abs(f'(stp)) <= gtol*abs(f'(0)).
+c
+c If ftol is less than gtol and if, for example, the function
+c is bounded below, then there is always a step which satisfies
+c both conditions.
+c
+c If no step can be found that satisfies both conditions, then
+c the algorithm stops with a warning. In this case stp only
+c satisfies the sufficient decrease condition.
+c
+c A typical invocation of dcsrch has the following outline:
+c
+c task = 'START'
+c 10 continue
+c call dcsrch( ... )
+c if (task .eq. 'FG') then
+c Evaluate the function and the gradient at stp
+c goto 10
+c end if
+c
+c NOTE: The user must no alter work arrays between calls.
+c
+c The subroutine statement is
+c
+c subroutine dcsrch(f,g,stp,ftol,gtol,xtol,stpmin,stpmax,
+c task,isave,dsave)
+c where
+c
+c f is a double precision variable.
+c On initial entry f is the value of the function at 0.
+c On subsequent entries f is the value of the
+c function at stp.
+c On exit f is the value of the function at stp.
+c
+c g is a double precision variable.
+c On initial entry g is the derivative of the function at 0.
+c On subsequent entries g is the derivative of the
+c function at stp.
+c On exit g is the derivative of the function at stp.
+c
+c stp is a double precision variable.
+c On entry stp is the current estimate of a satisfactory
+c step. On initial entry, a positive initial estimate
+c must be provided.
+c On exit stp is the current estimate of a satisfactory step
+c if task = 'FG'. If task = 'CONV' then stp satisfies
+c the sufficient decrease and curvature condition.
+c
+c ftol is a double precision variable.
+c On entry ftol specifies a nonnegative tolerance for the
+c sufficient decrease condition.
+c On exit ftol is unchanged.
+c
+c gtol is a double precision variable.
+c On entry gtol specifies a nonnegative tolerance for the
+c curvature condition.
+c On exit gtol is unchanged.
+c
+c xtol is a double precision variable.
+c On entry xtol specifies a nonnegative relative tolerance
+c for an acceptable step. The subroutine exits with a
+c warning if the relative difference between sty and stx
+c is less than xtol.
+c On exit xtol is unchanged.
+c
+c stpmin is a double precision variable.
+c On entry stpmin is a nonnegative lower bound for the step.
+c On exit stpmin is unchanged.
+c
+c stpmax is a double precision variable.
+c On entry stpmax is a nonnegative upper bound for the step.
+c On exit stpmax is unchanged.
+c
+c task is a character variable of length at least 60.
+c On initial entry task must be set to 'START'.
+c On exit task indicates the required action:
+c
+c If task(1:2) = 'FG' then evaluate the function and
+c derivative at stp and call dcsrch again.
+c
+c If task(1:4) = 'CONV' then the search is successful.
+c
+c If task(1:4) = 'WARN' then the subroutine is not able
+c to satisfy the convergence conditions. The exit value of
+c stp contains the best point found during the search.
+c
+c If task(1:5) = 'ERROR' then there is an error in the
+c input arguments.
+c
+c On exit with convergence, a warning or an error, the
+c variable task contains additional information.
+c
+c isave is an integer work array of dimension 2.
+c
+c dsave is a double precision work array of dimension 13.
+c
+c Subprograms called
+c
+c MINPACK-2 ... dcstep
+c
+c MINPACK-1 Project. June 1983.
+c Argonne National Laboratory.
+c Jorge J. More' and David J. Thuente.
+c
+c MINPACK-2 Project. October 1993.
+c Argonne National Laboratory and University of Minnesota.
+c Brett M. Averick, Richard G. Carter, and Jorge J. More'.
+c
+c **********
+ double precision zero,p5,p66
+ parameter(zero=0.0d0,p5=0.5d0,p66=0.66d0)
+ double precision xtrapl,xtrapu
+ parameter(xtrapl=1.1d0,xtrapu=4.0d0)
+
+ logical brackt
+ integer stage
+ double precision finit,ftest,fm,fx,fxm,fy,fym,ginit,gtest,
+ + gm,gx,gxm,gy,gym,stx,sty,stmin,stmax,width,width1
+
+c Initialization block.
+
+ if (task(1:5) .eq. 'START') then
+
+c Check the input arguments for errors.
+
+ if (stp .lt. stpmin) task = 'ERROR: STP .LT. STPMIN'
+ if (stp .gt. stpmax) task = 'ERROR: STP .GT. STPMAX'
+ if (g .ge. zero) task = 'ERROR: INITIAL G .GE. ZERO'
+ if (ftol .lt. zero) task = 'ERROR: FTOL .LT. ZERO'
+ if (gtol .lt. zero) task = 'ERROR: GTOL .LT. ZERO'
+ if (xtol .lt. zero) task = 'ERROR: XTOL .LT. ZERO'
+ if (stpmin .lt. zero) task = 'ERROR: STPMIN .LT. ZERO'
+ if (stpmax .lt. stpmin) task = 'ERROR: STPMAX .LT. STPMIN'
+
+c Exit if there are errors on input.
+
+ if (task(1:5) .eq. 'ERROR') return
+
+c Initialize local variables.
+
+ brackt = .false.
+ stage = 1
+ finit = f
+ ginit = g
+ gtest = ftol*ginit
+ width = stpmax - stpmin
+ width1 = width/p5
+
+c The variables stx, fx, gx contain the values of the step,
+c function, and derivative at the best step.
+c The variables sty, fy, gy contain the value of the step,
+c function, and derivative at sty.
+c The variables stp, f, g contain the values of the step,
+c function, and derivative at stp.
+
+ stx = zero
+ fx = finit
+ gx = ginit
+ sty = zero
+ fy = finit
+ gy = ginit
+ stmin = zero
+ stmax = stp + xtrapu*stp
+ task = 'FG'
+
+ goto 1000
+
+ else
+
+c Restore local variables.
+
+ if (isave(1) .eq. 1) then
+ brackt = .true.
+ else
+ brackt = .false.
+ endif
+ stage = isave(2)
+ ginit = dsave(1)
+ gtest = dsave(2)
+ gx = dsave(3)
+ gy = dsave(4)
+ finit = dsave(5)
+ fx = dsave(6)
+ fy = dsave(7)
+ stx = dsave(8)
+ sty = dsave(9)
+ stmin = dsave(10)
+ stmax = dsave(11)
+ width = dsave(12)
+ width1 = dsave(13)
+
+ endif
+
+c If psi(stp) <= 0 and f'(stp) >= 0 for some step, then the
+c algorithm enters the second stage.
+
+ ftest = finit + stp*gtest
+ if (stage .eq. 1 .and. f .le. ftest .and. g .ge. zero)
+ + stage = 2
+
+c Test for warnings.
+
+ if (brackt .and. (stp .le. stmin .or. stp .ge. stmax))
+ + task = 'WARNING: ROUNDING ERRORS PREVENT PROGRESS'
+ if (brackt .and. stmax - stmin .le. xtol*stmax)
+ + task = 'WARNING: XTOL TEST SATISFIED'
+ if (stp .eq. stpmax .and. f .le. ftest .and. g .le. gtest)
+ + task = 'WARNING: STP = STPMAX'
+ if (stp .eq. stpmin .and. (f .gt. ftest .or. g .ge. gtest))
+ + task = 'WARNING: STP = STPMIN'
+
+c Test for convergence.
+
+ if (f .le. ftest .and. abs(g) .le. gtol*(-ginit))
+ + task = 'CONVERGENCE'
+
+c Test for termination.
+
+ if (task(1:4) .eq. 'WARN' .or. task(1:4) .eq. 'CONV') goto 1000
+
+c A modified function is used to predict the step during the
+c first stage if a lower function value has been obtained but
+c the decrease is not sufficient.
+
+ if (stage .eq. 1 .and. f .le. fx .and. f .gt. ftest) then
+
+c Define the modified function and derivative values.
+
+ fm = f - stp*gtest
+ fxm = fx - stx*gtest
+ fym = fy - sty*gtest
+ gm = g - gtest
+ gxm = gx - gtest
+ gym = gy - gtest
+
+c Call dcstep to update stx, sty, and to compute the new step.
+
+ call dcstep(stx,fxm,gxm,sty,fym,gym,stp,fm,gm,
+ + brackt,stmin,stmax)
+
+c Reset the function and derivative values for f.
+
+ fx = fxm + stx*gtest
+ fy = fym + sty*gtest
+ gx = gxm + gtest
+ gy = gym + gtest
+
+ else
+
+c Call dcstep to update stx, sty, and to compute the new step.
+
+ call dcstep(stx,fx,gx,sty,fy,gy,stp,f,g,
+ + brackt,stmin,stmax)
+
+ endif
+
+c Decide if a bisection step is needed.
+
+ if (brackt) then
+ if (abs(sty-stx) .ge. p66*width1) stp = stx + p5*(sty - stx)
+ width1 = width
+ width = abs(sty-stx)
+ endif
+
+c Set the minimum and maximum steps allowed for stp.
+
+ if (brackt) then
+ stmin = min(stx,sty)
+ stmax = max(stx,sty)
+ else
+ stmin = stp + xtrapl*(stp - stx)
+ stmax = stp + xtrapu*(stp - stx)
+ endif
+
+c Force the step to be within the bounds stpmax and stpmin.
+
+ stp = max(stp,stpmin)
+ stp = min(stp,stpmax)
+
+c If further progress is not possible, let stp be the best
+c point obtained during the search.
+
+ if (brackt .and. (stp .le. stmin .or. stp .ge. stmax)
+ + .or. (brackt .and. stmax-stmin .le. xtol*stmax)) stp = stx
+
+c Obtain another function and derivative.
+
+ task = 'FG'
+
+ 1000 continue
+
+c Save local variables.
+
+ if (brackt) then
+ isave(1) = 1
+ else
+ isave(1) = 0
+ endif
+ isave(2) = stage
+ dsave(1) = ginit
+ dsave(2) = gtest
+ dsave(3) = gx
+ dsave(4) = gy
+ dsave(5) = finit
+ dsave(6) = fx
+ dsave(7) = fy
+ dsave(8) = stx
+ dsave(9) = sty
+ dsave(10) = stmin
+ dsave(11) = stmax
+ dsave(12) = width
+ dsave(13) = width1
+
+ return
+ end
+
+c====================== The end of dcsrch ==============================
+
+ subroutine dcstep(stx,fx,dx,sty,fy,dy,stp,fp,dp,brackt,
+ + stpmin,stpmax)
+ logical brackt
+ double precision stx,fx,dx,sty,fy,dy,stp,fp,dp,stpmin,stpmax
+c **********
+c
+c Subroutine dcstep
+c
+c This subroutine computes a safeguarded step for a search
+c procedure and updates an interval that contains a step that
+c satisfies a sufficient decrease and a curvature condition.
+c
+c The parameter stx contains the step with the least function
+c value. If brackt is set to .true. then a minimizer has
+c been bracketed in an interval with endpoints stx and sty.
+c The parameter stp contains the current step.
+c The subroutine assumes that if brackt is set to .true. then
+c
+c min(stx,sty) < stp < max(stx,sty),
+c
+c and that the derivative at stx is negative in the direction
+c of the step.
+c
+c The subroutine statement is
+c
+c subroutine dcstep(stx,fx,dx,sty,fy,dy,stp,fp,dp,brackt,
+c stpmin,stpmax)
+c
+c where
+c
+c stx is a double precision variable.
+c On entry stx is the best step obtained so far and is an
+c endpoint of the interval that contains the minimizer.
+c On exit stx is the updated best step.
+c
+c fx is a double precision variable.
+c On entry fx is the function at stx.
+c On exit fx is the function at stx.
+c
+c dx is a double precision variable.
+c On entry dx is the derivative of the function at
+c stx. The derivative must be negative in the direction of
+c the step, that is, dx and stp - stx must have opposite
+c signs.
+c On exit dx is the derivative of the function at stx.
+c
+c sty is a double precision variable.
+c On entry sty is the second endpoint of the interval that
+c contains the minimizer.
+c On exit sty is the updated endpoint of the interval that
+c contains the minimizer.
+c
+c fy is a double precision variable.
+c On entry fy is the function at sty.
+c On exit fy is the function at sty.
+c
+c dy is a double precision variable.
+c On entry dy is the derivative of the function at sty.
+c On exit dy is the derivative of the function at the exit sty.
+c
+c stp is a double precision variable.
+c On entry stp is the current step. If brackt is set to .true.
+c then on input stp must be between stx and sty.
+c On exit stp is a new trial step.
+c
+c fp is a double precision variable.
+c On entry fp is the function at stp
+c On exit fp is unchanged.
+c
+c dp is a double precision variable.
+c On entry dp is the the derivative of the function at stp.
+c On exit dp is unchanged.
+c
+c brackt is an logical variable.
+c On entry brackt specifies if a minimizer has been bracketed.
+c Initially brackt must be set to .false.
+c On exit brackt specifies if a minimizer has been bracketed.
+c When a minimizer is bracketed brackt is set to .true.
+c
+c stpmin is a double precision variable.
+c On entry stpmin is a lower bound for the step.
+c On exit stpmin is unchanged.
+c
+c stpmax is a double precision variable.
+c On entry stpmax is an upper bound for the step.
+c On exit stpmax is unchanged.
+c
+c MINPACK-1 Project. June 1983
+c Argonne National Laboratory.
+c Jorge J. More' and David J. Thuente.
+c
+c MINPACK-2 Project. October 1993.
+c Argonne National Laboratory and University of Minnesota.
+c Brett M. Averick and Jorge J. More'.
+c
+c **********
+ double precision zero,p66,two,three
+ parameter(zero=0.0d0,p66=0.66d0,two=2.0d0,three=3.0d0)
+
+ double precision gamma,p,q,r,s,sgnd,stpc,stpf,stpq,theta
+
+ sgnd = dp*(dx/abs(dx))
+
+c First case: A higher function value. The minimum is bracketed.
+c If the cubic step is closer to stx than the quadratic step, the
+c cubic step is taken, otherwise the average of the cubic and
+c quadratic steps is taken.
+
+ if (fp .gt. fx) then
+ theta = three*(fx - fp)/(stp - stx) + dx + dp
+ s = max(abs(theta),abs(dx),abs(dp))
+ gamma = s*sqrt((theta/s)**2 - (dx/s)*(dp/s))
+ if (stp .lt. stx) gamma = -gamma
+ p = (gamma - dx) + theta
+ q = ((gamma - dx) + gamma) + dp
+ r = p/q
+ stpc = stx + r*(stp - stx)
+ stpq = stx + ((dx/((fx - fp)/(stp - stx) + dx))/two)*
+ + (stp - stx)
+ if (abs(stpc-stx) .lt. abs(stpq-stx)) then
+ stpf = stpc
+ else
+ stpf = stpc + (stpq - stpc)/two
+ endif
+ brackt = .true.
+
+c Second case: A lower function value and derivatives of opposite
+c sign. The minimum is bracketed. If the cubic step is farther from
+c stp than the secant step, the cubic step is taken, otherwise the
+c secant step is taken.
+
+ else if (sgnd .lt. zero) then
+ theta = three*(fx - fp)/(stp - stx) + dx + dp
+ s = max(abs(theta),abs(dx),abs(dp))
+ gamma = s*sqrt((theta/s)**2 - (dx/s)*(dp/s))
+ if (stp .gt. stx) gamma = -gamma
+ p = (gamma - dp) + theta
+ q = ((gamma - dp) + gamma) + dx
+ r = p/q
+ stpc = stp + r*(stx - stp)
+ stpq = stp + (dp/(dp - dx))*(stx - stp)
+ if (abs(stpc-stp) .gt. abs(stpq-stp)) then
+ stpf = stpc
+ else
+ stpf = stpq
+ endif
+ brackt = .true.
+
+c Third case: A lower function value, derivatives of the same sign,
+c and the magnitude of the derivative decreases.
+
+ else if (abs(dp) .lt. abs(dx)) then
+
+c The cubic step is computed only if the cubic tends to infinity
+c in the direction of the step or if the minimum of the cubic
+c is beyond stp. Otherwise the cubic step is defined to be the
+c secant step.
+
+ theta = three*(fx - fp)/(stp - stx) + dx + dp
+ s = max(abs(theta),abs(dx),abs(dp))
+
+c The case gamma = 0 only arises if the cubic does not tend
+c to infinity in the direction of the step.
+
+ gamma = s*sqrt(max(zero,(theta/s)**2-(dx/s)*(dp/s)))
+ if (stp .gt. stx) gamma = -gamma
+ p = (gamma - dp) + theta
+ q = (gamma + (dx - dp)) + gamma
+ r = p/q
+ if (r .lt. zero .and. gamma .ne. zero) then
+ stpc = stp + r*(stx - stp)
+ else if (stp .gt. stx) then
+ stpc = stpmax
+ else
+ stpc = stpmin
+ endif
+ stpq = stp + (dp/(dp - dx))*(stx - stp)
+
+ if (brackt) then
+
+c A minimizer has been bracketed. If the cubic step is
+c closer to stp than the secant step, the cubic step is
+c taken, otherwise the secant step is taken.
+
+ if (abs(stpc-stp) .lt. abs(stpq-stp)) then
+ stpf = stpc
+ else
+ stpf = stpq
+ endif
+ if (stp .gt. stx) then
+ stpf = min(stp+p66*(sty-stp),stpf)
+ else
+ stpf = max(stp+p66*(sty-stp),stpf)
+ endif
+ else
+
+c A minimizer has not been bracketed. If the cubic step is
+c farther from stp than the secant step, the cubic step is
+c taken, otherwise the secant step is taken.
+
+ if (abs(stpc-stp) .gt. abs(stpq-stp)) then
+ stpf = stpc
+ else
+ stpf = stpq
+ endif
+ stpf = min(stpmax,stpf)
+ stpf = max(stpmin,stpf)
+ endif
+
+c Fourth case: A lower function value, derivatives of the same sign,
+c and the magnitude of the derivative does not decrease. If the
+c minimum is not bracketed, the step is either stpmin or stpmax,
+c otherwise the cubic step is taken.
+
+ else
+ if (brackt) then
+ theta = three*(fp - fy)/(sty - stp) + dy + dp
+ s = max(abs(theta),abs(dy),abs(dp))
+ gamma = s*sqrt((theta/s)**2 - (dy/s)*(dp/s))
+ if (stp .gt. sty) gamma = -gamma
+ p = (gamma - dp) + theta
+ q = ((gamma - dp) + gamma) + dy
+ r = p/q
+ stpc = stp + r*(sty - stp)
+ stpf = stpc
+ else if (stp .gt. stx) then
+ stpf = stpmax
+ else
+ stpf = stpmin
+ endif
+ endif
+
+c Update the interval which contains a minimizer.
+
+ if (fp .gt. fx) then
+ sty = stp
+ fy = fp
+ dy = dp
+ else
+ if (sgnd .lt. zero) then
+ sty = stx
+ fy = fx
+ dy = dx
+ endif
+ stx = stp
+ fx = fp
+ dx = dp
+ endif
+
+c Compute the new step.
+
+ stp = stpf
+
+ return
+ end
+
diff --git a/ccx_2.9/src/limit_case_calc.f b/ccx_2.10/src/limit_case_calc.f
similarity index 100%
rename from ccx_2.9/src/limit_case_calc.f
rename to ccx_2.10/src/limit_case_calc.f
diff --git a/ccx_2.9/src/linel.f b/ccx_2.10/src/linel.f
similarity index 100%
rename from ccx_2.9/src/linel.f
rename to ccx_2.10/src/linel.f
diff --git a/ccx_2.9/src/linkdissimilar.f b/ccx_2.10/src/linkdissimilar.f
similarity index 100%
rename from ccx_2.9/src/linkdissimilar.f
rename to ccx_2.10/src/linkdissimilar.f
diff --git a/ccx_2.10/src/linpack.f b/ccx_2.10/src/linpack.f
new file mode 100644
index 0000000..c737987
--- /dev/null
+++ b/ccx_2.10/src/linpack.f
@@ -0,0 +1,218 @@
+c
+c L-BFGS-B is released under the “New BSD License” (aka “Modified BSD License”
+c or “3-clause license”)
+c Please read attached file License.txt
+c
+ subroutine dpofa(a,lda,n,info)
+ integer lda,n,info
+ double precision a(lda,*)
+c
+c dpofa factors a double precision symmetric positive definite
+c matrix.
+c
+c dpofa is usually called by dpoco, but it can be called
+c directly with a saving in time if rcond is not needed.
+c (time for dpoco) = (1 + 18/n)*(time for dpofa) .
+c
+c on entry
+c
+c a double precision(lda, n)
+c the symmetric matrix to be factored. only the
+c diagonal and upper triangle are used.
+c
+c lda integer
+c the leading dimension of the array a .
+c
+c n integer
+c the order of the matrix a .
+c
+c on return
+c
+c a an upper triangular matrix r so that a = trans(r)*r
+c where trans(r) is the transpose.
+c the strict lower triangle is unaltered.
+c if info .ne. 0 , the factorization is not complete.
+c
+c info integer
+c = 0 for normal return.
+c = k signals an error condition. the leading minor
+c of order k is not positive definite.
+c
+c linpack. this version dated 08/14/78 .
+c cleve moler, university of new mexico, argonne national lab.
+c
+c subroutines and functions
+c
+c blas ddot
+c fortran sqrt
+c
+c internal variables
+c
+ double precision ddot,t
+ double precision s
+ integer j,jm1,k
+c begin block with ...exits to 40
+c
+c
+ do 30 j = 1, n
+ info = j
+ s = 0.0d0
+ jm1 = j - 1
+ if (jm1 .lt. 1) go to 20
+ do 10 k = 1, jm1
+ t = a(k,j) - ddot(k-1,a(1,k),1,a(1,j),1)
+ t = t/a(k,k)
+ a(k,j) = t
+ s = s + t*t
+ 10 continue
+ 20 continue
+ s = a(j,j) - s
+c ......exit
+ if (s .le. 0.0d0) go to 40
+ a(j,j) = sqrt(s)
+ 30 continue
+ info = 0
+ 40 continue
+ return
+ end
+
+c====================== The end of dpofa ===============================
+
+ subroutine dtrsl(t,ldt,n,b,job,info)
+ integer ldt,n,job,info
+ double precision t(ldt,*),b(*)
+c
+c
+c dtrsl solves systems of the form
+c
+c t * x = b
+c or
+c trans(t) * x = b
+c
+c where t is a triangular matrix of order n. here trans(t)
+c denotes the transpose of the matrix t.
+c
+c on entry
+c
+c t double precision(ldt,n)
+c t contains the matrix of the system. the zero
+c elements of the matrix are not referenced, and
+c the corresponding elements of the array can be
+c used to store other information.
+c
+c ldt integer
+c ldt is the leading dimension of the array t.
+c
+c n integer
+c n is the order of the system.
+c
+c b double precision(n).
+c b contains the right hand side of the system.
+c
+c job integer
+c job specifies what kind of system is to be solved.
+c if job is
+c
+c 00 solve t*x=b, t lower triangular,
+c 01 solve t*x=b, t upper triangular,
+c 10 solve trans(t)*x=b, t lower triangular,
+c 11 solve trans(t)*x=b, t upper triangular.
+c
+c on return
+c
+c b b contains the solution, if info .eq. 0.
+c otherwise b is unaltered.
+c
+c info integer
+c info contains zero if the system is nonsingular.
+c otherwise info contains the index of
+c the first zero diagonal element of t.
+c
+c linpack. this version dated 08/14/78 .
+c g. w. stewart, university of maryland, argonne national lab.
+c
+c subroutines and functions
+c
+c blas daxpy,ddot
+c fortran mod
+c
+c internal variables
+c
+ double precision ddot,temp
+ integer case,j,jj
+c
+c begin block permitting ...exits to 150
+c
+c check for zero diagonal elements.
+c
+ do 10 info = 1, n
+c ......exit
+ if (t(info,info) .eq. 0.0d0) go to 150
+ 10 continue
+ info = 0
+c
+c determine the task and go to it.
+c
+ case = 1
+ if (mod(job,10) .ne. 0) case = 2
+ if (mod(job,100)/10 .ne. 0) case = case + 2
+ go to (20,50,80,110), case
+c
+c solve t*x=b for t lower triangular
+c
+ 20 continue
+ b(1) = b(1)/t(1,1)
+ if (n .lt. 2) go to 40
+ do 30 j = 2, n
+ temp = -b(j-1)
+ call daxpy(n-j+1,temp,t(j,j-1),1,b(j),1)
+ b(j) = b(j)/t(j,j)
+ 30 continue
+ 40 continue
+ go to 140
+c
+c solve t*x=b for t upper triangular.
+c
+ 50 continue
+ b(n) = b(n)/t(n,n)
+ if (n .lt. 2) go to 70
+ do 60 jj = 2, n
+ j = n - jj + 1
+ temp = -b(j+1)
+ call daxpy(j,temp,t(1,j+1),1,b(1),1)
+ b(j) = b(j)/t(j,j)
+ 60 continue
+ 70 continue
+ go to 140
+c
+c solve trans(t)*x=b for t lower triangular.
+c
+ 80 continue
+ b(n) = b(n)/t(n,n)
+ if (n .lt. 2) go to 100
+ do 90 jj = 2, n
+ j = n - jj + 1
+ b(j) = b(j) - ddot(jj-1,t(j+1,j),1,b(j+1),1)
+ b(j) = b(j)/t(j,j)
+ 90 continue
+ 100 continue
+ go to 140
+c
+c solve trans(t)*x=b for t upper triangular.
+c
+ 110 continue
+ b(1) = b(1)/t(1,1)
+ if (n .lt. 2) go to 130
+ do 120 j = 2, n
+ b(j) = b(j) - ddot(j-1,t(1,j),1,b(1),1)
+ b(j) = b(j)/t(j,j)
+ 120 continue
+ 130 continue
+ 140 continue
+ 150 continue
+ return
+ end
+
+c====================== The end of dtrsl ===============================
+
+
diff --git a/ccx_2.9/src/linscal.f b/ccx_2.10/src/linscal.f
similarity index 100%
rename from ccx_2.9/src/linscal.f
rename to ccx_2.10/src/linscal.f
diff --git a/ccx_2.9/src/linstatic.c b/ccx_2.10/src/linstatic.c
similarity index 96%
rename from ccx_2.9/src/linstatic.c
rename to ccx_2.10/src/linstatic.c
index e12eefe..74c4069 100644
--- a/ccx_2.9/src/linstatic.c
+++ b/ccx_2.10/src/linstatic.c
@@ -68,7 +68,7 @@ void linstatic(double *co, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
ITG *istep,ITG *nmat,ITG *ielprop,double *prop,char *typeboun,
ITG *mortar,ITG *mpcinfo,double *tietol,ITG *ics,ITG *icontact){
- char description[13]=" ",*lakon=NULL;
+ char description[13]=" ",*lakon=NULL,stiffmatrix[132]="";
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,
@@ -97,6 +97,8 @@ void linstatic(double *co, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
*areaslav=NULL,*xmastnor=NULL,theta=0.,*ener=NULL,*xstate=NULL,
*fnext=NULL,*energyini=NULL,*energy=NULL;
+ FILE *f1;
+
#ifdef SGI
ITG token;
#endif
@@ -348,24 +350,6 @@ void linstatic(double *co, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
NNEW(au,double,*nzs);
nmethodl=*nmethod;
}
-
-
-/* FORTRAN(mafillsm,(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));*/
mafillsmmain(co,nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,xbounact,nboun,
ipompc,nodempc,coefmpc,nmpc,nodeforc,ndirforc,xforcact,
@@ -621,6 +605,35 @@ void linstatic(double *co, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
#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 */
+
+ 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 */
@@ -640,8 +653,8 @@ void linstatic(double *co, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
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);
+ 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,
diff --git a/ccx_2.9/src/lintemp.f b/ccx_2.10/src/lintemp.f
similarity index 100%
rename from ccx_2.9/src/lintemp.f
rename to ccx_2.10/src/lintemp.f
diff --git a/ccx_2.9/src/lintemp_th.f b/ccx_2.10/src/lintemp_th.f
similarity index 100%
rename from ccx_2.9/src/lintemp_th.f
rename to ccx_2.10/src/lintemp_th.f
diff --git a/ccx_2.9/src/linvec.f b/ccx_2.10/src/linvec.f
similarity index 100%
rename from ccx_2.9/src/linvec.f
rename to ccx_2.10/src/linvec.f
diff --git a/ccx_2.9/src/liquidchannel.f b/ccx_2.10/src/liquidchannel.f
similarity index 100%
rename from ccx_2.9/src/liquidchannel.f
rename to ccx_2.10/src/liquidchannel.f
diff --git a/ccx_2.9/src/liquidpipe.f b/ccx_2.10/src/liquidpipe.f
similarity index 100%
rename from ccx_2.9/src/liquidpipe.f
rename to ccx_2.10/src/liquidpipe.f
diff --git a/ccx_2.9/src/liquidpump.f b/ccx_2.10/src/liquidpump.f
similarity index 100%
rename from ccx_2.9/src/liquidpump.f
rename to ccx_2.10/src/liquidpump.f
diff --git a/ccx_2.9/src/loadadd.f b/ccx_2.10/src/loadadd.f
similarity index 100%
rename from ccx_2.9/src/loadadd.f
rename to ccx_2.10/src/loadadd.f
diff --git a/ccx_2.9/src/loadaddp.f b/ccx_2.10/src/loadaddp.f
similarity index 100%
rename from ccx_2.9/src/loadaddp.f
rename to ccx_2.10/src/loadaddp.f
diff --git a/ccx_2.9/src/loadaddt.f b/ccx_2.10/src/loadaddt.f
similarity index 100%
rename from ccx_2.9/src/loadaddt.f
rename to ccx_2.10/src/loadaddt.f
diff --git a/ccx_2.9/src/machpi.f b/ccx_2.10/src/machpi.f
similarity index 100%
rename from ccx_2.9/src/machpi.f
rename to ccx_2.10/src/machpi.f
diff --git a/ccx_2.9/src/mafillcorio.f b/ccx_2.10/src/mafillcorio.f
similarity index 93%
rename from ccx_2.9/src/mafillcorio.f
rename to ccx_2.10/src/mafillcorio.f
index 43608be..1da1406 100644
--- a/ccx_2.9/src/mafillcorio.f
+++ b/ccx_2.10/src/mafillcorio.f
@@ -26,7 +26,7 @@
& t0,t1,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)
+ & matname,mi,ncmat_,ttime,time,istep,iinc,ibody,ielprop,prop)
!
! filling the damping matrix in spare matrix format (sm)
!
@@ -39,24 +39,18 @@
integer kon(*),nodeboun(*),ndirboun(*),ipompc(*),nodempc(3,*),
& nodeforc(2,*),ndirforc(*),nelemload(2,*),icol(*),jq(*),ikmpc(*),
& ilmpc(*),ikboun(*),ilboun(*),mi(*),nactdof(0:mi(2),*),konl(20),
- & irow(*),
- & nelcon(2,*),nrhcon(*),nalcon(2,*),ielmat(mi(3),*),
- & ielorien(mi(3),*),
- & ipkon(*),ipobody(2,*),nbody,
- & ibody(3,*)
-!
- integer nk,ne,nboun,nmpc,nforc,nload,neq(2),nzl,nmethod,icolumn,
+ & irow(*),nelcon(2,*),nrhcon(*),nalcon(2,*),ielmat(mi(3),*),
+ & ielorien(mi(3),*),ipkon(*),ipobody(2,*),nbody,ibody(3,*),
+ & nk,ne,nboun,nmpc,nforc,nload,neq(2),nzl,nmethod,icolumn,
& ithermal,iprestr,iperturb,nzs(3),i,j,k,l,m,idist,jj,
& ll,id,id1,id2,ist,ist1,ist2,index,jdof1,jdof2,idof1,idof2,
- & mpc1,mpc2,index1,index2,node1,node2,
- & ntmat_,indexe,nope,norien,iexpl,i0,ncmat_,istep,iinc
-!
- integer nplicon(0:ntmat_,*),nplkcon(0:ntmat_,*),npmat_
+ & mpc1,mpc2,index1,index2,node1,node2,ielprop(*),
+ & ntmat_,indexe,nope,norien,iexpl,i0,ncmat_,istep,iinc,
+ & nplicon(0:ntmat_,*),nplkcon(0:ntmat_,*),npmat_
!
real*8 co(3,*),xboun(*),coefmpc(*),xforc(*),xload(2,*),p1(3),
- & p2(3),ad(*),au(*),bodyf(3),
- & t0(*),t1(*),prestr(6,mi(1),*),vold(0:mi(2),*),s(100,100),
- & ff(100),
+ & p2(3),ad(*),au(*),bodyf(3),t0(*),t1(*),prestr(6,mi(1),*),
+ & vold(0:mi(2),*),s(100,100),ff(100),prop(*),
& sti(6,mi(1),*),sm(100,100),stx(6,mi(1),*),adb(*),aub(*),
& elcon(0:ncmat_,ntmat_,*),rhcon(0:1,ntmat_,*),
& alcon(0:6,ntmat_,*),alzero(*),orab(7,*),xbody(7,*),cgr(4,*)
@@ -144,7 +138,7 @@ c Bernhardi end
& nelemload,sideload,xload,nload,idist,sti,stx,
& iexpl,plicon,nplicon,plkcon,nplkcon,xstiff,npmat_,
& dtime,matname,mi(1),ncmat_,ttime,time,istep,iinc,
- & nmethod)
+ & nmethod,ielprop,prop)
!
do jj=1,3*nope
!
diff --git a/ccx_2.9/src/mafilldm.f b/ccx_2.10/src/mafilldm.f
similarity index 100%
rename from ccx_2.9/src/mafilldm.f
rename to ccx_2.10/src/mafilldm.f
diff --git a/ccx_2.9/src/mafillem.f b/ccx_2.10/src/mafillem.f
similarity index 100%
rename from ccx_2.9/src/mafillem.f
rename to ccx_2.10/src/mafillem.f
diff --git a/ccx_2.9/src/mafillnet.f b/ccx_2.10/src/mafillnet.f
similarity index 98%
rename from ccx_2.9/src/mafillnet.f
rename to ccx_2.10/src/mafillnet.f
index d9f734a..a2c2ab6 100644
--- a/ccx_2.9/src/mafillnet.f
+++ b/ccx_2.10/src/mafillnet.f
@@ -36,7 +36,7 @@
integer mi(*),itg(*),ieg(*),ntg,nteq,nflow,nload,
& ielmat(mi(3),*),iaxial,
& nelemload(2,*),nope,nopes,mint2d,i,j,k,l,iflag,
- & node,imat,ntmat_,id,ifaceq(9,6),ifacet(7,4),
+ & node,imat,ntmat_,id,ifaceq(8,6),ifacet(6,4),
& ifacew(8,5),node1,node2,nshcon(*),nelem,ig,index,konl(20),
& ipkon(*),kon(*),idof,iinc,ibody(3,*),istep,jltyp,nfield,
& ipobody(2,*),nodem,ieq,kflag,nrhcon(*),numf,
@@ -55,16 +55,16 @@
!
include "gauss.f"
!
- data ifaceq /4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/
- data ifacet /1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/
+ data ifaceq /4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/
+ data ifacet /1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/
data ifacew /1,3,2,9,8,7,0,0,
& 4,5,6,10,11,12,0,0,
& 1,2,5,4,7,14,10,13,
diff --git a/ccx_2.9/src/mafillp.f b/ccx_2.10/src/mafillp.f
similarity index 81%
rename from ccx_2.9/src/mafillp.f
rename to ccx_2.10/src/mafillp.f
index 01dc509..c1bac20 100644
--- a/ccx_2.9/src/mafillp.f
+++ b/ccx_2.10/src/mafillp.f
@@ -18,8 +18,8 @@
!
subroutine mafillp(nef,lakon,ipnei,neifa,neiel,vfa,area,
& advfa,xlet,cosa,volume,au,ad,jq,irow,ap,ielfa,ifabou,xle,
- & b,xxn,compressible,neq,nzs,hfa,gradpel,bp,xxi,neij,
- & xlen,cosb)
+ & b,xxn,neq,nzs,hfa,gradpel,bp,xxi,neij,
+ & xlen,cosb,nefa,nefb)
!
! filling the lhs and rhs to calculate p
!
@@ -27,18 +27,16 @@
!
character*8 lakon(*)
!
- integer i,nef,jdof1,indexf,ipnei(*),j,neifa(*),
+ integer i,nef,jdof1,indexf,ipnei(*),j,neifa(*),nefa,nefb,
& neiel(*),iel,ifa,jdof2,irow(*),ielfa(4,*),compressible,
& ifabou(*),neq,jq(*),iel2,indexb,knownflux,indexf2,
- & iatleastonepressurebc,j2,neij(*),nzs,numfaces,k
+ & j2,neij(*),nzs,numfaces,k
!
real*8 coef,vfa(0:5,*),volume(*),area(*),advfa(*),xlet(*),
& cosa(*),ad(*),au(*),xle(*),xxn(3,*),ap(*),b(*),cosb(*),
- & hfa(3,*),gradpel(3,*),bp(*),xxi(3,*),xlen(*)
+ & hfa(3,*),gradpel(3,*),bp(*),xxi(3,*),xlen(*),bp_ifa
!
- iatleastonepressurebc=0
-!
- do i=1,nef
+ do i=nefa,nefb
jdof1=i
indexf=ipnei(i)
if(lakon(i)(4:4).eq.'8') then
@@ -69,7 +67,7 @@
!
j2=neij(indexf)
indexf2=ipnei(iel)+j2
- bp(ifa)=((gradpel(1,iel)*(xxi(1,indexf2)
+ bp_ifa=((gradpel(1,iel)*(xxi(1,indexf2)
& -cosa(indexf2)*xxn(1,indexf2))+
& gradpel(2,iel)*(xxi(2,indexf2)
& -cosa(indexf2)*xxn(2,indexf2))+
@@ -83,8 +81,8 @@
& gradpel(3,i)*(xxi(3,indexf)
& -cosa(indexf)*xxn(3,indexf)))
& *xle(indexf))
- b(jdof1)=b(jdof1)-coef*bp(ifa)
- if(i.gt.iel) bp(ifa)=-bp(ifa)
+ b(jdof1)=b(jdof1)-coef*bp_ifa
+c if(i.gt.iel) bp_ifa=-bp_ifa
else
iel2=ielfa(2,ifa)
if(iel2.lt.0) then
@@ -100,9 +98,7 @@
! sliding conditions
!
knownflux=2
-c knownflux=1
elseif(ifabou(-iel2+4).ne.0) then
- iatleastonepressurebc=1
!
! pressure given (only if not all velocity
! components are given)
@@ -115,21 +111,28 @@ c knownflux=1
!
! correction for non-orthogonal meshes
!
- bp(ifa)=(-(gradpel(1,i)*(xxi(1,indexf)
+ bp_ifa=(-(gradpel(1,i)*(xxi(1,indexf)
& -cosa(indexf)*xxn(1,indexf))+
& gradpel(2,i)*(xxi(2,indexf)
& -cosa(indexf)*xxn(2,indexf))+
& gradpel(3,i)*(xxi(3,indexf)
& -cosa(indexf)*xxn(3,indexf)))
& *xle(indexf))
- b(jdof1)=b(jdof1)-coef*bp(ifa)
+ b(jdof1)=b(jdof1)-coef*bp_ifa
endif
endif
endif
!
+! save coefficients for correctvfa.f
+!
+ if((iel.eq.0).or.(i.lt.iel)) then
+ ap(ifa)=coef
+ bp(ifa)=bp_ifa
+ endif
+!
! save the coefficient for correctvfa.f
!
- ap(ifa)=coef
+c ap(ifa)=coef
!
if(knownflux.eq.1) then
b(jdof1)=b(jdof1)+vfa(5,ifa)*area(ifa)*
@@ -141,10 +144,6 @@ c knownflux=1
& (hfa(1,ifa)*xxn(1,indexf)+
& hfa(2,ifa)*xxn(2,indexf)+
& hfa(3,ifa)*xxn(3,indexf))
-c write(*,*) 'mafillp ',i,j,+vfa(5,ifa)*area(ifa)*
-c & (hfa(1,ifa)*xxn(1,indexf)+
-c & hfa(2,ifa)*xxn(2,indexf)+
-c & hfa(3,ifa)*xxn(3,indexf))
endif
enddo
enddo
@@ -155,17 +154,17 @@ c & hfa(3,ifa)*xxn(3,indexf))
! a pressure bc is only recognized if not all velocity degrees of
! freedom are prescribed on the same face
!
- if(iatleastonepressurebc.eq.0) then
- ad(nef)=1.d0
- b(nef)=0.d0
- do i=2,nef
- if(jq(i)-1>0) then
- if(irow(jq(i)-1).eq.nef) then
- au(jq(i)-1)=0.d0
- endif
- endif
- enddo
- endif
+c if(iatleastonepressurebc.eq.0) then
+c ad(nef)=1.d0
+c b(nef)=0.d0
+c do i=2,nef
+c if(jq(i)-1>0) then
+c if(irow(jq(i)-1).eq.nef) then
+c au(jq(i)-1)=0.d0
+c endif
+c endif
+c enddo
+c endif
!
c do i=1,nzs
c write(*,*) 'mafillp irow,au',i,au(i)
diff --git a/ccx_2.10/src/mafillpbc.f b/ccx_2.10/src/mafillpbc.f
new file mode 100644
index 0000000..f8b9ee2
--- /dev/null
+++ b/ccx_2.10/src/mafillpbc.f
@@ -0,0 +1,57 @@
+!
+! CalculiX - A 3-dimensional finite element program
+! Copyright (C) 1998-2015 Guido Dhondt
+!
+! This program is free software; you can redistribute it and/or
+! modify it under the terms of the GNU General Public License as
+! published by the Free Software Foundation(version 2);
+!
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program; if not, write to the Free Software
+! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+!
+ subroutine mafillpbc(nef,au,ad,jq,irow,
+ & b,iatleastonepressurebc,nzs)
+!
+! filling the lhs and rhs to calculate p
+!
+ implicit none
+!
+ integer i,nef,irow(*),jq(*),iatleastonepressurebc,nzs
+!
+ real*8 ad(*),au(*),b(*)
+!
+! 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
+!
+c write(*,*) 'mafillpbc', iatleastonepressurebc
+ if(iatleastonepressurebc.eq.0) then
+ ad(nef)=1.d0
+ b(nef)=0.d0
+ do i=2,nef
+ if(jq(i)-1>0) then
+ if(irow(jq(i)-1).eq.nef) then
+ au(jq(i)-1)=0.d0
+ endif
+ endif
+ enddo
+ endif
+!
+c do i=1,nzs
+c write(*,*) 'mafillp irow,au',i,au(i)
+c enddo
+c do i=1,nef
+c write(*,*) 'mafillp ad b',i,ad(i),b(i)
+c enddo
+!
+ return
+ end
diff --git a/ccx_2.9/src/mafillpcomp.f b/ccx_2.10/src/mafillpcomp.f
similarity index 58%
rename from ccx_2.9/src/mafillpcomp.f
rename to ccx_2.10/src/mafillpcomp.f
index 6b16427..d1cb1ce 100644
--- a/ccx_2.9/src/mafillpcomp.f
+++ b/ccx_2.10/src/mafillpcomp.f
@@ -1,4 +1,4 @@
-c!
+!
! CalculiX - A 3-dimensional finite element program
! Copyright (C) 1998-2015 Guido Dhondt
!
@@ -16,47 +16,48 @@ c!
! along with this program; if not, write to the Free Software
! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
!
- subroutine mafillpcomp(nef,lakon,ipnei,neifa,neiel,vfa,area,
+ subroutine mafillpcomp(nef,lakonf,ipnei,neifa,neiel,vfa,area,
& advfa,xlet,cosa,volume,au,ad,jq,irow,ap,ielfa,ifabou,xle,
- & b,xxn,nzs,hfa,gradpel,bp,xxi,neij,
- & xlen,cosb,ielmat,mi,a1,a2,a3,velo,veloo,dtimef,shcon,
- & ntmat_,vel,nactdohinv,xrlfa)
+ & b,xxn,neq,nzs,hfa,gradpel,bp,xxi,neij,
+ & xlen,cosb,ielmatf,mi,a1,a2,a3,velo,veloo,dtimef,shcon,
+ & ntmat_,vel,nactdohinv,xrlfa,flux,nefa,nefb)
!
! filling the lhs and rhs to calculate p
!
implicit none
!
- character*8 lakon(*)
+ character*8 lakonf(*)
!
integer i,nef,jdof1,indexf,ipnei(*),j,neifa(*),iel3,
& neiel(*),iel,ifa,jdof2,irow(*),ielfa(4,*),compressible,
& ifabou(*),neq,jq(*),iel2,indexb,knownflux,indexf2,
- & iatleastonepressurebc,j2,neij(*),nzs,numfaces,imat,
- & mi(*),ielmat(mi(3),*),ntmat_,nactdohinv(*),knownpressure
+ & j2,neij(*),nzs,numfaces,imat,nefa,nefb,
+ & mi(*),ielmatf(mi(3),*),ntmat_,nactdohinv(*),knownpressure
!
real*8 coef,vfa(0:5,*),volume(*),area(*),advfa(*),xlet(*),
- & cosa(*),ad(*),au(*),xle(*),xxn(3,*),ap(*),b(*),cosb(*),
+ & cosa(*),ad(neq),au(nzs),xle(*),xxn(3,*),ap(*),b(neq),cosb(*),
& hfa(3,*),gradpel(3,*),bp(*),xxi(3,*),xlen(*),r,a1,a2,a3,
- & flux,constant,velo(nef,0:5),veloo(nef,0:5),dtimef,
+ & xflux,constant,velo(nef,0:5),veloo(nef,0:5),dtimef,
& shcon(0:3,ntmat_,*),vel(nef,0:5),dd,convec,fluxisobar,
- & coef1,coef3,xrlfa(3,*),coef2,gamma,coefp,coefn,xmach
+ & coef1,coef3,xrlfa(3,*),coef2,gamma,coefp,coefn,xmach,
+ & flux(*),bp_ifa
!
- iatleastonepressurebc=0
+ intent(in) nef,lakonf,ipnei,neifa,neiel,vfa,area,
+ & advfa,xlet,cosa,volume,jq,irow,ielfa,ifabou,xle,
+ & xxn,nzs,hfa,gradpel,xxi,neij,
+ & xlen,cosb,ielmatf,mi,a1,a2,a3,velo,veloo,dtimef,shcon,
+ & ntmat_,vel,nactdohinv,xrlfa,flux
!
- do i=1,nef
-c if(i.eq.2840) write(*,*) 'mafillpcomp ',vel(i,4)
+ intent(inout) ad,au,b,ap,bp
!
-c xmach=dsqrt((vel(i,1)**2+vel(i,2)**2+vel(i,3)**2)/
-c & (1.4*r*vel(i,0)))
-c write(*,*) dsqrt(vel(i,1)**2+vel(i,2)**2+vel(i,3)**2),
-c & r,vel(i,0)
+ do i=nefa,nefb
jdof1=i
- imat=ielmat(1,i)
+ imat=ielmatf(1,i)
r=shcon(3,1,imat)
indexf=ipnei(i)
- if(lakon(i)(4:4).eq.'8') then
+ if(lakonf(i)(4:4).eq.'8') then
numfaces=6
- elseif(lakon(i)(4:4).eq.'6') then
+ elseif(lakonf(i)(4:4).eq.'6') then
numfaces=5
else
numfaces=4
@@ -76,20 +77,16 @@ c & r,vel(i,0)
& (advfa(ifa)*2.d0*xlet(indexf)*cosb(indexf))
call add_sm_fl_as(au,ad,jq,irow,jdof1,jdof1,
& coef,nzs)
-c write(*,*) 'mafillpcomp ',jdof1,jdof1,coef
-c coef1=coef
call add_sm_fl_as(au,ad,jq,irow,jdof1,jdof2,
& -coef,nzs)
-c write(*,*) 'mafillpcomp ',jdof1,jdof2,-coef
-c coef2=-coef
- b(jdof1)=b(jdof1)+coef*(velo(jdof2,4)-velo(jdof1,4))
- convec=coef*(velo(jdof2,4)-velo(jdof1,4))
+ b(jdof1)=b(jdof1)+coef*(vel(jdof2,4)-vel(jdof1,4))
+ convec=coef*(vel(jdof2,4)-vel(jdof1,4))
!
! correction for non-orthogonal meshes
!
j2=neij(indexf)
indexf2=ipnei(iel)+j2
- bp(ifa)=((gradpel(1,iel)*(xxi(1,indexf2)
+ bp_ifa=((gradpel(1,iel)*(xxi(1,indexf2)
& -cosa(indexf2)*xxn(1,indexf2))+
& gradpel(2,iel)*(xxi(2,indexf2)
& -cosa(indexf2)*xxn(2,indexf2))+
@@ -103,18 +100,15 @@ c coef2=-coef
& gradpel(3,i)*(xxi(3,indexf)
& -cosa(indexf)*xxn(3,indexf)))
& *xle(indexf))
- b(jdof1)=b(jdof1)+coef*bp(ifa)
- convec=convec+coef*bp(ifa)
-c convec=-convec/vfa(4,ifa)
+ b(jdof1)=b(jdof1)+coef*bp_ifa
+ convec=convec+coef*bp_ifa
!
! following line is correct if the temperature
! changes from one pressure correction iteration to
! the next
!
convec=-convec/(vfa(5,ifa)*r*vfa(0,ifa))
-c write(*,*) 'mafillpcomp ',vfa(4,ifa),
-c & (vfa(5,ifa)*r*vfa(0,ifa))
- if(i.gt.iel) bp(ifa)=-bp(ifa)
+c if(i.gt.iel) bp_ifa=-bp_ifa
else
iel2=ielfa(2,ifa)
if(iel2.lt.0) then
@@ -132,7 +126,6 @@ c & (vfa(5,ifa)*r*vfa(0,ifa))
knownflux=2
elseif(ifabou(-iel2+4).ne.0) then
knownpressure=1
- iatleastonepressurebc=1
!
! pressure given (only if not all velocity
! components are given)
@@ -141,55 +134,66 @@ c & (vfa(5,ifa)*r*vfa(0,ifa))
& (advfa(ifa)*xle(indexf)*cosa(indexf))
call add_sm_fl_as(au,ad,jq,irow,jdof1,jdof1,
& coef,nzs)
-c write(*,*) 'mafillpcomp ',jdof1,jdof1,coef
-c coef1=coef
b(jdof1)=b(jdof1)+coef*vfa(4,ifa)
- & -coef*velo(jdof1,4)
- convec=coef*vfa(4,ifa)-coef*velo(jdof1,4)
+ & -coef*vel(jdof1,4)
+ convec=coef*vfa(4,ifa)-coef*vel(jdof1,4)
!
! correction for non-orthogonal meshes
!
- bp(ifa)=(-(gradpel(1,i)*(xxi(1,indexf)
+ bp_ifa=(-(gradpel(1,i)*(xxi(1,indexf)
& -cosa(indexf)*xxn(1,indexf))+
& gradpel(2,i)*(xxi(2,indexf)
& -cosa(indexf)*xxn(2,indexf))+
& gradpel(3,i)*(xxi(3,indexf)
& -cosa(indexf)*xxn(3,indexf)))
& *xle(indexf))
- b(jdof1)=b(jdof1)+coef*bp(ifa)
- convec=convec+coef*bp(ifa)
-c convec=-convec/vfa(4,ifa)
+ b(jdof1)=b(jdof1)+coef*bp_ifa
+ convec=convec+coef*bp_ifa
!
! following line is correct if the temperature
! changes from one pressure correction iteration to
! the next
!
convec=-convec/(vfa(5,ifa)*r*vfa(0,ifa))
+ else
+c
+c check!
+c
+ convec=0.d0
endif
endif
endif
!
+! save coefficients for correctvfa.f
+!
+ if((iel.eq.0).or.(i.lt.iel)) then
+ ap(ifa)=coef
+ bp(ifa)=bp_ifa
+ endif
+!
! save the coefficient for correctvfa.f
!
- ap(ifa)=coef
+c ap(ifa)=coef
!
! convection
!
! flux
!
-c if(knownflux.eq.1) then
-c flux=area(ifa)*
+ if(knownflux.eq.1) then
+ xflux=flux(indexf)
+c xflux=area(ifa)*vfa(5,ifa)*
+c xflux=area(ifa)*
c & (vfa(1,ifa)*xxn(1,indexf)+
c & vfa(2,ifa)*xxn(2,indexf)+
c & vfa(3,ifa)*xxn(3,indexf))
-c endif
- if(knownflux.ne.2) then
- flux=area(ifa)*
- & (vfa(1,ifa)*xxn(1,indexf)+
- & vfa(2,ifa)*xxn(2,indexf)+
- & vfa(3,ifa)*xxn(3,indexf))
- else
- flux=0.d0
+c write(*,*) 'mafillpcomp ',i,j,ifa
+c write(*,*) vfa(5,ifa)
+c write(*,*) vfa(1,ifa)
+c write(*,*) vfa(2,ifa)
+c write(*,*) vfa(3,ifa)
+c write(*,*) 'mafillpcomp ',xflux,flux(indexf)
+ elseif(knownflux.eq.2) then
+ xflux=0.d0
endif
!
! flux based on constant pressure
@@ -206,59 +210,25 @@ c endif
if(knownflux.eq.0) then
b(jdof1)=b(jdof1)-vfa(5,ifa)*fluxisobar
elseif(knownflux.eq.1) then
- b(jdof1)=b(jdof1)-vfa(5,ifa)*flux
+ b(jdof1)=b(jdof1)-xflux
endif
!
-c write(*,*) 'xmach ',xmach
-c if(xmach.lt.1.d0) then
-c coef=0.d0
-c else
if(knownflux.eq.0) then
-c coef=convec
!
! following line leads to oscillations in the solution
! (only for subsonic and transonic solutions)
!
-c coef=fluxisobar/(r*vfa(0,ifa))+convec
-c coef=fluxisobar/(r*vfa(0,ifa))
- coef=0.d0
+ coef=fluxisobar/(r*vfa(0,ifa))+convec
elseif(knownflux.eq.1) then
-c coef=flux/(r*vfa(0,ifa))
- coef=0.d0
+ coef=xflux/(r*vfa(0,ifa)*vfa(5,ifa))
else
coef=0.d0
endif
-c endif
-!
-ccccc
-C if(iel.ne.0) then
-C if(ielfa(1,ifa).eq.i) then
-C coefp=coef*xrlfa(1,ifa)
-C coefn=coef*xrlfa(2,ifa)
-C else
-C coefp=coef*xrlfa(2,ifa)
-C coefn=coef*xrlfa(1,ifa)
-C endif
-C endif
-cccc
-c if(flux.ge.0.d0) then
-C gamma=0.5d0
+!
if(coef.ge.0.d0) then
!
! outflowing flux
!
-C if(iel.gt.0) then
-C coefp=gamma*coefp+(1.d0-gamma)*coef
-C call add_sm_fl_as(au,ad,jq,irow,jdof1,jdof1,
-C & coefp,nzs)
-C coefn=gamma*coefn
-C call add_sm_fl_as(au,ad,jq,irow,jdof1,jdof2,
-C & coefn,nzs)
-C else
-C call add_sm_fl_as(au,ad,jq,irow,jdof1,jdof1,
-C & coef,nzs)
-C endif
-c
call add_sm_fl_as(au,ad,jq,irow,jdof1,jdof1,
& coef,nzs)
c
@@ -270,13 +240,6 @@ c
!
! incoming flux from neighboring element
!
-C coefp=gamma*coefp
-C call add_sm_fl_as(au,ad,jq,irow,jdof1,jdof1,coefp,
-C & nzs)
-C coefn=gamma*coefn+(1.d0-gamma)*coef
-C call add_sm_fl_as(au,ad,jq,irow,jdof1,jdof2,coefn,
-C & nzs)
-c
call add_sm_fl_as(au,ad,jq,irow,jdof1,jdof2,coef,
& nzs)
!
@@ -285,18 +248,8 @@ c retarded central difference
c b(jdof1)=b(jdof1)-(vfa(4,ifa)-vel(iel,4))*coef
c
elseif(knownpressure.eq.0) then
-c??? iel3=ielfa(3,ifa)
-c if(iel3.gt.0) then
-c coef1=coef*xrlfa(1,ifa)
-c call add_sm_fl_as(au,ad,jq,irow,jdof1,jdof1,coef1,
-c & nzs)
-c coef3=coef*xrlfa(3,ifa)
-c call add_sm_fl_as(au,ad,jq,irow,jdof1,iel3,coef3,
-c & nzs)
-c else
call add_sm_fl_as(au,ad,jq,irow,jdof1,jdof1,coef,
& nzs)
-c endif
endif
endif
!
@@ -304,16 +257,16 @@ c endif
!
! transient term
!
- a1=1.d0/dtimef
- a2=-1.d0/dtimef
- a3=0.d0/dtimef
-C a1=1.5d0/dtimef
-C a2=-2.d0/dtimef
-C a3=0.5d0/dtimef
- constant=volume(i)/(r*vel(i,0))
+c a1=1.d0/dtimef
+c a2=-1.d0/dtimef
+c a3=0.d0/dtimef
+c constant=volume(i)/(r*vel(i,0))
+c b(jdof1)=b(jdof1)-
+c & (a1*vel(i,5)+a2*velo(i,5)+a3*veloo(i,5))*volume(i)
b(jdof1)=b(jdof1)-
- & (a1*velo(i,4)+a2*velo(i,4)+a3*veloo(i,4))*constant
- constant=a1*constant
+ & (vel(i,5)-velo(i,5))*volume(i)/dtimef
+c constant=a1*constant
+ constant=volume(i)/(r*vel(i,0)*dtimef)
call add_sm_fl_as(au,ad,jq,irow,jdof1,jdof1,constant,nzs)
!
enddo
diff --git a/ccx_2.10/src/mafillpcompmain.c b/ccx_2.10/src/mafillpcompmain.c
new file mode 100644
index 0000000..8e772d6
--- /dev/null
+++ b/ccx_2.10/src/mafillpcompmain.c
@@ -0,0 +1,198 @@
+/* CalculiX - A 3-dimensional finite element program */
+/* Copyright (C) 1998-2015 Guido Dhondt */
+
+/* This program is free software; you can redistribute it and/or */
+/* modify it under the terms of the GNU General Public License as */
+/* published by the Free Software Foundation(version 2); */
+/* */
+
+/* This program is distributed in the hope that it will be useful, */
+/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
+/* GNU General Public License for more details. */
+
+/* You should have received a copy of the GNU General Public License */
+/* along with this program; if not, write to the Free Software */
+/* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+#include <unistd.h>
+#include <stdio.h>
+#include <math.h>
+#include <stdlib.h>
+#include <pthread.h>
+#include "CalculiX.h"
+
+static char *lakonf1;
+
+static ITG num_cpus,*nef1,*ipnei1,*neifa1,*neiel1,*jq1,*irow1,*ielfa1,
+ *ifabou1,*neq1,*nzs1,*neij1,*ielmatf1,*mi1,*ntmat1_,*nactdohinv1;
+
+static double *vfa1,*area1,*advfa1,*xlet1,*cosa1,*volume1,*au1=NULL,*ad1=NULL,
+ *ap1,*xle1,*b1=NULL,*xxn1,*hfa1,*gradpel1,*bp1,*xxi1,*xlen1,*cosb1,
+ *a11,*a21,*a31,*velo1,*veloo1,*dtimef1,*shcon1,*vel1,*xrlfa1,*flux1;
+
+void mafillpcompmain(ITG *nef,char *lakonf,ITG *ipnei,
+ ITG *neifa,ITG *neiel,double *vfa,double *area,double *advfa,
+ 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 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];
+
+ /* allocating fields for lhs and rhs matrix */
+
+ NNEW(ad1,double,num_cpus**neq);
+ NNEW(au1,double,(long long)num_cpus*2**nzs);
+ NNEW(b1,double,num_cpus**neq);
+
+ /* 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;
+
+ /* 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);
+
+ /* copying and accumulating the stiffnes and/or mass matrix */
+
+#pragma omp parallel \
+ default(none) \
+ shared(neq,ad,ad1,num_cpus,nzs,au,au1,b,b1) \
+ private(i,j)
+ {
+ #pragma omp for
+ for(i=0;i<*neq;i++){
+ ad[i]=ad1[i];
+ for(j=1;j<num_cpus;j++){
+ ad[i]+=ad1[i+j**neq];
+ }
+ }
+
+ #pragma omp for
+ for(i=0;i<2**nzs;i++){
+ au[i]=au1[i];
+ for(j=1;j<num_cpus;j++){
+ au[i]+=au1[i+(long long)j*2**nzs];
+ }
+ }
+
+ #pragma omp for
+ for(i=0;i<*neq;i++){
+ b[i]=b1[i];
+ for(j=1;j<num_cpus;j++){
+ b[i]+=b1[i+j**neq];
+ }
+ }
+ }
+
+ SFREE(ad1);
+ SFREE(au1);
+ SFREE(b1);
+
+ return;
+
+}
+
+/* subroutine for multithreading of mafillpcomp */
+
+void *mafillpcompmt(ITG *i){
+
+ ITG indexad,indexb,nefa,nefb,nefdelta;
+ long long indexau;
+
+ indexad=*i**neq1;
+ indexau=(long long)*i*2**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(mafillpcomp,(nef1,lakonf1,ipnei1,neifa1,neiel1,vfa1,area1,
+ advfa1,xlet1,cosa1,volume1,&au1[indexau],&ad1[indexad],
+ jq1,irow1,ap1,ielfa1,ifabou1,xle1,&b1[indexb],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));
+
+ return NULL;
+}
diff --git a/ccx_2.10/src/mafillpmain.c b/ccx_2.10/src/mafillpmain.c
new file mode 100644
index 0000000..053f13a
--- /dev/null
+++ b/ccx_2.10/src/mafillpmain.c
@@ -0,0 +1,192 @@
+/* CalculiX - A 3-dimensional finite element program */
+/* Copyright (C) 1998-2015 Guido Dhondt */
+
+/* This program is free software; you can redistribute it and/or */
+/* modify it under the terms of the GNU General Public License as */
+/* published by the Free Software Foundation(version 2); */
+/* */
+
+/* This program is distributed in the hope that it will be useful, */
+/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
+/* GNU General Public License for more details. */
+
+/* You should have received a copy of the GNU General Public License */
+/* along with this program; if not, write to the Free Software */
+/* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+#include <unistd.h>
+#include <stdio.h>
+#include <math.h>
+#include <stdlib.h>
+#include <pthread.h>
+#include "CalculiX.h"
+
+static char *lakonf1;
+
+static ITG num_cpus,*nef1,*ipnei1,*neifa1,*neiel1,*jq1,*irow1,*ielfa1,
+ *ifabou1,*neq1,*nzs1,*neij1;
+
+static double *vfa1,*area1,*advfa1,*xlet1,*cosa1,*volume1,*au1=NULL,*ad1=NULL,
+ *ap1,*xle1,*b1=NULL,*xxn1,*hfa1,*gradpel1,*bp1,*xxi1,*xlen1,*cosb1;
+
+void mafillpmain(ITG *nef,char *lakonf,ITG *ipnei,
+ ITG *neifa,ITG *neiel,double *vfa,double *area,double *advfa,
+ 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 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];
+
+ /* allocating fields for lhs and rhs matrix */
+
+ NNEW(ad1,double,num_cpus**neq);
+ NNEW(au1,double,(long long)num_cpus**nzs);
+ NNEW(b1,double,num_cpus**neq);
+
+ /* 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;
+
+ /* 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);
+
+ /* copying and accumulating the stiffnes and/or mass matrix */
+
+#pragma omp parallel \
+ default(none) \
+ shared(neq,ad,ad1,num_cpus,nzs,au,au1,b,b1) \
+ private(i,j)
+ {
+ #pragma omp for
+ for(i=0;i<*neq;i++){
+ ad[i]=ad1[i];
+ for(j=1;j<num_cpus;j++){
+ ad[i]+=ad1[i+j**neq];
+ }
+ }
+
+ #pragma omp for
+ for(i=0;i<*nzs;i++){
+ au[i]=au1[i];
+ for(j=1;j<num_cpus;j++){
+ au[i]+=au1[i+(long long)j**nzs];
+ }
+ }
+
+ #pragma omp for
+ for(i=0;i<*neq;i++){
+ b[i]=b1[i];
+ for(j=1;j<num_cpus;j++){
+ b[i]+=b1[i+j**neq];
+ }
+ }
+ }
+
+ SFREE(ad1);
+ SFREE(au1);
+ SFREE(b1);
+
+ FORTRAN(mafillpbc,(nef,au,ad,jq,irow,b,iatleastonepressurebc,nzs));
+
+ return;
+
+}
+
+/* subroutine for multithreading of mafillp */
+
+void *mafillpmt(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(mafillp,(nef1,lakonf1,ipnei1,neifa1,neiel1,vfa1,area1,
+ advfa1,xlet1,cosa1,volume1,&au1[indexau],&ad1[indexad],
+ jq1,irow1,ap1,ielfa1,ifabou1,xle1,&b1[indexb],xxn1,neq1,nzs1,
+ hfa1,gradpel1,bp1,xxi1,neij1,xlen1,cosb1,&nefa,&nefb));
+
+ return NULL;
+}
diff --git a/ccx_2.9/src/mafillsm1.f b/ccx_2.10/src/mafillsm.f
similarity index 98%
rename from ccx_2.9/src/mafillsm1.f
rename to ccx_2.10/src/mafillsm.f
index 250d8e5..5b28393 100644
--- a/ccx_2.9/src/mafillsm1.f
+++ b/ccx_2.10/src/mafillsm.f
@@ -16,7 +16,7 @@
! along with this program; if not, write to the Free Software
! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
!
- subroutine mafillsm1(co,nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,
+ subroutine mafillsm(co,nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,
& xboun,nboun,
& ipompc,nodempc,coefmpc,nmpc,nodeforc,ndirforc,xforc,
& nforc,nelemload,sideload,xload,nload,xbody,ipobody,nbody,cgr,
@@ -141,14 +141,10 @@ c Bernhardi start
elseif(lakon(i)(4:5).eq.'20') then
c Bernhardi end
nope=20
- elseif(lakon(i)(4:4).eq.'2') then
- nope=26
elseif(lakon(i)(4:4).eq.'8') then
nope=8
elseif(lakon(i)(4:5).eq.'10') then
nope=10
- elseif(lakon(i)(4:5).eq.'14') then
- nope=14
elseif(lakon(i)(4:4).eq.'4') then
nope=4
elseif(lakon(i)(4:5).eq.'15') then
@@ -488,14 +484,10 @@ c endif
indexe=ipkon(i)
if(lakon(i)(4:5).eq.'20') then
nope=20
- elseif(lakon(i)(4:4).eq.'2') then
- nope=26
elseif(lakon(i)(4:4).eq.'8') then
nope=8
elseif(lakon(i)(4:5).eq.'10') then
nope=10
- elseif(lakon(i)(4:5).eq.'14') then
- nope=14
elseif(lakon(i)(4:4).eq.'4') then
nope=4
elseif(lakon(i)(4:5).eq.'15') then
diff --git a/ccx_2.9/src/mafillsm.f b/ccx_2.10/src/mafillsm1.f
similarity index 99%
rename from ccx_2.9/src/mafillsm.f
rename to ccx_2.10/src/mafillsm1.f
index 87a89e9..904e748 100644
--- a/ccx_2.9/src/mafillsm.f
+++ b/ccx_2.10/src/mafillsm1.f
@@ -16,7 +16,7 @@
! along with this program; if not, write to the Free Software
! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
!
- subroutine mafillsm(co,nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,
+ subroutine mafillsm1(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,
diff --git a/ccx_2.9/src/mafillsmas.f b/ccx_2.10/src/mafillsmas.f
similarity index 100%
copy from ccx_2.9/src/mafillsmas.f
copy to ccx_2.10/src/mafillsmas.f
diff --git a/ccx_2.9/src/mafillsmas.f b/ccx_2.10/src/mafillsmas1.f
similarity index 97%
rename from ccx_2.9/src/mafillsmas.f
rename to ccx_2.10/src/mafillsmas1.f
index e78d132..69e0a20 100644
--- a/ccx_2.9/src/mafillsmas.f
+++ b/ccx_2.10/src/mafillsmas1.f
@@ -16,11 +16,11 @@
! along with this program; if not, write to the Free Software
! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
!
- subroutine mafillsmas(co,nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,
+ subroutine mafillsmas1(co,nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,
& xboun,nboun,
& ipompc,nodempc,coefmpc,nmpc,nodeforc,ndirforc,xforc,
& nforc,nelemload,sideload,xload,nload,xbody,ipobody,nbody,cgr,
- & ad,au,bb,nactdof,icol,jq,irow,neq,nzl,nmethod,
+ & 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,t1,ithermal,prestr,
@@ -32,7 +32,7 @@
& xstateini,xstate,thicke,
& integerglob,doubleglob,tieset,istartset,iendset,
& ialset,ntie,nasym,pslavsurf,pmastsurf,mortar,clearini,ielprop,
- & prop,ne0,kscale)
+ & prop,ne0,nea,neb,kscale)
!
! filling the stiffness matrix in spare matrix format (sm)
! asymmetric contributions
@@ -58,10 +58,10 @@
& ll,jdof1,jdof2,node1,node2,id,i0,id1,id2,idof1,idof2,nasym,
& ntmat_,indexe,nope,norien,iexpl,ncmat_,istep,iinc,mpc2,
& nplicon(0:ntmat_,*),nplkcon(0:ntmat_,*),npmat_,ist1,ist2,
- & mortar,ielprop(*),kscale
+ & mortar,ielprop(*),kscale,nea,neb
!
real*8 co(3,*),xboun(*),coefmpc(*),xforc(*),xload(2,*),p1(3),
- & p2(3),ad(*),au(*),bodyf(3),bb(*),xloadold(2,*),value,
+ & p2(3),ad(*),au(*),bodyf(3),fext(*),xloadold(2,*),value,
& t0(*),t1(*),prestr(6,mi(1),*),vold(0:mi(2),*),s(100,100),
& ff(100),
& sti(6,mi(1),*),sm(100,100),stx(6,mi(1),*),adb(*),aub(*),
@@ -76,20 +76,6 @@
!
i0=0
!
-! storing the symmetric matrix in asymmetric format
-!
- do i=1,nzs(2)
- au(nzs(3)+i)=au(i)
- enddo
-!
-! dynamic applications
-!
- if((nmethod.eq.2).or.(nmethod.eq.4)) then
- do i=1,nzs(2)
- aub(nzs(3)+i)=aub(i)
- enddo
- endif
-!
if(rhsi) then
!
! distributed forces (body forces or thermal loads or
@@ -109,7 +95,7 @@
! mechanical analysis: asymmetric contributions
! only contact friction
!
- do i=ne0+1,ne
+ do i=max(ne0+1,nea),neb
!
if(ipkon(i).lt.0) cycle
if(lakon(i)(1:2).ne.'ES') cycle
@@ -322,7 +308,7 @@ c & s(jj,ll)/coefmpc(ist)/coefmpc(ist)
!
! thermal analysis: asymmetric contributions
!
- do i=1,ne
+ do i=nea,neb
!
if(ipkon(i).lt.0) cycle
if(lakon(i)(1:2).ne.'D ') cycle
diff --git a/ccx_2.9/src/mafillsmmain.c b/ccx_2.10/src/mafillsmasmain.c
similarity index 66%
copy from ccx_2.9/src/mafillsmmain.c
copy to ccx_2.10/src/mafillsmasmain.c
index 6a60bfa..1395f85 100644
--- a/ccx_2.9/src/mafillsmmain.c
+++ b/ccx_2.10/src/mafillsmasmain.c
@@ -41,9 +41,9 @@ static double *co1,*xboun1,*coefmpc1,*xforc1,*xload1,*xbody1,*cgr1,
*plicon1,*plkcon1,*xstiff1,*dtime1,*physcon1,*shcon1,*cocon1,
*ttime1,*time1,*xloadold1,*reltime1,*veold1,*springarea1,
*xstateini1,*xstate1,*thicke1,*doubleglob1,*pslavsurf1,*pmastsurf1,
- *clearini1,*prop1,*fnext1=NULL;
+ *clearini1,*prop1;
-void mafillsmmain(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
+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,
@@ -75,7 +75,7 @@ void mafillsmmain(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
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 *kscale){
ITG i,j,k,mt=mi[1]+1;
@@ -121,9 +121,9 @@ void mafillsmmain(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
env = getenv("OMP_NUM_THREADS");
if(num_cpus==0){
- if (env)
- num_cpus = atoi(env);
- if (num_cpus < 1) {
+ if(env)
+ num_cpus=atoi(env);
+ if (num_cpus<1) {
num_cpus=1;
}else if(num_cpus>sys_cpus){
num_cpus=sys_cpus;
@@ -132,17 +132,22 @@ void mafillsmmain(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
// next line is to be inserted in a similar way for all other paralell parts
- if(*ne<num_cpus) num_cpus=*ne;
+ if(*ne-*ne0<num_cpus) num_cpus=*ne-*ne0;
+ if(num_cpus<1)num_cpus=1;
pthread_t tid[num_cpus];
- /* determine nzl */
+ /* storing the symmetric matrix in asymmetric format */
- *nzl=0;
- for(i=neq[1];i>=1;i--){
- if(icol[i-1]>0){
- *nzl=i;
- break;
+ for(i=0;i<nzs[1];i++){
+ au[nzs[2]+i]=au[i];
+ }
+
+ /* dynamic applications */
+
+ if((*nmethod==2)||(*nmethod==4)){
+ for(i=0;i<nzs[1];i++){
+ aub[nzs[2]+i]=aub[i];
}
}
@@ -150,20 +155,7 @@ void mafillsmmain(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
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);
+ NNEW(au1,double,(long long)num_cpus*(nzs[2]+nzs[1]));
}
/* allocating memory for nmethod; if the Jacobian determinant
@@ -207,30 +199,24 @@ void mafillsmmain(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
/* calculating the stiffness/mass */
- printf(" Using up to %" ITGFORMAT " cpu(s) for the stiffness/mass calculation.\n\n", num_cpus);
+ printf(" Using up to %" ITGFORMAT " cpu(s) for the asymmetric 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]);
+ pthread_create(&tid[i], NULL, (void *)mafillsmasmt, (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 */
if(*buckling!=1){
for(i=0;i<neq[1];i++){
- ad[i]=ad1[i];
+ ad[i]+=ad1[i];
}
for(i=0;i<neq[1];i++){
for(j=1;j<num_cpus;j++){
@@ -239,174 +225,68 @@ void mafillsmmain(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
}
SFREE(ad1);
- for(i=0;i<nzs[2];i++){
- au[i]=au1[i];
+ for(i=0;i<nzs[2]+nzs[1];i++){
+ au[i]+=au1[i];
}
- for(i=0;i<nzs[2];i++){
+ for(i=0;i<nzs[2]+nzs[1];i++){
for(j=1;j<num_cpus;j++){
- au[i]+=au1[i+(long long)j*nzs[2]];
+ au[i]+=au1[i+(long long)j*(nzs[2]+nzs[1])];
}
}
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;
}
}
-
- /* 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));
+ SFREE(nmethod1);
return;
}
-/* subroutine for multithreading of mafillsm */
+/* subroutine for multithreading of mafillsmas */
-void *mafillsmmt(ITG *i){
+void *mafillsmasmt(ITG *i){
- ITG indexad,indexfext,indexadb,nea,neb,nedelta,indexfnext;
- long long indexau,indexaub;
+ ITG indexad,nea,neb,nedelta;
+ long long indexau;
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;
- }
-
-// ceil -> floor
-
- if(*nasym1==0){
- 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;
- }else{
- nedelta=(ITG)floor(*ne01/(double)num_cpus);
- nea=*i*nedelta+1;
- neb=(*i+1)*nedelta;
-// next line! -> all parallel sections
- if((*i==num_cpus-1)&&(neb<*ne01)) neb=*ne01;
+ indexau=(long long)*i*(nzs1[2]+nzs1[1]);
}
-// printf("i=%d,nea=%d,neb=%d\n",*i,nea,neb);
+ /* at first, nea and neb are calculated based on all
+ elements with numbers superseding ne0 (contact
+ spring elements */
+
+ nedelta=(ITG)floor((*ne1-*ne01)/(double)num_cpus);
+ nea=*ne01+*i*nedelta+1;
+ neb=*ne01+(*i+1)*nedelta;
+ if((*i==num_cpus-1)&&(neb<*ne1))neb=*ne1;
+
+ /* advective thermal elements also asymmetric */
+
+ if((*ithermal1>1)&&(*i==0))nea=1;
- FORTRAN(mafillsm1,(co1,nk1,kon1,ipkon1,lakon1,ne1,nodeboun1,ndirboun1,
+ FORTRAN(mafillsmas1,(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],
+ nbody1,cgr1,&ad1[indexad],&au1[indexau],fext1,
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,
+ nzs1,stx1,adb1,aub1,iexpl1,plicon1,
nplicon1,plkcon1,nplkcon1,
xstiff1,npmat1_,dtime1,matname1,mi1,
ncmat1_,mass1,stiffness1,buckling1,rhsi1,intscheme1,physcon1,
@@ -415,7 +295,7 @@ void *mafillsmmt(ITG *i){
xstateini1,xstate1,thicke1,integerglob1,doubleglob1,
tieset1,istartset1,iendset1,ialset1,ntie1,nasym1,pslavsurf1,
pmastsurf1,mortar1,clearini1,ielprop1,prop1,ne01,
- &fnext1[indexfnext],&nea,&neb,kscale1));
+ &nea,&neb,kscale1));
return NULL;
}
diff --git a/ccx_2.9/src/mafillsmcs.f b/ccx_2.10/src/mafillsmcs.f
similarity index 100%
rename from ccx_2.9/src/mafillsmcs.f
rename to ccx_2.10/src/mafillsmcs.f
diff --git a/ccx_2.9/src/mafillsmcsas.f b/ccx_2.10/src/mafillsmcsas.f
similarity index 100%
rename from ccx_2.9/src/mafillsmcsas.f
rename to ccx_2.10/src/mafillsmcsas.f
diff --git a/ccx_2.9/src/mafillsmforc.f b/ccx_2.10/src/mafillsmforc.f
similarity index 100%
rename from ccx_2.9/src/mafillsmforc.f
rename to ccx_2.10/src/mafillsmforc.f
diff --git a/ccx_2.9/src/mafillsmmain.c b/ccx_2.10/src/mafillsmmain.c
similarity index 94%
rename from ccx_2.9/src/mafillsmmain.c
rename to ccx_2.10/src/mafillsmmain.c
index 6a60bfa..c58a5fb 100644
--- a/ccx_2.9/src/mafillsmmain.c
+++ b/ccx_2.10/src/mafillsmmain.c
@@ -77,7 +77,7 @@ void mafillsmmain(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
double *clearini,ITG *ielprop,double *prop,ITG *ne0,
double *fnext,ITG *kscale){
- ITG i,j,k,mt=mi[1]+1;
+ ITG i,j,mt=mi[1]+1;
/* variables for multithreading procedure */
@@ -148,10 +148,10 @@ void mafillsmmain(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
/* allocating fields for mass and stiffness matrix */
- if(*buckling!=1){
+// 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]);
@@ -207,7 +207,7 @@ void mafillsmmain(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
/* calculating the stiffness/mass */
- printf(" Using up to %" ITGFORMAT " cpu(s) for the stiffness/mass calculation.\n\n", num_cpus);
+ printf(" Using up to %" ITGFORMAT " cpu(s) for the symmetric stiffness/mass contributions.\n\n", num_cpus);
/* create threads and wait */
@@ -226,29 +226,54 @@ void mafillsmmain(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
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 */
+ /* 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++){
- for(j=1;j<num_cpus;j++){
- ad[i]+=ad1[i+j*neq[1]];
- }
+ 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);
+ }
+ 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++){
- for(j=1;j<num_cpus;j++){
- au[i]+=au1[i+(long long)j*nzs[2]];
- }
+ 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);
- }
+ }
+ SFREE(au1);
if(*rhsi==1){
for(i=0;i<neq[1];i++){
@@ -331,6 +356,7 @@ void mafillsmmain(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
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]);}
@@ -360,10 +386,10 @@ void *mafillsmmt(ITG *i){
indexaub=0;
indexfnext=0;
- if(*buckling1!=1){
+// if(*buckling1!=1){
indexad=*i*neq1[1];
indexau=(long long)*i*nzs1[2];
- }
+// }
if(*rhsi1==1){
indexfext=*i*neq1[1];
}
@@ -396,7 +422,7 @@ void *mafillsmmt(ITG *i){
// printf("i=%d,nea=%d,neb=%d\n",*i,nea,neb);
- FORTRAN(mafillsm1,(co1,nk1,kon1,ipkon1,lakon1,ne1,nodeboun1,ndirboun1,
+ 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,
diff --git a/ccx_2.9/src/mafillsmmain_se.c b/ccx_2.10/src/mafillsmmain_se.c
similarity index 82%
rename from ccx_2.9/src/mafillsmmain_se.c
rename to ccx_2.10/src/mafillsmmain_se.c
index da6522f..8da0b84 100644
--- a/ccx_2.9/src/mafillsmmain_se.c
+++ b/ccx_2.10/src/mafillsmmain_se.c
@@ -36,7 +36,7 @@ static ITG *nk1,*kon1,*ipkon1,*ne1,*nodeboun1,*ndirboun1,*nboun1,
*mortar1,*ielprop1,*ne01,num_cpus,*ndesi1,*nodedesi1,*ndirdesi1;
static double *co1,*xboun1,*coefmpc1,*xforc1,*xload1,*xbody1,*cgr1,
- *ad1=NULL,*au1=NULL,*fext1=NULL,*elcon1,*rhcon1,*alcon1,*alzero1,
+ *ad1=NULL,*au1=NULL,*elcon1,*rhcon1,*alcon1,*alzero1,
*orab1,*t01,*t11,*prestr1,*vold1,*sti1,*stx1,*adb1=NULL,*aub1=NULL,
*plicon1,*plkcon1,*xstiff1,*dtime1,*physcon1,*shcon1,*cocon1,
*ttime1,*time1,*xloadold1,*reltime1,*veold1,*springarea1,
@@ -78,8 +78,8 @@ void mafillsmmain_se(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
double *fnext,double *distmin,ITG *ndesi,ITG *nodedesi,
ITG *ndirdesi,double *dfextminds){
- ITG i,j,k,mt=mi[1]+1;
-
+ ITG i,j,mt=mi[1]+1;
+
/* variables for multithreading procedure */
ITG sys_cpus,*ithread=NULL;
@@ -149,6 +149,8 @@ void mafillsmmain_se(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
/* allocating fields for mass and stiffness matrix and sensitivity matrix */
+ NNEW(dfextminds1,double,num_cpus**ndesi**neq);
+
if(*buckling!=1){
NNEW(ad1,double,num_cpus*neq[1]);
NNEW(au1,double,num_cpus*nzs[2]);
@@ -202,7 +204,6 @@ void mafillsmmain_se(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
pslavsurf1=pslavsurf;pmastsurf1=pmastsurf;mortar1=mortar;
clearini1=clearini;ielprop1=ielprop;prop1=prop;ne01=ne0;
distmin1=distmin;ndesi1=ndesi;nodedesi1=nodedesi;ndirdesi1=ndirdesi;
- dfextminds1=dfextminds;
/* calculating the stiffness/mass */
@@ -213,20 +214,12 @@ void mafillsmmain_se(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
NNEW(ithread,ITG,num_cpus);
for(i=0; i<num_cpus; i++) {
ithread[i]=i;
- pthread_create(&tid[i], NULL, (void *)mafillsm_semt, (void *)&ithread[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(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]);}
- for(k=i*neq[1];k<i*neq[1]+neq[1];++k){printf("adb=%" ITGFORMAT ",%f\n",k-i*neq[1],adb1[k]);}
- for(k=i*nzs[2];k<i*nzs[2]+nzs[2];++k){printf("aub=%" ITGFORMAT ",%f\n",k-i*nzs[2],aub1[k]);}
- }*/
-
/* copying and accumulating the stiffnes and/or mass matrix */
if(*buckling!=1){
@@ -327,24 +320,13 @@ void mafillsmmain_se(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,
}
SFREE(dfextminds1);
-
- /* 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;
+ return;
}
/* subroutine for multithreading of mafillsm */
-void *mafillsm_semt(ITG *i){
+void *mafillsmsemt(ITG *i){
ITG indexad,indexau,indexfext,indexadb,indexaub,nea,neb,nedelta,indexfnext;
@@ -383,27 +365,20 @@ void *mafillsm_semt(ITG *i){
printf("i=%d,nea=%d,neb=%d\n",*i,nea,neb);
- FORTRAN(mafillsm_se,(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],
- 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,
+ 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,
- 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,distmin1,ndesi1,nodedesi1,ndirdesi1,
- dfextminds1));
-
+ 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,
+ ndirdesi1,dfextminds1));
+
return NULL;
}
diff --git a/ccx_2.9/src/mafillsm_se.f b/ccx_2.10/src/mafillsmse.f
similarity index 61%
rename from ccx_2.9/src/mafillsm_se.f
rename to ccx_2.10/src/mafillsmse.f
index 3e941e1..d3c11d3 100644
--- a/ccx_2.9/src/mafillsm_se.f
+++ b/ccx_2.10/src/mafillsmse.f
@@ -16,25 +16,18 @@
! along with this program; if not, write to the Free Software
! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
!
- subroutine mafillsm_se(co,nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,
- & xboun,nboun,
- & ipompc,nodempc,coefmpc,nmpc,nodeforc,ndirforc,xforc,
- & nforc,nelemload,sideload,xload,nload,xbody,ipobody,nbody,cgr,
- & ad,au,nactdof,icol,jq,irow,neq,nzl,nmethod,
- & ikmpc,ilmpc,ikboun,ilboun,elcon,nelcon,rhcon,
+ subroutine mafillsmse(co,kon,ipkon,lakon,ne,ipompc,nodempc,
+ & coefmpc,nmpc,nelemload,sideload,xload,nload,xbody,ipobody,
+ & nbody,cgr,nactdof,neq,nmethod,ikmpc,ilmpc,elcon,nelcon,rhcon,
& nrhcon,alcon,nalcon,alzero,ielmat,ielorien,norien,orab,ntmat_,
- & t0,t1,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,nea,neb,distmin,ndesi,
- & nodedesi,ndirdesi,dfextminds)
-!
-! filling the stiffness matrix in spare matrix format (sm)
+ & t0,t1,ithermal,iprestr,vold,iperturb,sti,stx,iexpl,plicon,
+ & nplicon,plkcon,nplkcon,xstiff,npmat_,dtime,matname,mi,
+ & ncmat_,mass,stiffness,buckling,rhsi,intscheme,physcon,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,nea,
+ & neb,distmin,ndesi,nodedesi,ndirdesi,dfextminds)
!
implicit none
!
@@ -45,65 +38,48 @@
character*80 matname(*)
character*81 tieset(3,*)
!
- integer kon(*),nodeboun(*),ndirboun(*),ipompc(*),nodempc(3,*),
- & nodeforc(2,*),ndirforc(*),nelemload(2,*),icol(*),jq(*),ikmpc(*),
- & ilmpc(*),ikboun(*),ilboun(*),mi(*),nstate_,ne0,nasym,
- & nactdof(0:mi(2),*),irow(*),icolumn,ialset(*),ielprop(*),
- & nelcon(2,*),nrhcon(*),nalcon(2,*),ielmat(mi(3),*),ntie,
- & ielorien(mi(3),*),integerglob(*),istartset(*),iendset(*),
- & ipkon(*),intscheme,ncocon(2,*),nshcon(*),ipobody(2,*),nbody,
- & ibody(3,*),nk,ne,nboun,nmpc,nforc,nload,neq(2),nzl,nmethod,
- & ithermal(2),iprestr,iperturb(*),nzs(3),i,j,k,l,m,idist,jj,
- & ll,id,id1,id2,ist,ist1,ist2,index,jdof1,jdof2,idof1,idof2,
- & mpc1,mpc2,index1,index2,jdof,node1,node2,kflag,icalccg,
- & ntmat_,indexe,nope,norien,iexpl,i0,ncmat_,istep,iinc,
- & nplicon(0:ntmat_,*),nplkcon(0:ntmat_,*),npmat_,mortar,
- & nea,neb,ndesi,nodedesi(*),ndirdesi(*),desvar
-!
- real*8 co(3,*),xboun(*),coefmpc(*),xforc(*),xload(2,*),p1(3),
- & p2(3),ad(*),au(*),bodyf(3),xloadold(2,*),reltime,
- & t0(*),t1(*),prestr(6,mi(1),*),vold(0:mi(2),*),s(100,100),
- & ff(100),fnext(0:mi(2),*),
- & sti(6,mi(1),*),sm(100,100),stx(6,mi(1),*),adb(*),aub(*),
- & elcon(0:ncmat_,ntmat_,*),rhcon(0:1,ntmat_,*),springarea(2,*),
- & alcon(0:6,ntmat_,*),physcon(*),cocon(0:6,ntmat_,*),prop(*),
- & xstate(nstate_,mi(1),*),xstateini(nstate_,mi(1),*),
- & shcon(0:3,ntmat_,*),alzero(*),orab(7,*),xbody(7,*),cgr(4,*),
- & plicon(0:2*npmat_,ntmat_,*),plkcon(0:2*npmat_,ntmat_,*),
- & xstiff(27,mi(1),*),veold(0:mi(2),*),om,valu2,value,dtime,ttime,
- & time,thicke(mi(3),*),doubleglob(*),clearini(3,9,*),
- & pslavsurf(3,*),pmastsurf(6,*),distmin,
- & dfminds(ndesi,100),dfextminds(ndesi,*)
-!
- intent(in) co,nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,
- & xboun,nboun,
- & ipompc,nodempc,coefmpc,nmpc,nodeforc,ndirforc,xforc,
- & nforc,nelemload,sideload,nload,xbody,ipobody,nbody,
- & nactdof,icol,jq,irow,neq,nzl,
- & ikmpc,ilmpc,ikboun,ilboun,elcon,nelcon,rhcon,
- & nrhcon,alcon,nalcon,alzero,ielmat,ielorien,norien,orab,ntmat_,
- & t0,t1,ithermal,prestr,
- & iprestr,vold,iperturb,sti,nzs,stx,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,nstate_,
- & xstateini,thicke,integerglob,doubleglob,
- & tieset,istartset,iendset,ialset,ntie,nasym,pslavsurf,pmastsurf,
- & mortar,clearini,ielprop,prop,ne0,nea,neb,ndesi,nodedesi,
- & ndirdesi,distmin
-!
- intent(inout) ad,au,adb,aub,xload,nmethod,cgr,springarea,
- & xstate
+ integer kon(*),ipompc(*),nodempc(3,*),nelemload(2,*),ikmpc(*),
+ & ilmpc(*),mi(*),nstate_,ne0,nasym,nactdof(0:mi(2),*),ialset(*),
+ & ielprop(*),nelcon(2,*),nrhcon(*),nalcon(2,*),ielmat(mi(3),*),
+ & ntie,ielorien(mi(3),*),integerglob(*),istartset(*),iendset(*),
+ & ipkon(*),intscheme,ipobody(2,*),nbody,ibody(3,*),ne,nmpc,
+ & nload,neq(2),nmethod,ithermal(2),iprestr,iperturb(*),i,j,k,
+ & idist,jj,id,ist,index,jdof1,idof1,node1,kflag,icalccg,ntmat_,
+ & indexe,nope,norien,iexpl,i0,ncmat_,istep,iinc,
+ & nplicon(0:ntmat_,*),nplkcon(0:ntmat_,*),npmat_,mortar,nea,
+ & neb,ndesi,nodedesi(*),ndirdesi(*),desvar
+!
+ real*8 co(3,*),coefmpc(*),xload(2,*),p1(3),p2(3),bodyf(3),
+ & xloadold(2,*),reltime,t0(*),t1(*),vold(0:mi(2),*),
+ & s(100,100),ff(100),sti(6,mi(1),*),sm(100,100),
+ & stx(6,mi(1),*),elcon(0:ncmat_,ntmat_,*),
+ & rhcon(0:1,ntmat_,*),springarea(2,*),alcon(0:6,ntmat_,*),
+ & physcon(*),prop(*),xstate(nstate_,mi(1),*),
+ & xstateini(nstate_,mi(1),*),alzero(*),orab(7,*),
+ & xbody(7,*),cgr(4,*),plicon(0:2*npmat_,ntmat_,*),
+ & plkcon(0:2*npmat_,ntmat_,*),xstiff(27,mi(1),*),
+ & veold(0:mi(2),*),om,dtime,ttime,time,thicke(mi(3),*),
+ & doubleglob(*),clearini(3,9,*),pslavsurf(3,*),
+ & pmastsurf(6,*),distmin,dfminds(ndesi,100),
+ & dfextminds(ndesi,*)
+!
+ intent(in) co,kon,ipkon,lakon,ne,ipompc,nodempc,coefmpc,nmpc,
+ & nelemload,sideload,nload,xbody,ipobody,nbody,nactdof,neq,
+ & ikmpc,ilmpc,elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,
+ & ielmat,ielorien,norien,orab,ntmat_,t0,t1,ithermal,iprestr,
+ & vold,iperturb,sti,stx,iexpl,plicon,nplicon,plkcon,nplkcon,
+ & xstiff,npmat_,dtime,matname,mi,ncmat_,mass,stiffness,
+ & buckling,rhsi,intscheme,physcon,ttime,time,istep,iinc,
+ & coriolis,ibody,xloadold,reltime,veold,nstate_,xstateini,
+ & thicke,integerglob,doubleglob,tieset,istartset,iendset,
+ & ialset,ntie,nasym,pslavsurf,pmastsurf,mortar,clearini,
+ & ielprop,prop,ne0,nea,neb,ndesi,nodedesi,ndirdesi,distmin
+!
+ intent(inout) xload,nmethod,cgr,springarea,xstate
!
kflag=2
i0=0
icalccg=0
-c write(*,*) loc(kflag)
- write(*,*) loc(s)
-c write(*,*) loc(sm)
-c write(*,*) loc(ff)
-c write(*,*) loc(index1)
!
if((stiffness.eq.1).and.(mass(1).eq.0).and.(buckling.eq.0)) then
stiffonly(1)=1
@@ -116,6 +92,22 @@ c write(*,*) loc(index1)
stiffonly(2)=0
endif
!
+! initializing the matrices dfextminds
+!
+ do i=1,ndesi
+ do j=1,neq(2)
+ dfextminds(i,j)=0.d0
+ enddo
+ enddo
+!
+! initializing the matrices dfminds
+!
+ do i=1,ndesi
+ do j=1,neq(2)
+ dfminds(i,j)=0.d0
+ enddo
+ enddo
+!
if(rhsi.eq.1) then
!
! distributed forces (body forces or thermal loads or
@@ -144,14 +136,10 @@ c Bernhardi start
elseif(lakon(i)(4:5).eq.'20') then
c Bernhardi end
nope=20
- elseif(lakon(i)(4:4).eq.'2') then
- nope=26
elseif(lakon(i)(4:4).eq.'8') then
nope=8
elseif(lakon(i)(4:5).eq.'10') then
nope=10
- elseif(lakon(i)(4:5).eq.'14') then
- nope=14
elseif(lakon(i)(4:4).eq.'4') then
nope=4
elseif(lakon(i)(4:5).eq.'15') then
@@ -236,6 +224,7 @@ c nope=nope+1
& clearini,ielprop,prop,distmin,ndesi,nodedesi,ndirdesi,
& dfminds)
!
+ do desvar=1,ndesi
do jj=1,3*nope
!
j=(jj-1)/3+1
@@ -257,12 +246,10 @@ c nope=nope+1
jdof1=nactdof(nodempc(2,index),
& nodempc(1,index))
if(jdof1.ne.0) then
- do desvar=1,ndesi
dfextminds(desvar,jdof1)=
& dfextminds(desvar,jdof1)
& -coefmpc(index)*dfminds(desvar,jj)
& /coefmpc(ist)
- enddo
endif
index=nodempc(3,index)
if(index.eq.0) exit
@@ -273,8 +260,8 @@ c nope=nope+1
endif
dfextminds(desvar,jdof1)=dfextminds(desvar,jdof1)+
& dfminds(desvar,jj)
-!
enddo
+ enddo
enddo
endif
!
diff --git a/ccx_2.9/src/mafillt.f b/ccx_2.10/src/mafillt.f
similarity index 88%
rename from ccx_2.9/src/mafillt.f
rename to ccx_2.10/src/mafillt.f
index 0511d20..29189fb 100644
--- a/ccx_2.9/src/mafillt.f
+++ b/ccx_2.10/src/mafillt.f
@@ -18,9 +18,9 @@
!
subroutine mafillt(nef,ipnei,neifa,neiel,vfa,xxn,area,
& au,ad,jq,irow,nzs,b,vel,umel,xlet,xle,gradtfa,xxi,
- & body,volume,compressible,ielfa,lakon,ifabou,nbody,neq,
- & dtimef,velo,veloo,cpfa,hcfa,cpel,gradvel,xload,gammat,xrlfa,
- & xxj,nactdohinv,a1,a2,a3,flux)
+ & body,volume,ielfa,lakonf,ifabou,nbody,neq,
+ & dtimef,velo,veloo,cvfa,hcfa,cvel,gradvel,xload,gammat,xrlfa,
+ & xxj,nactdohinv,a1,a2,a3,flux,nefa,nefb)
!
! filling the matrix for the conservation of energy
!
@@ -28,25 +28,33 @@
!
logical knownflux
!
- character*8 lakon(*)
+ character*8 lakonf(*)
!
integer i,nef,jdof1,indexf,ipnei(*),j,ifa,iel,neifa(*),
- & neiel(*),jdof2,jq(*),irow(*),nzs,compressible,ielfa(4,*),
+ & neiel(*),jdof2,jq(*),irow(*),nzs,ielfa(4,*),nefa,nefb,
& ipointer,ifabou(*),nbody,neq,indexb,numfaces,nactdohinv(*)
!
real*8 xflux,vfa(0:5,*),xxn(3,*),area(*),au(*),ad(*),b(neq),
& vel(nef,0:5),umel(*),xlet(*),xle(*),coef,gradtfa(3,*),
& xxi(3,*),body(0:3,*),volume(*),dtimef,velo(nef,0:5),
- & veloo(nef,0:5),rhovol,constant,cpel(*),gradvel(3,3,*),
- & cpfa(*),hcfa(*),div,xload(2,*),gammat(*),xrlfa(3,*),
+ & veloo(nef,0:5),rhovol,constant,cvel(*),gradvel(3,3,*),
+ & cvfa(*),hcfa(*),div,xload(2,*),gammat(*),xrlfa(3,*),
& xxj(3,*),a1,a2,a3,flux(*)
!
- do i=1,nef
+ intent(in) nef,ipnei,neifa,neiel,vfa,xxn,area,
+ & jq,irow,nzs,vel,umel,xlet,xle,gradtfa,xxi,
+ & body,volume,ielfa,lakonf,ifabou,nbody,neq,
+ & dtimef,velo,veloo,cvfa,hcfa,cvel,gradvel,xload,gammat,xrlfa,
+ & xxj,nactdohinv,a1,a2,a3,flux,nefa,nefb
+!
+ intent(inout) au,ad,b
+!
+ do i=nefa,nefb
jdof1=i
indexf=ipnei(i)
- if(lakon(i)(4:4).eq.'8') then
+ if(lakonf(i)(4:4).eq.'8') then
numfaces=6
- elseif(lakon(i)(4:4).eq.'6') then
+ elseif(lakonf(i)(4:4).eq.'6') then
numfaces=5
else
numfaces=4
@@ -59,7 +67,7 @@
ifa=neifa(indexf)
iel=neiel(indexf)
if(iel.ne.0) jdof2=iel
- xflux=flux(indexf)*cpfa(ifa)
+ xflux=flux(indexf)*cvfa(ifa)
!
if(xflux.ge.0.d0) then
!
@@ -195,7 +203,7 @@ c & body(2,i),body(3,i)
!
! transient term
!
- constant=rhovol*cpel(i)
+ constant=rhovol*cvel(i)
b(jdof1)=b(jdof1)-(a2*velo(i,0)+a3*veloo(i,0))*constant
constant=a1*constant
call add_sm_fl(au,ad,jq,irow,jdof1,jdof1,constant,nzs)
diff --git a/ccx_2.9/src/mafilltcomp.f b/ccx_2.10/src/mafilltcomp.f
similarity index 81%
rename from ccx_2.9/src/mafilltcomp.f
rename to ccx_2.10/src/mafilltcomp.f
index b7bd1f8..872f367 100644
--- a/ccx_2.9/src/mafilltcomp.f
+++ b/ccx_2.10/src/mafilltcomp.f
@@ -18,9 +18,9 @@
!
subroutine mafilltcomp(nef,ipnei,neifa,neiel,vfa,xxn,area,
& au,ad,jq,irow,nzs,b,vel,umel,xlet,xle,gradtfa,xxi,
- & body,volume,compressible,ielfa,lakon,ifabou,nbody,neq,
- & dtimef,velo,veloo,cpfa,hcfa,cpel,gradvel,xload,gammat,xrlfa,
- & xxj,nactdohinv,a1,a2,a3,flux)
+ & body,volume,ielfa,lakonf,ifabou,nbody,neq,
+ & dtimef,velo,veloo,cvfa,hcfa,cvel,gradvel,xload,gammat,xrlfa,
+ & xxj,nactdohinv,a1,a2,a3,flux,nefa,nefb)
!
! filling the matrix for the conservation of energy
!
@@ -28,25 +28,34 @@
!
logical knownflux
!
- character*8 lakon(*)
+ character*8 lakonf(*)
!
integer i,nef,jdof1,indexf,ipnei(*),j,ifa,iel,neifa(*),
- & neiel(*),jdof2,jq(*),irow(*),nzs,compressible,ielfa(4,*),
- & ipointer,ifabou(*),nbody,neq,indexb,numfaces,nactdohinv(*)
+ & neiel(*),jdof2,jq(*),irow(*),nzs,ielfa(4,*),
+ & ipointer,ifabou(*),nbody,neq,indexb,numfaces,nactdohinv(*),
+ & nefa,nefb
!
real*8 xflux,vfa(0:5,*),xxn(3,*),area(*),au(*),ad(*),b(neq),
& vel(nef,0:5),umel(*),xlet(*),xle(*),coef,gradtfa(3,*),
& xxi(3,*),body(0:3,*),volume(*),dtimef,velo(nef,0:5),
- & veloo(nef,0:5),rhovel,constant,cpel(*),gradvel(3,3,*),
- & cpfa(*),hcfa(*),div,xload(2,*),gammat(*),xrlfa(3,*),
+ & veloo(nef,0:5),rhovel,constant,cvel(*),gradvel(3,3,*),
+ & cvfa(*),hcfa(*),div,xload(2,*),gammat(*),xrlfa(3,*),
& xxj(3,*),a1,a2,a3,flux(*)
!
- do i=1,nef
+ intent(in) nef,ipnei,neifa,neiel,vfa,xxn,area,
+ & jq,irow,nzs,vel,umel,xlet,xle,gradtfa,xxi,
+ & body,volume,ielfa,lakonf,ifabou,nbody,neq,
+ & dtimef,velo,veloo,cvfa,hcfa,cvel,gradvel,xload,gammat,xrlfa,
+ & xxj,nactdohinv,a1,a2,a3,flux,nefa,nefb
+!
+ intent(inout) au,ad,b
+!
+ do i=nefa,nefb
jdof1=i
indexf=ipnei(i)
- if(lakon(i)(4:4).eq.'8') then
+ if(lakonf(i)(4:4).eq.'8') then
numfaces=6
- elseif(lakon(i)(4:4).eq.'6') then
+ elseif(lakonf(i)(4:4).eq.'6') then
numfaces=5
else
numfaces=4
@@ -59,11 +68,12 @@
ifa=neifa(indexf)
iel=neiel(indexf)
if(iel.ne.0) jdof2=iel
- xflux=flux(indexf)*cpfa(ifa)
+ xflux=flux(indexf)*cvfa(ifa)
c xflux=(vfa(1,ifa)*xxn(1,indexf)+
c & vfa(2,ifa)*xxn(2,indexf)+
c & vfa(3,ifa)*xxn(3,indexf))
-c & *vfa(5,ifa)*cpfa(ifa)*area(ifa)
+c & *vfa(5,ifa)*cvfa(ifa)*area(ifa)
+c write(*,*) 'mafilltcomp ',i,j,flux(indexf),xflux
!
if(xflux.ge.0.d0) then
!
@@ -72,7 +82,7 @@ c & *vfa(5,ifa)*cpfa(ifa)*area(ifa)
call add_sm_fl_as(au,ad,jq,irow,jdof1,jdof1,
& xflux,nzs)
! centdiff
-c b(jdof1)=b(jdof1)-(vfa(0,ifa)-vel(i,0))*xflux
+c b(jdof1)=b(jdof1)-0.4*(vfa(0,ifa)-vel(i,0))*xflux
!end centdiff
else
if(iel.gt.0) then
@@ -82,7 +92,7 @@ c b(jdof1)=b(jdof1)-(vfa(0,ifa)-vel(i,0))*xflux
call add_sm_fl_as(au,ad,jq,irow,jdof1,jdof2,xflux,
& nzs)
!centdiff
-c b(jdof1)=b(jdof1)-(vfa(0,ifa)-vel(iel,0))*xflux
+c b(jdof1)=b(jdof1)-0.4*(vfa(0,ifa)-vel(iel,0))*xflux
!end centdiff
else
!
@@ -178,10 +188,8 @@ c call exit(201)
!
! -p*div(v) term
!
- if(compressible.eq.1) then
- div=gradvel(1,1,i)+gradvel(2,2,i)+gradvel(3,3,i)
- b(jdof1)=b(jdof1)-vel(i,4)*div*volume(i)
- endif
+ div=gradvel(1,1,i)+gradvel(2,2,i)+gradvel(3,3,i)
+ b(jdof1)=b(jdof1)-vel(i,4)*div*volume(i)
!
! viscous dissipation
!
@@ -191,9 +199,7 @@ c call exit(201)
& (gradvel(1,2,i)+gradvel(2,1,i))**2+
& (gradvel(1,3,i)+gradvel(3,1,i))**2+
& (gradvel(2,3,i)+gradvel(3,2,i))**2)
- if(compressible.eq.1) then
- b(jdof1)=b(jdof1)-2.d0*umel(i)*volume(i)/3.d0*div**2
- endif
+ b(jdof1)=b(jdof1)-2.d0*umel(i)*volume(i)/3.d0*div**2
!
! body heat source and body sources
!
@@ -209,9 +215,14 @@ c & body(2,i),body(3,i)
!
! transient term
!
- constant=rhovel*cpel(i)
- b(jdof1)=b(jdof1)-(a2*velo(i,0)+a3*veloo(i,0))*constant
- constant=a1*constant
+c a1=1.d0/dtimef
+c a2=-1.d0/dtimef
+c a3=0.d0/dtimef
+c constant=rhovel*cvel(i)
+c b(jdof1)=b(jdof1)-(a2*velo(i,0)+a3*veloo(i,0))*constant
+c
+ constant=rhovel*cvel(i)/dtimef
+ b(jdof1)=b(jdof1)+velo(i,0)*constant
call add_sm_fl(au,ad,jq,irow,jdof1,jdof1,constant,nzs)
!
enddo
diff --git a/ccx_2.10/src/mafilltcompmain.c b/ccx_2.10/src/mafilltcompmain.c
new file mode 100644
index 0000000..cb93673
--- /dev/null
+++ b/ccx_2.10/src/mafilltcompmain.c
@@ -0,0 +1,202 @@
+/* CalculiX - A 3-dimensional finite element program */
+/* Copyright (C) 1998-2015 Guido Dhondt */
+
+/* This program is free software; you can redistribute it and/or */
+/* modify it under the terms of the GNU General Public License as */
+/* published by the Free Software Foundation(version 2); */
+/* */
+
+/* This program is distributed in the hope that it will be useful, */
+/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
+/* GNU General Public License for more details. */
+
+/* You should have received a copy of the GNU General Public License */
+/* along with this program; if not, write to the Free Software */
+/* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+#include <unistd.h>
+#include <stdio.h>
+#include <math.h>
+#include <stdlib.h>
+#include <pthread.h>
+#include "CalculiX.h"
+
+static char *lakonf1;
+
+static ITG num_cpus,*nef1,*ipnei1,*neifa1,*neiel1,*jq1,*irow1,*nzs1,
+ *ielfa1,*ifabou1,*nbody1,*neq1,*nactdohinv1;
+
+static double *au1=NULL,*ad1=NULL,*b1=NULL,*vfa1,*xxn1,*area1,*vel1,
+ *umel1,*xlet1,*xle1,*gradtfa1,*xxi1,*body1,*volume1,*dtimef1,*velo1,
+ *veloo1,*cvfa1,*hcfa1,*cvel1,*gradvel1,*xload1,*gammat1,*xrlfa1,
+ *xxj1,*a11,*a21,*a31,*flux1;
+
+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 *cvfa,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 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];
+
+ /* allocating fields for lhs and rhs matrix */
+
+ NNEW(ad1,double,num_cpus**neq);
+ NNEW(au1,double,(long long)num_cpus*2**nzs);
+ NNEW(b1,double,num_cpus**neq);
+
+ /* 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;
+ gammat1=gammat;xrlfa1=xrlfa;xxj1=xxj;nactdohinv1=nactdohinv;a11=a1;
+ a21=a2;a31=a3;flux1=flux;
+
+ /* 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);
+
+ /* copying and accumulating the stiffnes and/or mass matrix */
+
+#pragma omp parallel \
+ default(none) \
+ shared(neq,ad,ad1,num_cpus,nzs,au,au1,b,b1) \
+ private(i,j)
+ {
+ #pragma omp for
+ for(i=0;i<*neq;i++){
+ ad[i]=ad1[i];
+ for(j=1;j<num_cpus;j++){
+ ad[i]+=ad1[i+j**neq];
+ }
+ }
+
+ #pragma omp for
+ for(i=0;i<2**nzs;i++){
+ au[i]=au1[i];
+ for(j=1;j<num_cpus;j++){
+ au[i]+=au1[i+(long long)j*2**nzs];
+ }
+ }
+
+ #pragma omp for
+ for(i=0;i<*neq;i++){
+ b[i]=b1[i];
+ for(j=1;j<num_cpus;j++){
+ b[i]+=b1[i+j**neq];
+ }
+ }
+ }
+
+ SFREE(ad1);
+ SFREE(au1);
+ SFREE(b1);
+
+ return;
+
+}
+
+/* subroutine for multithreading of mafilltcomp */
+
+void *mafilltcompmt(ITG *i){
+
+ ITG indexad,indexb,nefa,nefb,nefdelta;
+ long long indexau;
+
+ indexad=*i**neq1;
+ indexau=(long long)*i*2**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(mafilltcomp,(nef1,ipnei1,neifa1,neiel1,vfa1,xxn1,area1,
+ &au1[indexau],&ad1[indexad],jq1,irow1,nzs1,
+ &b1[indexb],vel1,umel1,xlet1,xle1,gradtfa1,xxi1,
+ body1,volume1,ielfa1,lakonf1,ifabou1,
+ nbody1,neq1,dtimef1,velo1,veloo1,cvfa1,hcfa1,cvel1,
+ gradvel1,xload1,gammat1,xrlfa1,xxj1,nactdohinv1,
+ a11,a21,a31,flux1,&nefa,&nefb));
+
+ return NULL;
+}
diff --git a/ccx_2.10/src/mafilltmain.c b/ccx_2.10/src/mafilltmain.c
new file mode 100644
index 0000000..8139b49
--- /dev/null
+++ b/ccx_2.10/src/mafilltmain.c
@@ -0,0 +1,202 @@
+/* CalculiX - A 3-dimensional finite element program */
+/* Copyright (C) 1998-2015 Guido Dhondt */
+
+/* This program is free software; you can redistribute it and/or */
+/* modify it under the terms of the GNU General Public License as */
+/* published by the Free Software Foundation(version 2); */
+/* */
+
+/* This program is distributed in the hope that it will be useful, */
+/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
+/* GNU General Public License for more details. */
+
+/* You should have received a copy of the GNU General Public License */
+/* along with this program; if not, write to the Free Software */
+/* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+#include <unistd.h>
+#include <stdio.h>
+#include <math.h>
+#include <stdlib.h>
+#include <pthread.h>
+#include "CalculiX.h"
+
+static char *lakonf1;
+
+static ITG num_cpus,*nef1,*ipnei1,*neifa1,*neiel1,*jq1,*irow1,*nzs1,
+ *ielfa1,*ifabou1,*nbody1,*neq1,*nactdohinv1;
+
+static double *au1=NULL,*ad1=NULL,*b1=NULL,*vfa1,*xxn1,*area1,*vel1,
+ *umel1,*xlet1,*xle1,*gradtfa1,*xxi1,*body1,*volume1,*dtimef1,*velo1,
+ *veloo1,*cvfa1,*hcfa1,*cvel1,*gradvel1,*xload1,*gammat1,*xrlfa1,
+ *xxj1,*a11,*a21,*a31,*flux1;
+
+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 *cvfa,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 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];
+
+ /* allocating fields for lhs and rhs matrix */
+
+ NNEW(ad1,double,num_cpus**neq);
+ NNEW(au1,double,(long long)num_cpus*2**nzs);
+ NNEW(b1,double,num_cpus**neq);
+
+ /* 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;
+ gammat1=gammat;xrlfa1=xrlfa;xxj1=xxj;nactdohinv1=nactdohinv;a11=a1;
+ a21=a2;a31=a3;flux1=flux;
+
+ /* 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);
+
+ /* copying and accumulating the stiffnes and/or mass matrix */
+
+#pragma omp parallel \
+ default(none) \
+ shared(neq,ad,ad1,num_cpus,nzs,au,au1,b,b1) \
+ private(i,j)
+ {
+ #pragma omp for
+ for(i=0;i<*neq;i++){
+ ad[i]=ad1[i];
+ for(j=1;j<num_cpus;j++){
+ ad[i]+=ad1[i+j**neq];
+ }
+ }
+
+ #pragma omp for
+ for(i=0;i<2**nzs;i++){
+ au[i]=au1[i];
+ for(j=1;j<num_cpus;j++){
+ au[i]+=au1[i+(long long)j*2**nzs];
+ }
+ }
+
+ #pragma omp for
+ for(i=0;i<*neq;i++){
+ b[i]=b1[i];
+ for(j=1;j<num_cpus;j++){
+ b[i]+=b1[i+j**neq];
+ }
+ }
+ }
+
+ SFREE(ad1);
+ SFREE(au1);
+ SFREE(b1);
+
+ return;
+
+}
+
+/* subroutine for multithreading of mafillt */
+
+void *mafilltmt(ITG *i){
+
+ ITG indexad,indexb,nefa,nefb,nefdelta;
+ long long indexau;
+
+ indexad=*i**neq1;
+ indexau=(long long)*i*2**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(mafillt,(nef1,ipnei1,neifa1,neiel1,vfa1,xxn1,area1,
+ &au1[indexau],&ad1[indexad],jq1,irow1,nzs1,
+ &b1[indexb],vel1,umel1,xlet1,xle1,gradtfa1,xxi1,
+ body1,volume1,ielfa1,lakonf1,ifabou1,
+ nbody1,neq1,dtimef1,velo1,veloo1,cvfa1,hcfa1,cvel1,
+ gradvel1,xload1,gammat1,xrlfa1,xxj1,nactdohinv1,
+ a11,a21,a31,flux1,&nefa,&nefb));
+
+ return NULL;
+}
diff --git a/ccx_2.9/src/mafillv.f b/ccx_2.10/src/mafillv.f
similarity index 93%
rename from ccx_2.9/src/mafillv.f
rename to ccx_2.10/src/mafillv.f
index 3f59940..5c2e93f 100644
--- a/ccx_2.9/src/mafillv.f
+++ b/ccx_2.10/src/mafillv.f
@@ -18,17 +18,17 @@
!
subroutine mafillv(nef,ipnei,neifa,neiel,vfa,xxn,area,
& auv,adv,jq,irow,nzs,bv,vel,cosa,umfa,xlet,xle,gradvfa,xxi,
- & body,volume,ielfa,lakon,ifabou,nbody,neq,
+ & body,volume,ielfa,lakonf,ifabou,nbody,neq,
& dtimef,velo,veloo,sel,xrlfa,gamma,xxj,nactdohinv,a1,
- & a2,a3,flux)
+ & a2,a3,flux,nefa,nefb)
!
implicit none
!
character*2 one,two,three
- character*8 lakon(*)
+ character*8 lakonf(*)
!
integer i,nef,jdof1,indexf,ipnei(*),j,ifa,iel,neifa(*),
- & neiel(*),jdof2,jq(*),irow(*),nzs,iwall,ielfa(4,*),
+ & neiel(*),jdof2,jq(*),irow(*),nzs,iwall,ielfa(4,*),nefa,nefb,
& ipointer,ifabou(*),nbody,neq,k,indexb,numfaces,nactdohinv(*)
!
real*8 xflux,vfa(0:5,*),xxn(3,*),area(*),auv(*),adv(*),bv(neq,3),
@@ -37,16 +37,24 @@
& veloo(nef,0:5),rhovel,constant,sel(3,*),xrlfa(3,*),gamma(*),
& xxj(3,*),a1,a2,a3,flux(*)
!
+ intent(in) nef,ipnei,neifa,neiel,vfa,xxn,area,
+ & jq,irow,nzs,vel,cosa,umfa,xlet,xle,gradvfa,xxi,
+ & body,volume,ielfa,lakonf,ifabou,nbody,neq,
+ & dtimef,velo,veloo,xrlfa,gamma,xxj,nactdohinv,a1,
+ & a2,a3,flux
+!
+ intent(inout) adv,auv,bv,sel
+!
one='b1'
two='b2'
three='b3'
!
- do i=1,nef
+ do i=nefa,nefb
jdof1=i
indexf=ipnei(i)
- if(lakon(i)(4:4).eq.'8') then
+ if(lakonf(i)(4:4).eq.'8') then
numfaces=6
- elseif(lakon(i)(4:4).eq.'6') then
+ elseif(lakonf(i)(4:4).eq.'6') then
numfaces=5
else
numfaces=4
@@ -60,10 +68,6 @@
iel=neiel(indexf)
if(iel.ne.0) jdof2=iel
xflux=flux(indexf)
-c xflux=(vfa(1,ifa)*xxn(1,indexf)+
-c & vfa(2,ifa)*xxn(2,indexf)+
-c & vfa(3,ifa)*xxn(3,indexf))
-c & *vfa(5,ifa)*area(ifa)
!
! vfa sometimes undefined?
!
@@ -97,25 +101,25 @@ c write(*,*) 'mafillv2 ',bv(1,1),bv(1,2),bv(1,3)
if(((ifabou(indexb+1).ne.0).and.
& (ifabou(indexb+2).ne.0).and.
& (ifabou(indexb+3).ne.0)).or.
-c & (dabs(xflux).lt.1.d-3)) then
& (dabs(xflux).lt.1.d-10)) then
bv(jdof1,1)=bv(jdof1,1)-vfa(1,ifa)*xflux
bv(jdof1,2)=bv(jdof1,2)-vfa(2,ifa)*xflux
bv(jdof1,3)=bv(jdof1,3)-vfa(3,ifa)*xflux
-c write(*,*) 'mafillv3 ',bv(1,1),bv(1,2),bv(1,3)
else
write(*,*) '*ERROR in mafillv: not all'
write(*,*) ' components of an incoming'
write(*,*) ' flux through face ',j
write(*,*)' of element ',nactdohinv(i),
- & ' are given'
+ & ' are given',
+ &vfa(1,ifa),vfa(2,ifa),vfa(3,ifa)
endif
else
write(*,*) '*ERROR in mafillv: not all'
write(*,*) ' components of an incoming'
write(*,*) ' flux through face ',j
write(*,*)' of element ',nactdohinv(i),
- & ' are given'
+ & ' are given',
+ &vfa(1,ifa),vfa(2,ifa),vfa(3,ifa)
endif
endif
endif
@@ -158,7 +162,7 @@ c write(*,*) 'mafillv4 ',bv(1,1),bv(1,2),bv(1,3)
if(ipointer.gt.0) then
iwall=ifabou(ipointer+5)
endif
- if(iwall.eq.0) then
+ if(iwall.ne.1) then
!
! external face, but no wall
!
diff --git a/ccx_2.9/src/mafillvcomp.f b/ccx_2.10/src/mafillvcomp.f
similarity index 84%
rename from ccx_2.9/src/mafillvcomp.f
rename to ccx_2.10/src/mafillvcomp.f
index 3bca519..5fe79a3 100644
--- a/ccx_2.9/src/mafillvcomp.f
+++ b/ccx_2.10/src/mafillvcomp.f
@@ -18,16 +18,16 @@
!
subroutine mafillvcomp(nef,ipnei,neifa,neiel,vfa,xxn,area,
& auv,adv,jq,irow,nzs,bv,vel,cosa,umfa,xlet,xle,gradvfa,xxi,
- & body,volume,ielfa,lakon,ifabou,nbody,neq,
+ & body,volume,ielfa,lakonf,ifabou,nbody,neq,
& dtimef,velo,veloo,sel,xrlfa,gamma,xxj,nactdohinv,a1,
- & a2,a3,flux)
+ & a2,a3,flux,nefa,nefb)
!
implicit none
!
character*2 one,two,three
- character*8 lakon(*)
+ character*8 lakonf(*)
!
- integer i,nef,jdof1,indexf,ipnei(*),j,ifa,iel,neifa(*),
+ integer i,nef,jdof1,indexf,ipnei(*),j,ifa,iel,neifa(*),nefa,nefb,
& neiel(*),jdof2,jq(*),irow(*),nzs,iwall,compressible,ielfa(4,*),
& ipointer,ifabou(*),nbody,neq,k,indexb,numfaces,nactdohinv(*)
!
@@ -37,16 +37,24 @@
& veloo(nef,0:5),rhovel,constant,sel(3,*),xrlfa(3,*),gamma(*),
& xxj(3,*),a1,a2,a3,flux(*)
!
+ intent(in) nef,ipnei,neifa,neiel,vfa,xxn,area,
+ & jq,irow,nzs,vel,cosa,umfa,xlet,xle,gradvfa,xxi,
+ & body,volume,ielfa,lakonf,ifabou,nbody,neq,
+ & dtimef,velo,veloo,xrlfa,gamma,xxj,nactdohinv,a1,
+ & a2,a3,flux
+!
+ intent(inout) adv,auv,bv,sel
+!
one='b1'
two='b2'
three='b3'
!
- do i=1,nef
+ do i=nefa,nefb
jdof1=i
indexf=ipnei(i)
- if(lakon(i)(4:4).eq.'8') then
+ if(lakonf(i)(4:4).eq.'8') then
numfaces=6
- elseif(lakon(i)(4:4).eq.'6') then
+ elseif(lakonf(i)(4:4).eq.'6') then
numfaces=5
else
numfaces=4
@@ -59,14 +67,7 @@
ifa=neifa(indexf)
iel=neiel(indexf)
if(iel.ne.0) jdof2=iel
-c xflux=flux(indexf)
-c write(*,*) 'mafillvcomp ',i,j,xflux
- xflux=(vfa(1,ifa)*xxn(1,indexf)+
- & vfa(2,ifa)*xxn(2,indexf)+
- & vfa(3,ifa)*xxn(3,indexf))
- & *vfa(5,ifa)*area(ifa)
-c! vfa sometimes undefined?
-c write(*,*) 'mafillvcomp ',i,j,xflux
+ xflux=flux(indexf)
!
if(xflux.ge.0.d0) then
!
@@ -75,9 +76,9 @@ c write(*,*) 'mafillvcomp ',i,j,xflux
call add_sm_fl_as(auv,adv,jq,irow,jdof1,jdof1,
& xflux,nzs)
cccc
-c bv(jdof1,1)=bv(jdof1,1)-(vfa(1,ifa)-vel(i,1))*xflux
-c bv(jdof1,2)=bv(jdof1,2)-(vfa(2,ifa)-vel(i,2))*xflux
-c bv(jdof1,3)=bv(jdof1,3)-(vfa(3,ifa)-vel(i,3))*xflux
+c bv(jdof1,1)=bv(jdof1,1)-0.4*(vfa(1,ifa)-vel(i,1))*xflux
+c bv(jdof1,2)=bv(jdof1,2)-0.4*(vfa(2,ifa)-vel(i,2))*xflux
+c bv(jdof1,3)=bv(jdof1,3)-0.4*(vfa(3,ifa)-vel(i,3))*xflux
cccc
c write(*,*) 'mafillv1 ',bv(1,1),bv(1,2),bv(1,3)
else
@@ -88,9 +89,9 @@ c write(*,*) 'mafillv1 ',bv(1,1),bv(1,2),bv(1,3)
call add_sm_fl_as(auv,adv,jq,irow,jdof1,jdof2,xflux,
& nzs)
cccc
-c bv(jdof1,1)=bv(jdof1,1)-(vfa(1,ifa)-vel(iel,1))*xflux
-c bv(jdof1,2)=bv(jdof1,2)-(vfa(2,ifa)-vel(iel,2))*xflux
-c bv(jdof1,3)=bv(jdof1,3)-(vfa(3,ifa)-vel(iel,3))*xflux
+c bv(jdof1,1)=bv(jdof1,1)-0.4*(vfa(1,ifa)-vel(iel,1))*xflux
+c bv(jdof1,2)=bv(jdof1,2)-0.4*(vfa(2,ifa)-vel(iel,2))*xflux
+c bv(jdof1,3)=bv(jdof1,3)-0.4*(vfa(3,ifa)-vel(iel,3))*xflux
cccc
c write(*,*) 'mafillv2 ',bv(1,1),bv(1,2),bv(1,3)
else
@@ -163,7 +164,8 @@ c write(*,*) 'mafillv4 ',bv(1,1),bv(1,2),bv(1,3)
if(ipointer.gt.0) then
iwall=ifabou(ipointer+5)
endif
- if(iwall.eq.0) then
+c if(iwall.eq.0) then
+ if(iwall.ne.1) then
!
! external face, but no wall
!
@@ -258,19 +260,22 @@ c write(*,*) 'mafillv7 ',bv(1,1),bv(1,2),bv(1,3)
bv(jdof1,1)=bv(jdof1,1)+rhovel*body(1,i)
bv(jdof1,2)=bv(jdof1,2)+rhovel*body(2,i)
bv(jdof1,3)=bv(jdof1,3)+rhovel*body(3,i)
-c write(*,*) 'mafillv9 ',bv(1,1),bv(1,2),bv(1,3)
endif
!
! transient term
!
- constant=rhovel
- bv(jdof1,1)=bv(jdof1,1)-(a2*velo(i,1)+a3*veloo(i,1))*constant
- bv(jdof1,2)=bv(jdof1,2)-(a2*velo(i,2)+a3*veloo(i,2))*constant
- bv(jdof1,3)=bv(jdof1,3)-(a2*velo(i,3)+a3*veloo(i,3))*constant
-c write(*,*) 'mafillv10 ',bv(1,1),bv(1,2),bv(1,3)
-c write(*,*) 'mafillv10 ',velo(1,1),veloo(1,1),constant
-c write(*,*) 'mafillv10 ',rhovel,dtimef,vel(i,5)
- constant=a1*constant
+c a1=1.d0/dtimef
+c a2=-1.d0/dtimef
+c a3=0.d0/dtimef
+c constant=rhovel
+ constant=rhovel/dtimef
+c bv(jdof1,1)=bv(jdof1,1)-(a2*velo(i,1)+a3*veloo(i,1))*constant
+c bv(jdof1,2)=bv(jdof1,2)-(a2*velo(i,2)+a3*veloo(i,2))*constant
+c bv(jdof1,3)=bv(jdof1,3)-(a2*velo(i,3)+a3*veloo(i,3))*constant
+ bv(jdof1,1)=bv(jdof1,1)+velo(i,1)*constant
+ bv(jdof1,2)=bv(jdof1,2)+velo(i,2)*constant
+ bv(jdof1,3)=bv(jdof1,3)+velo(i,3)*constant
+c constant=a1*constant
call add_sm_fl(auv,adv,jq,irow,jdof1,jdof1,constant,nzs)
!
! copying b into sel (rhs without pressure)
@@ -278,7 +283,6 @@ c write(*,*) 'mafillv10 ',rhovel,dtimef,vel(i,5)
do j=1,3
sel(j,jdof1)=bv(jdof1,j)
enddo
-c write(*,*) 'mafillv sel ',sel(1,1),sel(2,1),sel(3,1)
!
! pressure contribution to b
!
@@ -295,13 +299,6 @@ c write(*,*) 'mafillv sel ',sel(1,1),sel(2,1),sel(3,1)
enddo
!
enddo
-!
-c do i=1,nzs
-c write(*,*) 'mafillv auv,irow',i,auv(i),auv(i+nzs)
-c enddo
-c do i=1,nef
-c write(*,*) 'mafillv b adv',i,bv(i,1),adv(i)
-c enddo
!
return
end
diff --git a/ccx_2.10/src/mafillvcompmain.c b/ccx_2.10/src/mafillvcompmain.c
new file mode 100644
index 0000000..702b5ff
--- /dev/null
+++ b/ccx_2.10/src/mafillvcompmain.c
@@ -0,0 +1,199 @@
+/* CalculiX - A 3-dimensional finite element program */
+/* Copyright (C) 1998-2015 Guido Dhondt */
+
+/* This program is free software; you can redistribute it and/or */
+/* modify it under the terms of the GNU General Public License as */
+/* published by the Free Software Foundation(version 2); */
+/* */
+
+/* This program is distributed in the hope that it will be useful, */
+/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
+/* GNU General Public License for more details. */
+
+/* You should have received a copy of the GNU General Public License */
+/* along with this program; if not, write to the Free Software */
+/* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+#include <unistd.h>
+#include <stdio.h>
+#include <math.h>
+#include <stdlib.h>
+#include <pthread.h>
+#include "CalculiX.h"
+
+static char *lakonf1;
+
+static ITG num_cpus,*nef1,*ipnei1,*neifa1,*neiel1,*jq1,*irow1,*nzs1,*ielfa1,*
+ ifabou1,*nbody1,*neq1,*nactdohinv1;
+
+static double *auv1=NULL,*adv1=NULL,*bv1=NULL,*vfa1,*xxn1,*area1,*vel1,
+ *cosa1,*umfa1,*xlet1,*xle1,*gradvfa1,*xxi1,*body1,*volume1,*dtimef1,
+ *velo1,*veloo1,*sel1,*xrlfa1,*gamma1,*xxj1,*a11,*a21,*a31,*flux1;
+
+void mafillvcompmain(ITG *nef,ITG *ipnei,ITG *neifa,ITG *neiel,
+ double *vfa,double *xxn,double *area,double *auv,double *adv,
+ ITG *jq,ITG *irow,ITG *nzs,double *bv,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,ITG *neq,
+ 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 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];
+
+ /* allocating fields for lhs and rhs matrix */
+
+ NNEW(adv1,double,num_cpus**neq);
+ NNEW(auv1,double,(long long)num_cpus*2**nzs);
+ NNEW(bv1,double,num_cpus*3**neq);
+
+ /* 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;neq1=neq;
+ dtimef1=dtimef;velo1=velo;veloo1=veloo;sel1=sel;xrlfa1=xrlfa;
+ gamma1=gamma;xxj1=xxj;nactdohinv1=nactdohinv;a11=a1;a21=a2;a31=a3;
+ flux1=flux;
+
+ /* 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);
+
+ /* copying and accumulating the stiffnes and/or mass matrix */
+
+#pragma omp parallel \
+ default(none) \
+ shared(neq,adv,adv1,num_cpus,nzs,auv,auv1,bv,bv1) \
+ private(i,j)
+ {
+
+ #pragma omp for
+ for(i=0;i<*neq;i++){
+ adv[i]=adv1[i];
+ for(j=1;j<num_cpus;j++){
+ adv[i]+=adv1[i+j**neq];
+ }
+ }
+
+ #pragma omp for
+ for(i=0;i<2**nzs;i++){
+ auv[i]=auv1[i];
+ for(j=1;j<num_cpus;j++){
+ auv[i]+=auv1[i+(long long)j*2**nzs];
+ }
+ }
+
+ #pragma omp for
+ for(i=0;i<3**neq;i++){
+ bv[i]=bv1[i];
+ for(j=1;j<num_cpus;j++){
+ bv[i]+=bv1[i+j*3**neq];
+ }
+ }
+ }
+
+ SFREE(adv1);
+ SFREE(auv1);
+ SFREE(bv1);
+
+ return;
+
+}
+
+/* subroutine for multithreading of mafillpcomp */
+
+void *mafillvcompmt(ITG *i){
+
+ ITG indexadv,indexbv,nefa,nefb,nefdelta;
+ long long indexauv;
+
+ indexadv=*i**neq1;
+ indexauv=(long long)*i*2**nzs1;
+ indexbv=*i*3**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(mafillvcomp,(nef1,ipnei1,neifa1,neiel1,vfa1,xxn1,area1,
+ &auv1[indexauv],&adv1[indexadv],jq1,irow1,nzs1,&bv1[indexbv],
+ vel1,cosa1,umfa1,xlet1,xle1,gradvfa1,xxi1,
+ body1,volume1,ielfa1,lakonf1,ifabou1,nbody1,neq1,
+ dtimef1,velo1,veloo1,sel1,xrlfa1,gamma1,xxj1,nactdohinv1,a11,
+ a21,a31,flux1,&nefa,&nefb));
+
+ return NULL;
+}
diff --git a/ccx_2.10/src/mafillvmain.c b/ccx_2.10/src/mafillvmain.c
new file mode 100644
index 0000000..dfd41cd
--- /dev/null
+++ b/ccx_2.10/src/mafillvmain.c
@@ -0,0 +1,197 @@
+/* CalculiX - A 3-dimensional finite element program */
+/* Copyright (C) 1998-2015 Guido Dhondt */
+
+/* This program is free software; you can redistribute it and/or */
+/* modify it under the terms of the GNU General Public License as */
+/* published by the Free Software Foundation(version 2); */
+/* */
+
+/* This program is distributed in the hope that it will be useful, */
+/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
+/* GNU General Public License for more details. */
+
+/* You should have received a copy of the GNU General Public License */
+/* along with this program; if not, write to the Free Software */
+/* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+#include <unistd.h>
+#include <stdio.h>
+#include <math.h>
+#include <stdlib.h>
+#include <pthread.h>
+#include "CalculiX.h"
+
+static char *lakonf1;
+
+static ITG num_cpus,*nef1,*ipnei1,*neifa1,*neiel1,*jq1,*irow1,*nzs1,*ielfa1,*
+ ifabou1,*nbody1,*neq1,*nactdohinv1;
+
+static double *auv1=NULL,*adv1=NULL,*bv1=NULL,*vfa1,*xxn1,*area1,*vel1,
+ *cosa1,*umfa1,*xlet1,*xle1,*gradvfa1,*xxi1,*body1,*volume1,*dtimef1,
+ *velo1,*veloo1,*sel1,*xrlfa1,*gamma1,*xxj1,*a11,*a21,*a31,*flux1;
+
+void mafillvmain(ITG *nef,ITG *ipnei,ITG *neifa,ITG *neiel,
+ double *vfa,double *xxn,double *area,double *auv,double *adv,
+ ITG *jq,ITG *irow,ITG *nzs,double *bv,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,ITG *neq,
+ 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 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];
+
+ /* allocating fields for lhs and rhs matrix */
+
+ NNEW(adv1,double,num_cpus**neq);
+ NNEW(auv1,double,(long long)num_cpus*2**nzs);
+ NNEW(bv1,double,num_cpus*3**neq);
+
+ /* 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;neq1=neq;
+ dtimef1=dtimef;velo1=velo;veloo1=veloo;sel1=sel;xrlfa1=xrlfa;
+ gamma1=gamma;xxj1=xxj;nactdohinv1=nactdohinv;a11=a1;a21=a2;a31=a3;
+ flux1=flux;
+
+ /* 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);
+
+ /* copying and accumulating the stiffnes and/or mass matrix */
+
+#pragma omp parallel \
+ default(none) \
+ shared(neq,adv,adv1,num_cpus,nzs,auv,auv1,bv,bv1) \
+ private(i,j)
+ {
+
+ #pragma omp for
+ for(i=0;i<*neq;i++){
+ adv[i]=adv1[i];
+ for(j=1;j<num_cpus;j++){
+ adv[i]+=adv1[i+j**neq];
+ }
+ }
+
+ #pragma omp for
+ for(i=0;i<2**nzs;i++){
+ auv[i]=auv1[i];
+ for(j=1;j<num_cpus;j++){
+ auv[i]+=auv1[i+(long long)j*2**nzs];
+ }
+ }
+
+ #pragma omp for
+ for(i=0;i<3**neq;i++){
+ bv[i]=bv1[i];
+ for(j=1;j<num_cpus;j++){
+ bv[i]+=bv1[i+j*3**neq];
+ }
+ }
+ }
+
+ SFREE(adv1);
+ SFREE(auv1);
+ SFREE(bv1);
+
+ return;
+
+}
+
+/* subroutine for multithreading of mafillv */
+
+void *mafillvmt(ITG *i){
+
+ ITG indexadv,indexbv,nefa,nefb,nefdelta;
+ long long indexauv;
+
+ indexadv=*i**neq1;
+ indexauv=(long long)*i*2**nzs1;
+ indexbv=*i*3**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(mafillv,(nef1,ipnei1,neifa1,neiel1,vfa1,xxn1,area1,
+ &auv1[indexauv],&adv1[indexadv],jq1,irow1,nzs1,&bv1[indexbv],
+ vel1,cosa1,umfa1,xlet1,xle1,gradvfa1,xxi1,
+ body1,volume1,ielfa1,lakonf1,ifabou1,nbody1,neq1,
+ dtimef1,velo1,veloo1,sel1,xrlfa1,gamma1,xxj1,nactdohinv1,a11,
+ a21,a31,flux1,&nefa,&nefb));
+
+ return NULL;
+}
diff --git a/ccx_2.9/src/magneticpermeabilitys.f b/ccx_2.10/src/magneticpermeabilitys.f
similarity index 100%
rename from ccx_2.9/src/magneticpermeabilitys.f
rename to ccx_2.10/src/magneticpermeabilitys.f
diff --git a/ccx_2.9/src/map3dto1d2d.f b/ccx_2.10/src/map3dto1d2d.f
similarity index 96%
rename from ccx_2.9/src/map3dto1d2d.f
rename to ccx_2.10/src/map3dto1d2d.f
index 9762cc2..7080027 100644
--- a/ccx_2.9/src/map3dto1d2d.f
+++ b/ccx_2.10/src/map3dto1d2d.f
@@ -92,9 +92,6 @@
elseif(lakonl(4:5).eq.'20') then
indexe2d=indexe+20
jmax=3
- elseif(lakonl(4:5).eq.'26') then
- indexe2d=indexe+26
- jmax=3
endif
do j=1,jmax
node2d=kon(indexe2d+j)
@@ -113,9 +110,6 @@
elseif(lakonl(4:5).eq.'20') then
indexe2d=indexe+20
jmax=8
- elseif(lakonl(4:5).eq.'26') then
- indexe2d=indexe+26
- jmax=8
endif
do j=1,jmax
node2d=kon(indexe2d+j)
@@ -249,11 +243,6 @@
jmax=3
jinc=2
nope=8
- elseif(lakonl(4:5).eq.'26') then
- indexe2d=indexe+26
- jmax=3
- jinc=2
- nope=8
endif
if(cflag.ne.'M') then
!
@@ -469,9 +458,6 @@
elseif(lakonl(4:5).eq.'20') then
indexe2d=indexe+20
jmax=8
- elseif(lakonl(4:5).eq.'26') then
- indexe2d=indexe+26
- jmax=8
endif
do j=1,jmax
node2d=kon(indexe2d+j)
@@ -582,9 +568,6 @@
elseif(lakonl(4:5).eq.'20') then
indexe2d=indexe+20
jmax=3
- elseif(lakonl(4:5).eq.'26') then
- indexe2d=indexe+26
- jmax=3
endif
do j=1,jmax
node2d=kon(indexe2d+j)
@@ -605,9 +588,6 @@
elseif(lakonl(4:5).eq.'20') then
indexe2d=indexe+20
jmax=8
- elseif(lakonl(4:5).eq.'26') then
- indexe2d=indexe+26
- jmax=8
endif
do j=1,jmax
node2d=kon(indexe2d+j)
@@ -646,11 +626,7 @@
if((lakonl(4:4).eq.'6').or.(lakonl(4:4).eq.'8')) cycle
!
if(lakonl(7:7).eq.'B') then
- if(lakonl(4:5).eq.'20') then
- indexe2d=indexe+20
- else
- indexe2d=indexe+26
- endif
+ indexe2d=indexe+20
if(cflag.eq.'M') then
!
! section forces in the middle node are the mean
diff --git a/ccx_2.9/src/map3dto1d2d_v.f b/ccx_2.10/src/map3dto1d2d_v.f
similarity index 100%
rename from ccx_2.9/src/map3dto1d2d_v.f
rename to ccx_2.10/src/map3dto1d2d_v.f
diff --git a/ccx_2.9/src/map3dtolayer.f b/ccx_2.10/src/map3dtolayer.f
similarity index 100%
rename from ccx_2.9/src/map3dtolayer.f
rename to ccx_2.10/src/map3dtolayer.f
diff --git a/ccx_2.9/src/massflow_percent.f b/ccx_2.10/src/massflow_percent.f
similarity index 100%
rename from ccx_2.9/src/massflow_percent.f
rename to ccx_2.10/src/massflow_percent.f
diff --git a/ccx_2.9/src/massflows.f b/ccx_2.10/src/massflows.f
similarity index 100%
rename from ccx_2.9/src/massflows.f
rename to ccx_2.10/src/massflows.f
diff --git a/ccx_2.9/src/mastruct.c b/ccx_2.10/src/mastruct.c
similarity index 93%
rename from ccx_2.9/src/mastruct.c
rename to ccx_2.10/src/mastruct.c
index d6e33e7..80a7532 100644
--- a/ccx_2.9/src/mastruct.c
+++ b/ccx_2.10/src/mastruct.c
@@ -41,8 +41,8 @@ void mastruct(ITG *nk, ITG *kon, ITG *ipkon, char *lakon, ITG *ne,
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,
- indexeold,identical;
+ *irow=NULL,icolumn,nmastboun,mt=mi[1]+1,jmax,*next=NULL,nopeold=0,
+ indexeold=0,identical,jstart;
/* the indices in the comments follow FORTRAN convention, i.e. the
fields start with 1 */
@@ -609,6 +609,14 @@ void mastruct(ITG *nk, ITG *kon, ITG *ipkon, char *lakon, ITG *ne,
- 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;
@@ -620,17 +628,9 @@ void mastruct(ITG *nk, ITG *kon, ITG *ipkon, char *lakon, ITG *ne,
index=next[index-1];
}while(1);
jq[i+1]=nmast+1;
- icol[i]=jq[i+1]-jq[i];
+// icol[i]=jq[i+1]-jq[i];
}
- /* 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");
-
/* sorting the row numbers within each column */
for(i=0;i<neq[1];++i){
@@ -640,12 +640,46 @@ void mastruct(ITG *nk, ITG *kon, ITG *ipkon, char *lakon, ITG *ne,
}
}
+ /* 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 */
+ 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))){
@@ -655,11 +689,10 @@ void mastruct(ITG *nk, ITG *kon, ITG *ipkon, char *lakon, ITG *ne,
do{
if(index==0) break;
irow[nmastboun++]=mast1[index-1];
-// if(i==720) printf("mastruct i=%d,index=%d,idof1=%d\n",i,index,mast1[index-1]);
index=next[index-1];
}while(1);
jq[i+1]=nmastboun+1;
- icol[i]=jq[i+1]-jq[i];
+// icol[i]=jq[i+1]-jq[i];
}
/* sorting the row numbers within each column */
@@ -670,24 +703,38 @@ void mastruct(ITG *nk, ITG *kon, ITG *ipkon, char *lakon, ITG *ne,
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];}
- /* for(i=0;i<nzs[2];i++){
- printf("i=%" ITGFORMAT ",irow[i]=%" ITGFORMAT "\n",i+1,irow[i]);
- }
- for(i=0;i<neq[2]+1;i++){
- printf("i=%" ITGFORMAT ",jq[i]=%" ITGFORMAT "\n",i+1,jq[i]);
- }*/
-
SFREE(next);
*mast1p=mast1;
*irowp=irow;
- /*for(i=0;i<4**nk;++i){printf("nactdof=%" ITGFORMAT ",%" ITGFORMAT "\n",i,nactdof[i]);}*/
-
return;
}
diff --git a/ccx_2.9/src/mastructcs.c b/ccx_2.10/src/mastructcs.c
similarity index 96%
rename from ccx_2.9/src/mastructcs.c
rename to ccx_2.10/src/mastructcs.c
index f52d9b0..3353042 100644
--- a/ccx_2.9/src/mastructcs.c
+++ b/ccx_2.10/src/mastructcs.c
@@ -42,7 +42,7 @@ void mastructcs(ITG *nk, ITG *kon, ITG *ipkon, char *lakon, ITG *ne,
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;
+ 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 */
@@ -448,16 +448,9 @@ void mastructcs(ITG *nk, ITG *kon, ITG *ipkon, char *lakon, ITG *ne,
index=next[index-1];
}while(1);
jq[i+1]=nmast+1;
- icol[i]=jq[i+1]-jq[i];
+// icol[i]=jq[i+1]-jq[i];
}
- /* summary */
-
- printf(" number of equations\n");
- printf(" %" ITGFORMAT "\n",neq[0]);
- printf(" number of nonzero lower triangular matrix elements\n");
- printf(" %" ITGFORMAT "\n",ifree);
-
/* sorting the row numbers within each column */
for(i=0;i<neq[0];++i){
@@ -466,11 +459,38 @@ void mastructcs(ITG *nk, ITG *kon, ITG *ipkon, char *lakon, ITG *ne,
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;
diff --git a/ccx_2.9/src/mastructem.c b/ccx_2.10/src/mastructem.c
similarity index 96%
rename from ccx_2.9/src/mastructem.c
rename to ccx_2.10/src/mastructem.c
index dbc464a..296a0b1 100644
--- a/ccx_2.9/src/mastructem.c
+++ b/ccx_2.10/src/mastructem.c
@@ -40,7 +40,7 @@ void mastructem(ITG *nk, ITG *kon, ITG *ipkon, char *lakon, ITG *ne,
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;
+ *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 */
@@ -537,38 +537,9 @@ void mastructem(ITG *nk, ITG *kon, ITG *ipkon, char *lakon, ITG *ne,
index=next[index-1];
}while(1);
jq[i+1]=nmast+1;
- icol[i]=jq[i+1]-jq[i];
+// icol[i]=jq[i+1]-jq[i];
}
- /* 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];
- }
-
- /* 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");
-
/* sorting the row numbers within each column */
for(i=0;i<neq[1];++i){
@@ -578,11 +549,39 @@ void mastructem(ITG *nk, ITG *kon, ITG *ipkon, char *lakon, ITG *ne,
}
}
+ /* 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);
diff --git a/ccx_2.9/src/mastructf.c b/ccx_2.10/src/mastructf.c
similarity index 88%
rename from ccx_2.9/src/mastructf.c
rename to ccx_2.10/src/mastructf.c
index 689658e..6fc688a 100644
--- a/ccx_2.9/src/mastructf.c
+++ b/ccx_2.10/src/mastructf.c
@@ -31,7 +31,7 @@ void mastructf(ITG *nk,ITG *kon,ITG *ipkon,char *lakon,ITG *ne,
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;
+ *next=NULL,jstart;
/* the indices in the comments follow FORTRAN convention, i.e. the
fields start with 1 */
@@ -89,17 +89,9 @@ void mastructf(ITG *nk,ITG *kon,ITG *ipkon,char *lakon,ITG *ne,
index=next[index-1];
}while(1);
jq[i+1]=nmast+1;
- icol[i]=jq[i+1]-jq[i];
+// icol[i]=jq[i+1]-jq[i];
}
- /* summary */
-
- printf(" number of equations\n");
- printf(" %" ITGFORMAT "\n",*neq);
- printf(" number of nonzero lower triangular matrix elements\n");
- printf(" %" ITGFORMAT "\n",nmast);
- printf("\n");
-
/* sorting the row numbers within each column */
for(i=0;i<*neq;++i){
@@ -108,6 +100,34 @@ void mastructf(ITG *nk,ITG *kon,ITG *ipkon,char *lakon,ITG *ne,
FORTRAN(isortii,(&irow[jq[i]-1],&mast1[jq[i]-1],&isize,&kflag));
}
}
+
+ /* removing duplicate entries */
+
+ nmast=0;
+ for(i=0;i<*neq;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]=nmast+1;
+
+ for(i=0;i<*neq;i++){
+ icol[i]=jq[i+1]-jq[i];
+ }
+
+ /* summary */
+
+ printf(" number of equations\n");
+ printf(" %" ITGFORMAT "\n",*neq);
+ printf(" number of nonzero lower triangular matrix elements\n");
+ printf(" %" ITGFORMAT "\n",nmast);
+ printf("\n");
*nzs=jq[*neq]-1;
diff --git a/ccx_2.9/src/mastructrad.c b/ccx_2.10/src/mastructrad.c
similarity index 100%
rename from ccx_2.9/src/mastructrad.c
rename to ccx_2.10/src/mastructrad.c
diff --git a/ccx_2.10/src/materialdata_cfd.f b/ccx_2.10/src/materialdata_cfd.f
new file mode 100644
index 0000000..0fed73b
--- /dev/null
+++ b/ccx_2.10/src/materialdata_cfd.f
@@ -0,0 +1,105 @@
+!
+! CalculiX - A 3-dimensional finite element program
+! Copyright (C) 1998-2015 Guido Dhondt
+!
+! This program is free software; you can redistribute it and/or
+! modify it under the terms of the GNU General Public License as
+! published by the Free Software Foundation(version 2);
+!
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program; if not, write to the Free Software
+! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+!
+ subroutine materialdata_cfd(nef,vel,shcon,nshcon,ielmatf,
+ & ntmat_,mi,cvel,vfa,cocon,ncocon,physcon,cvfa,ithermal,nface,
+ & umel,umfa,ielfa,hcfa,rhcon,nrhcon)
+!
+! calculation of material properties at elements centers and
+! face centers (incompressible fluids)
+!
+ implicit none
+!
+ integer nef,i,imat,ntmat_,mi(*),ielmatf(mi(3),*),ithermal,
+ & nshcon(2,*),nface,ncocon(2,*),ielfa(4,*),nrhcon(*)
+!
+ real*8 t1l,vel(nef,0:5),shcon(0:3,ntmat_,*),cvel(*),vfa(0:5,*),
+ & cocon(0:6,ntmat_,*),physcon(*),cvfa(*),umel(*),umfa(*),
+ & hcfa(*),rhcon(0:1,ntmat_,*)
+!
+ intent(in) nef,shcon,nshcon,ielmatf,
+ & ntmat_,mi,cocon,ncocon,physcon,ithermal,nface,
+ & ielfa
+!
+ intent(inout) vel,vfa,cvel,cvfa,umel,umfa,hcfa
+!
+c$omp parallel default(none)
+c$omp& shared(nef,vel,ielmatf,shcon,ntmat_,nshcon,physcon,cvel,umel,
+c$omp& ithermal,nface,vfa,ielfa,cvfa,umfa,hcfa,cocon,ncocon,
+c$omp& rhcon,nrhcon)
+c$omp& private(i,t1l,imat)
+!
+! element (cell) values
+!
+c$omp do
+ do i=1,nef
+ t1l=vel(i,0)
+ imat=ielmatf(1,i)
+!
+! density
+!
+ call materialdata_rho(rhcon,nrhcon,imat,vel(i,5),t1l,ntmat_,
+ & ithermal)
+!
+! heat capacity at constant volume
+! (for liquids: =heat capacity at constant pressure)
+!
+ call materialdata_cp_sec(imat,ntmat_,t1l,shcon,nshcon,cvel(i),
+ & physcon)
+!
+! dynamic viscosity
+!
+ call materialdata_dvi(shcon,nshcon,imat,umel(i),t1l,ntmat_,
+ & ithermal)
+ enddo
+c$omp end do
+!
+! facial values
+!
+c$omp do
+ do i=1,nface
+ t1l=vfa(0,i)
+!
+! take the material of the first adjacent element
+!
+ imat=ielmatf(1,ielfa(1,i))
+!
+! density
+!
+ call materialdata_rho(rhcon,nrhcon,imat,vfa(5,i),t1l,ntmat_,
+ & ithermal)
+!
+! heat capacity at constant volume
+!
+ call materialdata_cp_sec(imat,ntmat_,t1l,shcon,nshcon,cvfa(i),
+ & physcon)
+!
+! dynamic viscosity
+!
+ call materialdata_dvi(shcon,nshcon,imat,umfa(i),t1l,ntmat_,
+ & ithermal)
+!
+! heat conduction
+!
+ call materialdata_cond(imat,ntmat_,t1l,cocon,ncocon,hcfa(i))
+ enddo
+c$omp end do
+c$omp end parallel
+!
+ return
+ end
diff --git a/ccx_2.10/src/materialdata_cfd_comp.f b/ccx_2.10/src/materialdata_cfd_comp.f
new file mode 100644
index 0000000..4430ea9
--- /dev/null
+++ b/ccx_2.10/src/materialdata_cfd_comp.f
@@ -0,0 +1,109 @@
+!
+! CalculiX - A 3-dimensional finite element program
+! Copyright (C) 1998-2015 Guido Dhondt
+!
+! This program is free software; you can redistribute it and/or
+! modify it under the terms of the GNU General Public License as
+! published by the Free Software Foundation(version 2);
+!
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program; if not, write to the Free Software
+! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+!
+ subroutine materialdata_cfd_comp(nef,vel,shcon,nshcon,ielmatf,
+ & ntmat_,mi,cvel,vfa,cocon,ncocon,physcon,cvfa,ithermal,nface,
+ & umel,umfa,ielfa,hcfa)
+!
+! calculation of material properties at elements centers and
+! face centers (compressible fluids)
+!
+ implicit none
+!
+ integer nef,i,imat,ntmat_,mi(*),ielmatf(mi(3),*),ithermal,
+ & nshcon(2,*),nface,ncocon(2,*),ielfa(4,*)
+!
+ real*8 t1l,vel(nef,0:5),shcon(0:3,ntmat_,*),cvel(*),vfa(0:5,*),
+ & cp,cocon(0:6,ntmat_,*),physcon(*),cvfa(*),umel(*),umfa(*),
+ & hcfa(*)
+!
+ intent(in) nef,shcon,nshcon,ielmatf,
+ & ntmat_,mi,cocon,ncocon,physcon,ithermal,nface,
+ & ielfa
+!
+ intent(inout) vel,vfa,cvel,cvfa,umel,umfa,hcfa
+!
+c$omp parallel default(none)
+c$omp& shared(nef,vel,ielmatf,shcon,ntmat_,nshcon,physcon,cvel,umel,
+c$omp& ithermal,nface,vfa,ielfa,cvfa,umfa,hcfa,cocon,ncocon)
+c$omp& private(i,t1l,imat,cp)
+!
+! element (cell) values
+!
+c$omp do
+ do i=1,nef
+ t1l=vel(i,0)
+ imat=ielmatf(1,i)
+!
+! density
+!
+ vel(i,5)=vel(i,4)/(shcon(3,1,imat)*t1l)
+!
+! heat capacity at constant volume
+!
+ call materialdata_cp_sec(imat,ntmat_,t1l,shcon,nshcon,cp,
+ & physcon)
+!
+! cv=cp-r
+!
+ cvel(i)=cp-shcon(3,1,imat)
+!
+! dynamic viscosity
+!
+ call materialdata_dvi(shcon,nshcon,imat,umel(i),t1l,ntmat_,
+ & ithermal)
+ enddo
+c$omp end do
+!
+! facial values
+!
+c$omp do
+ do i=1,nface
+ t1l=vfa(0,i)
+!
+! take the material of the first adjacent element
+!
+ imat=ielmatf(1,ielfa(1,i))
+!
+! density
+!
+ vfa(5,i)=vfa(4,i)/(shcon(3,1,imat)*t1l)
+!
+! heat capacity at constant volume
+!
+ call materialdata_cp_sec(imat,ntmat_,t1l,shcon,nshcon,cp,
+ & physcon)
+!
+! cv=cp-r
+!
+ cvfa(i)=cp-shcon(3,1,imat)
+!
+! dynamic viscosity
+!
+ call materialdata_dvi(shcon,nshcon,imat,umfa(i),t1l,ntmat_,
+ & ithermal)
+!
+! heat conduction
+!
+ call materialdata_cond(imat,ntmat_,t1l,cocon,ncocon,hcfa(i))
+ enddo
+c$omp end do
+c$omp end parallel
+!
+ return
+ end
diff --git a/ccx_2.9/src/materialdata_cond.f b/ccx_2.10/src/materialdata_cond.f
similarity index 100%
rename from ccx_2.9/src/materialdata_cond.f
rename to ccx_2.10/src/materialdata_cond.f
diff --git a/ccx_2.9/src/materialdata_cp.f b/ccx_2.10/src/materialdata_cp.f
similarity index 100%
rename from ccx_2.9/src/materialdata_cp.f
rename to ccx_2.10/src/materialdata_cp.f
diff --git a/ccx_2.9/src/materialdata_cp_sec.f b/ccx_2.10/src/materialdata_cp_sec.f
similarity index 100%
rename from ccx_2.9/src/materialdata_cp_sec.f
rename to ccx_2.10/src/materialdata_cp_sec.f
diff --git a/ccx_2.9/src/materialdata_dvi.f b/ccx_2.10/src/materialdata_dvi.f
similarity index 100%
rename from ccx_2.9/src/materialdata_dvi.f
rename to ccx_2.10/src/materialdata_dvi.f
diff --git a/ccx_2.9/src/materialdata_em.f b/ccx_2.10/src/materialdata_em.f
similarity index 100%
rename from ccx_2.9/src/materialdata_em.f
rename to ccx_2.10/src/materialdata_em.f
diff --git a/ccx_2.9/src/materialdata_me.f b/ccx_2.10/src/materialdata_me.f
similarity index 100%
rename from ccx_2.9/src/materialdata_me.f
rename to ccx_2.10/src/materialdata_me.f
diff --git a/ccx_2.9/src/materialdata_rho.f b/ccx_2.10/src/materialdata_rho.f
similarity index 100%
rename from ccx_2.9/src/materialdata_rho.f
rename to ccx_2.10/src/materialdata_rho.f
diff --git a/ccx_2.9/src/materialdata_sp.f b/ccx_2.10/src/materialdata_sp.f
similarity index 100%
rename from ccx_2.9/src/materialdata_sp.f
rename to ccx_2.10/src/materialdata_sp.f
diff --git a/ccx_2.9/src/materialdata_tg.f b/ccx_2.10/src/materialdata_tg.f
similarity index 100%
rename from ccx_2.9/src/materialdata_tg.f
rename to ccx_2.10/src/materialdata_tg.f
diff --git a/ccx_2.9/src/materialdata_th.f b/ccx_2.10/src/materialdata_th.f
similarity index 100%
rename from ccx_2.9/src/materialdata_th.f
rename to ccx_2.10/src/materialdata_th.f
diff --git a/ccx_2.9/src/materials.f b/ccx_2.10/src/materials.f
similarity index 100%
rename from ccx_2.9/src/materials.f
rename to ccx_2.10/src/materials.f
diff --git a/ccx_2.9/src/matrixstorage.c b/ccx_2.10/src/matrixstorage.c
similarity index 100%
rename from ccx_2.9/src/matrixstorage.c
rename to ccx_2.10/src/matrixstorage.c
diff --git a/ccx_2.9/src/matrixstorage.h b/ccx_2.10/src/matrixstorage.h
similarity index 100%
rename from ccx_2.9/src/matrixstorage.h
rename to ccx_2.10/src/matrixstorage.h
diff --git a/ccx_2.9/src/matvec.f b/ccx_2.10/src/matvec.f
similarity index 100%
rename from ccx_2.9/src/matvec.f
rename to ccx_2.10/src/matvec.f
diff --git a/ccx_2.9/src/meannode.f b/ccx_2.10/src/meannode.f
similarity index 100%
rename from ccx_2.9/src/meannode.f
rename to ccx_2.10/src/meannode.f
diff --git a/ccx_2.9/src/mechmodel.f b/ccx_2.10/src/mechmodel.f
similarity index 100%
rename from ccx_2.9/src/mechmodel.f
rename to ccx_2.10/src/mechmodel.f
diff --git a/ccx_2.9/src/modaldampings.f b/ccx_2.10/src/modaldampings.f
similarity index 100%
rename from ccx_2.9/src/modaldampings.f
rename to ccx_2.10/src/modaldampings.f
diff --git a/ccx_2.9/src/modaldynamics.f b/ccx_2.10/src/modaldynamics.f
similarity index 100%
rename from ccx_2.9/src/modaldynamics.f
rename to ccx_2.10/src/modaldynamics.f
diff --git a/ccx_2.9/src/modelchanges.f b/ccx_2.10/src/modelchanges.f
similarity index 100%
rename from ccx_2.9/src/modelchanges.f
rename to ccx_2.10/src/modelchanges.f
diff --git a/ccx_2.9/src/modf.f b/ccx_2.10/src/modf.f
similarity index 100%
rename from ccx_2.9/src/modf.f
rename to ccx_2.10/src/modf.f
diff --git a/ccx_2.9/src/moehring.f b/ccx_2.10/src/moehring.f
similarity index 100%
rename from ccx_2.9/src/moehring.f
rename to ccx_2.10/src/moehring.f
diff --git a/ccx_2.9/src/mpcrem.f b/ccx_2.10/src/mpcrem.f
similarity index 100%
rename from ccx_2.9/src/mpcrem.f
rename to ccx_2.10/src/mpcrem.f
diff --git a/ccx_2.9/src/mpcs.f b/ccx_2.10/src/mpcs.f
similarity index 100%
rename from ccx_2.9/src/mpcs.f
rename to ccx_2.10/src/mpcs.f
diff --git a/ccx_2.9/src/msolve.f b/ccx_2.10/src/msolve.f
similarity index 100%
rename from ccx_2.9/src/msolve.f
rename to ccx_2.10/src/msolve.f
diff --git a/ccx_2.9/src/mult.f b/ccx_2.10/src/mult.f
similarity index 100%
rename from ccx_2.9/src/mult.f
rename to ccx_2.10/src/mult.f
diff --git a/ccx_2.9/src/multistages.f b/ccx_2.10/src/multistages.f
similarity index 100%
rename from ccx_2.9/src/multistages.f
rename to ccx_2.10/src/multistages.f
diff --git a/ccx_2.9/src/multvec.f b/ccx_2.10/src/multvec.f
similarity index 100%
rename from ccx_2.9/src/multvec.f
rename to ccx_2.10/src/multvec.f
diff --git a/ccx_2.9/src/near2d.f b/ccx_2.10/src/near2d.f
similarity index 100%
rename from ccx_2.9/src/near2d.f
rename to ccx_2.10/src/near2d.f
diff --git a/ccx_2.9/src/near3d.f b/ccx_2.10/src/near3d.f
similarity index 100%
rename from ccx_2.9/src/near3d.f
rename to ccx_2.10/src/near3d.f
diff --git a/ccx_2.9/src/neartriangle.f b/ccx_2.10/src/neartriangle.f
similarity index 100%
rename from ccx_2.9/src/neartriangle.f
rename to ccx_2.10/src/neartriangle.f
diff --git a/ccx_2.9/src/negativepressure.f b/ccx_2.10/src/negativepressure.f
similarity index 100%
rename from ccx_2.9/src/negativepressure.f
rename to ccx_2.10/src/negativepressure.f
diff --git a/ccx_2.9/src/networkextrapolate.f b/ccx_2.10/src/networkextrapolate.f
similarity index 100%
rename from ccx_2.9/src/networkextrapolate.f
rename to ccx_2.10/src/networkextrapolate.f
diff --git a/ccx_2.9/src/networkforc.f b/ccx_2.10/src/networkforc.f
similarity index 100%
rename from ccx_2.9/src/networkforc.f
rename to ccx_2.10/src/networkforc.f
diff --git a/ccx_2.9/src/networkinum.f b/ccx_2.10/src/networkinum.f
similarity index 100%
rename from ccx_2.9/src/networkinum.f
rename to ccx_2.10/src/networkinum.f
diff --git a/ccx_2.9/src/networkstiff.f b/ccx_2.10/src/networkstiff.f
similarity index 100%
rename from ccx_2.9/src/networkstiff.f
rename to ccx_2.10/src/networkstiff.f
diff --git a/ccx_2.9/src/newton.f b/ccx_2.10/src/newton.f
similarity index 100%
rename from ccx_2.9/src/newton.f
rename to ccx_2.10/src/newton.f
diff --git a/ccx_2.9/src/nident.f b/ccx_2.10/src/nident.f
similarity index 100%
rename from ccx_2.9/src/nident.f
rename to ccx_2.10/src/nident.f
diff --git a/ccx_2.9/src/nident2.f b/ccx_2.10/src/nident2.f
similarity index 100%
rename from ccx_2.9/src/nident2.f
rename to ccx_2.10/src/nident2.f
diff --git a/ccx_2.9/src/nidentk.f b/ccx_2.10/src/nidentk.f
similarity index 100%
rename from ccx_2.9/src/nidentk.f
rename to ccx_2.10/src/nidentk.f
diff --git a/ccx_2.9/src/nidentll.f b/ccx_2.10/src/nidentll.f
similarity index 100%
rename from ccx_2.9/src/nidentll.f
rename to ccx_2.10/src/nidentll.f
diff --git a/ccx_2.9/src/noanalysiss.f b/ccx_2.10/src/noanalysiss.f
similarity index 100%
rename from ccx_2.9/src/noanalysiss.f
rename to ccx_2.10/src/noanalysiss.f
diff --git a/ccx_2.9/src/nodalthicknesss.f b/ccx_2.10/src/nodalthicknesss.f
similarity index 100%
rename from ccx_2.9/src/nodalthicknesss.f
rename to ccx_2.10/src/nodalthicknesss.f
diff --git a/ccx_2.9/src/nodeprints.f b/ccx_2.10/src/nodeprints.f
similarity index 100%
rename from ccx_2.9/src/nodeprints.f
rename to ccx_2.10/src/nodeprints.f
diff --git a/ccx_2.9/src/nodes.f b/ccx_2.10/src/nodes.f
similarity index 100%
rename from ccx_2.9/src/nodes.f
rename to ccx_2.10/src/nodes.f
diff --git a/ccx_2.9/src/nodestiedface.f b/ccx_2.10/src/nodestiedface.f
similarity index 91%
rename from ccx_2.9/src/nodestiedface.f
rename to ccx_2.10/src/nodestiedface.f
index 633cdff..54f3cb6 100644
--- a/ccx_2.9/src/nodestiedface.f
+++ b/ccx_2.10/src/nodestiedface.f
@@ -30,26 +30,26 @@
!
integer ntie,nset,istartset(*),iendset(*),ialset(*),ifree,
& ipkon(*),kon(*),node,ifaceslave(*),i,j,k,l,
- & ifaceq(9,6),ifacet(7,4),ilength,id,ncone,
+ & ifaceq(8,6),ifacet(6,4),ilength,id,ncone,
& ifacew1(4,5),ifacew2(8,5),nelem,jface,indexe,
& nnodelem,nface,nope,nodef(8),
& ifield(*),istartfield(*),iendfield(*),nconf
!
! nodes per face for hex elements
!
- data ifaceq /4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/
+ data ifaceq /4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/
!
! nodes per face for tet elements
!
- data ifacet /1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/
+ data ifacet /1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/
!
! nodes per face for linear wedge elements
!
diff --git a/ccx_2.9/src/noelfiles.f b/ccx_2.10/src/noelfiles.f
similarity index 98%
rename from ccx_2.9/src/noelfiles.f
rename to ccx_2.10/src/noelfiles.f
index 75de23a..8e259ee 100644
--- a/ccx_2.9/src/noelfiles.f
+++ b/ccx_2.10/src/noelfiles.f
@@ -699,6 +699,17 @@
filab(46)(6:6)=elemsys
filab(46)(7:87)=noset
endif
+ elseif(textpart(ii)(1:4).eq.'SEN ') then
+ if(nmethod.ne.12) then
+ write(*,*)
+ &'*WARNING reading *NODE FILE or *EL FILE: SEN only makes'
+ write(*,*) ' sense for sensitivity'
+ write(*,*) ' calculations'
+ else
+ filab(47)(1:4)='SEN '
+ filab(47)(6:6)=elemsys
+ filab(47)(7:87)=noset
+ endif
else
write(*,*)
&'*WARNING reading *NODE FILE or *EL FILE: label not applicable'
diff --git a/ccx_2.9/src/noelsets.f b/ccx_2.10/src/noelsets.f
similarity index 100%
rename from ccx_2.9/src/noelsets.f
rename to ccx_2.10/src/noelsets.f
diff --git a/ccx_2.9/src/nonlingeo.c b/ccx_2.10/src/nonlingeo.c
similarity index 87%
rename from ccx_2.9/src/nonlingeo.c
rename to ccx_2.10/src/nonlingeo.c
index ea931c8..c235d49 100644
--- a/ccx_2.9/src/nonlingeo.c
+++ b/ccx_2.10/src/nonlingeo.c
@@ -32,6 +32,7 @@
#include "pardiso.h"
#endif
+#define max(a,b) ((a) >= (b) ? (a) : (b))
void nonlingeo(double **cop, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
ITG *ne,
@@ -39,7 +40,7 @@ void nonlingeo(double **cop, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
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 **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,
@@ -56,7 +57,7 @@ void nonlingeo(double **cop, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
double *xbounold, double *xforcold, double *xloadold,
double *veold, double *accold,
char *amname, double *amta, ITG *namta, ITG *nam,
- ITG *iamforc, ITG *iamload,
+ ITG *iamforc, ITG **iamloadp,
ITG *iamt1, double *alpha, ITG *iexpl,
ITG *iamboun, double *plicon, ITG *nplicon, double *plkcon,
ITG *nplkcon,
@@ -81,7 +82,7 @@ void nonlingeo(double **cop, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
char description[13]=" ",*lakon=NULL,jobnamef[396]="",
*sideface=NULL,*labmpc=NULL,fnffrd[132]="",*lakonf=NULL,
- *sideloadref=NULL;
+ *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,n1,n2,itruecontact,
@@ -100,7 +101,7 @@ void nonlingeo(double **cop, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
*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,
+ *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,
@@ -112,8 +113,10 @@ void nonlingeo(double **cop, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
*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,j,nloadref,
- *nelemloadref=NULL,*iamloadref=NULL,*idefload=NULL,*nload_;
+ *ielmatf=NULL,*ielorienf=NULL,ialeatoric=0,nloadref,
+ *nelemloadref=NULL,*iamloadref=NULL,*idefload=NULL,nload_,
+ *nelemload=NULL,*iamload=NULL,ncontacts=0,inccontact=0,
+ pflag=0,j=0;
double *stn=NULL,*v=NULL,*een=NULL,cam[5],*epn=NULL,*cg=NULL,
*cdn=NULL,*vel=NULL,*vfa=NULL,*pslavsurfold=NULL,
@@ -143,7 +146,17 @@ void nonlingeo(double **cop, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
*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;
+ energyref,denergymax,dtcont,dtvol,wavespeed[*nmat],
+ emax,enres,enetoll,dampwk=0.,dampwkini,temax, //MPADD
+ scal2,*tmp=NULL,energystartstep[4], //MPADD
+ sizemaxinc, *adblump=NULL;
+
+ // MPADD: initialize enresmin to the tolerance
+ enetoll=0.02;
+ enres=0.0;
+ emax=0.0;
+ // MPADD end
+
#ifdef SGI
ITG token;
@@ -154,7 +167,8 @@ void nonlingeo(double **cop, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
ielmat=*ielmatp;ener=*enerp;xstate=*xstatep;
ipompc=*ipompcp;labmpc=*labmpcp;ikmpc=*ikmpcp;ilmpc=*ilmpcp;
- fmpc=*fmpcp;nodempc=*nodempcp;coefmpc=*coefmpcp;
+ fmpc=*fmpcp;nodempc=*nodempcp;coefmpc=*coefmpcp;nelemload=*nelemloadp;
+ iamload=*iamloadp;sideload=*sideloadp;
islavsurf=*islavsurfp;pslavsurf=*pslavsurfp;clearini=*clearinip;
@@ -448,6 +462,10 @@ void nonlingeo(double **cop, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
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));
@@ -705,23 +723,23 @@ void nonlingeo(double **cop, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
NNEW(ad,double,neq[1]);
NNEW(au,double,nzs[1]);
-
- FORTRAN(mafillsm,(co,nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,xbounold,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));
+
+ 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);
if(*nmethod==0){
@@ -869,6 +887,52 @@ void nonlingeo(double **cop, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
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 */
}
@@ -892,15 +956,6 @@ void nonlingeo(double **cop, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
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 */
-
- *nload_=*nload;
- (*nload_)+=ne0;
- RENEW(nelemload,ITG,2**nload_);
- if(*nam>0) RENEW(iamload,ITG,2**nload_);
- RENEW(xloadact,double,2**nload_);
- RENEW(sideload,char,20**nload_);
}
while((1.-theta>1.e-6)||(negpres==1)){
@@ -911,6 +966,11 @@ void nonlingeo(double **cop, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
iinc++;
jprint++;
+
+ /* store number of elements (important for implicit dynamic
+ contact */
+
+ neini=*ne;
/* vold is copied into vini */
@@ -933,8 +993,15 @@ void nonlingeo(double **cop, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
fextini[k]=fext[k];
cvini[k]=cv[k];
}
- allwkini=allwk;
- energyini[3]=energy[3];
+ 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){
@@ -976,14 +1043,11 @@ void nonlingeo(double **cop, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
if((*ithermal==3)&&(ncont!=0)&&(*mortar==1)&&(*ncmat_>=11)){
*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);
+ memcpy(&sideload[0],&sideloadref[0],sizeof(char)*20**nload);
}
/* determining the actual loads at the end of the new increment*/
@@ -1099,6 +1163,11 @@ void nonlingeo(double **cop, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
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));
@@ -1190,6 +1259,48 @@ void nonlingeo(double **cop, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
printf(" Number of contact spring elements=%" ITGFORMAT "\n\n",*ne-ne0);
+// MPADD start
+ if((newstep==1)&&(*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
+
+ /* 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
@@ -1356,7 +1467,8 @@ void nonlingeo(double **cop, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
ielas=0;
iout=0;
- SFREE(fn);SFREE(stx);SFREE(v);
+ 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 */
@@ -1365,7 +1477,7 @@ void nonlingeo(double **cop, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
iit=1;
icntrl=0;
ctrl[0]=i0ref;ctrl[1]=irref;ctrl[3]=icref;
- NNEW(resold,double,neq[1]);
+ if(*nmethod!=4)NNEW(resold,double,neq[1]);
if(uncoupled){
*ithermal=2;
NNEW(iruc,ITG,nzs[1]-nzs[0]);
@@ -1390,14 +1502,11 @@ void nonlingeo(double **cop, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
if((*ithermal==3)&&(ncont!=0)&&(*mortar==1)&&(*ncmat_>=11)){
*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);
+ memcpy(&sideload[0],&sideloadref[0],sizeof(char)*20**nload);
}
FORTRAN(tempload,(xforcold,xforc,xforcact,iamforc,nforc,
@@ -1543,7 +1652,8 @@ void nonlingeo(double **cop, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
/*for(k=0;k<neq[1];++k){printf("f=%" ITGFORMAT ",%f\n",k,f[k]);}*/
- SFREE(v);SFREE(stx);SFREE(fn);SFREE(inum);
+ SFREE(v);SFREE(fn);SFREE(inum);
+ if((*ithermal!=3)||(ncont==0)||(*mortar!=1)||(*ncmat_<11)) SFREE(stx);
iout=0;
}else{
@@ -1555,13 +1665,26 @@ void nonlingeo(double **cop, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
/* add friction heating */
if((*ithermal==3)&&(ncont!=0)&&(*mortar==1)&&(*ncmat_>=11)){
- NNEW(idefload,ITG,*nload_);
- DMEMSET(idefload,0,*nload_,1);
+ 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,xload,nload,nload_,nelemload,iamload,
+ veold,pslavsurf,xloadact,nload,&nload_,nelemload,iamload,
idefload,sideload,stx,nam));
- SFREE(idefload);
+ SFREE(idefload);SFREE(stx);
}
if(*iexpl<=1){
@@ -1573,23 +1696,6 @@ void nonlingeo(double **cop, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
if(*nmethod==4) DMEMSET(fnext,0,mt**nk,0.);
-/* FORTRAN(mafillsm,(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));*/
-
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,
@@ -1710,7 +1816,7 @@ void nonlingeo(double **cop, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
/* storing the residuum in resold (for line search) */
- if((*mortar==1)&&(iit!=1)&&(*ne-ne0>0)){memcpy(&resold[0],&b[0],sizeof(double)*neq[1]);}
+ if((*mortar==1)&&(iit!=1)&&(*ne-ne0>0)&(*nmethod!=4)){memcpy(&resold[0],&b[0],sizeof(double)*neq[1]);}
newstep=0;
@@ -1892,6 +1998,7 @@ void nonlingeo(double **cop, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
#endif
}
+// if((*mortar<=1)&&((*nmethod!=4)||(*iexpl>1)){SFREE(ad);SFREE(au);} //MPADD
if(*mortar<=1){SFREE(ad);SFREE(au);}
}
@@ -1938,23 +2045,47 @@ void nonlingeo(double **cop, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
islavsurf,ielprop,prop,energyini,energy,&kscale);
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){
+ if((*nmethod==4)&&(*ithermal<2)){
allwk=allwkini;
for(i=0;i<*nk;i++){
- for(j=1;j<4;j++){
- allwk+=(fnext[i*mt+j]+fnextini[i*mt+j])*
- (v[i*mt+j]-vini[i*mt+j])/2.;
+ 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.;
}
}
-// printf(" external work = %e\n\n",allwk);
+ /* Damping forces --> MPADD */
}
- /* line search (only for surface-to-surface penalty contact)
+ /* line search (only for static surface-to-surface penalty contact)
and not in the first iteration */
- if((*mortar==1)&&(iit!=1)&&(*ne-ne0>0)){
+ if((*mortar==1)&&(iit!=1)&&(*ne-ne0>0)&&(*nmethod!=4)){
SFREE(v);SFREE(stx);SFREE(fn);
@@ -2025,23 +2156,6 @@ void nonlingeo(double **cop, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
islavnode,nslavnode,mortar,ntie,f_cm,f_cs,mi,
nzs,&nasym,&idamping,veold,adc,auc,cvini,cv);
- /* 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];}
- }
- }
-
memcpy(&vold[0],&v[0],sizeof(double)*mt**nk);
if(*ithermal!=2){
for(k=0;k<6*mi[0]*ne0;++k){
@@ -2058,126 +2172,171 @@ void nonlingeo(double **cop, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
}else{pressureratio=0.;}
SFREE(v);SFREE(stx);SFREE(fn);
-
- /* 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);*/
if(idamping==1){SFREE(adc);SFREE(auc);}
-
- /* 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(*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){
- for(k=neq[0];k<neq[1];++k){
- err=fabs(b[k]);
- if(err>ram[1]){ram[1]=err;ram[3]=k+0.5;}
+ 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];}
+ }
}
- }
-
- /* Divergence criteria for face-to-face penalty is different */
+
+ /* calculating the maximum residual */
- if(*mortar==1){
- for(k=4;k<8;++k){
+ for(k=0;k<2;++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;}
+ ram[k]=0.;
}
-
- }
-
- /* next line is inserted to cope with stress-less
- temperature calculations */
-
- if(*ithermal!=2){
- if(ram[0]<1.e-6) ram[0]=0.;
-// if(ram[0]<1.e-12) 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);
+ 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;}
+ }
}
- 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){
+ for(k=neq[0];k<neq[1];++k){
+ err=fabs(b[k]);
+ if(err>ram[1]){ram[1]=err;ram[3]=k+0.5;}
+ }
}
- }
- 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);
+
+ /* 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;}
+ }
+
}
- 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);
+
+ /* 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);
+ }
}
- }
- fflush(stdout);
-
- FORTRAN(writecvg,(istep,&iinc,&icutb,&iit,ne,&ne0,ram,qam,cam,uam,
+ 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);
+ 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,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",
+ dtheta**tper);
+ }
+ dtheta=1.-theta;
+ dthetaref=dtheta;
+ }
+ iflagact=0;
+ }
+
}
- SFREE(resold);
+ if(*nmethod!=4)SFREE(resold);
/*********************************************************/
/* end of the iteration loop */
@@ -2187,24 +2346,51 @@ void nonlingeo(double **cop, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
icutb!=0 indicates that the increment has to be reiterated with
another increment size (dtheta) */
- /* printing the energies (only for dynamic calculations */
+ /* printing the energies (only for dynamic calculations) */
- if((icutb==0)&&(*nmethod==4)){
+ if((icutb==0)&&(*nmethod==4)&&(*ithermal<2)){
printf(" initial energy (at start of step) = %e\n\n",energyref);
- printf(" external work = %e\n\n",allwk);
+ 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(" friction contact energy = %e\n",energy[3]);
- printf(" total energy = %e\n\n",energy[0]+energy[1]+energy[2]+energy[3]);
+ 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 = %e %f %% \n\n",energy[0]+energy[1]+energy[2]+energy[3]-energyref-allwk,
- fabs((energy[0]+energy[1]+energy[2]+energy[3]-energyref-allwk)/
- (energy[0]+energy[1]+energy[2]+energy[3]-energyref)*100.));
+ 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]+energy[2]) denergymax=energy[1]+energy[2];
+// if(denergymax<energy[3]) denergymax=energy[3];
+ if(denergymax<energy[1]) denergymax=energy[1];
+// if(denergymax<energy[3]) denergymax=energy[3];
+ 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) =0f %% \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){
@@ -2285,7 +2471,7 @@ void nonlingeo(double **cop, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
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;dtheta=0.;
+ negpres=1;theta=1.-1.e-6;dtheta=1.e-6;
}
}
}else{negpres=0;}
@@ -2501,7 +2687,6 @@ void nonlingeo(double **cop, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
if((*ithermal==3)&&(ncont!=0)&&(*mortar==1)&&(*ncmat_>=11)){
*nload=nloadref;
- (*nload_)-=ne0;
RENEW(nelemload,ITG,2**nload);memcpy(&nelemload[0],&nelemloadref[0],sizeof(ITG)*2**nload);
if(*nam>0){
RENEW(iamload,ITG,2**nload);
@@ -2649,7 +2834,8 @@ void nonlingeo(double **cop, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
*icolp=icol;*irowp=irow;*cop=co;*voldp=vold;
*ipompcp=ipompc;*labmpcp=labmpc;*ikmpcp=ikmpc;*ilmpcp=ilmpc;
- *fmpcp=fmpc;*nodempcp=nodempc;*coefmpcp=coefmpc;
+ *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;
@@ -2660,7 +2846,10 @@ void nonlingeo(double **cop, ITG *nk, ITG **konp, ITG **ipkonp, char **lakonp,
(*tmax)*=(*tper);
SFREE(nactdofinv);
-
+ // MPADD start
+ if((*nmethod==4)&&(*ithermal!=2)&&(*iexpl<=1)&&(icfd!=1)){ SFREE(adblump);}
+ // MPADD end
+
(*ttime)+=(*tper);
return;
diff --git a/ccx_2.9/src/nonlinmpc.f b/ccx_2.10/src/nonlinmpc.f
similarity index 100%
rename from ccx_2.9/src/nonlinmpc.f
rename to ccx_2.10/src/nonlinmpc.f
diff --git a/ccx_2.9/src/norm.f b/ccx_2.10/src/norm.f
similarity index 100%
rename from ccx_2.9/src/norm.f
rename to ccx_2.10/src/norm.f
diff --git a/ccx_2.9/src/normals.f b/ccx_2.10/src/normals.f
similarity index 100%
rename from ccx_2.9/src/normals.f
rename to ccx_2.10/src/normals.f
diff --git a/ccx_2.9/src/normalsoninterface.f b/ccx_2.10/src/normalsoninterface.f
similarity index 78%
rename from ccx_2.9/src/normalsoninterface.f
rename to ccx_2.10/src/normalsoninterface.f
index 37dbe9a..8731b38 100644
--- a/ccx_2.9/src/normalsoninterface.f
+++ b/ccx_2.10/src/normalsoninterface.f
@@ -26,7 +26,7 @@
!
integer istartset(*),iendset(*),ialset(*),imast,j,ifacem,
& nelemm,jfacem,indexe,ipkon(*),kon(*),nopem,node,
- & ifaceq(9,6),ifacet(7,4),ifacew1(4,5),ifacew2(8,5),
+ & ifaceq(8,6),ifacet(6,4),ifacew1(4,5),ifacew2(8,5),
& nmastnode,id,indexnode(9),konl(26),imastnode(*)
!
real*8 xmastnor(3,*),xsj2(3),shp2(7,9),xs2(3,2),xi,et,dd,
@@ -34,19 +34,19 @@
!
! nodes per face for hex elements
!
- data ifaceq /4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/
+ data ifaceq /4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/
!
! nodes per face for tet elements
!
- data ifacet /1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/
+ data ifacet /1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/
!
! nodes per face for linear wedge elements
!
@@ -103,14 +103,10 @@
!
if(lakon(nelemm)(4:5).eq.'20') then
nopem=8
- elseif(lakon(nelemm)(4:4).eq.'2') then
- nopem=9
elseif(lakon(nelemm)(4:4).eq.'8') then
nopem=4
elseif(lakon(nelemm)(4:5).eq.'10') then
nopem=6
- elseif(lakon(nelemm)(4:5).eq.'14') then
- nopem=7
elseif(lakon(nelemm)(4:4).eq.'4') then
nopem=3
endif
@@ -181,15 +177,9 @@
elseif(lakon(nelemm)(4:5).eq.'20') then
nopem=8
nope=20
- elseif(lakon(nelemm)(4:4).eq.'2') then
- nopem=9
- nope=26
elseif(lakon(nelemm)(4:5).eq.'10') then
nopem=6
nope=10
- elseif(lakon(nelemm)(4:5).eq.'14') then
- nopem=7
- nope=14
elseif(lakon(nelemm)(4:4).eq.'4') then
nopem=3
nope=4
@@ -219,13 +209,13 @@
konl(k)=kon(ipkon(nelemm)+k)
enddo
!
- if((nope.eq.20).or.(nope.eq.8).or.(nope.eq.26)) then
+ if((nope.eq.20).or.(nope.eq.8)) then
do m=1,nopem
do k=1,3
xl2m(k,m)=co(k,konl(ifaceq(m,jfacem)))
enddo
enddo
- elseif((nope.eq.10).or.(nope.eq.4).or.(nope.eq.14))
+ elseif((nope.eq.10).or.(nope.eq.4))
& then
do m=1,nopem
do k=1,3
@@ -248,35 +238,7 @@
! calculate the normal vector in the nodes belonging to the master surface
!
- if(nopem.eq.9) then
- do m=1,nopem
- xi=xquad(1,m)
- et=xquad(2,m)
- call shape9q(xi,et,xl2m,xsj2,xs2,shp2,iflag)
- dd=dsqrt(xsj2(1)*xsj2(1) + xsj2(2)*xsj2(2)
- & + xsj2(3)*xsj2(3))
- xsj2(1)=xsj2(1)/dd
- xsj2(2)=xsj2(2)/dd
- xsj2(3)=xsj2(3)/dd
-!
- if(nope.eq.26) then
- node=konl(ifaceq(m,jfacem))
- elseif(nope.eq.20) then
- node=konl(ifacew2(m,jfacem))
- endif
-!
- call nident(imastnode,node,
- & nmastnode,id)
- index1=id
- indexnode(m)=index1
- xmastnor(1,index1)=xmastnor(1,index1)
- & +xsj2(1)
- xmastnor(2,index1)=xmastnor(2,index1)
- & +xsj2(2)
- xmastnor(3,index1)=xmastnor(3,index1)
- & +xsj2(3)
- enddo
- elseif(nopem.eq.8) then
+ if(nopem.eq.8) then
do m=1,nopem
xi=xquad(1,m)
et=xquad(2,m)
@@ -361,34 +323,6 @@
xmastnor(3,index1)=xmastnor(3,index1)
& +xsj2(3)
enddo
- elseif(nopem.eq.7) then
- do m=1,nopem
- xi=xtri(1,m)
- et=xtri(2,m)
- call shape7tri(xi,et,xl2m,xsj2,xs2,shp2,iflag)
- dd=dsqrt(xsj2(1)*xsj2(1) + xsj2(2)*xsj2(2)
- & + xsj2(3)*xsj2(3))
- xsj2(1)=xsj2(1)/dd
- xsj2(2)=xsj2(2)/dd
- xsj2(3)=xsj2(3)/dd
-!
- if(nope.eq.14) then
- node=konl(ifacet(m,jfacem))
- elseif(nope.eq.20) then
- node=konl(ifacew2(m,jfacem))
- endif
-!
- call nident(imastnode,node,
- & nmastnode,id)
- index1=id
- indexnode(m)=index1
- xmastnor(1,index1)=xmastnor(1,index1)
- & +xsj2(1)
- xmastnor(2,index1)=xmastnor(2,index1)
- & +xsj2(2)
- xmastnor(3,index1)=xmastnor(3,index1)
- & +xsj2(3)
- enddo
else
do m=1,nopem
xi=xtri(1,m)
diff --git a/ccx_2.9/src/norshell3.f b/ccx_2.10/src/norshell3.f
similarity index 100%
rename from ccx_2.9/src/norshell3.f
rename to ccx_2.10/src/norshell3.f
diff --git a/ccx_2.9/src/norshell4.f b/ccx_2.10/src/norshell4.f
similarity index 100%
rename from ccx_2.9/src/norshell4.f
rename to ccx_2.10/src/norshell4.f
diff --git a/ccx_2.9/src/norshell6.f b/ccx_2.10/src/norshell6.f
similarity index 100%
rename from ccx_2.9/src/norshell6.f
rename to ccx_2.10/src/norshell6.f
diff --git a/ccx_2.9/src/norshell8.f b/ccx_2.10/src/norshell8.f
similarity index 100%
rename from ccx_2.9/src/norshell8.f
rename to ccx_2.10/src/norshell8.f
diff --git a/ccx_2.10/src/objective_mass.f b/ccx_2.10/src/objective_mass.f
new file mode 100644
index 0000000..b228aeb
--- /dev/null
+++ b/ccx_2.10/src/objective_mass.f
@@ -0,0 +1,51 @@
+!
+! CalculiX - A 3-dimensional finite element program
+! Copyright (C) 1998-2015 Guido Dhondt
+!
+! This program is free software; you can redistribute it and/or
+! modify it under the terms of the GNU General Public License as
+! published by the Free Software Foundation(version 2);
+!
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program; if not, write to the Free Software
+! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+!
+ subroutine objective_mass(co,kon,ipkon,lakon,v,nelcon,rhcon,
+ & ielmat,ielorien,norien,ntmat_,vold,matname,mi,
+ & nal,thicke,mortar,nea,neb,ielprop,prop,distmin,
+ & ndesi,nodedesi,ndirdesi,nobject,g0,dgdxtot,numobject)
+!
+! calculates the total differential of the objective function MASS
+!
+ implicit none
+!
+ character*8 lakon(*)
+ character*80 matname(*)
+!
+ integer kon(*),nea,neb,mi(*),nelcon(2,*),ielmat(mi(3),*),
+ & ielorien(mi(3),*),ntmat_,ipkon(*),norien,nal,ielprop(*),
+ & mortar,ndesi,nodedesi(*),ndirdesi(*),nobject,numobject
+!
+ real*8 co(3,*),v(0:mi(2),*),prop(*),rhcon(0:1,ntmat_,*),
+ & vold(0:mi(2),*),thicke(mi(3),*),distmin,g0(nobject),
+ & dgdxtot(ndesi,nobject)
+!
+! -------------------------------------------------------------
+! Calculation of the derivative w.r.t to the designvaribales
+! (For the objective function mass this is equal to the
+! total difference
+! -------------------------------------------------------------
+!
+ call objective_mass_dx(co,kon,ipkon,lakon,v,nelcon,rhcon,
+ & ielmat,ielorien,norien,ntmat_,vold,matname,mi,nal,thicke,
+ & mortar,nea,neb,ielprop,prop,distmin,ndesi,nodedesi,ndirdesi,
+ & nobject,g0,dgdxtot,numobject)
+!
+ return
+ end
diff --git a/ccx_2.10/src/objective_mass_dx.f b/ccx_2.10/src/objective_mass_dx.f
new file mode 100644
index 0000000..72b82e9
--- /dev/null
+++ b/ccx_2.10/src/objective_mass_dx.f
@@ -0,0 +1,398 @@
+!
+! CalculiX - A 3-dimensional finite element program
+! Copyright (C) 1998-2015 Guido Dhondt
+!
+! This program is free software; you can redistribute it and/or
+! modify it under the terms of the GNU General Public License as
+! published by the Free Software Foundation(version 2);
+!
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program; if not, write to the Free Software
+! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+!
+ subroutine objective_mass_dx(co,kon,ipkon,lakon,v,nelcon,rhcon,
+ & ielmat,ielorien,norien,ntmat_,vold,matname,mi,
+ & nal,thicke,mortar,nea,neb,ielprop,prop,distmin,
+ & ndesi,nodedesi,ndirdesi,nobject,g0,dgdxtot,numobject)
+!
+! calculates stresses and the material tangent at the integration
+! points and the internal forces at the nodes
+!
+ implicit none
+!
+ character*8 lakon(*),lakonl
+ character*80 amat,matname(*)
+!
+ integer kon(*),konl(26),nea,neb,mi(*),mint2d,nopes,nelcon(2,*),
+ & ielmat(mi(3),*),ielorien(mi(3),*),ntmat_,ipkon(*),iflag,null,
+ & mt,i,ii,j,k,jj,kk,indexe,nope,norien,nal,ihyper,
+ & imat,mint3d,iorien,ilayer,nlayer,ki,kl,
+ & ielprop(*),mortar,desvar,actnode,ndesi,nodedesi(*),
+ & ndirdesi(*),nobject,numobject
+!
+ real*8 co(3,*),v(0:mi(2),*),shp(4,26),xl(3,26),vl(0:mi(2),26),
+ & prop(*),rhcon(0:1,ntmat_,*),xs2(3,7),thickness,rho,xl2(3,8),
+ & vold(0:mi(2),*),voldl(0:mi(2),26),xsj2(3),shp2(7,8),xi,et,ze,
+ & xsj,weight,gs(8,4),a,tlayer(4),dlayer(4),xlayer(mi(3),4),
+ & thicke(mi(3),*),distmin,mass,g0(nobject),dg,
+ & dgdxtot(ndesi,nobject)
+!
+ include "gauss.f"
+!
+ iflag=3
+ null=0
+!
+ mt=mi(2)+1
+ nal=0
+!
+! -------------------------------------------------------------
+! Initialisation of the loop for the variation of
+! the internal forces
+! -------------------------------------------------------------
+!
+! Loop over all designvariables
+ do desvar=0,ndesi
+!
+! initialisation of dg
+!
+ dg=0.d0
+!
+! Loop over all elements in thread
+ do i=nea,neb
+!
+! initialisation of mass
+!
+ mass=0.d0
+ lakonl=lakon(i)
+!
+ if(ipkon(i).lt.0) cycle
+!
+! no 3D-fluid elements
+!
+ if(lakonl(1:1).eq.'F') cycle
+ if(lakonl(1:7).eq.'DCOUP3D') cycle
+!
+ if(lakonl(7:8).ne.'LC') then
+!
+ imat=ielmat(1,i)
+ amat=matname(imat)
+ if(norien.gt.0) then
+ iorien=ielorien(1,i)
+ else
+ iorien=0
+ endif
+!
+ if(nelcon(1,imat).lt.0) then
+ ihyper=1
+ else
+ ihyper=0
+ endif
+ else
+!
+! composite materials
+!
+ mint2d=4
+ nopes=8
+! determining the number of layers
+!
+ nlayer=0
+ do k=1,mi(3)
+ if(ielmat(k,i).ne.0) then
+ nlayer=nlayer+1
+ endif
+ enddo
+!
+! determining the layer thickness and global thickness
+! at the shell integration points
+!
+ iflag=1
+ indexe=ipkon(i)
+ do kk=1,mint2d
+ xi=gauss3d2(1,kk)
+ et=gauss3d2(2,kk)
+ call shape8q(xi,et,xl2,xsj2,xs2,shp2,iflag)
+ tlayer(kk)=0.d0
+ do k=1,nlayer
+ thickness=0.d0
+ do j=1,nopes
+ thickness=thickness+thicke(k,indexe+j)*shp2(4,j)
+ enddo
+ tlayer(kk)=tlayer(kk)+thickness
+ xlayer(k,kk)=thickness
+ enddo
+ enddo
+ iflag=3
+!
+ ilayer=0
+ do k=1,4
+ dlayer(k)=0.d0
+ enddo
+!
+ endif
+!
+ indexe=ipkon(i)
+c Bernhardi start
+ if(lakonl(1:5).eq.'C3D8I') then
+ nope=11
+ elseif(lakonl(4:5).eq.'20') then
+c Bernhardi end
+ nope=20
+ elseif(lakonl(4:4).eq.'2') then
+ nope=26
+ elseif(lakonl(4:4).eq.'8') then
+ nope=8
+ elseif(lakonl(4:5).eq.'10') then
+ nope=10
+ elseif(lakonl(4:5).eq.'14') then
+ nope=14
+ elseif(lakonl(4:4).eq.'4') then
+ nope=4
+ elseif(lakonl(4:5).eq.'15') then
+ nope=15
+ elseif(lakonl(4:4).eq.'6') then
+ nope=6
+ elseif((lakonl(1:1).eq.'E').and.(lakonl(7:7).ne.'F')) then
+!
+! spring elements, contact spring elements and
+! dashpot elements
+!
+ if(lakonl(7:7).eq.'C') then
+!
+! contact spring elements
+!
+ if(mortar.eq.1) then
+!
+! face-to-face penalty
+!
+ nope=kon(ipkon(i))
+ elseif(mortar.eq.0) then
+!
+! node-to-face penalty
+!
+ nope=ichar(lakonl(8:8))-47
+ konl(nope+1)=kon(indexe+nope+1)
+ endif
+ else
+!
+! genuine spring elements and dashpot elements
+!
+ nope=ichar(lakonl(8:8))-47
+ endif
+ else
+ cycle
+ endif
+!
+ if(lakonl(4:5).eq.'8R') then
+ mint3d=1
+ elseif(lakonl(4:7).eq.'20RB') then
+ if((lakonl(8:8).eq.'R').or.(lakonl(8:8).eq.'C')) then
+ mint3d=50
+ else
+ call beamintscheme(lakonl,mint3d,ielprop(i),prop,
+ & null,xi,et,ze,weight)
+ endif
+ elseif((lakonl(4:4).eq.'8').or.(lakonl(4:6).eq.'26R').or.
+ & (lakonl(4:6).eq.'20R')) then
+ if(lakonl(7:8).eq.'LC') then
+ mint3d=8*nlayer
+ else
+ mint3d=8
+ endif
+ elseif(lakonl(4:4).eq.'2') then
+ mint3d=27
+ elseif((lakonl(4:5).eq.'10').or.(lakonl(4:5).eq.'14')) then
+ mint3d=4
+ elseif(lakonl(4:4).eq.'4') then
+ mint3d=1
+ elseif(lakonl(4:5).eq.'15') then
+ mint3d=9
+ elseif(lakonl(4:4).eq.'6') then
+ mint3d=2
+ elseif(lakonl(1:1).eq.'E') then
+ mint3d=0
+ endif
+
+ do j=1,nope
+ konl(j)=kon(indexe+j)
+ do k=1,3
+ xl(k,j)=co(k,konl(j))
+ vl(k,j)=v(k,konl(j))
+ voldl(k,j)=vold(k,konl(j))
+ enddo
+ enddo
+!
+! computation of the objective function and the derivate
+! if the designnode belongs to the considered element
+! if not, next element in loop will be taken
+!
+ if(desvar.gt.0) then
+ do ii=1,nope
+ actnode=kon(indexe+ii)
+ if(actnode.eq.nodedesi(desvar).or.(desvar.eq.0)) then
+ xl(ndirdesi(desvar),ii)=xl(ndirdesi(desvar),ii)+distmin
+ exit
+ endif
+ enddo
+ endif
+!
+ do jj=1,mint3d
+ if(lakonl(4:5).eq.'8R') then
+ xi=gauss3d1(1,jj)
+ et=gauss3d1(2,jj)
+ ze=gauss3d1(3,jj)
+ weight=weight3d1(jj)
+ elseif(lakonl(4:7).eq.'20RB') then
+ if((lakonl(8:8).eq.'R').or.(lakonl(8:8).eq.'C')) then
+ xi=gauss3d13(1,jj)
+ et=gauss3d13(2,jj)
+ ze=gauss3d13(3,jj)
+ weight=weight3d13(jj)
+ else
+ call beamintscheme(lakonl,mint3d,ielprop(i),prop,
+ & jj,xi,et,ze,weight)
+ endif
+ elseif((lakonl(4:4).eq.'8').or.
+ & (lakonl(4:6).eq.'20R').or.(lakonl(4:6).eq.'26R'))
+ & then
+ if(lakonl(7:8).ne.'LC') then
+ xi=gauss3d2(1,jj)
+ et=gauss3d2(2,jj)
+ ze=gauss3d2(3,jj)
+ weight=weight3d2(jj)
+ else
+ kl=mod(jj,8)
+ if(kl.eq.0) kl=8
+!
+ xi=gauss3d2(1,kl)
+ et=gauss3d2(2,kl)
+ ze=gauss3d2(3,kl)
+ weight=weight3d2(kl)
+!
+ ki=mod(jj,4)
+ if(ki.eq.0) ki=4
+!
+ if(kl.eq.1) then
+ ilayer=ilayer+1
+ if(ilayer.gt.1) then
+ do k=1,4
+ dlayer(k)=dlayer(k)+xlayer(ilayer-1,k)
+ enddo
+ endif
+ endif
+ ze=2.d0*(dlayer(ki)+(ze+1.d0)/2.d0*xlayer(ilayer,ki))/
+ & tlayer(ki)-1.d0
+ weight=weight*xlayer(ilayer,ki)/tlayer(ki)
+!
+! material and orientation
+!
+ imat=ielmat(ilayer,i)
+ amat=matname(imat)
+ if(norien.gt.0) then
+ iorien=ielorien(ilayer,i)
+ else
+ iorien=0
+ endif
+!
+ if(nelcon(1,imat).lt.0) then
+ ihyper=1
+ else
+ ihyper=0
+ endif
+ endif
+ elseif(lakonl(4:4).eq.'2') then
+ xi=gauss3d3(1,jj)
+ et=gauss3d3(2,jj)
+ ze=gauss3d3(3,jj)
+ weight=weight3d3(jj)
+ elseif((lakonl(4:5).eq.'10').or.(lakonl(4:5).eq.'14')) then
+ xi=gauss3d5(1,jj)
+ et=gauss3d5(2,jj)
+ ze=gauss3d5(3,jj)
+ weight=weight3d5(jj)
+ elseif(lakonl(4:4).eq.'4') then
+ xi=gauss3d4(1,jj)
+ et=gauss3d4(2,jj)
+ ze=gauss3d4(3,jj)
+ weight=weight3d4(jj)
+ elseif(lakonl(4:5).eq.'15') then
+ xi=gauss3d8(1,jj)
+ et=gauss3d8(2,jj)
+ ze=gauss3d8(3,jj)
+ weight=weight3d8(jj)
+ elseif(lakonl(4:4).eq.'6') then
+ xi=gauss3d7(1,jj)
+ et=gauss3d7(2,jj)
+ ze=gauss3d7(3,jj)
+ weight=weight3d7(jj)
+ endif
+!
+c Bernhardi start
+ if(lakonl(1:5).eq.'C3D8R') then
+ call shape8hr(xl,xsj,shp,gs,a)
+ elseif(lakonl(1:5).eq.'C3D8I') then
+ call shape8hu(xi,et,ze,xl,xsj,shp,iflag)
+ elseif(nope.eq.20) then
+c Bernhardi end
+ if(lakonl(7:7).eq.'A') then
+ call shape20h_ax(xi,et,ze,xl,xsj,shp,iflag)
+ elseif((lakonl(7:7).eq.'E').or.
+ & (lakonl(7:7).eq.'S')) then
+ call shape20h_pl(xi,et,ze,xl,xsj,shp,iflag)
+ else
+ call shape20h(xi,et,ze,xl,xsj,shp,iflag)
+ endif
+ elseif(nope.eq.26) then
+ call shape26h(xi,et,ze,xl,xsj,shp,iflag,konl)
+ elseif(nope.eq.8) then
+ call shape8h(xi,et,ze,xl,xsj,shp,iflag)
+ elseif(nope.eq.10) then
+ call shape10tet(xi,et,ze,xl,xsj,shp,iflag)
+ elseif(nope.eq.14) then
+ call shape14tet(xi,et,ze,xl,xsj,shp,iflag,konl)
+ elseif(nope.eq.4) then
+ call shape4tet(xi,et,ze,xl,xsj,shp,iflag)
+ elseif(nope.eq.15) then
+ call shape15w(xi,et,ze,xl,xsj,shp,iflag)
+ else
+ call shape6w(xi,et,ze,xl,xsj,shp,iflag)
+ endif
+!
+! calculation of the objective function
+!
+ rho=rhcon(1,1,imat)
+ mass=mass+weight*xsj*rho
+!
+! end of loop over all integration points
+ enddo
+!
+! summation of the objective function over all elements
+!
+ dg=dg+mass
+!
+! end of loop over all elements in thread
+!
+ enddo
+!
+! Filling of g0 and dgdx
+!
+ if(desvar.eq.0) then
+ g0(numobject)=dg
+ else
+!
+! finite difference step
+!
+ dgdxtot(desvar,numobject)=(dg-g0(numobject))/distmin
+ endif
+!
+! end of loop over all designvariables
+!
+ enddo
+!
+ return
+ end
diff --git a/ccx_2.10/src/objective_shapeener.f b/ccx_2.10/src/objective_shapeener.f
new file mode 100644
index 0000000..ee3286b
--- /dev/null
+++ b/ccx_2.10/src/objective_shapeener.f
@@ -0,0 +1,89 @@
+!
+! CalculiX - A 3-dimensional finite element program
+! Copyright (C) 1998-2015 Guido Dhondt
+!
+! This program is free software; you can redistribute it and/or
+! modify it under the terms of the GNU General Public License as
+! published by the Free Software Foundation(version 2);
+!
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program; if not, write to the Free Software
+! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+!
+ subroutine objective_shapeener(co,kon,ipkon,lakon,ne,
+ & stx,elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,
+ & ielmat,ielorien,norien,orab,ntmat_,t0,t1,ithermal,prestr,
+ & iprestr,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,enerini,istep,iinc,
+ & springarea,reltime,calcul_qa,iener,ikin,nal,ne0,thicke,
+ & emeini,pslavsurf,pmastsurf,mortar,clearini,nea,neb,
+ & ielprop,prop,distmin,ndesi,nodedesi,ndirdesi,nobject,
+ & g0,dgdx,numobject,sti,dgdxtot,dfextminds,df,neq,nactdof,
+ & nk)
+!
+! calculates the total differential of the objective function
+! shape energy
+!
+ implicit none
+!
+ character*8 lakon(*)
+ character*80 matname(*)
+!
+ integer kon(*),nea,neb,mi(*),nelcon(2,*),nrhcon(*),
+ & nalcon(2,*),ielmat(mi(3),*),ielorien(mi(3),*),
+ & ntmat_,ipkon(*),ne0,istep,iinc,ne,ithermal(2),
+ & iprestr,iener,norien,iperturb(*),iout,nal,icmd,nmethod,
+ & ielas,ncmat_,nstate_,ikin,ielprop(*),nplicon(0:ntmat_,*),
+ & nplkcon(0:ntmat_,*),npmat_,calcul_qa,mortar,ndesi,
+ & nodedesi(*),ndirdesi(*),nobject,numobject,neq,
+ & nactdof(0:mi(2),*),nk
+!
+ real*8 co(3,*),stiini(6,mi(1),*),stx(6,mi(1),*),
+ & prop(*),elcon(0:ncmat_,ntmat_,*),rhcon(0:1,ntmat_,*),
+ & alcon(0:6,ntmat_,*),vini(0:mi(2),*),alzero(*),orab(7,*),
+ & fn(0:mi(2),*),t0(*),t1(*),prestr(6,mi(1),*),
+ & vold(0:mi(2),*),veold(0:mi(2),*),springarea(2,*),
+ & ener(mi(1),*),enerini(mi(1),*),qa(3),dtime,
+ & time,ttime,plicon(0:2*npmat_,ntmat_,*),
+ & plkcon(0:2*npmat_,ntmat_,*),xstiff(27,mi(1),*),
+ & xstate(nstate_,mi(1),*),xstateini(nstate_,mi(1),*),reltime,
+ & thicke(mi(3),*),emeini(6,mi(1),*),clearini(3,9,*),
+ & pslavsurf(3,*),pmastsurf(6,*),distmin,g0(nobject),
+ & dgdx(ndesi,nobject),dgdxtot(ndesi,nobject),sti(6,mi(1),*),
+ & dfextminds(ndesi,neq),df(ndesi,neq)
+!
+! -------------------------------------------------------------
+! Calculation of the derivative w.r.t to the designvaribales
+! (For the objective function mass this is equal to the
+! total difference
+! -------------------------------------------------------------
+!
+ call objective_shapeener_dx(co,kon,ipkon,lakon,ne,
+ & stx,elcon,nelcon,rhcon,nrhcon,alcon,nalcon,alzero,
+ & ielmat,ielorien,norien,orab,ntmat_,t0,t1,ithermal,prestr,
+ & iprestr,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,enerini,istep,iinc,springarea,reltime,
+ & calcul_qa,iener,ikin,nal,ne0,thicke,emeini,pslavsurf,
+ & pmastsurf,mortar,clearini,nea,neb,ielprop,prop,distmin,
+ & ndesi,nodedesi,ndirdesi,nobject,g0,dgdx,numobject,sti)
+!
+! -------------------------------------------------------------
+! Calculation of the total derivative of the shape energy w.r.t.
+! design variables
+! -------------------------------------------------------------
+!
+ call objective_shapeener_tot(dgdxtot,dgdx,dfextminds,df,vold,
+ & neq,ndesi,nobject,numobject,mi,nactdof,nk)
+
+ return
+ end
diff --git a/ccx_2.9/src/resultsmech.f b/ccx_2.10/src/objective_shapeener_dx.f
similarity index 79%
copy from ccx_2.9/src/resultsmech.f
copy to ccx_2.10/src/objective_shapeener_dx.f
index f61cc61..346358e 100644
--- a/ccx_2.9/src/resultsmech.f
+++ b/ccx_2.10/src/objective_shapeener_dx.f
@@ -16,16 +16,17 @@
! along with this program; if not, write to the Free Software
! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
!
- subroutine resultsmech(co,kon,ipkon,lakon,ne,v,
+ subroutine objective_shapeener_dx(co,kon,ipkon,lakon,ne,
& 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,
+ & iprestr,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,iener,
- & ikin,nal,ne0,thicke,emeini,pslavsurf,
- & pmastsurf,mortar,clearini,nea,neb,ielprop,prop,kscale)
+ & ncmat_,nstate_,stiini,vini,ener,enerini,istep,iinc,
+ & springarea,reltime,calcul_qa,iener,ikin,nal,ne0,thicke,
+ & emeini,pslavsurf,pmastsurf,mortar,clearini,nea,neb,ielprop,
+ & prop,distmin,ndesi,nodedesi,ndirdesi,nobject,g0,dgdx,
+ & numobject,sti)
!
! calculates stresses and the material tangent at the integration
! points and the internal forces at the nodes
@@ -39,25 +40,26 @@
!
integer kon(*),konl(26),nea,neb,mi(*),mint2d,nopes,
& nelcon(2,*),nrhcon(*),nalcon(2,*),ielmat(mi(3),*),
- & ielorien(mi(3),*),ntmat_,ipkon(*),ne0,iflag,null,kscale,
- & istep,iinc,mt,ne,mattyp,ithermal(2),iprestr,i,j,k,m1,m2,jj,
- & i1,m3,m4,kk,iener,indexe,nope,norien,iperturb(*),iout,
+ & ielorien(mi(3),*),ntmat_,ipkon(*),ne0,iflag,null,
+ & istep,iinc,mt,ne,mattyp,ithermal(2),iprestr,i,ii,j,k,m1,m2,jj,
+ & i1,m3,kk,iener,indexe,nope,norien,iperturb(*),iout,
& nal,icmd,ihyper,nmethod,kode,imat,mint3d,iorien,ielas,
& istiff,ncmat_,nstate_,ikin,ilayer,nlayer,ki,kl,ielprop(*),
- & nplicon(0:ntmat_,*),nplkcon(0:ntmat_,*),npmat_,calcul_fn,
- & calcul_cauchy,calcul_qa,nopered,mortar,jfaces,iloc,igauss
+ & nplicon(0:ntmat_,*),nplkcon(0:ntmat_,*),npmat_,calcul_qa,
+ & nopered,mortar,jfaces,iloc,igauss,desvar,ndesi,nodedesi(*),
+ & ndirdesi(*),nobject,numobject
!
- real*8 co(3,*),v(0:mi(2),*),shp(4,26),stiini(6,mi(1),*),
+ real*8 co(3,*),shp(4,26),stiini(6,mi(1),*),
& stx(6,mi(1),*),xl(3,26),vl(0:mi(2),26),stre(6),prop(*),
& elcon(0:ncmat_,ntmat_,*),rhcon(0:1,ntmat_,*),xs2(3,7),
& alcon(0:6,ntmat_,*),vini(0:mi(2),*),thickness,
& alzero(*),orab(7,*),elas(21),rho,fn(0:mi(2),*),
- & fnl(3,10),skl(3,3),beta(6),q(0:mi(2),26),xl2(3,8),
- & vkl(0:3,3),t0(*),t1(*),prestr(6,mi(1),*),eme(6,mi(1),*),
+ & fnl(3,10),beta(6),q(0:mi(2),26),xl2(3,8),
+ & vkl(0:3,3),t0(*),t1(*),prestr(6,mi(1),*),
& ckl(3,3),vold(0:mi(2),*),eloc(9),veold(0:mi(2),*),
& springarea(2,*),elconloc(21),eth(6),xkl(3,3),voldl(0:mi(2),26),
- & xikl(3,3),ener(mi(1),*),emec(6),eei(6,mi(1),*),enerini(mi(1),*),
- & emec0(6),vel(1:3,26),veoldl(0:mi(2),26),xsj2(3),shp2(7,8),
+ & xikl(3,3),ener(mi(1),*),emec(6),enerini(mi(1),*),
+ & emec0(6),veoldl(0:mi(2),26),xsj2(3),shp2(7,8),
& e,un,al,um,am1,xi,et,ze,tt,exx,eyy,ezz,exy,exz,eyz,
& xsj,qa(3),vj,t0l,t1l,dtime,weight,pgauss(3),vij,time,ttime,
& plicon(0:2*npmat_,ntmat_,*),plkcon(0:2*npmat_,ntmat_,*),
@@ -65,7 +67,8 @@
& vokl(3,3),xstateini(nstate_,mi(1),*),vikl(3,3),
& gs(8,4),a,reltime,tlayer(4),dlayer(4),xlayer(mi(3),4),
& thicke(mi(3),*),emeini(6,mi(1),*),clearini(3,9,*),
- & pslavsurf(3,*),pmastsurf(6,*)
+ & pslavsurf(3,*),pmastsurf(6,*),distmin,enerint,g0(numobject),
+ & dg,dgdx(ndesi,nobject),sti(6,mi(1),*)
!
include "gauss.f"
!
@@ -75,8 +78,24 @@
mt=mi(2)+1
nal=0
!
+! -------------------------------------------------------------
+! Initialisation of the loop for the variation of
+! the internal forces
+! -------------------------------------------------------------
+!
+! Loop over all designvariables
+ do desvar=0,ndesi
+!
+! initialisation of dg
+!
+ dg=0.d0
+!
+! Loop over all elements in thread
do i=nea,neb
!
+! initialisation of enerint and
+!
+ enerint=0.d0
lakonl=lakon(i)
!
if(ipkon(i).lt.0) cycle
@@ -225,16 +244,27 @@ c Bernhardi end
elseif(lakonl(1:1).eq.'E') then
mint3d=0
endif
-!
+
do j=1,nope
konl(j)=kon(indexe+j)
do k=1,3
xl(k,j)=co(k,konl(j))
- vl(k,j)=v(k,konl(j))
+ vl(k,j)=vold(k,konl(j))
voldl(k,j)=vold(k,konl(j))
enddo
enddo
!
+! computation of the objective function and the derivate
+!
+ if(desvar.gt.0) then
+ do ii=1,nope
+ if(konl(ii).eq.nodedesi(desvar)) then
+ xl(ndirdesi(desvar),ii)=xl(ndirdesi(desvar),ii)+distmin
+ exit
+ endif
+ enddo
+ endif
+!
! q contains the nodal forces per element; initialisation of q
!
if((iperturb(1).ge.2).or.((iperturb(1).le.0).and.(iout.lt.1)))
@@ -289,7 +319,7 @@ c Bernhardi end
& stx(1,1,i),mi,springarea(1,iloc),nmethod,
& ne0,nstate_,xstateini,xstate,reltime,
& ielas,iloc,jfaces,igauss,pslavsurf,pmastsurf,
- & clearini,ener(1,i+ne),kscale)
+ & clearini,ener(1,i+ne))
endif
!
! next lines are not executed in linstatic.c before the
@@ -310,20 +340,6 @@ c Bernhardi end
!
elseif((nmethod.eq.4).or.(nmethod.eq.5).or.
& ((abs(nmethod).eq.1).and.(iperturb(1).ge.2))) then
-c do j=1,nope
-c konl(j)=kon(indexe+j)
-c do k=1,3
-c vel(k,j)=veold(k,konl(j))
-c enddo
-c enddo
-c call dashforc(xl,konl,vl,imat,elcon,nelcon,
-c & elas,fnl,ncmat_,ntmat_,nope,lakonl,t0l,t1l,kode,
-c & elconloc,plicon,nplicon,npmat_,vel,time,nmethod,mi)
-c do j=1,nope
-c do k=1,3
-c fn(k,konl(j))=fn(k,konl(j))+fnl(k,j)
-c enddo
-c enddo
endif
elseif(ikin.eq.1) then
do j=1,nope
@@ -334,6 +350,16 @@ c enddo
endif
!
do jj=1,mint3d
+!
+! ---------------------------------------------------------------
+! Passing of stresses and strains from previous step
+! for sensitivity analysis
+! ---------------------------------------------------------------
+!
+ do m1=1,6
+ stiini(m1,jj,i)=sti(m1,jj,i)
+ enddo
+
if(lakonl(4:5).eq.'8R') then
xi=gauss3d1(1,jj)
et=gauss3d1(2,jj)
@@ -470,7 +496,7 @@ c Bernhardi end
do m3=1,3
vkl(m2,m3)=vkl(m2,m3)+shp(m3,m1)*vl(m2,m1)
enddo
-c write(*,*) 'vnoeie',i,konl(m1),(vkl(m2,k),k=1,3)
+c write(*,*) 'vnoeie',ivkl,konl(m1),(vkl(m2,k),k=1,3)
enddo
enddo
!
@@ -885,184 +911,23 @@ c emec0(m1)=emeini(m1,jj,i)
endif
endif
!
-! updating the internal energy and mechanical strain
-! for user materials (kode<=-100) the mechanical strain has to
-! be updated at the end of each increment (also if no output
-! is requested), since it is input to the umat routine
-!
- if((iout.gt.0).or.(iout.eq.-2).or.(kode.le.-100).or.
- & ((nmethod.eq.4).and.(iperturb(1).gt.1).and.
- & (ithermal(1).le.1))) then
- if(ithermal(1).eq.0) then
- do m1=1,6
- eth(m1)=0.d0
- enddo
- endif
- if(iener.eq.1) then
- ener(jj,i)=enerini(jj,i)+
- & ((eloc(1)-eth(1)-emeini(1,jj,i))*
- & (stre(1)+stiini(1,jj,i))+
- & (eloc(2)-eth(2)-emeini(2,jj,i))*
- & (stre(2)+stiini(2,jj,i))+
- & (eloc(3)-eth(3)-emeini(3,jj,i))*
- & (stre(3)+stiini(3,jj,i)))/2.d0+
+! calculation of the shape energy for the objective
+! function: SHAPE ENERGY
+!
+ ener(jj,i)=enerini(jj,i)+
+ & ((eloc(1)-eth(1)-emeini(1,jj,i))*
+ & (stre(1)+stiini(1,jj,i))+
+ & (eloc(2)-eth(2)-emeini(2,jj,i))*
+ & (stre(2)+stiini(2,jj,i))+
+ & (eloc(3)-eth(3)-emeini(3,jj,i))*
+ & (stre(3)+stiini(3,jj,i)))/2.d0+
& (eloc(4)-eth(4)-emeini(4,jj,i))*(stre(4)+stiini(4,jj,i))+
& (eloc(5)-eth(5)-emeini(5,jj,i))*(stre(5)+stiini(5,jj,i))+
& (eloc(6)-eth(6)-emeini(6,jj,i))*(stre(6)+stiini(6,jj,i))
-c ener(jj,i)=enerini(jj,i)+
-c & ((eloc(1)-eth(1)-eme(1,jj,i))*
-c & (stre(1)+stiini(1,jj,i))+
-c & (eloc(2)-eth(2)-eme(2,jj,i))*
-c & (stre(2)+stiini(2,jj,i))+
-c & (eloc(3)-eth(3)-eme(3,jj,i))*
-c & (stre(3)+stiini(3,jj,i)))/2.d0+
-c & (eloc(4)-eth(4)-eme(4,jj,i))*(stre(4)+stiini(4,jj,i))+
-c & (eloc(5)-eth(5)-eme(5,jj,i))*(stre(5)+stiini(5,jj,i))+
-c & (eloc(6)-eth(6)-eme(6,jj,i))*(stre(6)+stiini(6,jj,i))
- endif
- eme(1,jj,i)=eloc(1)-eth(1)
- eme(2,jj,i)=eloc(2)-eth(2)
- eme(3,jj,i)=eloc(3)-eth(3)
- eme(4,jj,i)=eloc(4)-eth(4)
- eme(5,jj,i)=eloc(5)-eth(5)
- eme(6,jj,i)=eloc(6)-eth(6)
- endif
-!
- if((iout.gt.0).or.(iout.eq.-2).or.(kode.le.-100)) then
-c eme(1,jj,i)=eloc(1)-eth(1)
-c eme(2,jj,i)=eloc(2)-eth(2)
-c eme(3,jj,i)=eloc(3)-eth(3)
-c eme(4,jj,i)=eloc(4)-eth(4)
-c eme(5,jj,i)=eloc(5)-eth(5)
-c eme(6,jj,i)=eloc(6)-eth(6)
-!
- eei(1,jj,i)=eloc(1)
- eei(2,jj,i)=eloc(2)
- eei(3,jj,i)=eloc(3)
- eei(4,jj,i)=eloc(4)
- eei(5,jj,i)=eloc(5)
- eei(6,jj,i)=eloc(6)
- endif
-!
-! updating the kinetic energy
-!
- if(ikin.eq.1) then
-
- call materialdata_rho(rhcon,nrhcon,imat,rho,t1l,
- & ntmat_,ithermal)
- do m1=1,3
- vel(m1,1)=0.d0
- do i1= 1,nope
- vel(m1,1)=vel(m1,1)+shp(4,i1)*veoldl(m1,i1)
- enddo
- enddo
- ener(jj,i+ne)=rho*(vel(1,1)*vel(1,1)+
- & vel(2,1)*vel(2,1)+ vel(3,1)*vel(3,1))/2.d0
- endif
-!
- skl(1,1)=stre(1)
- skl(2,2)=stre(2)
- skl(3,3)=stre(3)
- skl(2,1)=stre(4)
- skl(3,1)=stre(5)
- skl(3,2)=stre(6)
-!
- stx(1,jj,i)=skl(1,1)
- stx(2,jj,i)=skl(2,2)
- stx(3,jj,i)=skl(3,3)
- stx(4,jj,i)=skl(2,1)
- stx(5,jj,i)=skl(3,1)
- stx(6,jj,i)=skl(3,2)
-!
- skl(1,2)=skl(2,1)
- skl(1,3)=skl(3,1)
- skl(2,3)=skl(3,2)
-!
-! calculation of the nodal forces
-!
- if(calcul_fn.eq.1)then
-!
-! calculating fn using skl
-!
- do m1=1,nope
- do m2=1,3
-!
-! linear elastic part
-!
- do m3=1,3
- fn(m2,konl(m1))=fn(m2,konl(m1))+
- & xsj*skl(m2,m3)*shp(m3,m1)*weight
- enddo
-!
-! nonlinear geometric part
-!
- if(iperturb(2).eq.1) then
- do m3=1,3
- do m4=1,3
- fn(m2,konl(m1))=fn(m2,konl(m1))+
- & xsj*skl(m4,m3)*weight*
- & (vkl(m2,m4)*shp(m3,m1)+
- & vkl(m2,m3)*shp(m4,m1))/2.d0
- enddo
- enddo
- endif
-!
- enddo
- enddo
-c Bernhardi start
- if(lakonl(1:5).eq.'C3D8R') then
- call hgforce (fn,elas,a,gs,vl,mi,konl)
- endif
-c Bernhardi end
- endif
-!
-! calculation of the Cauchy stresses
-!
- if(calcul_cauchy.eq.1) then
-!
-! changing the displacement gradients into
-! deformation gradients
-!
-c if(kode.ne.-50) then
- if((kode.ne.-50).and.(kode.gt.-100)) then
-c Bernhardi start
- xkl(1,1)=vkl(1,1)+1.0d0
- xkl(2,2)=vkl(2,2)+1.0d0
- xkl(3,3)=vkl(3,3)+1.0d0
-c Bernhardi end
- xkl(1,2)=vkl(1,2)
- xkl(1,3)=vkl(1,3)
- xkl(2,3)=vkl(2,3)
- xkl(2,1)=vkl(2,1)
- xkl(3,1)=vkl(3,1)
- xkl(3,2)=vkl(3,2)
-!
- vj=xkl(1,1)*(xkl(2,2)*xkl(3,3)-xkl(2,3)*xkl(3,2))
- & -xkl(1,2)*(xkl(2,1)*xkl(3,3)-xkl(2,3)*xkl(3,1))
- & +xkl(1,3)*(xkl(2,1)*xkl(3,2)-xkl(2,2)*xkl(3,1))
- endif
-!
- do m1=1,3
- do m2=1,m1
- ckl(m1,m2)=0.d0
- do m3=1,3
- do m4=1,3
- ckl(m1,m2)=ckl(m1,m2)+
- & skl(m3,m4)*xkl(m1,m3)*xkl(m2,m4)
- enddo
- enddo
- ckl(m1,m2)=ckl(m1,m2)/vj
- enddo
- enddo
-!
- stx(1,jj,i)=ckl(1,1)
- stx(2,jj,i)=ckl(2,2)
- stx(3,jj,i)=ckl(3,3)
- stx(4,jj,i)=ckl(2,1)
- stx(5,jj,i)=ckl(3,1)
- stx(6,jj,i)=ckl(3,2)
- endif
+
+ enerint=enerint+weight*xsj*ener(jj,i)
!
+! end of loop over all integration points
enddo
!
! q contains the contributions to the nodal force in the nodes
@@ -1079,7 +944,30 @@ c Bernhardi end
enddo
nal=nal+3*nope
endif
+!
+! summation of the objective function over all elements
+!
+ dg=dg+enerint
+!
+! end of loop over all elements in thread
+!
enddo
!
+! for the nominal model ( without variation of the nodes) stop after
+! sum over all elements once
+!
+ if(desvar.eq.0) then
+ g0(numobject)=dg
+ else
+!
+! finite difference step
+!
+ dgdx(desvar,numobject)=(dg-g0(numobject))/distmin
+ endif
+!
+! end of loop over all designvariables
+!
+ enddo
+!
return
end
diff --git a/ccx_2.10/src/objective_shapeener_tot.f b/ccx_2.10/src/objective_shapeener_tot.f
new file mode 100644
index 0000000..afb732f
--- /dev/null
+++ b/ccx_2.10/src/objective_shapeener_tot.f
@@ -0,0 +1,56 @@
+!
+! CalculiX - A 3-dimensional finite element program
+! Copyright (C) 1998-2015 Guido Dhondt
+!
+! This program is free software; you can redistribute it and/or
+! modify it under the terms of the GNU General Public License as
+! published by the Free Software Foundation(version 2);
+!
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program; if not, write to the Free Software
+! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+!
+ subroutine objective_shapeener_tot(dgdxtot,dgdx,dfextminds,
+ & df,vold,neq,ndesi,nobject,numobject,mi,nactdof,nk)
+!
+ integer neq,ndesi,nobject,numobject,mi(*),i,j,jj,
+ & nactdof(0:mi(2),*)
+!
+ real*8 dgdxtot(ndesi,nobject),dgdx(ndesi,nobject),
+ & dfextminds(ndesi,neq),df(ndesi,neq),vold(0:mi(2),*),
+ & dummy1(ndesi,neq),dummy2(ndesi)
+!
+! ----------------------------------------------------------------
+! Calculation of the total differential:
+! dgdxtot = dgdx + vold^(T) * ( dfextminds - df )
+! ----------------------------------------------------------------
+!
+ do i=1,ndesi
+ do j=1,neq
+ dummy1(i,j)=dfextminds(i,j)-df(i,j)
+ enddo
+ enddo
+!
+ do jj=1,ndesi
+ dummy2(jj)=0.d0
+ do i=1,nk
+ do j=1,3
+ if(nactdof(j,i).eq.0) cycle
+ dummy2(jj)=dummy2(jj)+
+ & vold(j,i)*dummy1(jj,nactdof(j,i))
+ enddo
+ enddo
+ enddo
+!
+ do i=1,ndesi
+ dgdxtot(i,numobject)=dgdx(i,numobject)+dummy2(i)
+ enddo
+!
+ return
+ end
diff --git a/ccx_2.10/src/objectives.f b/ccx_2.10/src/objectives.f
new file mode 100644
index 0000000..88bde4e
--- /dev/null
+++ b/ccx_2.10/src/objectives.f
@@ -0,0 +1,92 @@
+!
+! CalculiX - A 3-dimensional finite element program
+! Copyright (C) 1998-2015 Guido Dhondt
+!
+! This program is free software; you can redistribute it and/or
+! modify it under the terms of the GNU General Public License as
+! published by the Free Software Foundation(version 2);
+!
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program; if not, write to the Free Software
+! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+!
+ subroutine objectives(inpc,textpart,istep,istat,n,iline,ipol,inl,
+ & ipoinp,inp,ipoinpc,nener,nobject,objectset)
+!
+! reading the input deck: *OBJECTIVE
+!
+! criteria: MASS
+! STRESS
+! EIGENFREQUENCY
+! SHAPE ENERGY
+!
+ implicit none
+!
+ character*1 inpc(*)
+ character*132 textpart(16)
+ character*81 objectset(3,*)
+!
+ integer istep,istat,n,key,i,iline,ipol,inl,ipoinp(2,*),
+ & inp(3,*),ipoinpc(0:*),j,nener,nobject
+!
+ if(istep.lt.1) then
+ write(*,*) '*ERROR reading *OBJECTIVE: *OBJECTIVE can
+ &only be used within a SENSITIVITY STEP'
+ call exit(201)
+ endif
+!
+ call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
+ & ipoinp,inp,ipoinpc)
+!
+
+ do j=1,nobject
+ i=1
+ if(textpart(i)(1:11).eq.'SHAPEENERGY') then
+ read(textpart(i)(1:85),'(a80)',iostat=istat)
+ & objectset(1,j)(1:80)
+ if(textpart(2)(1:6).eq.'ELSET=') then
+ read(textpart(2)(7:85),'(a80)',iostat=istat)
+ & objectset(3,j)(1:80)
+ endif
+ nener=1
+ elseif(textpart(i)(1:4).eq.'MASS') then
+ read(textpart(i)(1:4),'(a80)',iostat=istat)
+ & objectset(1,j)(1:80)
+ if(textpart(2)(1:6).eq.'ELSET=') then
+ read(textpart(2)(7:85),'(a80)',iostat=istat)
+ & objectset(3,j)(1:80)
+ endif
+ elseif(textpart(i)(1:6).eq.'STRESS') then
+ read(textpart(i)(1:6),'(a80)',iostat=istat)
+ & objectset(1,j)(1:80)
+ do i=2,n
+ if(textpart(i)(1:7).eq.'ENTITY=') then
+ read(textpart(i)(8:85),'(a80)',iostat=istat)
+ & objectset(2,j)(1:80)
+ elseif(textpart(i)(1:6).eq.'ELSET=') then
+ read(textpart(i)(7:85),'(a80)',iostat=istat)
+ & objectset(3,j)(1:80)
+ endif
+ enddo
+ elseif(textpart(i)(1:14).eq.'EIGENFREQUENCY') then
+ read(textpart(i)(1:14),'(a80)',iostat=istat)
+ & objectset(1,j)(1:80)
+ endif
+!
+ call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
+ & ipoinp,inp,ipoinpc)
+!
+ enddo
+!
+ call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
+ & ipoinp,inp,ipoinpc)
+!
+ return
+ end
+
diff --git a/ccx_2.10/src/objectivesmmain_se.c b/ccx_2.10/src/objectivesmmain_se.c
new file mode 100644
index 0000000..184d10e
--- /dev/null
+++ b/ccx_2.10/src/objectivesmmain_se.c
@@ -0,0 +1,319 @@
+/* CalculiX - A 3-dimensional finite element program */
+/* Copyright (C) 1998-2015 Guido Dhondt */
+
+/* This program is free software; you can redistribute it and/or */
+/* modify it under the terms of the GNU General Public License as */
+/* published by the Free Software Foundation(version 2); */
+/* */
+
+/* This program is distributed in the hope that it will be useful, */
+/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
+/* GNU General Public License for more details. */
+
+/* You should have received a copy of the GNU General Public License */
+/* along with this program; if not, write to the Free Software */
+/* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+#include <unistd.h>
+#include <stdio.h>
+#include <math.h>
+#include <stdlib.h>
+#include <pthread.h>
+#include "CalculiX.h"
+
+static char *lakon1,*matname1,*objectset1;
+
+static ITG *kon1,*ipkon1,*ne1,*nelcon1,*nrhcon1,*nalcon1,*ielmat1,*ielorien1,
+ *norien1,*ntmat1_,*ithermal1,*iprestr1,*iperturb1,*iout1,*nmethod1,
+ *nplicon1,*nplkcon1,*npmat1_,*mi1,*ielas1,*icmd1,*ncmat1_,*nstate1_,
+ *istep1,*iinc1,calcul_fn1,calcul_qa1,calcul_cauchy1,iener1,ikin1,
+ *nal=NULL,num_cpus,mt1,*nk1,*ne01,*mortar1,*ielprop1,*ndesi1,*nodedesi1,
+ *ndirdesi1,*nobject1,numobject1,*nactdof1,*neq1;
+
+static double *co1,*v1,*stx1,*elcon1,*rhcon1,*alcon1,*alzero1,*orab1,*t01,*t11,
+ *prestr1,*eme1,*fn1=NULL,*qa1=NULL,*vold1,*veold1,*dtime1,*time1,
+ *ttime1,*plicon1,*plkcon1,*xstateini1,*xstiff1,*xstate1,*stiini1,
+ *vini1,*ener1,*eei1,*enerini1,*springarea1,*reltime1,*thicke1,*emeini1,
+ *prop1,*pslavsurf1,*pmastsurf1,*clearini1,*distmin1,*g01,*dgdx1,*dgdv1,
+ *sti1,*dgdxtot1,*dfextminds1,*df1;
+
+
+void objectivesmmain_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 *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 *ndirdesi,ITG *nobject,char *objectset,double *g0,double *dgdx,
+ double *dgdv,double *sti,double *dgdxtot, double *dfextminds,
+ double *df){
+
+ ITG intpointvarm,calcul_fn,calcul_f,calcul_qa,calcul_cauchy,iener,ikin,
+ intpointvart,mt=mi[1]+1,i,j,m,numobject;
+
+ /* variables for multithreading procedure */
+
+ ITG sys_cpus,*ithread=NULL;
+ char *env,*envloc,*envsys;
+
+ num_cpus = 0;
+ sys_cpus=0;
+
+ /* copying and accumulating dfextminds
+
+ NNEW(dfextminds1,double,*ndesi**neq);
+ for(i=0;*ndesi**neq;++i){dfextminds1[i]=dfextminds[i];} */
+
+ /* 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,&iener,
+ &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 objective function and the derivatives */
+
+ NNEW(fn1,double,num_cpus*mt**nk);
+ NNEW(qa1,double,num_cpus*3);
+ NNEW(nal,ITG,num_cpus);
+ NNEW(g01,double,num_cpus);
+ NNEW(dgdxtot1,double,num_cpus**nk*numobject);
+
+ 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;
+ iener1=iener;ikin1=ikin;mt1=mt;nk1=nk;ne01=ne0;thicke1=thicke;
+ emeini1=emeini;pslavsurf1=pslavsurf;clearini1=clearini;
+ pmastsurf1=pmastsurf;mortar1=mortar;ielprop1=ielprop;prop1=prop;
+ distmin1=distmin;ndesi1=ndesi;nodedesi1=nodedesi;
+ ndirdesi1=ndirdesi;nobject1=nobject;objectset1=objectset;
+ dgdx1=dgdx;dgdv1=dgdv;sti1=sti;df1=df;nactdof1=nactdof;neq1=neq;
+ dfextminds1=dfextminds;
+
+ if(((*nmethod!=4)&&(*nmethod!=5))||(iperturb[0]>1)){
+ printf(" Using up to %" ITGFORMAT " cpu(s) for the stress calculation.\n\n", num_cpus);
+ }
+
+ NNEW(ithread,ITG,num_cpus);
+
+ for(m=1;m<*nobject+1;m=m+1){
+ if(strcmp1(&objectset[(m-1)*243],"MASS")==0){
+ numobject=m;
+ numobject1=numobject;
+ /* OBJECTIVE: MASS */
+
+ /* Total difference of the mass */
+ /* create threads and wait */
+
+ for(i=0; i<num_cpus; i++) {
+ ithread[i]=i;
+ pthread_create(&tid[i], NULL, (void *)objectivemt_mass, (void *)&ithread[i]);
+ }
+
+ for(i=0; i<num_cpus; i++) pthread_join(tid[i], NULL);
+ }
+
+ else if(strcmp1(&objectset[(m-1)*243],"SHAPEENERGY")==0){
+ numobject=m;
+ numobject1=numobject;
+ /* OBJECTIVE: SHAPE ENERGY */
+
+ /* Total difference of the internal shape energy */
+ /* create threads and wait */
+
+ for(i=0; i<num_cpus; i++) {
+ ithread[i]=i;
+ pthread_create(&tid[i], NULL, (void *)objectivemt_shapeener, (void *)&ithread[i]);
+ }
+
+ for(i=0; i<num_cpus; i++) pthread_join(tid[i], NULL);
+ }
+ }
+
+ /* Passing of g0 */
+ for(i=0;i<*nobject;i++){
+ g0[i]=g01[i];
+ }
+ for(i=0;i<*nobject;i++){
+ for(j=1;j<num_cpus;j++){
+ g0[i]+=g01[i+j**nobject];
+ }
+ }
+ SFREE(g01);
+
+ /* Passing of dgdxtot */
+ for(i=0;i<*ndesi**nobject;i++){
+ dgdxtot[i]=dgdxtot1[i];
+ }
+ for(i=0;i<*ndesi**nobject;i++){
+ for(j=1;j<num_cpus;j++){
+ dgdxtot[i]+=dgdxtot1[i+j**ndesi**nobject];
+ }
+ }
+ SFREE(dgdxtot1);
+
+ SFREE(fn1);SFREE(ithread);SFREE(qa1);SFREE(nal);
+
+return;
+
+}
+
+/* ----------------------------------------------------------------*/
+/* subroutine for multithreading: Differentiation of shape energy */
+/* ----------------------------------------------------------------*/
+
+void *objectivemt_shapeener(ITG *i){
+
+ ITG indexfn,indexqa,indexnal,nea,neb,nedelta;
+
+ indexfn=*i*mt1**nk1;
+ indexqa=*i*3;
+ 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(objective_shapeener,(co1,kon1,ipkon1,lakon1,ne1,
+ stx1,elcon1,nelcon1,rhcon1,nrhcon1,alcon1,nalcon1,alzero1,
+ ielmat1,ielorien1,norien1,orab1,ntmat1_,t01,t11,ithermal1,prestr1,
+ iprestr1,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,enerini1,istep1,iinc1,
+ springarea1,reltime1,&calcul_qa1,&iener1,&ikin1,&nal[indexnal],
+ ne01,thicke1,emeini1,pslavsurf1,pmastsurf1,mortar1,clearini1,
+ &nea,&neb,ielprop1,prop1,distmin1,ndesi1,nodedesi1,ndirdesi1,
+ nobject1,g01,dgdx1,&numobject1,sti1,dgdxtot1,dfextminds1,df1,
+ neq1,nactdof1,nk1));
+
+ return NULL;
+}
+
+/* ---------------------------------------------------*/
+/* subroutine for multithreading of objective_mass */
+/* ---------------------------------------------------*/
+
+void *objectivemt_mass(ITG *i){
+
+ ITG indexfn,indexqa,indexnal,nea,neb,nedelta;
+
+ indexfn=*i*mt1**nk1;
+ indexqa=*i*3;
+ 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(objective_mass,(co1,kon1,ipkon1,lakon1,v1,nelcon1,rhcon1,
+ ielmat1,ielorien1,norien1,ntmat1_,vold1,matname1,mi1,&nal[indexnal],
+ thicke1,mortar1,&nea,&neb,ielprop1,prop1,distmin1,ndesi1,nodedesi1,
+ ndirdesi1,nobject1,g01,dgdxtot1,&numobject1));
+
+ return NULL;
+}
diff --git a/ccx_2.9/src/onedint.f b/ccx_2.10/src/onedint.f
similarity index 100%
rename from ccx_2.9/src/onedint.f
rename to ccx_2.10/src/onedint.f
diff --git a/ccx_2.9/src/op.f b/ccx_2.10/src/op.f
similarity index 100%
rename from ccx_2.9/src/op.f
rename to ccx_2.10/src/op.f
diff --git a/ccx_2.9/src/op_corio.f b/ccx_2.10/src/op_corio.f
similarity index 100%
rename from ccx_2.9/src/op_corio.f
rename to ccx_2.10/src/op_corio.f
diff --git a/ccx_2.9/src/opas.f b/ccx_2.10/src/opas.f
similarity index 100%
rename from ccx_2.9/src/opas.f
rename to ccx_2.10/src/opas.f
diff --git a/ccx_2.9/src/openfile.f b/ccx_2.10/src/openfile.f
similarity index 100%
rename from ccx_2.9/src/openfile.f
rename to ccx_2.10/src/openfile.f
diff --git a/ccx_2.9/src/openfilefluid.f b/ccx_2.10/src/openfilefluid.f
similarity index 100%
rename from ccx_2.9/src/openfilefluid.f
rename to ccx_2.10/src/openfilefluid.f
diff --git a/ccx_2.9/src/orientations.f b/ccx_2.10/src/orientations.f
similarity index 100%
rename from ccx_2.9/src/orientations.f
rename to ccx_2.10/src/orientations.f
diff --git a/ccx_2.9/src/orifice.f b/ccx_2.10/src/orifice.f
similarity index 100%
rename from ccx_2.9/src/orifice.f
rename to ccx_2.10/src/orifice.f
diff --git a/ccx_2.9/src/orthonl.f b/ccx_2.10/src/orthonl.f
similarity index 100%
rename from ccx_2.9/src/orthonl.f
rename to ccx_2.10/src/orthonl.f
diff --git a/ccx_2.9/src/orthotropic.f b/ccx_2.10/src/orthotropic.f
similarity index 100%
rename from ccx_2.9/src/orthotropic.f
rename to ccx_2.10/src/orthotropic.f
diff --git a/ccx_2.9/src/outputs.f b/ccx_2.10/src/outputs.f
similarity index 100%
rename from ccx_2.9/src/outputs.f
rename to ccx_2.10/src/outputs.f
diff --git a/ccx_2.9/src/pardiso.c b/ccx_2.10/src/pardiso.c
similarity index 100%
rename from ccx_2.9/src/pardiso.c
rename to ccx_2.10/src/pardiso.c
diff --git a/ccx_2.9/src/pardiso.h b/ccx_2.10/src/pardiso.h
similarity index 100%
rename from ccx_2.9/src/pardiso.h
rename to ccx_2.10/src/pardiso.h
diff --git a/ccx_2.9/src/pardiso_as.c b/ccx_2.10/src/pardiso_as.c
similarity index 100%
rename from ccx_2.9/src/pardiso_as.c
rename to ccx_2.10/src/pardiso_as.c
diff --git a/ccx_2.9/src/patch.f b/ccx_2.10/src/patch.f
similarity index 100%
rename from ccx_2.9/src/patch.f
rename to ccx_2.10/src/patch.f
diff --git a/ccx_2.9/src/pcgsolver.c b/ccx_2.10/src/pcgsolver.c
similarity index 100%
rename from ccx_2.9/src/pcgsolver.c
rename to ccx_2.10/src/pcgsolver.c
diff --git a/ccx_2.9/src/physicalconstantss.f b/ccx_2.10/src/physicalconstantss.f
similarity index 100%
rename from ccx_2.9/src/physicalconstantss.f
rename to ccx_2.10/src/physicalconstantss.f
diff --git a/ccx_2.9/src/pk_cdc_cl1.f b/ccx_2.10/src/pk_cdc_cl1.f
similarity index 100%
rename from ccx_2.9/src/pk_cdc_cl1.f
rename to ccx_2.10/src/pk_cdc_cl1.f
diff --git a/ccx_2.9/src/pk_cdc_cl3.f b/ccx_2.10/src/pk_cdc_cl3.f
similarity index 100%
rename from ccx_2.9/src/pk_cdc_cl3.f
rename to ccx_2.10/src/pk_cdc_cl3.f
diff --git a/ccx_2.9/src/pk_cdc_cl3a.f b/ccx_2.10/src/pk_cdc_cl3a.f
similarity index 100%
rename from ccx_2.9/src/pk_cdc_cl3a.f
rename to ccx_2.10/src/pk_cdc_cl3a.f
diff --git a/ccx_2.9/src/pk_cdc_cl3b.f b/ccx_2.10/src/pk_cdc_cl3b.f
similarity index 100%
rename from ccx_2.9/src/pk_cdc_cl3b.f
rename to ccx_2.10/src/pk_cdc_cl3b.f
diff --git a/ccx_2.9/src/pk_cdc_cl3d.f b/ccx_2.10/src/pk_cdc_cl3d.f
similarity index 100%
rename from ccx_2.9/src/pk_cdc_cl3d.f
rename to ccx_2.10/src/pk_cdc_cl3d.f
diff --git a/ccx_2.9/src/pk_cdi_noz.f b/ccx_2.10/src/pk_cdi_noz.f
similarity index 100%
rename from ccx_2.9/src/pk_cdi_noz.f
rename to ccx_2.10/src/pk_cdi_noz.f
diff --git a/ccx_2.9/src/pk_cdi_r.f b/ccx_2.10/src/pk_cdi_r.f
similarity index 100%
rename from ccx_2.9/src/pk_cdi_r.f
rename to ccx_2.10/src/pk_cdi_r.f
diff --git a/ccx_2.9/src/pk_cdi_rl.f b/ccx_2.10/src/pk_cdi_rl.f
similarity index 100%
rename from ccx_2.9/src/pk_cdi_rl.f
rename to ccx_2.10/src/pk_cdi_rl.f
diff --git a/ccx_2.9/src/pk_cdi_se.f b/ccx_2.10/src/pk_cdi_se.f
similarity index 100%
rename from ccx_2.9/src/pk_cdi_se.f
rename to ccx_2.10/src/pk_cdi_se.f
diff --git a/ccx_2.9/src/pk_y0_yg.f b/ccx_2.10/src/pk_y0_yg.f
similarity index 100%
rename from ccx_2.9/src/pk_y0_yg.f
rename to ccx_2.10/src/pk_y0_yg.f
diff --git a/ccx_2.9/src/plane_eq.f b/ccx_2.10/src/plane_eq.f
similarity index 100%
rename from ccx_2.9/src/plane_eq.f
rename to ccx_2.10/src/plane_eq.f
diff --git a/ccx_2.9/src/planeeq.f b/ccx_2.10/src/planeeq.f
similarity index 100%
rename from ccx_2.9/src/planeeq.f
rename to ccx_2.10/src/planeeq.f
diff --git a/ccx_2.9/src/planempc.f b/ccx_2.10/src/planempc.f
similarity index 100%
rename from ccx_2.9/src/planempc.f
rename to ccx_2.10/src/planempc.f
diff --git a/ccx_2.9/src/plastics.f b/ccx_2.10/src/plastics.f
similarity index 50%
rename from ccx_2.9/src/plastics.f
rename to ccx_2.10/src/plastics.f
index 5a99346..6edaf03 100644
--- a/ccx_2.9/src/plastics.f
+++ b/ccx_2.10/src/plastics.f
@@ -19,7 +19,7 @@
subroutine plastics(inpc,textpart,nelcon,nmat,ntmat_,npmat_,
& plicon,nplicon,plkcon,nplkcon,iplas,iperturb,nstate_,
& ncmat_,elcon,matname,irstrt,istep,istat,n,iline,ipol,
- & inl,ipoinp,inp,ipoinpc,ianisoplas)
+ & inl,ipoinp,inp,ipoinpc)
!
! reading the input deck: *PLASTIC
!
@@ -34,8 +34,7 @@
integer nelcon(2,*),nmat,ntmat_,ntmat,npmat_,npmat,istep,
& n,key,i,nplicon(0:ntmat_,*),nplkcon(0:ntmat_,*),ncmat_,
& iplas,iperturb(*),istat,nstate_,kin,itemp,ndata,ndatamax,id,
- & irstrt,iline,ipol,inl,ipoinp(2,*),inp(3,*),ipoinpc(0:*),
- & ianisoplas
+ & irstrt,iline,ipol,inl,ipoinp(2,*),inp(3,*),ipoinpc(0:*)
!
real*8 plicon(0:2*npmat_,ntmat_,*),plkcon(0:2*npmat_,ntmat_,*),
& temperature,plconloc(802),t1l,elcon(0:ncmat_,ntmat_,*)
@@ -67,19 +66,16 @@
endif
!
iperturb(1)=3
-c iperturb(2)=1
-c write(*,*) '*INFO reading *PLASTIC: nonlinear geometric'
-c write(*,*) ' effects are turned on'
-c write(*,*)
!
if(nelcon(1,nmat).eq.2) then
iplas=1
nelcon(1,nmat)=-51
nstate_=max(nstate_,13)
else
- ianisoplas=1
- nelcon(1,nmat)=-114
- nstate_=max(nstate_,14)
+ write(*,*) '*ERROR reading *PLASTIC: *PLASTIC cannot '
+ write(*,*) ' be used with an anisotropic material'
+ write(*,*) ' use a material user subroutine instead'
+ call exit(201)
endif
!
do i=2,n
@@ -89,12 +85,6 @@ c write(*,*)
elseif(textpart(i)(11:18).eq.'COMBINED') then
iso=.false.
elseif(textpart(i)(11:14).eq.'USER') then
- if(nelcon(1,nmat).eq.-114) then
- write(*,*) '*ERROR reading *PLASTIC: user defined '
- write(*,*) ' hardening is not allowed for '
- write(*,*) ' elastically anisotropic materials'
- call exit(201)
- endif
call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
& ipoinp,inp,ipoinpc)
return
@@ -216,167 +206,6 @@ c write(*,*)
call exit(201)
endif
!
-! elastically anisotropic materials: recasting the input data
-! in a format conform to the user routine umat_aniso_plas.f
-!
- if(nelcon(1,nmat).eq.-114) then
- if(matname(nmat)(71:80).ne.' ') then
- write(*,*)
- & '*ERROR reading *PLASTIC: the material name for an'
- write(*,*) ' elastically anisotropic material with'
- write(*,*) ' isotropic plasticity must not exceed 70'
- write(*,*) ' characters'
- call exit(201)
- else
- do i=80,11,-1
- matname(nmat)(i:i)=matname(nmat)(i-10:i-10)
- enddo
-c matname(nmat)(11:80)=matname(nmat)(1:70)
- matname(nmat)(1:10)='ANISO_PLAS'
- endif
-!
- if(iso) then
-!
-! isotropic hardening
-!
-! interpolating the plastic data at the elastic temperature
-! data points
-!
- ndatamax=0
- do i=1,nelcon(2,nmat)
- t1l=elcon(0,i,nmat)
-c plconloc(1)=0.d0
-c plconloc(2)=0.d0
-c plconloc(3)=0.d0
-c plconloc(81)=nplicon(1,nmat)+0.5d0
-!
- if(nplicon(0,nmat).eq.1) then
- id=-1
- else
- call ident2(plicon(0,1,nmat),t1l,nplicon(0,nmat),
- & 2*npmat_+1,id)
- endif
-!
- if(nplicon(0,nmat).eq.0) then
- continue
- elseif((nplicon(0,nmat).eq.1).or.(id.eq.0).or.
- & (id.eq.nplicon(0,nmat))) then
- if(id.le.0) then
- itemp=1
- else
- itemp=id
- endif
- kin=0
- call plcopy(plicon,nplicon,plconloc,npmat_,ntmat_,
- & nmat,itemp,i,kin)
- if((id.eq.0).or.(id.eq.nplicon(0,nmat))) then
- endif
- else
- kin=0
- call plmix(plicon,nplicon,plconloc,npmat_,ntmat_,
- & nmat,id+1,t1l,i,kin)
- endif
-!
- ndata=int(plconloc(801))
- if(ndata.eq.1) then
- elcon(10,i,nmat)=plconloc(2)
- elcon(11,i,nmat)=0.d0
- elcon(12,i,nmat)=0.d0
- elcon(13,i,nmat)=-1.d0
- elcon(14,i,nmat)=1.d0
- else
- elcon(10,i,nmat)=plconloc(2)
- elcon(11,i,nmat)=(plconloc(4)-plconloc(2))/
- & (plconloc(3)-plconloc(1))
- elcon(12,i,nmat)=0.d0
- elcon(13,i,nmat)=-1.d0
- elcon(14,i,nmat)=1.d0
- endif
- ndatamax=max(ndata,ndatamax)
- enddo
- if(ndatamax.gt.2) then
- write(*,*)
- & '*WARNING reading *PLASTIC: isotropic hardening'
- write(*,*) ' curve is possibly nonlinear for'
- write(*,*) ' the elastically anisotropic'
- write(*,*) ' material ',matname(nmat)(11:80)
- endif
- else
-!
-! kinematic hardening
-!
-! interpolating the plastic data at the elastic temperature
-! data points
-!
- ndatamax=0
- do i=1,nelcon(2,nmat)
- t1l=elcon(0,i,nmat)
-c plconloc(1)=0.d0
-c plconloc(2)=0.d0
-c plconloc(3)=0.d0
-c plconloc(82)=nplkcon(1,nmat)+0.5d0
-!
- if(nplkcon(0,nmat).eq.1) then
- id=-1
- else
- call ident2(plkcon(0,1,nmat),t1l,nplkcon(0,nmat),
- & 2*npmat_+1,id)
- endif
-!
- if(nplkcon(0,nmat).eq.0) then
- continue
- elseif((nplkcon(0,nmat).eq.1).or.(id.eq.0).or.
- & (id.eq.nplkcon(0,nmat))) then
- if(id.le.0) then
- itemp=1
- else
- itemp=id
- endif
- kin=1
- call plcopy(plkcon,nplkcon,plconloc,npmat_,ntmat_,
- & nmat,itemp,i,kin)
- if((id.eq.0).or.(id.eq.nplkcon(0,nmat))) then
- endif
- else
- kin=1
- call plmix(plkcon,nplkcon,plconloc,npmat_,ntmat_,
- & nmat,id+1,t1l,i,kin)
- endif
-!
- ndata=int(plconloc(802))
- if(ndata.eq.1) then
- elcon(10,i,nmat)=plconloc(402)
- elcon(11,i,nmat)=0.d0
- elcon(12,i,nmat)=0.d0
- elcon(13,i,nmat)=-1.d0
- elcon(14,i,nmat)=1.d0
- else
- elcon(10,i,nmat)=plconloc(402)
- elcon(11,i,nmat)=0.d0
- elcon(12,i,nmat)=(plconloc(404)-plconloc(402))/
- & (plconloc(403)-plconloc(401))
- elcon(13,i,nmat)=-1.d0
- elcon(14,i,nmat)=1.d0
- endif
- ndatamax=max(ndata,ndatamax)
- enddo
- if(ndatamax.gt.2) then
- write(*,*)
- & '*WARNING reading *PLASTIC: kinematic hardening'
- write(*,*) ' curve is possibly nonlinear for'
- write(*,*) ' the elastically anisotropic'
- write(*,*) ' material ',matname(nmat)(11:80)
- endif
- endif
- endif
-!
-c if(nelcon(1,nmat).eq.-114) then
-c write(*,*) 'anisotropic elasticity+viscoplasticity'
-c do i=1,nelcon(2,nmat)
-c write(*,*) (elcon(j,i,nmat),j=0,14)
-c enddo
-c endif
-!
return
end
diff --git a/ccx_2.9/src/plcopy.f b/ccx_2.10/src/plcopy.f
similarity index 100%
rename from ccx_2.9/src/plcopy.f
rename to ccx_2.10/src/plcopy.f
diff --git a/ccx_2.9/src/plinterpol.f b/ccx_2.10/src/plinterpol.f
similarity index 100%
rename from ccx_2.9/src/plinterpol.f
rename to ccx_2.10/src/plinterpol.f
diff --git a/ccx_2.9/src/plmix.f b/ccx_2.10/src/plmix.f
similarity index 100%
rename from ccx_2.9/src/plmix.f
rename to ccx_2.10/src/plmix.f
diff --git a/ccx_2.9/src/pop.f b/ccx_2.10/src/pop.f
similarity index 100%
rename from ccx_2.9/src/pop.f
rename to ccx_2.10/src/pop.f
diff --git a/ccx_2.9/src/postview.f b/ccx_2.10/src/postview.f
similarity index 100%
rename from ccx_2.9/src/postview.f
rename to ccx_2.10/src/postview.f
diff --git a/ccx_2.9/src/precfd.f b/ccx_2.10/src/precfd.f
similarity index 100%
rename from ccx_2.9/src/precfd.f
rename to ccx_2.10/src/precfd.f
diff --git a/ccx_2.9/src/precontact.c b/ccx_2.10/src/precontact.c
similarity index 100%
rename from ccx_2.9/src/precontact.c
rename to ccx_2.10/src/precontact.c
diff --git a/ccx_2.9/src/predgmres.f b/ccx_2.10/src/predgmres.f
similarity index 100%
rename from ccx_2.9/src/predgmres.f
rename to ccx_2.10/src/predgmres.f
diff --git a/ccx_2.9/src/prediction.c b/ccx_2.10/src/prediction.c
similarity index 100%
rename from ccx_2.9/src/prediction.c
rename to ccx_2.10/src/prediction.c
diff --git a/ccx_2.9/src/prediction_em.c b/ccx_2.10/src/prediction_em.c
similarity index 100%
rename from ccx_2.9/src/prediction_em.c
rename to ccx_2.10/src/prediction_em.c
diff --git a/ccx_2.9/src/predir.f b/ccx_2.10/src/predir.f
similarity index 100%
rename from ccx_2.9/src/predir.f
rename to ccx_2.10/src/predir.f
diff --git a/ccx_2.9/src/preiter.c b/ccx_2.10/src/preiter.c
similarity index 100%
rename from ccx_2.9/src/preiter.c
rename to ccx_2.10/src/preiter.c
diff --git a/ccx_2.9/src/pretensionsections.f b/ccx_2.10/src/pretensionsections.f
similarity index 98%
rename from ccx_2.9/src/pretensionsections.f
rename to ccx_2.10/src/pretensionsections.f
index ffc2333..6bf3b75 100644
--- a/ccx_2.9/src/pretensionsections.f
+++ b/ccx_2.10/src/pretensionsections.f
@@ -39,7 +39,7 @@
& mpcfreeold,ikmpc(*),ilmpc(*),id,idof,iline,ipol,inl,
& ipoinp(2,*),inp(3,*),ipoinpc(0:*),irefnode,lathyp(3,6),inum,
& jn,jt,jd,iside,nelem,jface,nopes,nface,nodef(8),nodel(8),
- & ifaceq(9,6),ifacet(7,4),ifacew1(4,5),ifacew2(8,5),indexpret,
+ & ifaceq(8,6),ifacet(6,4),ifacew1(4,5),ifacew2(8,5),indexpret,
& k,ipos,nkold,nope,m,kon(*),ipkon(*),indexe,iset,nset,idir,
& istartset(*),iendset(*),ialset(*),index1,ics(2,*),mpcpret,
& mint,iflag,ithermal(2),ielem,three,in(3),node1,node2,isign,
@@ -57,19 +57,19 @@
!
! nodes per face for hex elements
!
- data ifaceq /4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/
+ data ifaceq /4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/
!
! nodes per face for tet elements
!
- data ifacet /1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/
+ data ifacet /1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/
!
! nodes per face for linear wedge elements
!
diff --git a/ccx_2.9/src/printout.f b/ccx_2.10/src/printout.f
similarity index 98%
rename from ccx_2.9/src/printout.f
rename to ccx_2.10/src/printout.f
index 45e122c..27a4c7a 100644
--- a/ccx_2.9/src/printout.f
+++ b/ccx_2.10/src/printout.f
@@ -414,7 +414,7 @@
call printoutelem(prlab,ipkon,lakon,kon,co,
& ener,mi(1),ii,nelem,energytot,volumetot,
& enerkintot,ikin,ne,stx,nodes,thicke,ielmat,
- & ielem,iface,mortar)
+ & ielem,iface,mortar,ielprop,prop)
enddo
elseif(mortar.eq.1) then
do nelem=ne0,ne
@@ -425,7 +425,7 @@
call printoutelem(prlab,ipkon,lakon,kon,co,
& ener,mi(1),ii,nelem,energytot,volumetot,
& enerkintot,ikin,ne,stx,nodes,thicke,ielmat,
- & ielem,iface,mortar)
+ & ielem,iface,mortar,ielprop,prop)
enddo
endif
endif
@@ -440,20 +440,20 @@
call printoutelem(prlab,ipkon,lakon,kon,co,
& ener,mi(1),ii,nelem,energytot,volumetot,
& enerkintot,ikin,ne,stx,nodes,thicke,ielmat,
- & ielem,iface,mortar)
+ & ielem,iface,mortar,ielprop,prop)
elseif(ialset(jj+1).gt.0) then
nelem=ialset(jj)
call printoutelem(prlab,ipkon,lakon,kon,co,
& ener,mi(1),ii,nelem,energytot,volumetot,
& enerkintot,ikin,ne,stx,nodes,thicke,ielmat,
- & ielem,iface,mortar)
+ & ielem,iface,mortar,ielprop,prop)
else
do nelem=ialset(jj-1)-ialset(jj+1),ialset(jj),
& -ialset(jj+1)
call printoutelem(prlab,ipkon,lakon,kon,co,
& ener,mi(1),ii,nelem,energytot,volumetot,
& enerkintot,ikin,ne,stx,nodes,thicke,ielmat,
- & ielem,iface,mortar)
+ & ielem,iface,mortar,ielprop,prop)
enddo
endif
enddo
diff --git a/ccx_2.9/src/printoutelem.f b/ccx_2.10/src/printoutelem.f
similarity index 90%
rename from ccx_2.9/src/printoutelem.f
rename to ccx_2.10/src/printoutelem.f
index 4b16eea..96b262e 100644
--- a/ccx_2.9/src/printoutelem.f
+++ b/ccx_2.10/src/printoutelem.f
@@ -18,7 +18,7 @@
!
subroutine printoutelem(prlab,ipkon,lakon,kon,co,
& ener,mi,ii,nelem,energytot,volumetot,enerkintot,nkin,ne,
- & stx,nodes,thicke,ielmat,ielem,iface,mortar)
+ & stx,nodes,thicke,ielmat,ielem,iface,mortar,ielprop,prop)
!
! stores whole element results for element "nelem" in the .dat file
!
@@ -28,15 +28,15 @@
character*8 lakon(*)
!
integer ipkon(*),nelem,ii,kon(*),mi(*),nope,indexe,i,j,k,
- & konl(20),iface,mortar,ielem,
+ & konl(20),iface,mortar,ielem,ielprop(*),
& mint3d,jj,nener,iflag,nkin,ne,nodes,ki,kl,ilayer,nlayer,kk,
- & nopes,ielmat(mi(3),*),mint2d
+ & nopes,ielmat(mi(3),*),mint2d,null
!
real*8 ener(mi(1),*),energytot,volumetot,energy,volume,co(3,*),
& xl(3,20),xi,et,ze,xsj,shp(4,20),weight,enerkintot,enerkin,
& stx(6,mi(1),*),a,gs(8,4),dlayer(4),tlayer(4),thickness,
& thicke(mi(3),*),xlayer(mi(3),4),shp2(7,8),xs2(3,7),xsj2(3),
- & xl2(3,8)
+ & xl2(3,8),prop(*)
!
include "gauss.f"
!
@@ -44,6 +44,7 @@
!
if(ipkon(nelem).lt.0) return
indexe=ipkon(nelem)
+ null=0
!
if((prlab(ii)(1:4).eq.'ELSE').or.(prlab(ii)(1:4).eq.'CELS')) then
nener=1
@@ -125,6 +126,14 @@
!
if(lakon(nelem)(4:5).eq.'8R') then
mint3d=1
+ elseif(lakon(nelem)(4:7).eq.'20RB') then
+ if((lakon(nelem)(8:8).eq.'R').or.
+ & (lakon(nelem)(8:8).eq.'C')) then
+ mint3d=50
+ else
+ call beamintscheme(lakon(nelem),mint3d,ielprop(nelem),prop,
+ & null,xi,et,ze,weight)
+ endif
elseif((lakon(nelem)(4:4).eq.'8').or.
& (lakon(nelem)(4:6).eq.'20R')) then
if(lakon(nelem)(7:8).eq.'LC') then
@@ -155,6 +164,17 @@
et=gauss3d1(2,jj)
ze=gauss3d1(3,jj)
weight=weight3d1(jj)
+ elseif(lakon(nelem)(4:7).eq.'20RB') then
+ if((lakon(nelem)(8:8).eq.'R').or.
+ & (lakon(nelem)(8:8).eq.'C')) then
+ xi=gauss3d13(1,kk)
+ et=gauss3d13(2,kk)
+ ze=gauss3d13(3,kk)
+ weight=weight3d13(kk)
+ else
+ call beamintscheme(lakon(nelem),mint3d,ielprop(nelem),
+ & prop,kk,xi,et,ze,weight)
+ endif
elseif((lakon(nelem)(4:4).eq.'8').or.
& (lakon(nelem)(4:6).eq.'20R'))
& then
diff --git a/ccx_2.9/src/printoutface.f b/ccx_2.10/src/printoutface.f
similarity index 96%
rename from ccx_2.9/src/printoutface.f
rename to ccx_2.10/src/printoutface.f
index d0efd2c..6f53b4b 100644
--- a/ccx_2.9/src/printoutface.f
+++ b/ccx_2.10/src/printoutface.f
@@ -31,9 +31,9 @@
character*80 faset
character*81 set(*),prset(*)
!
- integer konl(20),ifaceq(9,6),nelem,ii,nprint,i,j,i1,i2,j1,
+ integer konl(20),ifaceq(8,6),nelem,ii,nprint,i,j,i1,i2,j1,
& ncocon(2,*),k1,jj,ig,nrhcon(*),nshcon(*),ntmat_,nope,nopes,imat,
- & mint2d,ifacet(7,4),ifacew(8,5),iflag,indexe,jface,istartset(*),
+ & mint2d,ifacet(6,4),ifacew(8,5),iflag,indexe,jface,istartset(*),
& iendset(*),ipkon(*),kon(*),iset,ialset(*),nset,ipos,
& mi(*),ielmat(mi(3),*)
!
@@ -48,16 +48,16 @@
include "gauss.f"
include "xlocal.f"
!
- data ifaceq /4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/
- data ifacet /1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/
+ data ifaceq /4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/
+ data ifacet /1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/
data ifacew /1,3,2,9,8,7,0,0,
& 4,5,6,10,11,12,0,0,
& 1,2,5,4,7,14,10,13,
diff --git a/ccx_2.9/src/printoutfluid.f b/ccx_2.10/src/printoutfluid.f
similarity index 100%
rename from ccx_2.9/src/printoutfluid.f
rename to ccx_2.10/src/printoutfluid.f
diff --git a/ccx_2.9/src/printoutint.f b/ccx_2.10/src/printoutint.f
similarity index 97%
rename from ccx_2.9/src/printoutint.f
rename to ccx_2.10/src/printoutint.f
index 5f7885d..943328e 100644
--- a/ccx_2.9/src/printoutint.f
+++ b/ccx_2.10/src/printoutint.f
@@ -135,8 +135,7 @@
& null,xi,et,ze,weight)
endif
elseif((lakon(nelel)(4:4).eq.'8').or.
- & (lakon(nelel)(4:6).eq.'20R').or.
- & (lakon(nelel)(4:6).eq.'26R')) then
+ & (lakon(nelel)(4:6).eq.'20R')) then
if(lakon(nelel)(7:8).eq.'LC') then
mint3d=8*nlayer
else
@@ -144,8 +143,7 @@
endif
elseif(lakon(nelel)(4:4).eq.'2') then
mint3d=27
- elseif((lakon(nelel)(4:5).eq.'10').or.
- & (lakon(nelel)(4:5).eq.'14')) then
+ elseif(lakon(nelel)(4:5).eq.'10') then
mint3d=4
elseif(lakon(nelel)(4:4).eq.'4') then
mint3d=1
@@ -165,8 +163,7 @@
nope=20
elseif(lakon(nelel)(4:4).eq.'8') then
nope=8
- elseif((lakon(nelel)(4:5).eq.'10').or.
- & (lakon(nelel)(4:5).eq.'14')) then
+ elseif(lakon(nelel)(4:5).eq.'10') then
nope=10
elseif(lakon(nelel)(4:4).eq.'4') then
nope=4
@@ -203,8 +200,7 @@ c indexe=ipkon(nelel)
& prop,j,xi,et,ze,weight)
endif
elseif((lakon(nelel)(4:4).eq.'8').or.
- & (lakon(nelel)(4:6).eq.'20R').or.
- & (lakon(nelel)(4:6).eq.'26R'))
+ & (lakon(nelel)(4:6).eq.'20R'))
& then
if(lakon(nelel)(7:8).ne.'LC') then
xi=gauss3d2(1,j)
diff --git a/ccx_2.9/src/printoutnode.f b/ccx_2.10/src/printoutnode.f
similarity index 100%
rename from ccx_2.9/src/printoutnode.f
rename to ccx_2.10/src/printoutnode.f
diff --git a/ccx_2.9/src/printoutnodefluid.f b/ccx_2.10/src/printoutnodefluid.f
similarity index 100%
rename from ccx_2.9/src/printoutnodefluid.f
rename to ccx_2.10/src/printoutnodefluid.f
diff --git a/ccx_2.9/src/pt2_lim_calc.f b/ccx_2.10/src/pt2_lim_calc.f
similarity index 100%
rename from ccx_2.9/src/pt2_lim_calc.f
rename to ccx_2.10/src/pt2_lim_calc.f
diff --git a/ccx_2.9/src/pt2zpt1_crit.f b/ccx_2.10/src/pt2zpt1_crit.f
similarity index 100%
rename from ccx_2.9/src/pt2zpt1_crit.f
rename to ccx_2.10/src/pt2zpt1_crit.f
diff --git a/ccx_2.9/src/push.f b/ccx_2.10/src/push.f
similarity index 100%
rename from ccx_2.9/src/push.f
rename to ccx_2.10/src/push.f
diff --git a/ccx_2.9/src/qsorti.f b/ccx_2.10/src/qsorti.f
similarity index 100%
rename from ccx_2.9/src/qsorti.f
rename to ccx_2.10/src/qsorti.f
diff --git a/ccx_2.9/src/radcyc.c b/ccx_2.10/src/radcyc.c
similarity index 100%
rename from ccx_2.9/src/radcyc.c
rename to ccx_2.10/src/radcyc.c
diff --git a/ccx_2.9/src/radflowload.c b/ccx_2.10/src/radflowload.c
similarity index 100%
rename from ccx_2.9/src/radflowload.c
rename to ccx_2.10/src/radflowload.c
diff --git a/ccx_2.9/src/radiate.f b/ccx_2.10/src/radiate.f
similarity index 100%
rename from ccx_2.9/src/radiate.f
rename to ccx_2.10/src/radiate.f
diff --git a/ccx_2.9/src/radiates.f b/ccx_2.10/src/radiates.f
similarity index 100%
rename from ccx_2.9/src/radiates.f
rename to ccx_2.10/src/radiates.f
diff --git a/ccx_2.9/src/radmatrix.f b/ccx_2.10/src/radmatrix.f
similarity index 95%
rename from ccx_2.9/src/radmatrix.f
rename to ccx_2.10/src/radmatrix.f
index 82cb75e..9e9628a 100644
--- a/ccx_2.9/src/radmatrix.f
+++ b/ccx_2.10/src/radmatrix.f
@@ -35,7 +35,7 @@
character*20 sideload(*)
!
integer ntr,nelemload(2,*),nope,nopes,mint2d,i,j,k,l,
- & node,ifaceq(9,6),ifacet(7,4),iviewfile,mi(*),
+ & node,ifaceq(8,6),ifacet(6,4),iviewfile,mi(*),
& ifacew(8,5),nelem,ig,index,konl(20),iflag,
& ipkon(*),kon(*),nloadtr(*),i1,ithermal,iinc,iit,
& istep,jltyp,nfield,nmethod,iemchange,nam,
@@ -49,16 +49,16 @@
& dtime,ttime,time,areaj,xloadold(2,*),reltime,
& fform
!
- data ifaceq /4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/
- data ifacet /1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/
+ data ifaceq /4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/
+ data ifacet /1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/
data ifacew /1,3,2,9,8,7,0,0,
& 4,5,6,10,11,12,0,0,
& 1,2,5,4,7,14,10,13,
diff --git a/ccx_2.9/src/radresult.f b/ccx_2.10/src/radresult.f
similarity index 100%
rename from ccx_2.9/src/radresult.f
rename to ccx_2.10/src/radresult.f
diff --git a/ccx_2.9/src/rcavi.f b/ccx_2.10/src/rcavi.f
similarity index 100%
rename from ccx_2.9/src/rcavi.f
rename to ccx_2.10/src/rcavi.f
diff --git a/ccx_2.9/src/rcavi2.f b/ccx_2.10/src/rcavi2.f
similarity index 100%
rename from ccx_2.9/src/rcavi2.f
rename to ccx_2.10/src/rcavi2.f
diff --git a/ccx_2.9/src/rcavi_cp_lt.f b/ccx_2.10/src/rcavi_cp_lt.f
similarity index 100%
rename from ccx_2.9/src/rcavi_cp_lt.f
rename to ccx_2.10/src/rcavi_cp_lt.f
diff --git a/ccx_2.9/src/rcavi_cp_nt.f b/ccx_2.10/src/rcavi_cp_nt.f
similarity index 100%
rename from ccx_2.9/src/rcavi_cp_nt.f
rename to ccx_2.10/src/rcavi_cp_nt.f
diff --git a/ccx_2.9/src/readforce.f b/ccx_2.10/src/readforce.f
similarity index 100%
rename from ccx_2.9/src/readforce.f
rename to ccx_2.10/src/readforce.f
diff --git a/ccx_2.9/src/readfrd.c b/ccx_2.10/src/readfrd.c
similarity index 100%
rename from ccx_2.9/src/readfrd.c
rename to ccx_2.10/src/readfrd.c
diff --git a/ccx_2.9/src/readfrd.h b/ccx_2.10/src/readfrd.h
similarity index 100%
rename from ccx_2.9/src/readfrd.h
rename to ccx_2.10/src/readfrd.h
diff --git a/ccx_2.9/src/readinput.c b/ccx_2.10/src/readinput.c
similarity index 98%
rename from ccx_2.9/src/readinput.c
rename to ccx_2.10/src/readinput.c
index 57803b8..2e938ca 100644
--- a/ccx_2.9/src/readinput.c
+++ b/ccx_2.10/src/readinput.c
@@ -271,6 +271,10 @@ void readinput(char *jobnamec, char **inpcp, ITG *nline, ITG *nset,
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));
diff --git a/ccx_2.9/src/readview.f b/ccx_2.10/src/readview.f
similarity index 100%
rename from ccx_2.9/src/readview.f
rename to ccx_2.10/src/readview.f
diff --git a/ccx_2.9/src/rearrange.f b/ccx_2.10/src/rearrange.f
similarity index 100%
rename from ccx_2.9/src/rearrange.f
rename to ccx_2.10/src/rearrange.f
diff --git a/ccx_2.9/src/rectcyl.f b/ccx_2.10/src/rectcyl.f
similarity index 100%
rename from ccx_2.9/src/rectcyl.f
rename to ccx_2.10/src/rectcyl.f
diff --git a/ccx_2.9/src/rectcylexp.f b/ccx_2.10/src/rectcylexp.f
similarity index 100%
rename from ccx_2.9/src/rectcylexp.f
rename to ccx_2.10/src/rectcylexp.f
diff --git a/ccx_2.9/src/rectcyltrfm.f b/ccx_2.10/src/rectcyltrfm.f
similarity index 100%
rename from ccx_2.9/src/rectcyltrfm.f
rename to ccx_2.10/src/rectcyltrfm.f
diff --git a/ccx_2.9/src/rectcylvi.f b/ccx_2.10/src/rectcylvi.f
similarity index 100%
rename from ccx_2.9/src/rectcylvi.f
rename to ccx_2.10/src/rectcylvi.f
diff --git a/ccx_2.9/src/remastruct.c b/ccx_2.10/src/remastruct.c
similarity index 99%
rename from ccx_2.9/src/remastruct.c
rename to ccx_2.10/src/remastruct.c
index 90d0e95..fcbd361 100644
--- a/ccx_2.9/src/remastruct.c
+++ b/ccx_2.10/src/remastruct.c
@@ -69,7 +69,7 @@ void remastruct(ITG *ipompc, double **coefmpcp, ITG **nodempcp, ITG *nmpc,
if(nzs[1]<10) nzs[1]=10;
NNEW(mast1,ITG,nzs[1]);
NNEW(ipointer,ITG,mt**nk);
- RENEW(irow,ITG,nzs[1]);
+// RENEW(irow,ITG,nzs[1]);
mastruct(nk,kon,ipkon,lakon,ne,nodeboun,ndirboun,nboun,ipompc,
nodempc,nmpc,nactdof,icol,jq,&mast1,&irow,isolver,neq,
diff --git a/ccx_2.9/src/remastructar.c b/ccx_2.10/src/remastructar.c
similarity index 100%
rename from ccx_2.9/src/remastructar.c
rename to ccx_2.10/src/remastructar.c
diff --git a/ccx_2.9/src/remastructem.c b/ccx_2.10/src/remastructem.c
similarity index 100%
rename from ccx_2.9/src/remastructem.c
rename to ccx_2.10/src/remastructem.c
diff --git a/ccx_2.9/src/restartread.f b/ccx_2.10/src/restartread.f
similarity index 100%
rename from ccx_2.9/src/restartread.f
rename to ccx_2.10/src/restartread.f
diff --git a/ccx_2.9/src/restarts.f b/ccx_2.10/src/restarts.f
similarity index 100%
rename from ccx_2.9/src/restarts.f
rename to ccx_2.10/src/restarts.f
diff --git a/ccx_2.9/src/restartshort.f b/ccx_2.10/src/restartshort.f
similarity index 100%
rename from ccx_2.9/src/restartshort.f
rename to ccx_2.10/src/restartshort.f
diff --git a/ccx_2.9/src/restartwrite.f b/ccx_2.10/src/restartwrite.f
similarity index 99%
rename from ccx_2.9/src/restartwrite.f
rename to ccx_2.10/src/restartwrite.f
index 4ebbd4b..a9bd3b8 100644
--- a/ccx_2.9/src/restartwrite.f
+++ b/ccx_2.10/src/restartwrite.f
@@ -102,7 +102,7 @@
do i=1,80
version(i:i)=' '
enddo
- version='Version 2.9'
+ version(1:20)='Version 2.10'
write(15) version
!
write(15)istepnew
diff --git a/ccx_2.9/src/restrictor.f b/ccx_2.10/src/restrictor.f
similarity index 100%
rename from ccx_2.9/src/restrictor.f
rename to ccx_2.10/src/restrictor.f
diff --git a/ccx_2.9/src/resultnet.f b/ccx_2.10/src/resultnet.f
similarity index 98%
rename from ccx_2.9/src/resultnet.f
rename to ccx_2.10/src/resultnet.f
index a89da20..b52f7ad 100644
--- a/ccx_2.9/src/resultnet.f
+++ b/ccx_2.10/src/resultnet.f
@@ -38,7 +38,7 @@
integer mi(*),itg(*),ieg(*),ntg,nteq,nflow,nload,
& ielmat(mi(3),*),iflag,ider,iaxial,
& nelemload(2,*),nope,nopes,mint2d,i,j,k,l,nrhcon(*),
- & node,imat,ntmat_,id,ifaceq(9,6),ifacet(7,4),numf,
+ & node,imat,ntmat_,id,ifaceq(8,6),ifacet(6,4),numf,
& ifacew(8,5),node1,node2,nshcon(*),nelem,ig,index,konl(20),
& ipkon(*),kon(*),idof,ineighe(*),idir,
& iinc,istep,jltyp,nfield,ikforc(*),ipobody(2,*),
@@ -62,16 +62,16 @@
!
include "gauss.f"
!
- data ifaceq /4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/
- data ifacet /1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/
+ data ifaceq /4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/
+ data ifacet /1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/
data ifacew /1,3,2,9,8,7,0,0,
& 4,5,6,10,11,12,0,0,
& 1,2,5,4,7,14,10,13,
diff --git a/ccx_2.9/src/results.c b/ccx_2.10/src/results.c
similarity index 100%
rename from ccx_2.9/src/results.c
rename to ccx_2.10/src/results.c
diff --git a/ccx_2.9/src/results_se.c b/ccx_2.10/src/results_se.c
similarity index 70%
rename from ccx_2.9/src/results_se.c
rename to ccx_2.10/src/results_se.c
index f0cc8a7..ee5bdee 100644
--- a/ccx_2.9/src/results_se.c
+++ b/ccx_2.10/src/results_se.c
@@ -37,7 +37,8 @@ static double *co1,*v1,*stx1,*elcon1,*rhcon1,*alcon1,*alzero1,*orab1,*t01,*t11,
*ttime1,*plicon1,*plkcon1,*xstateini1,*xstiff1,*xstate1,*stiini1,
*vini1,*ener1,*eei1,*enerini1,*springarea1,*reltime1,*coefmpc1,
*cocon1,*qfx1,*thicke1,*emeini1,*shcon1,*xload1,*prop1,
- *xloadold1,*pslavsurf1,*pmastsurf1,*clearini1,*dfn1,*distmin1,*fn01;
+ *xloadold1,*pslavsurf1,*pmastsurf1,*clearini1,*dfn1,*distmin1,*fn01,
+ *sti1;
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,
@@ -71,7 +72,7 @@ void results_se(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,ITG *ne,
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,
- ITG *ndirdesi){
+ ITG *ndirdesi,double *sti){
ITG intpointvarm,calcul_fn,calcul_f,calcul_qa,calcul_cauchy,iener,ikin,
intpointvart,mt=mi[1]+1,i,j;
@@ -113,41 +114,41 @@ void results_se(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,ITG *ne,
envsys=getenv("NUMBER_OF_CPUS");
if(envsys){
- sys_cpus=atoi(envsys);
- if(sys_cpus<0) sys_cpus=0;
+ 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;
+ 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;
- }
-
+ 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;
- }
+ 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
@@ -170,8 +171,8 @@ void results_se(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,ITG *ne,
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));
+ FORTRAN(frditeration,(co,nk,kon,ipkon,lakon,ne,v,
+ ttime,ielmat,matname,mi,istep,iinc,ithermal));
}
/* calculating the stresses and material tangent at the
@@ -179,15 +180,15 @@ void results_se(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,ITG *ne,
if(((ithermal[0]<=1)||(ithermal[0]>=3))&&(intpointvarm==1)){
- NNEW(fn1,double,num_cpus*mt**nk);
- NNEW(fn0,double,num_cpus*mt**nk);
- NNEW(fn01,double,num_cpus*mt**nk);
- NNEW(dfn,double,num_cpus*mt**nk**ndesi);
- NNEW(dfn1,double,num_cpus*mt**nk**ndesi);
- NNEW(qa1,double,num_cpus*3);
- NNEW(nal,ITG,num_cpus);
+ NNEW(fn1,double,num_cpus*mt**nk);
+ NNEW(fn0,double,num_cpus*mt**nk);
+ NNEW(fn01,double,num_cpus*mt**nk);
+ NNEW(dfn,double,num_cpus*mt**nk**ndesi);
+ NNEW(dfn1,double,num_cpus*mt**nk**ndesi);
+ NNEW(qa1,double,num_cpus*3);
+ NNEW(nal,ITG,num_cpus);
- co1=co;kon1=kon;ipkon1=ipkon;lakon1=lakon;ne1=ne;v1=v;
+ 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;
@@ -204,76 +205,76 @@ void results_se(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,ITG *ne,
iener1=iener;ikin1=ikin;mt1=mt;nk1=nk;ne01=ne0;thicke1=thicke;
emeini1=emeini;pslavsurf1=pslavsurf;clearini1=clearini;
pmastsurf1=pmastsurf;mortar1=mortar;ielprop1=ielprop;prop1=prop;
- dfn1=dfn;distmin1=distmin;ndesi1=ndesi;nodedesi1=nodedesi;
- ndirdesi1=ndirdesi;fn01=fn0;
-
- /* 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_se, (void *)&ithread[i]);
- }
- for(i=0; i<num_cpus; i++) pthread_join(tid[i], NULL);
-
- /* Passing of fn */
- 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];
- }
- }
- /* Passing of dfn */
- for(i=0;i<mt**nk**ndesi;i++){
- dfn[i]=dfn1[i];
- }
- for(i=0;i<mt**nk**ndesi;i++){
- for(j=1;j<num_cpus;j++){
- dfn[i]+=dfn1[i+j*mt**nk**ndesi];
- }
- }
- SFREE(fn1);SFREE(ithread);
-
+ dfn1=dfn;distmin1=distmin;ndesi1=ndesi;nodedesi1=nodedesi;
+ ndirdesi1=ndirdesi;fn01=fn0;sti1=sti;
+
+ /* 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_se, (void *)&ithread[i]);
+ }
+ for(i=0; i<num_cpus; i++) pthread_join(tid[i], NULL);
+
+ /* Passing of fn */
+ 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];
+ }
+ }
+ /* Passing of dfn */
+ for(i=0;i<mt**nk**ndesi;i++){
+ dfn[i]=dfn1[i];
+ }
+ for(i=0;i<mt**nk**ndesi;i++){
+ for(j=1;j<num_cpus;j++){
+ dfn[i]+=dfn1[i+j*mt**nk**ndesi];
+ }
+ }
+ SFREE(fn1);SFREE(fn01);SFREE(dfn1);SFREE(ithread);
+
/* determine the internal force */
- qa[0]=qa1[0];
- for(j=1;j<num_cpus;j++){
- qa[0]+=qa1[j*3];
- }
+ qa[0]=qa1[0];
+ for(j=1;j<num_cpus;j++){
+ qa[0]+=qa1[j*3];
+ }
/* determine the decrease of the time increment in case
the material routine diverged */
for(j=0;j<num_cpus;j++){
- if(qa1[2+j*3]>0.){
- if(qa[2]<0.){
- qa[2]=qa1[2+j*3];
- }else{
- if(qa1[2+j*3]<qa[2]){qa[2]=qa1[2+j*3];}
- }
- }
- }
-
- 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);
+ if(qa1[2+j*3]>0.){
+ if(qa[2]<0.){
+ qa[2]=qa1[2+j*3];
+ }else{
+ if(qa1[2+j*3]<qa[2]){qa[2]=qa1[2+j*3];}
+ }
+ }
+ }
+
+ 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
@@ -281,15 +282,15 @@ void results_se(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,ITG *ne,
if((ithermal[0]>=2)&&(intpointvart==1)){
- NNEW(fn1,double,num_cpus*mt**nk);
- NNEW(fn01,double,num_cpus*mt**nk);
- NNEW(dfn,double,num_cpus*mt**nk**ndesi);
- NNEW(qa1,double,num_cpus*3);
- NNEW(nal,ITG,num_cpus);
+ NNEW(fn1,double,num_cpus*mt**nk);
+ NNEW(fn01,double,num_cpus*mt**nk);
+ NNEW(dfn,double,num_cpus*mt**nk**ndesi);
+ NNEW(qa1,double,num_cpus*3);
+ NNEW(nal,ITG,num_cpus);
- co1=co;kon1=kon;ipkon1=ipkon;lakon1=lakon;v1=v;
+ 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;
+ 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;
@@ -303,59 +304,57 @@ void results_se(double *co,ITG *nk,ITG *kon,ITG *ipkon,char *lakon,ITG *ne,
sideload1=sideload;xload1=xload;xloadold1=xloadold;
pslavsurf1=pslavsurf;pmastsurf1=pmastsurf;mortar1=mortar;
clearini1=clearini;plicon1=plicon;nplicon1=nplicon;ne1=ne;
- ielprop1=ielprop,prop1=prop;dfn1=dfn;distmin1=distmin;
- ndesi1=ndesi;nodedesi1=nodedesi;ndirdesi1=ndirdesi;fn01=fn0;
-
- /* 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_se, (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(fn01);SFREE(ithread);
-
+ ielprop1=ielprop,prop1=prop;distmin1=distmin;ndesi1=ndesi;
+ nodedesi1=nodedesi;ndirdesi1=ndirdesi;fn01=fn0;sti1=sti;
+
+ /* 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_se, (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(fn01);SFREE(ithread);
+
/* determine the internal concentrated heat flux */
- qa[1]=qa1[1];
- for(j=1;j<num_cpus;j++){
- qa[1]+=qa1[1+j*3];
- }
-
- 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);
+ qa[1]=qa1[1];
+ for(j=1;j<num_cpus;j++){
+ qa[1]+=qa1[1+j*3];
+ }
+
+ 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_se,(nk,f,dfn,nactdof,ipompc,nodempc,
- coefmpc,labmpc,nmpc,mi,fmpc,&calcul_fn,&calcul_f,ndesi,df));
-
- /* SFREE(dfn);SFREE(dfn1); */
+ coefmpc,labmpc,nmpc,mi,fmpc,&calcul_fn,&calcul_f,ndesi,df));
/* storing results in the .dat file
extrapolation of integration point values to the nodes
@@ -403,9 +402,9 @@ void *resultsmechmt_se(ITG *i){
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,&iener1,
- &ikin1,&nal[indexnal],ne01,thicke1,emeini1,
- pslavsurf1,pmastsurf1,mortar1,clearini1,&nea,&neb,ielprop1,prop1,
- dfn1,distmin1,ndesi1,nodedesi1,ndirdesi1,&fn01[indexfn]));
+ &ikin1,&nal[indexnal],ne01,thicke1,emeini1,
+ pslavsurf1,pmastsurf1,mortar1,clearini1,&nea,&neb,ielprop1,prop1,
+ dfn1,distmin1,ndesi1,nodedesi1,ndirdesi1,&fn01[indexfn],sti1));
return NULL;
}
@@ -426,15 +425,15 @@ void *resultsthermmt_se(ITG *i){
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,
+ 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,
+ &calcul_fn1,&calcul_qa1,&nal[indexnal],&nea,&neb,ithermal1,
+ nelemload1,nload1,nmethod1,reltime1,sideload1,xload1,xloadold1,
+ pslavsurf1,pmastsurf1,mortar1,clearini1,plicon1,nplicon1,ielprop1,
prop1));
return NULL;
diff --git a/ccx_2.9/src/resultsem.f b/ccx_2.10/src/resultsem.f
similarity index 97%
rename from ccx_2.9/src/resultsem.f
rename to ccx_2.10/src/resultsem.f
index 2a59361..c9c6737 100644
--- a/ccx_2.9/src/resultsem.f
+++ b/ccx_2.10/src/resultsem.f
@@ -32,7 +32,7 @@
& ntmat_,ipkon(*),null,three,iflag,mt,i,j,k,m1,kk,i1,m3,indexe,
& nope,imat,mint3d,ncmat_,nea,neb,nalcon(2,*),mm,l,istart,iset,
& isurf,ilength,istartset(*),iendset(*),ialset(*),nopes,m,
- & m2,ig,id,iactive(3),konl2(9),ifaceq(9,6),ifacet(7,4),iel,
+ & m2,ig,id,iactive(3),konl2(9),ifaceq(8,6),ifacet(6,4),iel,
& ifacew(8,5),mint2d,nfaces,one
!
real*8 co(3,*),v(0:mi(2),*),shp(4,26),xl(3,26),vl(0:mi(2),26),
@@ -45,16 +45,16 @@
!
include "gauss.f"
!
- data ifaceq /4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/
- data ifacet /1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/
+ data ifaceq /4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/
+ data ifacet /1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/
data ifacew /1,3,2,9,8,7,0,0,
& 4,5,6,10,11,12,0,0,
& 1,2,5,4,7,14,10,13,
diff --git a/ccx_2.9/src/resultsforc.f b/ccx_2.10/src/resultsforc.f
similarity index 100%
rename from ccx_2.9/src/resultsforc.f
rename to ccx_2.10/src/resultsforc.f
diff --git a/ccx_2.9/src/resultsforc_em.f b/ccx_2.10/src/resultsforc_em.f
similarity index 100%
rename from ccx_2.9/src/resultsforc_em.f
rename to ccx_2.10/src/resultsforc_em.f
diff --git a/ccx_2.9/src/resultsforc_se.f b/ccx_2.10/src/resultsforc_se.f
similarity index 100%
rename from ccx_2.9/src/resultsforc_se.f
rename to ccx_2.10/src/resultsforc_se.f
diff --git a/ccx_2.9/src/resultsinduction.c b/ccx_2.10/src/resultsinduction.c
similarity index 100%
rename from ccx_2.9/src/resultsinduction.c
rename to ccx_2.10/src/resultsinduction.c
diff --git a/ccx_2.9/src/resultsini.f b/ccx_2.10/src/resultsini.f
similarity index 100%
rename from ccx_2.9/src/resultsini.f
rename to ccx_2.10/src/resultsini.f
diff --git a/ccx_2.9/src/resultsini_em.f b/ccx_2.10/src/resultsini_em.f
similarity index 100%
rename from ccx_2.9/src/resultsini_em.f
rename to ccx_2.10/src/resultsini_em.f
diff --git a/ccx_2.9/src/resultsmech.f b/ccx_2.10/src/resultsmech.f
similarity index 97%
rename from ccx_2.9/src/resultsmech.f
rename to ccx_2.10/src/resultsmech.f
index f61cc61..52f8575 100644
--- a/ccx_2.9/src/resultsmech.f
+++ b/ccx_2.10/src/resultsmech.f
@@ -151,14 +151,10 @@ c Bernhardi start
elseif(lakonl(4:5).eq.'20') then
c Bernhardi end
nope=20
- elseif(lakonl(4:4).eq.'2') then
- nope=26
elseif(lakonl(4:4).eq.'8') then
nope=8
elseif(lakonl(4:5).eq.'10') then
nope=10
- elseif(lakonl(4:5).eq.'14') then
- nope=14
elseif(lakonl(4:4).eq.'4') then
nope=4
elseif(lakonl(4:5).eq.'15') then
@@ -205,7 +201,7 @@ c Bernhardi end
call beamintscheme(lakonl,mint3d,ielprop(i),prop,
& null,xi,et,ze,weight)
endif
- elseif((lakonl(4:4).eq.'8').or.(lakonl(4:6).eq.'26R').or.
+ elseif((lakonl(4:4).eq.'8').or.
& (lakonl(4:6).eq.'20R')) then
if(lakonl(7:8).eq.'LC') then
mint3d=8*nlayer
@@ -214,7 +210,7 @@ c Bernhardi end
endif
elseif(lakonl(4:4).eq.'2') then
mint3d=27
- elseif((lakonl(4:5).eq.'10').or.(lakonl(4:5).eq.'14')) then
+ elseif(lakonl(4:5).eq.'10') then
mint3d=4
elseif(lakonl(4:4).eq.'4') then
mint3d=1
@@ -350,7 +346,7 @@ c enddo
& jj,xi,et,ze,weight)
endif
elseif((lakonl(4:4).eq.'8').or.
- & (lakonl(4:6).eq.'20R').or.(lakonl(4:6).eq.'26R'))
+ & (lakonl(4:6).eq.'20R'))
& then
if(lakonl(7:8).ne.'LC') then
xi=gauss3d2(1,jj)
@@ -402,7 +398,7 @@ c enddo
et=gauss3d3(2,jj)
ze=gauss3d3(3,jj)
weight=weight3d3(jj)
- elseif((lakonl(4:5).eq.'10').or.(lakonl(4:5).eq.'14')) then
+ elseif(lakonl(4:5).eq.'10') then
xi=gauss3d5(1,jj)
et=gauss3d5(2,jj)
ze=gauss3d5(3,jj)
@@ -439,14 +435,10 @@ c Bernhardi end
else
call shape20h(xi,et,ze,xl,xsj,shp,iflag)
endif
- elseif(nope.eq.26) then
- call shape26h(xi,et,ze,xl,xsj,shp,iflag,konl)
elseif(nope.eq.8) then
call shape8h(xi,et,ze,xl,xsj,shp,iflag)
elseif(nope.eq.10) then
call shape10tet(xi,et,ze,xl,xsj,shp,iflag)
- elseif(nope.eq.14) then
- call shape14tet(xi,et,ze,xl,xsj,shp,iflag,konl)
elseif(nope.eq.4) then
call shape4tet(xi,et,ze,xl,xsj,shp,iflag)
elseif(nope.eq.15) then
@@ -722,8 +714,7 @@ c Bernhardi end
t0l=t0l+t0(konl(i1))/8.d0
t1l=t1l+t1(konl(i1))/8.d0
enddo
- elseif((lakonl(4:6).eq.'20 ').or.
- & (lakonl(4:6).eq.'26 ')) then
+ elseif(lakonl(4:6).eq.'20 ') then
nopered=20
call lintemp(t0,t1,konl,nopered,jj,t0l,t1l)
else
@@ -739,8 +730,7 @@ c Bernhardi end
t0l=t0l+t0(konl(i1))/8.d0
t1l=t1l+vold(0,konl(i1))/8.d0
enddo
- elseif((lakonl(4:6).eq.'20 ').or.
- & (lakonl(4:6).eq.'26 ')) then
+ elseif(lakonl(4:6).eq.'20 ') then
nopered=20
call lintemp_th(t0,vold,konl,nopered,jj,t0l,t1l,mi)
else
@@ -909,6 +899,13 @@ c emec0(m1)=emeini(m1,jj,i)
& (eloc(4)-eth(4)-emeini(4,jj,i))*(stre(4)+stiini(4,jj,i))+
& (eloc(5)-eth(5)-emeini(5,jj,i))*(stre(5)+stiini(5,jj,i))+
& (eloc(6)-eth(6)-emeini(6,jj,i))*(stre(6)+stiini(6,jj,i))
+c write(*,*) 'resultsmech ',jj,i,enerini(jj,i)
+c write(*,*) (eloc(k),k=1,6)
+c write(*,*) (eth(k),k=1,6)
+c write(*,*) (emeini(k,jj,i),k=1,6)
+c write(*,*) (stre(k),k=1,6)
+c write(*,*) (stiini(k,jj,i),k=1,6)
+c write(*,*) 'resultsmech2 ',jj,i,ener(jj,i)
c ener(jj,i)=enerini(jj,i)+
c & ((eloc(1)-eth(1)-eme(1,jj,i))*
c & (stre(1)+stiini(1,jj,i))+
diff --git a/ccx_2.9/src/resultsmech_se.f b/ccx_2.10/src/resultsmech_se.f
similarity index 97%
rename from ccx_2.9/src/resultsmech_se.f
rename to ccx_2.10/src/resultsmech_se.f
index 4e777be..d512f5a 100644
--- a/ccx_2.9/src/resultsmech_se.f
+++ b/ccx_2.10/src/resultsmech_se.f
@@ -26,7 +26,7 @@
& springarea,reltime,calcul_fn,calcul_qa,calcul_cauchy,iener,
& ikin,nal,ne0,thicke,emeini,pslavsurf,
& pmastsurf,mortar,clearini,nea,neb,ielprop,prop,dfn,distmin,
- & ndesi,nodedesi,ndirdesi,fn0)
+ & ndesi,nodedesi,ndirdesi,fn0,sti)
!
! calculates stresses and the material tangent at the integration
! points and the internal forces at the nodes
@@ -67,7 +67,7 @@
& vokl(3,3),xstateini(nstate_,mi(1),*),vikl(3,3),
& gs(8,4),a,reltime,tlayer(4),dlayer(4),xlayer(mi(3),4),
& thicke(mi(3),*),emeini(6,mi(1),*),clearini(3,9,*),
- & pslavsurf(3,*),pmastsurf(6,*),distmin,
+ & pslavsurf(3,*),pmastsurf(6,*),distmin,sti(6,mi(1),*),
& fn0(0:mi(2),*),dfn(ndesi,0:mi(2),*)
!
include "gauss.f"
@@ -163,14 +163,10 @@ c Bernhardi start
elseif(lakonl(4:5).eq.'20') then
c Bernhardi end
nope=20
- elseif(lakonl(4:4).eq.'2') then
- nope=26
elseif(lakonl(4:4).eq.'8') then
nope=8
elseif(lakonl(4:5).eq.'10') then
nope=10
- elseif(lakonl(4:5).eq.'14') then
- nope=14
elseif(lakonl(4:4).eq.'4') then
nope=4
elseif(lakonl(4:5).eq.'15') then
@@ -217,7 +213,7 @@ c Bernhardi end
call beamintscheme(lakonl,mint3d,ielprop(i),prop,
& null,xi,et,ze,weight)
endif
- elseif((lakonl(4:4).eq.'8').or.(lakonl(4:6).eq.'26R').or.
+ elseif((lakonl(4:4).eq.'8').or.
& (lakonl(4:6).eq.'20R')) then
if(lakonl(7:8).eq.'LC') then
mint3d=8*nlayer
@@ -226,7 +222,7 @@ c Bernhardi end
endif
elseif(lakonl(4:4).eq.'2') then
mint3d=27
- elseif((lakonl(4:5).eq.'10').or.(lakonl(4:5).eq.'14')) then
+ elseif(lakonl(4:5).eq.'10') then
mint3d=4
elseif(lakonl(4:4).eq.'4') then
mint3d=1
@@ -375,7 +371,7 @@ c enddo
& jj,xi,et,ze,weight)
endif
elseif((lakonl(4:4).eq.'8').or.
- & (lakonl(4:6).eq.'20R').or.(lakonl(4:6).eq.'26R'))
+ & (lakonl(4:6).eq.'20R'))
& then
if(lakonl(7:8).ne.'LC') then
xi=gauss3d2(1,jj)
@@ -427,7 +423,7 @@ c enddo
et=gauss3d3(2,jj)
ze=gauss3d3(3,jj)
weight=weight3d3(jj)
- elseif((lakonl(4:5).eq.'10').or.(lakonl(4:5).eq.'14')) then
+ elseif(lakonl(4:5).eq.'10') then
xi=gauss3d5(1,jj)
et=gauss3d5(2,jj)
ze=gauss3d5(3,jj)
@@ -464,14 +460,10 @@ c Bernhardi end
else
call shape20h(xi,et,ze,xl,xsj,shp,iflag)
endif
- elseif(nope.eq.26) then
- call shape26h(xi,et,ze,xl,xsj,shp,iflag,konl)
elseif(nope.eq.8) then
call shape8h(xi,et,ze,xl,xsj,shp,iflag)
elseif(nope.eq.10) then
call shape10tet(xi,et,ze,xl,xsj,shp,iflag)
- elseif(nope.eq.14) then
- call shape14tet(xi,et,ze,xl,xsj,shp,iflag,konl)
elseif(nope.eq.4) then
call shape4tet(xi,et,ze,xl,xsj,shp,iflag)
elseif(nope.eq.15) then
@@ -716,7 +708,7 @@ c Bernhardi end
! stresses at the start of the increment
!
do m1=1,6
- stre(m1)=stiini(m1,jj,i)
+ stre(m1)=sti(m1,jj,i)
enddo
!
endif
@@ -747,8 +739,7 @@ c Bernhardi end
t0l=t0l+t0(konl(i1))/8.d0
t1l=t1l+t1(konl(i1))/8.d0
enddo
- elseif((lakonl(4:6).eq.'20 ').or.
- & (lakonl(4:6).eq.'26 ')) then
+ elseif(lakonl(4:6).eq.'20 ') then
nopered=20
call lintemp(t0,t1,konl,nopered,jj,t0l,t1l)
else
@@ -764,8 +755,7 @@ c Bernhardi end
t0l=t0l+t0(konl(i1))/8.d0
t1l=t1l+vold(0,konl(i1))/8.d0
enddo
- elseif((lakonl(4:6).eq.'20 ').or.
- & (lakonl(4:6).eq.'26 ')) then
+ elseif(lakonl(4:6).eq.'20 ') then
nopered=20
call lintemp_th(t0,vold,konl,nopered,jj,t0l,t1l,mi)
else
diff --git a/ccx_2.9/src/resultsprint.f b/ccx_2.10/src/resultsprint.f
similarity index 99%
rename from ccx_2.9/src/resultsprint.f
rename to ccx_2.10/src/resultsprint.f
index a8ba37c..934c9fa 100644
--- a/ccx_2.9/src/resultsprint.f
+++ b/ccx_2.10/src/resultsprint.f
@@ -92,7 +92,7 @@
if((nmethod.eq.4).and.(iperturb(1).gt.1).and.
& (ithermal(1).le.1).and.(mi(2).ne.5)) then
call calcenergy(ipkon,lakon,kon,co,ener,mi,ne,thicke,
- & ielmat,energyini,energy)
+ & ielmat,energyini,energy,ielprop,prop)
endif
!
return
diff --git a/ccx_2.9/src/resultstherm.f b/ccx_2.10/src/resultstherm.f
similarity index 95%
rename from ccx_2.9/src/resultstherm.f
rename to ccx_2.10/src/resultstherm.f
index 18b20c8..359743e 100644
--- a/ccx_2.9/src/resultstherm.f
+++ b/ccx_2.10/src/resultstherm.f
@@ -91,14 +91,10 @@
indexe=ipkon(i)
if(lakon(i)(4:5).eq.'20') then
nope=20
- elseif(lakon(i)(4:4).eq.'2') then
- nope=26
elseif(lakon(i)(4:4).eq.'8') then
nope=8
elseif(lakon(i)(4:5).eq.'10') then
nope=10
- elseif(lakon(i)(4:5).eq.'14') then
- nope=14
elseif(lakon(i)(4:4).eq.'4') then
nope=4
elseif(lakon(i)(4:5).eq.'15') then
@@ -157,8 +153,7 @@ c if(lakon(i)(7:7).eq.'C') konl(nope+1)=kon(indexe+nope+1)
& null,xi,et,ze,weight)
endif
elseif((lakon(i)(4:4).eq.'8').or.
- & (lakon(i)(4:6).eq.'20R').or.
- & (lakon(i)(4:6).eq.'26R')) then
+ & (lakon(i)(4:6).eq.'20R')) then
if(lakon(i)(6:7).eq.'RA') then
mint3d=4
else
@@ -166,7 +161,7 @@ c if(lakon(i)(7:7).eq.'C') konl(nope+1)=kon(indexe+nope+1)
endif
elseif(lakon(i)(4:4).eq.'2') then
mint3d=27
- elseif((lakon(i)(4:5).eq.'10').or.(lakon(i)(5:5).eq.'14')) then
+ elseif(lakon(i)(4:5).eq.'10') then
mint3d=4
elseif(lakon(i)(4:4).eq.'4') then
mint3d=1
@@ -279,7 +274,7 @@ c if(lakon(i)(7:7).eq.'C') konl(nope+1)=kon(indexe+nope+1)
& prop,kk,xi,et,ze,weight)
endif
elseif((lakon(i)(4:4).eq.'8').or.
- & (lakon(i)(4:6).eq.'20R').or.(lakon(i)(4:6).eq.'26R'))
+ & (lakon(i)(4:6).eq.'20R'))
& then
xi=gauss3d2(1,kk)
et=gauss3d2(2,kk)
@@ -290,8 +285,7 @@ c if(lakon(i)(7:7).eq.'C') konl(nope+1)=kon(indexe+nope+1)
et=gauss3d3(2,kk)
ze=gauss3d3(3,kk)
weight=weight3d3(kk)
- elseif((lakon(i)(4:5).eq.'10').or.
- & (lakon(i)(4:5).eq.'14')) then
+ elseif(lakon(i)(4:5).eq.'10') then
xi=gauss3d5(1,kk)
et=gauss3d5(2,kk)
ze=gauss3d5(3,kk)
@@ -322,14 +316,10 @@ c if(lakon(i)(7:7).eq.'C') konl(nope+1)=kon(indexe+nope+1)
else
call shape20h(xi,et,ze,xl,xsj,shp,iflag)
endif
- elseif(nope.eq.26) then
- call shape26h(xi,et,ze,xl,xsj,shp,iflag,konl)
elseif(nope.eq.8) then
call shape8h(xi,et,ze,xl,xsj,shp,iflag)
elseif(nope.eq.10) then
call shape10tet(xi,et,ze,xl,xsj,shp,iflag)
- elseif(nope.eq.14) then
- call shape14tet(xi,et,ze,xl,xsj,shp,iflag,konl)
elseif(nope.eq.4) then
call shape4tet(xi,et,ze,xl,xsj,shp,iflag)
elseif(nope.eq.15) then
@@ -366,8 +356,7 @@ c if(lakon(i)(7:7).eq.'C') konl(nope+1)=kon(indexe+nope+1)
t1lold=t1lold+vold(0,konl(i1))/8.d0
t1l=t1l+v(0,konl(i1))/8.d0
enddo
- elseif((lakon(i)(4:6).eq.'20 ').or.
- & (lakon(i)(4:6).eq.'26 ')) then
+ elseif(lakon(i)(4:6).eq.'20 ') then
nopered=20
call lintemp_th(t0,vold,konl,nopered,kk,t0l,t1lold,mi)
call lintemp_th(t0,v,konl,nopered,kk,t0l,t1l,mi)
diff --git a/ccx_2.9/src/retainednodaldofss.f b/ccx_2.10/src/retainednodaldofss.f
similarity index 100%
rename from ccx_2.9/src/retainednodaldofss.f
rename to ccx_2.10/src/retainednodaldofss.f
diff --git a/ccx_2.9/src/rhs.f b/ccx_2.10/src/rhs.f
similarity index 100%
rename from ccx_2.9/src/rhs.f
rename to ccx_2.10/src/rhs.f
diff --git a/ccx_2.9/src/rhsp.f b/ccx_2.10/src/rhsp.f
similarity index 79%
rename from ccx_2.9/src/rhsp.f
rename to ccx_2.10/src/rhsp.f
index c3f82b6..a792175 100644
--- a/ccx_2.9/src/rhsp.f
+++ b/ccx_2.10/src/rhsp.f
@@ -16,34 +16,34 @@
! along with this program; if not, write to the Free Software
! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
!
- subroutine rhsp(nef,lakon,nactdoh,ipnei,neifa,neiel,vfa,area,
+ subroutine rhsp(nef,lakonf,ipnei,neifa,neiel,vfa,area,
& advfa,xlet,cosa,volume,au,ad,jq,irow,ap,ielfa,ifabou,xle,
- & b,xxn,compressible,neq,nzs,hfa,bp,neij,xxi,gradpel,xlen)
+ & b,xxn,neq,nzs,hfa,gradpel,bp,xxi,neij,xlen,nefa,nefb)
!
! filling the lhs and rhs to calculate the first correction to the
! pressure p'
!
implicit none
!
- character*8 lakon(*)
+ character*8 lakonf(*)
!
- integer i,nef,jdof1,nactdoh(*),indexf,ipnei(*),j,neifa(*),
- & neiel(*),iel,ifa,jdof2,irow(*),ielfa(4,*),compressible,
+ integer i,nef,jdof1,indexf,ipnei(*),j,neifa(*),
+ & neiel(*),iel,ifa,jdof2,irow(*),ielfa(4,*),nefa,nefb,
& ifabou(*),neq,nzs,jq(*),iel2,indexb,knownflux,numfaces,
& iatleastonepressurebc,j2,indexf2,neij(*)
!
real*8 coef,vfa(0:5,*),volume(*),area(*),advfa(*),xlet(*),
& cosa(*),ad(*),au(*),xle(*),xxn(3,*),ap(*),b(*),bp(*),
- & hfa(3,*),xxi(3,*),gradpel(3,*),xlen(*)
+ & hfa(3,*),xxi(3,*),gradpel(3,*),xlen(*),bp_ifa
!
- iatleastonepressurebc=0
+c iatleastonepressurebc=0
!
- do i=1,nef
+ do i=nefa,nefb
jdof1=i
indexf=ipnei(i)
- if(lakon(i)(4:4).eq.'8') then
+ if(lakonf(i)(4:4).eq.'8') then
numfaces=6
- elseif(lakon(i)(4:4).eq.'6') then
+ elseif(lakonf(i)(4:4).eq.'6') then
numfaces=5
else
numfaces=4
@@ -64,7 +64,7 @@
!
j2=neij(indexf)
indexf2=ipnei(iel)+j2
- bp(ifa)=((gradpel(1,iel)*(xxi(1,indexf2)
+ bp_ifa=((gradpel(1,iel)*(xxi(1,indexf2)
& -cosa(indexf2)*xxn(1,indexf2))+
& gradpel(2,iel)*(xxi(2,indexf2)
& -cosa(indexf2)*xxn(2,indexf2))+
@@ -78,8 +78,8 @@
& gradpel(3,i)*(xxi(3,indexf)
& -cosa(indexf)*xxn(3,indexf)))
& *xle(indexf))
- b(jdof1)=b(jdof1)-ap(ifa)*bp(ifa)
- if(i.gt.iel) bp(ifa)=-bp(ifa)
+ b(jdof1)=b(jdof1)-ap(ifa)*bp_ifa
+c if(i.gt.iel) bp_ifa=-bp_ifa
else
!
! external face
@@ -99,14 +99,14 @@
!
knownflux=2
elseif(ifabou(-iel2+4).gt.0) then
- iatleastonepressurebc=1
+c iatleastonepressurebc=1
!
! pressure given
!
!
! correction for non-orthogonal meshes
!
- bp(ifa)=(-(gradpel(1,i)*(xxi(1,indexf)
+ bp_ifa=(-(gradpel(1,i)*(xxi(1,indexf)
& -cosa(indexf)*xxn(1,indexf))+
& gradpel(2,i)*(xxi(2,indexf)
& -cosa(indexf)*xxn(2,indexf))+
@@ -115,10 +115,16 @@
& *xle(indexf))
!
b(jdof1)=b(jdof1)-ap(ifa)*
- & (vfa(4,ifa)+bp(ifa))
+ & (vfa(4,ifa)+bp_ifa)
endif
endif
endif
+!
+! save coefficients for correctvfa.f
+!
+ if((iel.eq.0).or.(i.lt.iel)) then
+ bp(ifa)=bp_ifa
+ endif
!
if(knownflux.eq.1) then
b(jdof1)=b(jdof1)+vfa(5,ifa)*area(ifa)*
@@ -130,11 +136,6 @@
& (hfa(1,ifa)*xxn(1,indexf)+
& hfa(2,ifa)*xxn(2,indexf)+
& hfa(3,ifa)*xxn(3,indexf))
-c write(*,*) 'rhsp ',i,j,+vfa(5,ifa)*area(ifa)*
-c & (hfa(1,ifa)*xxn(1,indexf)+
-c & hfa(2,ifa)*xxn(2,indexf)+
-c & hfa(3,ifa)*xxn(3,indexf)),
-c & hfa(1,ifa),hfa(2,ifa),hfa(3,ifa)
endif
enddo
enddo
@@ -145,7 +146,7 @@ c & hfa(1,ifa),hfa(2,ifa),hfa(3,ifa)
! a pressure bc is only recognized if not all velocity degrees of
! freedom are prescribed on the same face
!
- if(iatleastonepressurebc.eq.0) b(nef)=0.d0
+c if(iatleastonepressurebc.eq.0) b(nef)=0.d0
!
return
end
diff --git a/ccx_2.10/src/rhspmain.c b/ccx_2.10/src/rhspmain.c
new file mode 100644
index 0000000..ff69d44
--- /dev/null
+++ b/ccx_2.10/src/rhspmain.c
@@ -0,0 +1,198 @@
+/* CalculiX - A 3-dimensional finite element program */
+/* Copyright (C) 1998-2015 Guido Dhondt */
+
+/* This program is free software; you can redistribute it and/or */
+/* modify it under the terms of the GNU General Public License as */
+/* published by the Free Software Foundation(version 2); */
+/* */
+
+/* This program is distributed in the hope that it will be useful, */
+/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
+/* GNU General Public License for more details. */
+
+/* You should have received a copy of the GNU General Public License */
+/* along with this program; if not, write to the Free Software */
+/* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+#include <unistd.h>
+#include <stdio.h>
+#include <math.h>
+#include <stdlib.h>
+#include <pthread.h>
+#include "CalculiX.h"
+
+static char *lakonf1;
+
+static ITG num_cpus,*nef1,*ipnei1,*neifa1,*neiel1,*jq1,*irow1,*ielfa1,
+ *ifabou1,*neq1,*nzs1,*neij1;
+
+static double *vfa1,*area1,*advfa1,*xlet1,*cosa1,*volume1,*au1=NULL,*ad1=NULL,
+ *ap1,*xle1,*b1=NULL,*xxn1,*hfa1,*gradpel1,*bp1,*xxi1,*xlen1,*cosb1;
+
+void rhspmain(ITG *nef,char *lakonf,ITG *ipnei,
+ ITG *neifa,ITG *neiel,double *vfa,double *area,double *advfa,
+ 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){
+
+ 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];
+
+ /* allocating fields for lhs and rhs matrix */
+
+ NNEW(ad1,double,num_cpus**neq);
+ NNEW(au1,double,(long long)num_cpus**nzs);
+ NNEW(b1,double,num_cpus**neq);
+
+ /* 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;
+
+ /* 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);
+
+ /* copying and accumulating the stiffnes and/or mass matrix */
+
+#pragma omp parallel \
+ default(none) \
+ shared(neq,ad,ad1,num_cpus,nzs,au,au1,b,b1) \
+ private(i,j)
+ {
+ #pragma omp for
+ for(i=0;i<*neq;i++){
+ ad[i]=ad1[i];
+ for(j=1;j<num_cpus;j++){
+ ad[i]+=ad1[i+j**neq];
+ }
+ }
+
+ #pragma omp for
+ for(i=0;i<*nzs;i++){
+ au[i]=au1[i];
+ for(j=1;j<num_cpus;j++){
+ au[i]+=au1[i+(long long)j**nzs];
+ }
+ }
+
+ #pragma omp for
+ for(i=0;i<*neq;i++){
+ b[i]=b1[i];
+ for(j=1;j<num_cpus;j++){
+ b[i]+=b1[i+j**neq];
+ }
+ }
+ }
+
+ SFREE(ad1);
+ SFREE(au1);
+ SFREE(b1);
+
+/* 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;
+
+}
+
+/* subroutine for multithreading of rhsp */
+
+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[indexau],&ad1[indexad],
+ jq1,irow1,ap1,ielfa1,ifabou1,xle1,&b1[indexb],xxn1,neq1,nzs1,
+ hfa1,gradpel1,bp1,xxi1,neij1,xlen1,&nefa,&nefb));
+
+ return NULL;
+}
diff --git a/ccx_2.9/src/rigidbodys.f b/ccx_2.10/src/rigidbodys.f
similarity index 100%
rename from ccx_2.9/src/rigidbodys.f
rename to ccx_2.10/src/rigidbodys.f
diff --git a/ccx_2.9/src/rigidmpc.f b/ccx_2.10/src/rigidmpc.f
similarity index 100%
rename from ccx_2.9/src/rigidmpc.f
rename to ccx_2.10/src/rigidmpc.f
diff --git a/ccx_2.9/src/rimseal.f b/ccx_2.10/src/rimseal.f
similarity index 100%
rename from ccx_2.9/src/rimseal.f
rename to ccx_2.10/src/rimseal.f
diff --git a/ccx_2.9/src/rimseal_calc.f b/ccx_2.10/src/rimseal_calc.f
similarity index 100%
rename from ccx_2.9/src/rimseal_calc.f
rename to ccx_2.10/src/rimseal_calc.f
diff --git a/ccx_2.9/src/rs.f b/ccx_2.10/src/rs.f
similarity index 100%
rename from ccx_2.9/src/rs.f
rename to ccx_2.10/src/rs.f
diff --git a/ccx_2.9/src/rubber.f b/ccx_2.10/src/rubber.f
similarity index 100%
rename from ccx_2.9/src/rubber.f
rename to ccx_2.10/src/rubber.f
diff --git a/ccx_2.9/src/scavenge_pump.f b/ccx_2.10/src/scavenge_pump.f
similarity index 100%
rename from ccx_2.9/src/scavenge_pump.f
rename to ccx_2.10/src/scavenge_pump.f
diff --git a/ccx_2.9/src/sdvini.f b/ccx_2.10/src/sdvini.f
similarity index 100%
rename from ccx_2.9/src/sdvini.f
rename to ccx_2.10/src/sdvini.f
diff --git a/ccx_2.9/src/selectcyclicsymmetrymodess.f b/ccx_2.10/src/selectcyclicsymmetrymodess.f
similarity index 100%
rename from ccx_2.9/src/selectcyclicsymmetrymodess.f
rename to ccx_2.10/src/selectcyclicsymmetrymodess.f
diff --git a/ccx_2.10/src/sensitivity.c b/ccx_2.10/src/sensitivity.c
new file mode 100644
index 0000000..af22a8b
--- /dev/null
+++ b/ccx_2.10/src/sensitivity.c
@@ -0,0 +1,334 @@
+/* CalculiX - A 3-dimensional finite element program */
+/* Copyright (C) 1998-2015 Guido Dhondt */
+
+/* This program is free software; you can redistribute it and/or */
+/* modify it under the terms of the GNU General Public License as */
+/* published by the Free Software Foundation(version 2); */
+/* */
+
+/* This program is distributed in the hope that it will be useful, */
+/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
+/* GNU General Public License for more details. */
+
+/* You should have received a copy of the GNU General Public License */
+/* along with this program; if not, write to the Free Software */
+/* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+#include <stdio.h>
+#include <math.h>
+#include <stdlib.h>
+#include "CalculiX.h"
+#ifdef SPOOLES
+ #include "spooles.h"
+#endif
+#ifdef SGI
+ #include "sgi.h"
+#endif
+#ifdef TAUCS
+ #include "tau.h"
+#endif
+#ifdef PARDISO
+ #include "pardiso.h"
+#endif
+
+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 **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 *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, 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 *objectset,ITG *istat){
+
+ char description[13]=" ",*lakon=NULL,stiffmatrix[132]="";
+
+ ITG *inum=NULL,k,*icol=NULL,*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;
+
+ double *stn=NULL,*v=NULL,*een=NULL,cam[5],*xstiff=NULL,*stiini=NULL,*tper,
+ *f=NULL,*fn=NULL,qa[3],*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,*cgr=NULL,*xbodyact=NULL,*springarea=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,*xstate=NULL,*fnext=NULL,*energyini=NULL,
+ *energy=NULL,*ener=NULL;
+
+ /* variables introduced for sensitivity calculation */
+
+ ITG ndesi,numobject,*ndirdesi=NULL,*nodedesi=NULL;
+
+ double distmin,*dfextminds=NULL,*df=NULL,*g0=NULL,*dgdx=NULL,*dgdv=NULL,
+ *dgdxtot=NULL,*dgdxtotglob=NULL;
+
+
+ FILE *f1;
+
+#ifdef SGI
+ ITG token;
+#endif
+
+ /* dummy arguments for the results call */
+
+ double *veold=NULL,*accold=NULL,bet,gam,dtime,time,reltime=1.;
+
+ icol=*icolp;irow=*irowp;
+
+ kon=*konp;ipkon=*ipkonp;lakon=*lakonp;ielmat=*ielmatp;xstate=*xstatep;
+
+ tper=&timepar[1];
+
+ time=*tper;
+ dtime=*tper;
+
+ ne0=*ne;
+
+ /* allocating a field for the sensitivity analysis operations */
+
+ NNEW(ndirdesi,ITG,*nk);
+ NNEW(nodedesi,ITG,*nk);
+ NNEW(ad,double,neq[1]);
+ NNEW(au,double,nzs[2]);
+ NNEW(enerini,double,mi[0]**ne);
+ NNEW(emeini,double,6*mi[0]**ne);
+
+ ener=*enerp;emeini=eme;
+
+ for(k=0;k<mi[0]*ne0;++k){enerini[k]=ener[k];}
+
+ /* reading the stiffness matrix from previous step for sensitivity analysis */
+ /* matrix stored in <jobname>.stima file */
+
+ 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(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),nzs[2],f1)!=nzs[2]){
+ printf("*ERROR in sensitivity reading the off-diagonals of the stiffness matrix in the .stm-file");
+ exit(0);
+ }
+
+ fclose(f1);
+
+ /* determining the information of the designvariable set */
+
+ FORTRAN(getdesiinfo,(set,istartset,iendset,ialset,nset,
+ mi,nactdof,&ndesi,ndirdesi,nodedesi,ntie,tieset));
+
+ /* calculation of the smallest distance between nodes */
+
+ FORTRAN(smalldist,(co,&distmin,lakon,ipkon,kon,ne));
+
+ /* 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));
+
+ /* 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(df,double,ndesi**neq);
+ NNEW(stx,double,6*mi[0]**ne);
+ NNEW(inum,ITG,*nk);
+ NNEW(stiini,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,ndirdesi,sti);
+
+ iout=1;
+
+ /* determining the system matrix and the external forces */
+
+ NNEW(fext,double,*neq);
+ NNEW(dfextminds,double,ndesi**neq);
+
+ nmethodl=*nmethod;
+
+ 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,ad,au,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,
+ &distmin,&ndesi,nodedesi,ndirdesi,dfextminds);
+
+ /* determining the values and the derivatives of the objective functions */
+
+ NNEW(g0,double,*nobject);
+ NNEW(dgdx,double,ndesi**nobject);
+ NNEW(dgdxtot,double,ndesi**nobject);
+ NNEW(dgdv,double,*neq**nobject);
+
+ iout=-1;
+ objectivesmmain_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,&distmin,
+ &ndesi,nodedesi,ndirdesi,nobject,objectset,g0,dgdx,dgdv,sti,
+ dgdxtot,dfextminds,df);
+ iout=1;
+
+ /* calculating the normal direction for every designvariable */
+
+
+ /* preparing the sensitivities for the output in the frd-file */
+
+ NNEW(dgdxtotglob,double,4**nk**nobject);
+
+ FORTRAN(sensitivity_glob,(dgdxtot,dgdxtotglob,nobject,&ndesi,nodedesi,
+ ndirdesi,nk));
+
+ /* writing the sensitivities in the frd-file */
+
+ for(numobject=0;numobject<*nobject;numobject++){
+ frd_se(co,nk,stn,inum,nmethod,kode,filab,fn,&ptime,nstate_,istep,
+ &iinc,&mode,&noddiam,description,mi,&ngraph,ne,cs,set,nset,
+ istartset,iendset,ialset,thicke,jobnamec,output,
+ &dgdxtotglob[numobject*4**nk],numobject);
+ }
+
+
+ SFREE(xbounact);SFREE(xforcact);SFREE(xloadact);SFREE(t1act);SFREE(ampli);
+ SFREE(xbodyact);SFREE(v);SFREE(fn);SFREE(stx);SFREE(inum);SFREE(fext);
+ SFREE(f);if(*nbody>0) SFREE(ipobody);SFREE(xstiff);SFREE(enerini);
+
+ SFREE(dfextminds);SFREE(df);SFREE(g0);SFREE(dgdx);SFREE(ndirdesi);
+ SFREE(nodedesi);SFREE(au);SFREE(ad);SFREE(stiini);SFREE(dgdv);
+ SFREE(dgdxtotglob);
+
+ *icolp=icol;*irowp=irow;
+
+ *konp=kon;*ipkonp=ipkon;*lakonp=lakon;*ielmatp=ielmat;*enerp=ener;
+ *xstatep=xstate;
+
+ (*ttime)+=(*tper);
+
+ return;
+}
diff --git a/ccx_2.10/src/sensitivity_glob.f b/ccx_2.10/src/sensitivity_glob.f
new file mode 100644
index 0000000..5d6331f
--- /dev/null
+++ b/ccx_2.10/src/sensitivity_glob.f
@@ -0,0 +1,58 @@
+!
+! CalculiX - A 3-dimensional finite element program
+! Copyright (C) 1998-2015 Guido Dhondt
+!
+! This program is free software; you can redistribute it and/or
+! modify it under the terms of the GNU General Public License as
+! published by the Free Software Foundation(version 2);
+!
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program; if not, write to the Free Software
+! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+!
+ subroutine sensitivity_glob(dgdxtot,dgdxtotglob,nobject,ndesi,
+ & nodedesi,ndirdesi,nk)
+
+!
+! prepares the sensitivities for the output in the frd-file
+!
+ implicit none
+!
+ integer nobject,ndesi,nodedesi(*),ndirdesi(*),nk,numobject,
+ & numnode,numdesvar,i
+!
+ real*8 dgdxtot(ndesi,nobject),dgdxtotglob(4,nk,nobject)
+!
+! Loop over all nodes
+ do numnode=1,nk
+! Loop over designvariables
+ do numdesvar=1,ndesi
+ if(nodedesi(numdesvar).eq.numnode) then
+! Loop over all objective functions
+ do numobject=1,nobject
+! loop over all coordinates
+ do i=1,3
+ if(nodedesi(numdesvar).eq.nodedesi(numdesvar+
+ & i-1)) then
+ dgdxtotglob(i,numnode,numobject)=
+ & dgdxtot(numdesvar+i-1,numobject)
+ endif
+ enddo
+ enddo
+ exit
+ endif
+ enddo
+ enddo
+!
+ return
+ end
+
+
+
+
diff --git a/ccx_2.9/src/sensitivitys.f b/ccx_2.10/src/sensitivitys.f
similarity index 100%
rename from ccx_2.9/src/sensitivitys.f
rename to ccx_2.10/src/sensitivitys.f
diff --git a/ccx_2.9/src/sgi.c b/ccx_2.10/src/sgi.c
similarity index 100%
rename from ccx_2.9/src/sgi.c
rename to ccx_2.10/src/sgi.c
diff --git a/ccx_2.9/src/sgi.h b/ccx_2.10/src/sgi.h
similarity index 100%
rename from ccx_2.9/src/sgi.h
rename to ccx_2.10/src/sgi.h
diff --git a/ccx_2.9/src/shape10tet.f b/ccx_2.10/src/shape10tet.f
similarity index 100%
rename from ccx_2.9/src/shape10tet.f
rename to ccx_2.10/src/shape10tet.f
diff --git a/ccx_2.9/src/shape14tet.f b/ccx_2.10/src/shape14tet.f
similarity index 100%
rename from ccx_2.9/src/shape14tet.f
rename to ccx_2.10/src/shape14tet.f
diff --git a/ccx_2.9/src/shape15w.f b/ccx_2.10/src/shape15w.f
similarity index 100%
rename from ccx_2.9/src/shape15w.f
rename to ccx_2.10/src/shape15w.f
diff --git a/ccx_2.9/src/shape20h.f b/ccx_2.10/src/shape20h.f
similarity index 100%
rename from ccx_2.9/src/shape20h.f
rename to ccx_2.10/src/shape20h.f
diff --git a/ccx_2.9/src/shape20h_ax.f b/ccx_2.10/src/shape20h_ax.f
similarity index 100%
rename from ccx_2.9/src/shape20h_ax.f
rename to ccx_2.10/src/shape20h_ax.f
diff --git a/ccx_2.9/src/shape20h_pl.f b/ccx_2.10/src/shape20h_pl.f
similarity index 100%
rename from ccx_2.9/src/shape20h_pl.f
rename to ccx_2.10/src/shape20h_pl.f
diff --git a/ccx_2.9/src/shape26h.f b/ccx_2.10/src/shape26h.f
similarity index 100%
rename from ccx_2.9/src/shape26h.f
rename to ccx_2.10/src/shape26h.f
diff --git a/ccx_2.9/src/shape3l.f b/ccx_2.10/src/shape3l.f
similarity index 100%
rename from ccx_2.9/src/shape3l.f
rename to ccx_2.10/src/shape3l.f
diff --git a/ccx_2.9/src/shape3tri.f b/ccx_2.10/src/shape3tri.f
similarity index 97%
rename from ccx_2.9/src/shape3tri.f
rename to ccx_2.10/src/shape3tri.f
index a32f98a..73c8738 100644
--- a/ccx_2.9/src/shape3tri.f
+++ b/ccx_2.10/src/shape3tri.f
@@ -34,6 +34,8 @@
! value of their 1st and 2nd order derivatives
! w.r.t. the local coordinates, the Jacobian vector
! (local normal to the surface)
+! iflag=5: calculate the value of the shape functions and
+! their derivatives w.r.t. the local coordinates
!
implicit none
!
@@ -68,6 +70,8 @@
shp(2,2)=0.d0
shp(2,3)=1.d0
!
+ if(iflag.eq.5) return
+!
! computation of the local derivative of the global coordinates
! (xs)
!
diff --git a/ccx_2.9/src/shape4q.f b/ccx_2.10/src/shape4q.f
similarity index 90%
rename from ccx_2.9/src/shape4q.f
rename to ccx_2.10/src/shape4q.f
index 914017f..70a0a1c 100644
--- a/ccx_2.9/src/shape4q.f
+++ b/ccx_2.10/src/shape4q.f
@@ -31,12 +31,15 @@
! value of their 1st and 2nd order derivatives
! w.r.t. the local coordinates, the Jacobian vector
! (local normal to the surface)
+! iflag=5: calculate the value of the shape functions and
+! their derivatives w.r.t. the local coordinates
!
implicit none
!
integer i,j,k,iflag
!
- real*8 shp(7,4),xs(3,7),xsi(2,3),xl(3,8),sh(3),xsj(3),xi,et
+ real*8 shp(7,4),xs(3,7),xsi(2,3),xl(3,8),sh(3),xsj(3),xi,et,
+ & xip,xim,etp,etm
!
intent(in) xi,et,xl,iflag
!
@@ -45,28 +48,35 @@
! shape functions and their glocal derivatives for an element
! described with two local parameters and three global ones.
!
+ xip=1.d0+xi
+ xim=1.d0-xi
+ etp=1.d0+et
+ etm=1.d0-et
+!
! shape functions
!
- shp(4,1)=(1.d0-xi)*(1.d0-et)/4.d0
- shp(4,2)=(1.d0+xi)*(1.d0-et)/4.d0
- shp(4,3)=(1.d0+xi)*(1.d0+et)/4.d0
- shp(4,4)=(1.d0-xi)*(1.d0+et)/4.d0
+ shp(4,1)=xim*etm/4.d0
+ shp(4,2)=xip*etm/4.d0
+ shp(4,3)=xip*(etp)/4.d0
+ shp(4,4)=xim*(etp)/4.d0
!
if(iflag.eq.1) return
!
! local derivatives of the shape functions: xi-derivative
!
- shp(1,1)=-(1.d0-et)/4.d0
- shp(1,2)=(1.d0-et)/4.d0
- shp(1,3)=(1.d0+et)/4.d0
- shp(1,4)=-(1.d0+et)/4.d0
+ shp(1,1)=-etm/4.d0
+ shp(1,2)=etm/4.d0
+ shp(1,3)=(etp)/4.d0
+ shp(1,4)=-(etp)/4.d0
!
! local derivatives of the shape functions: eta-derivative
!
- shp(2,1)=-(1.d0-xi)/4.d0
- shp(2,2)=-(1.d0+xi)/4.d0
- shp(2,3)=(1.d0+xi)/4.d0
- shp(2,4)=(1.d0-xi)/4.d0
+ shp(2,1)=-xim/4.d0
+ shp(2,2)=-xip/4.d0
+ shp(2,3)=xip/4.d0
+ shp(2,4)=xim/4.d0
+!
+ if(iflag.eq.5) return
!
! computation of the local derivative of the global coordinates
! (xs)
diff --git a/ccx_2.9/src/shape4tet.f b/ccx_2.10/src/shape4tet.f
similarity index 100%
rename from ccx_2.9/src/shape4tet.f
rename to ccx_2.10/src/shape4tet.f
diff --git a/ccx_2.9/src/shape6tri.f b/ccx_2.10/src/shape6tri.f
similarity index 93%
rename from ccx_2.9/src/shape6tri.f
rename to ccx_2.10/src/shape6tri.f
index de8ed6a..f6fafbf 100644
--- a/ccx_2.9/src/shape6tri.f
+++ b/ccx_2.10/src/shape6tri.f
@@ -31,6 +31,8 @@
! value of their 1st and 2nd order derivatives
! w.r.t. the local coordinates, the Jacobian vector
! (local normal to the surface)
+! iflag=5: calculate the value of the shape functions and
+! their derivatives w.r.t. the local coordinates
!
! shape functions and derivatives for a 6-node quadratic
! isoparametric triangular element. 0<=xi,et<=1,xi+et<=1
@@ -39,7 +41,7 @@
!
integer i,j,k,iflag
!
- real*8 shp(7,6),xs(3,7),xsi(2,3),xl(3,6),sh(3),xsj(3),xi,et
+ real*8 shp(7,6),xs(3,7),xsi(2,3),xl(3,6),sh(3),xsj(3),xi,et,c1
!
intent(in) xi,et,xl,iflag
!
@@ -48,14 +50,16 @@
! shape functions and their glocal derivatives for an element
! described with two local parameters and three global ones.
!
+ c1=1.d0-xi-et
+!
! shape functions
!
- shp(4,1)=2.d0*(0.5d0-xi-et)*(1.d0-xi-et)
+ shp(4,1)=2.d0*(0.5d0-xi-et)*c1
shp(4,2)=xi*(2.d0*xi-1.d0)
shp(4,3)=et*(2.d0*et-1.d0)
- shp(4,4)=4.d0*xi*(1.d0-xi-et)
+ shp(4,4)=4.d0*xi*c1
shp(4,5)=4.d0*xi*et
- shp(4,6)=4.d0*et*(1.d0-xi-et)
+ shp(4,6)=4.d0*et*c1
!
if(iflag.eq.1) return
!
@@ -64,7 +68,7 @@
shp(1,1)=4.d0*(xi+et)-3.d0
shp(1,2)=4.d0*xi-1.d0
shp(1,3)=0.d0
- shp(1,4)=4.d0*(1.d0-2.d0*xi-et)
+ shp(1,4)=4.d0*(c1-xi)
shp(1,5)=4.d0*et
shp(1,6)=-4.d0*et
!
@@ -75,7 +79,9 @@
shp(2,3)=4.d0*et-1.d0
shp(2,4)=-4.d0*xi
shp(2,5)=4.d0*xi
- shp(2,6)=4.d0*(1.d0-xi-2.d0*et)
+ shp(2,6)=4.d0*(c1-et)
+!
+ if(iflag.eq.5) return
!
! computation of the local derivative of the global coordinates
! (xs)
@@ -100,12 +106,6 @@
! computation of the global derivative of the local coordinates
! (xsi) (inversion of xs)
!
-c xsi(1,1)=xs(2,2)/xsj(3)
-c xsi(2,1)=-xs(2,1)/xsj(3)
-c xsi(1,2)=-xs(1,2)/xsj(3)
-c xsi(2,2)=xs(1,1)/xsj(3)
-c xsi(1,3)=-xs(2,2)/xsj(1)
-c xsi(2,3)=xs(2,1)/xsj(1)
if(dabs(xsj(3)).gt.1.d-10) then
xsi(1,1)=xs(2,2)/xsj(3)
xsi(2,2)=xs(1,1)/xsj(3)
diff --git a/ccx_2.9/src/shape6w.f b/ccx_2.10/src/shape6w.f
similarity index 100%
rename from ccx_2.9/src/shape6w.f
rename to ccx_2.10/src/shape6w.f
diff --git a/ccx_2.9/src/shape7tri.f b/ccx_2.10/src/shape7tri.f
similarity index 100%
rename from ccx_2.9/src/shape7tri.f
rename to ccx_2.10/src/shape7tri.f
diff --git a/ccx_2.9/src/shape8h.f b/ccx_2.10/src/shape8h.f
similarity index 100%
rename from ccx_2.9/src/shape8h.f
rename to ccx_2.10/src/shape8h.f
diff --git a/ccx_2.9/src/shape8hr.f b/ccx_2.10/src/shape8hr.f
similarity index 100%
rename from ccx_2.9/src/shape8hr.f
rename to ccx_2.10/src/shape8hr.f
diff --git a/ccx_2.9/src/shape8hu.f b/ccx_2.10/src/shape8hu.f
similarity index 100%
rename from ccx_2.9/src/shape8hu.f
rename to ccx_2.10/src/shape8hu.f
diff --git a/ccx_2.9/src/shape8q.f b/ccx_2.10/src/shape8q.f
similarity index 75%
rename from ccx_2.9/src/shape8q.f
rename to ccx_2.10/src/shape8q.f
index 51188ee..9c10545 100644
--- a/ccx_2.9/src/shape8q.f
+++ b/ccx_2.10/src/shape8q.f
@@ -34,50 +34,66 @@
! value of their 1st and 2nd order derivatives
! w.r.t. the local coordinates, the Jacobian vector
! (local normal to the surface)
+! iflag=5: calculate the value of the shape functions and
+! their derivatives w.r.t. the local coordinates
!
implicit none
!
integer i,j,k,iflag
!
- real*8 shp(7,8),xs(3,7),xsi(2,3),xl(3,8),sh(3),xsj(3),xi,et
+ real*8 shp(7,8),xs(3,7),xsi(2,3),xl(3,8),sh(3),xsj(3),xi,et,
+ & xip,xim,xim2,etp,etm,etm2,xipet,ximet
!
! shape functions and their glocal derivatives for an element
! described with two local parameters and three global ones.
!
+ xip=1.d0+xi
+ xim=1.d0-xi
+ xim2=xip*xim
+!
+ etp=1.d0+et
+ etm=1.d0-et
+ etm2=etp*etm
+!
+ xipet=xi+et
+ ximet=xi-et
+!
! shape functions
!
- shp(4,1)=(1.d0-xi)*(1.d0-et)*(-xi-et-1.d0)/4.d0
- shp(4,2)=(1.d0+xi)*(1.d0-et)*(xi-et-1.d0)/4.d0
- shp(4,3)=(1.d0+xi)*(1.d0+et)*(xi+et-1.d0)/4.d0
- shp(4,4)=(1.d0-xi)*(1.d0+et)*(-xi+et-1.d0)/4.d0
- shp(4,5)=(1.d0-xi*xi)*(1.d0-et)/2.d0
- shp(4,6)=(1.d0+xi)*(1.d0-et*et)/2.d0
- shp(4,7)=(1.d0-xi*xi)*(1.d0+et)/2.d0
- shp(4,8)=(1.d0-xi)*(1.d0-et*et)/2.d0
+ shp(4,1)=xim*etm*(-xipet-1.d0)/4.d0
+ shp(4,2)=xip*etm*(ximet-1.d0)/4.d0
+ shp(4,3)=xip*etp*(xipet-1.d0)/4.d0
+ shp(4,4)=xim*etp*(-ximet-1.d0)/4.d0
+ shp(4,5)=xim2*etm/2.d0
+ shp(4,6)=xip*etm2/2.d0
+ shp(4,7)=xim2*etp/2.d0
+ shp(4,8)=xim*etm2/2.d0
!
if(iflag.eq.1) return
!
! local derivatives of the shape functions: xi-derivative
!
- shp(1,1)=(1.d0-et)*(2.d0*xi+et)/4.d0
- shp(1,2)=(1.d0-et)*(2.d0*xi-et)/4.d0
- shp(1,3)=(1.d0+et)*(2.d0*xi+et)/4.d0
- shp(1,4)=(1.d0+et)*(2.d0*xi-et)/4.d0
- shp(1,5)=-xi*(1.d0-et)
- shp(1,6)=(1.d0-et*et)/2.d0
- shp(1,7)=-xi*(1.d0+et)
- shp(1,8)=-(1.d0-et*et)/2.d0
+ shp(1,1)=etm*(xi+xipet)/4.d0
+ shp(1,2)=etm*(xi+ximet)/4.d0
+ shp(1,3)=etp*(xi+xipet)/4.d0
+ shp(1,4)=etp*(xi+ximet)/4.d0
+ shp(1,5)=-xi*etm
+ shp(1,6)=etm2/2.d0
+ shp(1,7)=-xi*etp
+ shp(1,8)=-etm2/2.d0
!
! local derivatives of the shape functions: eta-derivative
!
- shp(2,1)=(1.d0-xi)*(2.d0*et+xi)/4.d0
- shp(2,2)=(1.d0+xi)*(2.d0*et-xi)/4.d0
- shp(2,3)=(1.d0+xi)*(2.d0*et+xi)/4.d0
- shp(2,4)=(1.d0-xi)*(2.d0*et-xi)/4.d0
- shp(2,5)=-(1.d0-xi*xi)/2.d0
- shp(2,6)=-et*(1.d0+xi)
- shp(2,7)=(1.d0-xi*xi)/2.d0
- shp(2,8)=-et*(1.d0-xi)
+ shp(2,1)=xim*(et+xipet)/4.d0
+ shp(2,2)=xip*(et-ximet)/4.d0
+ shp(2,3)=xip*(et+xipet)/4.d0
+ shp(2,4)=xim*(et-ximet)/4.d0
+ shp(2,5)=-xim2/2.d0
+ shp(2,6)=-et*xip
+ shp(2,7)=xim2/2.d0
+ shp(2,8)=-et*xim
+!
+ if(iflag.eq.5) return
!
! computation of the local derivative of the global coordinates
! (xs)
@@ -153,21 +169,21 @@
!
! local 2nd order derivatives of the shape functions: xi,xi-derivative
!
- shp(5,1)=(1.d0-et)/2.d0
- shp(5,2)=(1.d0-et)/2.d0
- shp(5,3)=(1.d0+et)/2.d0
- shp(5,4)=(1.d0+et)/2.d0
- shp(5,5)=-(1.d0-et)
+ shp(5,1)=etm/2.d0
+ shp(5,2)=etm/2.d0
+ shp(5,3)=etp/2.d0
+ shp(5,4)=etp/2.d0
+ shp(5,5)=-etm
shp(5,6)=0.d0
- shp(5,7)=-(1.d0+et)
+ shp(5,7)=-etp
shp(5,8)=0.d0
!
! local 2nd order derivatives of the shape functions: xi,eta-derivative
!
- shp(6,1)=(1.d0-2.d0*(xi+et))/4.d0
- shp(6,2)=(-1.d0-2.d0*(xi-et))/4.d0
- shp(6,3)=(1.d0+2.d0*(xi+et))/4.d0
- shp(6,4)=(-1.d0-2.d0*(xi+et))/4.d0
+ shp(6,1)=(1.d0-2.d0*xipet)/4.d0
+ shp(6,2)=(-1.d0-2.d0*ximet)/4.d0
+ shp(6,3)=(1.d0+2.d0*xipet)/4.d0
+ shp(6,4)=(-1.d0+2.d0*ximet)/4.d0
shp(6,5)=xi
shp(6,6)=-et
shp(6,7)=-xi
@@ -175,14 +191,14 @@
!
! local 2nd order derivatives of the shape functions: eta,eta-derivative
!
- shp(7,1)=(1.d0-xi)/2.d0
- shp(7,2)=(1.d0+xi)/2.d0
- shp(7,3)=(1.d0+xi)/2.d0
- shp(7,4)=(1.d0-xi)/2.d0
+ shp(7,1)=xim/2.d0
+ shp(7,2)=xip/2.d0
+ shp(7,3)=xip/2.d0
+ shp(7,4)=xim/2.d0
shp(7,5)=0.d0
- shp(7,6)=-(1.d0+xi)
+ shp(7,6)=-xip
shp(7,7)=0.d0
- shp(7,8)=-(1.d0-xi)
+ shp(7,8)=-xim
!
! computation of the local 2nd derivatives of the global coordinates
! (xs)
diff --git a/ccx_2.9/src/shape9q.f b/ccx_2.10/src/shape9q.f
similarity index 100%
rename from ccx_2.9/src/shape9q.f
rename to ccx_2.10/src/shape9q.f
diff --git a/ccx_2.9/src/shellsections.f b/ccx_2.10/src/shellsections.f
similarity index 100%
rename from ccx_2.9/src/shellsections.f
rename to ccx_2.10/src/shellsections.f
diff --git a/ccx_2.9/src/sigini.f b/ccx_2.10/src/sigini.f
similarity index 100%
rename from ccx_2.9/src/sigini.f
rename to ccx_2.10/src/sigini.f
diff --git a/ccx_2.9/src/skip.f b/ccx_2.10/src/skip.f
similarity index 100%
rename from ccx_2.9/src/skip.f
rename to ccx_2.10/src/skip.f
diff --git a/ccx_2.9/src/slavintpoints.f b/ccx_2.10/src/slavintpoints.f
similarity index 100%
rename from ccx_2.9/src/slavintpoints.f
rename to ccx_2.10/src/slavintpoints.f
diff --git a/ccx_2.9/src/smalldist.f b/ccx_2.10/src/smalldist.f
similarity index 96%
rename from ccx_2.9/src/smalldist.f
rename to ccx_2.10/src/smalldist.f
index 56dbfb0..00a5728 100644
--- a/ccx_2.9/src/smalldist.f
+++ b/ccx_2.10/src/smalldist.f
@@ -101,15 +101,15 @@ C nope=15
enddo
enddo
!
-! 1% of the smallest distance used for the variation
+! 0.1% of the smallest distance used for the variation
!
- distmin=(distmin**0.5)*0.01
+ distmin=(distmin**0.5)*0.001
!
! Write results in file
!
! open(16,file='results_distance.out',status='unknown')
! write(16,'(1x,i6,1x,i6,1x,f5.4)') mindistnod(1,1),
-! & mindistnod(2,1),distmin
+! & mindistnod(2,1),distmin
! close(16)
return
diff --git a/ccx_2.9/src/solidsections.f b/ccx_2.10/src/solidsections.f
similarity index 100%
rename from ccx_2.9/src/solidsections.f
rename to ccx_2.10/src/solidsections.f
diff --git a/ccx_2.9/src/sortev.f b/ccx_2.10/src/sortev.f
similarity index 100%
rename from ccx_2.9/src/sortev.f
rename to ccx_2.10/src/sortev.f
diff --git a/ccx_2.9/src/spcmatch.f b/ccx_2.10/src/spcmatch.f
similarity index 100%
rename from ccx_2.9/src/spcmatch.f
rename to ccx_2.10/src/spcmatch.f
diff --git a/ccx_2.9/src/specificgasconstants.f b/ccx_2.10/src/specificgasconstants.f
similarity index 100%
rename from ccx_2.9/src/specificgasconstants.f
rename to ccx_2.10/src/specificgasconstants.f
diff --git a/ccx_2.9/src/specificheats.f b/ccx_2.10/src/specificheats.f
similarity index 100%
rename from ccx_2.9/src/specificheats.f
rename to ccx_2.10/src/specificheats.f
diff --git a/ccx_2.9/src/splitline.f b/ccx_2.10/src/splitline.f
similarity index 100%
rename from ccx_2.9/src/splitline.f
rename to ccx_2.10/src/splitline.f
diff --git a/ccx_2.9/src/spooles.c b/ccx_2.10/src/spooles.c
similarity index 100%
rename from ccx_2.9/src/spooles.c
rename to ccx_2.10/src/spooles.c
diff --git a/ccx_2.9/src/spooles.h b/ccx_2.10/src/spooles.h
similarity index 100%
rename from ccx_2.9/src/spooles.h
rename to ccx_2.10/src/spooles.h
diff --git a/ccx_2.9/src/springdamp_f2f.f b/ccx_2.10/src/springdamp_f2f.f
similarity index 100%
rename from ccx_2.9/src/springdamp_f2f.f
rename to ccx_2.10/src/springdamp_f2f.f
diff --git a/ccx_2.9/src/springdamp_n2f.f b/ccx_2.10/src/springdamp_n2f.f
similarity index 100%
rename from ccx_2.9/src/springdamp_n2f.f
rename to ccx_2.10/src/springdamp_n2f.f
diff --git a/ccx_2.9/src/springforc_f2f.f b/ccx_2.10/src/springforc_f2f.f
similarity index 99%
rename from ccx_2.9/src/springforc_f2f.f
rename to ccx_2.10/src/springforc_f2f.f
index c43e42a..18cf2dd 100644
--- a/ccx_2.9/src/springforc_f2f.f
+++ b/ccx_2.10/src/springforc_f2f.f
@@ -47,6 +47,8 @@
include "gauss.f"
!
iflag=2
+!
+ if(iener.eq.1) venergy=0.d0
!
! # of master nodes
!
@@ -410,7 +412,7 @@ c dftrial=dsqrt(ftrial(1)**2+ftrial(2)**2+ftrial(3)**2)
!
if(iener.eq.1) then
senergy=senergy+dfshear*dfshear/xk
- venergy=venergy+dg*dfshear
+ venergy=dg*dfshear
endif
!
endif
diff --git a/ccx_2.9/src/springforc_f2f_th.f b/ccx_2.10/src/springforc_f2f_th.f
similarity index 100%
rename from ccx_2.9/src/springforc_f2f_th.f
rename to ccx_2.10/src/springforc_f2f_th.f
diff --git a/ccx_2.9/src/springforc_n2f.f b/ccx_2.10/src/springforc_n2f.f
similarity index 90%
rename from ccx_2.9/src/springforc_n2f.f
rename to ccx_2.10/src/springforc_n2f.f
index 7d0d795..5c3ea70 100644
--- a/ccx_2.9/src/springforc_n2f.f
+++ b/ccx_2.10/src/springforc_n2f.f
@@ -45,6 +45,8 @@
!
iflag=2
!
+ if(iener.eq.1) venergy=0.d0
+!
! actual positions of the nodes belonging to the contact spring
! (otherwise no contact force)
!
@@ -106,7 +108,7 @@
xk=0.d0
fk=yiso(1)
if(iener.eq.1) then
- senergy=fk*val;
+ senergy=fk*val
endif
elseif(id.eq.niso) then
xk=0.d0
@@ -206,6 +208,15 @@
clear=clear-springarea(2)*(1.d0-reltime)
endif
if(clear.le.0.d0) cstr(1)=clear
+!
+! MPADD start
+! (keep also positive clearance in the frd file)
+c if(nmethod.eq.4) then
+c cstr(1)=clear
+c else
+c if(clear.le.0.d0) cstr(1)=clear
+c endif
+! MPADD end
!
! representative area: usually the slave surface stored in
! springarea; however, if no area was assigned because the
@@ -237,19 +248,42 @@
elas(1)=dexp(-beta*clear+dlog(alpha))
endif
if(iener.eq.1) then
- senergy=elas(1)/beta;
+ senergy=elas(1)/beta
endif
elseif(int(elcon(3,1,imat)).eq.2) then
!
! linear overclosure
+!
+! MPADD start
+ if(nmethod.eq.4) then
+!
+! Conputation of the force (only if negative clearance)
+! the energy is computed with the exact potential
+!
+ if(clear.le.0.d0)then
+ pi=4.d0*datan(1.d0)
+ eps=elcon(1,1,imat)*pi/elcon(2,1,imat)
+ elas(1)=(-springarea(1)*elcon(2,1,imat)*clear*
+ & (0.5d0+datan(-clear/eps)/pi))
+ if(iener.eq.1)
+ & senergy=springarea(1)*elcon(2,1,imat)*(clear**2/4.d0+
+ & (0.5d0*datan(-clear/eps)*clear**2+
+ & 0.5d0*(eps*clear+datan(-clear/eps)*eps**2))/pi)
+ else
+ elas(1)=0.d0
+ if(iener.eq.1) senergy=0.d0
+ endif
!
- pi=4.d0*datan(1.d0)
- eps=elcon(1,1,imat)*pi/elcon(2,1,imat)
- elas(1)=(-springarea(1)*elcon(2,1,imat)*clear*
- & (0.5d0+datan(-clear/eps)/pi))
- if(iener.eq.1) then
- senergy=-elas(1)*clear/2.d0;
+ else
+ pi=4.d0*datan(1.d0)
+ eps=elcon(1,1,imat)*pi/elcon(2,1,imat)
+ elas(1)=(-springarea(1)*elcon(2,1,imat)*clear*
+ & (0.5d0+datan(-clear/eps)/pi))
+ if(iener.eq.1) then
+ senergy=-elas(1)*clear/2.d0
+ endif
endif
+! MPADD end
elseif(int(elcon(3,1,imat)).eq.3) then
!
! tabular overclosure
@@ -268,7 +302,7 @@
if(id.eq.0) then
pres=yiso(1)
if(iener.eq.1) then
- senergy=yiso(1)*overlap;
+ senergy=yiso(1)*overlap
endif
elseif(id.eq.niso) then
pres=yiso(niso)
@@ -440,7 +474,7 @@ c write(*,*)'SLIP'
!
if(iener.eq.1) then
senergy=senergy+dfshear*dfshear/xk
- venergy=venergy+dg*dfshear
+ venergy=dg*dfshear
endif
!
endif
diff --git a/ccx_2.9/src/springforc_n2f_th.f b/ccx_2.10/src/springforc_n2f_th.f
similarity index 100%
rename from ccx_2.9/src/springforc_n2f_th.f
rename to ccx_2.10/src/springforc_n2f_th.f
diff --git a/ccx_2.9/src/springs.f b/ccx_2.10/src/springs.f
similarity index 100%
rename from ccx_2.9/src/springs.f
rename to ccx_2.10/src/springs.f
diff --git a/ccx_2.9/src/springstiff_f2f.f b/ccx_2.10/src/springstiff_f2f.f
similarity index 100%
rename from ccx_2.9/src/springstiff_f2f.f
rename to ccx_2.10/src/springstiff_f2f.f
diff --git a/ccx_2.9/src/springstiff_f2f_th.f b/ccx_2.10/src/springstiff_f2f_th.f
similarity index 100%
rename from ccx_2.9/src/springstiff_f2f_th.f
rename to ccx_2.10/src/springstiff_f2f_th.f
diff --git a/ccx_2.9/src/springstiff_n2f.f b/ccx_2.10/src/springstiff_n2f.f
similarity index 100%
rename from ccx_2.9/src/springstiff_n2f.f
rename to ccx_2.10/src/springstiff_n2f.f
diff --git a/ccx_2.9/src/springstiff_n2f_th.f b/ccx_2.10/src/springstiff_n2f_th.f
similarity index 100%
rename from ccx_2.9/src/springstiff_n2f_th.f
rename to ccx_2.10/src/springstiff_n2f_th.f
diff --git a/ccx_2.9/src/statics.f b/ccx_2.10/src/statics.f
similarity index 100%
rename from ccx_2.9/src/statics.f
rename to ccx_2.10/src/statics.f
diff --git a/ccx_2.9/src/steadystate.c b/ccx_2.10/src/steadystate.c
similarity index 100%
rename from ccx_2.9/src/steadystate.c
rename to ccx_2.10/src/steadystate.c
diff --git a/ccx_2.9/src/steadystatedynamicss.f b/ccx_2.10/src/steadystatedynamicss.f
similarity index 100%
rename from ccx_2.9/src/steadystatedynamicss.f
rename to ccx_2.10/src/steadystatedynamicss.f
diff --git a/ccx_2.9/src/steps.f b/ccx_2.10/src/steps.f
similarity index 100%
rename from ccx_2.9/src/steps.f
rename to ccx_2.10/src/steps.f
diff --git a/ccx_2.9/src/stiff2mat.f b/ccx_2.10/src/stiff2mat.f
similarity index 100%
rename from ccx_2.9/src/stiff2mat.f
rename to ccx_2.10/src/stiff2mat.f
diff --git a/ccx_2.9/src/stof.c b/ccx_2.10/src/stof.c
similarity index 100%
rename from ccx_2.9/src/stof.c
rename to ccx_2.10/src/stof.c
diff --git a/ccx_2.9/src/stoi.c b/ccx_2.10/src/stoi.c
similarity index 100%
rename from ccx_2.9/src/stoi.c
rename to ccx_2.10/src/stoi.c
diff --git a/ccx_2.9/src/stop.f b/ccx_2.10/src/stop.f
similarity index 100%
rename from ccx_2.9/src/stop.f
rename to ccx_2.10/src/stop.f
diff --git a/ccx_2.9/src/storecontactdof.c b/ccx_2.10/src/storecontactdof.c
similarity index 100%
rename from ccx_2.9/src/storecontactdof.c
rename to ccx_2.10/src/storecontactdof.c
diff --git a/ccx_2.10/src/storecontactprop.f b/ccx_2.10/src/storecontactprop.f
new file mode 100644
index 0000000..6b74735
--- /dev/null
+++ b/ccx_2.10/src/storecontactprop.f
@@ -0,0 +1,183 @@
+!
+! CalculiX - A 3-dimensional finite element program
+! Copyright (C) 1998-2007 Guido Dhondt
+!
+! This program is free software; you can redistribute it and/or
+! modify it under the terms of the GNU General Public License as
+! published by the Free Software Foundation(version 2);
+!
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program; if not, write to the Free Software
+! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+!
+ subroutine storecontactprop(ne,ne0,lakon,kon,ipkon,mi,
+ & ielmat,elcon,mortar,adb,nactdof,springarea,
+ & ncmat_,ntmat_,stx,temax)
+!
+! # # # # # # # # # # # # # # # # # # # # # # # # # # # #
+! Routine that computes the natural period of oscillation
+! of the contact elements. A simplified two-dofs model
+! has been used to compute the natural frequencies due
+! to the relative motion between slave and master surf-
+! ace.
+!
+! Main variables and meaning
+!
+! temax : max. natural period of oscillation
+! stx : vector containig results (from results.c)
+! springmm : average mass of master surface
+! springms : average mass of slave surface
+! xk : spring stiffness between the surfaces
+! xmacont : mass of the actual node of the element
+! areaslav : area of the slave surface (stiffness comp)
+!
+! Proposed by Matteo Pacher
+!
+! # # # # # # # # # # # # # # # # # # # # # # # # # # # #
+!
+ implicit none
+!
+ character*8 lakonl,lakon(*)
+!
+ integer mi(*),ne,ne0,kon(*),ipkon(*),nactdof(0:mi(2),*),
+ & indexe,j,nope,ielmat(mi(3),*),imat,mortar,nopem,
+ & indexn,nelem,ncmat_,ntmat_
+!
+ real*8 adb(*),springarea(2,*),pi,te,stx(6,mi(1),ne),
+ & springmm,springms,elcon(0:ncmat_,ntmat_,*),springfac,
+ & xmacont,areaslav,xk,temax
+!
+ intent(in) ne,ne0,lakon,kon,ipkon,mi,ielmat,elcon,mortar,
+ & adb,nactdof,springarea,ncmat_,ntmat_,stx
+
+ intent(out) temax
+!
+! Initialization
+!
+ temax=0.d0
+ pi=4.d0*datan(1.d0)
+
+! Loop over the contact elements
+ do nelem=ne0+1,ne
+ indexe=ipkon(nelem)
+ lakonl=lakon(nelem)
+ imat=ielmat(1,nelem)
+
+ xk=elcon(2,1,imat) ! element stiffness
+ springmm=0.0d0 ! mass master surface
+ springms=0.0d0 ! mass slave node/surface
+
+ if(mortar.eq.0) then
+!
+! Contact node to face
+!
+! nope = number of master nodes + 1 (1 slave node)
+!
+ nope=ichar(lakonl(8:8))-47
+ springfac=1.0
+!
+ do indexn=1,nope
+ xmacont=0.0d0
+
+ do j=1,3
+ if(nactdof(j,kon(indexe+indexn)).ne.0)then
+ xmacont=adb(nactdof(j,kon(indexe+indexn)))
+ exit
+ endif
+ enddo
+! mass accumulation
+ if(indexn.eq.nope)then
+ springms=springms+xmacont
+!
+! mean mass at master nodes
+!
+ springmm=springmm/(nope-1.0d0)
+ else
+ springmm=springmm+xmacont
+ endif
+ enddo
+!
+ areaslav=springarea(1,kon(indexe+nope+1))
+ xk=xk*areaslav
+!
+! checking whether mass or slave side is constrained
+!
+ if((springmm.le.0.d0).and.(springms.le.0.d0)) then
+ cycle
+ elseif(springmm.le.0.d0) then
+ springmm=springms
+ elseif(springms.le.0.d0) then
+ springms=springmm
+ endif
+!
+ elseif(mortar.eq.1) then
+!
+! Contact face to face
+!
+! nopem = number of master nodes
+!
+ nopem=ichar(lakonl(8:8))-48
+ springfac=0.1d0
+!
+ do indexn=1,kon(indexe)
+!
+ xmacont=0.0d0
+ do j=1,3
+ if(nactdof(j,kon(indexe+indexn)).ne.0)then
+ xmacont=adb(nactdof(j,kon(indexe+indexn)))
+ exit
+ endif
+ enddo
+!
+ if(indexn.gt.nopem)then !slave
+ springms=springms+xmacont
+ else !master
+ springmm=springmm+xmacont
+ endif
+ enddo
+!
+! mean mass at slave and master nodes
+!
+ springms=springms/(kon(indexe)-nopem)
+ springmm=springmm/nopem
+!
+ areaslav=springarea(1,kon(1+indexe+kon(indexe)))
+ xk=xk*areaslav*springfac
+!
+! checking whether mass or slave side is constrained
+!
+ if((springmm.le.0.d0).and.(springms.le.0.d0)) then
+ cycle
+ elseif(springmm.le.0.d0) then
+ springmm=springms
+ elseif(springms.le.0.d0) then
+ springms=springmm
+ endif
+ endif ! face-to-face
+!
+! Calculation of the natural period according to the 2-dof model
+!
+ te=0.d0
+ if(xk.ne.0.d0)then
+ te=2.d0*pi*dsqrt((springmm*springms)/
+ & ((springmm+springms)*xk))
+!
+! exponential pressure-overclosure behavior
+!
+ if(int(elcon(3,1,imat)).eq.1) then
+ te=te/10.d0
+ endif
+ endif
+!
+ if(stx(4,1,nelem).gt.0.d0) temax=max(te,temax)
+!
+ enddo ! loop over the contact elements
+!
+ return
+ end
diff --git a/ccx_2.9/src/storeresidual.f b/ccx_2.10/src/storeresidual.f
similarity index 99%
rename from ccx_2.9/src/storeresidual.f
rename to ccx_2.10/src/storeresidual.f
index c8a72e8..3861e0d 100644
--- a/ccx_2.9/src/storeresidual.f
+++ b/ccx_2.10/src/storeresidual.f
@@ -45,7 +45,7 @@
!
mt=mi(2)+1
!
- nlabel=46
+ nlabel=47
!
! storing the residual forces in field fn
!
diff --git a/ccx_2.9/src/stos.c b/ccx_2.10/src/stos.c
similarity index 100%
rename from ccx_2.9/src/stos.c
rename to ccx_2.10/src/stos.c
diff --git a/ccx_2.9/src/str2mat.f b/ccx_2.10/src/str2mat.f
similarity index 100%
rename from ccx_2.9/src/str2mat.f
rename to ccx_2.10/src/str2mat.f
diff --git a/ccx_2.9/src/straighteq2d.f b/ccx_2.10/src/straighteq2d.f
similarity index 100%
rename from ccx_2.9/src/straighteq2d.f
rename to ccx_2.10/src/straighteq2d.f
diff --git a/ccx_2.9/src/straighteq3d.f b/ccx_2.10/src/straighteq3d.f
similarity index 100%
rename from ccx_2.9/src/straighteq3d.f
rename to ccx_2.10/src/straighteq3d.f
diff --git a/ccx_2.9/src/straighteq3dpen.f b/ccx_2.10/src/straighteq3dpen.f
similarity index 100%
rename from ccx_2.9/src/straighteq3dpen.f
rename to ccx_2.10/src/straighteq3dpen.f
diff --git a/ccx_2.9/src/straightmpc.f b/ccx_2.10/src/straightmpc.f
similarity index 100%
rename from ccx_2.9/src/straightmpc.f
rename to ccx_2.10/src/straightmpc.f
diff --git a/ccx_2.9/src/strcmp1.c b/ccx_2.10/src/strcmp1.c
similarity index 100%
rename from ccx_2.9/src/strcmp1.c
rename to ccx_2.10/src/strcmp1.c
diff --git a/ccx_2.9/src/strcmp2.c b/ccx_2.10/src/strcmp2.c
similarity index 100%
rename from ccx_2.9/src/strcmp2.c
rename to ccx_2.10/src/strcmp2.c
diff --git a/ccx_2.9/src/strcpy1.c b/ccx_2.10/src/strcpy1.c
similarity index 100%
rename from ccx_2.9/src/strcpy1.c
rename to ccx_2.10/src/strcpy1.c
diff --git a/ccx_2.9/src/strsplt.c b/ccx_2.10/src/strsplt.c
similarity index 100%
rename from ccx_2.9/src/strsplt.c
rename to ccx_2.10/src/strsplt.c
diff --git a/ccx_2.9/src/submodels.f b/ccx_2.10/src/submodels.f
similarity index 100%
rename from ccx_2.9/src/submodels.f
rename to ccx_2.10/src/submodels.f
diff --git a/ccx_2.9/src/subspace.f b/ccx_2.10/src/subspace.f
similarity index 100%
rename from ccx_2.9/src/subspace.f
rename to ccx_2.10/src/subspace.f
diff --git a/ccx_2.9/src/substructuregenerates.f b/ccx_2.10/src/substructuregenerates.f
similarity index 100%
rename from ccx_2.9/src/substructuregenerates.f
rename to ccx_2.10/src/substructuregenerates.f
diff --git a/ccx_2.9/src/substructurematrixoutputs.f b/ccx_2.10/src/substructurematrixoutputs.f
similarity index 100%
rename from ccx_2.9/src/substructurematrixoutputs.f
rename to ccx_2.10/src/substructurematrixoutputs.f
diff --git a/ccx_2.9/src/surfacebehaviors.f b/ccx_2.10/src/surfacebehaviors.f
similarity index 100%
rename from ccx_2.9/src/surfacebehaviors.f
rename to ccx_2.10/src/surfacebehaviors.f
diff --git a/ccx_2.9/src/surfaceinteractions.f b/ccx_2.10/src/surfaceinteractions.f
similarity index 100%
rename from ccx_2.9/src/surfaceinteractions.f
rename to ccx_2.10/src/surfaceinteractions.f
diff --git a/ccx_2.9/src/surfaces.f b/ccx_2.10/src/surfaces.f
similarity index 100%
rename from ccx_2.9/src/surfaces.f
rename to ccx_2.10/src/surfaces.f
diff --git a/ccx_2.9/src/sutherland_hodgman.f b/ccx_2.10/src/sutherland_hodgman.f
similarity index 100%
rename from ccx_2.9/src/sutherland_hodgman.f
rename to ccx_2.10/src/sutherland_hodgman.f
diff --git a/ccx_2.9/src/swap.f b/ccx_2.10/src/swap.f
similarity index 100%
rename from ccx_2.9/src/swap.f
rename to ccx_2.10/src/swap.f
diff --git a/ccx_2.9/src/tau.c b/ccx_2.10/src/tau.c
similarity index 100%
rename from ccx_2.9/src/tau.c
rename to ccx_2.10/src/tau.c
diff --git a/ccx_2.9/src/tau.h b/ccx_2.10/src/tau.h
similarity index 100%
rename from ccx_2.9/src/tau.h
rename to ccx_2.10/src/tau.h
diff --git a/ccx_2.9/src/tee.f b/ccx_2.10/src/tee.f
similarity index 100%
rename from ccx_2.9/src/tee.f
rename to ccx_2.10/src/tee.f
diff --git a/ccx_2.9/src/temperatures.f b/ccx_2.10/src/temperatures.f
similarity index 100%
rename from ccx_2.9/src/temperatures.f
rename to ccx_2.10/src/temperatures.f
diff --git a/ccx_2.9/src/tempload.f b/ccx_2.10/src/tempload.f
similarity index 100%
rename from ccx_2.9/src/tempload.f
rename to ccx_2.10/src/tempload.f
diff --git a/ccx_2.9/src/tempload_em.f b/ccx_2.10/src/tempload_em.f
similarity index 100%
rename from ccx_2.9/src/tempload_em.f
rename to ccx_2.10/src/tempload_em.f
diff --git a/ccx_2.9/src/temploaddiff.f b/ccx_2.10/src/temploaddiff.f
similarity index 100%
rename from ccx_2.9/src/temploaddiff.f
rename to ccx_2.10/src/temploaddiff.f
diff --git a/ccx_2.9/src/temploadmodal.f b/ccx_2.10/src/temploadmodal.f
similarity index 100%
rename from ccx_2.9/src/temploadmodal.f
rename to ccx_2.10/src/temploadmodal.f
diff --git a/ccx_2.9/src/thermmodel.f b/ccx_2.10/src/thermmodel.f
similarity index 100%
rename from ccx_2.9/src/thermmodel.f
rename to ccx_2.10/src/thermmodel.f
diff --git a/ccx_2.9/src/tiedcontact.c b/ccx_2.10/src/tiedcontact.c
similarity index 100%
rename from ccx_2.9/src/tiedcontact.c
rename to ccx_2.10/src/tiedcontact.c
diff --git a/ccx_2.9/src/tiefaccont.f b/ccx_2.10/src/tiefaccont.f
similarity index 96%
rename from ccx_2.9/src/tiefaccont.f
rename to ccx_2.10/src/tiefaccont.f
index 4048b87..7f61eed 100644
--- a/ccx_2.9/src/tiefaccont.f
+++ b/ccx_2.10/src/tiefaccont.f
@@ -42,7 +42,7 @@
integer ntie,i,j,k,l,nset,istartset(*),iendset(*),ialset(*),
& ifaces,nelems,jfaces,ifacem,nelemm,nslavs,nmasts,jface,
& jfacem,indexe,nopes,nopem,ipkon(*),kon(*),id,nodef(9),
- & ifaceq(9,6),ifacet(7,4),ifacew1(4,5),ifacew2(8,5),node,
+ & ifaceq(8,6),ifacet(6,4),ifacew1(4,5),ifacew2(8,5),node,
& itiefac(2,*),islavsurf(2,*),islavnode(*),imastnode(*),
& nslavnode(ntie+1),nmastnode(ntie+1),ifacecount,islav,imast,
& ipos,index1,iponoels(*),inoels(2,*),ifreenoels,ifreenoelold,
@@ -60,19 +60,19 @@
!
! nodes per face for hex elements
!
- data ifaceq /4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/
+ data ifaceq /4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/
!
! nodes per face for tet elements
!
- data ifacet /1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/
+ data ifacet /1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/
!
! nodes per face for linear wedge elements
!
@@ -401,14 +401,10 @@
!
if(lakon(nelems)(4:5).eq.'20') then
nopes=8
- elseif(lakon(nelems)(4:4).eq.'2') then
- nopes=9
elseif(lakon(nelems)(4:4).eq.'8') then
nopes=4
elseif(lakon(nelems)(4:5).eq.'10') then
nopes=6
- elseif(lakon(nelems)(4:5).eq.'14') then
- nopes=7
elseif(lakon(nelems)(4:4).eq.'4') then
nopes=3
endif
@@ -538,14 +534,10 @@
!
if(lakon(nelemm)(4:5).eq.'20') then
nopem=8
- elseif(lakon(nelemm)(4:4).eq.'2') then
- nopem=9
elseif(lakon(nelemm)(4:4).eq.'8') then
nopem=4
elseif(lakon(nelemm)(4:5).eq.'10') then
nopem=6
- elseif(lakon(nelemm)(4:5).eq.'14') then
- nopem=7
elseif(lakon(nelemm)(4:4).eq.'4') then
nopem=3
endif
diff --git a/ccx_2.9/src/ties.f b/ccx_2.10/src/ties.f
similarity index 100%
rename from ccx_2.9/src/ties.f
rename to ccx_2.10/src/ties.f
diff --git a/ccx_2.9/src/timepointss.f b/ccx_2.10/src/timepointss.f
similarity index 100%
rename from ccx_2.9/src/timepointss.f
rename to ccx_2.10/src/timepointss.f
diff --git a/ccx_2.10/src/timer.f b/ccx_2.10/src/timer.f
new file mode 100644
index 0000000..5535ccf
--- /dev/null
+++ b/ccx_2.10/src/timer.f
@@ -0,0 +1,32 @@
+c
+c L-BFGS-B is released under the “New BSD License” (aka “Modified BSD License”
+c or “3-clause license”)
+c Please read attached file License.txt
+c
+ subroutine timer(ttime)
+ double precision ttime
+c
+ real temp
+c
+c This routine computes cpu time in double precision; it makes use of
+c the intrinsic f90 cpu_time therefore a conversion type is
+c needed.
+c
+c J.L Morales Departamento de Matematicas,
+c Instituto Tecnologico Autonomo de Mexico
+c Mexico D.F.
+c
+c J.L Nocedal Department of Electrical Engineering and
+c Computer Science.
+c Northwestern University. Evanston, IL. USA
+c
+c January 21, 2011
+c
+ temp = sngl(ttime)
+ call cpu_time(temp)
+ ttime = dble(temp)
+
+ return
+
+ end
+
diff --git a/ccx_2.9/src/transformatrix.f b/ccx_2.10/src/transformatrix.f
similarity index 100%
rename from ccx_2.9/src/transformatrix.f
rename to ccx_2.10/src/transformatrix.f
diff --git a/ccx_2.9/src/transformfs.f b/ccx_2.10/src/transformfs.f
similarity index 100%
rename from ccx_2.9/src/transformfs.f
rename to ccx_2.10/src/transformfs.f
diff --git a/ccx_2.9/src/transforms.f b/ccx_2.10/src/transforms.f
similarity index 100%
rename from ccx_2.9/src/transforms.f
rename to ccx_2.10/src/transforms.f
diff --git a/ccx_2.9/src/treatmasterface.f b/ccx_2.10/src/treatmasterface.f
similarity index 100%
rename from ccx_2.9/src/treatmasterface.f
rename to ccx_2.10/src/treatmasterface.f
diff --git a/ccx_2.9/src/trianeighbor.f b/ccx_2.10/src/trianeighbor.f
similarity index 100%
rename from ccx_2.9/src/trianeighbor.f
rename to ccx_2.10/src/trianeighbor.f
diff --git a/ccx_2.9/src/triangucont.f b/ccx_2.10/src/triangucont.f
similarity index 92%
rename from ccx_2.9/src/triangucont.f
rename to ccx_2.10/src/triangucont.f
index eaa70cb..a5f19b3 100644
--- a/ccx_2.9/src/triangucont.f
+++ b/ccx_2.10/src/triangucont.f
@@ -34,7 +34,7 @@
integer ncont,ntie,i,j,k,l,nset,istartset(*),iendset(*),
& ialset(*),itrifac9(3,8),itrifac7(3,6),
& iright,itietri(2,ntie),nelem,jface,indexe,ipkon(*),nope,m,one,
- & ifaceq(9,6),ifacet(7,4),ifacew1(4,5),ifacew2(8,5),node,ilen,
+ & ifaceq(8,6),ifacet(6,4),ifacew1(4,5),ifacew2(8,5),node,ilen,
& ntrifac,itrifac3(3,1),itrifac4(3,2),itrifac6(3,4),itrifac8(3,6),
& itrifac(3,6),nnodelem,nface,nodef(9),kon(*),koncont(4,*),nk,
& ncontini
@@ -43,19 +43,19 @@
!
! nodes per face for hex elements
!
- data ifaceq /4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/
+ data ifaceq /4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/
!
! nodes per face for tet elements
!
- data ifacet /1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/
+ data ifacet /1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/
!
! nodes per face for linear wedge elements
!
@@ -134,18 +134,12 @@
if(lakon(nelem)(4:5).eq.'20') then
nnodelem=8
nface=6
- elseif(lakon(nelem)(4:4).eq.'2') then
- nnodelem=9
- nface=6
elseif(lakon(nelem)(4:4).eq.'8') then
nnodelem=4
nface=6
elseif(lakon(nelem)(4:5).eq.'10') then
nnodelem=6
nface=4
- elseif(lakon(nelem)(4:5).eq.'14') then
- nnodelem=7
- nface=4
elseif(lakon(nelem)(4:4).eq.'4') then
nnodelem=3
nface=4
diff --git a/ccx_2.9/src/triangulate.f b/ccx_2.10/src/triangulate.f
similarity index 94%
rename from ccx_2.9/src/triangulate.f
rename to ccx_2.10/src/triangulate.f
index 2e7d71c..483c4d8 100644
--- a/ccx_2.9/src/triangulate.f
+++ b/ccx_2.10/src/triangulate.f
@@ -33,7 +33,7 @@
character*8 lakon(*)
!
integer jcs(*),l,j,ics(*),nodef(8),ifacetet(*),
- & nrcg(*),node,ncsnodes,id,ifaceq(9,6),ifacet(7,4),
+ & nrcg(*),node,ncsnodes,id,ifaceq(8,6),ifacet(6,4),
& ifacew1(4,5),iface(8,6),nodelem(20),nnodelem,nzcg(*),
& itrifac3(3,1),itrifac4(3,2),itrifac6(3,4),itrifac8(3,6),
& itrifac(3,6),ifacew2(8,5),lcs(*),inodface(*),nnodface,
@@ -45,19 +45,19 @@
!
! nodes per face for hex elements
!
- data ifaceq /4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/
+ data ifaceq /4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/
!
! nodes per face for tet elements
!
- data ifacet /1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/
+ data ifacet /1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/
!
! nodes per face for linear wedge elements
!
diff --git a/ccx_2.9/src/triloc.f b/ccx_2.10/src/triloc.f
similarity index 100%
rename from ccx_2.9/src/triloc.f
rename to ccx_2.10/src/triloc.f
diff --git a/ccx_2.9/src/ts_calc.f b/ccx_2.10/src/ts_calc.f
similarity index 100%
rename from ccx_2.9/src/ts_calc.f
rename to ccx_2.10/src/ts_calc.f
diff --git a/ccx_2.9/src/tt_calc.f b/ccx_2.10/src/tt_calc.f
similarity index 100%
rename from ccx_2.9/src/tt_calc.f
rename to ccx_2.10/src/tt_calc.f
diff --git a/ccx_2.9/src/two_phase_flow.f b/ccx_2.10/src/two_phase_flow.f
similarity index 100%
rename from ccx_2.9/src/two_phase_flow.f
rename to ccx_2.10/src/two_phase_flow.f
diff --git a/ccx_2.9/src/twodint.f b/ccx_2.10/src/twodint.f
similarity index 100%
rename from ccx_2.9/src/twodint.f
rename to ccx_2.10/src/twodint.f
diff --git a/ccx_2.9/src/u_calloc.c b/ccx_2.10/src/u_calloc.c
similarity index 100%
rename from ccx_2.9/src/u_calloc.c
rename to ccx_2.10/src/u_calloc.c
diff --git a/ccx_2.9/src/u_free.c b/ccx_2.10/src/u_free.c
similarity index 100%
rename from ccx_2.9/src/u_free.c
rename to ccx_2.10/src/u_free.c
diff --git a/ccx_2.9/src/u_realloc.c b/ccx_2.10/src/u_realloc.c
similarity index 100%
rename from ccx_2.9/src/u_realloc.c
rename to ccx_2.10/src/u_realloc.c
diff --git a/ccx_2.9/src/uamplitude.f b/ccx_2.10/src/uamplitude.f
similarity index 100%
rename from ccx_2.9/src/uamplitude.f
rename to ccx_2.10/src/uamplitude.f
diff --git a/ccx_2.9/src/uboun.f b/ccx_2.10/src/uboun.f
similarity index 100%
rename from ccx_2.9/src/uboun.f
rename to ccx_2.10/src/uboun.f
diff --git a/ccx_2.9/src/ufaceload.f b/ccx_2.10/src/ufaceload.f
similarity index 100%
rename from ccx_2.9/src/ufaceload.f
rename to ccx_2.10/src/ufaceload.f
diff --git a/ccx_2.9/src/uhardening.f b/ccx_2.10/src/uhardening.f
similarity index 100%
rename from ccx_2.9/src/uhardening.f
rename to ccx_2.10/src/uhardening.f
diff --git a/ccx_2.9/src/umat.f b/ccx_2.10/src/umat.f
similarity index 100%
rename from ccx_2.9/src/umat.f
rename to ccx_2.10/src/umat.f
diff --git a/ccx_2.9/src/umat_abaqus.f b/ccx_2.10/src/umat_abaqus.f
similarity index 100%
rename from ccx_2.9/src/umat_abaqus.f
rename to ccx_2.10/src/umat_abaqus.f
diff --git a/ccx_2.9/src/umat_abaqusnl.f b/ccx_2.10/src/umat_abaqusnl.f
similarity index 100%
rename from ccx_2.9/src/umat_abaqusnl.f
rename to ccx_2.10/src/umat_abaqusnl.f
diff --git a/ccx_2.9/src/umat_aniso_creep.f b/ccx_2.10/src/umat_aniso_creep.f
similarity index 100%
rename from ccx_2.9/src/umat_aniso_creep.f
rename to ccx_2.10/src/umat_aniso_creep.f
diff --git a/ccx_2.9/src/umat_aniso_plas.f b/ccx_2.10/src/umat_aniso_plas.f
similarity index 100%
rename from ccx_2.9/src/umat_aniso_plas.f
rename to ccx_2.10/src/umat_aniso_plas.f
diff --git a/ccx_2.9/src/umat_ciarlet_el.f b/ccx_2.10/src/umat_ciarlet_el.f
similarity index 100%
rename from ccx_2.9/src/umat_ciarlet_el.f
rename to ccx_2.10/src/umat_ciarlet_el.f
diff --git a/ccx_2.9/src/umat_compression_only.f b/ccx_2.10/src/umat_compression_only.f
similarity index 100%
rename from ccx_2.9/src/umat_compression_only.f
rename to ccx_2.10/src/umat_compression_only.f
diff --git a/ccx_2.9/src/umat_elastic_fiber.f b/ccx_2.10/src/umat_elastic_fiber.f
similarity index 100%
rename from ccx_2.9/src/umat_elastic_fiber.f
rename to ccx_2.10/src/umat_elastic_fiber.f
diff --git a/ccx_2.9/src/umat_ideal_gas.f b/ccx_2.10/src/umat_ideal_gas.f
similarity index 100%
rename from ccx_2.9/src/umat_ideal_gas.f
rename to ccx_2.10/src/umat_ideal_gas.f
diff --git a/ccx_2.9/src/umat_lin_iso_el.f b/ccx_2.10/src/umat_lin_iso_el.f
similarity index 100%
rename from ccx_2.9/src/umat_lin_iso_el.f
rename to ccx_2.10/src/umat_lin_iso_el.f
diff --git a/ccx_2.9/src/umat_main.f b/ccx_2.10/src/umat_main.f
similarity index 100%
rename from ccx_2.9/src/umat_main.f
rename to ccx_2.10/src/umat_main.f
diff --git a/ccx_2.9/src/umat_single_crystal.f b/ccx_2.10/src/umat_single_crystal.f
similarity index 100%
rename from ccx_2.9/src/umat_single_crystal.f
rename to ccx_2.10/src/umat_single_crystal.f
diff --git a/ccx_2.9/src/umat_single_crystal_creep.f b/ccx_2.10/src/umat_single_crystal_creep.f
similarity index 100%
rename from ccx_2.9/src/umat_single_crystal_creep.f
rename to ccx_2.10/src/umat_single_crystal_creep.f
diff --git a/ccx_2.9/src/umat_tension_only.f b/ccx_2.10/src/umat_tension_only.f
similarity index 100%
rename from ccx_2.9/src/umat_tension_only.f
rename to ccx_2.10/src/umat_tension_only.f
diff --git a/ccx_2.9/src/umat_user.f b/ccx_2.10/src/umat_user.f
similarity index 100%
rename from ccx_2.9/src/umat_user.f
rename to ccx_2.10/src/umat_user.f
diff --git a/ccx_2.9/src/umatht.f b/ccx_2.10/src/umatht.f
similarity index 95%
rename from ccx_2.9/src/umatht.f
rename to ccx_2.10/src/umatht.f
index 6e2711a..f31a02d 100644
--- a/ccx_2.9/src/umatht.f
+++ b/ccx_2.10/src/umatht.f
@@ -116,22 +116,22 @@
! an example for combined mechanical-lubrication problems.
! Please replace it by your own code for your concrete application.
!
- integer ifaceq(9,6),ifacet(7,4),ifacew(8,5),ig,nelem,nopes,
+ integer ifaceq(8,6),ifacet(6,4),ifacew(8,5),ig,nelem,nopes,
& iflag,i,j,nope,node,idof,id
!
real*8 xl21(3,9),xi,et,al,rho,um,h,pnode1(3),pnode2(3),
& ratio(9),dist,xl22(3,9)
!
- data ifaceq /4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/
- data ifacet /1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/
+ data ifaceq /4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/
+ data ifacet /1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/
data ifacew /1,3,2,9,8,7,0,0,
& 4,5,6,10,11,12,0,0,
& 1,2,5,4,7,14,10,13,
diff --git a/ccx_2.9/src/umpc_dist.f b/ccx_2.10/src/umpc_dist.f
similarity index 100%
rename from ccx_2.9/src/umpc_dist.f
rename to ccx_2.10/src/umpc_dist.f
diff --git a/ccx_2.9/src/umpc_gap.f b/ccx_2.10/src/umpc_gap.f
similarity index 100%
rename from ccx_2.9/src/umpc_gap.f
rename to ccx_2.10/src/umpc_gap.f
diff --git a/ccx_2.9/src/umpc_mean_rot.f b/ccx_2.10/src/umpc_mean_rot.f
similarity index 100%
rename from ccx_2.9/src/umpc_mean_rot.f
rename to ccx_2.10/src/umpc_mean_rot.f
diff --git a/ccx_2.9/src/umpc_user.f b/ccx_2.10/src/umpc_user.f
similarity index 100%
rename from ccx_2.9/src/umpc_user.f
rename to ccx_2.10/src/umpc_user.f
diff --git a/ccx_2.9/src/uncouptempdisps.f b/ccx_2.10/src/uncouptempdisps.f
similarity index 100%
rename from ccx_2.9/src/uncouptempdisps.f
rename to ccx_2.10/src/uncouptempdisps.f
diff --git a/ccx_2.9/src/updatecont.f b/ccx_2.10/src/updatecont.f
similarity index 100%
rename from ccx_2.9/src/updatecont.f
rename to ccx_2.10/src/updatecont.f
diff --git a/ccx_2.9/src/updatecont2d.f b/ccx_2.10/src/updatecont2d.f
similarity index 100%
rename from ccx_2.9/src/updatecont2d.f
rename to ccx_2.10/src/updatecont2d.f
diff --git a/ccx_2.9/src/updatecontpen.f b/ccx_2.10/src/updatecontpen.f
similarity index 83%
rename from ccx_2.9/src/updatecontpen.f
rename to ccx_2.10/src/updatecontpen.f
index fc6754d..2acb547 100644
--- a/ccx_2.9/src/updatecontpen.f
+++ b/ccx_2.10/src/updatecontpen.f
@@ -33,7 +33,7 @@
& nmastnode(*),ntie,imast,iplaneaxial,noeq,
& istartset(*),iendset(*),ialset(*),ifacem,nelemm,
& jfacem,indexe,ipkon(*),nopem,nope,konl(26),kon(*),m,
- & ifaceq(9,6),ifacet(7,4),ifacew1(4,5),
+ & ifaceq(8,6),ifacet(6,4),ifacew1(4,5),
& ifacew2(8,5),id,index1,indexnode(9),l,iflag,nset,itriact,
& ipos,ntrifaces,noeq4(2),noeq8(6),mcs,ics(*),icyc(3),
& istart,ilength,noeq9(8)
@@ -44,19 +44,19 @@
!
! nodes per face for hex elements
!
- data ifaceq /4,3,2,1,11,10,9,12,21,
- & 5,6,7,8,13,14,15,16,22,
- & 1,2,6,5,9,18,13,17,23,
- & 2,3,7,6,10,19,14,18,24,
- & 3,4,8,7,11,20,15,19,25,
- & 4,1,5,8,12,17,16,20,26/
+ data ifaceq /4,3,2,1,11,10,9,12,
+ & 5,6,7,8,13,14,15,16,
+ & 1,2,6,5,9,18,13,17,
+ & 2,3,7,6,10,19,14,18,
+ & 3,4,8,7,11,20,15,19,
+ & 4,1,5,8,12,17,16,20/
!
! nodes per face for tet elements
!
- data ifacet /1,3,2,7,6,5,11,
- & 1,2,4,5,9,8,12,
- & 2,3,4,6,10,9,13,
- & 1,4,3,8,10,7,14/
+ data ifacet /1,3,2,7,6,5,
+ & 1,2,4,5,9,8,
+ & 2,3,4,6,10,9,
+ & 1,4,3,8,10,7/
!
! nodes per face for linear wedge elements
!
@@ -152,15 +152,9 @@
elseif(lakon(nelemm)(4:5).eq.'20') then
nopem=8
nope=20
- elseif(lakon(nelemm)(4:4).eq.'2') then
- nopem=9
- nope=26
elseif(lakon(nelemm)(4:5).eq.'10') then
nopem=6
nope=10
- elseif(lakon(nelemm)(4:5).eq.'14') then
- nopem=7
- nope=14
elseif(lakon(nelemm)(4:4).eq.'4') then
nopem=3
nope=4
@@ -190,14 +184,14 @@
konl(k)=kon(ipkon(nelemm)+k)
enddo
!
- if((nope.eq.20).or.(nope.eq.8).or.(nope.eq.26)) then
+ if((nope.eq.20).or.(nope.eq.8)) then
do m=1,nopem
do k=1,3
xl2m(k,m)=co(k,konl(ifaceq(m,jfacem)))+
& vold(k,konl(ifaceq(m,jfacem)))
enddo
enddo
- elseif((nope.eq.10).or.(nope.eq.4).or.(nope.eq.14))
+ elseif((nope.eq.10).or.(nope.eq.4))
& then
do m=1,nopem
do k=1,3
@@ -223,35 +217,7 @@
! calculate the normal vector in the nodes belonging to the master surface
!
- if(nopem.eq.9) then
- do m=1,nopem
- xi=xquad(1,m)
- et=xquad(2,m)
- call shape9q(xi,et,xl2m,xsj2,xs2,shp2,iflag)
- dd=dsqrt(xsj2(1)*xsj2(1) + xsj2(2)*xsj2(2)
- & + xsj2(3)*xsj2(3))
- xsj2(1)=xsj2(1)/dd
- xsj2(2)=xsj2(2)/dd
- xsj2(3)=xsj2(3)/dd
-!
- if(nope.eq.26) then
- node=konl(ifaceq(m,jfacem))
- elseif(nope.eq.20) then
- node=konl(ifacew2(m,jfacem))
- endif
-!
- call nident(imastnode(nmastnode(i)+1),node,
- & nmastnode(i+1)-nmastnode(i),id)
- index1=nmastnode(i)+id
- indexnode(m)=index1
- xmastnor(1,index1)=xmastnor(1,index1)
- & +xsj2(1)
- xmastnor(2,index1)=xmastnor(2,index1)
- & +xsj2(2)
- xmastnor(3,index1)=xmastnor(3,index1)
- & +xsj2(3)
- enddo
- elseif(nopem.eq.8) then
+ if(nopem.eq.8) then
do m=1,nopem
xi=xquad(1,m)
et=xquad(2,m)
@@ -336,34 +302,6 @@
xmastnor(3,index1)=xmastnor(3,index1)
& +xsj2(3)
enddo
- elseif(nopem.eq.7) then
- do m=1,nopem
- xi=xtri(1,m)
- et=xtri(2,m)
- call shape7tri(xi,et,xl2m,xsj2,xs2,shp2,iflag)
- dd=dsqrt(xsj2(1)*xsj2(1) + xsj2(2)*xsj2(2)
- & + xsj2(3)*xsj2(3))
- xsj2(1)=xsj2(1)/dd
- xsj2(2)=xsj2(2)/dd
- xsj2(3)=xsj2(3)/dd
-!
- if(nope.eq.14) then
- node=konl(ifacet(m,jfacem))
- elseif(nope.eq.20) then
- node=konl(ifacew2(m,jfacem))
- endif
-!
- call nident(imastnode(nmastnode(i)+1),node,
- & nmastnode(i+1)-nmastnode(i),id)
- index1=nmastnode(i)+id
- indexnode(m)=index1
- xmastnor(1,index1)=xmastnor(1,index1)
- & +xsj2(1)
- xmastnor(2,index1)=xmastnor(2,index1)
- & +xsj2(2)
- xmastnor(3,index1)=xmastnor(3,index1)
- & +xsj2(3)
- enddo
else
do m=1,nopem
xi=xtri(1,m)
@@ -440,14 +378,10 @@
!
if(lakon(nelemm)(4:5).eq.'20') then
ntrifaces=6
- elseif(lakon(nelemm)(4:4).eq.'2') then
- ntrifaces=8
elseif(lakon(nelemm)(4:4).eq.'8') then
ntrifaces=2
elseif(lakon(nelemm)(4:5).eq.'10') then
ntrifaces=4
- elseif(lakon(nelemm)(4:5).eq.'14') then
- ntrifaces=6
elseif(lakon(nelemm)(4:4).eq.'4') then
ntrifaces=1
elseif(lakon(nelemm)(4:5).eq.'15') then
diff --git a/ccx_2.9/src/usermaterials.f b/ccx_2.10/src/usermaterials.f
similarity index 100%
rename from ccx_2.9/src/usermaterials.f
rename to ccx_2.10/src/usermaterials.f
diff --git a/ccx_2.9/src/usermpc.f b/ccx_2.10/src/usermpc.f
similarity index 100%
rename from ccx_2.9/src/usermpc.f
rename to ccx_2.10/src/usermpc.f
diff --git a/ccx_2.9/src/utemp.f b/ccx_2.10/src/utemp.f
similarity index 100%
rename from ccx_2.9/src/utemp.f
rename to ccx_2.10/src/utemp.f
diff --git a/ccx_2.9/src/utemp_ccxlib.f b/ccx_2.10/src/utemp_ccxlib.f
similarity index 100%
rename from ccx_2.9/src/utemp_ccxlib.f
rename to ccx_2.10/src/utemp_ccxlib.f
diff --git a/ccx_2.9/src/v_betrag.c b/ccx_2.10/src/v_betrag.c
similarity index 100%
rename from ccx_2.9/src/v_betrag.c
rename to ccx_2.10/src/v_betrag.c
diff --git a/ccx_2.9/src/v_prod.c b/ccx_2.10/src/v_prod.c
similarity index 100%
rename from ccx_2.9/src/v_prod.c
rename to ccx_2.10/src/v_prod.c
diff --git a/ccx_2.9/src/v_result.c b/ccx_2.10/src/v_result.c
similarity index 100%
rename from ccx_2.9/src/v_result.c
rename to ccx_2.10/src/v_result.c
diff --git a/ccx_2.9/src/valuesatinfinitys.f b/ccx_2.10/src/valuesatinfinitys.f
similarity index 100%
rename from ccx_2.9/src/valuesatinfinitys.f
rename to ccx_2.10/src/valuesatinfinitys.f
diff --git a/ccx_2.9/src/varbous.f b/ccx_2.10/src/varbous.f
similarity index 100%
rename from ccx_2.9/src/varbous.f
rename to ccx_2.10/src/varbous.f
diff --git a/ccx_2.9/src/viewfactors.f b/ccx_2.10/src/viewfactors.f
similarity index 100%
rename from ccx_2.9/src/viewfactors.f
rename to ccx_2.10/src/viewfactors.f
diff --git a/ccx_2.9/src/viscos.f b/ccx_2.10/src/viscos.f
similarity index 100%
rename from ccx_2.9/src/viscos.f
rename to ccx_2.10/src/viscos.f
diff --git a/ccx_2.9/src/vortex.f b/ccx_2.10/src/vortex.f
similarity index 100%
rename from ccx_2.9/src/vortex.f
rename to ccx_2.10/src/vortex.f
diff --git a/ccx_2.9/src/wcoef.f b/ccx_2.10/src/wcoef.f
similarity index 100%
rename from ccx_2.9/src/wcoef.f
rename to ccx_2.10/src/wcoef.f
diff --git a/ccx_2.9/src/wpi.f b/ccx_2.10/src/wpi.f
similarity index 100%
rename from ccx_2.9/src/wpi.f
rename to ccx_2.10/src/wpi.f
diff --git a/ccx_2.9/src/writeboun.f b/ccx_2.10/src/writeboun.f
similarity index 100%
rename from ccx_2.9/src/writeboun.f
rename to ccx_2.10/src/writeboun.f
diff --git a/ccx_2.9/src/writebv.f b/ccx_2.10/src/writebv.f
similarity index 100%
rename from ccx_2.9/src/writebv.f
rename to ccx_2.10/src/writebv.f
diff --git a/ccx_2.9/src/writecvg.f b/ccx_2.10/src/writecvg.f
similarity index 100%
rename from ccx_2.9/src/writecvg.f
rename to ccx_2.10/src/writecvg.f
diff --git a/ccx_2.9/src/writeev.f b/ccx_2.10/src/writeev.f
similarity index 100%
rename from ccx_2.9/src/writeev.f
rename to ccx_2.10/src/writeev.f
diff --git a/ccx_2.9/src/writeevcomplex.f b/ccx_2.10/src/writeevcomplex.f
similarity index 100%
rename from ccx_2.9/src/writeevcomplex.f
rename to ccx_2.10/src/writeevcomplex.f
diff --git a/ccx_2.9/src/writeevcs.f b/ccx_2.10/src/writeevcs.f
similarity index 100%
rename from ccx_2.9/src/writeevcs.f
rename to ccx_2.10/src/writeevcs.f
diff --git a/ccx_2.9/src/writeevcscomplex.f b/ccx_2.10/src/writeevcscomplex.f
similarity index 100%
rename from ccx_2.9/src/writeevcscomplex.f
rename to ccx_2.10/src/writeevcscomplex.f
diff --git a/ccx_2.9/src/writehe.f b/ccx_2.10/src/writehe.f
similarity index 100%
rename from ccx_2.9/src/writehe.f
rename to ccx_2.10/src/writehe.f
diff --git a/ccx_2.9/src/writeheading.c b/ccx_2.10/src/writeheading.c
similarity index 100%
rename from ccx_2.9/src/writeheading.c
rename to ccx_2.10/src/writeheading.c
diff --git a/ccx_2.9/src/writeim.f b/ccx_2.10/src/writeim.f
similarity index 100%
rename from ccx_2.9/src/writeim.f
rename to ccx_2.10/src/writeim.f
diff --git a/ccx_2.9/src/writeinput.f b/ccx_2.10/src/writeinput.f
similarity index 100%
rename from ccx_2.9/src/writeinput.f
rename to ccx_2.10/src/writeinput.f
diff --git a/ccx_2.9/src/writemac.f b/ccx_2.10/src/writemac.f
similarity index 100%
rename from ccx_2.9/src/writemac.f
rename to ccx_2.10/src/writemac.f
diff --git a/ccx_2.9/src/writemaccs.f b/ccx_2.10/src/writemaccs.f
similarity index 100%
rename from ccx_2.9/src/writemaccs.f
rename to ccx_2.10/src/writemaccs.f
diff --git a/ccx_2.9/src/writempc.f b/ccx_2.10/src/writempc.f
similarity index 100%
rename from ccx_2.9/src/writempc.f
rename to ccx_2.10/src/writempc.f
diff --git a/ccx_2.9/src/writepf.f b/ccx_2.10/src/writepf.f
similarity index 100%
rename from ccx_2.9/src/writepf.f
rename to ccx_2.10/src/writepf.f
diff --git a/ccx_2.9/src/writere.f b/ccx_2.10/src/writere.f
similarity index 100%
rename from ccx_2.9/src/writere.f
rename to ccx_2.10/src/writere.f
diff --git a/ccx_2.9/src/writesubmatrix.f b/ccx_2.10/src/writesubmatrix.f
similarity index 100%
rename from ccx_2.9/src/writesubmatrix.f
rename to ccx_2.10/src/writesubmatrix.f
diff --git a/ccx_2.9/src/writesummary.f b/ccx_2.10/src/writesummary.f
similarity index 100%
rename from ccx_2.9/src/writesummary.f
rename to ccx_2.10/src/writesummary.f
diff --git a/ccx_2.9/src/writesummarydiv.f b/ccx_2.10/src/writesummarydiv.f
similarity index 100%
rename from ccx_2.9/src/writesummarydiv.f
rename to ccx_2.10/src/writesummarydiv.f
diff --git a/ccx_2.9/src/writetetmesh.f b/ccx_2.10/src/writetetmesh.f
similarity index 100%
rename from ccx_2.9/src/writetetmesh.f
rename to ccx_2.10/src/writetetmesh.f
diff --git a/ccx_2.9/src/writevfa.f b/ccx_2.10/src/writevfa.f
similarity index 96%
rename from ccx_2.9/src/writevfa.f
rename to ccx_2.10/src/writevfa.f
index 22cdd36..add9eb6 100644
--- a/ccx_2.9/src/writevfa.f
+++ b/ccx_2.10/src/writevfa.f
@@ -31,7 +31,7 @@
iel=ielfa(1,i)
iel=nactdohinv(iel)
write(*,*) 'writevfa ',iel,ielfa(4,i),
- & vfa(1,i),vfa(2,i),vfa(3,i)
+ & vfa(0,i),vfa(1,i),vfa(2,i),vfa(3,i)
enddo
!
return
diff --git a/ccx_2.9/src/writeview.f b/ccx_2.10/src/writeview.f
similarity index 100%
rename from ccx_2.9/src/writeview.f
rename to ccx_2.10/src/writeview.f
diff --git a/ccx_2.9/src/wye.f b/ccx_2.10/src/wye.f
similarity index 100%
rename from ccx_2.9/src/wye.f
rename to ccx_2.10/src/wye.f
diff --git a/ccx_2.9/src/xlocal.f b/ccx_2.10/src/xlocal.f
similarity index 100%
rename from ccx_2.9/src/xlocal.f
rename to ccx_2.10/src/xlocal.f
diff --git a/ccx_2.9/src/zeta_calc.f b/ccx_2.10/src/zeta_calc.f
similarity index 100%
rename from ccx_2.9/src/zeta_calc.f
rename to ccx_2.10/src/zeta_calc.f
diff --git a/ccx_2.9/src/zienzhu.f b/ccx_2.10/src/zienzhu.f
similarity index 100%
rename from ccx_2.9/src/zienzhu.f
rename to ccx_2.10/src/zienzhu.f
diff --git a/ccx_2.9/src/attach.f b/ccx_2.9/src/attach.f
deleted file mode 100644
index ed70940..0000000
--- a/ccx_2.9/src/attach.f
+++ /dev/null
@@ -1,148 +0,0 @@
-!
-! CalculiX - A 3-dimensional finite element program
-! Copyright (C) 1998-2015 Guido Dhondt
-!
-! This program is free software; you can redistribute it and/or
-! modify it under the terms of the GNU General Public License as
-! published by the Free Software Foundation(version 2);
-!
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program; if not, write to the Free Software
-! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-!
- subroutine attach(pneigh,pnode,nterms,ratio,dist,xil,etl)
-!
-! ataches node with coordinates in "pnode" to the face containing
-! "nterms" nodes with coordinates in field "pneigh" (nterms < 9).
-! cave: the coordinates are stored in pneigh(1..3,*)
-!
- implicit none
-!
- integer nterms,i,j,k,imin,jmin
-!
- real*8 ratio(9),pneigh(3,9),pnode(3),dummy,
- & a(-1:1,-1:1),xi(-1:1,-1:1),et(-1:1,-1:1),p(3),aold(-1:1,-1:1),
- & xiold(-1:1,-1:1),etold(-1:1,-1:1),distmin,xiopt,etopt,
- & d1,dist,xil,etl
-!
- intent(in) pneigh,nterms
-!
- intent(inout) xil,etl,pnode,dist,ratio
-!
- d1=1.d0
- xi(0,0)=0.d0
- et(0,0)=0.d0
-!
- do k=1,8
-!
-! initialisation
-!
- d1=d1/10.d0
- xiopt=xi(0,0)
- etopt=et(0,0)
-!
- do i=-1,1
- do j=-1,1
- xi(i,j)=xiopt+i*d1
- et(i,j)=etopt+j*d1
- call distattach(xi(i,j),et(i,j),pneigh,pnode,a(i,j),p,
- & ratio,nterms)
- enddo
- enddo
-!
-! minimizing the distance from the face to the node
-!
- do
- distmin=a(0,0)
- imin=0
- jmin=0
- do i=-1,1
- do j=-1,1
- if(a(i,j).lt.distmin) then
- distmin=a(i,j)
- imin=i
- jmin=j
- endif
- enddo
- enddo
-!
-! exit if minimum found
-!
- if((imin.eq.0).and.(jmin.eq.0)) exit
-!
- do i=-1,1
- do j=-1,1
- aold(i,j)=a(i,j)
- xiold(i,j)=xi(i,j)
- etold(i,j)=et(i,j)
- enddo
- enddo
-!
- do i=-1,1
- do j=-1,1
- if((i+imin.ge.-1).and.(i+imin.le.1).and.
- & (j+jmin.ge.-1).and.(j+jmin.le.1)) then
- a(i,j)=aold(i+imin,j+jmin)
- xi(i,j)=xiold(i+imin,j+jmin)
- et(i,j)=etold(i+imin,j+jmin)
- else
- xi(i,j)=xi(i,j)+imin*d1
- et(i,j)=et(i,j)+jmin*d1
-!
- xi(i,j)=min(xi(i,j),1.d0)
- xi(i,j)=max(xi(i,j),-1.d0)
- et(i,j)=min(et(i,j),1.d0)
- et(i,j)=max(et(i,j),-1.d0)
-!
- call distattach(xi(i,j),et(i,j),pneigh,
- & pnode,a(i,j),p,ratio,nterms)
-!
- endif
- enddo
- enddo
- enddo
- enddo
-!
- call distattach(xi(0,0),et(0,0),pneigh,pnode,a(0,0),p,
- & ratio,nterms)
-!
- do i=1,3
- pnode(i)=p(i)
- enddo
-!
- dist=dsqrt(a(0,0))
-!
- if(nterms.eq.3) then
- xil=(xi(0,0)+1.d0)/2.d0
- etl=(et(0,0)+1.d0)/2.d0
- if(xil+etl.gt.1.d0) then
- dummy=xil
- xil=1.d0-etl
- etl=1.d0-dummy
- endif
- elseif(nterms.eq.4) then
- xil=xi(0,0)
- etl=et(0,0)
- elseif((nterms.eq.6).or.(nterms.eq.7)) then
- xil=(xi(0,0)+1.d0)/2.d0
- etl=(et(0,0)+1.d0)/2.d0
- if(xil+etl.gt.1.d0) then
- dummy=xil
- xil=1.d0-etl
- etl=1.d0-dummy
- endif
- elseif((nterms.eq.8).or.(nterms.eq.9)) then
- xil=xi(0,0)
- etl=et(0,0)
- endif
-!
-c write(*,*) 'end attach.f'
- return
- end
-
diff --git a/ccx_2.9/src/creeps.f b/ccx_2.9/src/creeps.f
deleted file mode 100644
index 30e3c6e..0000000
--- a/ccx_2.9/src/creeps.f
+++ /dev/null
@@ -1,357 +0,0 @@
-!
-! CalculiX - A 3-dimensional finite element program
-! Copyright (C) 1998-2015 Guido Dhondt
-!
-! This program is free software; you can redistribute it and/or
-! modify it under the terms of the GNU General Public License as
-! published by the Free Software Foundation(version 2);
-!
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program; if not, write to the Free Software
-! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-!
- subroutine creeps(inpc,textpart,nelcon,nmat,ntmat_,npmat_,
- & plicon,nplicon,elcon,iplas,iperturb,nstate_,ncmat_,
- & matname,irstrt,istep,istat,n,iline,ipol,inl,ipoinp,inp,
- & ipoinpc,ianisoplas)
-!
-! reading the input deck: *CREEP
-!
- implicit none
-!
- logical iso
-!
- character*1 inpc(*)
- character*80 matname(*)
- character*132 textpart(16)
-!
- integer nelcon(2,*),nmat,ntmat_,ntmat,istep,npmat_,nstate_,
- & n,key,i,j,iplas,iperturb(*),istat,nplicon(0:ntmat_,*),ncmat_,
- & k,id,irstrt,iline,ipol,inl,ipoinp(2,*),inp(3,*),ipoinpc(0:*),
- & ianisoplas
-!
- real*8 temperature,elcon(0:ncmat_,ntmat_,*),t1l,
- & plicon(0:2*npmat_,ntmat_,*)
-!
- iso=.true.
- ntmat=0
-!
- if((istep.gt.0).and.(irstrt.ge.0)) then
- write(*,*) '*ERROR reading *CREEP: *CREEP should be placed'
- write(*,*) ' before all step definitions'
- call exit(201)
- endif
-!
- if(nmat.eq.0) then
- write(*,*) '*ERROR reading *CREEP: *CREEP should be preceded'
- write(*,*) ' by a *MATERIAL card'
- call exit(201)
- endif
-!
-! check for anisotropic creep: assumes a ucreep routine
-!
- if((nelcon(1,nmat).ne.2).and.(nelcon(1,nmat).ne.-51)) then
- if((nelcon(1,nmat).ne.9).and.(nelcon(1,nmat).ne.-114)) then
- write(*,*) '*ERROR reading *CREEP: *CREEP should be'
- write(*,*) ' preceded by an *ELASTIC,TYPE=ISO card,'
- write(*,*) ' or an *ELASTIC,TYPE=ORTHO card'
- call exit(201)
- endif
-!
- ianisoplas=1
-!
- if(nelcon(1,nmat).ne.-114) then
-!
-! viscoplastic material with zero yield surface and
-! without hardening: no plasticity
-!
- iperturb(1)=3
-c iperturb(2)=1
-c write(*,*) '*INFO reading *CREEP: nonlinear geometric'
-c write(*,*) ' effects are turned on'
-c write(*,*)
- nelcon(1,nmat)=-114
- do i=2,n
- if(textpart(i)(1:8).eq.'LAW=USER') then
- nelcon(1,nmat)=-109
- exit
- endif
- enddo
- if(nelcon(1,nmat).eq.-109) then
-!
-! elastic orthotropic
-! no plasticity
-! user creep: -109
-!
- nstate_=max(nstate_,7)
- if(matname(nmat)(70:80).ne.' ') then
- write(*,*) '*ERROR reading *CREEP: the material name'
- write(*,*) ' for an elastically anisotropic'
- write(*,*) ' material with isotropic creep must'
- write(*,*) ' not exceed 69 characters'
- call exit(201)
- else
- do i=80,12,-1
- matname(nmat)(i:i)=matname(nmat)(i-11:i-11)
- enddo
-c matname(nmat)(12:80)=matname(nmat)(1:69)
- matname(nmat)(1:11)='ANISO_CREEP'
- endif
- call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
- & ipoinp,inp,ipoinpc)
- return
- else
-!
-! elastic orthotropic
-! no plasticity
-! Norton creep: -114
-!
- nstate_=max(nstate_,14)
- do i=1,nelcon(2,nmat)
- elcon(10,i,nmat)=0.d0
- elcon(11,i,nmat)=0.d0
- elcon(12,i,nmat)=0.d0
- enddo
- if(matname(nmat)(71:80).ne.' ') then
- write(*,*) '*ERROR reading *CREEP: the material name'
- write(*,*) ' for an elastically anisotropic'
- write(*,*) ' material with Norton creep'
- write(*,*) ' must not exceed 70 characters'
- call exit(201)
- else
- do i=80,11,-1
- matname(nmat)(i:i)=matname(nmat)(i-10:i-10)
- enddo
-c matname(nmat)(11:80)=matname(nmat)(1:70)
- matname(nmat)(1:10)='ANISO_PLAS'
- endif
- endif
- else
-!
-! elastic orthotropic
-! plasticity
-! Norton creep: -114 (user creep is not allowed)
-!
- do i=2,n
- if(textpart(i)(1:8).eq.'LAW=USER') then
- write(*,*) '*ERROR reading *CREEP: for an elastically'
- write(*,*) ' anisotropic material with von'
- write(*,*) ' Mises plasticity only Norton creep'
- write(*,*) ' is allowed (no user subroutine)'
- call exit(201)
- endif
- enddo
- endif
- endif
-!
-! if the *CREEP card is not preceded by a *PLASTIC card, a zero
-! yield surface is assumed
-!
- if(nelcon(1,nmat).ne.-114) then
-!
-! elastic isotropic
-! plasticity or no plasticity
-! creep (Norton or user): -52
-!
- if(nelcon(1,nmat).ne.-51) then
-!
-! elastic isotropic
-! no plasticity -> zero yield plasticity
-! creep (Norton or user)
-!
- nplicon(0,nmat)=1
- nplicon(1,nmat)=2
- plicon(0,1,nmat)=0.d0
- plicon(1,1,nmat)=0.d0
- plicon(2,1,nmat)=0.d0
- plicon(3,1,nmat)=0.d0
- plicon(4,1,nmat)=10.d10
- endif
-!
- iperturb(1)=3
-c iperturb(2)=1
-c write(*,*) '*INFO reading *CREEP: nonlinear geometric'
-c write(*,*) ' effects are turned on'
-c write(*,*)
- iplas=1
- nelcon(1,nmat)=-52
- nstate_=max(nstate_,13)
-!
- do i=2,n
- if(textpart(i)(1:8).eq.'LAW=USER') then
- do j=1,nelcon(2,nmat)
- elcon(3,j,nmat)=-1.d0
- enddo
- call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
- & ipoinp,inp,ipoinpc)
- return
- else
- write(*,*)
- & '*WARNING reading *CREEP: parameter not recognized:'
- write(*,*) ' ',
- & textpart(i)(1:index(textpart(i),' ')-1)
- call inputwarning(inpc,ipoinpc,iline,
- &"*CREEP%")
- endif
- enddo
-!
-! before interpolation: data are stored in positions 6-9:
-! A,n,m,temperature
-! after interpolation: data are stored in positions 3-5:
-! A,n,m
-!
- do
- call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
- & ipoinp,inp,ipoinpc)
- if((istat.lt.0).or.(key.eq.1)) exit
- ntmat=ntmat+1
- if(ntmat.gt.ntmat_) then
- write(*,*) '*ERROR reading *CREEP: increase ntmat_'
- call exit(201)
- endif
- do i=1,3
- read(textpart(i)(1:20),'(f20.0)',iostat=istat)
- & elcon(i+5,ntmat,nmat)
- if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
- &"*CREEP%")
- enddo
- if(elcon(6,ntmat,nmat).le.0.d0) then
- write(*,*) '*ERROR reading *CREEP: parameter A'
- write(*,*) ' in the Norton law is nonpositive'
- call exit(201)
- endif
- if(elcon(7,ntmat,nmat).le.0.d0) then
- write(*,*) '*ERROR reading *CREEP: parameter n'
- write(*,*) ' in the Norton law is nonpositive'
- call exit(201)
- endif
- if(textpart(4)(1:1).ne.' ') then
- read(textpart(4)(1:20),'(f20.0)',iostat=istat)
- & temperature
- if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
- &"*CREEP%")
- else
- temperature=0.d0
- endif
- elcon(9,ntmat,nmat)=temperature
- enddo
-!
- if(ntmat.eq.0) then
- write(*,*) '*ERROR reading *CREEP: Norton law assumed,'
- write(*,*) ' yet no constants given'
- call exit(201)
- endif
-!
-! interpolating the creep data at the elastic temperature
-! data points
-!
- do i=1,nelcon(2,nmat)
- t1l=elcon(0,i,nmat)
- call ident2(elcon(9,1,nmat),t1l,ntmat,ncmat_+1,id)
- if(ntmat.eq.0) then
- continue
- elseif((ntmat.eq.1).or.(id.eq.0)) then
- elcon(3,i,nmat)=elcon(6,1,nmat)
- elcon(4,i,nmat)=elcon(7,1,nmat)
- elcon(5,i,nmat)=elcon(8,1,nmat)
- elseif(id.eq.ntmat) then
- elcon(3,i,nmat)=elcon(6,id,nmat)
- elcon(4,i,nmat)=elcon(7,id,nmat)
- elcon(5,i,nmat)=elcon(8,id,nmat)
- else
- do k=3,5
- elcon(k,i,nmat)=elcon(k+3,id,nmat)+
- & (elcon(k+3,id+1,nmat)-elcon(k+3,id,nmat))*
- & (t1l-elcon(9,id,nmat))/
- & (elcon(9,id+1,nmat)-elcon(9,id,nmat))
- enddo
- endif
- enddo
-!
- else
-!
-! elastically anisotropic material with isotropic viscoplasticity
-! (i.e. isotropic plasticity with Norton creep)
-!
- do
- call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
- & ipoinp,inp,ipoinpc)
- if((istat.lt.0).or.(key.eq.1)) exit
- ntmat=ntmat+1
- if(ntmat.gt.ntmat_) then
- write(*,*) '*ERROR reading *CREEP: increase ntmat_'
- call exit(201)
- endif
- do i=1,3
- read(textpart(i)(1:20),'(f20.0)',iostat=istat)
- & elcon(i+15,ntmat,nmat)
- if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
- &"*CREEP%")
- enddo
- if(textpart(3)(1:1).ne.' ') then
- read(textpart(3)(1:20),'(f20.0)',iostat=istat)
- & temperature
- if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
- &"*CREEP%")
- else
- temperature=0.d0
- endif
- elcon(19,ntmat,nmat)=temperature
- enddo
-!
-! interpolating the creep data at the elastic temperature
-! data points
-!
-! before interpolation: data are stored in positions 16-19:
-! A,n,m,temperature
-! after interpolation: data are stored in positions 13-15:
-! A,n,m
-!
- if(ntmat.eq.0) then
- write(*,*) '*ERROR reading *CREEP: Norton law assumed,'
- write(*,*) ' yet no constants given'
- call exit(201)
- endif
-!
- do i=1,nelcon(2,nmat)
- t1l=elcon(0,i,nmat)
- call ident2(elcon(19,1,nmat),t1l,ntmat,ncmat_+1,id)
- if(ntmat.eq.0) then
- continue
- elseif((ntmat.eq.1).or.(id.eq.0)) then
- elcon(13,i,nmat)=elcon(16,1,nmat)
- elcon(14,i,nmat)=elcon(17,1,nmat)
- elcon(15,i,nmat)=elcon(18,1,nmat)
- elseif(id.eq.ntmat) then
- elcon(13,i,nmat)=elcon(16,id,nmat)
- elcon(14,i,nmat)=elcon(17,id,nmat)
- elcon(15,i,nmat)=elcon(18,id,nmat)
- else
- do k=13,15
- elcon(k,i,nmat)=elcon(k+3,id,nmat)+
- & (elcon(k+3,id+1,nmat)-elcon(k+3,id,nmat))*
- & (t1l-elcon(19,id,nmat))/
- & (elcon(19,id+1,nmat)-elcon(19,id,nmat))
- enddo
- endif
- enddo
-!
- endif
-!
-c if(nelcon(1,nmat).eq.-114) then
-c write(*,*) 'anisotropic elasticity+viscoplasticity'
-c do i=1,nelcon(2,nmat)
-c write(*,*) (elcon(j,i,nmat),j=0,14)
-c enddo
-cc call exit(201)
-c endif
-!
- return
- end
-
diff --git a/ccx_2.9/src/date.pl b/ccx_2.9/src/date.pl
deleted file mode 100755
index e18595e..0000000
--- a/ccx_2.9/src/date.pl
+++ /dev/null
@@ -1,14 +0,0 @@
-#!/usr/bin/perl
-
-chomp($date=`date`);
-
-# inserting the date into ccx_2.9.c
-
- at ARGV="ccx_2.9.c";
-$^I=".old";
-while(<>){
- s/You are using an executable made on.*/You are using an executable made on $date\\n");/g;
- print;
-}
-
-system "rm -f ccx_2.9.c.old";
diff --git a/ccx_2.9/src/distattach.f b/ccx_2.9/src/distattach.f
deleted file mode 100644
index 4938d72..0000000
--- a/ccx_2.9/src/distattach.f
+++ /dev/null
@@ -1,162 +0,0 @@
-!
-! CalculiX - A 3-dimensional finite element program
-! Copyright (C) 1998-2015 Guido Dhondt
-!
-! This program is free software; you can redistribute it and/or
-! modify it under the terms of the GNU General Public License as
-! published by the Free Software Foundation(version 2);
-!
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program; if not, write to the Free Software
-! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-!
- subroutine distattach(xig,etg,pneigh,pnode,a,p,ratio,nterms)
-!
-! calculates the distance between the node with coordinates
-! in "pnode" and the node with local coordinates xig and etg
-! in a face described by "nterms" nodes with coordinates
-! in pneigh
-!
- implicit none
-!
- integer nterms,i,j
-!
- real*8 ratio(9),pneigh(3,*),pnode(3),a,xi,et,xig,etg,p(3),
- & dummy,fxi1,fxi2,fxi3,fet1,fet2,fet3,b,xip,xim,etp,etm,
- & xim2,etm2
-!
- intent(in) xig,etg,pneigh,pnode,nterms
-!
- intent(inout) ratio,a,p
-!
- if(nterms.eq.3) then
- xi=(xig+1.d0)/2.d0
- et=(etg+1.d0)/2.d0
- if(xi+et.gt.1.d0) then
- dummy=xi
- xi=1.d0-et
- et=1.d0-dummy
- endif
- ratio(1)=1.d0-xi-et
- ratio(2)=xi
- ratio(3)=et
- elseif(nterms.eq.4) then
-c xi=xig
-c et=etg
-c ratio(1)=(1.d0-xi)*(1.d0-et)/4.d0
-c ratio(2)=(1.d0+xi)*(1.d0-et)/4.d0
-c ratio(3)=(1.d0+xi)*(1.d0+et)/4.d0
-c ratio(4)=(1.d0-xi)*(1.d0+et)/4.d0
- xip=1.d0+xig
- xim=1.d0-xig
- etp=1.d0+etg
- etm=1.d0-etg
- ratio(1)=xim*etm/4.d0
- ratio(2)=xip*etm/4.d0
- ratio(3)=xip*etp/4.d0
- ratio(4)=xim*etp/4.d0
- elseif(nterms.eq.6) then
- xi=(xig+1.d0)/2.d0
- et=(etg+1.d0)/2.d0
- if(xi+et.gt.1.d0) then
- dummy=xi
- xi=1.d0-et
- et=1.d0-dummy
- endif
- a=1.d0-xi-et
- ratio(1)=a*(2.d0*a-1.d0)
- ratio(2)=xi*(2.d0*xi-1.d0)
- ratio(3)=et*(2.d0*et-1.d0)
- ratio(4)=4.d0*xi*a
- ratio(5)=4.d0*xi*et
- ratio(6)=4.d0*et*a
- elseif(nterms.eq.7) then
- xi=(xig+1.d0)/2.d0
- et=(etg+1.d0)/2.d0
- if(xi+et.gt.1.d0) then
- dummy=xi
- xi=1.d0-et
- et=1.d0-dummy
- endif
- a=1.d0-xi-et
- b=a*xi*et
- ratio(1)=a*(2.d0*a-1.d0)+3.d0*b
- ratio(2)=xi*(2.d0*xi-1.d0)+3.d0*b
- ratio(3)=et*(2.d0*et-1.d0)+3.d0*b
- ratio(4)=4.d0*xi*a-12.d0*b
- ratio(5)=4.d0*xi*et-12.d0*b
- ratio(6)=4.d0*et*a-12.d0*b
- ratio(7)=27.d0*b
- elseif(nterms.eq.8) then
-c xi=xig
-c et=etg
-c ratio(1)=(1.d0-xi)*(1.d0-et)*(-xi-et-1.d0)/4.d0
-c ratio(2)=(1.d0+xi)*(1.d0-et)*(xi-et-1.d0)/4.d0
-c ratio(3)=(1.d0+xi)*(1.d0+et)*(xi+et-1.d0)/4.d0
-c ratio(4)=(1.d0-xi)*(1.d0+et)*(-xi+et-1.d0)/4.d0
-c ratio(5)=(1.d0-xi*xi)*(1.d0-et)/2.d0
-c ratio(6)=(1.d0+xi)*(1.d0-et*et)/2.d0
-c ratio(7)=(1.d0-xi*xi)*(1.d0+et)/2.d0
-c ratio(8)=(1.d0-xi)*(1.d0-et*et)/2.d0
- xip=1.d0+xig
- xim=1.d0-xig
- xim2=xip*xim
- etp=1.d0+etg
- etm=1.d0-etg
- etm2=etp*etm
- ratio(1)=xim*etm*(-xig-etp)/4.d0
- ratio(2)=xip*etm*(xig-etp)/4.d0
- ratio(3)=xip*etp*(xig-etm)/4.d0
- ratio(4)=xim*etp*(-xig-etm)/4.d0
- ratio(5)=xim2*etm/2.d0
- ratio(6)=xip*etm2/2.d0
- ratio(7)=xim2*etp/2.d0
- ratio(8)=xim*etm2/2.d0
- elseif(nterms.eq.9) then
- xi=xig
- et=etg
-!
- fxi1=xi*(xi-1.d0)/2.d0
- fxi2=(1.d0-xi)*(1.d0+xi)
- fxi3=xi*(xi+1.d0)/2.d0
- fet1=et*(et-1.d0)/2.d0
- fet2=(1.d0-et)*(1.d0+et)
- fet3=et*(et+1.d0)/2.d0
- ratio(1)=fxi1*fet1
- ratio(2)=fxi3*fet1
- ratio(3)=fxi3*fet3
- ratio(4)=fxi1*fet3
- ratio(5)=fxi2*fet1
- ratio(6)=fxi3*fet2
- ratio(7)=fxi2*fet3
- ratio(8)=fxi1*fet2
- ratio(9)=fxi2*fet2
- else
- write(*,*) '*ERROR in distattach: case with ',nterms
- write(*,*) ' terms is not covered'
- call exit(201)
- endif
-!
-! calculating the position in the face
-!
- do i=1,3
- p(i)=0.d0
- do j=1,nterms
- p(i)=p(i)+ratio(j)*pneigh(i,j)
- enddo
- enddo
-!
-! calculating the distance
-!
- a=(pnode(1)-p(1))**2+(pnode(2)-p(2))**2+(pnode(3)-p(3))**2
-!
-c write(*,*) 'distattach.f xi,et,dist**2',xig,etg,a
- return
- end
-
diff --git a/ccx_2.9/src/objectives.f b/ccx_2.9/src/objectives.f
deleted file mode 100644
index 0104de8..0000000
--- a/ccx_2.9/src/objectives.f
+++ /dev/null
@@ -1,63 +0,0 @@
-!
-! CalculiX - A 3-dimensional finite element program
-! Copyright (C) 1998-2015 Guido Dhondt
-!
-! This program is free software; you can redistribute it and/or
-! modify it under the terms of the GNU General Public License as
-! published by the Free Software Foundation(version 2);
-!
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program; if not, write to the Free Software
-! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-!
- subroutine objectives(inpc,textpart,istep,istat,n,iline,ipol,inl,
- & ipoinp,inp,ipoinpc,objective)
-!
-! reading the input deck: *OBJECTIVE
-!
-! criteria: MASS
-! STRESS
-! EIGENFREQUENCY
-! DISPLACEMENT
-!
- implicit none
-!
- character*1 inpc(*)
- character*132 textpart(16)
- character*81 objective(3)
-!
- integer istep,istat,n,key,i,iline,ipol,inl,ipoinp(2,*),
- & inp(3,*),ipoinpc(0:*)
-!
- if(istep.lt.1) then
- write(*,*) '*ERROR reading *OBJECTIVE: *OBJECTIVE can
- &only be used within a SENSITIVITY STEP'
- call exit(201)
- endif
-!
- do i=2,n
- if(textpart(i)(1:9).eq.'CRITERIA=') then
- read(textpart(i)(10:85),'(a80)',iostat=istat)
- & objective(1)(1:80)
- elseif(textpart(i)(1:7).eq.'ENTITY=') then
- read(textpart(i)(8:85),'(a80)',iostat=istat)
- & objective(2)(1:80)
- elseif(textpart(i)(1:3).eq.'MIN') then
- read(textpart(i)(1:85),'(a80)',iostat=istat)
- & objective(3)(1:80)
- endif
- enddo
-!
- call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
- & ipoinp,inp,ipoinpc)
-!
-!
- return
- end
-
diff --git a/ccx_2.9/src/sensitivity.c b/ccx_2.9/src/sensitivity.c
deleted file mode 100644
index acc6fb0..0000000
--- a/ccx_2.9/src/sensitivity.c
+++ /dev/null
@@ -1,450 +0,0 @@
-/* CalculiX - A 3-dimensional finite element program */
-/* Copyright (C) 1998-2015 Guido Dhondt */
-
-/* This program is free software; you can redistribute it and/or */
-/* modify it under the terms of the GNU General Public License as */
-/* published by the Free Software Foundation(version 2); */
-/* */
-
-/* This program is distributed in the hope that it will be useful, */
-/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
-/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
-/* GNU General Public License for more details. */
-
-/* You should have received a copy of the GNU General Public License */
-/* along with this program; if not, write to the Free Software */
-/* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
-
-#include <stdio.h>
-#include <math.h>
-#include <stdlib.h>
-#include "CalculiX.h"
-#ifdef SPOOLES
- #include "spooles.h"
-#endif
-#ifdef SGI
- #include "sgi.h"
-#endif
-#ifdef TAUCS
- #include "tau.h"
-#endif
-#ifdef PARDISO
- #include "pardiso.h"
-#endif
-
-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 **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 *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, 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 description[13]=" ",*lakon=NULL;
-
- 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;
-
- double *stn=NULL,*v=NULL,*een=NULL,cam[5],*xstiff=NULL,*stiini=NULL,*tper,
- *f=NULL,*fn=NULL,qa[3],*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;
-
- /* variables introduced for sensitivity calculation */
-
- ITG ndesi,*ndirdesi=NULL,*nodedesi=NULL;
-
- double distmin,*dfextminds=NULL,*df=NULL;
-
-#ifdef SGI
- ITG token;
-#endif
-
- /* dummy arguments for the results call */
-
- double *veold=NULL,*accold=NULL,bet,gam,dtime,time,reltime=1.;
-
- icol=*icolp;irow=*irowp;
-
- kon=*konp;ipkon=*ipkonp;lakon=*lakonp;ielmat=*ielmatp;ener=*enerp;
- xstate=*xstatep;
-
- tper=&timepar[1];
-
- time=*tper;
- dtime=*tper;
-
- ne0=*ne;
-
- /* allocating a field for the definition of the designvariables */
-
- NNEW(ndirdesi,ITG,*nk);
- NNEW(nodedesi,ITG,*nk);
-
- /* determining the information of the designvariable set */
-
- FORTRAN(getdesiinfo,(set,istartset,iendset,ialset,nset,istep,
- mi,nactdof,&ndesi,ndirdesi,nodedesi,ntie,tieset));
-
- /* calculation of the smallest distance between nodes */
-
- FORTRAN(smalldist,(co,&distmin,lakon,ipkon,kon,ne));
-
- /* 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));
-
- /* 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(df,double,ndesi**neq);
- NNEW(stx,double,6*mi[0]**ne);
- NNEW(inum,ITG,*nk);
- 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,ndirdesi);
- 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);
- NNEW(dfextminds,double,ndesi**neq);
-
- NNEW(au,double,*nzs);
- nmethodl=*nmethod;
-
-
- 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,ad,au,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,
- &distmin,&ndesi,nodedesi,ndirdesi,dfextminds);
-
-
- /* determining the right hand side */
-
- NNEW(b,double,*neq);
- for(k=0;k<*neq;++k){
- b[k]=fext[k]-f[k];
- }
-
- /* for(k=0;k<neq[1];++k){printf("f2=%" ITGFORMAT ",%e\n",k,f[k]);}
- for(k=0;k<neq[1];++k){printf("fext2=%" ITGFORMAT ",%e\n",k,fext[k]);}
- for(k=0;k<neq[1];++k){printf("ad2=%" ITGFORMAT ",%e\n",k,ad[k]);}
- for(k=0;k<nzs[1];++k){printf("au2=%" ITGFORMAT ",%e\n",k,au[k]);}
- for(k=0;k<neq[1];++k){printf("b2=%" ITGFORMAT ",%e\n",k,b[k]);} */
-
- SFREE(fext);SFREE(f);
-
- /* generation of a substructure stiffness matrix */
-
- if(*nmethod!=0){
-
- 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
- }
-
- 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(df,double,ndesi**neq);
- 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(enerini,double,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,ndirdesi);
-
- SFREE(eei);
- if(*nener==1){
- SFREE(stiini);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);
- }
- 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,());
-
- }
-
- /* 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);}
-
- *icolp=icol;*irowp=irow;
-
- *konp=kon;*ipkonp=ipkon;*lakonp=lakon;*ielmatp=ielmat;*enerp=ener;
- *xstatep=xstate;
-
- (*ttime)+=(*tper);
-
- return;
-}
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-science/packages/calculix-ccx.git
More information about the debian-science-commits
mailing list