master.for

本程序是D.R.J.OWEN主编的FINITE ELEMENTS IN PLASTICITYG一书中第八章例题的有限元程序

C$DEBUG
C$LARGE
	PROGRAM MASTER VISCO                           !(Page 300)
C****************************************************************
C       PROGRAM FOR THE ELASTO-VISCOPLASTIC ANALYSIS OF PLANE STRESS,
C       PLANE STRAIN END AXISYMMETRIC SOLIDS
C****************************************************************
      PARAMETER (MPOIN0=60, MELEM0=20, NDOFN0=2, MEVAB0=NDOFN0*9, 
     .           MTOTV0=MPOIN0*NDOFN0, MBUFA0=10, MFRON0=40, 
     .           MSTIF0=(MFRON0*MFRON0-MFRON0)/2.0+MFRON0, MVFIX0=25,
     .           MMATS0=5, NPROP0=10, MTOTG0=MELEM0*9)

	DIMENSION ASDIS(MTOTV0),COORD(MPOIN0,2),ELOAD(MELEM0,MEVAB0),
     .          ESTIF(MEVAB0,MEVAB0),
     .          EQRHS(MBUFA0),EQUAT(MFRON0,MBUFA0),FIXED(MTOTV0),
     .          GLOAD(MFRON0),GSTIF(MSTIF0),
     .          IFFIX(MTOTV0),LNODS(MELEM0,9),LOCEL(MEVAB0),
     .          MATNO(MELEM0),
     .          NACVA(MFRON0),NAMEV(MBUFA0),NDEST(MEVAB0),NDFRO(MELEM0),
     .          NOFIX(MVFIX0),
     .          NOUTP(2),NPIVO(MBUFA0),
     .          POSGP(4),PRESC(MVFIX0,2),PROPS(MMATS0,NPROP0),
     .          RLOAD(MELEM0,MEVAB0),
     .          STFOR(MTOTV0),TREAC(MVFIX0,NDOFN0),VECRV(MFRON0),
     .          WEIGP(4),
     .          STRSG(4,MTOTG0),TDISP(MTOTV0),
     .          TLOAD(MELEM0,MEVAB0),VIVEL(5,MTOTG0),VISTN(4,MTOTG0)
C	DIMENSION ASDIS(120),COORD(60,2),ELOAD(20,18),ESTIF(18,18),
C     .          EQRHS(10),EQUAT(40,10),FIXED(120),
C     .          GLOAD(40),GSTIF(986),
C     .          IFFIX(120),LNODS(20,9),LOCEL(18),MATNO(20),
C     .          NACVA(40),NAMEV(10),NDEST(18),NDFRO(20),NOFIX(25),
C     .          NOUTP(2),NPIVO(10),
C     .          POSGP(4),PRESC(25,2),PROPS(5,10),RLOAD(20,18),
C     .          STFOR(120),TREAC(25,2),VECRV(40),WEIGP(4),
C     .          STRSG(4,180),TDISP(120),
C     .          TLOAD(20,18),VIVEL(5,180),VISTN(4,180)
C***
      open( 5,file='data\input.dat',status='unknown')
      open( 6,file='data\output.dat',status='unknown')
      open(11,file='data\temp.dat',status='unknown')
C
C*** PRESET VARIABLES ASSOCIATED WITH DYNAMIC DIMENSIONING
C
	CALL DIMEN(MBUFA,MELEM,MEVAB,MFRON,MMATS,MPOIN,MSTIF,MTOTG,
     .           MTOTV,MVFIX,NDOFN,NPROP,NSTRE) !(Page 238)
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) !(Page 208)
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) !(Page 183)
C
C*** INITIALISE CERTAIN ARRAYS
C
	CALL ZERO(ELOAD,MELEM,MEVAB,MPOIN,MTOTG,MTOTV,NDOFN,NELEM,
     .          NEVAB,NGAUS,NSTR1,NTOTG,NTOTV,NVFIX,STRSG,TDISP,
     .          VIVEL,VISTN,TTIME,TLOAD,TREAC,MVFIX) !(Page 297)
	READ(5,*) TIMEX,TAUFT,DTINT,FTIME
	WRITE(6,910) TIMEX,TAUFT,DTINT,FTIME
  900 FORMAT(4F10.3)
  910 FORMAT(1H0,5X,25HTIME STEPPING PARAMETER =,F10.3,5X,
     . 28HTIME STEP STABILITY FACTOR =,F10.5,//
     . 5X,26HINITIAL TIME STEP LENGTH =,F10.5,5X,32HTIME STEP INCREMENT
     .PARAMETER = ,F10.5)
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) !(Page 212)
C
C*** LOOP OVER EACH ITERATION
C
      DTIME=0.0
	DO 50 ISTEP =1,MITER
	TTIME=TTIME+DTIME
