<!-- source-page: 411 -->

```csv
540 IFPRE(IDOFN,IPOIN)=0 NPUT 76
DO 550 IVFIX=1,NVFIX NPUT 77
550 READ (5,908) IPOIN,(IFPRE(IDOFN,IPOIN),IDOFN=1,NDOFN) NPUT 78
DO 560 IPOIN=1,NPOIN NPUT 79
560 WRITE(6,909) IPOIN,(IFPRE(IDOFN,IPOIN),IDOFN=1,NDOFN) NPUT 80
908 FORMAT(1X,I4,3X,2I1) NPUT 81
909 FORMAT(6X,I5,3X,2I1) NPUT 82
C NPUT 83
C*** READ THE AVAILABLE SELECTION OF ELEMENT PROPERTIES. NPUT 84
C NPUT 85
WRITE(6,910) NPUT 86
910 FORMAT(//5X,19HATERIAL PROPERTIES) NPUT 87
DO 520 IMATS=1,NMATS NPUT 88
READ(5,900) NUMAT NPUT 89
READ (5,917) (PROPS(NUMAT,IPROP),IPROP=1,NPROP) NPUT 90
WRITE(6,911) NUMAT NPUT 91
911 FORMAT(/5X,11HATERIAL NO,I5) NPUT 92
520 WRITE(6,912) (PROPS(NUMAT,IPROP),IPROP=1,NPROP) NPUT 93
912 FORMAT(/5X,13HYOUNG MODULUS,G12.4/5X,13HPOISSON RATIO,G12.4/5X,13HTHICKNESS ,G12.4/5X,13HMASS DENSITY ,G12.4/5X,13HALPHA TEMPR ,G12.4/5X,13HREFERENCE FO ,G12.4/5X,13HHARDENING PAR,G12.4/5X,13HFRICT ANGLE ,G12.4/5X,13HFLUIDITY PAR ,G12.4/5X,13HEXP DELTA ,G12.4/5X,13HNFLOW CODE ,G12.4) NPUT 99
917 FORMAT(8E10.4) NPUT 100
C NPUT 101
C*** SET UP GAUSSIAN INTEGRATION CONSTANTS NPUT 102
C NPUT 103
CALL GAUSSQ (NGAUS,POSGP,WEIGP) NPUT 104
RETURN NPUT 105
END NPUT 106 
```

# 10.6.11 Subroutine INTIME

This routine reads and writes all data required for time integration and plotting stress and displacement histories.

```fortran
SUBROUTINE INTIME (AALFA, ACCEH, ACCEV, AFACT, AZERO, BEETA, TIME 1
BZERO, DELTA, DTIME, DTEND, GAAMA, IFIXD, TIME 2
IFUNC, INTGR, KSTEP, MITER, NDOFN, NELEM, TIME 3
NGRQS, NOUTD, NOUTP, NPOIN, NPRQD, NREQD, TIME 4
NREQS, NSTEP, OMEGA, TDISP, TOLER, VELOC, TIME 5
IPRED) TIME 6
C******************************************************************************************TIME 7
C TIME 8
C ** INITIAL VALUES AND TIME INTEGRATION DATA TIME 9
C TIME 10
C******************************************************************************************TIME 11
DIMENSION TDISP(1), ACCEH(1), NPRQD(1), INTGR(1), TIME 12
VELOC(1), ACCEV(1), NGRQS(1) TIME 13
C TIME 14
C*** READ TIME STEPPING AND SELECTIVE OUTPUT PARAMETERS TIME 15
C TIME 16
READ (5,902) NSTEP, NOUTD, NOUTP, NREQD, NREQS, NACCE, IFUNC, TIME 17
IFIXD, MITER, KSTEP, IPRED TIME 18
READ (5,190) DTIME, DTEND, DTREC, AALFA, BEETA, DELTA, GAAMA, TIME 19
AZERO, BZERO, OMEGA, TOLER TIME 20
WRITE(6,950) NSTEP, NOUTD, NOUTP, NREQD, NREQS, NACCE, IFUNC, TIME 21
IFIXD, MITER, KSTEP, IPRED TIME 22
WRITE(6,960) DTIME, DTEND, DTREC, AALFA, BEETA, DELTA, GAAMA, TIME 23
AZERO, BZERO, OMEGA, TOLER TIME 24
950 FORMAT(/5X, 'TIME STEPPING PARAMETERS'/ TIME 25
/5X, 'NSTEP=', I5, 12X, 'NOUTD=', I5, 12X, 'NOUTP=', I5,/
/5X, 'NREQD=', I5, 12X, 'NREQS=', I5, 12X, 'NACCE=', I5,/
/5X, 'IFUNC=', I5, 12X, 'IFIXD=', I5, 12X, 'MITER=', I5,/
/5X, 'KSTEP=', I5, 12X, 'IPRED=', I5) TIME 29 
```

