| C | | | | | | | | | MDYN | 36 |
| CALL | PREVOS | (FORCE STRIN) | NDOFN | ,NELEM | ,NGAUS | ,NPOIN | ,NPREV | , | MDYN |
| C | | | | | | | | | MDYN | 37 |
| | | | | | | | | MDYN | 38 |
| | | | | | | | | MDYN | 39 |
| CALL | LOADPL | (COORD NELEM NTYPE WEIGP) | ,FORCE,NGAUS,POSGP | ,LNODS,NMATS,PROPS | ,MATNO,NNODE,RLOAD | ,NDIME,NPOIN,STRIN | ,NDOFN,NSTRE,TEMPE | , | MDYN |
| C | | | | | | | | | MDYN | 40 |
| | | | | | | | | MDYN | 41 |
| | | | | | | | | MDYN | 42 |
| | | | | | | | | MDYN | 43 |
| | | | | | | | | MDYN | 44 |
| CALL | LUMASS | (COORD NDOFN NTYPE) | ,INTGR,NELEM,PROPS | ,LNODS,NGAUM,YMASS | ,MATNO,NMATS | ,NCONM,NNODE | ,NDIME,NPOIN | , | MDYN |
| C | | | | | | | | | MDYN | 45 |
| | | | | | | | | MDYN | 46 |
| | | | | | | | | MDYN | 47 |
| | | | | | | | | MDYN | 48 |
| CALL | LINKIN | (FORCE MAXAJ NPOIN) | ,IFPRE,MHIGH,NWKTL | ,INTGR,NDOFN,NWMTL | ,LEQNS,NELEM,XMASS | ,LNODS,NEQNS,YMASS | ,MAXAI,NNODE | , | MDYN |
| C | | | | | | | | | MDYN | 50 |
| | | | | | | | | MDYN | 51 |
| | | | | | | | | MDYN | 52 |
| DO 510 | ISTEP=1,NSTEP | | | | | | | MDYN | 53 |
| C | | | | | | | | | MDYN | 54 |
| DO 500 | IITER=1,MITER | | | | | | | MDYN | 55 |
| C | | | | | | | | | MDYN | 56 |
| CALL | GSTIFF | (COORD LNODS NDOFN NPOIN PROPS) | ,EPSTN,MATNO,NELEM,NSTRE,STIFF | ,INTGR,MAXAI,NGAUS,NTYPE,STIFI | ,ISTEP,MAXAJ,NLAPS,NWMTL,STRSG | ,KSTEP,NCRIT,NMATS,NWKTL,DISPT | ,LEQNS,NDIME,NNODE,POSGP,WEIGP) | , | MDYN |
| C | | | | | | | | | MDYN | 57 |
| | | | | | | | | MDYN | 58 |
| | | | | | | | | MDYN | 59 |
| | | | | | | | | MDYN | 60 |
| | | | | | | | | MDYN | 61 |
| | | | | | | | | MDYN | 62 |
| CALL | IMPEXP | (AALFA ACCEV CONSF DISPT IFUNC NDOFN FORCE VELOT) | ,ACCEH,FACT,DAMPI,DTEND,IITER,NEQNS,STIFF,XMASS | ,ACCEI,AZERO,DAMPG,DTIME,ISTEP,NPOIN,STIFI,YMASS | ,ACCEJ,BEETA,DELTA,GAAMA,KSTEP,NWKTL,STIFS,IPRED | ,ACCEK,BZERO,DISPI,IFIXD,MAXAI,VELOI | ,ACCEL,CONSD,DISPL,IFPRE,MAXAJ,OMEGA,VELOL | , | MDYN |
| C | | | | | | | | | MDYN | 63 |
| | | | | | | | | MDYN | 64 |
| | | | | | | | | MDYN | 65 |
| | | | | | | | | MDYN | 66 |
| | | | | | | | | MDYN | 67 |
| | | | | | | | | MDYN | 68 |
| | | | | | | | | MDYN | 69 |
| | | | | | | | | MDYN | 70 |
| C | | | | | | | | | MDYN | 71 |
| CALL | RESEPL | (COORD INTGR NDOFN NPOIN STRAG) | ,DISPT,LEQNS,NELEM,NSTRE,STRIN | ,EFFST,LNODS,NGAUS,NTYPE,STRSG | ,RLOAD,MATNO,NLAPS,POSGP,WEIGP | ,EPSTN,NCRIT,NMATS,PROPS,IPRED | ,IITER,NDIME,NNODE,RESID,ISTEP) | , | MDYN |
| C | | | | | | | | | MDYN | 72 |
| | | | | | | | | MDYN | 73 |
| | | | | | | | | MDYN | 74 |
| | | | | | | | | MDYN | 75 |
| | | | | | | | | MDYN | 76 |
| C | | | | | | | | | MDYN | 77 |
| CALL | ITRATE | (ACCEI DISPL RESID IITER) | ,ACCEL,DISPT,STIFS,MITER | ,CONSD,MAXAI,TOLER) | ,CONSF,NCHEK,VELOI | ,XMASS,NEQNS,NWMTL,VELOL | ,DISPI,NWMTL,VELOT | , | MDYN |
| C | | | | | | | | | MDYN | 78 |
| | | | | | | | | MDYN | 79 |
| | | | | | | | | MDYN | 80 |
| | | | | | | | | MDYN | 81 |
| C | | | | | | | | | MDYN | 82 |
| 500 | IF(NCHEK.EQ.1) GO TO 510 | | | | | | | MDYN | 83 |
| C | | | | | | | | | MDYN | 84 |
| 510 | CALL | OUTDYN | (DISPQ NDOFN NOUTP STRSG) | ,DTIME,NELEM,NPOIN,NPRQD,DISPI) | ,EPSTN,NGAUS,NPRQD,NREQD | ,IFPRE,NNGRQS,NREQD,NREQD | ,IITER,NITER,NOUTD,NTYPE | ,ISTEP | MDYN |
| C | | | | | | | | | MDYN | 85 |
| | | | | | | | | MDYN | 86 |
| | | | | | | | | MDYN | 87 |
| | | | | | | | | MDYN | 88 |
| C | | | | | | | | | MDYN | 89 |
| STOP | | | | | | | | MDYN | 90 |
| END | | | | | | | | MDYN | 91 |
# 11.5.3 Subroutine ADDBAN
This routine $^{(9)}$ assembles the element stiffness matrix into the global stiffness matrix in a compacted form.
```asm
SUBROUTINE ADDBAN (STIFF, MAXAI, ESTIF, LEQNS, NEVAB) ADDB 1
C*******************************
C*******************************
C *** ASSEMBLY OF TOTAL STIFFNESS VECTOR ADDB 2
C
C*******************************
DIMENSION STIFF(1), MAXAI(1), ESTIF(1), LEQNS(1) ADDB 5
C
KOUNT=0 ADDB 8
DO 200 IEVAB=1, NEVAB ADDB 9
IEQNS=LEQNS(IEVAB) ADDB 10
IF(IEQNS) 200, 200, 100 ADDB 11
100 IMAXA=MAXAI(IEQNS) ADDB 12
KEVAB=IEVAB ADDB 13
DO 220 JEVAB=1, NEVAB ADDB 14
JEQNS=LEQNS(JEVAB) ADDB 15
IF(JEQNS) 220, 220, 110 ADDB 16
110 IJEQN=IEQNS-JEQNS ADDB 17
IF(IJEQN) 220, 210, 210 ADDB 18
210 ISIZE=IMAXA+IJEQN ADDB 19
JSIZE=KEVAB ADDB 20
IF(JEVAB.GE.IEVAB) JSIZE=JEVAB+KOUNT ADDB 21
STIFF(ISIZE)=STIFF(ISIZE)+ESTIF(JSIZE) ADDB 22
220 KEVAB=KEVAB+NEVAB-JEVAB ADDB 23
200 KOUNT=KOUNT+NEVAB-IEVAB ADDB 24
RETURN ADDB 25
END ADDB 26
ADDB 27
```
# 11.5.4 Subroutine ADDRES
This routine $^{(9)}$ addresses the diagonal elements of the global matrix using the column heights.
```csv
SUBROUTINE ADDRES(MAXAI ,MHIGH ,NEQNS ,NWKTL ,MKOUN ) ADDR 1
C************************** ADDR 2
C ADDRESS 3
C *** EVALUATES ADRESSES OF DIAGONAL ELEMENTS ADDR 4
C ADDRESS 5
C************************** ADDR 6
DIMENSION MAXAI(1) ,MHIGH(1) ADDR 7
NEQNN=NEQNS+1 ADDR 8
DO 20 IEQNN=1,NEQNN ADDR 9
20 MAXAI(1)=1 ADDR 10
MAXAI(2)=2 ADDR 11
MKOUN=0 ADDR 12
IF(NEQNS.EQ.1) GO TO 30 ADDR 13
DO 10 IEQNS=2,NEQNS ADDR 14
IF(MHIGH(IEQNS).GT.MKOUN) MKOUN=MHIGH(IEQNS) ADDR 15
10 MAXAI(IEQNS+1)=MAXAI(IEQNS)+MHIGH(IEQNS)+1 ADDR 16
30 MKOUN=MKOUN+1 ADDR 17
NWKTL=MAXAI(NEQNS+1)-MAXAI(1) ADDR 18
RETURN ADDR 19
END ADDR 20
```
# 11.5.5 Subroutine COLMHT
This routine $^{(9)}$ calculates the vertical column heights above the diagonal of the global matrix using equation numbers and the total number of degrees of freedom of an element (NEVAB).
```asm
SUBROUTINE COLMHT (MHIGH, NEVAB, LEQNS) COLM 1
C*************** COLM 2
C COLM 3
C*** EVALUATES THE COLUMN HEIGHT OF STIFFNESS MATRIX COLM 4
C COLM 5
C*************** COLM 6
DIMENSION LEQNS(1), MHIGH(1) COLM 7
MAXAM=100000 COLM 8
DO 100 IEVAB=1, NEVAB COLM 9
IF(LEQNS(IEVAB)) 110, 100, 110 COLM 10
110 IF(LEQNS(IEVAB)-MAXAM) 120, 100, 100 COLM 11
120 MAXAM=LEQNS(IEVAB) COLM 12
100 CONTINUE COLM 13
DO 200 IEVAB=1, NEVAB COLM 14
IEQNS=LEQNS(IEVAB) COLM 15
IF(IEQNS.EQ.0) GO TO 200 COLM 16
JHIGH=IEQNS-MAXAM COLM 17
IF(JHIGH.GT.MHIGH(IEQNS)) MHIGH(IEQNS)=JHIGH COLM 18
200 CONTINUE COLM 19
RETURN COLM 20
END COLM 21
```
# 11.5.6 Subroutine DECOMP
This routine $^{(9)}$ factorises a matrix into lower, diagonal and upper matrices $(LDL^{T})$
```fortran
SUBROUTINE DECOMP (STIFF, MAXAI, NEQNS, ISHOT) DECM 1
C*************** DECM 2
C DECM 3
C *** FACTORISES (L)*(D)*(L) TRANSPOSE OF STIFFNESS MATRIX DECM 4
C DECM 5
C*************** DECM 6
DIMENSION STIFF(1), MAXAI(1) DECM 7
C DECM 8
IF(NEQNS.EQ.1) RETURN DECM 9
DO 200 IEQNS=1, NEQNS DECM 10
IMAXA=MAXAI(IEQNS) DECM 11
LOWER=IMAXA+1 DECM 12
KUPER=MAXAI(IEQNS+1)-1 DECM 13
KHIGH=KUPER-LOWER DECM 14
IF(KHIGH) 304,240,210 DECM 15
210 KSIZE=IEQNS-KHIGH DECM 16
ICOUN=0 DECM 17
JUPER=KUPER DECM 18
DO 260 JHIGH=1,KHIGH DECM 19
ICOUN=ICOUN+1 DECM 20
JUPER=JUPER-1 DECM 21
KMAXA=MAXAI(KSIZE) DECM 22
NDIAG=MAXAI(KSIZE+1)-KMAXA-1 DECM 23
IF(NDIAG) 260,260,270 DECM 24
```
```csv
270 NCOLM=MINO(ICOUN,NDIAG) DECM 25
COUNT=0. DECM 26
DO 280 ICOLM=1,NCOLM DECM 27
280 COUNT=COUNT+STIFF(KMAXA+ICOLM)*STIFF(JUPER+ICOLM) DECM 28
STIFF(JUPER)=STIFF(JUPER)-COUNT DECM 29
260 KSIZE=KSIZE+1 DECM 30
240 KSIZE=IEQNS DECM 31
BSUMM=0. DECM 32
DO 300 ICOLM=LOWER,KUPER DECM 33
KSIZE=KSIZE-1 DECM 34
JMAXA=MAXAI(KSIZE) DECM 35
RATIO=STIFF(ICOLM)/STIFF(JMAXA) DECM 36
BSUMM=BSUMM+RATIO*STIFF(ICOLM) DECM 37
300 STIFF(ICOLM)=RATIO DECM 38
STIFF(IMAXA)=STIFF(IMAXA)-BSUMM DECM 39
304 IF(STIFF(IMAXA)) 310,310,200 DECM 40
310 IF(ISHOT.EQ.0) GO TO 320 DECM 41
IF(STIFF(IMAXA).EQ.0) STIFF(IMAXA)=-1.E-16 DECM 42
GO TO 200 DECM 43
320 WRITE(6,2000) IEQNS,STIFF(IMAXA) DECM 44
STOP DECM 45
200 CONTINUE DECM 46
RETURN DECM 47
2000 FORMAT(//48H STOP - STIFFNESS MATRIX NOT POSITIVE DEFINITE ,//
.32H NONPOSITIVE PIVOT FOR EQUATION ,I4,//10H PIVOT = ,E20.12 ) DECM 49
END DECM 50
```
# 11.5.7 Subroutine DINTOB
This routine multiplies the modulus matrix D with the strain matrix B.
```fortran
SUBROUTINE DINTOB (BMATX, DBMAT, DMATX, NEVAB, NSTRE) DINT 1
C*******************************
C DINT 2
C DINT 3
C*** CALCULATE D INTO B DINT 4
C DINT 5
C*******************************
DIMENSION DBMAT(4,18), DMATX(4,4), BMATX(4,18) DINT 7
DO 10 ISTRE=1, NSTRE DINT 8
DO 10 IEVAB=1, NEVAB DINT 9
DBMAT(ISTRE, IEVAB)=0.0 DINT 10
DO 10 JSTRE=1, NSTRE DINT 11
DBMAT(ISTRE, IEVAB)=DBMAT(ISTRE, IEVAB)+ DINT 12
.DMATX(ISTRE, JSTRE)*BMATX(JSTRE, IEVAB) DINT 13
10 CONTINUE DINT 14
RETURN DINT 15
END DINT 16
```
# 11.5.8 Subroutine GEOMST
This routine adds the initial stress matrix to the stiffness matrix.
```asm
SUBROUTINE GEOMST (CARTD, DVOLU, ESTIF, KGAUS, NDOFN, NNODE, STRSG, SHAPE, NTYPE, GPCOD, KGASP) GEOM 1
C*************** GEOM 2
C
C
C
ADD INITIAL STRESS STIFFNESS MATRIX TO STIFFNESS MATRIX GEOM 3
C
C
C*************** GEOM 4
DIMENSION STRES(4), CARTD(2,9), ESTIF(171), STRSG(4,1), SHAPE(1), GPCOD(2,9) GEOM 5
NEVAB=NNODE*NDOFN GEOM 6
DO 300 ISTR1=1,4 GEOM 7
GEOM 8
GEOM 9
GEOM 10
GEOM 11
```
```txt
300 STRES(ISTR1)=STRSG(ISTR1,KGAUS) GEOM 12
IEVAB=1 GEOM 13
KOUNT=NEVAB GEOM 14
DO 200 INODE=1,NNODE GEOM 15
DO 100 JNODE=INODE,NNODE GEOM 16
DGASH=STRES(1)*CARTD(1,INODE)*CARTD(1,JNODE)+
.STRES(3)*(CARTD(1,INODE)*CARTD(2,JNODE)+
.CARTD(2,INODE)*CARTD(1,JNODE))+ GEOM 19
.STRES(2)*CARTD(2,INODE)*CARTD(2,JNODE) GEOM 20
DGASY=DGASH*DVOLU GEOM 21
DGASX=DGASY GEOM 22
IF(NTYPE.NE.3) GO TO 400 GEOM 23
PRODT=SHAPE(INODE)/(GPCOD(1,KGASP)**2) GEOM 24
DGASX=DGASY+STRES(4)*PRODT*SHAPE(JNODE)*DVOLU GEOM 25
400 ESTIF(IEVAB)=ESTIF(IEVAB)+DGASX GEOM 26
JEVAB=IEVAB+KOUNT GEOM 27
ESTIF(JEVAB)=ESTIF(JEVAB)+DGASY GEOM 28
IEVAB=IEVAB+2 GEOM 29
100 CONTINUE GEOM 30
KOUNT=KOUNT-2 GEOM 31
IEVAB=JEVAB+1 GEOM 32
200 CONTINUE GEOM 33
RETURN GEOM 34
END GEOM 35
```
# 11.5.9 Subroutine GSTIFF
This routine generates the compacted geometrically nonlinear stiffness matrix for two-dimensional plane stress/strain and axisymmetric problems from the element stiffness matrices.
```txt
SUBROUTINE GSTIFF (COORD ,EPSTN ,INTGR ,ISTEP ,KSTEP ,LEQNS , STIF 1
. LNODS ,MATNO ,MAXAI ,MAXAJ ,NCRIT ,NDIME , STIF 2
. NDOFN ,NELEM ,NGAUS ,NLAPS ,NMATS ,NNODE , STIF 3
. NPOIN ,NSTRE ,NTYPE ,NWMTL ,NWKTL ,POSGP , STIF 4
. PROPS ,STIFF ,STIFI ,STRSG ,TDISP ,WEIGP ) STIF 5
C***********************************************************************************************
C
C EVALUATES GEOMETRICALLY NONLINEAR STIFFNESS MATRIX STIF 8
C FOR 2-D PLANE STRESS/STRAIN 2-D ELEMENT STIF 9
C
C***********************************************************************************************
C
DIMENSION COORD(NPOIN,1) ,DMATX(4, 4) ,ELCOD(2,9) ,AVECT(4) , STIF 12
. LNODS(NELEM,1) ,BMATX(4,18) ,CARTD(2,9) ,DVECT(4) , STIF 13
. PROPS(NMATS,1) ,DBMAT(4,18) ,GPCOD(2,9) ,DEVIA(4) , STIF 14
. LEQNS( 18, 1) ,STRSG(4, 1) ,DLCOD(2,9) ,STRES(4) , STIF 15
. ESTIF( 171) ,DJACM(2, 2) ,DERIV(2,9) ,SHAPE(9) STIF 16
C
DIMENSION MAXAI(1) ,INTGR(1) ,STIFF(1) ,POSGP(1) ,EPSTN(1) , STIF 18
. MAXAJ(1) ,TDISP(1) ,STIFI(1) ,WEIGP(1) ,MATNO(1) STIF 19
C
C
IF(ISTEP.EQ.1) GO TO 200 STIF 21
KOUNT=(ISTEP/KSTEP)*KSTEP STIF 22
IF(KOUNT.NE.ISTEP)RETURN STIF 23
200 CONTINUE STIF 24
TWOPI=6.283185307179586 STIF 25
KGAUS=0 STIF 26
C
C*** LOOP OVER EACH ELEMENT STIF 27
C
NSTR1=4 STIF 28
NEVAB=NDOFN*NNODE STIF 29
DO 500 IWKTL=1,NWKTL STIF 30
500 STIFF(IWKTL) ,STIFI(IWKTL)=0.0 STIF 31
STIF 32
STIF 33
STIF 34
```
```csv
DO 70 IELEM=1,NELEM
LPROP=MATNO(IELEM)
C
C*** EVALUATE THE COORDINATES OF THE ELEMENT NODAL POINTS
C
IPOSN=0
DO 10 INODE=1,NNODE
LNODE=LNODS(IELEM,INODE)
DO 10 IDIME=1,NDIME
IPOSN=IPOSN+1
NPOSN=LEQNS(IPOSN,IELEM)
IF(NPOSN.EQ.0) DISPT=0.
IF(NPOSN.NE.0) DISPT=TDISP(NPOSN)
DLCOD(IDIME,INODE)=COORD(LNODE,IDIME)+DISPT
10 ELCOD(IDIME,INODE)=COORD(LNODE,IDIME)
YOUNG=PROPS(LPROP, 1)
POISS=PROPS(LPROP, 2)
THICK=PROPS(LPROP, 3)
HARDS=PROPS(LPROP, 7)
FRICT=PROPS(LPROP, 8)
C
C*** INITIALIZE THE ELEMENT STIFFNESS MATRIX 171=NEVAB*(NEVAB+1)/2
C
DO 20 ISIZE=1,171
20 ESTIF(ISIZE)=0.0
KGASP=0
C
C*** ENTER LOOPS FOR AREA NUMERICAL INTEGRATION
C
DO 50 IGAUS=1,NGAUS
EXISP=POSGP(IGAUS)
DO 50 JGAUS=1,NGAUS
ETASP=POSGP(JGAUS)
KGASP=KGASP+1
KGAUS=KGAUS+1
CALL MODPS (DMATX,LPROP,NMATS,NSTRE,NTYPE,PROPS)
CALL SFR2 (DERIV,NNODE,SHAPE,EXISP,ETASP)
CALL JACOB2 (CARTD,DERIV,DJACB,ELCOD,GPCOD,
IELEM,KGASP,NNODE,SHAPE)
CALL JACOBD (CARTD,DLCOD,DJACM,NDIME,NLAPS,NNODE)
DVOLU=DJACB*WEIGP(IGAUS)*WEIGP(JGAUS)
IF(NTYPE.EQ.3) DVOLU=DVOLU*TWOPI*GPCOD(1,KGASP)
IF(NTYPE.EQ.1) DVOLU=DVOLU*THICK
C
C*** EVALUATE THE B AND DB MATRICES
C
CALL BLARGE (BMATX,CARTD,DJACM,DLCOD,GPCOD,
KGASP,NLAPS,NNODE,NTYPE,SHAPE)
IF(NLAPS.EQ.2.OR.NLAPS.EQ.0) GO TO 80
IF(ISSTEP.EQ.1) GO TO 80
IF(EPSTN(KGAUS).EQ.0.0) GO TO 80
DO 90 ISTR1=1,NSTR1
90 STRES(ISTR1)=STRSG(ISTR1,KGAUS)
CALL INVAR (DEVIA,LPROP,NCRIT,NMATS,PROPS,SINT3,STEFF,
STRES,THETA,VARJ2,YIELD)
CALL YIELDF (AVECT,DEVIA,FRICT,NCRIT,SINT3,STEFF,
THETA,VARJ2)
CALL FLOWPL (AVECT,ABETA,DVECT,HARDS,NTYPE,POISS,YOUNG)
DO 100 ISTRE=1,NSTRE
DO 100 JSTRE=1,NSTRE
100 DMAIX(ISTRE,JSTRE)=DMATX(ISTRE,JSTRE)-ABETA*DVECT(ISTRE)
DVECT(JSTRE)
80 CONTINUE
CALL DINTOB (BMATX,DBMAT,DMATX,NEVAB,NSTRE)
```
```csv
C STIF 99
C ***EVALUATE GEOMETRIC STIFFNESS TERMS STIF 100
C STIF 101
IF(NLAPS.LT.2) GO TO 85 STIF 102
CALL GEOMST (CARTD,DVOLU,ESTIF,KGAUS,NDOFN,NNODE, STIF 103
STRSG,SHAPE,NTYPE,GPCOD,KGASP) STIF 104
C STIF 105
C*** CALCULATE THE ELEMENT STIFFNESSES STIF 106
C STIF 107
85 KOUNT=0 STIF 108
DO 30 IEVAB=1,NEVAB STIF 109
DO 30 JEVAB=IEVAB,NEVAB STIF 110
KOUNT=KOUNT+1 STIF 111
DO 30 ISTRE=1,NSTRE STIF 112
30 ESTIF(KOUNT)=ESTIF(KOUNT)+BMATX(ISTRE,IEVAB)* STIF 113
DBMAT(ISTRE,JEVAB)*DVOLU STIF 114
50 CONTINUE STIF 115
C STIF 116
C *** GENERATES GLOBAL STIFFNSS MATRIX IN COMPACTED COLUMN FORM STIF 117
C STIF 118
IF(INTGR(IELEM).EQ.2) GO TO 210 STIF 119
CALL ADDBAN (STIFI,MAXAI,ESTIF,LEQNS(1,IELEM),NEVAB) STIF 120
210 CALL ADDBAN (STIFF,MAXAJ,ESTIF,LEQNS(1,IELEM),NEVAB) STIF 121
70 CONTINUE STIF 122
C WRITE(6,900) (STIFI(I),I=1,NWMTL) STIF 123
900 FORMAT(10E12.4) STIF 124
RETURN STIF 125
END STIF 126
```
# 11.5.10 Subroutine IMPEXP
This routine generates the partial effective load vector for direct time integration.
```asm
SUBROUTINE IMPEXP (AALFA, ACCEH, ACCEI, ACCEJ, ACCEK, ACCEL, IMEX 1
ACCEV, AFACT, AZERO, BEETA, BZERO, CONSD, IMEX 2
CONSF, DAMPI, DAMPG, DELTA, DISPI, DISPL, IMEX 3
DISPT, DTEND, DTIME, GAAMA, IFIXD, IFPRE, IMEX 4
IFUNC, IITER, ISTEP, KSTEP, MAXAI, MAXAJ, IMEX 5
NDOFN, NSIZE, NPOIN, NWKTL, NWMTL, OMEGA, IMEX 6
RLOAD, STIFF, STIFI, STIFS, VELOI, VELOL, IMEX 7
VELOT, XMASS, YMASS, IPRED) IMEX 8
C*************** IMEX 9
C
C *** GENERATES PARTIAL EFFECTIVE LOAD VECTOR IMEX 10
C
C*************** IMEX 11
C
DIMENSION STIFF(1), DISPI(1), ACCEH(1), DISPL(1), IFPRE(2,1), IMEX 12
XMASS(1), VELOI(1), ACCEV(1), VELOL(1), ACCEK(1), IMEX 13
RLOAD(1), ACCEI(1), MAXAI(1), ACCEL(1), DAMPG(1), IMEX 14
ACCEJ(1), MAXAJ(1), YMASS(1), STIFI(1), DISPT(1), IMEX 15
STIFS(1), DAMPI(1), VELOT(1) IMEX 16
C
C
C
IF(ISTEP.GT.1.OR.IITER.GT.1) GO TO 1000 IMEX 17
CONSA-DTIME*DTIME*(0.5-DELTA) IMEX 18
CONSB-DTIME*(1.-GAAMA) IMEX 19
CONSC-DTIME*DTIME*DELTA IMEX 20
CONSD-DTIME*GAAMA IMEX 21
CONSF=1./CONSC IMEX 22
CONSG-BEETA*GAAMA*DTIME IMEX 23
CONSH-AALFA*GAAMA*DTIME IMEX 24
CONSE=1.+CONSH IMEX 25
IMEX 26
IMEX 27
IMEX 28
IMEX 29
IMEX 30
```
```txt
ISHOT=0 IMEX 31
DO 550 IPOIN=1,NPOIN IMEX 32
DO 550 IDOFN=1,NDOFN IMEX 33
ISIZE=IFPRE(IDOFN,IPOIN) IMEX 34
IF(ISIZE.EQ.0) GO TO 550 IMEX 35
ACCEI(ISIZE)=1.0 IMEX 36
ACCEL(ISIZE)=0.0 IMEX 37
IF(IDOFN.EQ.1) GO TO 550 IMEX 38
ACCEI(ISIZE)=0.0 IMEX 39
ACCEL(ISIZE)=1.0 IMEX 40
550 CONTINUE IMEX 41
DO 590 ISIZE=1,NSIZE IMEX 42
IMAXA=MAXAI(ISIZE) IMEX 43
590 XMASS(IMAXA)=XMASS(IMAXA)+YMASS(ISIZE) IMEX 44
C IMEX 45
C *** CALCULATES VECTORS FOR HORIZONTAL AND VERTICAL EXCITATION IMEX 46
C IMEX 47
CALL MULTPY (ACCEK,XMASS,ACCEL,MAXAI,NSIZE,NWMTL) IMEX 48
CALL MULTPY (ACCEJ,XMASS,ACCEI,MAXAI,NSIZE,NWMTL) IMEX 49
CALL MULTPY (DISPL,STIFF,DISPI,MAXAJ,NSIZE,NWKT L) IMEX 50
C IMEX 51
C *** CALCULATES DAMPING MATRIX (AALFA*M+BEETA*K) IMEX 52
C IMEX 53
DO 500 ISIZE=1,NSIZE IMEX 54
IMAXA=MAXAI(ISIZE) IMEX 55
KMAXA=MAXAI(ISIZE+1)-1 IMEX 56
JMAXA=MAXAJ(ISIZE) IMEX 57
DO 500 LMAXA=IMAXA,KMAXA IMEX 58
DAMPI(JMAXA)=AALFA*XMASS(LMAXA) IMEX 59
500 JMAXA=JMAXA+1 IMEX 60
DO 560 IWKTL=1,NWKTL IMEX 61
560 DAMPI(IWKTL)=DAMPI(IWKTL)+BEETA*STIFF(IWKTL) IMEX 62
C IMEX 63
C *** CALCULATES INITIAL ACCELERATION IMEX 64
C IMEX 65
CALL MULTPY (VELOL,DAMPI,VELOI,MAXAJ,NSIZE,NWKTL) IMEX 66
DO 600 IWMTL=1,NWMTL IMEX 67
600 DAMPG(IWMTL)=XMASS(IWMTL) IMEX 68
DO 510 ISIZE = 1,NSIZE IMEX 69
510 ACCEI(ISIZE)=RLOAD(ISIZE)-DISPL(ISIZE)-VELOL(ISIZE) IMEX 70
CALL DECOMP (DAMPG,MAXAI,NSIZE,ISHOT) IMEX 71
CALL REDBAK (DAMPG,ACCEI,MAXAI,NSIZE) IMEX 72
WRITE (6,900) IMEX 73
WRITE (6,910) (ACCEI(ISIZE),ISIZE=1,NSIZE) IMEX 74
900 FORMAT(/' INITIAL ACCELERATION '/') IMEX 75
910 FORMAT(1X,10E12.5) IMEX 76
1000 CONTINUE IMEX 77
IF(IITER.GT.1) GO TO 650 IMEX 78
C IMEX 79
C *** CALCULATES PREDICTED DISPLACEMENT AND VELOCITY VECTOR IMEX 80
C IMEX 81
DO 540 ISIZE=1,NSIZE IMEX 82
IF(IPRED.EQ.1) GO TO 210 IMEX 83
DISPT(ISIZE)=DISPI(ISIZE) IMEX 84
VELOT(ISIZE)=VELOI(ISIZE) IMEX 85
210 DISPI(ISIZE)=DISPI(ISIZE)+DTIME*VELOI(ISIZE)+CONSA*ACCEI(ISIZE) IMEX 86
VELOI(ISIZE)=VELOI(ISIZE)+CONSB*ACCEI(ISIZE) IMEX 87
IF(IPRED.EQ.2) GO TO 220 IMEX 88
DISPT(ISIZE)=DISPI(ISIZE) IMEX 89
VELOT(ISIZE)=VELOI(ISIZE) IMEX 90
220 ACCEI(ISIZE)=CONSF*(DISPT(ISIZE)-DISPI(ISIZE)) IMEX 91
540 CONTINUE IMEX 92
C IMEX 93
C*** CALCULATES LOAD VECTORS IMEX 94
```