# 6.4.7 Subroutine BMATPS for evaluating the strain matrix B for plane and axisymmetric situations The function of this subroutine is to evaluate the strain matrix B at any position within an element. The relevant expressions are given in Table 6.1. The B matrix is stored in array BMATX ( ). ```txt SUBROUTINE BMATPS(BMATX,CARTD,NNODE,SHAPE,GPCOD,NTYPE,KGASP) BMPS 1 C*************** BMPS 2 C BMPS 3 C**** THIS SUBROUTINE EVALUATES THE STRAIN-DISPLACEMENT MATRIX BMPS 4 C BMPS 5 C*************** BMPS 6 DIMENSION BMATX(4,18),CARTD(2,9),SHAPE(9),GPCOD(2,9) BMPS 7 NGASH=0 BMPS 8 DO 10 INODE=1,NNODE BMPS 9 MGASH=NGASH+1 BMPS 10 NGASH=MGASH+1 BMPS 11 BMATX(1,MGASH)=CARTD(1,INODE) BMPS 12 BMATX(1,NGASH)=0.0 BMPS 13 BMATX(2,MGASH)=0.0 BMPS 14 BMATX(2,NGASH)=CARTD(2,INODE) BMPS 15 BMATX(3,MGASH)=CARTD(2,INODE) BMPS 16 BMATX(3,NGASH)=CARTD(1,INODE) BMPS 17 IF(NTYPE.NE.3) GO TO 10 BMPS 18 BMATX(4,MGASH)=SHAPE(INODE)/GPCOD(1,KGASP) BMPS 19 BMATX(4,NGASH)=0.0 BMPS 20 10 CONTINUE BMPS 21 RETURN BMPS 22 END BMPS 23 ``` # 6.4.8 Subroutine BMATPB for evaluating the strain matrix B for plate bending problems This subroutine evaluates the strain matrix B within any point of an element for plate bending applications according to Table 6.1. The B matrix is partitioned into plane, BPLAN, flexural, BFLEX, and shear, BSHER, contributions. ```csv SUBROUTINE BMATPB (BFLEX,BPLAN,BSHER,CARTD,KNODE,SHAPE, BMAT 1 IFPLA,IFFLE,IFSHE) BMAT 2 C********** BMAT 3 C BMAT 4 C*** EVALUATES STRAIN-DISPLACEMENT MATRIX FOR BMAT 5 C*** MINDLIN PLATE BMAT 6 C BMAT 7 C********** BMAT 8 DIMENSION BFLEX(3,3),BPLAN(3,2),BSHER(2,3), BMAT 9 CARTD(2,9),SHAPE(9) BMAT 10 DNKDX=CARTD(1,KNODE) BMAT 11 DNKDY=CARTD(2,KNODE) BMAT 12 C*** FORM BPLAN BMAT 13 IF(IFPLA.EQ.0) GO TO 10 BMAT 14 DO 1 IROWS=1,3 BMAT 15 DO 1 JCOLS=1,2 BMAT 16 1 BPLAN(IROWS,JCOLS)=0.0 BMAT 17 BPLAN(1,1)=DNKDX BMAT 18 BPLAN(2,2)=DNKDY BMAT 19 BPLAN(3,1)=DNKDY BMAT 20 BPLAN(3,2)=DNKDX BMAT 21 ```
C*** FORM BFLEXBMAT22
10 IF(IFFLE.EQ.0) GO TO 20BMAT23
DO 2 IROWS=1,3BMAT24
DO 2 JCOLS=1,3BMAT25
2 BFLEX(IROWS,JCOLS)=0.0BMAT26
BFLEX(1,2)=-DNKDXBMAT27
BFLEX(2,3)=-DNKDYBMAT28
BFLEX(3,2)=-DNKDYBMAT29
BFLEX(3,3)=-DNKDXBMAT30
C*** FORM BSHERBMAT31
20 IF(IFSHE.EQ.0) RETURNBMAT32
DO 3 IROWS=1,2BMAT33
DO 3 JCOLS=1,3BMAT34
3 BSHER(IROWS,JCOLS)=0.0BMAT35
BSHER(1,1)=DNKDXBMAT36
BSHER(1,2)=-SHAPE(KNODE)BMAT37
BSHER(2,1)=DNKDYBMAT38
BSHER(2,3)=-SHAPE(KNODE)BMAT39
RETURNBMAT40
ENDBMAT41
# 6.4.9 Subroutine MODPS for evaluating the $D$ matrix for plane and axisymmetric situations This subroutine simply evaluates the elasticity matrix D for either plane stress, plane strain or axisymmetric situations according to (6.7), (6.16) or (6.24) respectively. The D matrix is stored in the array DMATX(). ```csv SUBROUTINE MODPS(DMATX,LPROP,MMATS,NTYPE,PROPS) MDPS 1 C***** C C**** C C C***** DIMENSION DMATX(4,4),PROPS(MMATS,7) MDPS 7 YOUNG=PROPS(LPROP,1) MDPS 8 POISS=PROPS(LPROP,2) MDPS 9 DO 10 ISTR1=1,4 MDPS 10 DO 10 JSTR1=1,4 MDPS 11 10 DMATX(ISTR1,JSTR1)=0.0 MDPS 12 IF(NTYPE.NE.1) GO TO 4 MDPS 13 C C**** C C CONST=YOUNG/(1.0-POISS*POISS) MDPS 17 DMATX(1,1)=CONST MDPS 18 DMATX(2,2)=CONST MDPS 19 DMATX(1,2)=CONST*POISS MDPS 20 DMATX(2,1)=CONST*POISS MDPS 21 DMATX(3,3)=(1.0-POISS)*CONST/2.0 MDPS 22 RETURN MDPS 23 4 IF(NTYPE.NE.2) GO TO 6 MDPS 24 C C**** C C CONST=YOUNG*(1.0-POISS)/((1.0+POISS)*(1.0-2.0*POISS)) MDPS 28 DMATX(1,1)=CONST MDPS 29 DMATX(2,2)=CONST MDPS 30 DMATX(1,2)=CONST*POISS/(1.0-POISS) MDPS 31 DMATX(2,1)=CONST*POISS/(1.0-POISS) MDPS 32 ``` ```asm DMATX(3,3)=(1.0-2.0*POISS)*CONST/(2.0*(1.0-POISS)) MDPS 33 RETURN MDPS 34 6 IF(NTYPE.NE.3) GO TO 8 MDPS 35 C MDPS 36 C*** D MATRIX FOR AXISYMMETRIC CASE MDPS 37 C CONST=YOUNG*(1.0-POISS)/((1.0+POISS)*(1.0-2.0*POISS)) MDPS 38 CONSS=POISS/(1.0-POISS) MDPS 39 DMATX(1,1)=CONST MDPS 40 DMATX(2,2)=CONST MDPS 41 DMATX(3,3)=CONST*(1.0-2.0*POISS)/(2.0*(1.0-POISS)) MDPS 42 DMATX(1,2)=CONST*CONSS MDPS 43 DMATX(1,4)=CONST*CONSS MDPS 44 DMATX(2,1)=CONST*CONSS MDPS 45 DMATX(2,4)=CONST*CONSS MDPS 46 DMATX(4,1)=CONST*CONSS MDPS 47 DMATX(4,2)=CONST*CONSS MDPS 48 DMATX(4,4)=CONST MDPS 49 8 CONTINUE MDPS 50 RETURN MDPS 51 END MDPS 52 MDPS 53 ``` # 6.4.10 Subroutine MODPB for evaluating the D matrix for plate bending applications This subroutine evaluates the elasticity matrix D for plate bending situations according to (6.35). Again the result is partitioned into plane, DPLAN, flexural, DFLEX, and shear, DSHER, contributions. ```txt SUBROUTINE MODPB (DFLEX, DPLAN, DSHER, LPROP, MMATS, PROPS, IFPLA, IFFLE, IFSHE) MODP 1 C*************** MODP 2 C C*** CALCULATES MATRIX OF ELASTIC RIGIDITIES MODP 3 C*** FOR MINDLIN PLATE MODP 4 C C*************** MODP 5 DIMENSION DFLEX(3,3), DPLAN(3,3), DSHER(2,2), MODP 6 PROPS(MMATS,8) MODP 7 YOUNG=PROPS(LPROP,1) MODP 8 POISS=PROPS(LPROP,2) MODP 9 THICK=PROPS(LPROP,3) MODP 10 C*** FORM DPLAN MODP 11 IF(IFPLA.EQ.0) GO TO 10 MODP 12 DO 1 IROWS=1,3 MODP 13 DO 1 JCOLS=1,3 MODP 14 1 DPLAN(IROWS, JCOLS)=0.0 MODP 15 CONST=(YOUNG*THICK)/(1.0-POISS*POISS) MODP 16 DPLAN(1,1)=CONST MODP 17 DPLAN(2,2)=CONST MODP 18 DPLAN(1,2)=CONST*POISS MODP 19 DPLAN(2,1)=CONST*POISS MODP 20 DPLAN(3,3)=CONST*(1.0-POISS)/2.0 MODP 21 C*** FORM DFLEX MODP 22 10 IF(IFFLE.EQ.0) GOTO 20 MODP 23 DO 2 IROWS=1,3 MODP 24 DO 2 JCOLS=1,3 MODP 25 2 DFLEX(IROWS, JCOLS)=0.0 MODP 26 CONST=(YOUNG*THICK**3)/(12.*(1.-POISS*POISS)) MODP 27 DFLEX(1,1)=CONST MODP 28 DFLEX(2,2)=CONST MODP 29 DFLEX(1,2)=CONST*POISS MODP 30 DFLEX(1,2)=CONST*POISS MODP 31 DFLEX(1,2)=CONST*POISS MODP 32 DFLEX(1,2)=CONST*POISS MODP 33 ``` ```csv DFLEX(2,1)=CONST*POISS DFLEX(3,3)=CONST*(1.-POISS)/2. C*** FORM DSHER 20 IF(IFSHE.EQ.0) RETURN DO 3 IROWS=1,2 DO 3 JCOLS=1,2 3 DSHER(IROWS,JCOLS)=0.0 DSHER(1,1)=(YOUNG*THICK)/(2.4+2.4*POISS) DSHER(2,2)=(YOUNG*THICK)/(2.4+2.4*POISS) RETURN END MODP 34 MODP 35 MODP 36 MODP 37 MODP 38 MODP 39 MODP 40 MODP 41 MODP 42 MODP 43 MODP 44 ``` # 6.4.11 Subroutine DBE for formulating the matrix product DB This subroutine simply multiplies the elasticity matrix D by the strain matrix B. ```fortran SUBROUTINE DBE(BMATX,DBMAT,DMATX,MEVAB,NEVAB,NSTRE,NSTR1) DBYB 1 C******************************* C C**** THIS SUBROUTINE MULTIPLIES THE D-MATRIX BY THE B-MATRIX DBYB 4 C C******************************* DIMENSION BMATX(NSTR1,MEVAB),DBMAT(NSTR1,MEVAB), DBYB 7 . DMATX(NSTR1,NSTR1) DBYB 8 DO 2 ISTRE=1,NSTRE DBYB 9 DO 2 IEVAB=1,NEVAB DBYB 10 DBMAT(ISTRE,IEVAB)=0.0 DBYB 11 DO 2 JSTRE=1,NSTRE DBYB 12 DBMAT(ISTRE,IEVAB)=DBMAT(ISTRE,IEVAB)+ .DMATX(ISTRE,JSTRE)*BMATX(JSTRE,IEVAB) DBYB 13 2 CONTINUE DBYB 14 RETURN DBYB 15 END DBYB 16 ``` # 6.4.12 Subroutine FRONT for equation solution by the frontal method The function of this subroutine is to assemble the contributions from each element to form the global stiffness matrix and global load vector and to solve the resulting set of simultaneous equations by Gaussian direct elimination. The main feature of the frontal solution technique is that it assembles the equations and eliminates the variables at the same time. Complete details of the frontal process can be found in Chapter 8, Ref. 4. The subroutine presented in Ref. 4 differs from the one listed in this section in three important ways: \- As described in Sections 3.3 and 3.4 for one-dimensional problems, a full equation solution need only be undertaken for iterations during which the element stiffnesses are being modified. Such a situation is recognised by the resolution counter KRESL = 1. On the other hand if the element stiffnesses have not been changed during the iteration, signified by KRESL = 2, only the R.H.S. or load terms need be reduced during the elimination phase. This situation is identical to the case of solution for second and subsequent loading cases in elastic problems. \- The reduced equations corresponding to eliminated variables are stored in core in a temporary array termed a buffer area. As soon as this array is full, the information is then transferred to disc. The number of reduced equations that can be accommodated in the buffer area is governed by the specified parameter, MBUFA. Thus on elimination of a variable a counter over the number of eliminated variables is incremented by one and the reduced equations stored in core. The counter is checked against the permissible buffer length, MBUFA. If this has been reached, the buffer array is transferred to disc file and the counter reset to zero. On back-substitution the contents of a complete buffer length are read from discfile by backspacing. \- The displacement and reaction values evaluated by subroutine FRONT during each iteration are incremental values and must be accumulated to give the total displacements, TDISP ( ) and total reactions, TREAC ( ). Also the incremental reactions must be added into the vector of total applied loads, TLOAD ( ), in order to check for convergence of the iteration process; since equilibrium is satisfied when the applied loads and reactions at restrained nodes balance with the nodal forces equivalent to the internal stress field. The displacements and reactions evaluated in Subroutine FRONT are stored for output by Subroutine OUTPUT described in Section 7.8.8. ```csv SUBROUTINE FRONT(ASDIS,ELOAD,EQRHS,EQUAT,ESTIF,FIXED,IFFIX,IINCS, FRNT 1 . IITER,GLOAD,GSTIF,LOCEL,LNODS,KRESL,MBUFA,MELEM, FRNT 2 . MEVAB,MFRON,MSTIF,MTOTV,MVFIX,NACVA,NAMEV,NDEST, FRNT 3 . NDOFN,NELEM,NEVAB,NNODE,NOFIX,NPIVO,NPOIN, FRNT 4 . NTOTV,TDISP,TLOAD,TREAC,VECRV) FRNT 5 C************************** FRNT 6 C C**** THIS SUBROUTINE UNDERTAKES EQUATION SOLUTION BY THE FRONTAL FRNT 7 C METHOD FRNT 8 C C************************** FRNT 9 C DIMENSION ASDIS(MTOTV),ELOAD(MELEM,MEVAB),EQRHS(MBUFA), FRNT 10 . EQUAT(MFRON,MBUFA),ESTIF(MEVAB,MEVAB),FIXED(MTOTV), FRNT 11 . IFFIX(MTOTV),NPIVO(MBUFA),VECRV(MFRON),GLOAD(MFRON), FRNT 12 . GSTIF(MSTIF),LNODS(MELEM,9),LOCEL(MEVAB),NACVA(MFRON), FRNT 13 . NAMEV(MBUFA),NDEST(MEVAB),NOFIX(MVFIX),NOUTP(2), FRNT 14 . TDISP(MTOTV),TLOAD(MELEM,MEVAB),TREAC(MVFIX,NDOFN) FRNT 15 NFUNC(I,J)=(J*J-J)/2+I FRNT 16 C C*** CHANGE THE SIGN OF THE LAST APPEARANCE OF EACH NODE FRNT 17 C IF(IINCS.GT.1.OR.IITER.GT.1) GO TO 455 FRNT 18 DO 140 IPOIN=1,NPOIN FRNT 19 KLAST=0 FRNT 20 DO 130 IELEM=1,NELEM FRNT 21 DO 120 INODE=1,NNODE FRNT 22 IF(LNODS(IELEM,INODE).NE.IPOIN) GO TO 23 FRNT 23 KLAST=IELEM FRNT 24 NLAST=INODE FRNT 25 120 CONTINUE FRNT 26 FRNT 27 FRNT 28 FRNT 29 FRNT 30 ``` ```txt 130 CONTINUE IF(KLAST.NE.0) LNODS(KLAST,NLAST)=-IPOIN 140 CONTINUE 455 CONTINUE C C*** START BY INITIALIZING EVERYTHING THAT MATTERS TO ZERO C DO 450 IBUFA=1,MBUFA 450 EQRHS(IBUFA)=0.0 DO 150 ISTIF=1,MSTIF 150 GSTIF(ISTIF)=0.0 DO 160 IFRON=1,MFRON GLOAD(IFRON)=0.0 VECRV(IFRON)=0.0 NACVA(IFRON)=0 DO 160 IBUFA=1,MBUFA 160 EQUAT(IFRON,IBUFA)=0.0 C C*** AND PREPARE FOR DISC READING AND WRITING OPERATIONS C NBUFA=0 IF(KRESL.GT.1) NBUFA=MBUFA REWIND 1 REWIND 2 REWIND 3 REWIND 4 REWIND 8 C C*** ENTER MAIN ELEMENT ASSEMBLY-REDUCTION LOOP C NFRON=0 KELVA=0 DO 320 IELEM=1,NELEM IF(KRESL.GT.1) GO TO 400 KEVAB=0 READ(1) ESTIF DO 170 INODE=1,NNODE DO 170 IDOFN=1,NDOFN NPOSI=(INODE-1)*NDOFN+IDOFN LOCNO=LNODS(IELEM,INODE) IF(LOCNO.GT.0) LOCEL(NPOSI)=(LOCNO-1)*NDOFN+IDOFN IF(LOCNO.LT.0) LOCEL(NPOSI)=(LOCNO+1)*NDOFN-IDOFN 170 CONTINUE C C*** START BY LOOKING FOR EXISTING DESTINATIONS C DO 210 IEVAB=1,NEVAB NIKNO=IABS(LOCEL(IEVAB)) KEXIS=0 DO 180 IFRON=1,NFRON IF(NIKNO.NE.NACVA(IFRON)) GO TO 180 KEVAB=KEVAB+1 KEXIS=1 NDEST(KEVAB)=IFRON 180 CONTINUE IF(KEXIS.NE.0) GO TO 210 C C*** WE NOW SEEK NEW EMPTY PLACES FOR DESTINATION VECTOR C DO 190 IFRON=1,MFRON IF(NACVA(IFRON).NE.0) GO TO 190 NACVA(IFRON)=NIKNO KEVAB=KEVAB+1 NDEST(KEVAB)=IFRON GO TO 200 FRNT 31 FRNT 32 FRNT 33 FRNT 34 FRNT 35 FRNT 36 FRNT 37 FRNT 38 FRNT 39 FRNT 40 FRNT 41 FRNT 42 FRNT 43 FRNT 44 FRNT 45 FRNT 46 FRNT 47 FRNT 48 FRNT 49 FRNT 50 FRNT 51 FRNT 52 FRNT 53 FRNT 54 FRNT 55 FRNT 56 FRNT 57 FRNT 58 FRNT 59 FRNT 60 FRNT 61 FRNT 62 FRNT 63 FRNT 64 FRNT 65 FRNT 66 FRNT 67 FRNT 68 FRNT 69 FRNT 70 FRNT 71 FRNT 72 FRNT 73 FRNT 74 FRNT 75 FRNT 76 FRNT 77 FRNT 78 FRNT 79 FRNT 80 FRNT 81 FRNT 82 FRNT 83 FRNT 84 FRNT 85 FRNT 86 FRNT 87 FRNT 88 FRNT 89 FRNT 90 FRNT 91 FRNT 92 FRNT 93 FRNT 94 FRNT 95 ``` ```txt 190 CONTINUE FRNT 96 C FRNT 97 C*** THE NEW PLACES MAY DEMAND AN INCREASE IN CURRENT FRONTWIDTH FRNT 98 C FRNT 99 200 IF(NDEST(KEVAB).GT.NFRON) NFRON=NDEST(KEVAB) FRNT 100 210 CONTINUE FRNT 101 WRITE(8) LOCEL,NDEST,NACVA,NFRON FRNT 102 400 IF(KRESL.GT.1) READ(8) LOCEL,NDEST,NACVA,NFRON FRNT 103 C FRNT 104 C*** ASSEMBLE ELEMENT LOADS FRNT 105 C FRNT 106 DO 220 IEVAB=1,NEVAB FRNT 107 IDEST=NDEST(IEVAB) FRNT 108 GLOAD(IDEST)=GLOAD(IDEST)+ELOAD(IELEM,IEVAB) FRNT 109 C FRNT 110 C*** ASSEMBLE THE ELEMENT STIFFNESSES-BUT NOT IN RESOLUTION FRNT 111 C FRNT 112 IF(KRESL.GT.1) GO TO 402 FRNT 113 DO 222 JEVAB=1,IEVAB FRNT 114 JDEST=NDEST(JEVAB) FRNT 115 NGASH=NFUNC(IDEST,JDEST) FRNT 116 NGISH=NFUNC(JDEST,IDEST) FRNT 117 IF(JDEST.GE.IDEST) GSTIF(NGASH)=GSTIF(NGASH)+ESTIF(IEVAB,JEVAB) FRNT 118 IF(JDEST.LT.IDEST) GSTIF(NGISH)=GSTIF(NGISH)+ESTIF(IEVAB,JEVAB) FRNT 119 222 CONTINUE FRNT 120 402 CONTINUE FRNT 121 220 CONTINUE FRNT 122 C FRNT 123 C*** RE-EXAMINE EACH ELEMENT NODE, TO ENQUIRE WHICH CAN BE ELIMINATED FRNT 124 C FRNT 125 DO 310 IEVAB=1,NEVAB FRNT 126 NIKNO=-LOCEL(IEVAB) FRNT 127 IF(NIKNO.LE.0) GO TO 310 FRNT 128 C FRNT 129 C*** FIND POSITIONS OF VARIABLES READY FOR ELIMINATION FRNT 130 C FRNT 131 DO 300 IFRON=1,NFRON FRNT 132 IF(NACVA(IFRON).NE.NIKNO) GO TO 300 FRNT 133 NBUFA=NBUFA+1 FRNT 134 C FRNT 135 C*** WRITE EQUATIONS TO DISC OR TO TAPE FRNT 136 C FRNT 137 IF(NBUFA.LE.MBUFA) GO TO 406 FRNT 138 NBUFA=1 FRNT 139 IF(KRESL.GT.1) GO TO 408 FRNT 140 WRITE(2) EQUAT,EQRHS,NPIVO,NAMEV FRNT 141 GO TO 406 FRNT 142 408 WRITE(4) EQRHS FRNT 143 READ(2) EQUAT,EQRHS,NPIVO,NAMEV FRNT 144 406 CONTINUE FRNT 145 C FRNT 146 C*** EXTRACT THE COEFFICIENTS OF THE NEW EQUATION FOR ELIMINATION FRNT 147 C FRNT 148 IF(KRESL.GT.1) GO TO 404 FRNT 149 DO 230 JFRON=1,MFRON FRNT 150 IF(IFRON.LT.JFRON) NLOCA=NFUNC(IFRON,JFRON) FRNT 151 IF(IFRON.GE.JFRON) NLOCA=NFUNC(JFRON,IFRON) FRNT 152 EQUAT(JFRON,NBUFA)=GSTIF(NLOCA) FRNT 153 230 GSTIF(NLOCA)=0.0 FRNT 154 404 CONTINUE FRNT 155 C FRNT 156 C*** AND EXTRACT THE CORRESPONDING RIGHT HAND SIDES FRNT 157 C FRNT 158 EQRHS(NBUFA)=GLOAD(IFRON) FRNT 159 GLOAD(IFRON)=0.0 FRNT 160 ``` ```csv KELVA=KELVA+1 FRNT 161 NAMEV(NBUFA)=NIKNO FRNT 162 NPIVO(NBUFA)=IFRON FRNT 163 C FRNT 164 C*** DEAL WITH PIVOT FRNT 165 C FRNT 166 PIVOT=EQUAT(IFRON,NBUFA) FRNT 167 IF(PIVOT.GT.0.0) GO TO 235 FRNT 168 WRITE(6,900) NIKNO,PIVOT FRNT 169 900 FORMAT(1H0,3X,52HNEGATIVE OR ZERO PIVOT ENCOUNTERED FOR VARIABLE NFRNT 170 .O.,14,10H OF VALUE,E17.6) FRNT 171 STOP FRNT 172 235 CONTINUE FRNT 173 EQUAT(IFRON,NBUFA)=0.0 FRNT 174 C FRNT 175 C*** ENQUIRE WHETHER PRESENT VARIABLE IS FREE OR PRESCRIBED FRNT 176 C FRNT 177 IF(IFFIX(NIKNO).EQ.0) GO TO 250 FRNT 178 C FRNT 179 C*** DEAL WITH A PRESCRIBED DEFLECTION FRNT 180 C FRNT 181 DO 240 JFRON=1,NFRON FRNT 182 240 GLOAD(JFRON)=GLOAD(JFRON)-FIXED(NIKNO)*EQUAT(JFRON,NBUFA) FRNT 183 GO TO 280 FRNT 184 C FRNT 185 C*** ELIMINATE A FREE VARIABLE - DEAL WITH THE RIGHT HAND SIDE FIRST FRNT 186 C FRNT 187 250 DO 270 JFRON=1,NFRON FRNT 188 GLOAD(JFRON)=GLOAD(JFRON)-EQUAT(JFRON,NBUFA)*EQRHS(NBUFA)/PIVOT FRNT 189 C FRNT 190 C*** NOW DEAL WITH THE COEFFICIENTS IN CORE FRNT 191 C FRNT 192 IF(KRESL.GT.1) GO TO 418 FRNT 193 IF(EQUAT(JFRON,NBUFA).EQ.0.0) GO TO 270 FRNT 194 NLOCA=NFUNC(0,JFRON) FRNT 195 CUREQ=EQUAT(JFRON,NBUFA) FRNT 196 DO 260 LFRON=1,JFRON FRNT 197 NGASH=LFRON+NLOCA FRNT 198 260 GSTIF(NGASH)=GSTIF(NGASH)-CUREQ*EQUAT(LFRON,NBUFA) FRNT 199 ./PIVOT FRNT 200 418 CONTINUE FRNT 201 270 CONTINUE FRNT 202 280 EQUAT(IFRON,NBUFA)=PIVOT FRNT 203 C FRNT 204 C*** RECORD THE NEW VACANT SPACE, AND REDUCE FRONTWIDTH IF POSSIBLE FRNT 205 C FRNT 206 NACVA(IFRON)=0 FRNT 207 GO TO 290 FRNT 208 C FRNT 209 C*** COMPLETE THE ELEMENT LOOP IN THE FORWARD ELIMINATION FRNT 210 C FRNT 211 300 CONTINUE FRNT 212 290 IF(NACVA(NFRON).NE.0) GO TO 310 FRNT 213 NFRON=NFRON-1 FRNT 214 IF(NFRON.GT.0) GO TO 290 FRNT 215 310 CONTINUE FRNT 216 320 CONTINUE FRNT 217 IF(KRESL.EQ.1) WRITE(2) EQUAT,EQRHS,NPIVO,NAMEV FRNT 218 BACKSPACE 2 FRNT 219 C FRNT 220 C*** ENTER BACK-SUBSTITUTION PHASE. LOOP BACKWARDS THROUGH VARIABLES FRNT 221 C FRNT 222 DO 340 IELVA=1,KELVA FRNT 223 C FRNT 224 C***READ A NEW BLOCK OF EQUATIONS - IF NEEDED FRNT 225 ``` ```csv C IF(NBUFA.NE.0) GO TO 412 BACKSPACE 2 READ(2) EQUAT,EQRHS,NPIVO,NAMEV BACKSPACE 2 NBUFA=MBUFA IF(KRESL.EQ.1) GO TO 412 BACKSPACE 4 READ(4) EQRHS BACKSPACE 4 412 CONTINUE C C*** PREPARE TO BACK-SUBSTITUTE FROM THE CURRENT EQUATION C IFRON=NPIVO(NBUFA) NIKNO=NAMEV(NBUFA) PIVOT=EQUAT(IFRON,NBUFA) IF(IFFIX(NIKNO).NE.0) VECRV(IFRON)=FIXED(NIKNO) IF(IFFIX(NIKNO).EQ.0) EQUAT(IFRON,NBUFA)=0.0 C C*** BACK-SUBSTITUTE IN THE CURRENT EQUATION C DO 330 JFRON=1,MFRON 330 EQRHS(NBUFA)=EQRHS(NBUFA)-VECRV(JFRON)*EQUAT(JFRON,NBUFA) C C*** PUT THE FINAL VALUES WHERE THEY BELONG C IF(IFFIX(NIKNO).EQ.0) VECRV(IFRON)=EQRHS(NBUFA)/PIVOT IF(IFFIX(NIKNO).NE.0) FIXED(NIKNO)=-EQRHS(NBUFA) NBUFA=NBUFA-1 ASDIS(NIKNO)=VECRV(IFRON) 340 CONTINUE C C*** ADD DISPLACEMENTS TO PREVIOUS TOTAL VALUES C DO 345 ITOTV=1,NTOTV 345 TDISP(ITOTV)=TDISP(ITOTV)+ASDIS(ITOTV) C C*** STORE REACTIONS FOR PRINTING LATER C KBOUN=1 DO 370 IPOIN=1,NPOIN NLOCA=(IPOIN-1)*NDOFN DO 350 IDOFN=1,NDOFN NGUSH=NLOCA+IDOFN IF(IFFIX(NGUSH).GT.0) GO TO 360 350 CONTINUE GO TO 370 360 DO 510 IDOFN=1,NDOFN NGASH=NLOCA+IDOFN 510 TREAC(KBOUN, IDOFN)=TREAC(KBOUN, IDOFN)+FIXED(NGASH) KBOUN=KBOUN+1 370 CONTINUE C C*** ADD REACTIONS INTO THE TOTAL LOAD ARRAY C DO 700 IPOIN=1,NPOIN DO 710 IELEM=1,NELEM DO 710 INODE=1,NNODE NLOCA=IABS(LNODS(IELEM, INODE)) 710 IF(IPOIN.EQ.NLOCA) GO TO 720 720 DO 730 IDOFN=1,NDOFN NGASH=(INODE-1)*NDOFN+IDOFN MGASH=(IPOIN-1)*NDOFN+IDOFN 730 TLOAD(IELEM, NGASH)=TLOAD(IELEM, NGASH)+FIXED(MGASH) ``` 700 CONTINUE RETURN END FRNT 291 FRNT 292 FRNT 293 # 6.4.13 Data error diagnostic subroutine CHECK1 The function of this subroutine is to scrutinise the problem control parameters, which are accepted by the data input subroutine, INPUT, which will be described in Section 6.5.1. Since subroutine INPUT is common to plane stress/strain, axisymmetric and plate bending applications, subroutine CHECK1 will only check that the control parameters are within the bounds defined by the correct values for the four cases. A counter, KEROR, is employed to indicate whether or not any errors have been detected. If errors have been found (indicated by KEROR = 1), subroutine ECHO, described in the next section, is called to list the remainder of the input data. Any errors detected are signalled by means of printed error numbers. The interpretation of each error message is given in Table 6.2. ```csv SUBROUTINE CHECK1(NDOFN,NELEM,NGAUS,NMATS,NNODE,NPOIN,NESTRE,NTYPE,NVFIX,NCRIT,NALGO,NINCS) CEK1 1 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 EITHER RETURN,OR ELSE PRINT THE ERRORS DIAGNOSED KEROR=0 DO 20 IEROR=1,12 IF(NEROR(IEROR).EQ.0) GO TO 20 KEROR=1 WRITE(6,900) IEROR 900 FORMAT(//31H *** DIAGNOSIS BY CHECK1, ERROR,I3) 20 CONTINUE IF(KEROR.EQ.0) RETURN CEK1 1 CEK1 2 CEK1 3 CEK1 4 CEK1 5 CEK1 6 CEK1 7 CEK1 8 CEK1 9 CEK1 10 CEK1 11 CEK1 12 CEK1 13 CEK1 14 CEK1 15 CEK1 16 CEK1 17 CEK1 18 CEK1 19 CEK1 20 CEK1 21 CEK1 22 CEK1 23 CEK1 24 CEK1 25 CEK1 26 CEK1 27 CEK1 28 CEK1 29 CEK1 30 CEK1 31 CEK1 32 CEK1 33 CEK1 34 CEK1 35 CEK1 36 ```