├── pardisolib ├── pardiso.lic ├── libpardiso600-GNU720-X86-64.so └── libpardiso600-GNU800-X86-64.so ├── src ├── GENERAL │ ├── nfunc.f │ ├── fclose.f │ ├── pexit.f │ ├── ivzero.f │ ├── rvscal.f │ ├── rvzero.f │ ├── tangen.f │ ├── rvsub.f │ ├── length.f │ ├── getgco.f │ ├── upconf.f │ ├── princ2.f │ ├── princ3.f │ ├── arrgo2.f │ ├── invf.f │ ├── rtv.f │ ├── nword.f │ ├── symta.f │ ├── intnum.f │ ├── logstr.f │ ├── arrgax.f │ ├── atasym.f │ ├── atsym.f │ ├── setbe.f │ ├── algor.f │ ├── greet.f │ ├── initia.f │ ├── intfor.f │ ├── rstchk.f │ ├── listra.f │ ├── defgra.f │ ├── leftcg.f │ └── rtsx.f ├── MATHS │ ├── dlgd2.f │ ├── exp2x.f │ ├── ddlgd2.f │ ├── scaprd.f │ ├── invmt3.f │ ├── rminve.f │ ├── lubksb.f │ ├── detm23.f │ ├── iso3.f │ ├── plfun.f │ ├── dplfun.f │ ├── podec2.f │ ├── spdec2.f │ ├── iso2.f │ ├── diso3.f │ ├── spdec3.f │ ├── ludcmp.f │ ├── gausel.f │ └── solqua.f ├── ELEMENTS │ ├── ext3.f │ ├── exq4fb.f │ ├── exq4.f │ ├── gaus1d.f │ ├── extnod.f │ ├── chkndb.f │ ├── sft3.f │ ├── sft7.f │ ├── exh8fb.f │ ├── sfq4fb.f │ ├── sfq4.f │ ├── ext7.f │ └── exh8.f ├── OGDEN │ ├── orogd.f │ └── swogd.f ├── DAMAGED_ELASTIC │ ├── ordmel.f │ ├── swdmel.f │ └── rddmel.f ├── ELASTIC │ ├── orel.f │ ├── tuel.f │ ├── rdel.f │ └── swel.f ├── DAMAGE │ └── ordama.f ├── MAXDIM.INC ├── VON_MISES │ ├── orvm.f │ └── tuvm.f ├── MOHR_COULOMB │ └── ormc.f ├── SOLVER │ └── solint.f ├── TRESCA │ ├── ortr.f │ └── cttrpn.f ├── VON_MISES_MIXED │ └── orvmmx.f ├── DRUCKER_PRAGER │ └── ordp.f ├── VON_MISES_MIXED_VISCO │ └── orvvmx.f ├── CRYSTAL_ELASTO_MARTEN │ ├── taumep.f │ └── dtadfe.f └── ELEMENTS.INC ├── README.md └── CMakeLists.txt /pardisolib/pardiso.lic: -------------------------------------------------------------------------------- 1 | 3B51D7930E59B2465E1F34DF8776510174D088911DE83F43B96E5971 2 | -------------------------------------------------------------------------------- /pardisolib/libpardiso600-GNU720-X86-64.so: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/chennachaos/rveplas/HEAD/pardisolib/libpardiso600-GNU720-X86-64.so -------------------------------------------------------------------------------- /pardisolib/libpardiso600-GNU800-X86-64.so: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/chennachaos/rveplas/HEAD/pardisolib/libpardiso600-GNU800-X86-64.so -------------------------------------------------------------------------------- /src/GENERAL/nfunc.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_INTEGER_FUNCTION NFUNC 2 | CDOC Simple integer calculation used in frontal slover 3 | CDOC 4 | INTEGER FUNCTION NFUNC(N1,N2) 5 | I = N1 6 | J = N2 7 | NF = (J*J-J)/2+I 8 | NFUNC=NF 9 | RETURN 10 | END 11 | CDOC END_INTEGER_FUNCTION NFUNC 12 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # rveplas 2 | The legacy HYPLAS code with multiscale modelling capabilities. 3 | 4 | The code has been developed using Intel Fortran compiler, and was using the Intel-specific library, MKL. 5 | 6 | I have modified the code so that it can be used with GNU Fortran compiler on personal computers. In the process, I have also fixed some bugs. 7 | 8 | The default solver now is MA41. 9 | -------------------------------------------------------------------------------- /src/GENERAL/fclose.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE FCLOSE 2 | CDOC Closes data file and results file 3 | CDOC 4 | SUBROUTINE FCLOSE 5 | C*********************************************************************** 6 | C CLOSES DATA AND RESULTS FILES 7 | C*********************************************************************** 8 | CLOSE(UNIT=15,STATUS='KEEP') 9 | CLOSE(UNIT=16,STATUS='KEEP') 10 | RETURN 11 | END 12 | CDOC END_SUBROUTINE FCLOSE 13 | -------------------------------------------------------------------------------- /src/GENERAL/pexit.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE PEXIT 2 | CDOC Aborts the execution of HYPLAS 3 | CDOC 4 | CDOC This routine closes the open files and stops the execution of 5 | CDOC HYPLAS, sending a message to the results file and to the standard 6 | CDOC output. It is called in emergency situations when a irrecoverable 7 | CDOC error occurs. 8 | CDOC 9 | SUBROUTINE PEXIT 10 | C Print message 11 | WRITE(*,'(///15X,A,///)')'Program HYPLAS aborted.' 12 | WRITE(16,'(///15X,A,///)')'Program HYPLAS aborted.' 13 | C Close files 14 | CALL FCLOSE 15 | C and exit program 16 | STOP ' ' 17 | END 18 | CDOC END_SUBROUTINE PEXIT 19 | -------------------------------------------------------------------------------- /src/GENERAL/ivzero.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE IVZERO 2 | CDOC Zero an integer array 3 | CDOC 4 | CDOC This routine initialises to zero the N components of the integer 5 | CDOC array argument IV. 6 | CDOC 7 | CDOC BEGIN_PARAMETERS 8 | CDOC INTEGER IV < Zeroed integer array. 9 | CDOC INTEGER N > Dimension of IV. 10 | CDOC END_PARAMETERS 11 | CDOC 12 | SUBROUTINE IVZERO 13 | 1( IV ,N ) 14 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 15 | DIMENSION IV(N) 16 | C*********************************************************************** 17 | C INITIALISES TO ZERO AN INTEGER ARRAY OF DIMENSION N 18 | C*********************************************************************** 19 | DO 10 I=1,N 20 | IV(I)=0 21 | 10 CONTINUE 22 | RETURN 23 | END 24 | CDOC END_SUBROUTINE IVZERO 25 | -------------------------------------------------------------------------------- /src/GENERAL/rvscal.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE RVSCAL 2 | CDOC Multiplies a double precision vector by a scalar. 3 | CDOC 4 | CDOC BEGIN_PARAMETERS 5 | CDOC DOUBLE_PRECISION V <> Double precision vector. 6 | CDOC INTEGER N > Dimension of V. 7 | CDOC DOUBLE_PRECISION SCAL > Scalar by which V will be multiplied. 8 | CDOC END_PARAMETERS 9 | CDOC 10 | SUBROUTINE RVSCAL 11 | 1( V ,N ,SCAL ) 12 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 13 | DIMENSION V(N) 14 | C*********************************************************************** 15 | C MULTIPLIES THE DOUBLE PRECISION VECTOR 'V', OF DIMENSION 'N', 16 | C BY THE SCALAR 'SCAL' 17 | C*********************************************************************** 18 | DO 10 I=1,N 19 | V(I)=SCAL*V(I) 20 | 10 CONTINUE 21 | RETURN 22 | END 23 | CDOC END_SUBROUTINE RVSCAL 24 | -------------------------------------------------------------------------------- /src/GENERAL/rvzero.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE RVZERO 2 | CDOC Zero a double precision array 3 | CDOC 4 | CDOC This routine sets to zero the N components of the double precision 5 | CDOC array argument V. 6 | CDOC 7 | CDOC BEGIN_PARAMETERS 8 | CDOC DOUBLE_PRECISION V < Zeroed double precision array. 9 | CDOC INTEGER N > Dimension of V. 10 | CDOC END_PARAMETERS 11 | CDOC 12 | SUBROUTINE RVZERO 13 | 1( V ,N ) 14 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 15 | DIMENSION V(N) 16 | DATA R0/0.0D0/ 17 | C*********************************************************************** 18 | C INITIALISES TO ZERO A DOUBLE PRECISION ARRAY OF DIMENSION N 19 | C*********************************************************************** 20 | DO 10 I=1,N 21 | V(I)=R0 22 | 10 CONTINUE 23 | RETURN 24 | END 25 | CDOC END_SUBROUTINE RVZERO 26 | -------------------------------------------------------------------------------- /src/MATHS/dlgd2.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_DOUBLE_PRECISION_FUNCTION DLGD2 2 | CDOC dlg2(x)=log(x)/2 3 | CDOC 4 | CDOC This function relates the principal logarithmic stretches and the 5 | CDOC eigenvalues of the Cauchy-Green strain tensor. 6 | CDOC 7 | CDOC BEGIN_PARAMETERS 8 | CDOC DOUBLE_PRECISION X > Point at which the function will be 9 | CDOC C evaluated. 10 | CDOC END_PARAMETERS 11 | CHST 12 | CHST E.de Souza Neto, August 1996; Initial coding 13 | CHST 14 | DOUBLE PRECISION FUNCTION DLGD2(X) 15 | C 16 | DOUBLE PRECISION X 17 | DOUBLE PRECISION RP5 18 | DATA RP5 /0.5D0/ 19 | C*********************************************************************** 20 | C SCALAR FUNCTION THAT RELATES PRINCIPAL LOGARITHMIC STRECTHES AND 21 | C EIGENVALUES OF THE CAUCHY-GREEN TENSOR 22 | C 23 | C REFERENCE: Section 3.1.7 24 | C*********************************************************************** 25 | DLGD2=RP5*DLOG(X) 26 | C 27 | RETURN 28 | END 29 | CDOC END_DOUBLE_PRECISION_FUNCTION DLGD2 30 | -------------------------------------------------------------------------------- /src/MATHS/exp2x.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_DOUBLE_PRECISION_FUNCTION EXP2X 2 | CDOC f(x)=exp(2x) 3 | CDOC 4 | CDOC This function relates the eigenvalues of the Cauchy-Green strain 5 | CDOC tensors to the principal logarithmic stretches. 6 | CDOC 7 | CDOC BEGIN_PARAMETERS 8 | CDOC DOUBLE_PRECISION X > Point at which the function will be 9 | CDOC C evaluated. 10 | CDOC END_PARAMETERS 11 | CHST 12 | CHST E.de Souza Neto, August 1996: Initial coding 13 | CHST 14 | DOUBLE PRECISION FUNCTION EXP2X(X) 15 | C 16 | DOUBLE PRECISION X 17 | DOUBLE PRECISION R2 18 | DATA R2 /2.0D0/ 19 | C*********************************************************************** 20 | C SCALAR FUNCTION THAT RELATES EIGENVALUES OF THE CAUCHY-GREEN 21 | C TENSOR TO THE PRINCIPAL LOGARITHMIC STRECTHES 22 | C 23 | C REFERENCE: Section 3.1.7 24 | C*********************************************************************** 25 | EXP2X=DEXP(R2*X) 26 | C 27 | RETURN 28 | END 29 | CDOC END_DOUBLE_PRECISION_FUNCTION EXP2X 30 | -------------------------------------------------------------------------------- /src/MATHS/ddlgd2.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_DOUBLE_PRECISION_FUNCTION DDLGD2 2 | CDOC ddlg2(x)=1/(2x) 3 | CDOC 4 | CDOC This is the derivative of the function defined in DLGD2, 5 | CDOC that relates the principal logarithmic stretches and the 6 | CDOC eigenvalues of the Cauchy-Green strain tensor. 7 | CDOC 8 | CDOC BEGIN_PARAMETERS 9 | CDOC DOUBLE_PRECISION X > Point at which the function will be 10 | CDOC C evaluated. 11 | CDOC END_PARAMETERS 12 | CHST 13 | CHST E.de Souza Neto, August 1996: Initial coding 14 | CHST 15 | DOUBLE PRECISION FUNCTION DDLGD2(X) 16 | C 17 | DOUBLE PRECISION X 18 | DOUBLE PRECISION RP5 19 | DATA RP5 /0.5D0/ 20 | C*********************************************************************** 21 | C DERIVATIVE OF THE SCALAR FUNCTION 'DLGD2' THAT RELATES PRINCIPAL 22 | C LOGARITHMIC STRECTHES AND EIGENVALUES OF THE CAUCHY-GREEN TENSOR 23 | C*********************************************************************** 24 | DDLGD2=RP5/X 25 | C 26 | RETURN 27 | END 28 | CDOC END_DOUBLE_PRECISION_FUNCTION DDLGD2 29 | -------------------------------------------------------------------------------- /src/GENERAL/tangen.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE TANGEN 2 | CDOC Sets prescribed displacements for arc-length tangential solution. 3 | CDOC 4 | CDOC This routine sets the array of prescribed displacements as needed 5 | CDOC for the tangential solution of the Arc-Length Method. 6 | CHST 7 | CHST M.E.Honnor, April 1987 8 | CHST 9 | SUBROUTINE TANGEN 10 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 11 | C Hyplas database 12 | INCLUDE '../MAXDIM.INC' 13 | INCLUDE '../MATERIAL.INC' 14 | INCLUDE '../ELEMENTS.INC' 15 | INCLUDE '../GLBDBASE.INC' 16 | C 17 | DATA R0/0.0D0/ 18 | C*********************************************************************** 19 | C SETS UP PRESCRIBED DISPLACEMENTS FOR THE TANGENTIAL SOLUTION FOR 20 | C THE ARC-LENGTH METHOD 21 | C 22 | C REFERENCE: Item (iii), Box 4.4 23 | C*********************************************************************** 24 | DO 20 IVFIX=1,NVFIX 25 | NLOCA=(NOFIX(IVFIX)-1)*NDOFN 26 | DO 10 IDOFN=1,NDOFN 27 | NPOS=NLOCA+IDOFN 28 | FIXED(NPOS,1)=PRESC(IVFIX,IDOFN) 29 | FIXED(NPOS,2)=R0 30 | 10 CONTINUE 31 | 20 CONTINUE 32 | RETURN 33 | END 34 | CDOC END_SUBROUTINE TANGEN 35 | -------------------------------------------------------------------------------- /src/MATHS/scaprd.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_DOUBLE_PRECISION_FUNCTION SCAPRD 2 | CDOC Scalar product of double precision vectors 3 | CDOC 4 | CDOC This function returns the scalar product between its two double 5 | CDOC precision vector arguments U and V. 6 | CDOC 7 | CDOC BEGIN_PARAMETERS 8 | CDOC DOUBLE_PRECISION U > Array of components of a double 9 | CDOC C precision vector. 10 | CDOC DOUBLE_PRECISION V > Array of components of a double 11 | CDOC C precision vector. 12 | CDOC INTEGER N > Dimension of U and V. 13 | CDOC END_PARAMETERS 14 | CHST 15 | CHST E.de Souza Neto, May 1996: Initial coding 16 | CHST 17 | DOUBLE PRECISION FUNCTION SCAPRD(U ,V ,N ) 18 | C 19 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 20 | DIMENSION U(N), V(N) 21 | DATA R0 / 0.0D0 / 22 | C*********************************************************************** 23 | C SCALAR PRODUCT OF DOUBLE PRECISION VECTORS U AND V OF DIMENSION N 24 | C*********************************************************************** 25 | SCAPRD=R0 26 | DO 10 I=1,N 27 | SCAPRD=SCAPRD+U(I)*V(I) 28 | 10 CONTINUE 29 | RETURN 30 | END 31 | CDOC END_DOUBLE_PRECISION_FUNCTION SCAPRD 32 | -------------------------------------------------------------------------------- /src/GENERAL/rvsub.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE RVSUB 2 | CDOC Subtracts two double precision vectors 3 | CDOC 4 | CDOC This function subtracts two double precision vectors passed as 5 | CDOC arguments and stores the result in another vector U=V-W. 6 | CDOC 7 | CDOC BEGIN_PARAMETERS 8 | CDOC DOUBLE_PRECISION U < Double precision vector with the result 9 | CDOC C V-W. 10 | CDOC DOUBLE_PRECISION V > Double precision vector. 11 | CDOC DOUBLE_PRECISION W > Double precision vector. 12 | CDOC END_PARAMETERS 13 | CHST 14 | CHST E.de Souza Neto, September 1996: Initial coding 15 | CHST 16 | SUBROUTINE RVSUB 17 | 1( U ,V ,W ,N ) 18 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 19 | DIMENSION 20 | 1 U(N) ,V(N) ,W(N) 21 | C*********************************************************************** 22 | C SUBTRACTS THE VECTOR 'W' FROM THE VECTOR 'V' AND STORE THE RESULT 23 | C IN 'U'. U ,V AND W ARE DOUBLE PRECISION VECTORS OF DIMENSION N. 24 | C*********************************************************************** 25 | DO 10 I=1,N 26 | U(I)=V(I)-W(I) 27 | 10 CONTINUE 28 | RETURN 29 | END 30 | CDOC END_SUBROUTINE RVSUB 31 | -------------------------------------------------------------------------------- /src/ELEMENTS/ext3.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE EXT3 2 | CDOC Gauss point-node extrapolation matrix for element type TRI3 3 | CDOC 4 | CDOC This routine sets the coefficients matrix for extrapolation of 5 | CDOC fields from Gauss point values to nodal values for element type 6 | CDOC TRI3: Standard isoparametric 3-noded linear triangle. 7 | CDOC 8 | CDOC BEGIN_PARAMETERS 9 | CDOC DOUBLE_PRECISION EXMATX < Extrapolation matrix. 10 | CDOC END_PARAMETERS 11 | CHST 12 | CHST E.de Souza Neto, February 1997: Initial coding 13 | CHST 14 | SUBROUTINE EXT3 15 | 1( EXMATX ) 16 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 17 | PARAMETER(NNODE=3,NGAUSP=1) 18 | DIMENSION EXMATX(NNODE,NGAUSP) 19 | DATA R1 / 20 | 1 1.0D0 / 21 | C*********************************************************************** 22 | C SET COEFFICIENTS MATRIX (EXMATX) FOR EXTRAPOLATION FROM GAUSS POINTS 23 | C TO NODES FOR ELEMENT TYPE 'TRI_3' (STANDARD 3-NODED LINEAR TRIANGLE) 24 | C 25 | C REFERENCE: Section 5.6.1 26 | C E Hinton & JS Campbel. Local and global Smoothing of 27 | C discontinuous finite element functions using a least 28 | C squares method. Int. J. Num. meth. Engng., 8:461-480, 1974. 29 | C E Hinton & DRJ Owen. An introduction to finite element 30 | C computations. Pineridge Press, Swansea, 1979. 31 | C*********************************************************************** 32 | EXMATX(1,1)=R1 33 | EXMATX(2,1)=R1 34 | EXMATX(3,1)=R1 35 | C 36 | RETURN 37 | END 38 | CDOC END_SUBROUTINE EXT3 39 | -------------------------------------------------------------------------------- /src/GENERAL/length.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE LENGTH 2 | CDOC Adjusts step length for the Arc-Length Method. 3 | CDOC 4 | CDOC This subroutine adjusts the step length for the Arc-Length Method 5 | CDOC according to the prescribed desired number of iterations for 6 | CDOC equilibrium convergence and the actual number of iterations for 7 | CDOC convergence in the previous load step. 8 | CDOC 9 | CDOC BEGIN_PARAMETERS 10 | CDOC DOUBLE_PRECISION DLEN < Calculated step length. 11 | CDOC DOUBLE_PRECISION DLENM > Prescribed maximum permissible step 12 | CDOC C length. 13 | CDOC INTEGER ITACT > Actual number of iterations required for 14 | CDOC C convergence in the previous load step. 15 | CDOC INTEGER ITDES > Desired number of iterations for 16 | CDOC C convergence in the iterative solution of 17 | CDOC C the non-linear finite element 18 | CDOC C equilibrium equations. 19 | CDOC END_PARAMETERS 20 | CDOC 21 | SUBROUTINE LENGTH(DLENG ,DLENM ,ITACT ,ITDES ) 22 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 23 | C*********************************************************************** 24 | C ADJUSTS STEP LENGTH ACCORDING TO THE DESIRED NUMBER OF ITERATIONS AND 25 | C THE NUMBER OF ITERATIONS REQUIRED FOR CONVERGENCE IN THE PREVIOUS 26 | C LOAD STEP (USED FOR ARC-LENGTH METHOD ONLY) 27 | C 28 | C REFERENCE: Expression (5.3) 29 | C*********************************************************************** 30 | DLENG=DLENG*DBLE(ITDES)/DBLE(ITACT) 31 | DLENG=MIN(DLENG,DLENM) 32 | RETURN 33 | END 34 | CDOC END_SUBROUTINE LENGTH 35 | -------------------------------------------------------------------------------- /src/OGDEN/orogd.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE OROGD 2 | CDOC Output results for the Ogden hyperelastic material model 3 | CDOC 4 | CDOC This routine writes to the results file state variables for the 5 | CDOC Ogden hyperelastic material model. The state update procedure 6 | CDOC for this material model is carried out in subroutine SUOGD. 7 | CDOC 8 | CDOC BEGIN_PARAMETERS 9 | CDOC INTEGER NOUTF > Results file unit identifier. 10 | CDOC INTEGER NTYPE > Stress state type flag. 11 | CDOC DOUBLE_PRECISION STRES > Array of stress tensor components. 12 | CDOC END_PARAMETERS 13 | CHST 14 | CHST E.de Souza Neto, June 1996: Initial coding 15 | CHST 16 | SUBROUTINE OROGD 17 | 1( NOUTF ,NTYPE ,STRES ) 18 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 19 | DIMENSION STRES(*) 20 | DATA R2 ,R3 / 2.0D0,3.0D0 / 21 | C*********************************************************************** 22 | C OUTPUT RESULTS FOR OGDEN TYPE HYPERELATIC MATERIAL MODEL 23 | C*********************************************************************** 24 | 1000 FORMAT(' S-eff = ',G12.4,' Press.= ',G12.4) 25 | C 26 | IF(NTYPE.EQ.1)THEN 27 | P=(STRES(1)+STRES(2))/R3 28 | EFFST=SQRT(R3/R2*((STRES(1)-P)**2+(STRES(2)-P)**2+ 29 | 1 R2*STRES(3)**2+P**2)) 30 | ELSEIF(NTYPE.EQ.2.OR.NTYPE.EQ.3)THEN 31 | P=(STRES(1)+STRES(2)+STRES(4))/R3 32 | EFFST=SQRT(R3/R2*((STRES(1)-P)**2+(STRES(2)-P)**2+ 33 | 1 R2*STRES(3)**2+(STRES(4)-P)**2)) 34 | ENDIF 35 | C Write to output file 36 | WRITE(NOUTF,1000)EFFST,P 37 | RETURN 38 | END 39 | CDOC END_SUBROUTINE OROGD 40 | -------------------------------------------------------------------------------- /src/DAMAGED_ELASTIC/ordmel.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE ORDMEL 2 | CDOC Output results for the damaged elastic/crack closure model. 3 | CDOC 4 | CDOC This routine writes to the results file some state variables for 5 | CDOC the isotropically damaged isotropic elastic model accounting for 6 | CDOC partial microcrack/void closure effects (quasi-unilateral 7 | CDOC conditions) under compressive stresses. 8 | CDOC 9 | CDOC BEGIN_PARAMETERS 10 | CDOC INTEGER NOUTF > Results file unit identifier. 11 | CDOC INTEGER NTYPE > Stress state type flag. 12 | CDOC DOUBLE_PRECISION STRES > Array of stress tensor components. 13 | CDOC END_PARAMETERS 14 | CHST 15 | CHST E.de Souza Neto July 2001 16 | CHST 17 | SUBROUTINE ORDMEL 18 | 1( NOUTF ,NTYPE ,STRES ) 19 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 20 | PARAMETER(MSTRE=4) 21 | DIMENSION STRES(*) 22 | DATA R2 ,R3 / 2.0D0,3.0D0 / 23 | C*********************************************************************** 24 | C OUTPUT RESULTS FOR ISOTROPICALLY DAMAGED ISOTROPIC ELASTIC MODEL 25 | C ACCOUNTING FOR PARTIAL MICROCRACK/VOID CLOSURE EFFECTS 26 | C*********************************************************************** 27 | 1000 FORMAT(' S-eff = ',G12.4,' Press.= ',G12.4) 28 | C 29 | IF(NTYPE.EQ.2.OR.NTYPE.EQ.3)THEN 30 | P=(STRES(1)+STRES(2)+STRES(4))/R3 31 | EFFST=SQRT(R3/R2*((STRES(1)-P)**2+(STRES(2)-P)**2+ 32 | 1 R2*STRES(3)**2+(STRES(4)-P)**2)) 33 | ELSE 34 | CALL ERRPRT('EI0055') 35 | ENDIF 36 | C Write to output file 37 | WRITE(NOUTF,1000)EFFST,P 38 | RETURN 39 | END 40 | CDOC END_SUBROUTINE ORDMEL 41 | -------------------------------------------------------------------------------- /src/MATHS/invmt3.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE INVMT3 2 | CDOC Inverts a 3x3 double precision matrix 3 | CDOC 4 | CDOC This routine inverts a generally unsymmetric 3x3 double precision 5 | CDOC matrix. 6 | CDOC 7 | CDOC BEGIN_PARAMETERS 8 | CDOC DOUBLE_PRECISION S > Matrix to be inverted 9 | CDOC DOUBLE_PRECISION SINV < Inverse matrix 10 | CDOC DOUBLE_PRECISION DETS < Determinant of matrix S 11 | CDOC END_PARAMETERS 12 | CHST 13 | CHST E.de Souza Neto, July 2001: Initial coding 14 | CHST 15 | SUBROUTINE INVMT3 16 | 1( S ,SINV ,DETS ) 17 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 18 | DIMENSION 19 | 1 S(3,3) ,SINV(3,3) 20 | DATA 21 | 1 R0 ,R1 / 22 | 2 0.0D0,1.0D0/ 23 | C*********************************************************************** 24 | C INVERT A REAL 3x3 MATRIX 25 | C*********************************************************************** 26 | DETS=S(1,1)*S(2,2)*S(3,3)+S(1,2)*S(2,3)*S(3,1)+ 27 | 1 S(1,3)*S(2,1)*S(3,2)-S(1,2)*S(2,1)*S(3,3)- 28 | 2 S(1,1)*S(2,3)*S(3,2)-S(1,3)*S(2,2)*S(3,1) 29 | IF(DETS.EQ.R0)CALL ERRPRT('EE0013') 30 | C 31 | DETSIN=R1/DETS 32 | SINV(1,1)=+DETSIN*(S(2,2)*S(3,3)-S(2,3)*S(3,2)) 33 | SINV(2,1)=-DETSIN*(S(2,1)*S(3,3)-S(2,3)*S(3,1)) 34 | SINV(3,1)=+DETSIN*(S(2,1)*S(3,2)-S(2,2)*S(3,1)) 35 | SINV(1,2)=-DETSIN*(S(1,2)*S(3,3)-S(1,3)*S(3,2)) 36 | SINV(2,2)=+DETSIN*(S(1,1)*S(3,3)-S(1,3)*S(3,1)) 37 | SINV(3,2)=-DETSIN*(S(1,1)*S(3,2)-S(1,2)*S(3,1)) 38 | SINV(1,3)=+DETSIN*(S(1,2)*S(2,3)-S(1,3)*S(2,2)) 39 | SINV(2,3)=-DETSIN*(S(1,1)*S(2,3)-S(1,3)*S(2,1)) 40 | SINV(3,3)=+DETSIN*(S(1,1)*S(2,2)-S(1,2)*S(2,1)) 41 | C 42 | RETURN 43 | END 44 | CDOC END_SUBROUTINE INVMT3 45 | -------------------------------------------------------------------------------- /src/MATHS/rminve.f: -------------------------------------------------------------------------------- 1 | C @(#) Module: Version:1.6 Date:05/03/94 2 | SUBROUTINE RMINVE 3 | 1( A ,AI ,NSIZE ,ERROR ) 4 | C$DP,1 5 | IMPLICIT DOUBLE PRECISION(A-H,O-Z) 6 | PARAMETER (MSIZE=50) 7 | CHARACTER*6 NAME 8 | LOGICAL 9 | 1 ERROR 10 | DIMENSION 11 | 1 A(NSIZE,NSIZE) ,AI(NSIZE,NSIZE) 12 | DIMENSION 13 | 2 INDX(MSIZE) 14 | C$DP,1 15 | DATA R0,R1/0.0D0,1.0D0/ 16 | C$SP,1 17 | C DATA R0,R1/0.0 ,1.0 / 18 | DATA NAME/'RMINVE'/ 19 | C*********************************************************************** 20 | C Evaluate inverse matrix without determinant 21 | C*Coded by 22 | C G.C.Huang, Oct.,1991 23 | C*Arrays 24 | C A - A matrix 25 | C=AI - inversed A matrix 26 | C*Variables 27 | C NSIZE - Size of the matrix 28 | C=ERROR - Error flag 29 | C*********************************************************************** 30 | cccccccccccccccD CALL SENTRY(NAME,MODEDB) 31 | C System checks 32 | ccccccccccccccc IF(NSIZE.LT.1.OR.NSIZE.GT.MSIZE) 33 | ccccccccccccccc 1 CALL SYSCHK(NAME ,10 ,NSIZE ,0 ) 34 | C Set up identity matrix 35 | C ---------------------- 36 | DO 20 ISIZE=1,NSIZE 37 | DO 10 JSIZE=1,NSIZE 38 | AI(ISIZE,JSIZE)=R0 39 | 10 CONTINUE 40 | AI(ISIZE,ISIZE)=R1 41 | 20 CONTINUE 42 | C LU decompose the matrix 43 | CALL LUDCMP(A ,INDX ,DUMMY,NSIZE ,NSIZE ,ERROR ) 44 | IF(ERROR)THEN 45 | C Error. Singular matrix encountered. 46 | GOTO 999 47 | ENDIF 48 | C Find inverse by columns 49 | DO 30 ISIZE=1,NSIZE 50 | CALL LUBKSB(A ,AI(1,ISIZE),INDX ,NSIZE ,NSIZE ) 51 | 30 CONTINUE 52 | 999 CONTINUE 53 | cccccccccccccccD CALL SEXIT(MODEDB) 54 | RETURN 55 | END 56 | -------------------------------------------------------------------------------- /src/MATHS/lubksb.f: -------------------------------------------------------------------------------- 1 | C @(#) Module: Version:1.4 Date:05/03/94 2 | SUBROUTINE LUBKSB 3 | 1( A ,B ,INDX , 4 | 2 N ,NP ) 5 | C$DP,1 6 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 7 | CHARACTER 8 | 1 NAME*6 9 | DIMENSION 10 | 1 A(NP,NP) ,INDX(N) ,B(N) 11 | DATA NAME/'LUBKSB'/ 12 | C*********************************************************************** 13 | C Routine to solve the set of N linear equations AX=B 14 | C See NUMERICAL RECIPES p36. 15 | C*ACRONYM 16 | C LU_BacK_SuBustitutions 17 | C*DESCRIPTION 18 | C*HISTORY 19 | C Name Date Comment 20 | C G.C.Huang Oct,92 initial coding 21 | C*EXTERNAL 22 | C Arrays 23 | C A - LU decomposed matrix 24 | C=B - Right hand side matrix as input and stored solutions as output 25 | C INDX - Permutation vector 26 | C Variables 27 | C N - Size of the problem 28 | C NP - Physical size of A matrix 29 | C (c) Copyright 1992, Rockfield Software Limited, Swansea, UK 30 | C*********************************************************************** 31 | cccccccccccccccD CALL SENTRY(NAME,MODEDB) 32 | II=0 33 | DO 12 I=1,N 34 | LL=INDX(I) 35 | SUM=B(LL) 36 | B(LL)=B(I) 37 | IF (II.NE.0)THEN 38 | DO 11 J=II,I-1 39 | SUM=SUM-A(I,J)*B(J) 40 | 11 CONTINUE 41 | ELSE IF (SUM.NE.0.) THEN 42 | II=I 43 | ENDIF 44 | B(I)=SUM 45 | 12 CONTINUE 46 | DO 14 I=N,1,-1 47 | SUM=B(I) 48 | IF(I.LT.N)THEN 49 | DO 13 J=I+1,N 50 | SUM=SUM-A(I,J)*B(J) 51 | 13 CONTINUE 52 | ENDIF 53 | B(I)=SUM/A(I,I) 54 | 14 CONTINUE 55 | cccccccccccccccD CALL SEXIT(MODEDB) 56 | RETURN 57 | END 58 | -------------------------------------------------------------------------------- /CMakeLists.txt: -------------------------------------------------------------------------------- 1 | cmake_minimum_required (VERSION 3.0) 2 | 3 | project (hypas) 4 | 5 | enable_language(Fortran) 6 | 7 | ################################## 8 | # compiler options 9 | ################################## 10 | 11 | 12 | set(CMAKE_Fortran_COMPILER "gfortran") 13 | 14 | #debug 15 | set(FFLAGS "-g -pg -O2 -fopenmp -cpp") 16 | 17 | 18 | set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${FLAGS}") 19 | 20 | 21 | ################################## 22 | # include directories 23 | ################################## 24 | #include_directories(/usr/include/petsc) 25 | include_directories( 26 | ) 27 | 28 | 29 | ################################## 30 | # lib directories 31 | ################################## 32 | #link_directories(/usr/lib/gcc/x86_64-linux-gnu /usr/lib /opt/petsc-3.6.4/arch-linux2-c-debug/lib) 33 | link_directories( 34 | /usr/lib/gcc/x86_64-linux-gnu/7 35 | /usr/lib/x86_64-linux-gnu 36 | /home/chenna/Documents/otherCodes/hyplas/pardisolib 37 | /usr/lib/x86_64-linux-gnu/blas 38 | /usr/lib/x86_64-linux-gnu/lapack 39 | ) 40 | 41 | 42 | 43 | #src/elemutilitiesquadrature.F 44 | file(GLOB_RECURSE sources1 src/*/*.f) 45 | file(GLOB_RECURSE sources2 src/*/*/*.f) 46 | 47 | ################################## 48 | 49 | add_executable(rveplas src/hyplas.f ${sources1} ${sources2}) 50 | 51 | target_link_libraries(rveplas gfortran gomp -fopenmp pardiso600-GNU720-X86-64 blas lapack ) # mkl_blacs_lp64 mkl_blas95_lp64 mkl_lapack95_lp64 mkl_scalapack_lp64 mkl_scalapack_ilp64 mkl_lapack95_lp64 mkl_lapack95_ilp64 mkl_intel_thread mkl_intel_ilp64 mkl_gnu_thread mkl_gf_lp64 mkl_gf_ilp64 mkl_blas95_ilp64 mkl_cdft_core mkl_blacs_openmpi_lp64 mkl_blacs_sgimpt_ilp64 mkl_blacs_sgimpt_lp64 mkl_blacs_intelmpi_lp64 mkl_blacs_openmpi_ilp64 mkl_blacs_ilp64 mkl_blacs_intelmpi_ilp64 ) 52 | 53 | install(TARGETS rveplas RUNTIME DESTINATION /home/chenna/Documents/otherCodes/hyplas/bin) 54 | -------------------------------------------------------------------------------- /src/ELASTIC/orel.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE OREL 2 | CDOC Output results for the linear elastic material model 3 | CDOC 4 | CDOC This routine writes to the results file some state variables for 5 | CDOC the linear elastic material model. 6 | CDOC 7 | CDOC BEGIN_PARAMETERS 8 | CDOC INTEGER NOUTF > Results file unit identifier. 9 | CDOC INTEGER NTYPE > Stress state type flag. 10 | CDOC DOUBLE_PRECISION STRES > Array of stress tensor components. 11 | CDOC END_PARAMETERS 12 | CHST 13 | CHST E.de Souza Neto, September 1996: Initial coding 14 | CHST D. de Bortoli , March 2015: 3-D case added (NTYPE=4) 15 | CHST 16 | SUBROUTINE OREL 17 | 1( NOUTF ,NTYPE ,STRES ) 18 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 19 | DIMENSION STRES(*) 20 | DATA R2 ,R3 / 2.0D0,3.0D0 / 21 | C*********************************************************************** 22 | C OUTPUT RESULTS FOR LINEAR ELASTIC MATERIAL MODEL 23 | C*********************************************************************** 24 | 1000 FORMAT(' S-eff = ',G12.4,' Press.= ',G12.4) 25 | C 26 | IF(NTYPE.EQ.1)THEN 27 | P=(STRES(1)+STRES(2))/R3 28 | EFFST=SQRT(R3/R2*((STRES(1)-P)**2+(STRES(2)-P)**2+ 29 | 1 R2*STRES(3)**2+P**2)) 30 | ELSEIF(NTYPE.EQ.2.OR.NTYPE.EQ.3)THEN 31 | P=(STRES(1)+STRES(2)+STRES(4))/R3 32 | EFFST=SQRT(R3/R2*((STRES(1)-P)**2+(STRES(2)-P)**2+ 33 | 1 R2*STRES(3)**2+(STRES(4)-P)**2)) 34 | ELSEIF(NTYPE.EQ.4)THEN 35 | P=(STRES(1)+STRES(2)+STRES(3))/R3 36 | EFFST=SQRT(R3/R2*((STRES(1)-P)**2+(STRES(2)-P)**2+ 37 | 1 (STRES(3)-P)**2+R2*STRES(4)**2+ 38 | 2 R2*STRES(5)**2+R2*STRES(6)**2)) 39 | ENDIF 40 | C Write to output file 41 | WRITE(NOUTF,1000)EFFST,P 42 | RETURN 43 | END 44 | CDOC END_SUBROUTINE OREL 45 | -------------------------------------------------------------------------------- /src/GENERAL/getgco.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE GETGCO 2 | CDOC Gets coordinates of a point within an element by interpolation 3 | CDOC 4 | CDOC This routine computes the global cartesian coordinates of a point 5 | CDOC within a finite element by interpolation of its nodal coordinates. 6 | CDOC 7 | CDOC BEGIN_PARAMETERS 8 | CDOC DOUBLE_PRECISION CARTCO < Cartesian coordinates of the point of 9 | CDOC C interest. 10 | CDOC DOUBLE_PRECISION ELCOD > Array of nodal coordinates of the 11 | CDOC C element. 12 | CDOC INTEGER MDIME > Dimensioning parameter: Number of rows 13 | CDOC C of ELCOD. 14 | CDOC INTEGER NDIME > Number of spatial dimensions. 15 | CDOC INTEGER NNODE > Number of nodes of the element. 16 | CDOC DOUBLE_PRECISION SHAPE > Array containing the value of the shape 17 | CDOC C function at the point of interest. 18 | CDOC END_PARAMETERS 19 | CHST 20 | CHST E.de Souza Neto August 1996 21 | CHST 22 | SUBROUTINE GETGCO 23 | 1( CARTCO ,ELCOD ,MDIME ,NDIME ,NNODE , 24 | 2 SHAPE ) 25 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 26 | DIMENSION 27 | 1 CARTCO(NDIME) ,ELCOD(MDIME,NNODE) ,SHAPE(NNODE) 28 | DATA R0/0.0D0/ 29 | C*********************************************************************** 30 | C EVALUATES THE GLOBAL CARTESIAN COORDINATES OF A POINT WITHIN AN 31 | C ELEMENT BY INTERPOLATION OF THE ELEMENT NODAL COORDINATES 32 | C 33 | C REFERENCE: Expressions (4.39-40) 34 | C*********************************************************************** 35 | DO 20 IDIME=1,NDIME 36 | CARTCO(IDIME)=R0 37 | DO 10 INODE=1,NNODE 38 | CARTCO(IDIME)=CARTCO(IDIME)+ELCOD(IDIME,INODE)*SHAPE(INODE) 39 | 10 CONTINUE 40 | 20 CONTINUE 41 | C 42 | RETURN 43 | END 44 | CDOC END_SUBROUTINE GETGCO 45 | -------------------------------------------------------------------------------- /src/GENERAL/upconf.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE UPCONF 2 | CDOC Kinematic/geometric configuration update 3 | CDOC 4 | CDOC Given the current iterative displacements, this routine updates 5 | CDOC the global arrays of incremental and total nodal displacements as 6 | CDOC well as the nodal coordinates. Nodal coordinates are updated only 7 | CDOC for large deformation analyses. 8 | CHST 9 | CHST E.de Souza Neto, June 1998: Initial coding 10 | CHST 11 | SUBROUTINE UPCONF 12 | C 13 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 14 | C Hyplas database 15 | INCLUDE '../MAXDIM.INC' 16 | INCLUDE '../MATERIAL.INC' 17 | INCLUDE '../ELEMENTS.INC' 18 | INCLUDE '../GLBDBASE.INC' 19 | C*********************************************************************** 20 | C KINEMATIC/GEOMETRIC CONFIGUTATION UPDATE: 21 | C GIVEN THE ITERATIVE DISPLACEMENTS, THIS ROUTINE UPDATES THE GLOBAL 22 | C ARRAYS OF INCREMENTAL AND TOTAL DISPLACEMENTS. 23 | C FOR GEOMETRICALLY NON-LINEAR ANALYSES (LARGE DEFORMATIONS) IT ALSO 24 | C UPDATES THE CURRENT NODAL COORDINATES. 25 | C 26 | C REFERENCE: Figures 5.2-3 27 | C*********************************************************************** 28 | C 29 | C Update incremental and total displacements 30 | C ========================================== 31 | C 32 | DO 10 ITOTV=1,NTOTV 33 | DINCR(ITOTV)=DINCR(ITOTV)+DITER(ITOTV) 34 | TDISP(ITOTV)=TDISP(ITOTV)+DITER(ITOTV) 35 | 10 CONTINUE 36 | C 37 | C Update current nodal coordinates for large deformation analyses 38 | C =============================================================== 39 | C 40 | IF(NLARGE.EQ.1)THEN 41 | DO 30 IPOIN=1,NPOIN 42 | NPOSN=(IPOIN-1)*NDOFN 43 | DO 20 IDOFN=1,NDIME 44 | NPOSN=NPOSN+1 45 | COORD(IDOFN,IPOIN,1)=COORD(IDOFN,IPOIN,2)+DINCR(NPOSN) 46 | 20 CONTINUE 47 | 30 CONTINUE 48 | ENDIF 49 | C 50 | RETURN 51 | END 52 | CDOC END_SUBROUTINE UPCONF 53 | -------------------------------------------------------------------------------- /src/GENERAL/princ2.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE PRINC2 2 | CDOC Computes the principal stresses and their angle in 2-D. 3 | CDOC 4 | CDOC This routine computes the eigenvalues of the stress tensor in 2-D 5 | CDOC and the angle of the system of eingenvectors relative to the 6 | CDOC system where the stress components are expressed. 7 | CDOC 8 | CDOC BEGIN_PARAMETERS 9 | CDOC DOUBLE_PRECISION PSTRS < Array of principal stresses and angle. 10 | CDOC DOUBLE_PRECISION STRSG > Array of stress components. 11 | CDOC END_PARAMETERS 12 | CHST 13 | CHST M.E.Honnor, September 1986 14 | CHST 15 | CHST E.A.de Souza Neto, October 2008: Angle computation changed for 16 | CHST nealy spherical 2-D stress tensor 17 | CHST so that numerically spherical 2-D 18 | CHST stress will render zero angle. 19 | CHST 20 | SUBROUTINE PRINC2(PSTRS ,STRSG ) 21 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 22 | DIMENSION PSTRS(3),STRSG(3) 23 | DATA R0 ,RP01 ,RP5 ,R1 ,R4 ,R90 ,SMALL/ 24 | 1 0.0D0,0.01D0,0.5D0,1.0D0,4.0D0,90.0D0,1.D-6/ 25 | C*********************************************************************** 26 | C COMPUTES THE PRINCIPAL STRESSES FOR TWO-DIMENSIONAL STRESSES 27 | C*********************************************************************** 28 | PI=R4*ATAN(R1) 29 | XGASH=(STRSG(1)+STRSG(2))*RP5 30 | XGISH=(STRSG(1)-STRSG(2))*RP5 31 | XGESH=STRSG(3) 32 | XGOSH=SQRT(XGISH*XGISH+XGESH*XGESH) 33 | PSTRS(1)=XGASH+XGOSH 34 | PSTRS(2)=XGASH-XGOSH 35 | AUX=SQRT(STRSG(1)**2+STRSG(2)**2+STRSG(3)**2) 36 | IF(AUX.EQ.R0)AUX=R1 37 | IF(ABS(XGESH/AUX).LT.SMALL.AND.ABS(XGISH/AUX).LT.SMALL)THEN 38 | PSTRS(3)=R0 39 | ELSE 40 | PSTRS(3)=(ATAN2(XGESH,XGISH))*R90/PI 41 | IF(PSTRS(3).LT.(-R90+RP01))PSTRS(3)=R90 42 | ENDIF 43 | RETURN 44 | END 45 | CDOC END_SUBROUTINE PRINC2 46 | -------------------------------------------------------------------------------- /src/GENERAL/princ3.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE PRINC3 2 | CDOC Computes the principal stresses in 3-D and outputs them in sorted 3 | CDOC order. 4 | CDOC 5 | CDOC BEGIN_PARAMETERS 6 | CDOC DOUBLE_PRECISION PSTRS < Array of principal stresses in 7 | CDOC decreasing order. 8 | CDOC DOUBLE_PRECISION STRSG > Array of stress components. 9 | CDOC END_PARAMETERS 10 | CHST 11 | CHST D. de Bortoli, October 2015: Initial coding 12 | CHST 13 | CHST D. de Bortoli, June 2016: Fixed bugs with repeated principal 14 | CHST stresses 15 | CHST 16 | CHST 17 | SUBROUTINE PRINC3(PSTRS ,STRSG) 18 | IMPLICIT NONE 19 | C Arguments 20 | DOUBLE PRECISION, DIMENSION(6) , INTENT(IN) :: STRSG 21 | DOUBLE PRECISION, DIMENSION(3) , INTENT(OUT) :: PSTRS 22 | C Local variables 23 | DOUBLE PRECISION, DIMENSION(3,3) :: STRMTX ! Matrix representation of stress tensor 24 | DOUBLE PRECISION, DIMENSION(3,3) :: STREVC ! Eigenvectors of stress tensor 25 | C 26 | DOUBLE PRECISION :: PSTMAX,PSTMIN,PSTMID 27 | INTEGER :: I, IMX, IMN, IMD 28 | C Parameters 29 | INTEGER , PARAMETER :: NDIME=3 30 | C 31 | C*********************************************************************** 32 | C COMPUTES THE PRINCIPAL STRESSES FOR THREE-DIMENSIONAL STRESSES 33 | C*********************************************************************** 34 | C Convert array representation of stress tensor to matrix form 35 | CALL ATSYM(STRSG, STRMTX, NDIME,.FALSE.) 36 | C Find eigenvalues (and eigenvectors) of stress tensor 37 | CALL JACOB(STRMTX, PSTRS, STREVC, NDIME) 38 | C Sort eigenvalues in decreasing order 39 | C Location of maximum and minimum values in PSTRS 40 | IMX=MAXLOC(PSTRS,1) 41 | IMN=MINLOC(PSTRS,1) 42 | C Locate other value 43 | DO I=1,3 44 | IF(I==IMX.OR.I==IMN)CYCLE 45 | IMD=I 46 | EXIT 47 | ENDDO 48 | PSTRS=PSTRS([IMX,IMD,IMN]) 49 | C 50 | RETURN 51 | END 52 | CDOC END_SUBROUTINE PRINC3 53 | -------------------------------------------------------------------------------- /src/ELEMENTS/exq4fb.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE EXQ4FB 2 | CDOC Gauss point-node extrapolation matrix for element type QUA4FB 3 | CDOC 4 | CDOC This routine sets the coefficients matrix for extrapolation of 5 | CDOC fields from Gauss point values to nodal values for element type 6 | CDOC QUA4FB: F-bar isoparametric 4-noded bi-linear quadrilateral. 7 | CDOC 8 | CDOC BEGIN_PARAMETERS 9 | CDOC DOUBLE_PRECISION EXMATX < Extrapolation matrix. 10 | CDOC END_PARAMETERS 11 | CHST 12 | CHST E.de Souza Neto, September 1996: Initial coding 13 | CHST 14 | SUBROUTINE EXQ4FB( EXMATX ) 15 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 16 | PARAMETER 17 | 1( NGAUSP=4 ,NNODE=4 ) 18 | DIMENSION EXMATX(NNODE,NGAUSP) 19 | DATA 20 | 1 A4 ,B4 ,C4 / 21 | 2 1.866025404D0 ,-0.5D0 ,0.133974596D0 / 22 | C*********************************************************************** 23 | C SET COEFFICIENTS MATRIX (EXMATX) FOR EXTRAPOLATION FROM GAUSS POINTS 24 | C TO NODES FOR ELEMENT TYPE 'QUAD_4_FBAR' (F-BAR 4-NODED BI-LINEAR 25 | C QUADRILATERAL) 26 | C 27 | C REFERENCE: Section 5.6.1 28 | C E Hinton & JS Campbel. Local and global Smoothing of 29 | C discontinuous finite element functions using a least 30 | C squares method. Int. J. Num. meth. Engng., 8:461-480, 1974. 31 | C E Hinton & DRJ Owen. An introduction to finite element 32 | C computations. Pineridge Press, Swansea, 1979. 33 | C*********************************************************************** 34 | EXMATX(1,1)=A4 35 | EXMATX(1,2)=B4 36 | EXMATX(1,3)=B4 37 | EXMATX(1,4)=C4 38 | EXMATX(2,1)=B4 39 | EXMATX(2,2)=C4 40 | EXMATX(2,3)=A4 41 | EXMATX(2,4)=B4 42 | EXMATX(3,1)=C4 43 | EXMATX(3,2)=B4 44 | EXMATX(3,3)=B4 45 | EXMATX(3,4)=A4 46 | EXMATX(4,1)=B4 47 | EXMATX(4,2)=A4 48 | EXMATX(4,3)=C4 49 | EXMATX(4,4)=B4 50 | RETURN 51 | END 52 | CDOC END_SUBROUTINE EXQ4FB 53 | -------------------------------------------------------------------------------- /src/GENERAL/arrgo2.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE ARRGO2 2 | CDOC Arrange a fourth order tensor in matrix form with G matrix ordering 3 | CDOC 4 | CDOC This routine re-arranges a given fourth order tensor, stored as a 5 | CDOC 4-index array, in matrix form (2-index array) using G matrix 6 | CDOC component ordering. 7 | CDOC Implemented only for 2-D tensors. 8 | CDOC 9 | CDOC BEGIN_PARAMETERS 10 | CDOC DOUBLE_PRECISION A4TH > Fourth order tensor stored as a 4-index 11 | CDOC C array. 12 | CDOC DOUBLE_PRECISION AMATX < 2-index array containing the components 13 | CDOC C of the given 4th order tensor stored 14 | CDOC C using G matrix ordering. 15 | CDOC END_PARAMETERS 16 | CHST 17 | CHST E.de Souza Neto, January 1999: Initial coding 18 | CHST 19 | SUBROUTINE ARRGO2 20 | 1( A4TH ,AMATX ) 21 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 22 | PARAMETER 23 | 1( NDIM=2 ,NGDIM=4 ) 24 | C Arguments 25 | DIMENSION 26 | 1 A4TH(NDIM,NDIM,NDIM,NDIM) ,AMATX(NGDIM,NGDIM) 27 | C*********************************************************************** 28 | C RE-ARRANGES A FOURTH ORDER TENSOR, STORED AS A 4-INDEX ARRAY, IN 29 | C MATRIX FORM (2-INDEX ARRAY) USING G-MATRIX COMPONENT ORDERING 30 | C (11,21,12,22). FOR 2-D ONLY. 31 | C 32 | C REFERENCE: Section D.2.1 33 | C*********************************************************************** 34 | C 35 | AMATX(1,1)=A4TH(1,1,1,1) 36 | AMATX(1,2)=A4TH(1,1,2,1) 37 | AMATX(1,3)=A4TH(1,1,1,2) 38 | AMATX(1,4)=A4TH(1,1,2,2) 39 | C 40 | AMATX(2,1)=A4TH(2,1,1,1) 41 | AMATX(2,2)=A4TH(2,1,2,1) 42 | AMATX(2,3)=A4TH(2,1,1,2) 43 | AMATX(2,4)=A4TH(2,1,2,2) 44 | C 45 | AMATX(3,1)=A4TH(1,2,1,1) 46 | AMATX(3,2)=A4TH(1,2,2,1) 47 | AMATX(3,3)=A4TH(1,2,1,2) 48 | AMATX(3,4)=A4TH(1,2,2,2) 49 | C 50 | AMATX(4,1)=A4TH(2,2,1,1) 51 | AMATX(4,2)=A4TH(2,2,2,1) 52 | AMATX(4,3)=A4TH(2,2,1,2) 53 | AMATX(4,4)=A4TH(2,2,2,2) 54 | C 55 | RETURN 56 | END 57 | CDOC END_SUBROUTINE ARRGO2 58 | -------------------------------------------------------------------------------- /src/GENERAL/invf.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE INVF 2 | CDOC Inverts the deformation gradient for 2-D and 3-D problems 3 | CDOC 4 | CDOC This routine inverts deformation gradient tensors for plane strain, 5 | CDOC plane stress, axisymmetric and three-dimensional problems. 6 | CDOC 7 | CDOC BEGIN_PARAMETERS 8 | CDOC DOUBLE_PRECISION F > Deformation gradient. 9 | CDOC DOUBLE_PRECISION FINV < Inverse of the deformation gradient. 10 | CDOC INTEGER NTYPE > Stress state type flag. 11 | CDOC END_PARAMETERS 12 | CHST 13 | CHST E.de Souza Neto, August 1996: Initial coding 14 | CHST D. de Bortoli , March 2015: 3-D case added, changed name from 15 | CHST INVF2 to INVF 16 | CHST 17 | SUBROUTINE INVF 18 | 1( F ,FINV ,NTYPE ) 19 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 20 | DIMENSION 21 | 1 F(3,3) ,FINV(3,3) 22 | LOGICAL IS2D 23 | DATA 24 | 1 R0 ,R1 / 25 | 2 0.0D0,1.0D0/ 26 | C*********************************************************************** 27 | C INVERTS DEFORMATION GRADIENT TENSORS FOR PLANE STRESS/STRAIN, 28 | C AXISYMMETRIC AND THREE-DIMENSIONAL PROBLEMS 29 | C*********************************************************************** 30 | IF((NTYPE.EQ.1).OR.(NTYPE.EQ.2).OR.(NTYPE.EQ.3))THEN 31 | IS2D=.TRUE. 32 | ELSEIF(NTYPE.EQ.4)THEN 33 | IS2D=.FALSE. 34 | ELSE 35 | CALL ERRPRT('EI0072') 36 | ENDIF 37 | C 2-D problems 38 | C ------------ 39 | IF(IS2D)THEN 40 | DETFPL=F(1,1)*F(2,2)-F(1,2)*F(2,1) 41 | IF(DETFPL.EQ.R0)CALL ERRPRT('EE0001') 42 | IF(NTYPE.EQ.3.AND.F(3,3).EQ.R0)CALL ERRPRT('EE0001') 43 | C 44 | DETFIN=R1/DETFPL 45 | FINV(1,1)=F(2,2)*DETFIN 46 | FINV(2,2)=F(1,1)*DETFIN 47 | FINV(1,2)=-F(1,2)*DETFIN 48 | FINV(2,1)=-F(2,1)*DETFIN 49 | IF(NTYPE.EQ.2)THEN 50 | FINV(3,3)=R1 51 | ELSEIF(NTYPE.EQ.3)THEN 52 | FINV(3,3)=R1/F(3,3) 53 | ENDIF 54 | C 3-D problems 55 | C ------------ 56 | ELSE 57 | CALL INVMT3 58 | 1( F ,FINV ,DETF3D ) 59 | ENDIF 60 | C 61 | RETURN 62 | END 63 | CDOC END_SUBROUTINE INVF 64 | -------------------------------------------------------------------------------- /src/GENERAL/rtv.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE RTV 2 | CDOC Matrix-vectot product s.Rt V 3 | CDOC 4 | CDOC This routine performs the matrix-vector product s Rt V, where s is 5 | CDOC a scalar, R a real rectangular matrix and v a real vector. 6 | CDOC Rt denotes the transpose of R. 7 | CDOC 8 | CDOC BEGIN_PARAMETERS 9 | CDOC INTEGER MODE > If set to 1, the argument V 10 | CDOC C returns the resulting vector s Rt V. 11 | CDOC C Otherwise, s Rt v is added to the input 12 | CDOC C value of P. 13 | CDOC INTEGER MROWR > Dimensioning parameter: maximum number 14 | CDOC C of rows of R. 15 | CDOC INTEGER NCOLR > Number of columns of R. 16 | CDOC INTEGER NROWR > Number of rows of R. 17 | CDOC DOUBLE_PRECISION P <> Vector where results are stored. 18 | CDOC DOUBLE_PRECISION R > Rectangular real matrix. 19 | CDOC DOUBLE_PRECISION V > Real vector. 20 | CDOC DOUBLE_PRECISION SCAL > Real scalar. 21 | CDOC END_PARAMETERS 22 | CHST 23 | CHST E.de Souza Neto, August 1996: Initial coding 24 | CHST 25 | SUBROUTINE RTV 26 | 1( MODE ,MROWR ,NCOLR ,NROWR ,P , 27 | 2 R ,V ,SCAL ) 28 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 29 | DIMENSION 30 | 1 P(NCOLR) ,R(MROWR,NCOLR) ,V(NROWR) 31 | DATA R0 /0.0D0/ 32 | C*********************************************************************** 33 | C PERFORMS THE PRODUCT 34 | C T 35 | C P := SCAL * R V (IF MODE=1) 36 | C OR 37 | C T 38 | C P := P + SCAL * R V (OTHERWISE) 39 | C 40 | C WHERE 'R' IS A REAL RECTANGULAR MATRIX, 'V' A REAL VECTOR AND 41 | C 'SCAL' A SCALAR. 42 | C*********************************************************************** 43 | IF(MODE.EQ.1)CALL RVZERO(P,NCOLR) 44 | DO 30 I=1,NCOLR 45 | DO 20 J=1,NROWR 46 | IF(R(J,I).NE.R0)THEN 47 | P(I)=P(I)+SCAL*R(J,I)*V(J) 48 | ENDIF 49 | 20 CONTINUE 50 | 30 CONTINUE 51 | C 52 | RETURN 53 | END 54 | CDOC END_SUBROUTINE RTV 55 | -------------------------------------------------------------------------------- /src/GENERAL/nword.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_INTEGER_FUNCTION NWORD 2 | CDOC Returns the number of words contained in a character string 3 | CDOC 4 | CDOC The return value of this function is the number of words contained 5 | CDOC in the character string passed in its argument list. The function 6 | CDOC also sets the pointers to the beginning and end of each word. The 7 | CDOC pointers are returned via argument list. 8 | CDOC 9 | CDOC BEGIN_PARAMETERS 10 | CDOC CHARACTER CHRSTR > Character string. 11 | CDOC INTEGER IWBEG < Array of pointers to the beginning of 12 | CDOC C the words contained in CHRSTR. 13 | CDOC C For the Nth word, beginning at 14 | CDOC C CHRSTR(I:I), the function sets 15 | CDOC C IWBEG(N)=I. 16 | CDOC INTEGER IWEND < Array of pointers to the end of 17 | CDOC C the words contained in CHRSTR. 18 | CDOC C For the Nth word, ending at 19 | CDOC C CHRSTR(I:I), the function sets 20 | CDOC C IWEND(N)=I. 21 | CDOC END_PARAMETERS 22 | CHST 23 | CHST E.de Souza Neto, July 1996: Initial coding 24 | CHST 25 | INTEGER FUNCTION NWORD(CHRSTR,IWBEG,IWEND) 26 | IMPLICIT NONE 27 | CHARACTER*(*) CHRSTR 28 | INTEGER IWBEG(*), IWEND(*) 29 | LOGICAL OUT 30 | INTEGER I, LEN, LENGTH 31 | C*********************************************************************** 32 | C FIND NUMBER OF WORDS CONTAINED IN A CHARACTER STRING AND SET POINTERS 33 | C TO BEGINNING AND END OF EACH WORD 34 | C*********************************************************************** 35 | LENGTH=LEN(CHRSTR) 36 | NWORD=0 37 | OUT=.TRUE. 38 | DO 10 I=1,LENGTH 39 | IF(OUT)THEN 40 | IF(CHRSTR(I:I).NE.' ')THEN 41 | OUT=.FALSE. 42 | NWORD=NWORD+1 43 | IWBEG(NWORD)=I 44 | ENDIF 45 | ELSE 46 | IF(CHRSTR(I:I).EQ.' ')THEN 47 | OUT=.TRUE. 48 | IWEND(NWORD)=I-1 49 | ELSEIF(I.EQ.LENGTH)THEN 50 | IWEND(NWORD)=I 51 | ENDIF 52 | ENDIF 53 | 10 CONTINUE 54 | RETURN 55 | END 56 | CDOC END_INTEGER_FUNCTION NWORD 57 | -------------------------------------------------------------------------------- /src/GENERAL/symta.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE SYMTA 2 | CDOC Converts the matrix representation (2-index array) of a symmetric 3 | CDOC second order tensor to its array representation. 4 | CDOC Implemented for both 2-D and 3-D tensors. 5 | CDOC 6 | CDOC BEGIN_PARAMETERS 7 | CDOC DOUBLE_PRECISION AMATX > Matrix representation of a symmetric 8 | CDOC second order tensor. 9 | CDOC DOUBLE_PRECISION A < Array representation of the given 10 | CDOC C symmetric second order tensor. 11 | CDOC INTEGER NDIM > Number of spatial dimensions of tensor. 12 | CDOC LOGICAL OUTOFP > .TRUE. if the out-of-plane component 13 | CDOC C (3,3) of a 2-D tensor is required. 14 | CDOC END_PARAMETERS 15 | CHST 16 | CHST D. de Bortoli , March 2015: Initial coding 17 | CHST 18 | SUBROUTINE SYMTA 19 | 1( AMATX ,A ,NDIM ,OUTOFP ) 20 | IMPLICIT NONE 21 | C Arguments 22 | DOUBLE PRECISION, DIMENSION(3,3), INTENT(IN) :: AMATX 23 | DOUBLE PRECISION, DIMENSION(6) , INTENT(OUT) :: A 24 | INTEGER , INTENT(IN) :: NDIM 25 | LOGICAL , INTENT(IN) :: OUTOFP 26 | C 27 | DOUBLE PRECISION, PARAMETER :: R0=0.0D0 28 | C*********************************************************************** 29 | C RE-ARRANGES THE MATRIX REPRESENTATION OF A SYMMETRIC SECOND ORDER 30 | C TENSOR TO ITS ARRAY REPRESENTATION (COMPONENT ORDERING (11,22,12,33) 31 | C IN 2-D, OR (11,22,33,12,23,13) IN 3-D). 32 | C 33 | C REFERENCE: Section D.1 34 | C*********************************************************************** 35 | C 36 | IF(NDIM==2)THEN 37 | A(1)=AMATX(1,1) 38 | A(2)=AMATX(2,2) 39 | A(3)=AMATX(1,2) 40 | C out-of-plane component 41 | IF(OUTOFP)THEN 42 | A(4)=AMATX(3,3) 43 | ELSE 44 | A(4)=R0 45 | ENDIF 46 | A(5:6)=R0 47 | ELSEIF(NDIM==3)THEN 48 | A(1)=AMATX(1,1) 49 | A(2)=AMATX(2,2) 50 | A(3)=AMATX(3,3) 51 | A(4)=AMATX(1,2) 52 | A(5)=AMATX(2,3) 53 | A(6)=AMATX(1,3) 54 | ELSE 55 | CALL ERRPRT('EI0068') 56 | ENDIF 57 | C 58 | END 59 | CDOC END_SUBROUTINE SYMTA 60 | -------------------------------------------------------------------------------- /src/GENERAL/intnum.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_INTEGER_FUNCTION INTNUM 2 | CDOC Converts a character string into an integer 3 | CDOC 4 | CDOC This function returns the integer corresponding to the number 5 | CDOC contained in the character string passed as argument. 6 | CDOC 7 | CDOC BEGIN_PARAMETERS 8 | CDOC CHARACTER CHRSTR > Character string containing a number. 9 | CDOC END_PARAMETERS 10 | CHST 11 | CHST E.de Souza Neto July 1996 12 | CHST 13 | INTEGER FUNCTION INTNUM(CHRSTR) 14 | IMPLICIT NONE 15 | CHARACTER*(*) CHRSTR 16 | INTEGER I, IASCII, IEND, IPOWER, LEN, LENGTH, NUMBER 17 | C*********************************************************************** 18 | C CONVERTS A NUMBER CONTAINED IN A CHARACTER STRING INTO AN INTEGER 19 | C*********************************************************************** 20 | 1000 FORMAT(/15X,'ERROR: String of blank characters passed'/ 21 | 1 22X,'into integer conversion function INTMUN') 22 | 1100 FORMAT(/15X,'ERROR: Invalid character in string ''',A,''' passed'/ 23 | 1 22X,'into integer conversion function INTMUN') 24 | C 25 | LENGTH=LEN(CHRSTR) 26 | DO 10 I=LENGTH,1,-1 27 | IF(CHRSTR(I:I).NE.' ')THEN 28 | IEND=I 29 | GOTO 20 30 | ENDIF 31 | 10 CONTINUE 32 | WRITE(*,1000) 33 | WRITE(16,1000) 34 | CALL PEXIT 35 | 20 CONTINUE 36 | INTNUM=0 37 | IPOWER=0 38 | DO 30 I=IEND,1,-1 39 | IASCII=ICHAR(CHRSTR(I:I)) 40 | IF(IASCII.GE.48.AND.IASCII.LE.57)THEN 41 | NUMBER=IASCII-48 42 | INTNUM=INTNUM+NUMBER*(10**IPOWER) 43 | IPOWER=IPOWER+1 44 | ELSEIF(CHRSTR(I:I).EQ.' ')THEN 45 | GOTO 40 46 | ELSEIF(CHRSTR(I:I).EQ.'-'.OR.CHRSTR(I:I).EQ.'+')THEN 47 | IF(I.NE.IEND)THEN 48 | IF(CHRSTR(I:I).EQ.'-')INTNUM=-INTNUM 49 | GOTO 40 50 | ELSE 51 | WRITE(*,1100)CHRSTR(1:IEND) 52 | WRITE(16,1100)CHRSTR(1:IEND) 53 | CALL PEXIT 54 | ENDIF 55 | ELSE 56 | WRITE(*,1100)CHRSTR(1:IEND) 57 | WRITE(16,1100)CHRSTR(1:IEND) 58 | CALL PEXIT 59 | ENDIF 60 | 30 CONTINUE 61 | 40 CONTINUE 62 | RETURN 63 | END 64 | CDOC END_INTEGER_FUNCTION INTNUM 65 | -------------------------------------------------------------------------------- /src/ELASTIC/tuel.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE TUEL 2 | CDOC Thickness update for Hencky elastic model in plane stress 3 | CDOC 4 | CDOC This routine updates the thickness for the (Hencky) elastic model 5 | CDOC under plane stress and large strains. It also computes the total 6 | CDOC deformation gradient (including the thickness strain contribution). 7 | CDOC 8 | CDOC BEGIN_PARAMETERS 9 | CDOC DOUBLE_PRECISION DETF < Determinant of the current total 10 | CDOC C deformation gradient (including the 11 | CDOC C thickness strain contribution). 12 | CDOC DOUBLE_PRECISION RSTAVA > Array of current (updated) engineering 13 | CDOC C logarithmic strain components. 14 | CDOC DOUBLE_PRECISION THICK <> Initial (reference) thickness on entry. 15 | CDOC C Returns as the current (updated) 16 | CDOC C thickness. 17 | CDOC INTEGER MODE > Flag. If MODE.NE.1, then only the total 18 | CDOC C deformation gradient is computed. 19 | CDOC C If MODE = 1, then the thickness is 20 | CDOC C updated in addition. 21 | CDOC END_PARAMETERS 22 | CHST 23 | CHST E.de Souza Neto, June 2003: Initial coding 24 | CHST 25 | SUBROUTINE TUEL 26 | 1( DETF ,RSTAVA ,THICK ,MODE ) 27 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 28 | PARAMETER( MSTRE=4 ) 29 | DIMENSION 30 | 1 RSTAVA(MSTRE) 31 | C*********************************************************************** 32 | C THICKNESS UPDATE FOR THE HENCKY ELASTIC MODEL MODEL UNDER LARGE 33 | C STRAINS AND PLANE STRESS 34 | C 35 | C REFERENCE: Section 13.3.2 36 | C*********************************************************************** 37 | C Compute determinant of total deformation gradient (including 38 | C out-of-plane contribution). 39 | C ...start by retrieving the diagonal components of the logarithmic 40 | C strain tensor 41 | E11=RSTAVA(1) 42 | E22=RSTAVA(2) 43 | E33=RSTAVA(4) 44 | C ...then compute determinant of total deformation gradient 45 | DETF=EXP(E11+E22+E33) 46 | IF(MODE.EQ.1)THEN 47 | C Compute thickness stretch 48 | STRTC3=EXP(E33) 49 | C Update thickness 50 | THICK=THICK*STRTC3 51 | ENDIF 52 | C 53 | RETURN 54 | END 55 | CDOC END_SUBROUTINE TUEL 56 | -------------------------------------------------------------------------------- /src/DAMAGE/ordama.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE ORDAMA 2 | CDOC Output results Lemaitre's ductile damage elasto-plastic model 3 | CDOC 4 | CDOC This routine writes to the results file the internal and 5 | CDOC algorithmic variables of Lemaitre's ductile damage elasto-plastic 6 | CDOC material with non-linear (piece-wise linear) isotropic hardening. 7 | CDOC 8 | CDOC BEGIN_PARAMETERS 9 | CDOC DOUBLE_PRECISION DGAMA > Incremental plastic multiplier. Computed 10 | CDOC C in routine SUDAMA. 11 | CDOC INTEGER NOUTF > Results file unit identifier. 12 | CDOC INTEGER NTYPE > Stress state type flag. 13 | CDOC DOUBLE_PRECISION RSTAVA > Array of real state variables other than 14 | CDOC C the stress tensor components. 15 | CDOC DOUBLE_PRECISION STRES > Array of stress tensor components. 16 | CDOC END_PARAMETERS 17 | CHST 18 | CHST E.de Souza Neto, January 2000: Initial coding 19 | CHST 20 | SUBROUTINE ORDAMA 21 | 1( DGAMA ,NOUTF ,NTYPE ,RSTAVA ,STRES ) 22 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 23 | PARAMETER(IPHARD=6 ,MSTRE=4) 24 | DIMENSION RSTAVA(MSTRE+2), STRES(*) 25 | DATA R2 ,R3 / 2.0D0,3.0D0 / 26 | C*********************************************************************** 27 | C OUTPUT RESULTS (INTERNAL AND ALGORITHMIC VARIABLES) FOR LEMAITRE'S 28 | C DUCTILE DAMAGE ELASTO-PLASTIC MODEL WITH NON-LINEAR ISOTROPIC 29 | C HARDENING 30 | C*********************************************************************** 31 | 1000 FORMAT(' S-eff = ',G12.4,' R = ',G12.4,' dgama = ',G12.4) 32 | 2000 FORMAT(' Damage= ',G12.4) 33 | C 34 | C Retrieve current values of hardening variable and damage 35 | HVAR=RSTAVA(MSTRE+1) 36 | DAMAGE=RSTAVA(MSTRE+2) 37 | IF(NTYPE.EQ.1)THEN 38 | C Plane stress 39 | P=(STRES(1)+STRES(2))/R3 40 | EFFST=SQRT(R3/R2*((STRES(1)-P)**2+(STRES(2)-P)**2+ 41 | 1 R2*STRES(3)**2+P**2)) 42 | ELSEIF(NTYPE.EQ.2.OR.NTYPE.EQ.3)THEN 43 | C Plane strain and axisymmetric 44 | P=(STRES(1)+STRES(2)+STRES(4))/R3 45 | EFFST=SQRT(R3/R2*((STRES(1)-P)**2+(STRES(2)-P)**2+ 46 | 1 R2*STRES(3)**2+(STRES(4)-P)**2)) 47 | ENDIF 48 | C Write to output file 49 | WRITE(NOUTF,1000)EFFST,HVAR,DGAMA 50 | WRITE(NOUTF,2000)DAMAGE 51 | RETURN 52 | END 53 | CDOC END_SUBROUTINE ORDAMA 54 | -------------------------------------------------------------------------------- /src/ELEMENTS/exq4.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE EXQ4 2 | CDOC Sets Gauss point-node extrapolation matrix for element type QUAD4 3 | CDOC 4 | CDOC This routine sets the coefficients matrix for extrapolation of 5 | CDOC fields from Gauss point values to nodal values for element type 6 | CDOC QUAD4: Standard isoparametric 4-noded bi-linear quadrilateral. 7 | CDOC 8 | CDOC BEGIN_PARAMETERS 9 | CDOC INTEGER NGAUSP > Number of Gauss points. 10 | CDOC DOUBLE_PRECISION EXMATX < Extrapolation matrix. 11 | CDOC END_PARAMETERS 12 | CHST 13 | CHST E.de Souza Neto, September 1996: Initial coding 14 | CHST 15 | SUBROUTINE EXQ4 16 | 1( NGAUSP ,EXMATX ) 17 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 18 | PARAMETER(NNODE=4) 19 | DIMENSION EXMATX(NNODE,NGAUSP) 20 | DATA R1 / 21 | 1 1.0D0 / 22 | DATA 23 | 1 A4 ,B4 ,C4 / 24 | 2 1.866025404D0 ,-0.5D0 ,0.133974596D0 / 25 | C*********************************************************************** 26 | C SETS COEFFICIENTS MATRIX (EXMATX) FOR EXTRAPOLATION FROM GAUSS POINTS 27 | C TO NODES FOR ELEMENT TYPE 'QUAD_4' (STANDARD 4-NODED BI-LINEAR 28 | C QUADRILATERAL) 29 | C 30 | C REFERENCE: Section 5.6.1 31 | C E Hinton & JS Campbel. Local and global Smoothing of 32 | C discontinuous finite element functions using a least 33 | C squares method. Int. J. Num. meth. Engng., 8:461-480, 1974. 34 | C E Hinton & DRJ Owen. An introduction to finite element 35 | C computations. Pineridge Press, Swansea, 1979. 36 | C*********************************************************************** 37 | IF(NGAUSP.EQ.1)THEN 38 | EXMATX(1,1)=R1 39 | EXMATX(2,1)=R1 40 | EXMATX(3,1)=R1 41 | EXMATX(4,1)=R1 42 | ELSEIF(NGAUSP.EQ.4)THEN 43 | EXMATX(1,1)=A4 44 | EXMATX(1,2)=B4 45 | EXMATX(1,3)=B4 46 | EXMATX(1,4)=C4 47 | EXMATX(2,1)=B4 48 | EXMATX(2,2)=C4 49 | EXMATX(2,3)=A4 50 | EXMATX(2,4)=B4 51 | EXMATX(3,1)=C4 52 | EXMATX(3,2)=B4 53 | EXMATX(3,3)=B4 54 | EXMATX(3,4)=A4 55 | EXMATX(4,1)=B4 56 | EXMATX(4,2)=A4 57 | EXMATX(4,3)=C4 58 | EXMATX(4,4)=B4 59 | ENDIF 60 | RETURN 61 | END 62 | CDOC END_SUBROUTINE EXQ4 63 | -------------------------------------------------------------------------------- /src/MAXDIM.INC: -------------------------------------------------------------------------------- 1 | C*********************************************************************** 2 | C----------------------------------------------------------------------* 3 | C * 4 | C * 5 | C H Y P L A S MAXIMUM PROBLEM SIZE DIMENSIONING PARAMETERS * 6 | C * 7 | C * 8 | C----------------------------------------------------------------------* 9 | C*********************************************************************** 10 | C 11 | C 12 | C 13 | C Dimensioning parameters: 14 | C ----------------------- 15 | C 16 | C * MELEM = Maximum permissible number of elements in the mesh. 17 | C 18 | C * MFRON = Maximum front width allowed in frontal solver. 19 | C 20 | C * MGRUP = Maximum permissible number of element groups. 21 | C 22 | C * MINCS = Maximum permissible number of load increments. 23 | C 24 | C * MPOIN = Maximum permissible number of nodal points in the mesh. 25 | C 26 | C * MSUBIN= Dimension of increment cut stack array. Maximum 27 | C permissible number of consecutive increment cuts is 28 | C MSUBIN-1. 29 | C 30 | C * MVFIX = Maximum permissible number of nodes with prescribed 31 | C displacements. Does not include (slave) nodes with 32 | C kinematical contraints prescribed by means of Master/Slave 33 | C constraint specification. 34 | C 35 | C * MDOFGL= Maximum permissible number of degrees of freedom in 36 | C reduced global stiffness matrix (only used by solvers that 37 | C assemble the global stiffness matrix, e.g. MA41) 38 | C 39 | C * MNNZSP= Maximum non zero entries in the sparse reduced global 40 | C stiffness matrix (only used by sparse solvers, e.g. MA41) 41 | C 42 | C * MA41RW= Maximum size of the real working space used by the solver 43 | C MA41 44 | C 45 | C * MA41IW= Maximum size of the integer working space used by the 46 | C solver MA41 47 | C 48 | PARAMETER( MELEM = 1000) 49 | PARAMETER( MFRON = 500) 50 | PARAMETER( MGRUP = 10) 51 | PARAMETER( MINCS = 1000) 52 | PARAMETER( MPOIN = 1000) 53 | PARAMETER( MSUBIN = 100 ) 54 | PARAMETER( MVFIX = 500 ) 55 | -------------------------------------------------------------------------------- /src/VON_MISES/orvm.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE ORVM 2 | CDOC Output results for the von Mises elasto-plastic material model 3 | CDOC 4 | CDOC This routine writes to the results file the internal and 5 | CDOC algorithmic variables of the von Mises elasto-plastic material 6 | CDOC with non-linear isotropic hardening. The results printed here 7 | CDOC are the von Mises effective stress, the equivalent plastic strain 8 | CDOC and the incremental plastic multiplier obtained by the return 9 | CDOC mapping algorithm of routine SUVM or SUVMPS. 10 | CDOC 11 | CDOC BEGIN_PARAMETERS 12 | CDOC DOUBLE_PRECISION DGAMA > Incremental plastic multiplier. 13 | CDOC C Computed in routine SUVM or SUVMPS. 14 | CDOC INTEGER NOUTF > Results file unit identifier. 15 | CDOC INTEGER NTYPE > Stress state type flag. 16 | CDOC DOUBLE_PRECISION RSTAVA > Array of real state variables other than 17 | CDOC C the stress tensor components. 18 | CDOC DOUBLE_PRECISION STRES > Array of stress tensor components. 19 | CDOC END_PARAMETERS 20 | CHST 21 | CHST E.de Souza Neto, June 1996: Initial coding 22 | CHST 23 | SUBROUTINE ORVM 24 | 1( DGAMA ,NOUTF ,NTYPE ,RSTAVA ,STRES ) 25 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 26 | PARAMETER(IPHARD=4 ,MSTRE=4) 27 | DIMENSION RSTAVA(MSTRE+1), STRES(*) 28 | DATA R2 ,R3 / 2.0D0,3.0D0 / 29 | C*********************************************************************** 30 | C OUTPUT RESULTS (INTERNAL AND ALGORITHMIC VARIABLES) FOR VON MISES 31 | C TYPE ELASTO-PLASTIC MATERIAL WITH NON-LINEAR ISOTROPIC HARDENING 32 | C*********************************************************************** 33 | 1000 FORMAT(' S-eff = ',G12.4,' Eps. = ',G12.4,' dgama = ',G12.4) 34 | C 35 | EPBAR=RSTAVA(MSTRE+1) 36 | IF(NTYPE.EQ.1)THEN 37 | C Plane stress 38 | P=(STRES(1)+STRES(2))/R3 39 | EFFST=SQRT(R3/R2*((STRES(1)-P)**2+(STRES(2)-P)**2+ 40 | 1 R2*STRES(3)**2+P**2)) 41 | ELSEIF(NTYPE.EQ.2.OR.NTYPE.EQ.3)THEN 42 | C Plane strain and axisymmetric 43 | P=(STRES(1)+STRES(2)+STRES(4))/R3 44 | EFFST=SQRT(R3/R2*((STRES(1)-P)**2+(STRES(2)-P)**2+ 45 | 1 R2*STRES(3)**2+(STRES(4)-P)**2)) 46 | ENDIF 47 | C Write to output file 48 | WRITE(NOUTF,1000)EFFST,EPBAR,DGAMA 49 | RETURN 50 | END 51 | CDOC END_SUBROUTINE ORVM 52 | -------------------------------------------------------------------------------- /src/MOHR_COULOMB/ormc.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE ORMC 2 | CDOC Output results for the Mohr-Coulomb elasto-plastic material model 3 | CDOC 4 | CDOC This routine writes to the results file the internal and 5 | CDOC algorithmic variables of the Mohr-Coulomb elasto-plastic material 6 | CDOC with non-linear isotropic hardening. The results printed here 7 | CDOC are obtained by the return mapping algorithm implemented in routine 8 | CDOC SUMC. 9 | CDOC 10 | CDOC BEGIN_PARAMETERS 11 | CDOC DOUBLE_PRECISION DGAM > Array of incremental plastic 12 | CDOC C multipliers. 13 | CDOC C Computed in routine SUMC. 14 | CDOC INTEGER NOUTF > Results file unit identifier. 15 | CDOC INTEGER NTYPE > Stress state type flag. 16 | CDOC DOUBLE_PRECISION RSTAVA > Array of real state variables other than 17 | CDOC C the stress tensor components. 18 | CDOC DOUBLE_PRECISION STRES > Array of stress tensor components. 19 | CDOC END_PARAMETERS 20 | CHST 21 | CHST E.de Souza Neto, July 1996: Initial coding 22 | CHST 23 | SUBROUTINE ORMC 24 | 1( DGAM ,NOUTF ,NTYPE ,RSTAVA ,STRES ) 25 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 26 | PARAMETER(IPHARD=7 ,MSTRE=4) 27 | DIMENSION DGAM(2), RSTAVA(MSTRE+1), STRES(*) 28 | DATA R2 ,R3 / 2.0D0,3.0D0 / 29 | C*********************************************************************** 30 | C OUTPUT RESULTS (INTERNAL AND ALGORITHMIC VARIABLES) FOR THE 31 | C MOHR-COULOMB TYPE ELASTO-PLASTIC MATERIAL WITH ASSOCIATIVE/NON- 32 | C ASSOCIATIVE FLOW RULE AND NON-LINEAR ISOTROPIC HARDENING 33 | C*********************************************************************** 34 | 1000 FORMAT(' S-eff = ',G12.4,' Press.= ',G12.4,' Eps. = ',G12.4, 35 | 1 ' dgama = ',G12.4,' dgamb = ',G12.4) 36 | C 37 | EPBAR=RSTAVA(MSTRE+1) 38 | IF(NTYPE.EQ.1)THEN 39 | P=(STRES(1)+STRES(2))/R3 40 | EFFST=SQRT(R3/R2*((STRES(1)-P)**2+(STRES(2)-P)**2+ 41 | 1 R2*STRES(3)**2+P**2)) 42 | ELSEIF(NTYPE.EQ.2.OR.NTYPE.EQ.3)THEN 43 | P=(STRES(1)+STRES(2)+STRES(4))/R3 44 | EFFST=SQRT(R3/R2*((STRES(1)-P)**2+(STRES(2)-P)**2+ 45 | 1 R2*STRES(3)**2+(STRES(4)-P)**2)) 46 | ENDIF 47 | C Write to output file 48 | WRITE(NOUTF,1000)EFFST,P,EPBAR,DGAM(1),DGAM(2) 49 | RETURN 50 | END 51 | CDOC END_SUBROUTINE ORMC 52 | -------------------------------------------------------------------------------- /src/SOLVER/solint.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE SOLINT 2 | CDOC Interface for the solution of the linear system of equations 3 | CDOC 4 | CDOC This routine calls the corresponding function to perform the linear 5 | CDOC system solution, according to the selected method (currently 6 | CDOC frontal or MA41 - sparse multifrontal method). 7 | CDOC 8 | CDOC BEGIN_PARAMETERS 9 | CDOC DOUBLE_PRECISION DTIME > Time increment. 10 | CDOC INTEGER IITER > Current equilibrium iteration number. 11 | CDOC INTEGER KRESL > Equation resolution index. 12 | CDOC INTEGER IFNEG < Signum (+1/-1) of the determinant of the 13 | CDOC C stiffness matrix. 14 | CDOC INTEGER KUNLD <> Unloading flag. 15 | CDOC DOUBLE_PRECISION MXFRON > Maximum frontwidth encountered in the 16 | CDOC C system of linear finite element 17 | CDOC C equations. Used only by FRONT. 18 | CDOC LOGICAL UNSYM > Stiffness matrix unsymmetry flag. 19 | CDOC LOGICAL INCCUT < Load increment cutting flag. 20 | CDOC INTEGER NSOLVE > Solver type flag. 21 | CDOC END_PARAMETERS 22 | CHST 23 | CHST F.M. Andrade Pires, February 2002: Initial coding as SOLVER 24 | CHST 25 | CHST M.F. Adziman, D. de Bortoli, E.A. de Souza Neto, July 2013: 26 | CHST Modified to make it compatible with HYPLAS v3.1 27 | CHST 28 | SUBROUTINE SOLINT 29 | 1( DTIME ,IITER ,KRESL ,IFNEG ,KUNLD , 30 | 2 MXFRON ,UNSYM ,INCCUT ,NSOLVE ) 31 | IMPLICIT NONE 32 | C 33 | C Arguments 34 | C 35 | DOUBLE PRECISION DTIME 36 | INTEGER IITER, KRESL, IFNEG, KUNLD, MXFRON, NSOLVE 37 | LOGICAL UNSYM, INCCUT 38 | 39 | C 40 | C Call solver routine according to the type of solver 41 | C --------------------------------------------------- 42 | C 43 | IF(NSOLVE.EQ.1)THEN 44 | C Solves the system of equations by the frontal method 45 | CALL FRONT ( DTIME ,IITER ,KRESL ,IFNEG ,KUNLD , 46 | 1 MXFRON ,UNSYM ,INCCUT ) 47 | ELSEIF(NSOLVE.EQ.2)THEN 48 | C Multifrontal sparse Gaussian elimination: MA41 from HSL 49 | CALL INMA41 ( DTIME, IFNEG, IITER, INCCUT, KRESL, KUNLD, 50 | 1 UNSYM ) 51 | ELSE 52 | C Incorrect solver specification 53 | CALL ERRPRT('ED0302') 54 | ENDIF 55 | C 56 | RETURN 57 | END 58 | CDOC END_SUBROUTINE SOLINT 59 | -------------------------------------------------------------------------------- /src/TRESCA/ortr.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE ORTR 2 | CDOC Output results for the Tresca elasto-plastic material model 3 | CDOC 4 | CDOC This routine writes to the results file the internal and 5 | CDOC algorithmic variables of the Tresca elasto-plastic material model 6 | CDOC with non-linear isotropic hardening. The results printed here 7 | CDOC are the von Mises effective stress, the equivalent plastic strain 8 | CDOC and the incremental plastic multiplier(s) obtained by the return 9 | CDOC mapping algorithm of routine SUTR. 10 | CDOC 11 | CDOC BEGIN_PARAMETERS 12 | CDOC DOUBLE_PRECISION DGAM > Array of incremental plastic 13 | CDOC C multipliers. 14 | CDOC C Computed in routine SUTR. 15 | CDOC INTEGER NOUTF > Results file unit identifier. 16 | CDOC INTEGER NTYPE > Stress state type flag. 17 | CDOC DOUBLE_PRECISION RSTAVA > Array of real state variables other than 18 | CDOC C the stress tensor components. 19 | CDOC DOUBLE_PRECISION STRES > Array of stress tensor components. 20 | CDOC END_PARAMETERS 21 | CHST 22 | CHST E.de Souza Neto, June 1996: Initial coding 23 | CHST 24 | SUBROUTINE ORTR 25 | 1( DGAM ,NOUTF ,NTYPE ,RSTAVA ,STRES ) 26 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 27 | PARAMETER(IPHARD=4 ,MSTRE=4) 28 | DIMENSION DGAM(2), RSTAVA(MSTRE+1), STRES(*) 29 | DATA R2 ,R3 / 2.0D0,3.0D0 / 30 | C*********************************************************************** 31 | C OUTPUT RESULTS (INTERNAL AND ALGORITHMIC VARIABLES) FOR TRESCA 32 | C TYPE ELASTO-PLASTIC MATERIAL WITH NON-LINEAR ISOTROPIC HARDENING 33 | C*********************************************************************** 34 | 1000 FORMAT(' S-eff = ',G12.4,' Eps. = ',G12.4,' dgama = ',G12.4, 35 | 1 ' dgamb = ',G12.4) 36 | C 37 | EPBAR=RSTAVA(MSTRE+1) 38 | IF(NTYPE.EQ.1)THEN 39 | P=(STRES(1)+STRES(2))/R3 40 | EFFST=SQRT(R3/R2*((STRES(1)-P)**2+(STRES(2)-P)**2+ 41 | 1 R2*STRES(3)**2+P**2)) 42 | ELSEIF(NTYPE.EQ.2.OR.NTYPE.EQ.3)THEN 43 | P=(STRES(1)+STRES(2)+STRES(4))/R3 44 | EFFST=SQRT(R3/R2*((STRES(1)-P)**2+(STRES(2)-P)**2+ 45 | 1 R2*STRES(3)**2+(STRES(4)-P)**2)) 46 | ENDIF 47 | C Write to output file 48 | WRITE(NOUTF,1000)EFFST,EPBAR,DGAM(1),DGAM(2) 49 | RETURN 50 | END 51 | CDOC END_SUBROUTINE ORTR 52 | -------------------------------------------------------------------------------- /src/GENERAL/logstr.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE LOGSTR 2 | CDOC Logarithmic strain computation 3 | CDOC 4 | CDOC Given the left (right) Cauchy-Green strain tensor, this routine 5 | CDOC computes the corresponding Eulerian (Lagrangian) logarithmic strain 6 | CDOC tensor (engineering components). 7 | CDOC Plane strain, plane stress, axisymmetric and 3-D implementations. 8 | CDOC 9 | CDOC BEGIN_PARAMETERS 10 | CDOC DOUBLE_PRECISION B > Array of components of the Cauchy-Green 11 | CDOC C strain tensor. 12 | CDOC DOUBLE_PRECISION E < Array of (engineering) components of the 13 | CDOC C logarithmic strain tensor. 14 | CDOC INTEGER NTYPE > Stress state type flag. 15 | CDOC END_PARAMETERS 16 | CHST 17 | CHST E.de Souza Neto, August 1996: Initial coding (as EETRIA) 18 | CHST E.de Souza Neto, May 1998: Routine and some variables renamed 19 | CHST D. de Bortoli , March 2015: 3-D case added 20 | CHST 21 | SUBROUTINE LOGSTR 22 | 1( B ,E ,NTYPE ) 23 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 24 | EXTERNAL DLGD2 25 | LOGICAL OUTOFP, IS2D 26 | DIMENSION 27 | 1 B(*) ,E(*) 28 | DATA R2 /2.0D0/ 29 | C*********************************************************************** 30 | C COMPUTES THE LOGARITHMIC STRAIN TENSOR: 31 | C 32 | C E := 1/2 ln[ B ] 33 | C 34 | C REFERENCE: Box 14.3, item (ii) 35 | C*********************************************************************** 36 | IF(NTYPE.EQ.2.OR.NTYPE.EQ.3)THEN 37 | OUTOFP=.TRUE. 38 | IS2D=.TRUE. 39 | ELSEIF(NTYPE.EQ.1)THEN 40 | OUTOFP=.FALSE. 41 | IS2D=.TRUE. 42 | ELSEIF(NTYPE.EQ.4)THEN 43 | OUTOFP=.FALSE. 44 | IS2D=.FALSE. 45 | ELSE 46 | CALL ERRPRT('EI0022') 47 | ENDIF 48 | C Use isotropic tensor function to compute the logarithmic (physical) 49 | C strain components, then convert physical components into engineering 50 | C strain components... 51 | IF(IS2D)THEN 52 | C ...plane strain/stress and axisymmetric cases 53 | CALL ISO2 54 | 1( DLGD2 ,OUTOFP ,B ,E ) 55 | C 56 | E(3)=R2*E(3) 57 | ELSE 58 | C ...three-dimensional case 59 | CALL ISO3 60 | 1( DLGD2 ,B ,E ) 61 | C 62 | E(4:6)=R2*E(4:6) 63 | ENDIF 64 | C 65 | RETURN 66 | END 67 | CDOC END_SUBROUTINE LOGSTR 68 | -------------------------------------------------------------------------------- /src/VON_MISES_MIXED/orvmmx.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE ORVMMX 2 | CDOC Output results for the von Mises model with mixed hardening 3 | CDOC 4 | CDOC This routine writes to the results file the internal and 5 | CDOC algorithmic variables of the von Mises elasto-plastic material 6 | CDOC with non-linear mixed hardening. 7 | CDOC 8 | CDOC BEGIN_PARAMETERS 9 | CDOC DOUBLE_PRECISION DGAMA > Incremental plastic multiplier. 10 | CDOC C Computed in routine SUVMMX. 11 | CDOC INTEGER NOUTF > Results file unit identifier. 12 | CDOC INTEGER NTYPE > Stress state type flag. 13 | CDOC DOUBLE_PRECISION RSTAVA > Array of real state variables other than 14 | CDOC C the stress tensor components. 15 | CDOC DOUBLE_PRECISION STRES > Array of stress tensor components. 16 | CDOC END_PARAMETERS 17 | CHST 18 | CHST E.de Souza Neto, August 1999: Initial coding 19 | CHST 20 | SUBROUTINE ORVMMX 21 | 1( DGAMA ,NOUTF ,NTYPE ,RSTAVA ,STRES ) 22 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 23 | PARAMETER(IPHARD=4 ,MSTRE=4) 24 | C Arguments 25 | DIMENSION RSTAVA(2*MSTRE+1), STRES(*) 26 | C Local arrays and variables 27 | DIMENSION BACSTR(MSTRE) 28 | DATA R2 ,R3 / 2.0D0,3.0D0 / 29 | C*********************************************************************** 30 | C OUTPUT RESULTS (INTERNAL AND ALGORITHMIC VARIABLES) FOR VON MISES 31 | C ELASTO-PLASTIC MATERIAL WITH NON-LINEAR MIXED HARDENING 32 | C*********************************************************************** 33 | 1000 FORMAT(' b-xx = ',G12.4,' b-yy = ',G12.4,' b-xy = ',G12.4, 34 | 1 ' b-zz = ',G12.4) 35 | 1100 FORMAT(' S-eff = ',G12.4,' Eps. = ',G12.4,' dgama = ',G12.4) 36 | C 37 | C Plane strain and axisymmetric only 38 | IF(NTYPE.NE.2.AND.NTYPE.NE.3)CALL ERRPRT('EI0050') 39 | C Print backstress tensor 40 | BACSTR(1)=RSTAVA(6) 41 | BACSTR(2)=RSTAVA(7) 42 | BACSTR(3)=RSTAVA(8) 43 | BACSTR(4)=RSTAVA(9) 44 | WRITE(NOUTF,1000)BACSTR(1),BACSTR(2),BACSTR(3),BACSTR(4) 45 | C Compute effective stress 46 | IF(NTYPE.EQ.2.OR.NTYPE.EQ.3)THEN 47 | P=(STRES(1)+STRES(2)+STRES(4))/R3 48 | EFFST=SQRT(R3/R2*((STRES(1)-P)**2+(STRES(2)-P)**2+ 49 | 1 R2*STRES(3)**2+(STRES(4)-P)**2)) 50 | ENDIF 51 | EPBAR=RSTAVA(MSTRE+1) 52 | WRITE(NOUTF,1100)EFFST,EPBAR,DGAMA 53 | RETURN 54 | END 55 | CDOC END_SUBROUTINE ORVMMX 56 | -------------------------------------------------------------------------------- /src/GENERAL/arrgax.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE ARRGAX 2 | CDOC Arrange a fourth order tensor in matrix form with G matrix ordering 3 | CDOC 4 | CDOC This routine re-arranges a given fourth order tensor, stored as a 5 | CDOC 4-index array, in matrix form (2-index array) using G matrix 6 | CDOC component ordering. 7 | CDOC Implemented only for axisymmetric problems. 8 | CDOC 9 | CDOC BEGIN_PARAMETERS 10 | CDOC DOUBLE_PRECISION A4TH > Fourth order tensor stored as a 4-index 11 | CDOC C array. 12 | CDOC DOUBLE_PRECISION AMATX < 2-index array containing the components 13 | CDOC C of the given 4th order tensor stored 14 | CDOC C using G matrix ordering. 15 | CDOC END_PARAMETERS 16 | CDOC 17 | CDOC E.de Souza Neto, May 1999: Initial coding 18 | CDOC 19 | SUBROUTINE ARRGAX 20 | 1( A4TH ,AMATX ) 21 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 22 | PARAMETER 23 | 1( NDIM=3 ,NGDIM=5 ) 24 | C Arguments 25 | DIMENSION 26 | 1 A4TH(NDIM,NDIM,NDIM,NDIM) ,AMATX(NGDIM,NGDIM) 27 | C*********************************************************************** 28 | C RE-ARRANGES A FOURTH ORDER TENSOR, STORED AS A 4-INDEX ARRAY, IN 29 | C MATRIX FORM (2-INDEX ARRAY) USING G MATRIX COMPONENT ORDERING 30 | C (11,21,12,22,33). FOR AXISYMMETRIC CASE ONLY. 31 | C 32 | C REFERENCE: Section D.2.1 33 | C 34 | C*********************************************************************** 35 | C 36 | AMATX(1,1)=A4TH(1,1,1,1) 37 | AMATX(1,2)=A4TH(1,1,2,1) 38 | AMATX(1,3)=A4TH(1,1,1,2) 39 | AMATX(1,4)=A4TH(1,1,2,2) 40 | AMATX(1,5)=A4TH(1,1,3,3) 41 | C 42 | AMATX(2,1)=A4TH(2,1,1,1) 43 | AMATX(2,2)=A4TH(2,1,2,1) 44 | AMATX(2,3)=A4TH(2,1,1,2) 45 | AMATX(2,4)=A4TH(2,1,2,2) 46 | AMATX(2,5)=A4TH(2,1,3,3) 47 | C 48 | AMATX(3,1)=A4TH(1,2,1,1) 49 | AMATX(3,2)=A4TH(1,2,2,1) 50 | AMATX(3,3)=A4TH(1,2,1,2) 51 | AMATX(3,4)=A4TH(1,2,2,2) 52 | AMATX(3,5)=A4TH(1,2,3,3) 53 | C 54 | AMATX(4,1)=A4TH(2,2,1,1) 55 | AMATX(4,2)=A4TH(2,2,2,1) 56 | AMATX(4,3)=A4TH(2,2,1,2) 57 | AMATX(4,4)=A4TH(2,2,2,2) 58 | AMATX(4,5)=A4TH(2,2,3,3) 59 | C 60 | AMATX(5,1)=A4TH(3,3,1,1) 61 | AMATX(5,2)=A4TH(3,3,2,1) 62 | AMATX(5,3)=A4TH(3,3,1,2) 63 | AMATX(5,4)=A4TH(3,3,2,2) 64 | AMATX(5,5)=A4TH(3,3,3,3) 65 | C 66 | RETURN 67 | END 68 | CDOC END_SUBROUTINE ARRGAX 69 | -------------------------------------------------------------------------------- /src/MATHS/detm23.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_DOUBLE_PRECISION_FUNCTION DETM23 2 | CDOC Calculates the determinant of a 2x2 or 3x3 matrix. 3 | CDOC 4 | CDOC BEGIN_PARAMETERS 5 | CDOC INTEGER DIMA > Size of square matrix AMATX. 6 | CDOC DOUBLE_PRECISION AMATX > Matrix whose determinant is to be 7 | CDOC C calculated. 8 | CDOC INTEGER NDIM > Part of AMATX used for the determinant 9 | CDOC C calculation: if NDIM=2, the 2x2 part of 10 | CDOC C AMATX is used in the determinant 11 | CDOC C calculation; if NDIM=3, the 3x3 part is 12 | CDOC C is used instead. 13 | CDOC LOGICAL OUTOFP > .TRUE. if the out-of-plane component 14 | CDOC C (3,3) of a 2x2 matrix is used in the 15 | CDOC C determinant calculation. 16 | CDOC END_PARAMETERS 17 | CHST 18 | CHST D. de Bortoli , March 2015: Initial coding 19 | CHST 20 | DOUBLE PRECISION FUNCTION DETM23 21 | 1( DIMA ,AMATX ,NDIM ,OUTOFP ) 22 | IMPLICIT NONE 23 | C Arguments 24 | INTEGER , INTENT(IN) :: DIMA 25 | DOUBLE PRECISION, DIMENSION(DIMA,DIMA), INTENT(IN) :: AMATX 26 | INTEGER , INTENT(IN) :: NDIM 27 | LOGICAL , INTENT(IN) :: OUTOFP 28 | C 29 | C*********************************************************************** 30 | C CALCULATES THE DETERMINANT OF A 2X2 OR 3X3 MATRIX. 31 | C*********************************************************************** 32 | C 33 | IF(NDIM > DIMA)THEN 34 | CALL ERRPRT('EI0074') 35 | ENDIF 36 | C 2x2 determinant required 37 | IF(NDIM==2)THEN 38 | DETM23=AMATX(1,1)*AMATX(2,2) 39 | 1 -AMATX(1,2)*AMATX(2,1) 40 | C out-of-plane component of 2x2 determinant 41 | IF(OUTOFP)THEN 42 | DETM23=DETM23*AMATX(3,3) 43 | ENDIF 44 | C 3x3 determinant required 45 | ELSEIF(NDIM==3)THEN 46 | DETM23=AMATX(1,1)*AMATX(2,2)*AMATX(3,3) 47 | 1 +AMATX(1,2)*AMATX(2,3)*AMATX(3,1) 48 | 2 +AMATX(1,3)*AMATX(2,1)*AMATX(3,2) 49 | 3 -AMATX(1,2)*AMATX(2,1)*AMATX(3,3) 50 | 4 -AMATX(1,1)*AMATX(2,3)*AMATX(3,2) 51 | 5 -AMATX(1,3)*AMATX(2,2)*AMATX(3,1) 52 | ELSE 53 | CALL ERRPRT('EI0075') 54 | ENDIF 55 | C 56 | END FUNCTION DETM23 57 | CDOC END_DOUBLE_PRECISION_FUNCTION DETM23 -------------------------------------------------------------------------------- /src/GENERAL/atasym.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE ATASYM 2 | CDOC Converts the array representation of an asymmetric second order 3 | CDOC tensor to its matrix representation (2-index array). 4 | CDOC Implemented for both 2-D and 3-D tensors. 5 | CDOC 6 | CDOC BEGIN_PARAMETERS 7 | CDOC DOUBLE_PRECISION A > Array representation of a asymmetric 8 | CDOC C second order tensor. 9 | CDOC DOUBLE_PRECISION AMATX < Matrix representation of the given 10 | CDOC C asymmetric second order tensor. 11 | CDOC INTEGER NDIM > Number of spatial dimensions of tensor. 12 | CDOC LOGICAL OUTOFP > .TRUE. if the out-of-plane component 13 | CDOC C (3,3) of a 2-D tensor is required. 14 | CDOC END_PARAMETERS 15 | CHST 16 | CHST D. de Bortoli , March 2015: Initial coding 17 | CHST 18 | SUBROUTINE ATASYM 19 | 1( A ,AMATX ,NDIM ,OUTOFP ) 20 | IMPLICIT NONE 21 | C Arguments 22 | DOUBLE PRECISION, DIMENSION(9) , INTENT(IN) :: A 23 | DOUBLE PRECISION, DIMENSION(3,3), INTENT(OUT) :: AMATX 24 | INTEGER , INTENT(IN) :: NDIM 25 | LOGICAL , INTENT(IN) :: OUTOFP 26 | C 27 | DOUBLE PRECISION, PARAMETER :: R0=0.0D0 28 | C*********************************************************************** 29 | C RE-ARRANGES THE ARRAY REPRESENTATION OF AN ASYMMETRIC SECOND ORDER 30 | C TENSOR, FROM COMPONENT ORDERING (11,21,12,22,33) IN 2-D, OR 31 | C (11,21,31,12,22,32,13,23,33) IN 3-D, INTO ITS MATRIX REPRESENTATION. 32 | C 33 | C REFERENCE: Section D.2.1 34 | C*********************************************************************** 35 | C 36 | IF(NDIM==2)THEN 37 | AMATX(1,1)=A(1) 38 | AMATX(2,1)=A(2) 39 | AMATX(1,2)=A(3) 40 | AMATX(2,2)=A(4) 41 | AMATX(1,3)=R0 42 | AMATX(2,3)=R0 43 | AMATX(3,3)=R0 44 | AMATX(3,1)=R0 45 | AMATX(3,2)=R0 46 | C out-of-plane component 47 | IF(OUTOFP)THEN 48 | AMATX(3,3)=A(5) 49 | ELSE 50 | AMATX(3,3)=R0 51 | ENDIF 52 | ELSEIF(NDIM==3)THEN 53 | AMATX(1,1)=A(1) 54 | AMATX(2,1)=A(2) 55 | AMATX(3,1)=A(3) 56 | AMATX(1,2)=A(4) 57 | AMATX(2,2)=A(5) 58 | AMATX(3,2)=A(6) 59 | AMATX(1,3)=A(7) 60 | AMATX(2,3)=A(8) 61 | AMATX(3,3)=A(9) 62 | ELSE 63 | CALL ERRPRT('EI0071') 64 | ENDIF 65 | C 66 | END 67 | CDOC END_SUBROUTINE ATASYM 68 | -------------------------------------------------------------------------------- /src/GENERAL/atsym.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE ATSYM 2 | CDOC Converts the array representation of a symmetric second order 3 | CDOC tensor to its matrix representation (2-index array). 4 | CDOC Implemented for both 2-D and 3-D tensors. 5 | CDOC 6 | CDOC BEGIN_PARAMETERS 7 | CDOC DOUBLE_PRECISION A > Array representation of a symmetric 8 | CDOC C second order tensor. 9 | CDOC DOUBLE_PRECISION AMATX < Matrix representation of the given 10 | CDOC C symmetric second order tensor. 11 | CDOC INTEGER NDIM > Number of spatial dimensions of tensor. 12 | CDOC LOGICAL OUTOFP > .TRUE. if the out-of-plane component 13 | CDOC C (3,3) of a 2-D tensor is required. 14 | CDOC END_PARAMETERS 15 | CHST 16 | CHST D. de Bortoli , March 2015: Initial coding 17 | CHST 18 | SUBROUTINE ATSYM 19 | 1( A ,AMATX ,NDIM ,OUTOFP ) 20 | IMPLICIT NONE 21 | C Arguments 22 | DOUBLE PRECISION, DIMENSION(6) , INTENT(IN) :: A 23 | DOUBLE PRECISION, DIMENSION(3,3), INTENT(OUT) :: AMATX 24 | INTEGER , INTENT(IN) :: NDIM 25 | LOGICAL , INTENT(IN) :: OUTOFP 26 | C 27 | DOUBLE PRECISION, PARAMETER :: R0=0.0D0 28 | C*********************************************************************** 29 | C RE-ARRANGES THE ARRAY REPRESENTATION OF A SYMMETRIC SECOND ORDER 30 | C TENSOR, FROM COMPONENT ORDERING (11,22,12,33) IN 2-D, OR 31 | C (11,22,33,12,23,13) IN 3-D, INTO ITS MATRIX REPRESENTATION. 32 | C 33 | C REFERENCE: Section D.1 34 | C*********************************************************************** 35 | C 36 | IF(NDIM==2)THEN 37 | AMATX(1,1)=A(1) 38 | AMATX(2,2)=A(2) 39 | AMATX(1,2)=A(3) 40 | AMATX(2,1)=AMATX(1,2) 41 | AMATX(1,3)=R0 42 | AMATX(2,3)=R0 43 | AMATX(3,3)=R0 44 | AMATX(3,1)=R0 45 | AMATX(3,2)=R0 46 | C out-of-plane component 47 | IF(OUTOFP)THEN 48 | AMATX(3,3)=A(4) 49 | ELSE 50 | AMATX(3,3)=R0 51 | ENDIF 52 | ELSEIF(NDIM==3)THEN 53 | AMATX(1,1)=A(1) 54 | AMATX(2,2)=A(2) 55 | AMATX(3,3)=A(3) 56 | AMATX(1,2)=A(4) 57 | AMATX(2,3)=A(5) 58 | AMATX(1,3)=A(6) 59 | AMATX(2,1)=AMATX(1,2) 60 | AMATX(3,2)=AMATX(2,3) 61 | AMATX(3,1)=AMATX(1,3) 62 | ELSE 63 | CALL ERRPRT('EI0067') 64 | ENDIF 65 | C 66 | END 67 | CDOC END_SUBROUTINE ATSYM 68 | -------------------------------------------------------------------------------- /src/DRUCKER_PRAGER/ordp.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE ORDP 2 | CDOC Output results for the Drucker-Prager elasto-plastic model 3 | CDOC 4 | CDOC This routine writes to the results file the internal and 5 | CDOC algorithmic variables of the Drucker-Prager elasto-plastic 6 | CDOC material model with non-linear isotropic hardening. 7 | CDOC The results printed here are obtained in routine SUCADP. 8 | CDOC 9 | CDOC BEGIN_PARAMETERS 10 | CDOC DOUBLE_PRECISION DGAM > Array of incremental plastic 11 | CDOC C multipliers. 12 | CDOC INTEGER NOUTF > Results file unit identifier. 13 | CDOC INTEGER NTYPE > Stress state type flag. 14 | CDOC DOUBLE_PRECISION RSTAVA > Array of real state variables other than 15 | CDOC C the stress tensor components. 16 | CDOC DOUBLE_PRECISION STRES > Array of stress tensor components. 17 | CDOC END_PARAMETERS 18 | CHST 19 | CHST E.de Souza Neto, June 1996: Initial coding 20 | CHST 21 | SUBROUTINE ORDP 22 | 1( DGAM ,NOUTF ,NTYPE ,RSTAVA ,STRES ) 23 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 24 | PARAMETER(IPHARD=7 ,MSTRE=6) 25 | DIMENSION DGAM(1), RSTAVA(MSTRE+1), STRES(*) 26 | DATA R2 ,R3 / 2.0D0,3.0D0 / 27 | C*********************************************************************** 28 | C OUTPUT RESULTS (INTERNAL AND ALGORITHMIC VARIABLES) FOR DRUCKER-PRAGER 29 | C TYPE ELASTO-PLASTIC MATERIAL WITH ASSOCIATIVE/NON-ASSOCIATIVE FLOW 30 | C RULE AND NON-LINEAR ISOTROPIC HARDENING 31 | C*********************************************************************** 32 | 1000 FORMAT(' S-eff = ',G12.4,' Press.= ',G12.4,' Eps. = ',G12.4, 33 | 1 ' dgama = ',G12.4) 34 | C 35 | EPBAR=RSTAVA(MSTRE+1) 36 | IF(NTYPE.EQ.1)THEN 37 | P=(STRES(1)+STRES(2))/R3 38 | EFFST=SQRT(R3/R2*((STRES(1)-P)**2+(STRES(2)-P)**2+ 39 | 1 R2*STRES(3)**2+P**2)) 40 | ELSEIF(NTYPE.EQ.2.OR.NTYPE.EQ.3)THEN 41 | P=(STRES(1)+STRES(2)+STRES(4))/R3 42 | EFFST=SQRT(R3/R2*((STRES(1)-P)**2+(STRES(2)-P)**2+ 43 | 1 R2*STRES(3)**2+(STRES(4)-P)**2)) 44 | ELSE 45 | P=(STRES(1)+STRES(2)+STRES(3))/R3 46 | EFFST=SQRT(R3/R2*((STRES(1)-P)**2+(STRES(2)-P)**2+ 47 | 1 R2*STRES(4)**2+R2*STRES(5)**2+ 48 | 2 R2*STRES(6)**2+(STRES(3)-P)**2)) 49 | ENDIF 50 | C Write to output file 51 | WRITE(NOUTF,1000)EFFST,P,EPBAR,DGAM(1) 52 | RETURN 53 | END 54 | CDOC END_SUBROUTINE ORDP 55 | -------------------------------------------------------------------------------- /src/VON_MISES_MIXED_VISCO/orvvmx.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE ORVVMX 2 | CDOC Output results for a mixed hardening von Mises viscoplastic model 3 | CDOC 4 | CDOC This routine writes to the results file the internal and 5 | CDOC algorithmic variables of the von Mises elasto-viscoplastic material 6 | CDOC with non-linear mixed hardening and Peric's power law for 7 | CDOC viscoplastic flow. 8 | CDOC 9 | CDOC BEGIN_PARAMETERS 10 | CDOC DOUBLE_PRECISION DGAMA > Incremental plastic multiplier. 11 | CDOC C Computed in routine SUVMMX. 12 | CDOC INTEGER NOUTF > Results file unit identifier. 13 | CDOC INTEGER NTYPE > Stress state type flag. 14 | CDOC DOUBLE_PRECISION RSTAVA > Array of real state variables other than 15 | CDOC C the stress tensor components. 16 | CDOC DOUBLE_PRECISION STRES > Array of stress tensor components. 17 | CDOC END_PARAMETERS 18 | CHST 19 | CHST E.de Souza Neto & F.Adziman, September 2012: Initial coding 20 | CHST 21 | SUBROUTINE ORVVMX 22 | 1( DGAMA ,NOUTF ,NTYPE ,RSTAVA ,STRES ) 23 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 24 | PARAMETER(IPHARD=6 ,MSTRE=4) 25 | C Arguments 26 | DIMENSION RSTAVA(2*MSTRE+1), STRES(*) 27 | C Local arrays and variables 28 | DIMENSION BACSTR(MSTRE) 29 | DATA R2 ,R3 / 2.0D0,3.0D0 / 30 | C*********************************************************************** 31 | C OUTPUT RESULTS (INTERNAL AND ALGORITHMIC VARIABLES) FOR VON MISES 32 | C ELASTO-VISCOPLASTIC MATERIAL WITH NON-LINEAR MIXED HARDENING 33 | C AND PERIC'S POWER LAW FOR VISCOPLASTIC FLOW 34 | C*********************************************************************** 35 | 1000 FORMAT(' b-xx = ',G12.4,' b-yy = ',G12.4,' b-xy = ',G12.4, 36 | 1 ' b-zz = ',G12.4) 37 | 1100 FORMAT(' S-eff = ',G12.4,' Eps. = ',G12.4,' dgama = ',G12.4) 38 | C 39 | C Plane strain and axisymmetric only 40 | IF(NTYPE.NE.2.AND.NTYPE.NE.3)CALL ERRPRT('EI0063') 41 | C Print backstress tensor 42 | BACSTR(1)=RSTAVA(6) 43 | BACSTR(2)=RSTAVA(7) 44 | BACSTR(3)=RSTAVA(8) 45 | BACSTR(4)=RSTAVA(9) 46 | WRITE(NOUTF,1000)BACSTR(1),BACSTR(2),BACSTR(3),BACSTR(4) 47 | C Compute effective stress 48 | IF(NTYPE.EQ.2.OR.NTYPE.EQ.3)THEN 49 | P=(STRES(1)+STRES(2)+STRES(4))/R3 50 | EFFST=SQRT(R3/R2*((STRES(1)-P)**2+(STRES(2)-P)**2+ 51 | 1 R2*STRES(3)**2+(STRES(4)-P)**2)) 52 | ENDIF 53 | EPBAR=RSTAVA(MSTRE+1) 54 | WRITE(NOUTF,1100)EFFST,EPBAR,DGAMA 55 | RETURN 56 | END 57 | CDOC END_SUBROUTINE ORVVMX 58 | -------------------------------------------------------------------------------- /src/ELEMENTS/gaus1d.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE GAUS1D 2 | CDOC Set Gauss point positions and weights for 1-D Gauss quadratures 3 | CDOC 4 | CDOC Given the required number of integration points, 5 | CDOC this routine sets the sampling point positions and the 6 | CDOC corresponding weights for 1-D Gauss quadratures for numerical 7 | CDOC integration over the domain [-1,1]. 8 | CDOC 9 | CDOC BEGIN_PARAMETERS 10 | CDOC INTEGER NGAUS > Number of Gauss points. 11 | CDOC DOUBLE_PRECISION POSGP < Array containing the Gauss point 12 | CDOC C positions in the standard domain. 13 | CDOC DOUBLE_PRECISION WEIGP < Array containing the Gauss point 14 | CDOC C weights. 15 | CDOC END_PARAMETERS 16 | CHST 17 | CHST E.de Souza Neto, July 1996: Initial coding 18 | CHST 19 | SUBROUTINE GAUS1D 20 | 1( NGAUS ,POSGP ,WEIGP ) 21 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 22 | DIMENSION 23 | 1 POSGP(*) ,WEIGP(*) 24 | C*********************************************************************** 25 | C SET SAMPLING POINTS POSITIONS AND WEIGHTS FOR GAUSSIAN NUMERICAL 26 | C INTEGRATION RULES IN 1-D (INTEGRATION OVER LIMITS [-1,1]). 27 | C 28 | C REFERENCE: Expression (4.36) 29 | C OC Zienkiewicz & RL Taylor. The finite element method, 30 | C Volume 1: The basis. 5th Edn. Butterworth Heinemann, 2000. 31 | C J Fish & T Belytschko. A first course in finite element 32 | C analysis. Wiley, Chichester, 2007. 33 | C*********************************************************************** 34 | IF(NGAUS.EQ.1)THEN 35 | POSGP(1)=0.0D0 36 | WEIGP(1)=2.0D0 37 | ELSEIF(NGAUS.EQ.2)THEN 38 | POSGP(1)=-0.577350269189626D0 39 | WEIGP(1)=1.0D0 40 | POSGP(2)=+0.577350269189626D0 41 | WEIGP(2)=1.0D0 42 | ELSEIF(NGAUS.EQ.3)THEN 43 | POSGP(1)=-0.774596669241483D0 44 | WEIGP(1)=0.555555555555556D0 45 | POSGP(2)=+0.0D0 46 | WEIGP(2)=0.888888888888889D0 47 | POSGP(3)=+0.774596669241483D0 48 | WEIGP(3)=0.555555555555556D0 49 | ELSEIF(NGAUS.EQ.4)THEN 50 | POSGP(1)=-0.861136311594053D0 51 | WEIGP(1)=0.347854845137454D0 52 | POSGP(2)=-0.339981043584856D0 53 | WEIGP(2)=0.652145154862546D0 54 | POSGP(3)=+0.339981043584856D0 55 | WEIGP(3)=0.652145154862546D0 56 | POSGP(4)=+0.861136311594053D0 57 | WEIGP(4)=0.347854845137454D0 58 | ELSE 59 | CALL ERRPRT('EI0004') 60 | ENDIF 61 | C 62 | RETURN 63 | END 64 | CDOC END_SUBROUTINE GAUS1D 65 | -------------------------------------------------------------------------------- /src/GENERAL/setbe.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE SETBE 2 | CDOC Obtains the left Cauchy-Green strain tensor from the log strain 3 | CDOC 4 | CDOC Given the Eulerian (Lagrangian) logarithmic strain tensor, this 5 | CDOC routine computes the corresponding left (right) Cauchy-Green 6 | CDOC strain tensor. 7 | CDOC Plane strain, plane stress, axisymmetric and 3-D implementations. 8 | CDOC In the present implementation, the out-of-plane component is 9 | CDOC always computed for the plane strain/stress and axisymmetric cases. 10 | CDOC 11 | CDOC BEGIN_PARAMETERS 12 | CDOC DOUBLE_PRECISION BE <> Array of engineering logarithmic strain 13 | CDOC C components on entry. Returns as the 14 | CDOC C array of components of the corresponding 15 | CDOC C Cauchy-Green strain tensor. 16 | CDOC INTEGER NTYPE > Stress state type flag. 17 | CDOC END_PARAMETERS 18 | CHST 19 | CHST E.de Souza Neto, August 1996: Initial coding 20 | CHST E.de Souza Neto, June 2003: Out-of-plane always computed 21 | CHST D. de Bortoli , March 2015: 3-D case added 22 | CHST 23 | SUBROUTINE SETBE 24 | 1( BE ,NTYPE ) 25 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 26 | EXTERNAL EXP2X 27 | LOGICAL OUTOFP, IS2D 28 | DIMENSION BE(*) 29 | DATA RP5 /0.5D0/ 30 | C*********************************************************************** 31 | C COMPUTES THE ELASTIC CAUCHY-GREEN TENSOR AS A FUNCTION OF 32 | C THE ELASTIC LOGARITHMIC STRAIN TENSOR: 33 | C 34 | C Be := exp[ 2 Ee ] 35 | C 36 | C REFERENCE: Box 14.3, item (ii) 37 | C*********************************************************************** 38 | IF(NTYPE.EQ.2.OR.NTYPE.EQ.3)THEN 39 | OUTOFP=.TRUE. 40 | IS2D=.TRUE. 41 | ELSEIF(NTYPE.EQ.1)THEN 42 | OUTOFP=.TRUE. 43 | IS2D=.TRUE. 44 | ELSEIF(NTYPE.EQ.4)THEN 45 | OUTOFP=.FALSE. 46 | IS2D=.FALSE. 47 | ELSE 48 | CALL ERRPRT('EI0024') 49 | ENDIF 50 | C Convert engineering elastic strain components into physical components 51 | C and use isotropic tensor function to compute elastic Cauchy-Green 52 | C strain tensor... 53 | IF(IS2D)THEN 54 | C ...plane strain/stress and axisymmetric cases 55 | BE(3)=RP5*BE(3) 56 | CALL ISO2 57 | 1( EXP2X ,OUTOFP ,BE ,BE ) 58 | C ...three-dimensional case 59 | ELSE 60 | BE(4:6)=RP5*BE(4:6) 61 | CALL ISO3 62 | 1( EXP2X ,BE ,BE ) 63 | ENDIF 64 | C 65 | RETURN 66 | END 67 | CDOC END_SUBROUTINE SETBE 68 | -------------------------------------------------------------------------------- /src/GENERAL/algor.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE ALGOR 2 | CDOC Sets equation resolution index (flag) according to chosen algorithm 3 | CDOC 4 | CDOC This routine sets the equation resolution index KRESL according to 5 | CDOC the selected algorithm for solution of the non-linear equilibrium 6 | CDOC problem. 7 | CDOC 8 | CDOC BEGIN_PARAMETERS 9 | CDOC INTEGER IINCS > Current load increment number. 10 | CDOC INTEGER IITER > Current equilibrium iteration number. 11 | CDOC INTEGER KRESL < Equation resolution index. 12 | CDOC INTEGER KLUND > Unloading flag. 13 | CDOC END_PARAMETERS 14 | CDOC 15 | SUBROUTINE ALGOR(IINCS ,IITER ,KRESL ,KUNLD ) 16 | C 17 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 18 | C 19 | C Hyplas database: Global parameters and common blocks 20 | INCLUDE '../MAXDIM.INC' 21 | INCLUDE '../MATERIAL.INC' 22 | INCLUDE '../ELEMENTS.INC' 23 | INCLUDE '../GLBDBASE.INC' 24 | C Numerical constants 25 | DATA R0 /0.0D0/ 26 | C*********************************************************************** 27 | C SETS EQUATION RESOLUTION INDEX, KRESL, ACCORDING TO SELECTED ITERATIVE 28 | C ALGORITHM FOR SOLUTION OF THE NON-LINEAR EQUILIBRIUM PROBLEM 29 | C 30 | C REFERENCE: Section 5.4.4 31 | C*********************************************************************** 32 | C 33 | C Set KRESL 34 | C --------- 35 | KRESL=2 36 | IABSN=IABS(NALGO) 37 | C Initial stiffness method 38 | IF(IABSN.EQ.1.AND.IINCS.EQ.1.AND.IITER.EQ.1) KRESL=1 39 | C Newton-Raphson tangential stiffness method 40 | IF(IABSN.EQ.2) KRESL=1 41 | C Modified Newton KT1 42 | IF(IABSN.EQ.3.AND.IITER.EQ.1) KRESL=1 43 | C Modified Newton KT2 44 | IF(IABSN.EQ.4.AND.IINCS.EQ.1.AND.IITER.EQ.1) KRESL=1 45 | IF(IABSN.EQ.4.AND.IITER.EQ.1.AND.KUNLD.EQ.1) KRESL=1 46 | IF(IABSN.EQ.4.AND.IITER.EQ.2) KRESL=1 47 | C Secant Newton - Initial stiffness 48 | IF(IABSN.EQ.5.AND.IINCS.EQ.1.AND.IITER.EQ.1) KRESL=1 49 | C Secant Newton - KT1 50 | IF(IABSN.EQ.6.AND.IITER.EQ.1) KRESL=1 51 | C Secant Newton - KT2 52 | IF(IABSN.EQ.7.AND.IINCS.EQ.1.AND.IITER.EQ.1) KRESL=1 53 | IF(IABSN.EQ.7.AND.IITER.EQ.1.AND.KUNLD.EQ.1) KRESL=1 54 | IF(IABSN.EQ.7.AND.IITER.EQ.2) KRESL=1 55 | C 56 | C Zero prescribed displacements if not first iteration 57 | C ---------------------------------------------------- 58 | IF(IITER.GT.1)THEN 59 | NRHS=1 60 | IF(NALGO.LT.0)NRHS=2 61 | DO 20 ITOTV = 1,NTOTV 62 | DO 10 IRHS=1,NRHS 63 | FIXED(ITOTV,IRHS)=R0 64 | 10 CONTINUE 65 | 20 CONTINUE 66 | ENDIF 67 | C 68 | RETURN 69 | END 70 | CDOC END_SUBROUTINE ALGOR 71 | -------------------------------------------------------------------------------- /src/MATHS/iso3.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE ISO3 2 | CDOC Computes the value of isotropic tensor functions of one tensor. 3 | CDOC 4 | CDOC This subroutine evaluates isotropic tensor functions Y(X), of one 5 | CDOC tensor belonging to the class described below. 6 | CDOC This implementation is restricted to 3-D. 7 | CDOC The class of symmetric tensor functions Y(X) is assumed to be 8 | CDOC defined as Y(X)= Sum[y(xi) ei(x)ei], where the scalar function 9 | CDOC y(xi) defines the eigenvalues of the tensor Y and xi the 10 | CDOC eigenvalues of the tensor X. ei are the egenvectors of X (which by 11 | CDOC definition of Y(X), coincide with those of tensor Y) and "(x)" 12 | CDOC denotes the tensor product. 13 | CDOC 14 | CDOC BEGIN_PARAMETERS 15 | CDOC SYMBOLIC_NAME FUNC > Symbolic name of the double 16 | CDOC C precision function defining y(xi). 17 | CDOC DOUBLE_PRECISION X > Array of components of the tensor at 18 | CDOC C which the function is to be evaluated. 19 | CDOC DOUBLE_PRECISION Y < Array of components of the tensor 20 | CDOC C function at X. 21 | CDOC END_PARAMETERS 22 | CHST 23 | CHST D. de Bortoli, March 2015: Initial coding, based on ISO2 24 | CHST 25 | SUBROUTINE ISO3 26 | 1( FUNC ,X ,Y ) 27 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 28 | PARAMETER 29 | 1( MCOMP=6 ,NDIM=3 ) 30 | LOGICAL REPEAT(5) 31 | DIMENSION 32 | 1 X(MCOMP) ,Y(MCOMP) 33 | DIMENSION 34 | 1 EIGPRJ(MCOMP,NDIM) ,EIGX(NDIM) , 35 | 1 EIGY(NDIM) 36 | C*********************************************************************** 37 | C COMPUTE THE TENSOR Y (STORED IN VECTOR FORM) AS AN ISOTROPIC 38 | C FUNCTION OF THE TYPE: 39 | C 40 | C Y(X) = sum{ y(x_i) E_i } 41 | C 42 | C WHERE Y AND X ARE SYMMETRIC TENSORS, x_i AND E_i ARE, RESPECTIVELY 43 | C THE EIGENVALUES AND EIGENPROJECTIONS OF X, AND y(.) IS A SCALAR 44 | C FUNCTION. THIS ROUTINE IS RESTRICTED TO 3-D. 45 | C 46 | C REFERENCE: Section A.5 47 | C*********************************************************************** 48 | C Performs the spectral decomposition of X 49 | CALL SPDEC3 50 | 1( EIGPRJ ,EIGX ,REPEAT ,X ) 51 | C Computes the eigenvalues of Y 52 | DO 10 IDIR=1,NDIM 53 | EIGY(IDIR)=FUNC(EIGX(IDIR)) 54 | 10 CONTINUE 55 | C Assembles Y (in vector form) 56 | CALL RVZERO(Y,MCOMP) 57 | DO 30 ICOMP=1,MCOMP 58 | DO 20 IDIR=1,NDIM 59 | Y(ICOMP)=Y(ICOMP)+EIGY(IDIR)*EIGPRJ(ICOMP,IDIR) 60 | 20 CONTINUE 61 | 30 CONTINUE 62 | RETURN 63 | END 64 | CDOC END_SUBROUTINE ISO3 65 | -------------------------------------------------------------------------------- /src/ELASTIC/rdel.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE RDEL 2 | CDOC Read data for the linear elastic material model. 3 | CDOC 4 | CDOC This routine reads from the data file and echos to the results file 5 | CDOC the material parameters necessary for the linear elastic material 6 | CDOC model. 7 | CDOC 8 | CDOC BEGIN_PARAMETERS 9 | CDOC INTEGER MRPROP > Dimension of the global array of real 10 | CDOC C material variables. 11 | CDOC INTEGER MRSTAV > Dimension of the global array of real 12 | CDOC C state variables. 13 | CDOC DOUBLE_PRECISION RPROPS < Array of real material properties. 14 | CDOC LOGICAL UNSYM < Unsymmetric tangent stiffness flag. 15 | CDOC END_PARAMETERS 16 | CHST 17 | CHST E.de Souza Neto, September 1996: Initial coding 18 | CHST 19 | CHST E.de Souza Neto, April 2011: I/O error message added 20 | CHST 21 | SUBROUTINE RDEL 22 | 1( MRPROP ,MRSTAV ,RPROPS ,UNSYM ) 23 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 24 | LOGICAL UNSYM 25 | PARAMETER( NRSTAV=6 ) 26 | DIMENSION 27 | 1 RPROPS(*) 28 | DATA R0 ,RP5 ,R1 ,R2 ,R3 / 29 | 1 0.0D0,0.5D0,1.0D0,2.0D0,3.0D0/ 30 | C*********************************************************************** 31 | C READ AND ECHO MATERIAL PROPERTIES FOR LINEAR ELASTIC MATERIAL MODEL 32 | C*********************************************************************** 33 | 1000 FORMAT(' LINEAR ELASTIC material (HENCKY material in large', 34 | 1 ' strains)'/) 35 | 1010 FORMAT( 36 | 1' Mass density ...................................... =',G15.6/ 37 | 2' Young''s modulus ................................... =',G15.6/ 38 | 3' Poisson''s ratio ................................... =',G15.6) 39 | C 40 | C Set unsymmetric tangent stiffness flag 41 | C 42 | UNSYM=.FALSE. 43 | C 44 | C Read and echo material properties 45 | C 46 | WRITE(16,1000) 47 | READ(15,*,ERR=100,END=100)DENSE 48 | READ(15,*,ERR=100,END=100)YOUNG,POISS 49 | WRITE(16,1010)DENSE,YOUNG,POISS 50 | IF(YOUNG.LT.R0)CALL ERRPRT('ED0077') 51 | IF(POISS.LE.-R1.OR.POISS.GE.RP5)CALL ERRPRT('ED0078') 52 | GMODU=YOUNG/(R2*(R1+POISS)) 53 | BULK=YOUNG/(R3*(R1-R2*POISS)) 54 | C 55 | C Set vector of real material properties 56 | C 57 | NRPROP=4 58 | IF(NRPROP.GT.MRPROP)CALL ERRPRT('ED0181') 59 | RPROPS(1)=DENSE 60 | RPROPS(2)=GMODU 61 | RPROPS(3)=BULK 62 | RPROPS(4)=YOUNG 63 | C 64 | C Check dimensioning of RSTAVA 65 | IF(NRSTAV.GT.MRSTAV)CALL ERRPRT('ED0182') 66 | C 67 | GOTO 200 68 | C Issue error message and abort program execution in case of I/O error 69 | 100 CALL ERRPRT('ED0204') 70 | C 71 | 200 CONTINUE 72 | RETURN 73 | END 74 | CDOC END_SUBROUTINE RDEL 75 | -------------------------------------------------------------------------------- /src/GENERAL/greet.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE GREET 2 | CDOC Prints HYPLAS greeting message on the standard output 3 | CDOC 4 | SUBROUTINE GREET 5 | 1000 FORMAT(//////////////////, 6 | 1' __________________________________________________________', 7 | 2'______________ '/ 8 | 3' |_|_|_|_|_|_|_|_|_|_|_|_|_|_|_| ', 9 | 4' |'/ 10 | 5' |_|_|_|_|_|_|_|_|_|_| ', 11 | 6' |'/ 12 | 7' |_|_|_|_|_|_| ', 13 | 8' |'/ 14 | 9' |_|_|_|_| ', 15 | O' |'/ 16 | 1' |_|_|_| H Y P L A S version 4.0.1 ', 17 | 2' |'/ 18 | 3' |_|_| ============================= ', 19 | 4' |'/ 20 | 5' |_|_| ', 21 | 6' _|'/ 22 | 7' |_|_| ', 23 | 8' |_|') 24 | 1010 FORMAT( 25 | 1' |_|_|_ ', 26 | 2' |_|'/ 27 | 3' |_|_|_|_ SMALL AND LARGE STRAIN FINITE ELEMENT ANALYSIS', 28 | 4' _|_|'/ 29 | 5' |_|_|_|_| OF HYPERELASTIC AND VISCO-ELASTO-PLASTIC SOLIDS', 30 | 6' |_|_|'/ 31 | 7' |_|_|_|_|_ ', 32 | 8' _ _|_|_|'/ 33 | 9' |_|_|_|_|_| ', 34 | O' _|_|_|_|_|'/ 35 | 1' |_|_|_|_|_|_ _ ', 36 | 2' _ _|_|_|_|_|_|'/ 37 | 3' |_|_|_|_|_|_|_|____________________________________________', 38 | 4'|_|_|_|_|_|_|_|') 39 | 1020 FORMAT( 40 | 1' | , ', 41 | 2' |'/ 42 | 3' | Copyright (c) 1996-2015 EA de Souza Neto, D Peric & ', 43 | 4'DRJ Owen |'/ 44 | 5' |__________________________________________________________', 45 | 6'______________|'/ 46 | 7' | ', 47 | 8' |'/ 48 | 9' | Companion to the textbook: ', 49 | O' |'/ 50 | 1' | EA de Souza Neto, D Peric & DRJ Owen. Computational Me', 51 | 2'thods for |'/ 52 | 3' | Plasticity: Theory and Applications. Wiley, Chichester', 53 | 4', 2008. |'/ 54 | 3' |__________________________________________________________', 55 | 4'______________|'///) 56 | WRITE(*,1000) 57 | WRITE(*,1010) 58 | WRITE(*,1020) 59 | RETURN 60 | END 61 | CDOC END_SUBROUTINE GREET 62 | -------------------------------------------------------------------------------- /src/GENERAL/initia.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE INITIA 2 | CDOC Initialises some arrays and problem control variables. 3 | CDOC 4 | CDOC This routine initialises various arrays and problem control 5 | CDOC variables. Gauss-point-related quantities (such as stresses and 6 | CDOC other state and algorithmic variables) are initialised by 7 | CDOC calling the corresponding material interface routine. 8 | CDOC 9 | CDOC BEGIN_PARAMETERS 10 | CDOC DOUBLE_PRECISION DLAMD < Iterative load factor. 11 | CDOC INTEGER IFNEG < Signum (+1/-1) of the stiffness matrix 12 | CDOC C determinant. 13 | CDOC INTEGER KLUND < Unloading flag. 14 | CDOC DOUBLE_PRECISION TFACT < Total load factor. 15 | CDOC DOUBLE_PRECISION TTIME < Time. 16 | CDOC END_PARAMETERS 17 | CDOC 18 | SUBROUTINE INITIA 19 | 1( DLAMD ,IFNEG ,KUNLD ,TFACT ,TTIME ) 20 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 21 | C Hyplas global database 22 | INCLUDE '../MAXDIM.INC' 23 | INCLUDE '../MATERIAL.INC' 24 | INCLUDE '../ELEMENTS.INC' 25 | INCLUDE '../GLBDBASE.INC' 26 | C Local variables and numerical constants 27 | LOGICAL LDUMMY 28 | DATA R0 / 29 | 1 0.0D0/ 30 | C*********************************************************************** 31 | C INITIALISES SOME ARRAYS AND VARIABLES 32 | C 33 | C REFERENCE: Section 5.3.4 34 | C*********************************************************************** 35 | KUNLD=0 36 | TFACT=R0 37 | TTIME=R0 38 | DLAMD=R0 39 | IFNEG=1 40 | DO 10 IELEM=1,NELEM 41 | IGRUP=IGRPID(IELEM) 42 | IELIDN=IELTID(IGRUP) 43 | NEVAB=IELPRP(5,IELIDN) 44 | CALL RVZERO(ELOAD(1,IELEM),NEVAB) 45 | CALL RVZERO(ELOADO(1,IELEM),NEVAB) 46 | 10 CONTINUE 47 | CALL RVZERO(DTANG,NTOTV) 48 | CALL RVZERO(TDISP,NTOTV) 49 | CALL RVZERO(TDISPO,NTOTV) 50 | CALL RVZERO(DINCR,NTOTV) 51 | CALL RVZERO(DINCRO,NTOTV) 52 | CALL RVZERO(DITER,NTOTV) 53 | C Arrays from common block STATE 54 | DO 30 IELEM=1,NELEM 55 | IGRUP=IGRPID(IELEM) 56 | IELIDN=IELTID(IGRUP) 57 | NGAUSP=IELPRP(4,IELIDN) 58 | DO 20 IGAUSP=1,NGAUSP 59 | C Call material interface routine to initialise material-specific Gauss 60 | C point data 61 | MODE=0 62 | CALL MATISW 63 | 1( MODE ,NLARGE ,NTYPE , 64 | 2 IPROPS(1,MATTID(IGRUP)),LALGVA(1,IGAUSP,IELEM,1) , 65 | 3 LDUMMY ,RALGVA(1,IGAUSP,IELEM,1) ,DUMMY , 66 | 4 RPROPS(1,MATTID(IGRUP)) , 67 | 5 RSTAVA(1,IGAUSP,IELEM,1) ,DUMMY , 68 | 6 STRSG(1,IGAUSP,IELEM,1) ,DUMMY ) 69 | 20 CONTINUE 70 | 30 CONTINUE 71 | RETURN 72 | END 73 | CDOC END_SUBROUTINE INITIA 74 | -------------------------------------------------------------------------------- /src/MATHS/plfun.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_DOUBLE_PRECISION_FUNCTION PLFUN 2 | CDOC Returns the value of a piece-wise linear scalar function 3 | CDOC 4 | CDOC This function returns the value of a piece-wise linear scalar 5 | CDOC function F(X) defined by a set of NPOINT pairs (X,F(X)) passed in 6 | CDOC the matrix argument XFX. 7 | CDOC 8 | CDOC BEGIN_PARAMETERS 9 | CDOC DOUBLE_PRECISION X > Point at which the function will be 10 | CDOC C evaluated. 11 | CDOC INTEGER NPOINT > Number of points defining the piece-wise 12 | CDOC C linear function. 13 | CDOC DOUBLE_PRECISION XFX > Matrix (dimension 2*NPOINT) 14 | CDOC C containing the pairs (x,f(x)) which 15 | CDOC C define the piece-wise linear function. 16 | CDOC C evaluated. Each column of XFX 17 | CDOC C contains a pair (xi,f(xi)). The pairs 18 | CDOC C supplied in XFX 19 | CDOC C must be ordered such that the x's are 20 | CDOC C monotonically increasing. That is, the 21 | CDOC C x [XFX(1,i+1)] of a column i+1 must be 22 | CDOC C greater than XFX(1,i) (x of column i). 23 | CDOC C If X < XFX(1,1) the 24 | CDOC C piece-wise linear function is assumed 25 | CDOC C constant equal to XFX(1,1). 26 | CDOC C If X > XFX(1,NPOINT) the 27 | CDOC C piece-wise linear function is assumed 28 | CDOC C constant equal to XFX(1,NPOINT). 29 | CDOC END_PARAMETERS 30 | CHST 31 | CHST E.de Souza Neto, August 1992: Initial coding 32 | CHST 33 | DOUBLE PRECISION FUNCTION PLFUN(X, NPOINT, XFX) 34 | C 35 | INTEGER NPOINT, I 36 | DOUBLE PRECISION X, XFX(2,*) 37 | C*********************************************************************** 38 | C PIECEWISE LINEAR FUNCTION DEFINED BY A SET OF NPOINT PAIRS 39 | C {X,F(X)} STORED IN THE MATRIX XFX (DIM. 2*NPOINT). 40 | C*********************************************************************** 41 | DO 100 I=1,NPOINT 42 | IF (X.GE.XFX(1,I)) THEN 43 | GOTO 100 44 | ELSE 45 | IF (I.EQ.1) THEN 46 | C -- x < x1 --> f(x)=f(x1) --- 47 | PLFUN=XFX(2,1) 48 | GOTO 999 49 | ELSE 50 | C -- x(i-1) <= x < x(i) --- 51 | PLFUN=XFX(2,I-1)+(X-XFX(1,I-1))* 52 | 1 (XFX(2,I)-XFX(2,I-1))/ 53 | 2 (XFX(1,I)-XFX(1,I-1)) 54 | GOTO 999 55 | ENDIF 56 | ENDIF 57 | 100 CONTINUE 58 | C ---- x >= x(npoint) --> f(x) = f(x(npoint)) --- 59 | PLFUN=XFX(2,NPOINT) 60 | 999 CONTINUE 61 | RETURN 62 | END 63 | CDOC END_DOUBLE_PRECISION_FUNCTION PLFUN 64 | -------------------------------------------------------------------------------- /src/ELEMENTS/extnod.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE EXTNOD 2 | CDOC Extrapolates Gauss point values of a given field to nodes 3 | CDOC 4 | CDOC This routine extrapolates the Gauss point values of a given field 5 | CDOC to the nodes of a finite element. It simply multiplies the 6 | CDOC coefficients matrix for extrapolation EXMATX by the matrix VARGP 7 | CDOC which contains the value of each component of the given field in 8 | CDOC all integration points of the element. 9 | CDOC The results stored in the argument VARNOD are the extrapolated 10 | CDOC (or locally smoothed) values of the components of the given field 11 | CDOC at the nodes of the element. 12 | CDOC 13 | CDOC BEGIN_PARAMETERS 14 | CDOC DOUBLE_PRECISION EXMATX > Extrapolation matrix. Dimension 15 | CDOC C NNODE x NGAUSP. 16 | CDOC DOUBLE_PRECISION VARGP > Matrix containing, in each column, 17 | CDOC C the Gauss point value of all 18 | CDOC C components of the given field. 19 | CDOC C Dimension NVAR x NGAUSP. 20 | CDOC DOUBLE_PRECISION VARNOD < Matrix containing, in each column, 21 | CDOC C the (extrapolated) nodal value of all 22 | CDOC C components of the given field. 23 | CDOC C Dimension NVAR x NNODE. 24 | CDOC INTEGER NVAR > Number of components of the given field. 25 | CDOC INTEGER NGAUSP > Number of Gauss points. 26 | CDOC INTEGER NNODE > Number of nodes of the element. 27 | CDOC END_PARAMETERS 28 | CHST 29 | CHST E.de Souza Neto, August 1996: Initial coding 30 | CHST 31 | SUBROUTINE EXTNOD 32 | 1( EXMATX ,VARGP ,VARNOD ,NVAR ,NGAUSP , 33 | 2 NNODE ) 34 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 35 | INCLUDE '../ELEMENTS.INC' 36 | DIMENSION 37 | 1 EXMATX(NNODE,NGAUSP),VARGP(NVAR,NGAUSP),VARNOD(NVAR,NNODE) 38 | C*********************************************************************** 39 | C EXTRAPOLATES GAUSS POINT VALUES OF A GIVEN FIELD TO NODES 40 | C 41 | C REFERENCE: Section 5.6.1 42 | C E Hinton & JS Campbel. Local and global Smoothing of 43 | C discontinuous finite element functions using a least 44 | C squares method. Int. J. Num. meth. Engng., 8:461-480, 1974. 45 | C E Hinton & DRJ Owen. An introduction to finite element 46 | C computations. Pineridge Press, Swansea, 1979. 47 | C*********************************************************************** 48 | CALL RVZERO(VARNOD,NVAR*NNODE) 49 | DO 30 IVAR=1,NVAR 50 | DO 20 INODE=1,NNODE 51 | DO 10 IGAUSP=1,NGAUSP 52 | VARNOD(IVAR,INODE)=VARNOD(IVAR,INODE)+ 53 | 1 EXMATX(INODE,IGAUSP)*VARGP(IVAR,IGAUSP) 54 | 10 CONTINUE 55 | 20 CONTINUE 56 | 30 CONTINUE 57 | C 58 | RETURN 59 | END 60 | CDOC END_SUBROUTINE EXTNOD 61 | -------------------------------------------------------------------------------- /src/VON_MISES/tuvm.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE TUVM 2 | CDOC Thickness update for large strain von Mises model in plane stress 3 | CDOC 4 | CDOC This routine updates the thickness for the von Mises model under 5 | CDOC plane stress and large strains. It also computes the total 6 | CDOC deformation gradient (including the thickness strain contribution). 7 | CDOC The corresponding state update procedure for the von Mises model 8 | CDOC is carried out in subroutine SUVMPS. 9 | CDOC 10 | CDOC BEGIN_PARAMETERS 11 | CDOC DOUBLE_PRECISION DETF <> Determinant of the current in-plane 12 | CDOC C deformation gradient on entry. Returns 13 | CDOC C as the determinant of the current total 14 | CDOC C deformation gradient (including the 15 | CDOC C thickness strain contribution). 16 | CDOC DOUBLE_PRECISION RSTAVA > Array of current (updated) real state 17 | CDOC C variables other than the stress tensor 18 | CDOC C components. 19 | CDOC DOUBLE_PRECISION THICK <> Initial (reference) thickness on entry. 20 | CDOC C Returns as the current (updated) 21 | CDOC C thickness. 22 | CDOC INTEGER MODE > Flag. If MODE.NE.1, then only the total 23 | CDOC C deformation gradient is computed. 24 | CDOC C If MODE = 1, then the thickness is 25 | CDOC C updated in addition. 26 | CDOC END_PARAMETERS 27 | CHST 28 | CHST E.de Souza Neto, June 2003: Initial coding 29 | CHST 30 | SUBROUTINE TUVM 31 | 1( DETF ,RSTAVA ,THICK ,MODE ) 32 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 33 | PARAMETER( MSTRE=4 ) 34 | DIMENSION 35 | 1 RSTAVA(MSTRE+1) 36 | C*********************************************************************** 37 | C THICKNESS UPDATE FOR THE VON MISES ELASTO-PLASTIC MODEL UNDER LARGE 38 | C STRAINS AND PLANE STRESS 39 | C 40 | C REFERENCE: Expressions (14.113-115) 41 | C*********************************************************************** 42 | C Compute determinant of total deformation gradient (including 43 | C out-of-plane contribution). Note that, for this model, the determinant 44 | C of the total and elastic deformation gradient coincide due to plastic 45 | C incompressibility. 46 | C... start by retrieving the diagonal components of the elastic 47 | C logarithmic strain tensor 48 | EE11=RSTAVA(1) 49 | EE22=RSTAVA(2) 50 | EE33=RSTAVA(4) 51 | C... then compute determinant of total deformation gradient 52 | DETFT=EXP(EE11+EE22+EE33) 53 | IF(MODE.EQ.1)THEN 54 | C Compute thickness stretch 55 | STRTC3=DETFT/DETF 56 | C Update thickness 57 | THICK=THICK*STRTC3 58 | ENDIF 59 | C return total deformation gradient determinant in DETF 60 | DETF=DETFT 61 | C 62 | RETURN 63 | END 64 | CDOC END_SUBROUTINE TUVM 65 | -------------------------------------------------------------------------------- /src/MATHS/dplfun.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_DOUBLE_PRECISION_FUNCTION DPLFUN 2 | CDOC Returns the derivative of piece-wise linear scalar function 3 | CDOC 4 | CDOC This procedure returns the derivative of the piece-wise linear 5 | CDOC scalar function of procedure PLFUN. 6 | CDOC The piece-wise linear function F(X) is defined by a set 7 | CDOC of NPOINT pairs (X,F(X)) passed in the matrix argument XFX. 8 | CDOC 9 | CDOC BEGIN_PARAMETERS 10 | CDOC DOUBLE_PRECISION X > Point at which the derivative will be 11 | CDOC C evaluated. 12 | CDOC INTEGER NPOINT > Number of points defining the piece-wise 13 | CDOC C linear function. 14 | CDOC DOUBLE_PRECISION XFX > Matrix (dimension 2*NPOINT) 15 | CDOC C containing the pairs (x,f(x)) which 16 | CDOC C define the piece-wise linear function. 17 | CDOC C evaluated. Each column of XFX 18 | CDOC C contains a pair (xi,f(xi)). The pairs 19 | CDOC C supplied in XFX 20 | CDOC C must be ordered such that the x's are 21 | CDOC C monotonically increasing. That is, the 22 | CDOC C x [XFX(1,i+1)] of a column i+1 must be 23 | CDOC C greater than XFX(1,i) (x of column i). 24 | CDOC C If X < XFX(1,1) the 25 | CDOC C piece-wise linear function is assumed 26 | CDOC C constant equal to XFX(1,1). 27 | CDOC C If X > XFX(1,NPOINT) the piece-wise 28 | CDOC C linear function is assumed constant 29 | CDOC C equal to XFX(1,NPOINT). 30 | CDOC END_PARAMETERS 31 | CHST 32 | CHST E.de Souza Neto, August 1992: Initial coding 33 | CHST 34 | DOUBLE PRECISION FUNCTION DPLFUN(X, NPOINT, XFX) 35 | C 36 | INTEGER NPOINT, I 37 | DOUBLE PRECISION X, XFX(2,NPOINT), R0 38 | DATA R0 / 0.0D0 / 39 | C*********************************************************************** 40 | C DERIVATIVE OF THE PIECEWISE LINEAR FUNCTION 'PLFUN' DEFINED BY A SET 41 | C OF NPOINT PAIRS {X,F(X)} STORED IN THE MATRIX XFX (DIM. 2*NPOINT). 42 | C*********************************************************************** 43 | DO 100 I=1,NPOINT 44 | IF (X.GE.XFX(1,I)) THEN 45 | GOTO 100 46 | ELSE 47 | IF (I.EQ.1) THEN 48 | C -- x < x1 --> f(x)=f(x1) --> df(x)/dx=0 --- 49 | DPLFUN=R0 50 | GOTO 999 51 | ELSE 52 | C -- x(i-1) <= x < x(i) --- 53 | DPLFUN=(XFX(2,I)-XFX(2,I-1))/ 54 | 1 (XFX(1,I)-XFX(1,I-1)) 55 | GOTO 999 56 | ENDIF 57 | ENDIF 58 | 100 CONTINUE 59 | C ---- x >= x(npoint) --> f(x) = f(x(npoint)) --> df/dx=0 --- 60 | DPLFUN=R0 61 | 999 CONTINUE 62 | RETURN 63 | END 64 | CDOC END_DOUBLE_PRECISION_FUNCTION DPLFUN 65 | -------------------------------------------------------------------------------- /src/GENERAL/intfor.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE INTFOR 2 | CDOC Calls internal force vector calculation routines 3 | CDOC 4 | CDOC This routine calls the internal force vector calculation routines 5 | CDOC for all element classes available in HYPLAS. It loops over all 6 | CDOC elements of the mesh. If the internal force vector calculation 7 | CDOC fails for some reason (such as due to failure of an state update 8 | CDOC procedure) the return value of the logical argument INCCUT will be 9 | CDOC .TRUE., which will activate the increment cutting procedure in the 10 | CDOC main program. 11 | CDOC 12 | CDOC BEGIN_PARAMETERS 13 | CDOC DOUBLE_PRECISION DTIME > Time increment. 14 | CDOC LOGICAL INCCUT < Increment cutting flag. Return value set 15 | CDOC C to .FALSE. if internal force vector was 16 | CDOC C successfully evaluated and set to .TRUE. 17 | CDOC C otherwise. 18 | CDOC C When the return value is set to .TRUE., 19 | CDOC C the main program will activate increment 20 | CDOC C cutting and the current increment will 21 | CDOC C be divided into sub-increments. 22 | CDOC END_PARAMETERS 23 | CHST 24 | CHST E.de Souza Neto, June 1996: Initial coding 25 | CHST 26 | CHST E.de Souza Neto, Jan 1998: Re-organised by element class 27 | CHST 28 | CHST E.de Souza Neto, August 1999: Element interface call introduced 29 | CHST 30 | CHST E.de Souza Neto & F.Adziman, 31 | CHST September 2012: Time increment added 32 | CHST 33 | SUBROUTINE INTFOR( DTIME, INCCUT, TTIME ) 34 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 35 | C 36 | INCLUDE '../MAXDIM.INC' 37 | INCLUDE '../MATERIAL.INC' 38 | INCLUDE '../ELEMENTS.INC' 39 | INCLUDE '../GLBDBASE.INC' 40 | C Arguments 41 | LOGICAL INCCUT 42 | C Local variables 43 | LOGICAL IFFAIL 44 | C*********************************************************************** 45 | C LOOPS OVER ALL ELEMENTS OF THE STRUCTURE TO COMPUTE ELEMENT INTERNAL 46 | C FORCE VECTORS 47 | C 48 | C REFERENCE: Figures 5.2-3 49 | C*********************************************************************** 50 | C Initialise increment cutting flag 51 | INCCUT=.FALSE. 52 | C 53 | C Begin loop over elements 54 | C ======================== 55 | DO 50 IELEM=1,NELEM 56 | C 57 | C Call element interface for internal force vector computation 58 | C ------------------------------------------------------------ 59 | CALL ELEIIF 60 | 1( DTIME ,IELEM ,IFFAIL ,TTIME ,DVOLU ) 61 | C 62 | IF(IFFAIL)THEN 63 | C Internal force calculation failed for current element: Break loop 64 | C over elements and return to main program with increment cutting 65 | C flag activated 66 | INCCUT=.TRUE. 67 | GOTO 999 68 | ENDIF 69 | C 70 | 50 CONTINUE 71 | C Emergency exit 72 | 999 CONTINUE 73 | RETURN 74 | END 75 | CDOC END_SUBROUTINE INTFOR 76 | -------------------------------------------------------------------------------- /src/GENERAL/rstchk.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE RSTCHK 2 | CDOC Checks wether the main data is to be read from a re-start file 3 | CDOC 4 | CDOC This routine reads the data file and checks wether the main data 5 | CDOC is to be read from it or from a re-start file. 6 | CDOC 7 | CDOC BEGIN_PARAMETERS 8 | CDOC CHARACTER RSTINP > Character string containing the input 9 | CDOC C re-start file name. 10 | CDOC LOGICAL RSTRT < Restart flag. Return value is set to 11 | CDOC C .FALSE. if the main data is to 12 | CDOC C be read from the data file. Set to 13 | CDOC C .TRUE. if the main data is to 14 | CDOC C be read from a re-start file. 15 | CDOC END_PARAMETERS 16 | CHST 17 | CHST E.de Souza Neto, September 1996: Initial coding 18 | CHST E.de Souza Neto, September 2009: Added check for missing re-start 19 | CHST file name in data file. HYPLAS now 20 | CHST stops if name is missing. 21 | CHST The absence of this check was 22 | CHST causing HYPLAS to crash 23 | CHST (segmentation fault) when the 24 | CHST re-start file name was missing. 25 | CHST 26 | SUBROUTINE RSTCHK( RSTINP ,RSTRT ) 27 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 28 | LOGICAL RSTRT 29 | CHARACTER*256 RSTINP 30 | C 31 | LOGICAL AVAIL,FOUND 32 | CHARACTER*80 INLINE 33 | DIMENSION IWBEG(40),IWEND(40) 34 | C*********************************************************************** 35 | C CHECKS WETHER MAIN DATA IS TO BE READ FROM INPUT RE-START FILE 36 | C AND SET INPUT RE-START FILE NAME IF REQUIRED 37 | C*********************************************************************** 38 | 1000 FORMAT(////, 39 | 1' Main input data read from re-start file'/ 40 | 2' ======================================='/// 41 | 3' Input re-start file name ----> ',A) 42 | C 43 | C Checks whether the input data file contains the keyword RESTART 44 | C 45 | CALL FNDKEY 46 | 1( FOUND ,IWBEG ,IWEND ,'RESTART', 47 | 2 INLINE ,15 ,NWRD ) 48 | IF(FOUND)THEN 49 | c checks if the re-start file name root is missing from the data file 50 | IF(NWRD.LT.2) CALL ERRPRT('ED0199') 51 | C sets re-start flag and name of input re-start file 52 | RSTRT=.TRUE. 53 | RSTINP=INLINE(IWBEG(2):IWEND(2))//'.rst' 54 | WRITE(16,1000)INLINE(IWBEG(2):IWEND(2))//'.rst' 55 | WRITE(18,1000)INLINE(IWBEG(2):IWEND(2))//'.rst' 56 | WRITE( *,1000)INLINE(IWBEG(2):IWEND(2))//'.rst' 57 | C checks existence of the input re-start file 58 | INQUIRE(FILE=RSTINP,EXIST=AVAIL) 59 | IF(.NOT.AVAIL)CALL ERRPRT('ED0096') 60 | ELSE 61 | RSTRT=.FALSE. 62 | ENDIF 63 | C 64 | RETURN 65 | END 66 | CDOC END_SUBROUTINE RSTCHK 67 | -------------------------------------------------------------------------------- /src/GENERAL/listra.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE LISTRA 2 | CDOC Computes the infinitesimal strain components in 2-D and 3-D 3 | CDOC 4 | CDOC Given the nodal displacements of the element and the B-matrix 5 | CDOC (discrete symmetric gradient operator) at a point in the element 6 | CDOC domain, this routine computes the corresponding (engineering) 7 | CDOC infinitesimal strain components at that point by performing 8 | CDOC the standard operation: e = B u, where e is the array of 9 | CDOC engineering strain components and u is the array of nodal 10 | CDOC displacements. This routine contains the plane strain/stress, 11 | CDOC axisymmetric and three-dimensional implementations. 12 | CDOC 13 | CDOC BEGIN_PARAMETERS 14 | CDOC DOUBLE_PRECISION BMATX > The discrete symmetric gradient 15 | CDOC C operator, B-matrix. 16 | CDOC DOUBLE_PRECISION ELDISP > Array containing the element nodal 17 | CDOC C displacements. 18 | CDOC INTEGER MDOFN > Dimensioning parameter: Number of rows 19 | CDOC C of ELDISP. 20 | CDOC INTEGER MBDIM > Dimensioning parameter: Number of rows 21 | CDOC C of BMATX. 22 | CDOC INTEGER NDOFN > Number of degrees of freedom per node. 23 | CDOC INTEGER NNODE > Number of nodes of the element. 24 | CDOC INTEGER NTYPE > Stress state type flag. 25 | CDOC DOUBLE_PRECISION STRAN < Array of engineering infinitesimal 26 | CDOC C strain components. 27 | CDOC END_PARAMETERS 28 | CHST 29 | CHST E.de Souza Neto, June 1996: Initial coding 30 | CHST D. de Bortoli , March 2015: 3-D case added 31 | CHST 32 | SUBROUTINE LISTRA 33 | 1( BMATX ,ELDISP ,MDOFN ,MBDIM ,NDOFN , 34 | 2 NNODE ,NTYPE ,STRAN ) 35 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 36 | DIMENSION 37 | 1 BMATX(MBDIM,*) ,ELDISP(MDOFN,*) ,STRAN(*) 38 | C*********************************************************************** 39 | C COMPUTES THE SYMMETRIC GRADIENT (LINEAR STRAIN MEASURE) ASSOCIATED 40 | C WITH THE ELEMENT DISPLACEMENT 'ELDISP' IN 3-D AND 2-D: PLANE STRAIN, 41 | C PLANE STRESS AND AXISYMMETRIC PROBLEMS 42 | C 43 | C REFERENCE: Expression (4.53) 44 | C*********************************************************************** 45 | IF(NTYPE.EQ.1)THEN 46 | NSTRE=3 47 | NBDIM=3 48 | ELSEIF(NTYPE.EQ.2)THEN 49 | NSTRE=4 50 | NBDIM=3 51 | ELSEIF(NTYPE.EQ.3)THEN 52 | NSTRE=4 53 | NBDIM=4 54 | ELSEIF(NTYPE.EQ.4)THEN 55 | NSTRE=6 56 | NBDIM=6 57 | ELSE 58 | CALL ERRPRT('EI0023') 59 | ENDIF 60 | C 61 | CALL RVZERO(STRAN,NSTRE) 62 | DO 30 ISTRE=1,NBDIM 63 | IEVAB=0 64 | DO 20 INODE=1,NNODE 65 | DO 10 IDOFN=1,NDOFN 66 | IEVAB=IEVAB+1 67 | STRAN(ISTRE)=STRAN(ISTRE)+ 68 | 1 BMATX(ISTRE,IEVAB)*ELDISP(IDOFN,INODE) 69 | 10 CONTINUE 70 | 20 CONTINUE 71 | 30 CONTINUE 72 | RETURN 73 | END 74 | CDOC END_SUBROUTINE LISTRA 75 | -------------------------------------------------------------------------------- /src/CRYSTAL_ELASTO_MARTEN/taumep.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE TAUMEP 2 | CDOC Given the elastic deformation gradient, this subroutine evaluates 3 | CDOC the Kirchhoff stress for the viscoplastic martensitic transforma- 4 | CDOC tion material model. 5 | CDOC 6 | CDOC BEGIN_PARAMETERS 7 | CDOC DOUBLE_PRECISION FE > Elastic deformation gradient. 8 | CDOC INTEGER NDIME > Number of spatial dimension. 9 | CDOC DOUBLE_PRECISION RPROPS > Array of real material properties. 10 | CDOC C It is set in routine RDPDSC. 11 | CDOC DOUBLE_PRECISION TAU < Kirchhoff stress tensor. 12 | CDOC END_PARAMETERS 13 | CHST 14 | CHST 15 | CHST 16 | SUBROUTINE TAUMEP(FE, NDIME, RPROPS, TAU) 17 | IMPLICIT NONE 18 | C Arguments 19 | DOUBLE PRECISION, DIMENSION(3,3), INTENT(IN) :: FE 20 | INTEGER , INTENT(IN) :: NDIME 21 | DOUBLE PRECISION, DIMENSION(*) , INTENT(IN) :: RPROPS 22 | DOUBLE PRECISION, DIMENSION(3,3), INTENT(OUT) :: TAU 23 | C Local variables 24 | DOUBLE PRECISION :: GMODU, BULK ! Neo-Hookean shear and bulk moduli 25 | DOUBLE PRECISION, DIMENSION(3,3) :: FEISO, ! Isochoric part of elastic deformation gradient 26 | 1 BEISO ! Isochoric elastic left Cauchy-Green tensor 27 | DOUBLE PRECISION, DIMENSION(6) :: BEDEV ! Deviatoric part of BEISO (array form) 28 | C 29 | DOUBLE PRECISION :: VOLFAC,! Volumetric factor in isochoric split 30 | 1 DETFE, ! Determinant of elastic deformation gradient 31 | 2 TRACE, ! Trace of BEISO 32 | 3 P ! Hydrostatic pressure 33 | INTEGER :: I ! Loop index 34 | C Functions called 35 | DOUBLE PRECISION :: DETM23 ! Determinant of 3x3 matrix 36 | C Local parameters 37 | DOUBLE PRECISION, PARAMETER :: R1D3=1.0D0/3.0D0 38 | C 39 | C*********************************************************************** 40 | C EVALUATE OF KIRCHHOFF STRESS FOR THE MARTENSITIC TRANSFORMATION 41 | C MATERIAL MODEL 42 | C*********************************************************************** 43 | C Neo-Hookean properties 44 | GMODU=RPROPS(2) 45 | BULK=RPROPS(3) 46 | C Isochoric part of elastic deformation gradient 47 | DETFE=DETM23(3, FE, NDIME, .FALSE.) 48 | VOLFAC=DETFE**(-R1D3) 49 | FEISO=VOLFAC*FE 50 | C Deviatoric part of the isochoric elastic left Cauchy-Green tensor (in 51 | C array form) 52 | BEISO=MATMUL(FEISO,TRANSPOSE(FEISO)) 53 | TRACE=BEISO(1,1)+BEISO(2,2)+BEISO(3,3) 54 | CALL SYMTA(BEISO, BEDEV, NDIME, .TRUE.) ! Write BEISO in array form (symmetric) 55 | BEDEV(1)=BEDEV(1)-R1D3*TRACE 56 | BEDEV(2)=BEDEV(2)-R1D3*TRACE 57 | IF(NDIME==2)THEN 58 | BEDEV(4)=BEDEV(4)-R1D3*TRACE 59 | ELSEIF(NDIME==3)THEN 60 | BEDEV(3)=BEDEV(3)-R1D3*TRACE 61 | ELSE 62 | CALL ERRPRT('EI0081') 63 | ENDIF 64 | C Kirchoff stress tensor 65 | P=BULK*LOG(DETFE) 66 | CALL ATSYM(BEDEV, TAU, NDIME, .TRUE.) ! Write BEDEV in matrix form (symmetric) 67 | TAU=GMODU*TAU 68 | DO I=1,3 69 | TAU(I,I)=TAU(I,I)+P 70 | ENDDO 71 | C 72 | RETURN 73 | END 74 | CDOC END_SUBROUTINE TAUMEP 75 | -------------------------------------------------------------------------------- /src/ELEMENTS/chkndb.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE CHKNDB 2 | CDOC Checks whether a set of nodes matches one of the element boundaries 3 | CDOC 4 | CDOC This routine checks whether a given set of local node numbers match 5 | CDOC one of the boundaries of an element. If the given set matches one 6 | CDOC boundary, NODCHK returns with the appropriate node number ordering 7 | CDOC for numerical integration on that boundary. 8 | CDOC 9 | CDOC BEGIN_PARAMETERS 10 | CDOC LOGICAL FOUND < Set to .TRUE. if the given set of local 11 | CDOC C node numbers matches one of the 12 | CDOC C boundaries of the element. Set to 13 | CDOC C .FALSE. otherwise. 14 | CDOC INTEGER NNODE > Total number of nodes of the element. 15 | CDOC INTEGER NEDGEL > Total number of edges (facets in 3-D) of 16 | CDOC C the element. 17 | CDOC INTEGER NODCHK <> On entry, defines the set of local node 18 | CDOC C numbers to be matched by a boundary: 19 | CDOC C If local node INODE is part of the set, 20 | CDOC C then NODCHK(INODE)=1. 21 | CDOC C NODCHK(INODE)=0 otherwise. 22 | CDOC C This array returns with the sequence of 23 | CDOC C local node numbers on the matching 24 | CDOC C boundary. 25 | CDOC INTEGER NORDEB > Array containing the sequence of local 26 | CDOC C node numbers in each edge (facets in 27 | CDOC C 3-D) of the element. 28 | CDOC END_PARAMETERS 29 | CHST 30 | CHST E.de Souza Neto, August 1996: Initial coding 31 | CHST 32 | SUBROUTINE CHKNDB 33 | 1( FOUND ,NNODE ,NEDGEL ,NODCHK ,NORDEB ) 34 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 35 | LOGICAL FOUND 36 | DIMENSION 37 | 1 NODCHK(NNODE) ,NORDEB(NNODE,NEDGEL) 38 | C*********************************************************************** 39 | C CHECKS WHETHER A GIVEN SET OF LOCAL ELEMENT NODE NUMBERS CORRESPOND TO 40 | C ONE OF THE ELEMENT BOUNDARIES (EDGES IN 2-D AND FACETS IN 3-D). IF IT 41 | C DOES, RETURNS (STORED IN NODCHK) THE LOCAL NODE NUMBERS ORDERED FOR 42 | C NUMERICAL INTEGRATION ON BOUNDARY. 43 | C*********************************************************************** 44 | FOUND=.FALSE. 45 | C Searches for the element boundary whose nodes coincide with the given 46 | C set 47 | DO 20 IEDGEL=1,NEDGEL 48 | DO 10 INODE=1,NNODE 49 | IF((NODCHK(INODE).NE.0.AND.NORDEB(INODE,IEDGEL).EQ.0).OR. 50 | 1 (NODCHK(INODE).EQ.0.AND.NORDEB(INODE,IEDGEL).NE.0))GOTO 20 51 | 10 CONTINUE 52 | FOUND=.TRUE. 53 | GOTO 30 54 | 20 CONTINUE 55 | C 56 | 30 CONTINUE 57 | IF(FOUND)THEN 58 | C If the given node set corresponds indeed to one of the boundaries of 59 | C the element, stores the node numbers in NODCHK ordered for numerical 60 | C integration on the boundary. 61 | DO 40 INODE=1,NNODE 62 | INODEG=NORDEB(INODE,IEDGEL) 63 | IF(INODEG.NE.0)NODCHK(INODEG)=INODE 64 | 40 CONTINUE 65 | ENDIF 66 | C 67 | RETURN 68 | END 69 | CDOC END_SUBROUTINE CHKNDB 70 | -------------------------------------------------------------------------------- /src/GENERAL/defgra.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE DEFGRA 2 | CDOC Deformation gradient for 2-D and 3-D isoparametric finite elements 3 | CDOC 4 | CDOC Given the element nodal displacements and the discrete gradient 5 | CDOC operator, G-matrix, at a point, this routine computes the 6 | CDOC corresponding deformation gradient at that point. This routine 7 | CDOC contains the plane strain, plane stress, axisymmetric and three- 8 | CDOC dimensional 9 | CDOC implementations. 10 | CDOC 11 | CDOC BEGIN_PARAMETERS 12 | CDOC DOUBLE_PRECISION ELDISP > Array of nodal displacements of the 13 | CDOC C finite element. 14 | CDOC DOUBLE_PRECISION F < Deformation gradient. 15 | CDOC DOUBLE_PRECISION GMATX > Discrete (full) gradient operator, 16 | CDOC C G-matrix, at the point of interest. 17 | CDOC INTEGER MDOFN > Dimensioning parameter: number of 18 | CDOC C rows of array ELDISP. 19 | CDOC INTEGER MGDIM > Dimensioning parameter: number of 20 | CDOC C rows of array GMATX. 21 | CDOC INTEGER NDOFN > Number of degrees of freedom per node. 22 | CDOC INTEGER NTYPE > Stress state type flag. 23 | CDOC INTEGER NNODE > Number of nodes of the element. 24 | CDOC END_PARAMETERS 25 | CHST 26 | CHST E.de Souza Neto, August 1996: Initial coding 27 | CHST D. de Bortoli , March 2015: 3-D case added 28 | CHST 29 | SUBROUTINE DEFGRA 30 | 1( ELDISP ,F ,GMATX ,MDOFN ,MGDIM , 31 | 2 NDOFN ,NTYPE ,NNODE ) 32 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 33 | PARAMETER 34 | 1( MCOMP=9 ) 35 | DIMENSION 36 | 1 ELDISP(MDOFN,*) ,F(3,3) ,GMATX(MGDIM,*) 37 | LOGICAL OUTOFP 38 | DIMENSION 39 | 1 FVEC(MCOMP) 40 | DATA R0 ,R1 / 0.0D0,1.0D0 / 41 | C*********************************************************************** 42 | C COMPUTES THE DEFORMATION GRADIENT TENSOR ASSOCIATED WITH THE ELEMENT 43 | C DISPLACEMENT 'ELDISP' 44 | C*********************************************************************** 45 | C Set total number of deformation gradient components 46 | IF(NTYPE.EQ.1.OR.NTYPE.EQ.2)THEN 47 | NCOMP=4 48 | NDIM=2 49 | OUTOFP=.FALSE. 50 | ELSEIF(NTYPE.EQ.3)THEN 51 | NCOMP=5 52 | NDIM=2 53 | OUTOFP=.TRUE. 54 | ELSEIF(NTYPE.EQ.4)THEN 55 | NCOMP=9 56 | NDIM=3 57 | OUTOFP=.FALSE. 58 | ELSE 59 | CALL ERRPRT('EI0021') 60 | ENDIF 61 | C Evaluate the deformation gradient stored in vector form 62 | CALL RVZERO(FVEC,NCOMP) 63 | DO 30 ICOMP=1,NCOMP 64 | IEVAB=0 65 | DO 20 INODE=1,NNODE 66 | DO 10 IDOFN=1,NDOFN 67 | IEVAB=IEVAB+1 68 | FVEC(ICOMP)=FVEC(ICOMP)+ 69 | 1 GMATX(ICOMP,IEVAB)*ELDISP(IDOFN,INODE) 70 | 10 CONTINUE 71 | 20 CONTINUE 72 | 30 CONTINUE 73 | C Store the deformation gradient in matrix form 74 | CALL ATASYM(FVEC, F, NDIM, OUTOFP) 75 | C Add identity to F 76 | F(1,1)=F(1,1)+R1 77 | F(2,2)=F(2,2)+R1 78 | IF(NTYPE.NE.1)THEN 79 | F(3,3)=F(3,3)+R1 80 | ENDIF 81 | C 82 | RETURN 83 | END 84 | CDOC END_SUBROUTINE DEFGRA 85 | -------------------------------------------------------------------------------- /src/MATHS/podec2.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE PODEC2 2 | CDOC Polar decomposition of 2-D tensors 3 | CDOC 4 | CDOC This routine performs the right polar decomposition of 2-D 5 | CDOC tensors: F = R U, where R is a rotation (orthogonal tensor) 6 | CDOC and U is a symmetric tensor. 7 | CDOC 8 | CDOC BEGIN_PARAMETERS 9 | CDOC DOUBLE_PRECISION F > 2-D tensor to be decomposed. 10 | CDOC C Dimension 2x2. 11 | CDOC DOUBLE_PRECISION R < Rotation matrix resulting from the polar 12 | CDOC C decomposition. Dimension 2x2. 13 | CDOC DOUBLE_PRECISION U < Right symmetric tensor resulting from 14 | CDOC C the polar decomposition. Dimension 2x2. 15 | CDOC END_PARAMETERS 16 | CHST 17 | CHST E.de Souza Neto, November 1998: Initial coding 18 | CHST 19 | SUBROUTINE PODEC2 20 | 1( F ,R ,U ) 21 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 22 | PARAMETER 23 | 1( NDIM=2 ) 24 | C Arguments 25 | DIMENSION 26 | 1 F(NDIM,NDIM) ,R(NDIM,NDIM) ,U(NDIM,NDIM) 27 | C Local variables and arrays 28 | LOGICAL DUMMY 29 | DIMENSION 30 | 1 C(NDIM,NDIM) ,CVEC(4) ,EIGPRJ(4,NDIM) , 31 | 2 EIGC(NDIM) ,UM1(NDIM,NDIM) ,UM1VEC(3) , 32 | 3 UVEC(3) 33 | DATA 34 | 1 R1 / 35 | 2 1.0D0/ 36 | C*********************************************************************** 37 | C PERFORMS THE RIGHT POLAR DECOMPOSITION OF A 2-D TENSOR 38 | C 39 | C REFERENCE: Section 2.2.9 40 | C*********************************************************************** 41 | C T 42 | C Compute C := F F 43 | C ------------------- 44 | CALL RVZERO(C,NDIM*NDIM) 45 | DO 30 I=1,NDIM 46 | DO 20 J=1,NDIM 47 | DO 10 K=1,NDIM 48 | C(I,J)=C(I,J)+F(K,I)*F(K,J) 49 | 10 CONTINUE 50 | 20 CONTINUE 51 | 30 CONTINUE 52 | C Perform spectral decomposition of C 53 | C ----------------------------------- 54 | CVEC(1)=C(1,1) 55 | CVEC(2)=C(2,2) 56 | CVEC(3)=C(1,2) 57 | CALL SPDEC2(EIGPRJ ,EIGC ,DUMMY ,CVEC ) 58 | C 59 | C 1/2 -1 60 | C Compute U := (C) and U 61 | C ------------------------------ 62 | C assemble in vector form 63 | CALL RVZERO(UVEC,3) 64 | CALL RVZERO(UM1VEC,3) 65 | DO 50 IDIM=1,NDIM 66 | UEIG=SQRT(EIGC(IDIM)) 67 | UM1EIG=R1/UEIG 68 | DO 40 ICOMP=1,3 69 | UVEC(ICOMP)=UVEC(ICOMP)+UEIG*EIGPRJ(ICOMP,IDIM) 70 | UM1VEC(ICOMP)=UM1VEC(ICOMP)+UM1EIG*EIGPRJ(ICOMP,IDIM) 71 | 40 CONTINUE 72 | 50 CONTINUE 73 | C and matrix form 74 | U(1,1)=UVEC(1) 75 | U(2,2)=UVEC(2) 76 | U(1,2)=UVEC(3) 77 | U(2,1)=UVEC(3) 78 | UM1(1,1)=UM1VEC(1) 79 | UM1(2,2)=UM1VEC(2) 80 | UM1(1,2)=UM1VEC(3) 81 | UM1(2,1)=UM1VEC(3) 82 | C -1 83 | C Compute rotation R := F U 84 | C ---------------------------- 85 | CALL RVZERO(R,NDIM*NDIM) 86 | DO 80 I=1,NDIM 87 | DO 70 J=1,NDIM 88 | DO 60 K=1,NDIM 89 | R(I,J)=R(I,J)+F(I,K)*UM1(K,J) 90 | 60 CONTINUE 91 | 70 CONTINUE 92 | 80 CONTINUE 93 | C 94 | RETURN 95 | END 96 | CDOC END_SUBROUTINE PODEC2 97 | -------------------------------------------------------------------------------- /src/MATHS/spdec2.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE SPDEC2 2 | CDOC Closed form spectral decomposition of 2-D symmetric tensors 3 | CDOC 4 | CDOC This routine performs the spectral decomposition of 2-D symmetric 5 | CDOC tensors in closed form. The tensor is passed as argument (stored in 6 | CDOC vector form). 7 | CDOC 8 | CDOC BEGIN_PARAMETERS 9 | CDOC DOUBLE_PRECISION EIGPRJ < Matrix with one eigenprojection tensor 10 | CDOC C of X stored in each column. 11 | CDOC DOUBLE_PRECISION EIGX < Array containing the eigenvalues of X. 12 | CDOC LOGICAL REPEAT < Repeated eigenvalues flag. Set to 13 | CDOC C .TRUE. if the eigenvalues of X 14 | CDOC C are repeated (within a small tolerance). 15 | CDOC DOUBLE_PRECISION X > Array containing the components of a 16 | CDOC C symmetric tensor. 17 | CDOC END_PARAMETERS 18 | CHST 19 | CHST E.de Souza Neto, May 1996: Initial coding 20 | CHST 21 | SUBROUTINE SPDEC2 22 | 1( EIGPRJ ,EIGX ,REPEAT ,X ) 23 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 24 | PARAMETER 25 | 1( MCOMP=4 ,NDIM=2 ) 26 | LOGICAL REPEAT 27 | DIMENSION 28 | 1 EIGPRJ(MCOMP,NDIM) ,EIGX(NDIM) , 29 | 2 X(MCOMP) 30 | DIMENSION 31 | 1 AUXMTX(NDIM,NDIM) ,EIGVEC(NDIM,NDIM) 32 | DATA 33 | 1 R0 ,RP5 ,R1 ,R4 ,SMALL / 34 | 2 0.0D0,0.5D0,1.0D0,4.0D0,1.D-5 / 35 | C*********************************************************************** 36 | C PERFORMS THE CLOSED FORM SPECTRAL DECOMPOSITION OF A 37 | C SYMMETRIC 2-D TENSOR STORED IN VECTOR FORM 38 | C 39 | C REFERENCE: Box A.2 40 | C*********************************************************************** 41 | REPEAT=.FALSE. 42 | C Compute eigenvalues of X 43 | C ------------------------ 44 | TRX=X(1)+X(2) 45 | B=SQRT((X(1)-X(2))**2+R4*X(3)*X(3)) 46 | EIGX(1)=RP5*(TRX+B) 47 | EIGX(2)=RP5*(TRX-B) 48 | C Compute eigenprojection tensors 49 | C ------------------------------- 50 | DIFFER=ABS(EIGX(1)-EIGX(2)) 51 | AMXEIG=DMAX1(ABS(EIGX(1)),ABS(EIGX(2))) 52 | IF(AMXEIG.NE.R0)DIFFER=DIFFER/AMXEIG 53 | IF(DIFFER.LT.SMALL)THEN 54 | REPEAT=.TRUE. 55 | C for repeated (or nearly repeated) eigenvalues, re-compute eigenvalues 56 | C and compute eigenvectors using the iterative procedure. In such cases, 57 | C the closed formula for the eigenvectors is singular (or dominated by 58 | C round-off errors) 59 | AUXMTX(1,1)=X(1) 60 | AUXMTX(2,2)=X(2) 61 | AUXMTX(1,2)=X(3) 62 | AUXMTX(2,1)=AUXMTX(1,2) 63 | CALL JACOB(AUXMTX,EIGX,EIGVEC,2) 64 | DO 10 IDIR=1,2 65 | EIGPRJ(1,IDIR)=EIGVEC(1,IDIR)*EIGVEC(1,IDIR) 66 | EIGPRJ(2,IDIR)=EIGVEC(2,IDIR)*EIGVEC(2,IDIR) 67 | EIGPRJ(3,IDIR)=EIGVEC(1,IDIR)*EIGVEC(2,IDIR) 68 | EIGPRJ(4,IDIR)=R0 69 | 10 CONTINUE 70 | ELSE 71 | C Use closed formula to compute eigenprojection tensors 72 | DO 20 IDIR=1,2 73 | B=EIGX(IDIR)-TRX 74 | C=R1/(EIGX(IDIR)+B) 75 | EIGPRJ(1,IDIR)=C*(X(1)+B) 76 | EIGPRJ(2,IDIR)=C*(X(2)+B) 77 | EIGPRJ(3,IDIR)=C*X(3) 78 | EIGPRJ(4,IDIR)=R0 79 | 20 CONTINUE 80 | ENDIF 81 | RETURN 82 | END 83 | CDOC END_SUBROUTINE SPDEC2 84 | -------------------------------------------------------------------------------- /src/ELEMENTS/sft3.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE SFT3 2 | CDOC Shape function and derivatives for element type TRI3 3 | CDOC 4 | CDOC This routine computes the shape functions and shape function 5 | CDOC derivatives for the element type TRI3: Standard isoparametric 6 | CDOC 3-noded triangle for plane strain, plane stress and 7 | CDOC axisymmetric analysis. 8 | CDOC 9 | CDOC BEGIN_PARAMETERS 10 | CDOC DOUBLE_PRECISION DERIV < Array of shape function derivatives. 11 | CDOC DOUBLE_PRECISION ETASP > Isoparametric coordinate ETA of the 12 | CDOC C point where the shape functions or their 13 | CDOC C derivatives are to be evaluated. 14 | CDOC DOUBLE_PRECISION EXISP > Isoparametric coordinate XI of the 15 | CDOC C point where the shape functions or their 16 | CDOC C derivatives are to be evaluated. 17 | CDOC INTEGER IBOUND > Boundary interpolation flag. Entry 18 | CDOC C must be 0 for domain interpolation. 19 | CDOC C Boundary interpolation is assumed 20 | CDOC C otherwise. 21 | CDOC INTEGER MDIME > Maximum permissible number of spatial 22 | CDOC C dimensions. Used here only for array 23 | CDOC C dimensioning. 24 | CDOC DOUBLE_PRECISION SHAPE < Array of shape function values. 25 | CDOC END_PARAMETERS 26 | CHST 27 | CHST E.de Souza Neto, February 1997: Initial coding 28 | CHST 29 | SUBROUTINE SFT3 30 | 1( DERIV ,ETASP ,EXISP ,IBOUND ,MDIME , 31 | 2 SHAPE ) 32 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 33 | DIMENSION 34 | 1 DERIV(MDIME,*) ,SHAPE(*) 35 | DATA R0 ,RP5 ,R1 /0.0D0,0.5D0,1.0D0/ 36 | C*********************************************************************** 37 | C COMPUTES SHAPE FUNCTIONS AND SHAPE FUNCTION DERIVATIVES FOR 38 | C ELEMENT 'TRI_3': 39 | C 3 o 40 | C |\ 41 | C | \ 42 | C | \ 43 | C | \ STANDARD LINEAR 44 | C | \ 3 NODE TRIANGLE 45 | C | \ 46 | C o------o 47 | C 1 2 48 | C 49 | C REFERENCE: Expression (4.38) 50 | C*********************************************************************** 51 | IF(IBOUND.EQ.0)THEN 52 | C Shape functions and derivatives on element DOMAIN 53 | C ------------------------------------------------- 54 | S=EXISP 55 | T=ETASP 56 | C Shape functions 57 | SHAPE(1)=R1-S-T 58 | SHAPE(2)=S 59 | SHAPE(3)=T 60 | C Shape function derivatives 61 | DERIV(1,1)=-R1 62 | DERIV(1,2)=+R1 63 | DERIV(1,3)=+R0 64 | DERIV(2,1)=-R1 65 | DERIV(2,2)=+R0 66 | DERIV(2,3)=+R1 67 | ELSE 68 | C Shape function and derivatives on element BOUNDARY (1-D) 69 | C -------------------------------------------------------- 70 | S=EXISP 71 | C Shape functions 72 | SHAPE(1)=(-S+R1)*RP5 73 | SHAPE(2)=(+S+R1)*RP5 74 | C Shape functions derivatives 75 | DERIV(1,1)=-RP5 76 | DERIV(1,2)=RP5 77 | C 78 | ENDIF 79 | C 80 | RETURN 81 | END 82 | CDOC END_SUBROUTINE SFT3 83 | -------------------------------------------------------------------------------- /src/ELEMENTS/sft7.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE SFT3 2 | CDOC Shape function and derivatives for element type TRI3 3 | CDOC 4 | CDOC This routine computes the shape functions and shape function 5 | CDOC derivatives for the element type TRI3: Standard isoparametric 6 | CDOC 3-noded triangle for plane strain, plane stress and 7 | CDOC axisymmetric analysis. 8 | CDOC 9 | CDOC BEGIN_PARAMETERS 10 | CDOC DOUBLE_PRECISION DERIV < Array of shape function derivatives. 11 | CDOC DOUBLE_PRECISION ETASP > Isoparametric coordinate ETA of the 12 | CDOC C point where the shape functions or their 13 | CDOC C derivatives are to be evaluated. 14 | CDOC DOUBLE_PRECISION EXISP > Isoparametric coordinate XI of the 15 | CDOC C point where the shape functions or their 16 | CDOC C derivatives are to be evaluated. 17 | CDOC INTEGER IBOUND > Boundary interpolation flag. Entry 18 | CDOC C must be 0 for domain interpolation. 19 | CDOC C Boundary interpolation is assumed 20 | CDOC C otherwise. 21 | CDOC INTEGER MDIME > Maximum permissible number of spatial 22 | CDOC C dimensions. Used here only for array 23 | CDOC C dimensioning. 24 | CDOC DOUBLE_PRECISION SHAPE < Array of shape function values. 25 | CDOC END_PARAMETERS 26 | CHST 27 | CHST E.de Souza Neto, February 1997: Initial coding 28 | CHST 29 | SUBROUTINE SFT7 30 | 1( DERIV ,ETASP ,EXISP ,IBOUND ,MDIME , 31 | 2 SHAPE ) 32 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 33 | DIMENSION 34 | 1 DERIV(MDIME,*) ,SHAPE(*) 35 | DATA R0 ,RP5 ,R1 /0.0D0,0.5D0,1.0D0/ 36 | C*********************************************************************** 37 | C COMPUTES SHAPE FUNCTIONS AND SHAPE FUNCTION DERIVATIVES FOR 38 | C ELEMENT 'TRI_3': 39 | C 3 o 40 | C |\ 41 | C | \ 42 | C | \ 43 | C | \ STANDARD LINEAR 44 | C | \ 3 NODE TRIANGLE 45 | C | \ 46 | C o------o 47 | C 1 2 48 | C 49 | C REFERENCE: Expression (4.38) 50 | C*********************************************************************** 51 | IF(IBOUND.EQ.0)THEN 52 | C Shape functions and derivatives on element DOMAIN 53 | C ------------------------------------------------- 54 | S=EXISP 55 | T=ETASP 56 | C Shape functions 57 | SHAPE(1)=R1-S-T 58 | SHAPE(2)=S 59 | SHAPE(3)=T 60 | C Shape function derivatives 61 | DERIV(1,1)=-R1 62 | DERIV(1,2)=+R1 63 | DERIV(1,3)=+R0 64 | DERIV(2,1)=-R1 65 | DERIV(2,2)=+R0 66 | DERIV(2,3)=+R1 67 | ELSE 68 | C Shape function and derivatives on element BOUNDARY (1-D) 69 | C -------------------------------------------------------- 70 | S=EXISP 71 | C Shape functions 72 | SHAPE(1)=(-S+R1)*RP5 73 | SHAPE(2)=(+S+R1)*RP5 74 | C Shape functions derivatives 75 | DERIV(1,1)=-RP5 76 | DERIV(1,2)=RP5 77 | C 78 | ENDIF 79 | C 80 | RETURN 81 | END 82 | CDOC END_SUBROUTINE SFT7 83 | -------------------------------------------------------------------------------- /src/ELEMENTS.INC: -------------------------------------------------------------------------------- 1 | C*********************************************************************** 2 | C----------------------------------------------------------------------* 3 | C * 4 | C * 5 | C H Y P L A S ELEMENTS DATABASE * 6 | C * 7 | C * 8 | C----------------------------------------------------------------------* 9 | C*********************************************************************** 10 | C 11 | C 12 | C*********************************************************************** 13 | C 14 | C 1. Dimensioning parameters associated with the available elements 15 | C 16 | C*********************************************************************** 17 | C 18 | PARAMETER( MNODE =20 ) 19 | PARAMETER( MDOFN =3 ) 20 | PARAMETER( MTOTG =27 ) 21 | PARAMETER( MEVAB =MNODE*MDOFN ) 22 | PARAMETER( MREPRP=200 ) 23 | PARAMETER( MIEPRP=100 ) 24 | C 25 | C 26 | C * MNODE = Maximun number of nodes per element. 27 | C 28 | C * MDOFN = Maximun number of degrees of freedom per node. 29 | C 30 | C * MTOTG = Maximun number of Gauss points allowed in any element. 31 | C 32 | C * MEVAB = Maximun number of element variables (degrees of freedom). 33 | C 34 | C * MREPRP = Maximun number of real element properties that can be 35 | C stored in array RELPRP for each element type. 36 | C 37 | C * MIEPRP = Maximun number of integer element properties that can be 38 | C stored in array IELPRP for each element type. 39 | C 40 | C 41 | C 42 | C*********************************************************************** 43 | C 44 | C 2. Element classes enumeration 45 | C 46 | C*********************************************************************** 47 | C 48 | INTEGER FBAR ,STDARD 49 | PARAMETER( STDARD=100 ) 50 | PARAMETER( FBAR =101 ) 51 | C 52 | C 53 | C * STDARD = Standard displacement based isoparametric elements. 54 | C 55 | C * FBAR = F-bar type elements. 56 | C 57 | C 58 | C 59 | C*********************************************************************** 60 | C 61 | C 3. Element types enumeration 62 | C 63 | C*********************************************************************** 64 | C 65 | INTEGER TRI3, TRI6, QUAD4 ,QUAD8 ,QUA4FB ,HEXA8 ,HEX8FB,TETA7 66 | PARAMETER( TRI3 =1 ) 67 | PARAMETER( TRI6 =7 ) 68 | PARAMETER( QUAD4 =2 ) 69 | PARAMETER( QUAD8 =3 ) 70 | PARAMETER( QUA4FB=4 ) 71 | PARAMETER( HEXA8 =5 ) 72 | PARAMETER( HEX8FB=6 ) 73 | PARAMETER( TETA7 =10) 74 | C 75 | C * TRI3 = Standard linear 3-noded triangle. 76 | C 77 | C * TRI6 = Standard quadratic 6-noded triangle. 78 | C 79 | C * QUAD4 = Standard bi-linear 4-noded quadrilateral. 80 | C 81 | C * QUAD8 = Standard quadratic 8-noded quadrilateral. 82 | C 83 | C * QUA4FB = F-Bar 4-noded quadrilateral. 84 | C 85 | C * HEXA8 = Standard tri-linear 8-noded hexahedron. 86 | C 87 | C * HEX8FB = F-Bar 8-noded hexahedron. 88 | C 89 | C * TETA7 = Standard 10-noded Tetrahedron. 90 | C 91 | C*********************************************************************** 92 | -------------------------------------------------------------------------------- /src/GENERAL/leftcg.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE LEFTCG 2 | CDOC Computes the left Cauchy-Green strain tensor 3 | CDOC 4 | CDOC Given the previous total left Cauchy-Green strain tensor and the 5 | CDOC incremental deformation gradient between the previous and current 6 | CDOC configuration, this routine computes the current left Cauchy-Green 7 | CDOC strain tensor. This routine contains the plane strain, plane stress 8 | CDOC and axisymmetric implementations. 9 | CDOC 10 | CDOC BEGIN_PARAMETERS 11 | CDOC DOUBLE_PRECISION BN > Array of components of the previous 12 | CDOC C (at tn) left Cauchy-Green tensor. 13 | CDOC DOUBLE_PRECISION BNP1 < Array of components of the current (at 14 | CDOC C tn+1) left Cauchy-Green strain tensor. 15 | CDOC DOUBLE_PRECISION FINCR > Incremental deformation gradient between 16 | CDOC C the previous and current configuration. 17 | CDOC INTEGER NTYPE > Stress state type. Present routine is 18 | CDOC C compatible with NTYPE=1 (plane 19 | CDOC C stress), NTYPE=2 (plane strain) 20 | CDOC C and NTYPE=3 (axisymmetric condition). 21 | CDOC END_PARAMETERS 22 | CHST 23 | CHST E.de Souza Neto, August 1996: Initial coding as BETRIA 24 | CHST E.de Souza Neto, July 2003: Routine name and some variable names 25 | CHST changed. 26 | CHST 27 | SUBROUTINE LEFTCG 28 | 1( BN ,BNP1 ,FINCR ,NTYPE ) 29 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 30 | DIMENSION 31 | 1 BN(*) ,BNP1(*) ,FINCR(3,3) 32 | DIMENSION 33 | 1 AUXM(2,2) ,BNMTX(2,2) ,BNP1M(2,2) 34 | C*********************************************************************** 35 | C COMPUTES THE LEFT CAUCHY-GREEN STRAIN TENSOR ACCORDING TO THE 36 | C FORMULA: 37 | C 38 | C T 39 | C B := F B F 40 | C n+1 incr n incr 41 | C 42 | C REFERENCE: Box 13.1. The formula used here is equivalent to that of 43 | C item (i) of Box 13.1. 44 | C*********************************************************************** 45 | C Convert previously converged left Cauchy-Green strain tensor from 46 | C vector form to matrix form 47 | BNMTX(1,1)=BN(1) 48 | BNMTX(2,1)=BN(3) 49 | BNMTX(1,2)=BN(3) 50 | BNMTX(2,2)=BN(2) 51 | C 52 | C In-plane components of the left Cauchy-Green tensor 53 | C 54 | CALL RVZERO(AUXM,4) 55 | DO 30 I=1,2 56 | DO 20 J=1,2 57 | DO 10 K=1,2 58 | AUXM(I,J)=AUXM(I,J)+FINCR(I,K)*BNMTX(K,J) 59 | 10 CONTINUE 60 | 20 CONTINUE 61 | 30 CONTINUE 62 | CALL RVZERO(BNP1M,4) 63 | DO 60 I=1,2 64 | DO 50 J=1,2 65 | DO 40 K=1,2 66 | BNP1M(I,J)=BNP1M(I,J)+AUXM(I,K)*FINCR(J,K) 67 | 40 CONTINUE 68 | 50 CONTINUE 69 | 60 CONTINUE 70 | C 71 | C Store B in vector form 72 | C n+1 73 | C 74 | BNP1(1)=BNP1M(1,1) 75 | BNP1(2)=BNP1M(2,2) 76 | BNP1(3)=BNP1M(1,2) 77 | C out-of-plane component 78 | IF(NTYPE.EQ.2)THEN 79 | BNP1(4)=BN(4) 80 | ELSEIF(NTYPE.EQ.3)THEN 81 | BNP1(4)=BN(4)*FINCR(3,3)*FINCR(3,3) 82 | ENDIF 83 | C 84 | RETURN 85 | END 86 | CDOC END_SUBROUTINE LEFTCG 87 | -------------------------------------------------------------------------------- /src/ELASTIC/swel.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE SWEL 2 | CDOC Initialise/switch state variables for the elastic material model 3 | CDOC 4 | CDOC This initialises and switches state variables (between current and 5 | CDOC previous values) for the elastic material model (Hencky material 6 | CDOC in large strain analysis). 7 | CDOC 8 | CDOC BEGIN_PARAMETERS 9 | CDOC INTEGER MODE > Initialisation/Switching mode. 10 | CDOC INTEGER NTYPE > Stress state type flag. 11 | CDOC DOUBLE_PRECISION RSTAVC <> Array of real state variables at Gauss 12 | CDOC C point. Current values. 13 | CDOC DOUBLE_PRECISION RSTAVL <> Array of real state variables at Gauss 14 | CDOC C point. Last converged (equilibrium) 15 | CDOC C values. 16 | CDOC DOUBLE_PRECISION STRESC <> Array of stress (Cauchy in large strain) 17 | CDOC C components. Current values. 18 | CDOC DOUBLE_PRECISION STRESL <> Array of stress (Cauchy in large strain) 19 | CDOC C components. Last converged (equilibrium) 20 | CDOC C values. 21 | CDOC END_PARAMETERS 22 | CHST 23 | CHST E.de Souza Neto, July 1999: Initial coding 24 | CHST E.de Souza Neto, October 2008: Unused arguments removed 25 | CHST D. de Bortoli , March 2015: 3-D case added (NTYPE=4) 26 | CHST 27 | SUBROUTINE SWEL 28 | 1( MODE ,NTYPE ,RSTAVC ,RSTAVL ,STRESC , 29 | 2 STRESL ) 30 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 31 | C Arguments 32 | DIMENSION 33 | 1 RSTAVC(*) ,RSTAVL(*) ,STRESC(*) , 34 | 2 STRESL(*) 35 | C*********************************************************************** 36 | C INITIALISE/SWITCH DATA FOR THE ELASTIC MATERIAL MODEL 37 | C 38 | C MODE=0: Initialises the relevant data. 39 | C 40 | C MODE=1: Assigns current values of the state variables to 41 | C converged solution (when the current iteration 42 | C satisfies the convergence criterion). 43 | C 44 | C MODE=2: Assigns the last converged solution to current state 45 | C variables values (when a new iteration is required by 46 | C the iterative process). 47 | C 48 | C MODE=3: Assigns the last converged solution to current state 49 | C variables values (when increment cutting is required). 50 | C*********************************************************************** 51 | C 52 | IF((NTYPE.EQ.1).OR.(NTYPE.EQ.2).OR.(NTYPE.EQ.3))THEN 53 | NSTRE=4 54 | ELSEIF(NTYPE.EQ.4)THEN 55 | NSTRE=6 56 | ENDIF 57 | C 58 | IF(MODE.EQ.0)THEN 59 | C Initialisation mode 60 | C =================== 61 | CALL RVZERO(STRESC,NSTRE) 62 | C RSTAVA stores the infinitesimal engineering strain tensor components 63 | C in small strains and the logarithmic eng. strains in large strain 64 | C analysis 65 | CALL RVZERO(RSTAVC,NSTRE) 66 | ELSE 67 | C Switching mode 68 | C ============== 69 | IF(MODE.EQ.1)THEN 70 | DO 10 ISTRE=1,NSTRE 71 | STRESL(ISTRE)=STRESC(ISTRE) 72 | RSTAVL(ISTRE)=RSTAVC(ISTRE) 73 | 10 CONTINUE 74 | ELSEIF(MODE.EQ.2.OR.MODE.EQ.3)THEN 75 | DO 20 ISTRE=1,NSTRE 76 | STRESC(ISTRE)=STRESL(ISTRE) 77 | RSTAVC(ISTRE)=RSTAVL(ISTRE) 78 | 20 CONTINUE 79 | ENDIF 80 | ENDIF 81 | RETURN 82 | END 83 | CDOC END_SUBROUTINE SWEL 84 | -------------------------------------------------------------------------------- /src/DAMAGED_ELASTIC/swdmel.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE SWDMEL 2 | CDOC Initialise/switch state variables for damaged elastic model 3 | CDOC 4 | CDOC This initialises and switches state variables (between current and 5 | CDOC previous values) for the damaged elastic material model (damaged 6 | CDOC Hencky material in large strain analysis) with microcrack/void 7 | CDOC closure effects. 8 | CDOC 9 | CDOC BEGIN_PARAMETERS 10 | CDOC INTEGER MODE > Initialisation/Switching mode. 11 | CDOC INTEGER NTYPE > Stress state type flag. 12 | CDOC DOUBLE_PRECISION RSTAVC <> Array of real state variables at Gauss 13 | CDOC C point. Current values. 14 | CDOC DOUBLE_PRECISION RSTAVL <> Array of real state variables at Gauss 15 | CDOC C point. Last converged (equilibrium) 16 | CDOC C values. 17 | CDOC DOUBLE_PRECISION STRESC <> Array of stress (Cauchy in large strain) 18 | CDOC C components. Current values. 19 | CDOC DOUBLE_PRECISION STRESL <> Array of stress (Cauchy in large strain) 20 | CDOC C components. Last converged (equilibrium) 21 | CDOC C values. 22 | CDOC END_PARAMETERS 23 | CHST 24 | CHST E.de Souza Neto, July 2001: Initial coding 25 | CHST 26 | CHST E.de Souza Neto, October 2008: Unused arguments removed 27 | CHST 28 | SUBROUTINE SWDMEL 29 | 1( MODE ,NTYPE ,RSTAVC ,RSTAVL ,STRESC , 30 | 2 STRESL ) 31 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 32 | C Arguments 33 | DIMENSION 34 | 1 RSTAVC(*) ,RSTAVL(*) ,STRESC(*) , 35 | 2 STRESL(*) 36 | C*********************************************************************** 37 | C INITIALISE/SWITCH DATA FOR THE DAMAGED ELASTIC MATERIAL MODEL WITH 38 | C PARTIAL MICROCRACK/VOID CLOSURE EFFECTS 39 | C 40 | C MODE=0: Initialises the relevant data. 41 | C 42 | C MODE=1: Assigns current values of the state variables to 43 | C converged solution (when the current iteration 44 | C satisfies the convergence criterion). 45 | C 46 | C MODE=2: Assigns the last converged solution to current state 47 | C variables values (when a new iteration is required by 48 | C the iterative process). 49 | C 50 | C MODE=3: Assigns the last converged solution to current state 51 | C variables values (when increment cutting is required). 52 | C*********************************************************************** 53 | C 54 | IF(NTYPE.EQ.2.OR.NTYPE.EQ.3)THEN 55 | NSTRE=4 56 | ELSE 57 | CALL ERRPRT('EI0054') 58 | ENDIF 59 | C 60 | IF(MODE.EQ.0)THEN 61 | C Initialisation mode 62 | C =================== 63 | CALL RVZERO(STRESC,NSTRE) 64 | C RSTAVA stores the infinitesimal egineering strain tensor components 65 | C (logarithmic strains in large strains) 66 | CALL RVZERO(RSTAVC,NSTRE) 67 | ELSE 68 | C Switching mode 69 | C ============== 70 | IF(MODE.EQ.1)THEN 71 | DO 10 ISTRE=1,NSTRE 72 | STRESL(ISTRE)=STRESC(ISTRE) 73 | RSTAVL(ISTRE)=RSTAVC(ISTRE) 74 | 10 CONTINUE 75 | ELSEIF(MODE.EQ.2.OR.MODE.EQ.3)THEN 76 | DO 20 ISTRE=1,NSTRE 77 | STRESC(ISTRE)=STRESL(ISTRE) 78 | RSTAVC(ISTRE)=RSTAVL(ISTRE) 79 | 20 CONTINUE 80 | ENDIF 81 | ENDIF 82 | RETURN 83 | END 84 | CDOC END_SUBROUTINE SWDMEL 85 | -------------------------------------------------------------------------------- /src/MATHS/iso2.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE ISO2 2 | CDOC Computes the value of isotropic tensor functions of one tensor. 3 | CDOC 4 | CDOC This subroutine evaluates isotropic tensor functions Y(X), of one 5 | CDOC tensor belonging to the class described below. 6 | CDOC This implementation is restricted to 2-D with one possible 7 | CDOC out-of-plane component (normally needed in axisymmetric problems). 8 | CDOC The class of symmetric tensor functions Y(X) is assumed to be 9 | CDOC defined as Y(X)= Sum[y(xi) ei(x)ei], where the scalar function 10 | CDOC y(xi) defines the eigenvalues of the tensor Y and xi the 11 | CDOC eigenvalues of the tensor X. ei are the egenvectors of X (which by 12 | CDOC definition of Y(X), coincide with those of tensor Y) and "(x)" 13 | CDOC denotes the tensor product. 14 | CDOC 15 | CDOC BEGIN_PARAMETERS 16 | CDOC SYMBOLIC_NAME FUNC > Symbolic name of the double 17 | CDOC C precision function defining y(xi). 18 | CDOC LOGICAL OUTOFP > Out-of-plane component flag. If set to 19 | CDOC C .TRUE. the out-of-plane 20 | CDOC C component (normally required in 21 | CDOC C axisymmetric problems) is computed. 22 | CDOC C The out-of-plane component is not 23 | CDOC C computed otherwise. 24 | CDOC DOUBLE_PRECISION X > Array of components of the tensor at 25 | CDOC C which the function is to be evaluated. 26 | CDOC DOUBLE_PRECISION Y < Array of components of the tensor 27 | CDOC C function at X. 28 | CDOC END_PARAMETERS 29 | CHST 30 | CHST E.de Souza Neto, August 1996: Initial coding 31 | CHST E.de Souza Neto, February 2004: External declaration for argument 32 | CHST FUNC removed 33 | CHST 34 | SUBROUTINE ISO2 35 | 1( FUNC ,OUTOFP ,X ,Y ) 36 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 37 | PARAMETER 38 | 1( MCOMP=4 ,NDIM=2 ) 39 | LOGICAL OUTOFP ,REPEAT 40 | DIMENSION 41 | 1 X(*) ,Y(*) 42 | DIMENSION 43 | 1 EIGPRJ(MCOMP,NDIM) ,EIGX(NDIM) , 44 | 1 EIGY(NDIM) 45 | C*********************************************************************** 46 | C COMPUTE THE TENSOR Y (STORED IN VECTOR FORM) AS AN ISOTROPIC 47 | C FUNCTION OF THE TYPE: 48 | C 49 | C Y(X) = sum{ y(x_i) E_i } 50 | C 51 | C WHERE Y AND X ARE SYMMETRIC TENSORS, x_i AND E_i ARE, RESPECTIVELY 52 | C THE EIGENVALUES AND EIGENPROJECTIONS OF X, AND y(.) IS A SCALAR 53 | C FUNCTION. THIS ROUTINE IS RESTRICTED TO 2-D TENSORS WITH ONE 54 | C POSSIBLE (TRANSVERSAL) OUT-OF-PLANE COMPONENT. 55 | C 56 | C REFERENCE: Section A.5 57 | C*********************************************************************** 58 | C Performs the spectral decomposition of X 59 | CALL SPDEC2 60 | 1( EIGPRJ ,EIGX ,REPEAT ,X ) 61 | C Computes the in-plane eigenvalues of Y 62 | DO 10 IDIR=1,2 63 | EIGY(IDIR)=FUNC(EIGX(IDIR)) 64 | 10 CONTINUE 65 | C Assembles in-plane component of Y (in vector form) 66 | CALL RVZERO(Y,3) 67 | DO 30 ICOMP=1,3 68 | DO 20 IDIR=1,2 69 | Y(ICOMP)=Y(ICOMP)+EIGY(IDIR)*EIGPRJ(ICOMP,IDIR) 70 | 20 CONTINUE 71 | 30 CONTINUE 72 | C Out-of-plane component required 73 | IF(OUTOFP)Y(4)=FUNC(X(4)) 74 | C 75 | RETURN 76 | END 77 | CDOC END_SUBROUTINE ISO2 78 | -------------------------------------------------------------------------------- /src/ELEMENTS/exh8fb.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE EXH8FB 2 | CDOC Sets Gauss point-node extrapolation matrix for element type 3 | CDOC HEXA_8_FBAR 4 | CDOC 5 | CDOC This routine sets the coefficients matrix for extrapolation of 6 | CDOC fields from Gauss point values to nodal values for element type 7 | CDOC HEXA_8_FBAR: F-bar isoparametric 8-noded tri-linear hexahedron. 8 | CDOC 9 | CDOC BEGIN_PARAMETERS 10 | CDOC DOUBLE_PRECISION EXMATX < Extrapolation matrix. 11 | CDOC END_PARAMETERS 12 | CHST 13 | CHST D. de Bortoli, April 2015: Initial coding 14 | CHST 15 | SUBROUTINE EXH8FB 16 | 1( EXMATX ) 17 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 18 | PARAMETER(NNODE=8, NGAUSP=8) 19 | DIMENSION EXMATX(NNODE,NGAUSP) 20 | DATA 21 | 1 A8 ,B8 ,C8 , 22 | 2 D8 / 23 | 3 2.54903810567666D0 ,-0.683012701892219D0 ,0.183012701892219D0, 24 | 4 -0.0490381056766580D0/ 25 | C*********************************************************************** 26 | C SETS COEFFICIENTS MATRIX (EXMATX) FOR EXTRAPOLATION FROM GAUSS POINTS 27 | C TO NODES FOR ELEMENT TYPE 'HEXA_8_FBAR' (F-BAR 8-NODED TRI-LINEAR 28 | C HEXAHEDRON) 29 | C 30 | C REFERENCE: Section 5.6.1 31 | C E Hinton & JS Campbel. Local and global Smoothing of 32 | C discontinuous finite element functions using a least 33 | C squares method. Int. J. Num. meth. Engng., 8:461-480, 1974. 34 | C E Hinton & DRJ Owen. An introduction to finite element 35 | C computations. Pineridge Press, Swansea, 1979. 36 | C*********************************************************************** 37 | EXMATX(1,1)=A8 38 | EXMATX(1,2)=B8 39 | EXMATX(1,3)=B8 40 | EXMATX(1,4)=C8 41 | EXMATX(1,5)=B8 42 | EXMATX(1,6)=C8 43 | EXMATX(1,7)=C8 44 | EXMATX(1,8)=D8 45 | C 46 | EXMATX(2,1)=B8 47 | EXMATX(2,2)=C8 48 | EXMATX(2,3)=C8 49 | EXMATX(2,4)=D8 50 | EXMATX(2,5)=A8 51 | EXMATX(2,6)=B8 52 | EXMATX(2,7)=B8 53 | EXMATX(2,8)=C8 54 | C 55 | EXMATX(3,1)=C8 56 | EXMATX(3,2)=D8 57 | EXMATX(3,3)=B8 58 | EXMATX(3,4)=C8 59 | EXMATX(3,5)=B8 60 | EXMATX(3,6)=C8 61 | EXMATX(3,7)=A8 62 | EXMATX(3,8)=B8 63 | C 64 | EXMATX(4,1)=B8 65 | EXMATX(4,2)=C8 66 | EXMATX(4,3)=A8 67 | EXMATX(4,4)=B8 68 | EXMATX(4,5)=C8 69 | EXMATX(4,6)=D8 70 | EXMATX(4,7)=B8 71 | EXMATX(4,8)=C8 72 | C 73 | EXMATX(5,1)=B8 74 | EXMATX(5,2)=A8 75 | EXMATX(5,3)=C8 76 | EXMATX(5,4)=B8 77 | EXMATX(5,5)=C8 78 | EXMATX(5,6)=B8 79 | EXMATX(5,7)=D8 80 | EXMATX(5,8)=C8 81 | C 82 | EXMATX(6,1)=C8 83 | EXMATX(6,2)=B8 84 | EXMATX(6,3)=D8 85 | EXMATX(6,4)=C8 86 | EXMATX(6,5)=B8 87 | EXMATX(6,6)=A8 88 | EXMATX(6,7)=C8 89 | EXMATX(6,8)=B8 90 | C 91 | EXMATX(7,1)=D8 92 | EXMATX(7,2)=C8 93 | EXMATX(7,3)=C8 94 | EXMATX(7,4)=B8 95 | EXMATX(7,5)=C8 96 | EXMATX(7,6)=B8 97 | EXMATX(7,7)=B8 98 | EXMATX(7,8)=A8 99 | C 100 | EXMATX(8,1)=C8 101 | EXMATX(8,2)=B8 102 | EXMATX(8,3)=B8 103 | EXMATX(8,4)=A8 104 | EXMATX(8,5)=D8 105 | EXMATX(8,6)=C8 106 | EXMATX(8,7)=C8 107 | EXMATX(8,8)=B8 108 | C 109 | RETURN 110 | END 111 | CDOC END_SUBROUTINE EXH8FB 112 | -------------------------------------------------------------------------------- /src/GENERAL/rtsx.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE RTSX 2 | CDOC Matrix product s.Rt S X 3 | CDOC 4 | CDOC This routine performs the matrix product s Rt S X, where s is a 5 | CDOC scalar, R and X rectangular real matrices of identical dimensions 6 | CDOC and S a square real matrix. Rt denotes the transpose of R. 7 | CDOC 8 | CDOC BEGIN_PARAMETERS 9 | CDOC DOUBLE_PRECISION AUXM < Auxiliary matrix used to store partial 10 | CDOC C results of the calculation. 11 | CDOC INTEGER MODE > If set to 1, the argument Q 12 | CDOC C returns the resulting matrix Rt S R. 13 | CDOC C Otherwise, Rt S R is added to the input 14 | CDOC C value of Q. 15 | CDOC INTEGER MROWQ > Dimensioning parameter: maximum 16 | CDOC C dimension of the square matrix Q. 17 | CDOC INTEGER MROWR > Dimensioning parameter: maximum number 18 | CDOC C of rows of R (same as the 19 | CDOC C maximum dimension of square matrix S). 20 | CDOC INTEGER NCOLR > Number of columns of R. 21 | CDOC INTEGER NROWR > Number of rows of R. 22 | CDOC DOUBLE_PRECISION Q <> Matrix where results are stored. 23 | CDOC DOUBLE_PRECISION R > Rectangular real matrix. 24 | CDOC DOUBLE_PRECISION S > Square real matrix. 25 | CDOC DOUBLE_PRECISION X > Rectangular real matrix. 26 | CDOC DOUBLE_PRECISION SCAL > Real scalar. 27 | CDOC END_PARAMETERS 28 | CHST 29 | CHST E.de Souza Neto, September 1996: Initial coding 30 | CHST 31 | CHST E.de Souza Neto & F.M.A.Pires , April 2002: 32 | CHST Bug fix in skipping zero multiplication 33 | CHST 34 | SUBROUTINE RTSX 35 | 1( AUXM ,MODE ,MROWQ ,MROWR ,NCOLR , 36 | 2 NROWR ,Q ,R ,S ,X , 37 | 3 SCAL ) 38 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 39 | DIMENSION 40 | 1 AUXM(NCOLR,NROWR) ,Q(MROWQ,MROWQ) ,R(MROWR,NCOLR) , 41 | 2 S(MROWR,MROWR) ,X(MROWR,NCOLR) 42 | DATA R0 /0.0D0/ 43 | C*********************************************************************** 44 | C PERFORMS THE MATRIX PRODUCTS 45 | C T 46 | C Q := SCAL * R S X (IF MODE=1) 47 | C OR 48 | C T 49 | C Q := Q + SCAL * R S X (OTHERWISE) 50 | C 51 | C WHERE 'R' AND 'X' ARE REAL RECTANGULAR MATRICES OF IDENTICAL 52 | C DIMENSIONS, 'S' A REAL SQUARE MATRIX AND 'SCAL' A SCALAR. 53 | C*********************************************************************** 54 | CALL RVZERO(AUXM,NCOLR*NROWR) 55 | DO 30 I=1,NCOLR 56 | DO 20 K=1,NROWR 57 | IF(R(K,I).NE.R0)THEN 58 | DO 10 J=1,NROWR 59 | AUXM(I,J)=AUXM(I,J)+SCAL*R(K,I)*S(K,J) 60 | 10 CONTINUE 61 | ENDIF 62 | 20 CONTINUE 63 | 30 CONTINUE 64 | C 65 | IF(MODE.EQ.1)THEN 66 | DO 50 I=1,NCOLR 67 | DO 40 J=1,NCOLR 68 | Q(I,J)=R0 69 | 40 CONTINUE 70 | 50 CONTINUE 71 | ENDIF 72 | C 73 | C Construct the matrix Q 74 | DO 80 J=1,NCOLR 75 | DO 70 K=1,NROWR 76 | IF(X(K,J).NE.R0)THEN 77 | DO 60 I=1,NCOLR 78 | Q(I,J)=Q(I,J)+AUXM(I,K)*X(K,J) 79 | 60 CONTINUE 80 | ENDIF 81 | 70 CONTINUE 82 | 80 CONTINUE 83 | C 84 | RETURN 85 | END 86 | CDOC END_SUBROUTINE RTSX 87 | -------------------------------------------------------------------------------- /src/ELEMENTS/sfq4fb.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE SFQ4FB 2 | CDOC Shape function and derivatives for element type QUA4FB 3 | CDOC 4 | CDOC This routine computes the shape functions and shape function 5 | CDOC derivatives for the element type QUA4FB: F-bar isoparametric 6 | CDOC 4-noded quadrilateral for plane strain and axisymmetric analysis. 7 | CDOC 8 | CDOC BEGIN_PARAMETERS 9 | CDOC DOUBLE_PRECISION DERIV < Array of shape function derivatives. 10 | CDOC DOUBLE_PRECISION ETASP > Isoparametric coordinate ETA of the 11 | CDOC C point where the shape functions or their 12 | CDOC C derivatives are to be evaluated. 13 | CDOC DOUBLE_PRECISION EXISP > Isoparametric coordinate XI of the 14 | CDOC C point where the shape functions or their 15 | CDOC C derivatives are to be evaluated. 16 | CDOC INTEGER IBOUND > Boundary interpolation flag. Entry 17 | CDOC C must be 0 for domain interpolation. 18 | CDOC C Boundary interpolation is assumed 19 | CDOC C otherwise. 20 | CDOC INTEGER MDIME > Maximum permissible number of spatial 21 | CDOC C dimensions. Used here only for array 22 | CDOC C dimensioning. 23 | CDOC DOUBLE_PRECISION SHAPE < Array of shape function values. 24 | CDOC END_PARAMETERS 25 | CHST 26 | CHST E.de Souza Neto, September 1996: Initial coding 27 | CHST 28 | SUBROUTINE SFQ4FB 29 | 1( DERIV ,ETASP ,EXISP ,IBOUND ,MDIME , 30 | 2 SHAPE ) 31 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 32 | DIMENSION 33 | 1 DERIV(MDIME,*) ,SHAPE(*) 34 | DATA RP25 ,RP5 ,R1 /0.25D0,0.5D0,1.0D0/ 35 | C*********************************************************************** 36 | C COMPUTES SHAPE FUNCTIONS AND SHAPE FUNCTION DERIVATIVES FOR 37 | C ELEMENT 'QUAD_4_FBAR': 38 | C 4 3 39 | C o-------o 40 | C | Fo | F-BAR BI-LINEAR 41 | C | x | 4 NODE QUADRILATERAL 42 | C | | 43 | C o-------o 44 | C 1 2 45 | C 46 | C 47 | C REFERENCE: Expression (4.42) 48 | C*********************************************************************** 49 | IF(IBOUND.EQ.0)THEN 50 | C Shape functions and derivatives on element DOMAIN 51 | C ------------------------------------------------- 52 | S=EXISP 53 | T=ETASP 54 | ST=S*T 55 | C Shape functions 56 | SHAPE(1)=(R1-T-S+ST)*RP25 57 | SHAPE(2)=(R1-T+S-ST)*RP25 58 | SHAPE(3)=(R1+T+S+ST)*RP25 59 | SHAPE(4)=(R1+T-S-ST)*RP25 60 | C Shape function derivatives 61 | DERIV(1,1)=(-R1+T)*RP25 62 | DERIV(1,2)=(+R1-T)*RP25 63 | DERIV(1,3)=(+R1+T)*RP25 64 | DERIV(1,4)=(-R1-T)*RP25 65 | DERIV(2,1)=(-R1+S)*RP25 66 | DERIV(2,2)=(-R1-S)*RP25 67 | DERIV(2,3)=(+R1+S)*RP25 68 | DERIV(2,4)=(+R1-S)*RP25 69 | ELSE 70 | C Shape function and derivatives on element BOUNDARY (1-D) 71 | C -------------------------------------------------------- 72 | S=EXISP 73 | C Shape functions 74 | SHAPE(1)=(-S+R1)*RP5 75 | SHAPE(2)=(+S+R1)*RP5 76 | C Shape functions derivatives 77 | DERIV(1,1)=-RP5 78 | DERIV(1,2)=RP5 79 | C 80 | ENDIF 81 | C 82 | RETURN 83 | END 84 | CDOC END_SUBROUTINE SFQ4FB 85 | -------------------------------------------------------------------------------- /src/ELEMENTS/sfq4.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE SFQ4 2 | CDOC Shape function and derivatives for element type QUAD4 3 | CDOC 4 | CDOC This routine computes the shape functions and shape function 5 | CDOC derivatives for the element type QUAD4: Standard isoparametric 6 | CDOC 4-noded quadrilateral for plane strain, plane stress and 7 | CDOC axisymmetric analysis. 8 | CDOC 9 | CDOC BEGIN_PARAMETERS 10 | CDOC DOUBLE_PRECISION DERIV < Array of shape function derivatives. 11 | CDOC DOUBLE_PRECISION ETASP > Isoparametric coordinate ETA of the 12 | CDOC C point where the shape functions or their 13 | CDOC C derivatives are to be evaluated. 14 | CDOC DOUBLE_PRECISION EXISP > Isoparametric coordinate XI of the 15 | CDOC C point where the shape functions or their 16 | CDOC C derivatives are to be evaluated. 17 | CDOC INTEGER IBOUND > Boundary interpolation flag. Entry 18 | CDOC C must be 0 for domain interpolation. 19 | CDOC C Boundary interpolation is assumed 20 | CDOC C otherwise. 21 | CDOC INTEGER MDIME > Maximum permissible number of spatial 22 | CDOC C dimensions. Used here only for array 23 | CDOC C dimensioning. 24 | CDOC DOUBLE_PRECISION SHAPE < Array of shape function values. 25 | CDOC END_PARAMETERS 26 | CHST 27 | CHST E.de Souza Neto, September 1996: Initial coding 28 | CHST 29 | SUBROUTINE SFQ4 30 | 1( DERIV ,ETASP ,EXISP ,IBOUND ,MDIME , 31 | 2 SHAPE ) 32 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 33 | DIMENSION 34 | 1 DERIV(MDIME,*) ,SHAPE(*) 35 | DATA RP25 ,RP5 ,R1 /0.25D0,0.5D0,1.0D0/ 36 | C*********************************************************************** 37 | C COMPUTES SHAPE FUNCTIONS AND SHAPE FUNCTION DERIVATIVES FOR 38 | C ELEMENT 'QUAD_4': 39 | C 4 3 40 | C o-------o 41 | C | | STANDARD ISOPARAMETRIC 42 | C | | BI-LINEAR 4-NODE QUADRILATERAL 43 | C | | 44 | C o-------o 45 | C 1 2 46 | C 47 | C REFERENCE: Expression (4.42) 48 | C*********************************************************************** 49 | IF(IBOUND.EQ.0)THEN 50 | C Shape functions and derivatives on element DOMAIN 51 | C ------------------------------------------------- 52 | S=EXISP 53 | T=ETASP 54 | ST=S*T 55 | C Shape functions 56 | SHAPE(1)=(R1-T-S+ST)*RP25 57 | SHAPE(2)=(R1-T+S-ST)*RP25 58 | SHAPE(3)=(R1+T+S+ST)*RP25 59 | SHAPE(4)=(R1+T-S-ST)*RP25 60 | C Shape function derivatives 61 | DERIV(1,1)=(-R1+T)*RP25 62 | DERIV(1,2)=(+R1-T)*RP25 63 | DERIV(1,3)=(+R1+T)*RP25 64 | DERIV(1,4)=(-R1-T)*RP25 65 | DERIV(2,1)=(-R1+S)*RP25 66 | DERIV(2,2)=(-R1-S)*RP25 67 | DERIV(2,3)=(+R1+S)*RP25 68 | DERIV(2,4)=(+R1-S)*RP25 69 | ELSE 70 | C Shape function and derivatives on element BOUNDARY (1-D) 71 | C -------------------------------------------------------- 72 | S=EXISP 73 | C Shape functions 74 | SHAPE(1)=(-S+R1)*RP5 75 | SHAPE(2)=(+S+R1)*RP5 76 | C Shape functions derivatives 77 | DERIV(1,1)=-RP5 78 | DERIV(1,2)=RP5 79 | C 80 | ENDIF 81 | C 82 | RETURN 83 | END 84 | CDOC END_SUBROUTINE SFQ4 85 | -------------------------------------------------------------------------------- /src/ELEMENTS/ext7.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE EXH8 2 | CDOC Sets Gauss point-node extrapolation matrix for element type HEXA_8 3 | CDOC 4 | CDOC This routine sets the coefficients matrix for extrapolation of 5 | CDOC fields from Gauss point values to nodal values for element type 6 | CDOC HEXA_8: Standard isoparametric 8-noded tri-linear hexahedron. 7 | CDOC 8 | CDOC BEGIN_PARAMETERS 9 | CDOC INTEGER NGAUSP > Number of Gauss points. 10 | CDOC DOUBLE_PRECISION EXMATX < Extrapolation matrix. 11 | CDOC END_PARAMETERS 12 | CHST 13 | CHST D. de Bortoli, March 2015: Initial coding, based on EXQ4 14 | CHST 15 | SUBROUTINE EXT7 16 | 1( NGAUSP ,EXMATX ) 17 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 18 | PARAMETER(NNODE=10) 19 | DIMENSION EXMATX(NNODE,NGAUSP) 20 | DATA R1 / 21 | 1 1.0D0 / 22 | DATA 23 | 1 w1 ,w2 ,w3 , 24 | 2 w4 / 25 | 3 0.2500000000000000 ,0.2500000000000000,0.2500000000000000, 26 | 4 0.2500000000000000/ 27 | C*********************************************************************** 28 | C SETS COEFFICIENTS MATRIX (EXMATX) FOR EXTRAPOLATION FROM GAUSS POINTS 29 | C TO NODES FOR ELEMENT TYPE 'HEXA_8' (STANDARD 8-NODED TRI-LINEAR 30 | C HEXAHEDRON) 31 | C 32 | C REFERENCE: Section 5.6.1 33 | C E Hinton & JS Campbel. Local and global Smoothing of 34 | C discontinuous finite element functions using a least 35 | C squares method. Int. J. Num. meth. Engng., 8:461-480, 1974. 36 | C E Hinton & DRJ Owen. An introduction to finite element 37 | C computations. Pineridge Press, Swansea, 1979. 38 | C*********************************************************************** 39 | IF(NGAUSP.EQ.1)THEN 40 | EXMATX(1,1)=R1 41 | EXMATX(2,1)=R1 42 | EXMATX(3,1)=R1 43 | EXMATX(4,1)=R1 44 | EXMATX(5,1)=R1 45 | EXMATX(6,1)=R1 46 | EXMATX(7,1)=R1 47 | EXMATX(8,1)=R1 48 | EXMATX(9,1)=R1 49 | EXMATX(10,1)=R1 50 | ELSEIF(NGAUSP.EQ.4)THEN 51 | EXMATX(1,1)=1.5 52 | EXMATX(1,2)=-0.5 53 | EXMATX(1,3)=-0.5 54 | EXMATX(1,4)=-0.5 55 | EXMATX(1,5)=0.5 56 | EXMATX(1,6)=-0.5 57 | EXMATX(1,7)=0.5 58 | EXMATX(1,8)=0.5 59 | EXMATX(1,9)=-0.5 60 | EXMATX(1,10)=-0.5 61 | C 62 | EXMATX(2,1)=-0.16666667 63 | EXMATX(2,2)=1.83333333 64 | EXMATX(2,3)=-0.16666667 65 | EXMATX(2,4)=-0.16666667 66 | EXMATX(2,5)=0.83333333 67 | EXMATX(2,6)=0.83333333 68 | EXMATX(2,7)=-0.16666667 69 | EXMATX(2,8)=-0.16666667 70 | EXMATX(2,9)=0.83333333 71 | EXMATX(2,10)=-0.16666667 72 | C 73 | EXMATX(3,1)=-0.16666667 74 | EXMATX(3,2)=-0.16666667 75 | EXMATX(3,3)=1.83333333 76 | EXMATX(3,4)=-0.16666667 77 | EXMATX(3,5)=-0.16666667 78 | EXMATX(3,6)=0.83333333 79 | EXMATX(3,7)=0.83333333 80 | EXMATX(3,8)=-0.16666667 81 | EXMATX(3,9)=-0.16666667 82 | EXMATX(3,10)=0.83333333 83 | C 84 | EXMATX(4,1)=-0.16666667 85 | EXMATX(4,2)=-0.16666667 86 | EXMATX(4,3)=-0.16666667 87 | EXMATX(4,4)=1.83333333 88 | EXMATX(4,5)=-0.16666667 89 | EXMATX(4,6)=-0.16666667 90 | EXMATX(4,7)=-0.16666667 91 | EXMATX(4,8)=0.83333333 92 | EXMATX(4,9)=0.83333333 93 | EXMATX(4,10)=0.83333333 94 | ENDIF 95 | C 96 | RETURN 97 | END 98 | CDOC END_SUBROUTINE EXT7 99 | -------------------------------------------------------------------------------- /src/OGDEN/swogd.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE SWOGD 2 | CDOC Initialise/switch state variables for the Ogden hyperelastic model 3 | CDOC 4 | CDOC This initialises and switches state variables (between current and 5 | CDOC previous values) for the Ogden hyperelastic material model. 6 | CDOC 7 | CDOC BEGIN_PARAMETERS 8 | CDOC INTEGER MODE > Initialisation/Switching mode. See 9 | CDOC C source code comments for details. 10 | CDOC INTEGER NTYPE > Stress state type flag. 11 | CDOC DOUBLE_PRECISION RSTAVC <> Array of real state variables at Gauss 12 | CDOC C point. Current values. 13 | CDOC DOUBLE_PRECISION RSTAVL <> Array of real state variables at Gauss 14 | CDOC C point. Last converged (equilibrium) 15 | CDOC C values. 16 | CDOC DOUBLE_PRECISION STRESC <> Array of stress (Cauchy in large strain) 17 | CDOC C components. Current values. 18 | CDOC DOUBLE_PRECISION STRESL <> Array of stress (Cauchy in large strain) 19 | CDOC C components. Last converged (equilibrium) 20 | CDOC C values. 21 | CDOC END_PARAMETERS 22 | CHST 23 | CHST E.de Souza Neto, July 1999: Initial coding 24 | CHST 25 | SUBROUTINE SWOGD 26 | 1( MODE ,NTYPE ,RSTAVC ,RSTAVL ,STRESC , 27 | 2 STRESL ) 28 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 29 | C Arguments 30 | DIMENSION 31 | 1 RSTAVC(*) ,RSTAVL(*) ,STRESC(*) , 32 | 2 STRESL(*) 33 | C Local numerical constants 34 | DATA R0 ,R1 / 35 | 1 0.0D0,1.0D0/ 36 | C*********************************************************************** 37 | C INITIALISE/SWITCH DATA FOR THE OGDEN MATERIAL MODEL 38 | C 39 | C MODE=0: Initialises the relevant data. 40 | C 41 | C MODE=1: Assigns current values of the state variables to 42 | C converged solution (when the current iteration 43 | C satisfies the convergence criterion). 44 | C 45 | C MODE=2: Assigns the last converged solution to current state 46 | C variables values (when a new iteration is required by 47 | C the iterative process). 48 | C 49 | C MODE=3: Assigns the last converged solution to current state 50 | C variables values (when increment cutting is required). 51 | C*********************************************************************** 52 | C 53 | IF(NTYPE.EQ.1.OR.NTYPE.EQ.2.OR.NTYPE.EQ.3)THEN 54 | NSTRE=4 55 | NRSTAV=4 56 | ENDIF 57 | C 58 | IF(MODE.EQ.0)THEN 59 | C Initialisation mode 60 | C =================== 61 | C Zero stress component array 62 | CALL RVZERO(STRESC,NSTRE) 63 | C RSTAVA stores the left Cauchy-Green strain tensor components. 64 | C Initialised as identity 65 | IF(NTYPE.EQ.1.OR.NTYPE.EQ.2.OR.NTYPE.EQ.3)THEN 66 | RSTAVC(1)=R1 67 | RSTAVC(2)=R1 68 | RSTAVC(3)=R0 69 | RSTAVC(4)=R1 70 | ENDIF 71 | C Switching modes 72 | C =============== 73 | ELSEIF(MODE.EQ.1)THEN 74 | DO 10 I=1,NSTRE 75 | STRESL(I)=STRESC(I) 76 | 10 CONTINUE 77 | DO 20 I=1,NRSTAV 78 | RSTAVL(I)=RSTAVC(I) 79 | 20 CONTINUE 80 | ELSEIF(MODE.EQ.2.OR.MODE.EQ.3)THEN 81 | DO 30 I=1,NSTRE 82 | STRESC(I)=STRESL(I) 83 | 30 CONTINUE 84 | DO 40 I=1,NRSTAV 85 | RSTAVC(I)=RSTAVL(I) 86 | 40 CONTINUE 87 | ENDIF 88 | RETURN 89 | END 90 | CDOC END_SUBROUTINE SWOGD 91 | -------------------------------------------------------------------------------- /src/DAMAGED_ELASTIC/rddmel.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE RDDMEL 2 | CDOC Read data for damaged elastic/crack closure model. 3 | CDOC 4 | CDOC This routine reads from the data file and echos to the results file 5 | CDOC the material parameters necessary for the isotropically damaged 6 | CDOC isotropic elastic model accounting for partial microcrack/void 7 | CDOC closure effects (quasi-unilateral conditions) under compressive 8 | CDOC stresses. 9 | CDOC 10 | CDOC BEGIN_PARAMETERS 11 | CDOC INTEGER NTYPE > Stress state type flag. 12 | CDOC DOUBLE_PRECISION RPROPS < Array of real material properties. 13 | CDOC LOGICAL UNSYM < Unsymmetric tangent stiffness flag. 14 | CDOC END_PARAMETERS 15 | CHST 16 | CHST E.de Souza Neto, July 2001: Initial coding 17 | CHST 18 | CHST E.de Souza Neto, October 2008: Dimensioning checks included 19 | CHST 20 | CHST E.de Souza Neto, April 2011: I/O error message added 21 | CHST 22 | SUBROUTINE RDDMEL 23 | 1( NTYPE ,MRPROP ,MRSTAV ,RPROPS ,UNSYM ) 24 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 25 | LOGICAL UNSYM 26 | PARAMETER( NRPROP=7 ,NRSTAV=4 ) 27 | DIMENSION 28 | 1 RPROPS(*) 29 | DATA R0 ,RP5 ,R1 ,R2 ,R3 / 30 | 1 0.0D0,0.5D0,1.0D0,2.0D0,3.0D0/ 31 | C*********************************************************************** 32 | C READ AND ECHO MATERIAL PROPERTIES FOR ISOTROPICALLY DAMAGED ISOTROPIC 33 | C ELASTIC MATERIAL MODEL WITH PARTIAL MICROCRACK/VOID CLOSURE EFFECTS 34 | C 35 | C REFERENCE: Section 12.6.1 36 | C*********************************************************************** 37 | 1000 FORMAT(' DAMAGED ELASTIC material (damaged HENCKY material in', 38 | 1 ' large strains)'/ 39 | 2 ' with partial microcrack closure effect'/) 40 | 1010 FORMAT( 41 | 1' Mass density ...................................... =',G15.6/ 42 | 2' Young''s modulus ................................... =',G15.6/ 43 | 3' Poisson''s ratio ................................... =',G15.6/ 44 | 4' Damage constant (D) ............................... =',G15.6/ 45 | 5' Crack closure parameter (h) ....................... =',G15.6) 46 | C 47 | C Check that required stress state type is implemented 48 | C 49 | IF(NTYPE.NE.2.AND.NTYPE.NE.3)CALL ERRPRT('ED0173') 50 | C 51 | C Set unsymmetric tangent stiffness flag 52 | C 53 | UNSYM=.FALSE. 54 | C 55 | C Read and echo material properties 56 | C 57 | WRITE(16,1000) 58 | READ(15,*,ERR=100,END=100)DENSE 59 | READ(15,*,ERR=100,END=100)YOUNG,POISS 60 | READ(15,*,ERR=100,END=100)DAMAGE,HFACT 61 | WRITE(16,1010)DENSE,YOUNG,POISS,DAMAGE,HFACT 62 | C Perform checks 63 | IF(YOUNG.LT.R0)CALL ERRPRT('ED0174') 64 | IF(POISS.LE.-R1.AND.POISS.GE.RP5)CALL ERRPRT('ED0175') 65 | IF(DAMAGE.LT.R0.OR.DAMAGE.GE.R1)CALL ERRPRT('ED0176') 66 | IF(HFACT.LT.R0.OR.HFACT.GT.R1)CALL ERRPRT('ED0177') 67 | C 68 | C Check dimensioning 69 | C 70 | IF(NRPROP.GT.MRPROP)CALL ERRPRT('ED0193') 71 | IF(NRSTAV.GT.MRSTAV)CALL ERRPRT('ED0194') 72 | C 73 | C Set vector of real material properties 74 | C 75 | GMODU=YOUNG/(R2*(R1+POISS)) 76 | BULK=YOUNG/(R3*(R1-R2*POISS)) 77 | RPROPS(1)=DENSE 78 | RPROPS(2)=YOUNG 79 | RPROPS(3)=POISS 80 | RPROPS(4)=DAMAGE 81 | RPROPS(5)=HFACT 82 | RPROPS(6)=GMODU 83 | RPROPS(7)=BULK 84 | C 85 | C Issue message and abort program execution in case of I/O error 86 | GOTO 200 87 | 100 CALL ERRPRT('ED0202') 88 | 200 CONTINUE 89 | C 90 | RETURN 91 | END 92 | CDOC END_SUBROUTINE RDDMEL 93 | -------------------------------------------------------------------------------- /src/MATHS/diso3.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE DISO3 2 | CDOC Derivative of a class of isotropic tensor function of one tensor 3 | CDOC 4 | CDOC This function computes the derivative, dY(X)/dX, of a particular 5 | CDOC class of symmetric isotropic tensor valued function of one 6 | CDOC symmetric tensor, Y(X). 7 | CDOC This implementation is restricted to 3-D. 8 | CDOC The subroutine for the general derivative of isotropic tensor 9 | CDOC functions of one tensor, DGISO3, is particularised to this class 10 | CDOC of tensor functions. 11 | CDOC The class of tensor functions Y(X) is assumed to be defined as 12 | CDOC Y(X)= Sum[y(xi) ei(x)ei], where the scalar function y(xi) defines 13 | CDOC the eigenvalues of the tensor Y and xi the eigenvalues of the 14 | CDOC tensor X. ei are the egenvectors of X (which by definition of 15 | CDOC Y(X), coincide with those of tensor Y) and "(x)" denotes the 16 | CDOC tensor product. 17 | CDOC 18 | CDOC BEGIN_PARAMETERS 19 | CDOC DOUBLE_PRECISION DYDX < Matrix of components of the derivative 20 | CDOC C (fourth order tensor) dY/dX. 21 | CDOC SYMBOLIC_NAME DFUNC > Symbolic name of the double precision 22 | CDOC C function defining the derivative 23 | CDOC C dy(x)/dx of the eigenvalues of the 24 | CDOC C tensor function. 25 | CDOC SYMBOLIC_NAME FUNC > Symbolic name of the double precision 26 | CDOC C function defining the eigenvalues y(x) 27 | CDOC C of the tensor fumction. 28 | CDOC DOUBLE_PRECISION X > Point (argument) at which the 29 | CDOC C derivative is to be computed. 30 | CDOC END_PARAMETERS 31 | CHST 32 | CHST D. de Bortoli, March 2015: Initial coding, based on DISO2 33 | CHST 34 | SUBROUTINE DISO3 35 | 1( DYDX ,DFUNC ,FUNC ,X ) 36 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 37 | EXTERNAL 38 | 1 DFUNC ,FUNC 39 | PARAMETER 40 | 1( MCOMP=6 ,NDIM=3 ) 41 | C Arguments 42 | DIMENSION 43 | 1 DYDX(MCOMP,MCOMP) ,X(MCOMP) 44 | C Local variables and arrays 45 | LOGICAL REPEAT(5) 46 | DIMENSION 47 | 1 DEIGY(NDIM,NDIM) ,EIGPRJ(MCOMP,NDIM) ,EIGX(NDIM) , 48 | 2 EIGY(NDIM) 49 | C*********************************************************************** 50 | C COMPUTE (AND STORE IN MATRIX FORM) THE DERIVATIVE dY/dX OF AN 51 | C ISOTROPIC TENSOR FUNCTION OF THE TYPE: 52 | C 53 | C Y(X) = sum{ y(x_i) E_i } 54 | C 55 | C WHERE Y AND X ARE SYMMETRIC TENSORS, x_i AND E_i ARE, RESPECTIVELY 56 | C THE EIGENVALUES AND EIGENPROJECTIONS OF X, AND y(.) IS A SCALAR 57 | C FUNCTION. THIS ROUTINE IS RESTRICTED TO 3-D TENSORS. 58 | C 59 | C REFERENCE: Section A.5.2 60 | C*********************************************************************** 61 | C Spectral decomposition of X 62 | CALL SPDEC3 63 | 1( EIGPRJ ,EIGX ,REPEAT ,X ) 64 | C Evaluate eigenvalues of Y and their derivatives 65 | C ----------------------------------------------- 66 | C DEIGY is a diagonal matrix containing the derivatives of the 67 | C eigenvalues of Y with respect to each eigenvalue of X 68 | CALL RVZERO(DEIGY, NDIM*NDIM) 69 | DO 10 IDIR=1,3 70 | EIGY(IDIR)=FUNC(EIGX(IDIR)) 71 | DEIGY(IDIR,IDIR)=DFUNC(EIGX(IDIR)) 72 | 10 CONTINUE 73 | C 74 | C Calculate components of dY/dX using DGISO3 75 | C ------------------------------------------ 76 | CALL DGISO3 77 | 1( DEIGY ,DYDX ,EIGPRJ ,EIGX ,EIGY , 78 | 2 REPEAT ,X ) 79 | C 80 | RETURN 81 | END 82 | CDOC END_SUBROUTINE DISO3 83 | -------------------------------------------------------------------------------- /src/MATHS/spdec3.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE SPDEC3 2 | CDOC Spectral decomposition of 3-D symmetric tensors 3 | CDOC 4 | CDOC This routine performs the spectral decomposition of 3-D symmetric 5 | CDOC tensors. The tensor is passed as argument (stored in vector form). 6 | CDOC 7 | CDOC BEGIN_PARAMETERS 8 | CDOC DOUBLE_PRECISION EIGPRJ < Matrix with one eigenprojection tensor 9 | CDOC C of \smparm{X} stored in each column. 10 | CDOC DOUBLE_PRECISION EIGX < Array containing the eigenvalues of 11 | CDOC C \smparm{X}. 12 | CDOC LOGICAL REPEAT < Array of repeated (within a small 13 | CDOC C tolerance) eigenvalues flag. 14 | CDOC DOUBLE_PRECISION X > Array containing the components of a 15 | CDOC C symmetric tensor. 16 | CDOC END_PARAMETERS 17 | CDOC 18 | CDOC E.de Souza Neto, March 1999: Initial coding 19 | CDOC 20 | SUBROUTINE SPDEC3 21 | 1( EIGPRJ ,EIGX ,REPEAT ,X ) 22 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 23 | PARAMETER 24 | 1( MCOMP=6 ,NDIM=3 ) 25 | C Arguments 26 | LOGICAL REPEAT(5) 27 | DIMENSION 28 | 1 EIGPRJ(MCOMP,NDIM) ,EIGX(NDIM) , 29 | 2 X(MCOMP) 30 | C Local arrays and variables 31 | LOGICAL DIF123 ,REP123 ,REP12 ,REP13 ,REP23 32 | DIMENSION 33 | 1 AUXMTX(NDIM,NDIM) ,EIGVEC(NDIM,NDIM) 34 | DATA 35 | 1 R0 ,R1 ,SMALL / 36 | 2 0.0D0,1.0D0,1.D-8 / 37 | C*********************************************************************** 38 | C PERFORMS THE SPECTRAL DECOMPOSITION OF A SYMMETRIC 3-D TENSOR STORED 39 | C IN VECTOR FORM 40 | C*********************************************************************** 41 | AUXMTX(1,1)=X(1) 42 | AUXMTX(2,2)=X(2) 43 | AUXMTX(3,3)=X(3) 44 | AUXMTX(1,2)=X(4) 45 | AUXMTX(2,3)=X(5) 46 | AUXMTX(1,3)=X(6) 47 | AUXMTX(2,1)=AUXMTX(1,2) 48 | AUXMTX(3,2)=AUXMTX(2,3) 49 | AUXMTX(3,1)=AUXMTX(1,3) 50 | CALL JACOB(AUXMTX,EIGX,EIGVEC,3) 51 | DO IDIR=1,3 52 | EIGPRJ(1,IDIR)=EIGVEC(1,IDIR)*EIGVEC(1,IDIR) 53 | EIGPRJ(2,IDIR)=EIGVEC(2,IDIR)*EIGVEC(2,IDIR) 54 | EIGPRJ(3,IDIR)=EIGVEC(3,IDIR)*EIGVEC(3,IDIR) 55 | EIGPRJ(4,IDIR)=EIGVEC(1,IDIR)*EIGVEC(2,IDIR) 56 | EIGPRJ(5,IDIR)=EIGVEC(2,IDIR)*EIGVEC(3,IDIR) 57 | EIGPRJ(6,IDIR)=EIGVEC(1,IDIR)*EIGVEC(3,IDIR) 58 | END DO 59 | C Identify possible repetitions of principal stretches 60 | C ---------------------------------------------------- 61 | DIF123=.FALSE. 62 | REP123=.FALSE. 63 | REP12=.FALSE. 64 | REP13=.FALSE. 65 | REP23=.FALSE. 66 | AMXEIG=ABS(EIGX(1)) 67 | IF(ABS(EIGX(2)).GT.AMXEIG)AMXEIG=ABS(EIGX(2)) 68 | IF(ABS(EIGX(3)).GT.AMXEIG)AMXEIG=ABS(EIGX(3)) 69 | FACTOR=R1 70 | IF(AMXEIG.NE.R0)THEN 71 | FACTOR=AMXEIG 72 | ELSE 73 | FACTOR=R1 74 | ENDIF 75 | IF(ABS(EIGX(1)-EIGX(2))/FACTOR.LT.SMALL.AND. 76 | 1 ABS(EIGX(1)-EIGX(3))/FACTOR.LT.SMALL)THEN 77 | REP123=.TRUE. 78 | ELSEIF(ABS(EIGX(1)-EIGX(2))/FACTOR.LT.SMALL.AND. 79 | 1 ABS(EIGX(1)-EIGX(3))/FACTOR.GE.SMALL)THEN 80 | REP12=.TRUE. 81 | ELSEIF(ABS(EIGX(1)-EIGX(3))/FACTOR.LT.SMALL.AND. 82 | 1 ABS(EIGX(1)-EIGX(2))/FACTOR.GE.SMALL)THEN 83 | REP13=.TRUE. 84 | ELSEIF(ABS(EIGX(2)-EIGX(3))/FACTOR.LT.SMALL.AND. 85 | 1 ABS(EIGX(2)-EIGX(1))/FACTOR.GE.SMALL)THEN 86 | REP23=.TRUE. 87 | ELSE 88 | DIF123=.TRUE. 89 | ENDIF 90 | REPEAT(1)=DIF123 91 | REPEAT(2)=REP123 92 | REPEAT(3)=REP12 93 | REPEAT(4)=REP13 94 | REPEAT(5)=REP23 95 | RETURN 96 | END 97 | CDOC END_SUBROUTINE SPDEC3 98 | -------------------------------------------------------------------------------- /src/MATHS/ludcmp.f: -------------------------------------------------------------------------------- 1 | C @(#) Module: Version:1.6 Date:10/02/95 2 | SUBROUTINE LUDCMP 3 | 1( A ,INDX , 4 | 2 D ,N ,NP ,ERROR ) 5 | C$DP,1 6 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 7 | CHARACTER 8 | 1 NAME*6 9 | PARAMETER 10 | 1( NMAX=50 ) 11 | LOGICAL 12 | 1 ERROR 13 | DIMENSION 14 | 1 A(NP,NP) ,INDX(N) ,VV(NMAX) 15 | C$DP,3 16 | DATA 17 | 1 R0 ,R1 ,TINY / 18 | 2 0.0D0 ,1.0D0 ,1.0D-19 / 19 | C$SP,3 20 | C DATA 21 | C 1 R0 ,R1 ,TINY / 22 | C 2 0.0 ,1.0 ,1.0E-19 / 23 | DATA NAME/'LUDCMP'/ 24 | C*********************************************************************** 25 | C Routine to do LU decomposition 26 | C See NUMERICAL RECIPES p35. 27 | C*ACRONYM 28 | C LU_DeCOmPosition 29 | C*DESCRIPTION 30 | C*HISTORY 31 | C Name Date Comment 32 | C G.C.Huang Oct,92 initial coding 33 | C*EXTERNAL 34 | C Arrays 35 | C=A - LU decomposed matrix 36 | C=INDX - Permutation vector 37 | C Variables 38 | C=D - Row interchange indicator 39 | C N - Size of the problem 40 | C NP - Physical size of A matrix 41 | C ERROR - Error flag 42 | C (c) Copyright 1992, Rockfield Software Limited, Swansea, UK 43 | C*********************************************************************** 44 | ccccccccccccccD CALL SENTRY(NAME,MODEDB) 45 | ERROR=.FALSE. 46 | D=R1 47 | DO 12 I=1,N 48 | AAMAX=R0 49 | DO 11 J=1,N 50 | IF (ABS(A(I,J)).GT.AAMAX) AAMAX=ABS(A(I,J)) 51 | 11 CONTINUE 52 | IF(AAMAX.EQ.R0)THEN 53 | C Error. Singular matrix encountered. 54 | cccccccccccccc CALL WRTER('A0176E',NAME,0 ) 55 | C Flag the error 56 | ERROR=.TRUE. 57 | GOTO 999 58 | ENDIF 59 | VV(I)=R1/AAMAX 60 | 12 CONTINUE 61 | DO 19 J=1,N 62 | IF (J.GT.1) THEN 63 | DO 14 I=1,J-1 64 | SUM=A(I,J) 65 | IF (I.GT.1)THEN 66 | DO 13 K=1,I-1 67 | IF(ABS(A(I,K)).LT.TINY.AND.ABS(A(K,J)).LT.TINY)GOTO 13 68 | C If A(I,K) and A(K,J) are very small, skip the following line. Otherwise 69 | C we have problem here. (G.C.) 70 | SUM=SUM-A(I,K)*A(K,J) 71 | 13 CONTINUE 72 | A(I,J)=SUM 73 | ENDIF 74 | 14 CONTINUE 75 | ENDIF 76 | AAMAX=R0 77 | DO 16 I=J,N 78 | SUM=A(I,J) 79 | IF (J.GT.1)THEN 80 | DO 15 K=1,J-1 81 | IF(ABS(A(I,K)).LT.TINY.AND.ABS(A(K,J)).LT.TINY)GOTO 15 82 | C If A(I,K) and A(K,J) are very small, skip the following line. Otherwise 83 | C we have problem here. (G.C.) 84 | SUM=SUM-A(I,K)*A(K,J) 85 | 15 CONTINUE 86 | A(I,J)=SUM 87 | ENDIF 88 | DUM=VV(I)*ABS(SUM) 89 | IF (DUM.GE.AAMAX) THEN 90 | IMAX=I 91 | AAMAX=DUM 92 | ENDIF 93 | 16 CONTINUE 94 | IF (J.NE.IMAX)THEN 95 | DO 17 K=1,N 96 | DUM=A(IMAX,K) 97 | A(IMAX,K)=A(J,K) 98 | A(J,K)=DUM 99 | 17 CONTINUE 100 | D=-D 101 | VV(IMAX)=VV(J) 102 | ENDIF 103 | INDX(J)=IMAX 104 | IF(J.NE.N)THEN 105 | IF(A(J,J).EQ.TINY)A(J,J)=TINY 106 | DUM=R1/A(J,J) 107 | DO 18 I=J+1,N 108 | A(I,J)=A(I,J)*DUM 109 | 18 CONTINUE 110 | ENDIF 111 | 19 CONTINUE 112 | IF(A(N,N).EQ.R0)A(N,N)=TINY 113 | 999 CONTINUE 114 | ccccccccccccccD CALL SEXIT(MODEDB) 115 | RETURN 116 | END 117 | -------------------------------------------------------------------------------- /src/MATHS/gausel.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE GAUSEL 2 | 1( A ,B ,N ,SINGUL ) 3 | IMPLICIT DOUBLE PRECISION(A-H,O-Z) 4 | C Arguments 5 | LOGICAL SINGUL 6 | DIMENSION 7 | 1 A(N,N) ,B(N) 8 | C Local definitions 9 | DATA 10 | 1 SMALL / 11 | 2 1.0D-10/ 12 | C*********************************************************************** 13 | C Routine for solution of simultaneous linear algebraic equations: 14 | C 15 | C A x = b 16 | C 17 | C by the GAUSS ELIMINATION method WITH ROW SWAPPING. 18 | C*********************************************************************** 19 | C Initialise singular matrix flag 20 | SINGUL=.FALSE. 21 | C Get norm of matrix A 22 | ANORM=SQRT(SCAPRD(A,A,N*N)) 23 | C 24 | C============================= 25 | C Start loop over pivot rows | 26 | C============================= 27 | C 28 | DO 40 IPASS=1,N 29 | C 30 | IF(ABS(A(IPASS,IPASS))/ANORM.LT.SMALL)THEN 31 | C Current pivot is zero (too small): Perform row swapping 32 | CALL ROWSWP(A,ANORM,B,IPASS,N,SINGUL) 33 | IF(SINGUL)THEN 34 | C Matrix is singular: exit without solving the system 35 | GOTO 999 36 | ENDIF 37 | ENDIF 38 | C 39 | C STEP 1. Divide the entire pivot row by the pivot element to get a 1 40 | C in the diagonal position of the pivot row 41 | C 42 | PIVOT=A(IPASS,IPASS) 43 | DO 10 ICOL=1,N 44 | A(IPASS,ICOL)=A(IPASS,ICOL)/PIVOT 45 | 10 CONTINUE 46 | C... the same for the right hand side vector 47 | B(IPASS)=B(IPASS)/PIVOT 48 | C 49 | C STEP 2. Replace each row other than the pivot row by that row plus a 50 | C multiple of the pivot row to get a 0 in the pivot column 51 | C 52 | DO 30 IROW=1,N 53 | IF(IROW.NE.IPASS)THEN 54 | FACTOR=A(IROW,IPASS) 55 | DO 20 ICOL=1,N 56 | A(IROW,ICOL)=A(IROW,ICOL)-FACTOR*A(IPASS,ICOL) 57 | 20 CONTINUE 58 | C... the same for the right hand side vector 59 | B(IROW)=B(IROW)-FACTOR*B(IPASS) 60 | ENDIF 61 | 30 CONTINUE 62 | C 63 | 40 CONTINUE 64 | C 65 | C============================== 66 | C End of loop over pivot rows | 67 | C============================== 68 | C 69 | C Now, "A" is the IDENTITY matrix and "B" is the solution 70 | C vector. Print solution vector. 71 | C 72 | 999 CONTINUE 73 | RETURN 74 | END 75 | 76 | 77 | 78 | 79 | SUBROUTINE ROWSWP 80 | 1( A ,ANORM ,B ,I ,N , 81 | 2 SINGUL ) 82 | IMPLICIT DOUBLE PRECISION(A-H,O-Z) 83 | C Arguments 84 | LOGICAL SINGUL 85 | DIMENSION 86 | 1 A(N,N) ,B(N) 87 | C Local definitions 88 | DATA 89 | 1 SMALL / 90 | 2 1.0d-10/ 91 | C*********************************************************************** 92 | C If row "i" has a zero (sufficiently small) entry on the diagonal 93 | C (column "i") then swap that row with the next row below row "i" with 94 | C a non-zero (sufficiently large) entry in column "i" 95 | C*********************************************************************** 96 | DO 20 J=I,N 97 | IF(ABS(A(J,I))/ANORM.GE.SMALL)THEN 98 | C Non-zero (sufficiently large) element found: Swap rows "i" and "j" 99 | DO 10 K=1,N 100 | ATMP=A(I,K) 101 | A(I,K)=A(J,K) 102 | A(J,K)=ATMP 103 | 10 CONTINUE 104 | BTMP=B(I) 105 | B(I)=B(J) 106 | B(J)=BTMP 107 | C Row swapping complete: break loop and exit successfully 108 | SINGUL=.FALSE. 109 | GOTO 30 110 | ENDIF 111 | 20 CONTINUE 112 | C Row swapping failed (no non-zero element found): matrix is singular 113 | SINGUL=.TRUE. 114 | C 115 | 30 CONTINUE 116 | RETURN 117 | END 118 | -------------------------------------------------------------------------------- /src/MATHS/solqua.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE SOLQUA 2 | CDOC Solves a quadratic equation: a x**2 + b x + c = 0 3 | CDOC 4 | CDOC Given the coeficients a, b and c, this routine computes the real 5 | CDOC roots of the associated quadratic equation, a x**2 + b x + c = 0. 6 | CDOC The return values of the arguments ROOT1 and ROOT2 (the roots) are 7 | CDOC set only if real roots exist. 8 | CDOC If the equation admits only one real solution, the return value 9 | CDOC of the logical argument ONEROO is set to .TRUE. (set to .FALSE. 10 | CDOC otherwise). 11 | CDOC If the equation admits two real roots, the return value 12 | CDOC of the logical argument TWOROO is set to .TRUE. (set to .FALSE. 13 | CDOC otherwise). 14 | CDOC Consequently, if the roots are complex or no roots/infinite 15 | CDOC number of roots exist (the equation is ill-defined), the return 16 | CDOC value of the logical arguments ONEROO and TWOROO is set to .FALSE. 17 | CDOC 18 | CDOC BEGIN_PARAMETERS 19 | CDOC DOUBLE_PRECISION A > Coefficient of the quadratic term. 20 | CDOC DOUBLE_PRECISION B > Coefficient of the linear term. 21 | CDOC DOUBLE_PRECISION C > Coefficient of the constant term. 22 | CDOC LOGICAL ONEROO < Logical flag. Set to .TRUE. if 23 | CDOC C there is only one (real) root. 24 | CDOC C Set to .FALSE. otherwise. 25 | CDOC LOGICAL TWOROO < Logical flag. Set to .TRUE. if 26 | CDOC C there are two distinct (real) root. 27 | CDOC C Set to .FALSE. otherwise. 28 | CDOC DOUBLE_PRECISION ROOT1 < One of the roots (the only root if there 29 | CDOC C is only one real root - not set if there 30 | CDOC C are no real roots). 31 | CDOC DOUBLE_PRECISION ROOT2 < The other root (not set if there is only 32 | CDOC C one real root or no real roots). 33 | CDOC END_PARAMETERS 34 | CHST 35 | CHST E.de Souza Neto, June 1998: Initial coding 36 | CHST 37 | SUBROUTINE SOLQUA 38 | 1( A ,B ,C ,ONEROO ,TWOROO , 39 | 2 ROOT1 ,ROOT2 ) 40 | C 41 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 42 | LOGICAL ONEROO ,TWOROO 43 | DATA 44 | 1 R0 ,R1 ,R2 ,R4 ,SMALL / 45 | 2 0.D0 ,1.0D0,2.0D0,4.0D0,1.D-12/ 46 | C*********************************************************************** 47 | C FINDS THE REAL ROOTS OF A QUADRATIC EQUATION: A X**2 + B X + C = 0. 48 | C 49 | C REFERENCE: 50 | C W.H.Press, S.A.Teukolsky, W.T.Vetterling and B.P.Flannery. Numerical 51 | C recipes in FORTRAN. The art of scientific computing. 2nd Ed., 52 | C Cambridge Univ. Press, 1992. (Section 5.6) 53 | C*********************************************************************** 54 | C Initialises logical flags 55 | ONEROO=.FALSE. 56 | TWOROO=.FALSE. 57 | IF(A.NE.R0)THEN 58 | C The equation is non-linear in fact 59 | C ---------------------------------- 60 | IF(B.NE.R0)THEN 61 | SIGNB=B/ABS(B) 62 | ELSE 63 | SIGNB=R1 64 | ENDIF 65 | B2=B*B 66 | R4AC=R4*A*C 67 | SQUAR=B2-R4AC 68 | IF(SQUAR.GT.R0)THEN 69 | C there are two distinct real roots: uses formula which minimises 70 | C round-off errors when the coefficients A and/or C are small 71 | TWOROO=.TRUE. 72 | SQUAR=SQRT(SQUAR) 73 | Q=-(B+SIGNB*SQUAR)/R2 74 | ROOT1=Q/A 75 | ROOT2=C/Q 76 | ELSEIF(SQUAR.EQ.R0.OR. 77 | 1 (SQUAR/DMAX1(B2,ABS(R4AC))+SMALL).GE.R0)THEN 78 | C there is only one root 79 | ONEROO=.TRUE. 80 | ROOT1=-B/(R2*A) 81 | ENDIF 82 | ELSE 83 | C The equation is linear 84 | C ---------------------- 85 | IF(B.NE.R0)THEN 86 | C and well defined -> (only) one root exists 87 | ONEROO=.TRUE. 88 | ROOT1=-C/B 89 | ENDIF 90 | ENDIF 91 | RETURN 92 | END 93 | CDOC END_SUBROUTINE SOLQUA 94 | -------------------------------------------------------------------------------- /src/TRESCA/cttrpn.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE CTTRPN 2 | CDOC Consistent tangent matrix for the Tresca model in plane stress. 3 | CDOC 4 | CDOC The tangent matrix computed in this routine is consistent with the 5 | CDOC nested iteration algorithm for the Tresca model in plane stress 6 | CDOC coded in subroutine SUTRPN. 7 | CDOC It returns either the elastic tangent or the elasto-plastic 8 | CDOC consistent tangent matrix depending on the input value of 9 | CDOC the logical argument EPFLAG. 10 | CDOC 11 | CDOC BEGIN_PARAMETERS 12 | CDOC DOUBLE_PRECISION DMATX < Consistent tangent matrix. 13 | CDOC LOGICAL EPFLAG > Elasto-plastic flag. 14 | CDOC C If .FALSE., DMATX returns as the elastic 15 | CDOC C as the elastic matrix. If .TRUE., DMATX 16 | CDOC C returns as the elasto-plastic tangent 17 | CDOC C consistent with the return mapping 18 | CDOC C algorithm implemented in routine SUTR. 19 | CDOC INTEGER IPROPS > Array of integer material properties. 20 | CDOC C This array is set in routines INDATA 21 | CDOC C and RDTR. 22 | CDOC C The number of points on the piece-wise 23 | CDOC C linear hardening curve is the only 24 | CDOC C element of this array used here. 25 | CDOC LOGICAL LALGVA > Array of logical algorithmic flags. 26 | CDOC C See list of arguments of SUTR. 27 | CDOC DOUBLE_PRECISION RPROPS > Array of real material properties. 28 | CDOC C Same as in the argument list of 29 | CDOC C subroutine SUTR. 30 | CDOC DOUBLE_PRECISION RSTAVA > Array of real state variables other 31 | CDOC C than the stress tensor components. 32 | CDOC C Output of SUTR. 33 | CDOC DOUBLE_PRECISION STRAT > Array of elastic trial (engineering) 34 | CDOC C strain components. Same as in the input 35 | CDOC C SUTR. 36 | CDOC DOUBLE_PRECISION STRES > Array of current stress tensor 37 | CDOC C components. 38 | CDOC END_PARAMETERS 39 | CHST 40 | CHST E.de Souza Neto, Sept 1998: Initial coding 41 | CHST 42 | SUBROUTINE CTTRPN 43 | 1( DMATX ,EPFLAG ,IPROPS ,LALGVA ,RPROPS , 44 | 2 RSTAVA ,STRAT ,STRES ) 45 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 46 | PARAMETER( MSTRE=4 ) 47 | C Arguments 48 | LOGICAL EPFLAG, LALGVA(4) 49 | DIMENSION 50 | 1 DMATX(MSTRE,MSTRE) ,IPROPS(*) ,RPROPS(*) , 51 | 2 RSTAVA(MSTRE+1) ,STRAT(*) ,STRES(*) 52 | C Local arrays and variables 53 | DIMENSION 54 | 1 D12(3) ,D21(3) 55 | C*********************************************************************** 56 | C COMPUTATION OF CONSISTENT TANGENT MODULUS FOR TRESCA TYPE 57 | C ELASTO-PLASTIC MATERIAL WITH PIECE-WISE LINEAR ISOTROPIC HARDENING. 58 | C PLANE STRAIN AND AXISYMMETRIC IMPLEMENTATIONS. 59 | C 60 | C REFERENCE: Section 9.2 61 | C*********************************************************************** 62 | STRAT(4)=RSTAVA(4) 63 | C Compute the axisymmetric tangent matrix 64 | NTYPAX=3 65 | CALL CTTR 66 | 1( DMATX ,EPFLAG ,IPROPS ,LALGVA ,NTYPAX , 67 | 2 RPROPS ,RSTAVA ,STRAT ,STRES ) 68 | C Decompose into submatrices 69 | D12(1)=DMATX(1,4) 70 | D12(2)=DMATX(2,4) 71 | D12(3)=DMATX(3,4) 72 | D21(1)=DMATX(4,1) 73 | D21(2)=DMATX(4,2) 74 | D21(3)=DMATX(4,3) 75 | D22=DMATX(4,4) 76 | C Assemble plane stress consistent tangent matrix 77 | DO 20 I=1,3 78 | DO 10 J=1,3 79 | DMATX(I,J)=DMATX(I,J)-D12(I)*D21(J)/D22 80 | 10 CONTINUE 81 | 20 CONTINUE 82 | RETURN 83 | END 84 | CDOC END_SUBROUTINE CTTRPN 85 | -------------------------------------------------------------------------------- /src/CRYSTAL_ELASTO_MARTEN/dtadfe.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE DTADFE 2 | CDOC Derivative of Kirchoff stress with respect to the elastic 3 | CDOC deformation gradient. 4 | CDOC Current implementation based on a regularised neo-Hookean 5 | CDOC hyperelastic material model. 6 | CDOC 7 | CDOC BEGIN_PARAMETERS 8 | CDOC DOUBLE_PRECISION FE > Elastic deformation gradient. 9 | CDOC DOUBLE_PRECISION RPROPS > Array of real material properties. 10 | CDOC C It is set in routine RDPDSC. 11 | CDOC DOUBLE_PRECISION DTDFE < Derivative of the Kirchoff stress with 12 | CDOC C respect to the elastic deformation 13 | CDOC C gradient for the regularised neo-Hookean 14 | CDOC C model. 15 | CDOC END_PARAMETERS 16 | CHST 17 | CHST M. Fauzan Adziman, June 2013: Initial coding 18 | CHST 19 | SUBROUTINE DTADFE( FE, RPROPS, DTDFE ) 20 | IMPLICIT NONE 21 | INTEGER, PARAMETER :: MDIM=3 22 | C Arguments 23 | DOUBLE PRECISION, INTENT(IN) , DIMENSION(MDIM,MDIM) :: FE 24 | DOUBLE PRECISION, INTENT(IN) , DIMENSION(*) :: RPROPS 25 | DOUBLE PRECISION, INTENT(OUT), DIMENSION(MDIM,MDIM,MDIM,MDIM) 26 | 1 :: DTDFE 27 | C Local variables 28 | DOUBLE PRECISION :: GMODU, BULK ! Neo-Hookean shear and bulk moduli 29 | DOUBLE PRECISION, DIMENSION(MDIM,MDIM) :: FEINV, FEISO ! Inverse and isochoric part of elastic deformation gradient 30 | DOUBLE PRECISION, DIMENSION(MDIM,MDIM,MDIM,MDIM) :: FTENS, HTENS ! Tensors used in intermediate calculations 31 | C 32 | INTEGER :: I, J, K, L ! Loop indices 33 | DOUBLE PRECISION :: VOLFAC, DETFE 34 | C Local parameters 35 | DOUBLE PRECISION, PARAMETER :: R0=0.0D0 , R1=1.0D0 , 36 | 1 R1D3=R1/3.0D0, R2D3=2.0D0/3.0D0 37 | DOUBLE PRECISION, PARAMETER, DIMENSION(MDIM,MDIM) :: ! delta_ij 38 | 1 DELTA=reshape((/R1,R0,R0,R0,R1,R0,R0,R0,R1/), (/3,3/) ) 39 | C 40 | C*********************************************************************** 41 | C PARTIAL DERIVATIVE OF KIRCHOFF STRESS WITH RESPECT TO THE ELASTIC 42 | C DEFORMATION GRADIENT FOR A REGULARISED NEO-HOOKEAN HYPERELASTIC 43 | C MODEL 44 | C*********************************************************************** 45 | C 46 | C Neo-Hookean properties 47 | GMODU=RPROPS(2) 48 | BULK=RPROPS(3) 49 | C Inverse of elastic deformation gradient 50 | CALL INVMT3(FE, FEINV, DETFE) 51 | C Isochoric part of elastic deformation gradient 52 | VOLFAC=DETFE**(-R1D3) 53 | FEISO=VOLFAC*FE 54 | C Assemble derivative of the Kirchoff stress with respect to the elastic 55 | C deformation gradient in full 4th order tensor form 56 | C ---------------------------------------------------------------------- 57 | C Evaluate tensor F 58 | DO I=1,MDIM 59 | DO J=1,MDIM 60 | DO K=1,MDIM 61 | DO L=1,MDIM 62 | FTENS(I,J,K,L)=GMODU*(DELTA(I,K)*FEISO(J,L) 63 | 1 +FEISO(I,L)*DELTA(J,K) 64 | 2 -R2D3*DELTA(I,J)*FEISO(K,L)) 65 | ENDDO 66 | ENDDO 67 | ENDDO 68 | ENDDO 69 | C Evaluate tensor H 70 | DO I=1,MDIM 71 | DO J=1,MDIM 72 | DO K=1,MDIM 73 | DO L=1,MDIM 74 | HTENS(I,J,K,L)=VOLFAC*(DELTA(I,K)*DELTA(J,L) 75 | 1 -R1D3*FE(I,J)*FEINV(L,K)) 76 | ENDDO 77 | ENDDO 78 | ENDDO 79 | ENDDO 80 | C DTDFE = (double contraction of tensors F and H) + tensor P 81 | DO I=1,MDIM 82 | DO J=1,MDIM 83 | DO K=1,MDIM 84 | DO L=1,MDIM 85 | DTDFE(I,J,K,L)=SUM(FTENS(I,J,:,:)*HTENS(:,:,K,L)) 86 | 1 +BULK*DELTA(I,J)*FEINV(L,K) 87 | ENDDO 88 | ENDDO 89 | ENDDO 90 | ENDDO 91 | C 92 | RETURN 93 | END 94 | CDOC END_SUBROUTINE DTADFE 95 | -------------------------------------------------------------------------------- /src/ELEMENTS/exh8.f: -------------------------------------------------------------------------------- 1 | CDOC BEGIN_SUBROUTINE EXH8 2 | CDOC Sets Gauss point-node extrapolation matrix for element type HEXA_8 3 | CDOC 4 | CDOC This routine sets the coefficients matrix for extrapolation of 5 | CDOC fields from Gauss point values to nodal values for element type 6 | CDOC HEXA_8: Standard isoparametric 8-noded tri-linear hexahedron. 7 | CDOC 8 | CDOC BEGIN_PARAMETERS 9 | CDOC INTEGER NGAUSP > Number of Gauss points. 10 | CDOC DOUBLE_PRECISION EXMATX < Extrapolation matrix. 11 | CDOC END_PARAMETERS 12 | CHST 13 | CHST D. de Bortoli, March 2015: Initial coding, based on EXQ4 14 | CHST 15 | SUBROUTINE EXH8 16 | 1( NGAUSP ,EXMATX ) 17 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) 18 | PARAMETER(NNODE=8) 19 | DIMENSION EXMATX(NNODE,NGAUSP) 20 | DATA R1 / 21 | 1 1.0D0 / 22 | DATA 23 | 1 A8 ,B8 ,C8 , 24 | 2 D8 / 25 | 3 2.54903810567666D0 ,-0.683012701892219D0 ,0.183012701892219D0, 26 | 4 -0.0490381056766580D0/ 27 | C*********************************************************************** 28 | C SETS COEFFICIENTS MATRIX (EXMATX) FOR EXTRAPOLATION FROM GAUSS POINTS 29 | C TO NODES FOR ELEMENT TYPE 'HEXA_8' (STANDARD 8-NODED TRI-LINEAR 30 | C HEXAHEDRON) 31 | C 32 | C REFERENCE: Section 5.6.1 33 | C E Hinton & JS Campbel. Local and global Smoothing of 34 | C discontinuous finite element functions using a least 35 | C squares method. Int. J. Num. meth. Engng., 8:461-480, 1974. 36 | C E Hinton & DRJ Owen. An introduction to finite element 37 | C computations. Pineridge Press, Swansea, 1979. 38 | C*********************************************************************** 39 | IF(NGAUSP.EQ.1)THEN 40 | EXMATX(1,1)=R1 41 | EXMATX(2,1)=R1 42 | EXMATX(3,1)=R1 43 | EXMATX(4,1)=R1 44 | EXMATX(5,1)=R1 45 | EXMATX(6,1)=R1 46 | EXMATX(7,1)=R1 47 | EXMATX(8,1)=R1 48 | ELSEIF(NGAUSP.EQ.8)THEN 49 | EXMATX(1,1)=A8 50 | EXMATX(1,2)=B8 51 | EXMATX(1,3)=B8 52 | EXMATX(1,4)=C8 53 | EXMATX(1,5)=B8 54 | EXMATX(1,6)=C8 55 | EXMATX(1,7)=C8 56 | EXMATX(1,8)=D8 57 | C 58 | EXMATX(2,1)=B8 59 | EXMATX(2,2)=C8 60 | EXMATX(2,3)=C8 61 | EXMATX(2,4)=D8 62 | EXMATX(2,5)=A8 63 | EXMATX(2,6)=B8 64 | EXMATX(2,7)=B8 65 | EXMATX(2,8)=C8 66 | C 67 | EXMATX(3,1)=C8 68 | EXMATX(3,2)=D8 69 | EXMATX(3,3)=B8 70 | EXMATX(3,4)=C8 71 | EXMATX(3,5)=B8 72 | EXMATX(3,6)=C8 73 | EXMATX(3,7)=A8 74 | EXMATX(3,8)=B8 75 | C 76 | EXMATX(4,1)=B8 77 | EXMATX(4,2)=C8 78 | EXMATX(4,3)=A8 79 | EXMATX(4,4)=B8 80 | EXMATX(4,5)=C8 81 | EXMATX(4,6)=D8 82 | EXMATX(4,7)=B8 83 | EXMATX(4,8)=C8 84 | C 85 | EXMATX(5,1)=B8 86 | EXMATX(5,2)=A8 87 | EXMATX(5,3)=C8 88 | EXMATX(5,4)=B8 89 | EXMATX(5,5)=C8 90 | EXMATX(5,6)=B8 91 | EXMATX(5,7)=D8 92 | EXMATX(5,8)=C8 93 | C 94 | EXMATX(6,1)=C8 95 | EXMATX(6,2)=B8 96 | EXMATX(6,3)=D8 97 | EXMATX(6,4)=C8 98 | EXMATX(6,5)=B8 99 | EXMATX(6,6)=A8 100 | EXMATX(6,7)=C8 101 | EXMATX(6,8)=B8 102 | C 103 | EXMATX(7,1)=D8 104 | EXMATX(7,2)=C8 105 | EXMATX(7,3)=C8 106 | EXMATX(7,4)=B8 107 | EXMATX(7,5)=C8 108 | EXMATX(7,6)=B8 109 | EXMATX(7,7)=B8 110 | EXMATX(7,8)=A8 111 | C 112 | EXMATX(8,1)=C8 113 | EXMATX(8,2)=B8 114 | EXMATX(8,3)=B8 115 | EXMATX(8,4)=A8 116 | EXMATX(8,5)=D8 117 | EXMATX(8,6)=C8 118 | EXMATX(8,7)=C8 119 | EXMATX(8,8)=B8 120 | ENDIF 121 | C 122 | RETURN 123 | END 124 | CDOC END_SUBROUTINE EXH8 125 | --------------------------------------------------------------------------------