<!-- source-page: 412 -->

```csv
960 FORMAT(/5X,'DTIME=',G12.4,5X,'DTEND=',G12.4,5X,'DTREC=',G12.4,/
    /5X,'AALFA=',G12.4,5X,'BEETA=',G12.4,5X,'DELTA=',G12.4,/
    /5X,'GAAMA=',G12.4,5X,'AZERO=',G12.4,5X,'BZERO=',G12.4,/
    /5X,'OMEGA=',G12.4,5X,'TOLER=',G12.4)
C
C*** SELECTED NODES AND GAUSS POINTS FOR OUTPUT
C
READ(5,902) (NPRQD(IREQD),IREQD=1,NREQD)
READ(5,902) (NGRQS(IREQS),IREQS=1,NREQS)
WRITE(6,909)
909 FORMAT(/5X,41H SELECTIVE OUTPUT REQUESTED FOR FOLLOWING )
WRITE(6,910) (NPRQD(IREQD),IREQD=1,NREQD)
910 FORMAT(/,5X,6H NODES,10I5)
WRITE(6,911) (NGRQS(IREQS),IREQS=1,NREQS)
911 FORMAT(5X,6H G.P.,10I5)
902 FORMAT(16I5)
190 FORMAT(8F10.4)
C
C*** READ THE INDICATOR FOR EXPLICIT OR IMPLICIT ELEMENT
C
READ (5,902) (INTGR(IELEM),IELEM=1,NELEM)
WRITE(6,930)
WRITE(6,902) (INTGR(IELEM),IELEM=1,NELEM)
930 FORMAT(/5X,'TYPE OF ELEMENT, IMPLICIT=1,EXPLICIT=2 '/)
C
C*** INITIAL DISPLACEMENTS
C
JPOIN=0
DO 500 IPOIN=1,NPOIN
DO 500 IDOFN=1,NDOFN
JPOIN=JPOIN+1
TDISP(JPOIN)=0.
500 VELOC(JPOIN)=0.
WRITE(6,903)
200 READ(5,904) NGASH,XGASH,YGASH
NPOSN=(NGASH-1)*NDOFN+1
TDISP(NPOSN)=XGASH
NPOSN=NPOSN+1
TDISP(NPOSN)=YGASH
WRITE(6,905) NGASH,XGASH,YGASH
IF(NGASH.NE.NPOIN) GO TO 200
C
C*** INITIAL VELOCITIES
C
WRITE(6,906)
210 READ(5,904) NGASH,XGASH,YGASH
NPOSN=(NGASH-1)*NDOFN+1
VELOC(NPOSN)=XGASH
NPOSN=NPOSN+1
VELOC(NPOSN)=YGASH
WRITE(6,905) NGASH,XGASH,YGASH
IF(NGASH.NE.NPOIN) GO TO 210
904 FORMAT(I5,2F10.5)
903 FORMAT(/5X,5H NODE,2X,16H INITIAL X-DISP.,2X,
.16H INITIAL Y-DISP./)
905 FORMAT(I10,2E18.5)
906 FORMAT(/5X,5H NODE,2X,16H INITIAL X-VELO.,2X,
.16H INITIAL Y-VELO./)
IF (IFUNC.NE.0) GO TO 250
C
C*** READ ACCELEROGRAM DATA ,X-DIREC FROM TAPE 7,Y-DIREC FROM TAPE 12
C
AFACT=DTREC/DTIME
IF(IFIXD-1) 220,230,240
220 READ (7,907)(ACCEH(I),I=1,NACCE) 
```

<!-- source-page: 413 -->

