master.for

有限元计算程序

C$DEBUG
C$LARGE
	PROGRAM MASTER PLAST                             !(Page 260)
C****************************************************************
C       PROGRAM FOR THE ELASTO-PLASTIC ANALYSIS OF PLANE STRESS,
C       PLANE STRAIN END AXISYMMETRIC SOLIDS
C****************************************************************
	DIMENSION ASDIS(300),COORD(150,2),ELOAD(40,18),ESTIF(18,18),
     .          EQRHS(10),EQUAT(80,10),FIXED(300),GLOAD(80),GSTIF(3240),
     .          IFFIX(300),LNODS(40,9),LOCEL(18),MATNO(40),
     .          NACVA(80),NAMEV(10),NDEST(18),NDFRO(40),NOFIX(30),
     .          NOUTP(2),NPIVO(10),
     .          POSGP(4),PRESC(30,2),PROPS(5,7),RLOAD(40,18),
     .          STFOR(300),TREAC(30,2),VECRV(80),WEIGP(4),
     .          STRSG(4,360),TDISP(300),TLOAD(40,18),
     .          TOFOR(300),EPSTN(360),EFFST(360)
C***
      open(5,file='data\input.dat',status='unknown')
      open(6,file='data\output.dat',status='unknown')
C***
C
C*** PRESET VARIABLES ASSOCIATED WITH DYNAMIC DIMENSIONING
C
	CALL DIMEN(MBUFA,MELEM,MEVAB,MFRON,MMATS,MPOIN,MSTIF,MTOTG,
     .           MTOTV,MVFIX,NDOFN,NPROP,NSTRE)
C
C*** CALL THE SUBRIUTINE WHICH READS MOST OF PROBLEM DATA
C
	CALL INPUT(COORD,IFFIX,LNODS,MATNO,MELEM,MEVAB,MFRON,MMATS,
     .           MPOIN,MTOTV,MVFIX,NALGO,
     .           NCRIT,NDFRO,NDOFN,NELEM,NEVAB,NGAUS,NGAU2,
     .           NINCS,NMATS,NNODE,NOFIX,NPOIN,NPROP,NSTRE,
     .           NSTR1,NTOTG,NTOTV,
     .           NTYPE,NVFIX,POSGP,PRESC,PROPS,WEIGP)
C
C*** CALL THE SUBROUTINE WHICH COMPUTES THE CONSISTENT LOAD VECTORS
C    FOR EACH ELEMENT AFTER READING THE RELEVENT INPUT DATA
C
	CALL LOADPS(COORD,LNODS,MATNO,MELEM,MMATS,MPOIN,NELEM,
     .            NEVAB,NGAUS,NNODE,NPOIN,NSTRE,NTYPE,POSGP,
     .            PROPS,RLOAD,WEIGP,NDOFN)
C
C*** INITIALISE CERTAIN ARRAYS
C
	CALL ZERO(ELOAD,MELEM,MEVAB,MPOIN,MTOTG,MTOTV,NDOFN,NELEM,
     .          NEVAB,NGAUS,NSTR1,NTOTG,EPSTN,EFFST,
     .          NTOTV,NVFIX,STRSG,TDISP,TFACT,
     .          TLOAD,TREAC,MVFIX)
C
C*** LOOP OVER EACH INCREMENT
C
	DO 100 IINCS=1,NINCS
C
C*** READ DATA FOR CURRENT INCREMENT
C
	CALL INCREM(ELOAD,FIXED,IINCS,MELEM,MEVAB,MITER,MTOTV,
     .            MVFIX,NDOFN,NELEM,NEVAB,NOUTP,NOFIX,NTOTV,
     .            NVFIX,PRESC,RLOAD,TFACT,TLOAD,TOLER)
C
C*** LOOP OVER EACH ITERATION
C
	DO 50 IITER =1,MITER
C
C*** CALL ROUTINE WHICH SELECTS SOLUTION ALORITHM VARIABLE KRESL
C
	CALL ALGOR(FIXED,IINCS,IITER,KRESL,MTOTV,NALGO,
     .           NTOTV)
C
C*** CHECK WHETHER A NEW EVALUATION OF THE STIFFNESS MATRIX IS REQUIRED
C
	IF(KRESL.EQ.1) CALL STIFFP(COORD,EPSTN,IINCS,LNODS,MATNO,
     .            MEVAB,MMATS,MPOIN,MTOTV,NELEM,NEVAB,NGAUS,NNODE,
     .            NSTRE,NSTR1,POSGP,PROPS,WEIGP,MELEM,MTOTG,
     .            STRSG,NTYPE,NCRIT)
C
C*** SOLVE EQUATIONS
C
	CALL FRONT(ASDIS,ELOAD,EQRHS,EQUAT,ESTIF,FIXED,IFFIX,IINCS,IITER,
     .           GLOAD,GSTIF,LOCEL,LNODS,KRESL,MBUFA,MELEM,MEVAB,MFRON,
     .           MSTIF,MTOTV,MVFIX,NACVA,NAMEV,NDEST,NDOFN,NELEM,NEVAB,
     .           NNODE,NOFIX,NPIVO,NPOIN,NTOTV,TDISP,TLOAD,TREAC,VECRV)
C
C*** CALCULATE RESIDUAL FORCES
C
	CALL RESIDU(ASDIS,COORD,EFFST,ELOAD,FACTO,IITER,LNODS,
     .            LPROP,MATNO,MELEM,MMATS,MPOIN,MTOTG,MTOTV,NDOFN,
     .            NELEM,NEVAB,NGAUS,NNODE,NSTR1,NTYPE,POSGP,PROPS,
     .            NSTRE,NCRIT,STRSG,WEIGP,TDISP,EPSTN)
C
C*** CHECK FOR CONVERGENCE
C
	CALL CONVER(ELOAD,IITER,LNODS,MELEM,MEVAB,MTOTV,NCHEK,NDOFN,
     .            NELEM,NEVAB,NNODE,NTOTV,PVALU,STFOR,TLOAD,
     .            TOFOR,TOLER)
C
C*** OUTPUT RESULTS IF REQUIRED
C
	IF(IITER.EQ.1.AND.NOUTP(1).GT.0)
     .CALL OUTPUT(IITER,MTOTG,MTOTV,MVFIX,NELEM,NGAUS,NOFIX,NOUTP,
     .            NPOIN,NVFIX,STRSG,TDISP,TREAC,EPSTN,NTYPE,NCHEK)
C
C*** IF SOLUTION HAS CONVERGED STOP ITERATING AND OUTPUT RESULTS
C
	IF(NCHEK.EQ.0) GO TO 75
  50  CONTINUE
C
C*** 
C
	IF(NALGO.EQ.2) GO TO 75
	STOP
  75  CALL OUTPUT(IITER,MTOTG,MTOTV,MVFIX,NELEM,NGAUS,NOFIX,NOUTP,
     .            NPOIN,NVFIX,STRSG,TDISP,TREAC,EPSTN,NTYPE,NCHEK)
 100  CONTINUE
C***
	close(5)
     	close(6)
C***
	STOP
	END