C
C*** CALL ROUTINE WHICH SELECTS SOLUTION ALORITHM VARIABLE KRESL
C
	CALL ALGOR(FIXED,IINCS,IITER,KRESL,MTOTV,NALGO,NTOTV) !(Page 210)
C
C*** CHECK WHETHER A NEW EVALUATION OF THE STIFFNESS MATRIX IS REQUIRED
C
	IF(KRESL.EQ.1) CALL STIFVP(COORD,IINCS,LNODS,MATNO,
     .            MEVAB,MMATS,MPOIN,MTOTV,NELEM,NEVAB,NGAUS,NNODE,
     .            NSTRE,NSTR1,POSGP,PROPS,WEIGP,MELEM,MTOTG,
     .            STRSG,NTYPE,NCRIT,TIMEX,DTIME) !(Page  283)
C
C*** SOLVE EQUATIONS
C
	CALL FRONT(ASDIS,ELOAD,EQRHS,EQUAT,ESTIF,FIXED,IFFIX,IINCS,ISTEP,
     .           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)
                                                            !(Page 194)
C
C*** CALCULATE RESIDUAL FORCES
C
	CALL STEPVP(ASDIS,COORD,ELOAD,ISTEP,LNODS,LPROP,TIMEX,
     .            MATNO,MELEM,MMATS,MPOIN,MTOTG,TAUFT,DTIME,
     .            MTOTV,NDOFN,NELEM,NEVAB,NGAUS,NNODE,NSTR1,
     .            NTYPE,POSGP,PROPS,NSTRE,NCRIT,STRSG,WEIGP,
     .            TDISP,VISTN,VIVEL,TLOAD,FTIME,DTINT,IINCS) !(Page 289)
C
C*** CHECK FOR CONVERGENCE TO STEADY STATE
C
	CALL STEADY(NELEM,NGAUS,NCHEK,VIVEL,ISTEP,FIRST,TOLER,PVALU,
     .            MTOTG,DTIME,NSTR1,TTIME) !(Page 298)
C
C*** OUTPUT RESULTS IF REQUIRED
C
	IF(NOUTP(1).EQ.0) GO TO 110
	KOUTD=(ISTEP/NOUTP(1))*NOUTP(1)
	KOUTS=(ISTEP/NOUTP(2))*NOUTP(2)
	IF(KOUTD.NE.ISTEP.OR.KOUTS.NE.ISTEP) GO TO 110
	KOUTP=2
	IF(KOUTS.EQ.ISTEP) KOUTP=3
	CALL OUTPUT(ISTEP,MTOTG,MTOTV,MVFIX,NELEM,NGAUS,NOFIX,NOUTP,
     .            NPOIN,NVFIX,STRSG,TDISP,TREAC,NTYPE,NCHEK,VIVEL,
     .            KOUTP)                                !(Page 258)
  110 CONTINUE
C
C*** IF SOLUTION HAS CONVERGED STOP ITERATING AND OUTPUT RESULTS
C
	IF(NCHEK.EQ.0) GO TO 75
  50  CONTINUE
C
C*** 
C
  75  CALL OUTPUT(ISTEP,MTOTG,MTOTV,MVFIX,NELEM,NGAUS,NOFIX,NOUTP,
     .            NPOIN,NVFIX,STRSG,TDISP,TREAC,NTYPE,NCHEK,VIVEL,
     .            KOUTP)     
 100  CONTINUE
C***
	close(5)
     	close(6)
     	close(11)
C***
	STOP
	
	END