<table><tr><td></td><td>WRITE(6,912) DTREC</td><td>TIME 95</td></tr><tr><td></td><td>WRITE(6,907)(ACCEH(I),I=1,NACCE)</td><td>TIME 96</td></tr><tr><td></td><td>READ(12,907)(ACCEV(I),I=1,NACCE)</td><td>TIME 97</td></tr><tr><td></td><td>WRITE(6,913) DTREC</td><td>TIME 98</td></tr><tr><td></td><td>WRITE(6,907)(ACCEV(I),I=1,NACCE)</td><td>TIME 99</td></tr><tr><td></td><td>GO TO 250</td><td>TIME 100</td></tr><tr><td>230</td><td>READ(12,907)(ACCEV(I),I=1,NACCE)</td><td>TIME 101</td></tr><tr><td></td><td>WRITE(6,913) DTREC</td><td>TIME 102</td></tr><tr><td></td><td>WRITE(6,907)(ACCEV(I),I=1,NACCE)</td><td>TIME 103</td></tr><tr><td></td><td>GO TO 250</td><td>TIME 104</td></tr><tr><td>240</td><td>READ(7,907)(ACCEH(I),I=1,NACCE)</td><td>TIME 105</td></tr><tr><td></td><td>WRITE(6,912)</td><td>TIME 106</td></tr><tr><td></td><td>WRITE(6,907)(ACCEH(I),I=1,NACCE)</td><td>TIME 107</td></tr><tr><td>907</td><td>FORMAT(7F10.3)</td><td>TIME 108</td></tr><tr><td>912</td><td>FORMAT(/5X,&#x27;HORIZONTAL ACCELERATION ORDINATES AT&#x27;,F9.4,2X,&#x27;SEC&#x27;)</td><td>TIME 109</td></tr><tr><td>913</td><td>FORMAT(/5X,&#x27;VERTICAL ACCELERATION ORDINATES AT&#x27;,F9.4,2X,&#x27;SEC&#x27;)</td><td>TIME 110</td></tr><tr><td>250</td><td>CONTINUE</td><td>TIME 111</td></tr><tr><td></td><td>RETURN</td><td>TIME 112</td></tr><tr><td></td><td>END</td><td>TIME 113</td></tr></table>

TIME 14-33 Read and write most of the control time integration data.

TIME 34–46 Read the selective nodal points and integration points for displacement and stress history.

TIME 54–70 Read initial displacement.

TIME 71-87 Read initial velocities.

TIME 89-111 Read appropriate acceleration data.

# 10.6.12 Subroutine INVAR

This routine calculates the stress invariants and yield values for the various yield criteria. The choice of yield criterion is governed by the parameter NCRIT. A similar routine was described in Section 7.8.3.

```fortran
SUBROUTINE INVAR (DEVIA, LPROP, NCRIT, NMATS, PROPS, SINT3, STEFF, STEMP, THETA, VARJ2, YIELD) INVR 1
C********** INVR 2
C INVR 3
C INVR 4
C** STRESS INVARIANTS INVR 5
C INVR 6
C********** INVR 7
DIMENSION DEVIA(4), PROPS(NMATS, 1), STEMP(4) INVR 8
C INVR 9
C*** INVARIANTS INVR 10
C INVR 11
ROOT3=1.73205080757 INVR 12
SMEAN=(STEMP(1)+STEMP(2)+STEMP(4))/3.0 INVR 13
DEVIA(1)=STEMP(1)-SMEAN INVR 14
DEVIA(2)=STEMP(2)-SMEAN INVR 15
DEVIA(3)=STEMP(3) INVR 16
DEVIA(4)=STEMP(4)-SMEAN INVR 17
VARJ2=DEVIA(3)*DEVIA(3)+0.5*(DEVIA(1)*DEVIA(1)+
DEVIA(2)*DEVIA(2)+DEVIA(4)*DEVIA(4)) INVR 18
VARJ3=DEVIA(4)*(DEVIA(4)*DEVIA(4)-VARJ2) INVR 19
STEFF=SQRT(VARJ2) INVR 20
IF (VARJ2.EQ.0.0.OR.STEFF.EQ.0.0) GO TO 5 INVR 21
SINT3=-2.5980762113*VARJ3/(VARJ2*STEFF) INVR 22
GO TO 6 INVR 23
5 SINT3=0.0 INVR 24
6 CONTINUE INVR 25
IF(SINT3.LT.-1.0) SINT3=-1.0 INVR 26
INVR 27 
```

<!-- source-page: 414 -->

```csv
IF(SINT3.GT. 1.0) SINT3= 1.0 INVR 28
THETA=ASIN(SINT3)/3.0 INVR 29
GO TO (1,2,3,4) NCRIT INVR 30
C*** TRESCA INVR 31
1 YIELD=2.0*COS(THETA)*STEFF INVR 32
RETURN INVR 33
C*** VON MISES INVR 34
2 YIELD=ROOT3*STEFF INVR 35
RETURN INVR 36
C*** MOHR-COULOMB INVR 37
3 PHIRA=PROPS(LPROP,8)*0.017453292 INVR 38
SNPHI=SIN(PHIRA) INVR 39
YIELD=SMEAN*SNPHI+STEFF*(COS(THETA)-SIN(THETA)*SNPHI/ROOT3) INVR 40
RETURN INVR 41
C*** DRUCKER-PRAGER INVR 42
4 PHIRA=PROPS(LPROP,8)*0.017453292 INVR 43
SNPHI=SIN(PHIRA) INVR 44
YIELD=6.0*SMEAN*SNPHI/(ROOT3*(3.0-SNPHI))+STEFF INVR 45
RETURN INVR 46
END INVR 47 
```

# 10.6.13 Subroutine JACOBD

This subroutine evaluates the deformation Jacobian matrix $[J_{D}]_{n}$ for a particular sampling point within an element.

```fortran
SUBROUTINE JACOBD (CARTD, DLCOD, DJACM, NDIME, NLAPS, NNODE) JACD 1
C*******************************
C*******************************
C*** DEFORMATION JACOBIAN JACD 2
C JACD 3
C*******************************
DIMENSION CARTD(2,9), DLCOD(2,9), DJACM(2,2) JACD 4
IF(NLAPS.GT.1) GO TO 10 JACD 5
C JACD 6
C*** FOR SMALL DISPLACEMENT JACD 7
C JACD 8
C JACD 9
DJACM(1,1)=1.0 JACD 10
DJACM(2,2)=1.0 JACD 11
DJACM(1,2)=0.0 JACD 12
DJACM(2,1)=0.0 JACD 13
RETURN JACD 14
RETURN JACD 15
RETURN JACD 16
C JACD 17
C*** FOR LARGE DISPLACEMENT JACD 18
C JACD 19
10 CONTINUE JACD 20
DO 20 IDIME=1, NDIME JACD 21
DO 20 JDIME=1, NDIME JACD 22
DJACM(IDIME, JDIME)=0.0 JACD 23
DO 20 INODE=1, NNODE JACD 24
DJACM(IDIME, JDIME)=DJACM(IDIME, JDIME) JACD 25
.+DLCOD(IDIME, INODE)*CARTD(JDIME, INODE) JACD 26
20 CONTINUE JACD 27
RETURN JACD 28
END JACD 29
```

# 10.6.14 Subroutine LINGNL

This routine calculates the total elastic strain and corresponding elastic stresses at a particular integration point. In this calculation the strains are evaluated using the deformation Jacobian matrix if geometric nonlinear behaviour is to be taken into account.

<!-- source-page: 415 -->

```fortran
SUBROUTINE LINGNL (CARTD, DJACM, DMATX, ELDIS, GPCOD, KGASP, LINR 1
KGAUS, NDOFN, NLAPS, NNODE, NSTRE, NTYPE, LINR 2
POISS, SHAPE, STRAN, STRES, STRIN) LINR 3
C****************************************************************************************
C
C*** ELASTIC STRAIN AND STRESSES
C
C****************************************************************************************
DIMENSION CARTD(2,9), STRAN(4), DMATX(4,4), STRIN(4,1), LINR 9
ELDIS(2,9), STRES(4), DJACM(2,2), AGASH(2,2), LINR 10
GPCOD(2,9), SHAPE(9) LINR 11
C
C*** CALCULATE STRAINS FROM DEFORMATION JACOBIAN
C
IF(NLAPS.LT.2) GO TO 15
STRAN(1)=0.5*(DJACM(1,1)*DJACM(1,1)+DJACM(2,1)*DJACM(2,1)-1.)
STRAN(2)=0.5*(DJACM(1,2)*DJACM(1,2)+DJACM(2,2)*DJACM(2,2)-1.)
STRAN(3)=DJACM(1,1)*DJACM(1,2)+DJACM(2,1)*DJACM(2,2) LINR 18
C
C *** FOR SMALL DISPLACEMENTS
C
GO TO 25
15 CONTINUE
DO 10 IDOFN=1, NDOFN
DO 10 JDOFN=1, NDOFN
BGASH=0.0
DO 20 INODE=1, NNODE
20 BGASH=BGASH+CARTD(JDOFN, INODE)*ELDIS(IDOFN, INODE) LINR 28
10 AGASH(IDOFN, JDOFN)=BGASH
STRAN(1)=AGASH(1,1) LINR 29
STRAN(2)=AGASH(2,2) LINR 30
STRAN(3)=AGASH(1,2)+AGASH(2,1) LINR 31
25 CONTINUE
IF(NTYPE.LT.3) GO TO 90
STRAN(4)=0.0
DO 70 INODE=1, NNODE
70 STRAN(4)=STRAN(4)+ELDIS(1, INODE)*SHAPE(INODE)/GPCOD(1, KGASP) LINR 32
EXTRA=0.0
DO 80 INODE=1, NNODE
80 EXTRA=EXTRA+ELDIS(1, INODE)*SHAPE(INODE)/GPCOD(1, KGASP) LINR 33
STRAN(4)=STRAN(4)+0.5*EXTRA*EXTRA LINR 34
90 DO 50 ISTRE=1,4
STRAN(ISTRE)=STRAN(ISTRE)-STRIN(ISTRE, KGAUS) LINR 35
50 CONTINUE
C
C*** AND THE CORRESPONDING STRESSES
C
DO 30 ISTRE=1, NSTRE
STRES(ISTRE)=0.0
DO 30 JSTRE=1, NSTRE
30 STRES(ISTRE)=STRES(ISTRE)+DMATX(ISTRE, JSTRE)*STRAN(JSTRE) LINR 40
IF(NTYPE.EQ.1) STRES(4)=0.0
IF(NTYPE.EQ.2) STRES(4)=POISS*(STRES(1)+STRES(2)) LINR 41
RETURN
END
LINR 42
LINR 43
LINR 44
LINR 45
LINR 46
LINR 47
LINR 48
LINR 49
LINR 50
LINR 51
LINR 52
LINR 53
LINR 54
LINR 55 
```

# 10.6.15 Subroutine LOADPL

This routine reads load data and evaluates the consistent nodal forces associated with thermal loading. A similar routine was described in Section 6.4.5. The additions which are included here have been discussed in detail in the authors' earlier text Finite Element Programming. $^{(7)}$

<!-- source-page: 416 -->

```csv
SUBROUTINE LOADPL (COORD, FORCE, LNODS, MATNO, NDIME, NDOFN, LOAD 1
NELEM, NGAUS, NMATS, NNODE, NPOIN, NSTRE, LOAD 2
NTYPE, POSGP, PROPS, RLOAD, STRIN, TEMPE, LOAD 3
WEIGP) LOAD 4
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
TWOPI=6.283185307179586
NEVAB=NNODE*NDOFN
DO 10 IELEM=1,NELEM
DO 10 IEVAB=1,NEVAB
10 RLOAD(IELEM,IEVAB)=0.0
READ(5,901) TITLE
901 FORMAT (10A4)
WRITE(6,903) TITLE
903 FORMAT(/5X,17HLOAD CASE TITLE -,10A4)
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C
C 
```

<!-- source-page: 417 -->

```txt
THETA=THETA/57.295779514
LOAD 65
C
DO 90 IELEM=1,NELEM
LOAD 66
C
C*** SET UP PRELIMINARY CONSTANTS
LOAD 69
C
LPROP=MATNO(IELEM)
LOAD 70
THICK=PROPS(LPROP,3)
LOAD 71
DENSE=PROPS(LPROP,4)
LOAD 72
IF(DENSE.EQ.0.0) GO TO 90
LOAD 73
GXCOM=DENSE*GRAVY*SIN(THETA)
LOAD 74
GYCOM=-DENSE*GRAVY*COS(THETA)
LOAD 75
C
C*** COMPUTE COORDINATES OF THE ELEMENT NODAL POINTS
LOAD 76
C
DO 60 INODE=1,NNODE
LOAD 77
LNODE=IABS(LNODS(IELEM,INODE))
LOAD 78
DO 60 IDIME=1,NDIME
LOAD 80
60 ELCOD(IDIME,INODE)=COORD(LNODE,IDIME)
LOAD 81
C
C*** ENTER LOOPS FOR AREA NUMERICAL INTEGRATION
LOAD 82
C
KGASP=0
LOAD 83
DO 80 IGAUS=1,NGAUS
LOAD 84
DO 80 JGAUS=1,NGAUS
LOAD 85
KGASP=KGASP+1
LOAD 86
EXISP=POSGP(IGAUS)
LOAD 87
ETASP=POSGP(JGAUS)
LOAD 88
C
C*** COMPUTE THE SHAPE FUNCTIONS AT THE SAMPLING POINTS AND ELEMENTAL
C VOLUME
LOAD 89
C
CALL SFR2 (DERIV,NNODE,SHAPE,EXISP,ETASP)
LOAD 90
CALL JACOB2 (CARTD,DERIV,DJACB,ELCOD,GPCOD,IELEM,
KGASP,NNODE,SHAPE)
LOAD 91
DVOLU=DJACB*WEIGP(IGAUS)*WEIGP(JGAUS)
LOAD 92
IF(NTYPE.EQ.1) DVOLU=DVOLU*THICK
LOAD 93
IF(NTYPE.EQ.3) DVOLU=DVOLU*TWOPI*GPCOD(1,KGASP)
LOAD 94
C
C*** CALCULATE LOADS AND ASSOCIATE WITH ELEMENT NODAL POINTS
LOAD 95
C
DO 70 INODE=1,NNODE
LOAD 96
NGASH=(INODE-1)*NDOFN+1
LOAD 97
MGASH=(INODE-1)*NDOFN+2
LOAD 98
RLOAD(IELEM,NGASH)=RLOAD(IELEM,NGASH)+GXCOM*SHAPE(INODE)*DVOLU
LOAD 100
70 RLOAD(IELEM,MGASH)=RLOAD(IELEM,MGASH)+GYCOM*SHAPE(INODE)*DVOLU
LOAD 101
80 CONTINUE
LOAD 102
90 CONTINUE
LOAD 103
600 CONTINUE
LOAD 104
IF(IEDGE.EQ.0) GO TO 700
LOAD 105
C
C*** DISTRIBUTED EDGE LOADS SECTION
LOAD 106
C
READ(5,932) NEDGE
LOAD 107
932 FORMAT(I5)
LOAD 108
WRITE(6,912) NEDGE
LOAD 109
912 FORMAT(1H0,5X,21HNO. OF LOADED EDGES =,I5)
LOAD 110
WRITE(6,915)
LOAD 111
915 FORMAT(1H0,5X,38HLIST OF LOADED EDGES AND APPLIED LOADS)
LOAD 112
NODEG=3
LOAD 113
NCODE=NNODE
LOAD 114
IF(NNODE.EQ.4) NODEG=2
LOAD 115
IF(NNODE.EQ.9) NCODE=8
LOAD 116
C
LOAD 117
LOAD 118
LOAD 119
LOAD 120
LOAD 121
LOAD 122
LOAD 123
LOAD 124
LOAD 125
LOAD 126
LOAD 127
C
LOAD 128 
```

<!-- source-page: 418 -->

```csv
C*** LOOP OVER EACH LOADED EDGE
C
DO 160 IEDGE=1,NEDGE
C
C*** READ DATA LOCATING THE LOADED EDGE AND APPLIED LOAD
C
READ (5,902) NEASS,(NOPRS(IODEG),IODEG=1,NODEG)
902 FORMAT(4I5)
WRITE(6,913) NEASS,(NOPRS(IODEG),IODEG=1,NODEG)
913 FORMAT(I10,5X,3I5)
READ (5,914)((PRESS(IODEG,IDOFN),IODEG=1,NODEG),IDOFN=1,NDOFN)
WRITE(6,914)((PRESS(IODEG,IDOFN),IODEG=1,NODEG),IDOFN=1,NDOFN)
914 FORMAT(6F10.3)
ETASP=-1.0
C
C*** CALCULATE THE COORDINATES OF THE NODES OF THE ELEMENT EDGE
C
DO 100 IODEG=1,NODEG
LNODE=NOPRS(IODEG)
DO 100 IDIME=1,NDIME
100 ELCOD(IDIME,IODEG)=COORD(LNODE,IDIME)
C
C*** ENTER LOOP FOR LINEAR NUMERICAL INTEGRATION
DO 150 IGAUS=1,NGAUS
EXISP=POSGP(IGAUS)
C
C*** EVALUATE THE SHAPE FUNCTIONS AT THE SAMPLING POINTS
C
CALL SFR2 (DERIV,NNODE,SHAPE,EXISP,ETASP)
C
C*** CALCULATE COMPONENTS OF THE EQUIVALENT NODAL LOADS
C
DO 110 IDOFN=1,NDOFN
PGASH(IDOFN)=0.0
DGASH(IDOFN)=0.0
DO 110 IODEG=1,NODEG
PGASH(IDOFN)=PGASH(IDOFN)+PRESS(IODEG,IDOFN)*SHAPE( IODEG)
110 DGASH(IDOFN)=DGASH(IDOFN)+ELCOD(IDOFN,IODEG)*DERIV(1,IODEG)
DVOLU=WEIGP(IGAUS)
PXCOM=DGASH(1)*PGASH(2)-DGASH(2)*PGASH(1)
PYCOM=DGASH(1)*PGASH(1)+DGASH(2)*PGASH(2)
IF(NTYPE.NE.3) GO TO 115
RADUS=0.0
DO 125 IODEG=1,NODEG
125 RADUS=RADIUS+SHAPE(IODEG)*ELCOD(1,IODEG)
DVOLU=DVOLU*TWOPI*RADIUS
115 CONTINUE
C
C*** ASSOCIATE THE EQUIVALENT NODAL EDGE LOADS WITH AN ELEMENT
C
DO 120 INODE=1,NNODE
NLOCA=IABS(LNODS(NEASS,INODE))
120 IF(NLOCA.EQ.NOPRS(1)) GO TO 130
130 JNODE=INODE+NODEG-1
KOUNT=0
DO 140 KNODE=INODE,JNODE
KOUNT=KOUNT+1
NGASH=(KNODE-1)*NDOFN+1
MGASH=(KNODE-1)*NDOFN+2
IF(KNODE.GT.NCODE) NGASH=1
IF(KNODE.GT.NCODE) MGASH=2
RLOAD(NEASS,NGASH)=RLOAD(NEASS,NGASH)+SHAPE(KOUNT)*PXCOM*DVOLU
140 RLOAD(NEASS,MGASH)=RLOAD(NEASS,MGASH)+SHAPE(KOUNT)*PYCOM*DVOLU
150 CONTINUE
160 CONTINUE
LOAD 129
LOAD 130
LOAD 131
LOAD 132
LOAD 133
LOAD 134
LOAD 135
LOAD 136
LOAD 137
LOAD 138
LOAD 139
LOAD 140
LOAD 141
LOAD 142
LOAD 143
LOAD 144
LOAD 145
LOAD 146
LOAD 147
LOAD 148
LOAD 149
LOAD 150
LOAD 151
LOAD 152
LOAD 153
LOAD 154
LOAD 155
LOAD 156
LOAD 157
LOAD 158
LOAD 159
LOAD 160
LOAD 161
LOAD 162
LOAD 163
LOAD 164
LOAD 165
LOAD 166
LOAD 167
LOAD 168
LOAD 169
LOAD 170
LOAD 171
LOAD 172
LOAD 173
LOAD 174
LOAD 175
LOAD 176
LOAD 177
LOAD 178
LOAD 179
LOAD 180
LOAD 181
LOAD 182
LOAD 183
LOAD 184
LOAD 185
LOAD 186
LOAD 187
LOAD 188
LOAD 189
LOAD 190
LOAD 191
LOAD 192
LOAD 193 
```

<!-- source-page: 419 -->

```fortran
700 CONTINUE
    IF(ITEMP.EQ.0) GO TO 800
C
C*** INITIALIZE AND INPUT THE NODAL TEMPERATURES
C
    DO 170 IPOIN=1,NPOIN
    170 TEMPE(IPOIN)=0.0
    WRITE(6,917)
    917 FORMAT(1HO,5X,29HPREScribed NODAL TEMPERATURES)
    180 READ (5,916) NODPT,TEMPE(NODPT)
    WRITE(6,916) NODPT,TEMPE(NODPT)
    916 FORMAT(I5,F10.3)
    IF(NODPT.LT.NPOIN) GO TO 180
    KGAST=0
C
C*** LOOP OVER EACH ELEMENT
C
    DO 280 IELEM=1,NELEM
    LPROP=MATNO(IELEM)
    DO 200 INODE=1,NNODE
    LNODE=IABS(LNODS(IELEM,INODE))
C
C*** IDENTIFY THE COORDINATES AND TEMPERATURE OF EACH ELEMENT NODE POINTLOAD
C
    DO 190 IDIME=1,NDIME
    190 ELCOD(IDIME,INODE)=COORD(LNODE,IDIME)
    200 ELCOD(2,INODE)=TEMPE(LNODE)
C
C*** SET UP MATERIAL PROPERTIES
C
    CALL MODPS (DMATX,LPROP,NMATS,NSTRE,NTYPE,PROPS)
    YOUNG=PROPS(LPROP,1)
    POISS=PROPS(LPROP,2)
    THICK=PROPS(LPROP,3)
    ALPHA=PROPS(LPROP,5)
C
C*** ENTER LOOPS FOR AREA NUMERICAL INTEGRATION
C
    KGASP=0
    DO 270 IGAUS=1,NGAUS
    DO 270 JGAUS=1,NGAUS
    KGAST=KGAST+1
    KGASP=KGASP+1
    EXISP=POSGP(IGAUS)
    ETASP=POSGP(JGAUS)
C
C*** EVALUATE THE SHAPE FUNCTIONS AND TEMPERATURE AT THE SAMPLING POINTSLOAD
C
    ,ELEMENTAL VOLUME AND CARTESIAN DERIVATIVES
C
    CALL SFR2 (DERIV,NNODE,SHAPE,EXISP,ETASP)
    CALL JACOB2 (CARTD,DERIV,DJACB,ELCOD,GPCOD,IELEM,
    KGASP,NNODE,SHAPE)
    THERM=0.0
    DO 210 INODE=1,NNODE
    210 THERM=THERM+ELCOD(2,INODE)*SHAPE(INODE)
    DVOLU=DJACB*WEIGP(IGAUS)*WEIGP(JGAUS)
    IF(NTYPE.EQ.1) DVOLU=DVOLU*THICK
    IF(NTYPE.EQ.3) DVOLU=DVOLU*TWOPI*GPCOD(1,KGASP)
C
C*** EVALUATE THE INITIAL THERMAL STRAINS
C
    EIGEN=THERM*ALPHA
    IF(NTYPE.EQ.2) GO TO 220
    STRAN(1)=-EIGEN
    STRAN(2)=-EIGEN
    LOAD 194
    LOAD 195
    LOAD 196
    LOAD 197
    LOAD 198
    LOAD 199
    LOAD 200
    LOAD 201
    LOAD 202
    LOAD 203
    LOAD 204
    LOAD 205
    LOAD 206
    LOAD 207
    LOAD 208
    LOAD 209
    LOAD 210
    LOAD 211
    LOAD 212
    LOAD 213
    LOAD 214
    LOAD 215
    LOAD 216
    LOAD 217
    LOAD 218
    LOAD 219
    LOAD 220
    LOAD 221
    LOAD 222
    LOAD 223
    LOAD 224
    LOAD 225
    LOAD 226
    LOAD 227
    LOAD 228
    LOAD 229
    LOAD 230
    LOAD 231
    LOAD 232
    LOAD 233
    LOAD 234
    LOAD 235
    LOAD 236
    LOAD 237
    LOAD 238
    LOAD 239
    LOAD 240
    LOAD 241
    LOAD 242
    LOAD 243
    LOAD 244
    LOAD 245
    LOAD 246
    LOAD 247
    LOAD 248
    LOAD 249
    LOAD 250
    LOAD 251
    LOAD 252
    LOAD 253
    LOAD 254
    LOAD 255
    LOAD 256
    LOAD 257
    LOAD 258 
```

<!-- source-page: 420 -->

```csv
STRAN(3)=0.0
GO TO 230
220 STRAN(1)=-(1.0+POISS)*EIGEN
STRAN(2)=-(1.0+POISS)*EIGEN
STRAN(3)=0.0
C
C*** AND THE CORRESPONDING INITIAL STRESSES
C
230 DO 250 ISTRE=1,NSTRE
STRES(ISTRE)=0.0
DO 240 JSTRE=1,NSTRE
240 STRES(ISTRE)=STRES(ISTRE)+DMATX(ISTRE,JSTRE)*STRAN(JSTRE)
250 STRIN(ISTRE,KGAST)=STRES(ISTRE)
IF(NTYPE.EQ.2) STRIN(4,KGAST)=-YOUNG*EIGEN
IF(NTYPE.EQ.1) STRIN(4,KGAST)=0.0
C
C*** CALCULATE THE EQUIVALENT NODAL FORCES AND ASSOCIATE WITH THE
C ELEMENT NODES
C
EXTRA=0.0
DO 260 INODE=1,NNODE
IF(NTYPE.EQ.3) EXTRA=DVOLU*SHAPE(INODE)*STRES(4)/GPCOD(1,KGASP)
NGASH=(INODE-1)*NDOFN+1
MGASH=(INODE-1)*NDOFN+2
RLOAD(IELEM,NGASH)=RLOAD(IELEM,NGASH)+EXTRA
-(CARTD(1,INODE)*STRES(1)+CARTD(2,INODE)*STRES(3))*DVOLU
260 RLOAD(IELEM,MGASH)=RLOAD(IELEM,MGASH)
-(CARTD(1,INODE)*STRES(3)+CARTD(2,INODE)*STRES(2))*DVOLU
270 CONTINUE
280 CONTINUE
800 CONTINUE
C WRITE(6,907)
C 907 FORMAT(1H0,5X,36H TOTAL NODAL FORCES FOR EACH ELEMENT)
C DO 290 IELEM=1,NELEM
C 290 WRITE(6,905) IELEM,(RLOAD(IELEM,IEVAB),IEVAB=1,NEVAB)
C 905 FORMAT(1X,14,5X,8E12.4/(10X,8E12.4))
DO 5 IELEM=1,NELEM
KEVAB=0
DO 5 INODE=1,NNODE
LNODE=LNODS(IELEM,INODE)
NPOSN=(LNODE-1)*NDOFN
DO 5 IDOFN=1,NDOFN
KEVAB KEVAB+1
NPOSN=NPOSN+1
FORCE(NPOSN)=FORCE(NPOSN)+RLOAD(IELEM,KEVAB)
5 CONTINUE
RETURN
END
LOAD 259
LOAD 260
LOAD 261
LOAD 262
LOAD 263
LOAD 264
LOAD 265
LOAD 266
LOAD 267
LOAD 268
LOAD 269
LOAD 270
LOAD 271
LOAD 272
LOAD 273
LOAD 274
LOAD 275
LOAD 276
LOAD 277
LOAD 278
LOAD 279
LOAD 280
LOAD 281
LOAD 282
LOAD 283
LOAD 284
LOAD 285
LOAD 286
LOAD 287
LOAD 288
LOAD 289
LOAD 290
LOAD 291
LOAD 292
LOAD 293
LOAD 294
LOAD 295
LOAD 296
LOAD 297
LOAD 298
LOAD 299
LOAD 300
LOAD 301
LOAD 302
LOAD 303
LOAD 304
LOAD 305
LOAD 306 
```

# 10.6.16 Subroutine LUMASS

This subroutine evaluates the lumped mass vector and consistent mass matrix for the finite element mesh. If INTGR(I)=1, it generates the consistent mass matrix and if INTGR(I)=2, it generates a special lumped mass vector. In the special mass lumping scheme which is employed, the diagonal terms of the consistent mass matrix are scaled to preserve the total mass. The element consistent mass matrices are written on tape 3. The consistent mass matrix is not used in DYNPAK.

This subroutine also reads concentrated masses and assembles them into the global diagonal mass vector.