forums.silverfrost.com

[shah]

C MAIN ROUTINE OF THE PROGRAM PASSFEM
C
IMPLICIT REAL*8(A-H,O-Z)
REAL*4 S1,S2,S3,S4,S5,S6,S7,S8,SS1,SS2,SS3,SS4
INTEGER CHT
COMMON/DIM/N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14
COMMON/PAR/IND,NET,NSN,NMP,NEQ,NSKY,NEQ1,LCOUNT
COMMON/TAPES/ISTRES,NDARAY,IPR
COMMON/PRECI/ITWO
COMMON/MULT/ELMN
COMMON/ELEM/NDEL(100)
COMMON/ELOAD/M1,M2,AA1,AA2,AA3,AA4,NSLC,NUM
DIMENSION SS1(10),SS2(10),SS3(10),SS4(10)
DIMENSION LLIB(7,3),NLN(10),TITLE(20),ELM(10)
CHARACTER*15 INFILE,OUTFILE
C
C
DIMENSION A(30000)
MTOT=30000
CALL SECOND(S1,0.0)
C
ITWO=1
C
C
ISTRES=1
NDARAY=2
C

C
C READ & PRINT STRUCTURE DATA
100 READ(5,55)(TITLE(I),I=1,20)
READ(5,11)NSN,NET,NMP,NLC,NEDMAX,MODEX
IF(NSN.EQ.0)STOP
READ(5,12)IPR
WRITE(6,66)(TITLE(I),I=1,20)
WRITE(6,22)NSN,NET,NMP,NLC
C READ,GENERATE & PRINT NODAL DATA & MATERIAL PROPERTIES
N1=1
N2=N1+6*NSN
N3=N2+NSN*ITWO
N4=N3+NSN*ITWO
N5=N4+NSN*ITWO
IF(N5.GT.MTOT)CALL ERROR(N5-MTOT,1)
IF(N5.GT.MTOT)STOP
N6=N5+NMP*ITWO
N7=N6+NMP*ITWO
N8=N7+NMP*ITWO
CALL PASSIN (A(N2),A(N3),A(N4),A(N5),A(N6),A(N7),A(N1),
*NSN,NMP,NEQ)
C INITIALIZE COLUMN HEIGHT TO '0'
N9=N8+NEQ
DO 10 I=N8,N9
10 A(I)=0.0
C READ AND GENERATE ELEMENT DATA
WRITE(6,33)
NEQ1=NEQ+1
REWIND NDARAY
IND=1
LCOUNT=0
CALL FELIB(A,LLIB,MTOT)
CALL SECOND(S2,S1)
C
C ADDRESS DIAGONAL ELEMENTS OF GSM FOR ASSEMBLY
N11=N10+NEQ1
CALL CADNUM (A(N,A(N10),NEQ,NEQ1,NSKY,MBAND)
C WRITE DATA FOR SOLUTION PHASE
WRITE(6,88)NEQ,NSKY
C ALLOT SPACE FOR STIFFNESS MATRIX & LOAD VECTOR
N12=N11+NSKY*ITWO
N13=N12+NEQ*ITWO
N14=N13+NEQ*ITWO
IF(N14.GT.MTOT)CALL ERROR(N14-MTOT,3)
IF(N14.GT.MTOT)STOP
C INITIALIZE GSM,LOAD VECTOR & DISPALCEMENT VECTOR
NSIZE=NSKY+NEQ+NEQ
CALL INISKP(A(N11),NSIZE)
IF (MODEX.NE.0)GO TO 222
C
C CAL LOAD VECTOR & ESM & ASSEMBLE STR STIFFNESS MATRIX
REWIND NDARAY
REWIND ISTRES
IND=2
LCOUNT=0
CALL FELIB(A,LLIB,MTOT)
CALL SECOND(S3,S1)
C
C TRIANGULARIZE STIFFNESS MATRIX
KTR=1
CALL PASOLV(A(N11),A(N13),A(N10),NEQ,NEQ1,NSKY,KTR)
222 CONTINUE
CALL SECOND(S4,S1)
C
C READ & PRINT ELEMENT LOAD MULTIPLIERS
C
READ (5,77)(ELM(J),J=1,NLC)
WRITE(6,7
WRITE(6,79)(L,L=1,NLC)
WRITE(6,81)(ELM(J),J=1,NLC)
READ(5,44)(NLN(J),J=1,NLC)
NN1=N13-1
CALL SECOND(S5,S1)
S6=0.0
S7=0.0
S8=0.0
DO 80 L=1,NLC
CALL SECOND(SS1(L),0.0)
ELMN=ELM(L)
DO 144 I=N12,NN1
144 A(I+NEQ)=A(I)*ELMN
WRITE(6,99) L
WRITE(6,122)
NC=NLN(L)
IF(NC.EQ.0) GOTO 30
C
C ADD CONC LOAD TO CAL LOAD VECTOR
C
CALL PASLOD(A(N13),A(N1),NC,NSN,NEQ)
C
30 CONTINUE
CALL SECOND(SS3(L),SS1(L))
IF(MODEX.NE.0)GO TO 80
C CAL OF DISPLACEMENTS
KTR=2
CALL PASOLV(A(N11),A(N13),A(N10),NEQ,NEQ1,NSKY,KTR)
C
C PRINT NODAL DISPLACEMENTS
WRITE(6,111)
CALL DISP(A(N13),A(N1),NSN,NEQ)
CALL SECOND(SS3(L),SS1(L))
C
C CAL STRESSES AT SELECTED POINTS OF EACH ELEMENT
REWIND NDARAY
REWIND ISTRES
IND=3
LCOUNT=0
CALL FELIB(A,LLIB,MTOT)
CALL SECOND(SS4(L),SS1(L))
S6=S6+SS2(L)
S7=S7+SS3(L)-SS2(L)
S8=S8+SS4(L)-SS3(L)
80 CONTINUE
IF (MODEX.NE.0) GO TO 200
S1=S2+(S5-S4)+S6
S2=S3-S2