C COMPUTER PROGRAM FOR NON-PRISMATIC PLANE FRAME C C READY TO BE COMPILED ON MICROSOFT FORTRAN POWER STATION C C REQUIRED ARRAY SIZE C C X(NJ),Y(NJ),JJ(M ),JK(M ),AX(M),L(M),CX(M),CY(M),RL(3NJ),CRL(3NJ) C A(3NJ),AML(6),AE(3NJ),AC(3NJ),S(N,IUBW),SMD(6,6),D(3NJ) C TIT1(20),NN(10),LDID(10),P(10),W(10),BK(10),AMC(10),XL(7),IZZ(7) C KK(M),PCOS(10),PSIN(10),IZ(M),IDMEM(M) C C UNITS ARE ALL INCH-KIPS C RIGHT HAND RULE CARTESIAN COORDINATE C C REQUIRED INPUT DATA C C NO. OF CARDS VARIABLES FORMAT C 1 TIT1 20A4 C 1 IUBW,M,NJ,NR,NRJ,E 5I5,F10.0 C NJ J,X(J),Y(J) I5,2F10.0 C M I,JJ(I),JK(I),AX(I),IZ(I),IDMEM(I) 3I5,2F10.0,I C NRJ K,RL(3K-2),RL(3K-1),RL(3K) 4I5 C IF IDMEM.EQ.0 SKIP BELOW AND GO TO ICASE LINE C 1 IZZ(I) 7F10.0 C 1 AA(I) 7F10.0 C 1 XL(I) 7F10.0 C 1 ICASE I5 C REPEATED ICAE TIMES C 1 NLJ,NLM 2I5 C NLJ K,A(3K-2),A(3K-1),A(3K) I5,3F10.0 C REPEATED NLM TIMES C 1 I,KK 2I5 C KK NN,LDID,PCOS,PSIN,BK,P,W,AMC 2I5,6F10.0 C C INPUTING EXTERNALLY COMPUTED MEMBER END ACTIONS INCURS ERRORNEOUS C RESULTS FOR LOADED MEMBERS C IMPLICIT REAL*8 (A-H,O-Z) DIMENSION A(4000),K(8000) COMMON/SETUP/TIT1(10),E,IUBW,M,NJ,NR,NRJ,NRUN,NJNJ,N COMMON A EQUIVALENCE (A(1),K(1)) C OPEN ( 2,RECL=288,FORM='UNFORMATTED',ACCESS='DIRECT', 1 STATUS='SCRATCH') OPEN ( 3,RECL=56,FORM='UNFORMATTED',ACCESS='DIRECT', 1 STATUS='SCRATCH') OPEN ( 4,RECL=56,FORM='UNFORMATTED',ACCESS='DIRECT', 1 STATUS='SCRATCH') OPEN ( 5,FILE=' ') OPEN ( 6,FILE=' ') OPEN ( 8,RECL=48,FORM='UNFORMATTED',ACCESS='DIRECT', 1 STATUS='SCRATCH') C 999 READ(5,900,END=901) (TIT1(I), I=1,10) 900 FORMAT(10A8) C C C WRITE(6,601) (TIT1(I), I=1,10) 601 FORMAT(///' ',10A8) C C IUBW=BAND WIDTH C M=NUMBER OF MEMBERS C NJ=NUMBER OF JOINTS C N=NUMBER OF DEGREES OF FREEDOM C NRJ=NUMBER OF RESTRAINED JOINTS C E=ELASTIC MODULUS FOR TENSION OR COMPRESSION C C 1 INPUT AND PRINT STRUCTURE DATA C A STRUCTURE PARAMETERS AND ELASTIC MODULUS C READ(5, *) IUBW,M,NJ,NR,NRJ,E C 502 FORMAT( 5I5,F10.0) C C IUBW=MAX(3*(JK(I)-JJ(I)+1)-NR) C C INPUT NODE NUMBERING MUST CONSIDER THE BANDWIDTH MINIMIZATION C C NONPRISMATIC MEMBERS (IDMEM.NE.0) CAN BE USED BY PROVIDING C PIECEWISE PRISMATIC SECTION PROPERTIES, IZZ AND AA C N=3*NJ-NR C C L=LENGTH OF MEMBERS C IZ=MOMENT OF INERTIA ABOUT Z-AXIS C WRITE(6,602) 602 FORMAT(//' ','STRUCTURE DATA') WRITE(6,603) 603 FORMAT(' ',' BW NOM DOF NOJ NOR NORJ E') WRITE(6,604) IUBW,M,N,NJ,NR,NRJ,E 604 FORMAT( 6I5,E12.5) NJNJ=NJ*3 N1=1 N2=N1+N*IUBW N3=N2+M N4=N3+M N5=N4+M N6=N5+M N7=N6+M N8=N7+NJ N9=N8+NJ N10=N9+NJNJ N11=N10+NJNJ N12=N11+NJNJ N13=(N12+NJNJ)*2-1 N14=N13+M N15=N14+M N16=N15+M N17=N16+NJNJ N18=N17+NJNJ NSIZE=N18+M WRITE(6,608) NSIZE 608 FORMAT(/' ','BLANK COMMON ARRAY',I6/) C C B JOINT COORDINATES C B WRITE(6,607) 607 FORMAT(' ','COORDINATES OF JOINTS - STRUCTURE COORDINATE SYSTEM'/) WRITE(6,606) 606 FORMAT(' ','JOINT X Y') IF(NSIZE.GT.8000) GO TO 902 605 FORMAT(///' PROBLEM TOO LARGE',I5//) CALL MAIN1(A(N1),A(N2),A(N3),A(N4),A(N5),A(N6),A(N7),A(N8),A(N9), * A(N10),A(N11),A(N12),K(N13),K(N14),K(N15),K(N16),K(N17), * K(N18)) GO TO 999 902 WRITE(6,605) NSIZE CLOSE (5) CLOSE (6) CLOSE (2) CLOSE (3) CLOSE (4) CLOSE (8) 901 STOP END SUBROUTINE MAIN1(S,CX,CY,AX,L,IZ,X,Y,A,AC,D,AE,JJ,JK,IDMEM,RL,CRL, * KK) IMPLICIT REAL*8 (A-H,O-Z) INTEGER*4 RL,CRL,Q REAL*8 L,IZ DIMENSION S(N,1),CX(M),CY(M),AX(M),L(M),IZ(M),X(NJ),Y(NJ), *A(NJNJ),AC(NJNJ),D(NJNJ),AE(NJNJ),JJ(M),JK(M),IDMEM(M),RL(NJNJ), *CRL(NJNJ),KK(M) DIMENSION SMD(6,6) COMMON/SETUP/TIT1(10),E,IUBW,M,NJ,NR,NRJ,NRUN,NJNJ,N CALL INPT (X,Y,JJ,JK,AX,IZ,IDMEM,L,CX,CY,RL,CRL,S) Q=0 KUBW=IUBW IUBW=0 CALL MATRIX(JJ,JK,IDMEM,L,SMD,CX,CY,S,AX,RL,CRL,Q,KUBW,IZ) C C DECOMPOSE SYMMETRIC BAND STIFFNESS MATRIX C CALL DBAND(N,NB,S) IF(NB-1) 150,25,150 25 WRITE(6,639) 639 FORMAT(//' ','NOT A BAND SYMMETRIC POSITIVE DEFINITE MATRIX'/' ',' 1SUBROUTINE FAILS') GO TO 100 150 CALL SOLOUT(S,A,KK,AE,RL,CRL,AC,D,JJ,JK,CX,CY,IDMEM,AX,L,IZ) 100 RETURN END SUBROUTINE INPT(X,Y,JJ,JK,AX,IZ,IDMEM,L,CX,CY,RL,CRL,S) IMPLICIT REAL*8 (A-H,O-Z) INTEGER*4 RL,CRL REAL*8 L,IZ DIMENSION X(1),Y(1),JJ(1),JK(1),AX(1),IZ(1),IDMEM(1),L(1),CX(1), *CY(1),RL(1),CRL(1),S(N,1) COMMON/SETUP/TIT1(10),E,IUBW,M,NJ,NR,NRJ,NRUN,NJNJ,N DO 1 I=1,NJ READ(5, *) J,X(J),Y(J) 1 WRITE(6,607) J,X(J),Y(J) C 503 FORMAT( I5,3F10.0) 607 FORMAT(I5,3F10.3) C C MEMBER DESIGNATIONS AND PROPERTIES C WRITE(6,608) 608 FORMAT(/' ','MEMBER DESIGNATIONS AND PROPERTIES'/) WRITE(6,609) 609 FORMAT(' ','MEMBER NE FE AREA INERTIA LENGTH D', 1 'IR COS DIR SIN NOSEG') DO 2 J=1,M C 504 FORMAT( 3I5,2F10.0,I5) READ(5, *) I,JJ(I),JK(I),AX(I),IZ(I),IDMEM(I) IF(JJ(I)-JK(I)) 201,201,202 202 ITEMP=JJ(I) JJ(I)=JK(I) JK(I)=ITEMP 201 JKJK=JK(I) JJJJ=JJ(I) XCL=X(JKJK)-X(JJJJ) YCL=Y(JKJK)-Y(JJJJ) L(I)=DSQRT(XCL**2+YCL**2) CX(I)=XCL/L(I) CY(I)=YCL/L(I) 2 WRITE(6,610) I,JJ(I),JK(I),AX(I),IZ(I),L(I),CX(I),CY(I),IDMEM(I) 610 FORMAT(I5,I9,I5,F8.3,F12.3,F10.3,2F9.4,I5) C C JOINT RESTRAINT LIST, CUMULATIVE RESTRAINT LIST C WRITE(6,611) 611 FORMAT(/' ','JOINT RESTRAINT'/) WRITE(6,612) 612 FORMAT(' ','JOINT X-RSTRT Y-RSTRT Z-RSTRT') C C RL=JOINT RESTRAINT LIST..RL(3K-2),RL(3K-1),RL(3K) C IF RSTRT EXISTS 1 OTHERWISE 0 C CUMULATIVE RESTRAINT LIST C DO 3 I=1,NJNJ RL(I)=0 3 CRL(I)=0 DO 4 J=1,NRJ READ(5, *) K,RL(3*K-2),RL(3*K-1),RL(3*K) 502 FORMAT(4I5) 4 WRITE(6,613) K,RL(3*K-2),RL(3*K-1),RL(3*K) 613 FORMAT( 2I6,I7,I8) CRL(1)=RL(1) DO 5 K=2,NJNJ 5 CRL(K)=CRL(K-1)+RL(K) C C 2 STRUCTURE STIFFNESS MATRIX C C J1,J2,J3=INDEXES FOR DISPLACEMENTS AT J END OF MEMBER C K1,K2,K3=INDEXES FOR DISPLACEMENTS AT K END OF MEMBER C DO 6 I=1,N DO 6 J=1,IUBW 6 S(I,J)=0. RETURN END SUBROUTINE MATRIX(JJ,JK,IDMEM,L,SMD,CX,CY,S,AX,RL,CRL,Q,KUBW,IZ) IMPLICIT REAL*8 (A-H,O-Z) INTEGER*4 RL,CRL,Q REAL*8 L,IZ(1) DIMENSION JJ(1),JK(1),IDMEM(1),L(1),SMD(6,6),CX(1),CY(1),S(N,1), 1 AX(1),RL(1),CRL(1) COMMON/SETUP/TIT1(10),E,IUBW,M,NJ,NR,NRJ,NRUN,NJNJ,N DO 7 I=1,M J1=3*JJ(I)-2 J2=3*JJ(I)-1 J3=3*JJ(I) K1=3*JK(I)-2 K2=3*JK(I)-1 K3=3*JK(I) IF(IDMEM(I)) 51,100,51 100 SCM1=E*AX(I)/L(I) SCM2=4.*E*IZ(I)/L(I) SCM3=1.5*SCM2/L(I) SCM4=2.*SCM3/L(I) CALL MEMST(SCM1,SCM2,SCM3,SCM4,SMD,CX,CY,I) GO TO 52 51 Q=Q+1 CALL STIFF(Q,SMD,CX,CY,IDMEM,I) WRITE(2,REC=Q)((SMD(K,J),J=K,6),K=1,6) 52 CALL CALC2(J1,J2,J3,K1,K2,K3,RL,CRL,S,SMD) 7 CONTINUE IF(IUBW-KUBW) 10,20,30 10 WRITE(6,601) IUBW,KUBW 601 FORMAT(/' THE CORRECT BANDWIDTH IS',I3,' REDUCE THE INITIAL', 1 ' VALUE',I3/) GO TO 20 30 WRITE(6,602) IUBW,KUBW 602 FORMAT(///' FATAL ERROR'//' TRUE BANDWIDTH',I3,' IS GREATER', 1 ' THAN INITIAL VALUE',I3,' SUBROUTINE FAILS'///) 20 RETURN END SUBROUTINE DBAND(N,NSR,A) IMPLICIT REAL*8 (A-H,O-Z) INTEGER*4 UBW,P,Q DIMENSION A(N,1) COMMON/SETUP/TIT1(10),E,IUBW,M,NJ,NR,NRJ,NRUN,NJNJ,L UBW=IUBW DO 10 I=1,N P=N-I+1 IF(UBW-P) 1,2,2 1 P=UBW 2 DO 10 J=1,P Q=UBW-J IF((I-1)-Q) 3,4,4 3 Q=I-1 4 SUM=A(I,J) IF(Q-1) 5,6,6 6 DO 12 K=1,Q IK=I-K JK=J+K 12 SUM=SUM-A(IK,K+1)*A(IK,JK) 5 IF(J-1) 13,11,13 11 IF(SUM) 14,14,16 16 NSR=0 TEMP=1./DSQRT(SUM) A(I,J)=TEMP GO TO 10 13 A(I,J)=SUM*TEMP 10 CONTINUE GO TO 15 14 NSR=1 15 RETURN END SUBROUTINE SOLOUT(S,A,KK,AE,RL,CRL,AC,D,JJ,JK,CX,CY,IDMEM,AX,L,IZ) IMPLICIT REAL*8 (A-H,O-Z) INTEGER*4 RL,CRL,Q REAL*8 L,IZ DIMENSION A(1),KK(1),AE(1),RL(1),CRL(1),AC(1),D(1),S(N,1), * JJ(1),JK(1),CX(1),CY(1),IDMEM(1),AX(1),L(1),IZ(1) DIMENSION PSIN(10),PCOS(10),NN(10),LDID(10),P(10),W(10) *,BK(10),AMC(10),AML(6) COMMON/SETUP/TIT1(10),E,IUBW,M,NJ,NR,NRJ,NRUN,NJNJ,N C C C C INPUT AND PRINT LOAD DATA C N=NJNJ-CRL(NJNJ) READ(5, *) ICASE 502 FORMAT(4I5) DO 220 KLUX=1,ICASE Q=0 WRITE(6,618) KLUX 618 FORMAT(/' ','LOADING NO.',I3/) WRITE(6,619) 619 FORMAT(' ','LOAD DATA'/) WRITE(6,620) 620 FORMAT(' ',' NLJ NLM') C C NLM=NUMBER OF LOADED MEMBER C READ(5, *) NLJ,NLM WRITE(6,502) NLJ,NLM C C B ACTIONS APPLIED AT JOINTS C DO 26 K=1,NJNJ 26 A(K)=0. IF(NLJ) 151,152,151 151 WRITE(6,622) 622 FORMAT(/' ','ACTIONS APPLIED AT JOINTS'/) WRITE(6,623) 623 FORMAT(' ','JOINT X-ACTION Y-ACTION Z-ACTION') DO 27 I=1,NLJ READ(5, *) K,A(3*K-2),A(3*K-1),A(3*K) C 503 FORMAT(I5,6F10.0) 27 WRITE(6,663) K,A(3*K-2),A(3*K-1),A(3*K) 663 FORMAT(I5,2X,3F15.3) C C A=ACTIONS(LOADS) APPLIED AT JOINTS IN DIRECTIONS OF STRUCTURE AXES C C C ACTIONS AT ENDS OF RESTRAINED MEMBERS DUE TO LOADS 152 CONTINUE C REWIND 8 C C AML1,AML4=HORIZ'TL ACTIONS DUE TO LOADS AT J AND K END OF MEMBER C AML2,AML5=VERTICAL ACTIONS DUE TO LOADS AT J AND K END OF MEMBER C AML3,AML6=FIXED END MOMENT DUE TO LOADS AT J AND K END OF MEMBER C IF(NLM) 153,29,153 153 WRITE(6,625) 625 FORMAT(/' ','TOTAL LOADING CASES IN EACH MEMBER'/) IP=0 DO 50 KIJ=1,M 50 KK(KIJ)=0 DO 30 J=1,NLM READ(5, *) I,KK(I) IF(I.EQ.1) GO TO 324 IM1=I-1 IF(IM1.EQ.IP) GO TO 324 GO TO 328 327 IF(IP.EQ.M) GO TO 30 IF(IM1.EQ.M) GO TO 30 IM1=M 328 IST=IP+1 DO 325 IJ=IST,IM1 DO 326 JI=1,6 326 AML(JI)=0.0 325 WRITE(8,REC=IJ) (AML(JI),JI=1,6) IF(IM1.EQ.M) GO TO 30 324 WRITE(6,626) 626 FORMAT(' ','MEMBER LOADING') WRITE(6,502) I,KK(I) KKK=KK(I) WRITE(6,629) 629 FORMAT(' ',' NN LOAD ID PCOS PSIN DIS TO LOAD CONC LO 1AD UNIF LOAD CONC MOMT') DO 31 II=1,KKK READ (5, *) NN(II),LDID(II),PCOS(II),PSIN(II),BK(II),P(II), 1W(II),AMC(II) C 510 FORMAT(2I5,6F10.0) 31 WRITE(6,630) NN(II),LDID(II),PCOS(II),PSIN(II),BK(II),P(II), 1W(II),AMC(II) 630 FORMAT(2I5,2F11.4,1X,4F12.4) CALL FEND(KK(I),NN,LDID,PCOS,PSIN,BK,P,W,AMC,AML(1),AML(2),AML(3), 1AML(4),AML(5),AML(6),Q,I,IDMEM,L) WRITE(8,REC=I) (AML(K), K=1,6) IP=I IF(IP.EQ.M) GO TO 30 IF(J.NE.NLM) GO TO 30 IF(IP.NE.M) GO TO 327 30 CONTINUE C REWIND 8 WRITE(6,631) 631 FORMAT(/' ','ACTIONS AT END OF RESTRAINED MEMBERS DUE TO LOADS'/) WRITE(6,638) DO 32 I=1,M IQ=I IF(KK(I).EQ.0) GO TO 32 READ(8,REC=IQ) (AML(J), J=1,6) WRITE(6,636) IQ,(AML(J), J=1,6) 32 CONTINUE 636 FORMAT(I5,6E12.4) C C 4 CONSTRUCTION OF VECTORS ASSOCIATED WITH LOADS C A EQUIVALENT JOINT LOADS C C AE=EQUIVALENT JOINT LOADS(IN DIRECTIONS OF STRUCTURE AXES) C 29 DO 33 I=1,NJNJ 33 AE(I)=0. IF(NLM) 155,34,155 155 DO 35 I=1,M CALL EQACT(AE,JJ,JK,CX,CY,I) 35 CONTINUE C C B COMBINED JOINT LOADS C 34 DO 36 I=1,NJNJ 36 AC(I)=0. DO 37 J=1,NJNJ IF(RL(J)) 157,38,157 157 K=N+CRL(J) GO TO 37 38 K=J-CRL(J) 37 AC(K)=A(J)+AE(J) C AC=COMBINED JOINT LOADS C C 5 CALCULATION AND OUTPUT OF RESULTS C DO 39 I=1,NJNJ 39 D(I)=0. C CALL SBAND(N,AC,D,S) C C D=JOINT DISPLACEMENTS(IN DIRECTIONS OF STRUCTURE AXES) J=N+1 C C JE,KE=INDEXES FOR EXPANDED VECTORS DO 44 JE=1,NJNJ NJE1=NJNJ-JE+1 IF(RL(NJE1)) 221,45,221 221 D(NJE1)=0. GO TO 44 45 J=J-1 D(NJE1)=D(J) 44 CONTINUE WRITE(6,634) 634 FORMAT(/' ','JOINT DISPLACEMENTS - STRUCTURE COORDINATE'/) WRITE(6,635) 635 FORMAT(' ','JOINT X-DISPL Y-DISPL Z-ROTN') DO 48 JE=3,NJNJ,3 JEE3=JE/3 48 WRITE(6,639) JEE3,D(JE-2),D(JE-1),D(JE) 639 FORMAT(I5,3F15.6) C B MEMBER END ACTIONS C WRITE(6,637) 637 FORMAT(/' ','MEMBER END ACTIONS IN MEMBER COORDINATES'/) WRITE(6,638) 638 FORMAT(' ','MEMBER NE THRUST NE SHEAR NE MOMENT FE', 1 ' THRUST FE SHEAR FE MOMENT') C C AE(I) ARRAY IS USED FOR REACTIONS C DO 51 I=1,NJNJ 51 AE(I)=0.0 Q=0 DO 49 I=1,M CALL MENDA (AM1,AM2,AM3,AM4,AM5,AM6,D,Q,I,JJ,JK,AX,L,IZ,CX,CY,AE, *RL,IDMEM,NLM) 49 WRITE(6,636) I,AM1,AM2,AM3,AM4,AM5,AM6 WRITE(6,640) 640 FORMAT(/' ','REACTIONS - STRUCTURE COORDINATE'/) WRITE(6,641) 641 FORMAT(' ','JOINT X-REACT Y-REACT Z-REACT') DO 52 I=1,NJNJ 52 AE(I)=AE(I)-A(I) DO 53 JE=3,NJNJ,3 IF(RL(JE-2).EQ.1) GO TO 54 IF(RL(JE-1).EQ.1) GO TO 54 IF(RL(JE).EQ.1) GO TO 54 GO TO 53 54 JEE3=JE/3 WRITE(6,642) JEE3,AE(JE-2),AE(JE-1),AE(JE) 642 FORMAT(I5,2F15.6,1X,F15.6) 53 CONTINUE 220 CONTINUE RETURN END SUBROUTINE MEMST(SCM1,SCM2,SCM3,SCM4,SMD,XC,YC,IQ) IMPLICIT REAL*8 (A-H,O-Z) DIMENSION SMD(6,6),XC(1),YC(1) CX=XC(IQ) CY=YC(IQ) SMD(1,1)=SCM1*CX**2+SCM4*CY**2 SMD(4,4)=SCM1*CX**2+SCM4*CY**2 SMD(1,4)=-SMD(1,1) SMD(4,1)=-SMD(1,1) SMD(1,2)=(SCM1-SCM4)*CX*CY SMD(2,1)=(SCM1-SCM4)*CX*CY SMD(4,5)=(SCM1-SCM4)*CX*CY SMD(5,4)=(SCM1-SCM4)*CX*CY SMD(1,5)=-SMD(1,2) SMD(5,1)=-SMD(1,2) SMD(2,4)=-SMD(1,2) SMD(4,2)=-SMD(1,2) SMD(1,3)=-SCM3*CY SMD(3,1)=-SCM3*CY SMD(1,6)=-SCM3*CY SMD(6,1)=-SCM3*CY SMD(3,4)=-SMD(1,3) SMD(4,3)=-SMD(1,3) SMD(4,6)=-SMD(1,3) SMD(6,4)=-SMD(1,3) SMD(2,2)=SCM1*CY**2+SCM4*CX**2 SMD(5,5)=SCM1*CY**2+SCM4*CX**2 SMD(2,5)=-SMD(2,2) SMD(5,2)=-SMD(2,2) SMD(2,3)=SCM3*CX SMD(3,2)=SCM3*CX SMD(2,6)=SCM3*CX SMD(6,2)=SCM3*CX SMD(3,5)=-SMD(2,3) SMD(5,3)=-SMD(2,3) SMD(5,6)=-SMD(2,3) SMD(6,5)=-SMD(2,3) SMD(3,3)=SCM2 SMD(6,6)=SCM2 SMD(3,6)=SCM2/2. SMD(6,3)=SCM2/2. RETURN END SUBROUTINE CALC3(J,S,SMD) IMPLICIT REAL*8 (A-H,O-Z) DIMENSION S(24,24),SMD(6,6) J1=3*J-2 J2=3*J-1 J3=3*J K1=3*J+1 K2=3*J+2 K3=3*J+3 S(J1,J1)=S(J1,J1)+SMD(1,1) S(J2,J1)=S(J2,J1)+SMD(2,1) S(J3,J1)=S(J3,J1)+SMD(3,1) S(K1,J1)=SMD(4,1) S(K2,J1)=SMD(5,1) S(K3,J1)=SMD(6,1) S(J1,J2)=S(J1,J2)+SMD(1,2) S(J2,J2)=S(J2,J2)+SMD(2,2) S(J3,J2)=S(J3,J2)+SMD(3,2) S(K1,J2)=SMD(4,2) S(K2,J2)=SMD(5,2) S(K3,J2)=SMD(6,2) S(J1,J3)=S(J1,J3)+SMD(1,3) S(J2,J3)=S(J2,J3)+SMD(2,3) S(J3,J3)=S(J3,J3)+SMD(3,3) S(K1,J3)=SMD(4,3) S(K2,J3)=SMD(5,3) S(K3,J3)=SMD(6,3) S(J1,K1)=SMD(1,4) S(J2,K1)=SMD(2,4) S(J3,K1)=SMD(3,4) S(K1,K1)=S(K1,K1)+SMD(4,4) S(K2,K1)=S(K2,K1)+SMD(5,4) S(K3,K1)=S(K3,K1)+SMD(6,4) S(J1,K2)=SMD(1,5) S(J2,K2)=SMD(2,5) S(J3,K2)=SMD(3,5) S(K1,K2)=S(K1,K2)+SMD(4,5) S(K2,K2)=S(K2,K2)+SMD(5,5) S(K3,K2)=S(K3,K2)+SMD(6,5) S(J1,K3)=SMD(1,6) S(J2,K3)=SMD(2,6) S(J3,K3)=SMD(3,6) S(K1,K3)=S(K1,K3)+SMD(4,6) S(K2,K3)=S(K2,K3)+SMD(5,6) S(K3,K3)=S(K3,K3)+SMD(6,6) RETURN END SUBROUTINE CALC4(S,SAA,SAB,SBA,SBB,N3M2) IMPLICIT REAL*8 (A-H,O-Z) DIMENSION S(24,24),SAA(6,6),SAB(6,18),SBA(18,6),SBB(18,18) N6=N3M2-4 DO 10 J=1,3 DO 11 I=1,3 11 SAA(I,J)=S(I,J) DO 10 I=4,6 IR=I+N3M2-4 10 SAA(I,J)=S(IR,J) DO 12 J=4,6 JR=J+N3M2-4 DO 13 I=1,3 13 SAA(I,J)=S(I,JR) DO 12 I=4,6 IR=I+N3M2-4 12 SAA(I,J)=S(IR,JR) DO 14 J=1,N6 DO 15 I=1,3 15 SAB(I,J)=S(I,J+3) DO 14 I=4,6 IR=I+N3M2-4 14 SAB(I,J)=S(IR,J+3) DO 16 I=1,N6 DO 17 J=1,3 17 SBA(I,J)=S(I+3,J) DO 16 J=4,6 JR=J+N3M2-4 16 SBA(I,J)=S(I+3,JR) DO 18 I=1,N6 DO 18 J=1,N6 18 SBB(I,J)=S(I+3,J+3) RETURN END SUBROUTINE FXCON(P,AM3,AM6,SP,BKL,PSIN,J) IMPLICIT REAL*8 (A-H,O-Z) DIMENSION AM3(1),AM6(1),P(1),PSIN(1) AM3(J)=P(J)*(SP-BKL)**2*BKL/SP**2*PSIN(J) AM6(J)=-P(J)*(BKL)**2*(SP-BKL)/SP**2*PSIN(J) RETURN END SUBROUTINE EACON(P,PCOS,PSIN,BK,SP,AM1,AM2,AM3,AM4,AM5,AM6,J) IMPLICIT REAL*8 (A-H,O-Z) DIMENSION P(1),PCOS(1),PSIN(1),BK(1),AM1(1),AM2(1),AM3(1),AM4(1), 1AM5(1),AM6(1) AM1(J)=P(J)*PCOS(J)*(1.-BK(J)) AM4(J)=P(J)*PCOS(J)*BK(J) AM5(J)=P(J)*PSIN(J)*BK(J)-(AM3(J)+AM6(J))/SP AM2(J)=P(J)*PSIN(J)*(1.-BK(J))+(AM3(J)+AM6(J))/SP RETURN END SUBROUTINE FXUNI(W,PSIN,SP,BK,AM3,AM6,J) IMPLICIT REAL*8 (A-H,O-Z) DIMENSION W(1),PSIN(1),BK(1),AM3(1),AM6(1) AM3(J)=(W(J)*(PSIN(J)*SP)**2/12.)*BK(J)**2*(6.-8.*BK(J)+3.*BK(J) 1 **2) AM6(J)=(W(J)*(PSIN(J)*SP)**2/12.)*BK(J)**3*(3.*BK(J)-4.) RETURN END SUBROUTINE EAUNI(W,PCOS,PSIN,SP,BKL,BK,AM1,AM2,AM3,AM4,AM5,AM6,J) IMPLICIT REAL*8 (A-H,O-Z) DIMENSION W(1),PCOS(1),PSIN(1),BK(1),AM1(1),AM2(1),AM4(1),AM3(1), 1AM5(1),AM6(1) AM4(J)=W(J)*PCOS(J)*BKL *BK(J)/2. AM1(J)=W(J)*PCOS(J)*BKL *(1.-BK(J)/2.) AM5(J)=W(J)*PSIN(J)*BK(J)**2*SP/2.-(AM3(J)+AM6(J))/SP AM2(J)=W(J)*PSIN(J)*BKL *(1.-BK(J)/2.)+(AM3(J)+AM6(J))/SP RETURN END SUBROUTINE FXTIN(W,PSIN,SP,BK,AM3,AM6,J) IMPLICIT REAL*8 (A-H,O-Z) DIMENSION W(1),PSIN(1),BK(1),AM3(1),AM6(1) AM3(J)=(W(J)*(PSIN(J)*SP)**2/30.)*BK(J)**2*(10.-15.*BK(J)+6.*BK(J) 1**2) AM6(J)=(W(J)*(PSIN(J)*SP)**2/20.)*BK(J)**3*(4.*BK(J)-5.) RETURN END SUBROUTINE EATIN(W,PCOS,PSIN,SP,BKL,BK,AM1,AM2,AM3,AM4,AM5,AM6,J) IMPLICIT REAL*8 (A-H,O-Z) DIMENSION W(1),PCOS(1),PSIN(1),BK(1),AM1(1),AM2(1),AM3(1),AM4(1), 1AM5(1),AM6(1) AM4(J)=W(J)*PCOS(J)*BKL /2.*2./3.*BK(J) AM1(J)=W(J)*PCOS(J)*BKL /2.*(1.-2./3.*BK(J)) AM5(J)=W(J)*PSIN(J)*BKL /2.*2./3.*BK(J)-(AM3(J)+AM6(J))/SP AM2(J)=W(J)*PSIN(J)*BKL /2.*(1.-2./3.*BK(J))+(AM3(J)+AM6(J))/S 1P RETURN END SUBROUTINE FXTDE(W,PSIN,SP,BK,AM3,AM6,J) IMPLICIT REAL*8 (A-H,O-Z) DIMENSION W(1),PSIN(1),BK(1),AM3(1),AM6(1) AM3(J)=W(J)*(PSIN(J)*SP)**2/60.*BK(J)**2*(10.-10.*BK(J)+3.*BK(J)** 1 2) AM6(J)=W(J)*(PSIN(J)*SP)**2/60.*BK(J)**3*(3.*BK(J)-5.) RETURN END SUBROUTINE EATDE(W,PCOS,PSIN,BKL,SP,BK,AM1,AM2,AM3,AM4,AM5,AM6,J) IMPLICIT REAL*8 (A-H,O-Z) DIMENSION W(1),PCOS(1),PSIN(1),BK(1),AM1(1),AM2(1),AM3(1),AM4(1), 1AM5(1),AM6(1) AM4(J)=W(J)*PCOS(J)*BKL /2.*BK(J)/3. AM1(J)=W(J)*PCOS(J)*BKL /2.*(1.-BK(J)/3.) AM5(J)=W(J)*PSIN(J)*BKL /2.*BK(J)/3.-(AM3(J)+AM6(J))/SP AM2(J)=W(J)*PSIN(J)*BKL /2.*(1.-BK(J)/3.)+(AM3(J)+AM6(J))/SP RETURN END SUBROUTINE FXPAR(W,PSIN,SP,AM3,AM6,J) IMPLICIT REAL*8 (A-H,O-Z) DIMENSION W(1),PSIN(1),AM3(1),AM6(1) AM3(J)=W(J)*(PSIN(J)*SP)**2/15. AM6(J)=-AM3(J) RETURN END SUBROUTINE EAPAR(W,PCOS,PSIN,SP,AM1,AM2,AM4,AM5,J) IMPLICIT REAL*8 (A-H,O-Z) DIMENSION W(1),PCOS(1),PSIN(1),AM1(1),AM2(1),AM4(1),AM5(1) AM4(J)=W(J)*PCOS(J)*SP*2./6. AM1(J)=AM4(J) AM5(J)=W(J)*PSIN(J)*SP*2./6. AM2(J)=AM5(J) RETURN END SUBROUTINE FXCMT(AMC,BK,AM3,AM6,J) IMPLICIT REAL*8 (A-H,O-Z) DIMENSION AMC(1),BK(1),AM3(1),AM6(1) AM3(J)=-AMC(J)*(1.-BK(J))*(1.-3.*BK(J)) AM6(J)=AMC(J)*BK(J)*(3.*(1.-BK(J))-1.) RETURN END SUBROUTINE EACMT(AMC,SP,AM1,AM2,AM3,AM4,AM5,AM6,J) IMPLICIT REAL*8 (A-H,O-Z) DIMENSION AMC(1),AM1(1),AM2(1),AM3(1),AM4(1),AM5(1),AM6(1) AM4(J)=0. AM5(J)=-(AM3(J)+AM6(J)+AMC(J))/SP AM1(J)=0. AM2(J)=-AM5(J) RETURN END SUBROUTINE STIFF(Q,SMD,CX,CY,IDMEM,IQ) IMPLICIT REAL*8 (A-H,O-Z) INTEGER*4 Q REAL*8 IZZ(7) DIMENSION CX(1),CY(1),IDMEM(1) DIMENSION SMD(6,6),AA(7),S(24,24),CC(6,6),X(7),SAA(6,6),SBA(18,6) DIMENSION SAB(6,18),SBB(18,18) COMMON/SETUP/TIT1(10),E,IUBW,M,NJ,NR,NRJ,NRUN,NJNJ,N C ND=IDMEM(IQ) N3=3*(ND+1) N3M2=N3-2 N6=N3-6 DO 30 I=1,N3 DO 30 J=1,N3 30 S(I,J)=0. READ(5, *) (IZZ(J), J=1,ND) READ(5, *) (AA(J), J=1,ND) READ(5, *) (X(J), J=1,ND) C 504 FORMAT(7F10.0) WRITE(3,REC=Q) (IZZ(J), J=1,ND) WRITE(4,REC=Q) (X(J), J=1,ND) DO 8 J=1,ND SCM1=E*AA(J)/X(J) SCM2=4.*E*IZZ(J)/X(J) SCM3=1.5*SCM2/X(J) SCM4=2.*SCM3/X(J) CALL MEMST(SCM1,SCM2,SCM3,SCM4,SMD,CX,CY,IQ) CALL CALC3(J,S,SMD) 8 CONTINUE CALL CALC4(S,SAA,SAB,SBA,SBB,N3M2) CALL DCOMP(N6,SBB,NSR,IQ) CALL INVRT(N6,SBB) DO 20 K=1,6 DO 20 J=1,6 20 CC(K,J)=0. DO 21 J=1,6 DO 21 KK=1,6 DO 21 IK=1,N6 DO 21 K=1,N6 21 CC(J,KK)=CC(J,KK)+SAB(J,IK)*SBB(IK,K)*SBA(K,KK) DO 22 K=1,6 DO 22 J=1,6 22 SMD(K,J)=SAA(K,J)-CC(K,J) RETURN END SUBROUTINE MENDA (AM1,AM2,AM3,AM4,AM5,AM6,D,Q,I,JJ,JK,AX,L,IZ,CX, *CY,AE,RL,IDMEM,NLM) IMPLICIT REAL*8 (A-H,O-Z) INTEGER*4 Q,RL(1) REAL*8 L(1),IZ(1),AE(1) DIMENSION D(1),JJ(1),JK(1),AX(1),CX(1),CY(1),IDMEM(1) DIMENSION SMD(6,6),AML(6) COMMON/SETUP/TIT1(10),E,IUBW,M,NJ,NR,NRJ,NRUN,NJNJ,N IF(NLM.EQ.0) GO TO 45 READ(8,REC=I) (AML(J), J=1,6) GO TO 44 45 DO 43 KJL=1,6 43 AML(KJL)=0. 44 J1=3*JJ(I)-2 J2=3*JJ(I)-1 J3=3*JJ(I) K1=3*JK(I)-2 K2=3*JK(I)-1 K3=3*JK(I) IF(IDMEM(I)) 53,47,53 47 SCM1=E*AX(I)/L(I) SCM2=4.*E*IZ(I)/L(I) SCM3=1.5*SCM2/L(I) SCM4=2.*SCM3/L(I) AM1=AML( 1)+SCM1*((D(J1)-D(K1))*CX(I)+(D(J2)-D(K2))*CY(I)) AM2=AML( 2)+SCM4*(-(D(J1)-D(K1))*CY(I)+(D(J2)-D(K2))*CX(I))+SCM3* 1(D(J3)+D(K3)) AM3=AML( 3)+SCM3*(-(D(J1)-D(K1))*CY(I)+(D(J2)-D(K2))*CX(I))+SCM2* 1(D(J3)+D(K3)/2.) AM4=AML( 4)+SCM1*(-(D(J1)-D(K1))*CX(I)-(D(J2)-D(K2))*CY(I)) AM5=AML( 5)+SCM4*((D(J1)-D(K1))*CY(I)-(D(J2)-D(K2))*CX(I))-SCM3*( 1D(J3)+D(K3)) AM6=AML( 6)+SCM3*(-(D(J1)-D(K1))*CY(I)+(D(J2)-D(K2))*CX(I))+SCM2* 1(D(J3)/2.+D(K3)) GO TO 49 53 Q=Q+1 READ(2,REC=Q)((SMD(K,J),J=K,6),K=1,6) FE1=(SMD( 1,1)*D(J1)+SMD( 1,2)*D(J2)+SMD( 1,3)*D(J3)+SMD( 1,4) 1*D(K1)+SMD( 1,5)*D(K2)+SMD( 1,6)*D(K3)) FE2=SMD( 1,2)*D(J1)+SMD( 2,2)*D(J2)+SMD( 2,3)*D(J3)+SMD( 2,4)* 1D(K1)+SMD( 2,5)*D(K2)+SMD( 2,6)*D(K3) FE3=SMD( 1,3)*D(J1)+SMD( 2,3)*D(J2)+SMD( 3,3)*D(J3)+SMD( 3,4)* 1D(K1)+SMD( 3,5)*D(K2)+SMD( 3,6)*D(K3) FE4=SMD( 1,4)*D(J1)+SMD( 2,4)*D(J2)+SMD( 3,4)*D(J3)+SMD(4,4)* 1D(K1)+SMD(4,5) *D(K2)+SMD(4,6) *D(K3) FE5=SMD( 1,5)*D(J1)+SMD( 2,5)*D(J2)+SMD( 3,5)*D(J3)+SMD(4,5)* 1D(K1)+SMD(5,5) *D(K2)+SMD(5,6) *D(K3) FE6=SMD( 1,6)*D(J1)+SMD( 2,6)*D(J2)+SMD( 3,6)*D(J3)+SMD(4,6)* 1D(K1)+SMD(5,6) *D(K2)+SMD(6,6) *D(K3) AM1=AML( 1)+FE1*CX(I)+FE2*CY(I) AM2=AML( 2)+FE2*CX(I)-FE1*CY(I) AM3=AML( 3)+FE3 AM4=AML( 4)+FE4*CX(I)+FE5*CY(I) AM5=AML( 5)+FE5*CX(I)-FE4*CY(I) AM6=AML( 6)+FE6 49 IF(RL(J1).NE.1) GO TO 1 AE(J1)=AE(J1)+AM1*CX(I)-AM2*CY(I) 1 IF(RL(J2).NE.1) GO TO 2 AE(J2)=AE(J2)+AM1*CY(I)+AM2*CX(I) 2 IF(RL(J3).NE.1) GO TO 3 AE(J3)=AE(J3)+AM3 3 IF(RL(K1).NE.1) GO TO 4 AE(K1)=AE(K1)+AM4*CX(I)-AM5*CY(I) 4 IF(RL(K2).NE.1) GO TO 5 AE(K2)=AE(K2)+AM4*CY(I)+AM5*CX(I) 5 IF(RL(K3).NE.1) GO TO 6 AE(K3)=AE(K3)+AM6 6 RETURN END SUBROUTINE SBAND(N,B,X,U) IMPLICIT REAL*8 (A-H,O-Z) INTEGER*4 UBW DIMENSION U(N,1),X(1),B(1) COMMON/SETUP/TIT1(10),E,IUBW,M,NJ,NR,NRJ,NRUN,NJNJ,L UBW=IUBW DO 2 I=1,N J=I-UBW+1 IF((I+1)-UBW) 10,10,11 10 J=1 11 SUM=B(I) K1=I-1 IF(J-K1)12,12,2 12 DO 4 K=J,K1 IK1=I-K+1 4 SUM=SUM-U(K,IK1)*X(K) 2 X(I)=SUM*U(I,1) DO 5 I1=1,N I=N-I1+1 J=I+UBW-1 IF(J-N) 13,13,14 14 J=N 13 SUM=X(I) K2=I+1 IF(K2-J) 15,15,5 15 DO 6 K=K2,J KI1=K-I+1 6 SUM=SUM-U(I,KI1)*X(K) 5 X(I)=SUM*U(I,1) RETURN END SUBROUTINE CALC2 (J1,J2,J3,K1,K2,K3,RL,CRL,S,SMD) IMPLICIT REAL*8 (A-H,O-Z) INTEGER*4 RL(1),CRL(1),ROW,COL DIMENSION S(N,1),SMD(6,6) COMMON/SETUP/TIT1(10),E,IUBW,M,NJ,NR,NRJ,NRUN,NJNJ,N I2=2 IF(RL(J1)) 102,103,102 103 ROW=J1-CRL(J1) S(ROW,1)=S(ROW,1)+SMD(1,1) IF(RL(J2)) 104,105,104 105 S(ROW,I2)=S(ROW,I2)+SMD(1,2) 104 IF(RL(J3)) 106,107,106 107 COL=J3-CRL(J3)-ROW+1 S(ROW,COL)=S(ROW,COL)+SMD(1,3) 106 IF(RL(K1)) 108,109,108 109 COL=K1-CRL(K1)-ROW+1 S(ROW,COL)=SMD(1,4) 108 IF(RL(K2)) 110,111,110 111 COL=K2-CRL(K2)-ROW+1 S(ROW,COL)=SMD(1,5) 110 IF(RL(K3)) 112,113,112 113 COL=K3-CRL(K3)-ROW+1 S(ROW,COL)=SMD(1,6) 112 IF(COL-IUBW) 102,102,115 115 IUBW=COL 102 IF(RL(J2)) 114,117,114 117 ROW=J2-CRL(J2) S(ROW,1)=S(ROW,1)+SMD(2,2) IF(RL(J3)) 118,119,118 119 S(ROW,I2)=S(ROW,I2)+SMD(2,3) 118 IF(RL(K1)) 120,121,120 121 COL=K1-CRL(K1)-ROW+1 S(ROW,COL)=SMD(2,4) 120 IF(RL(K2)) 122,123,122 123 COL=K2-CRL(K2)-ROW+1 S(ROW,COL)=SMD(2,5) 122 IF(RL(K3)) 124,125,124 125 COL=K3-CRL(K3)-ROW+1 S(ROW,COL)=SMD(2,6) 124 IF(COL-IUBW) 114,114,127 127 IUBW=COL 114 IF(RL(J3)) 116,128,116 128 ROW=J3-CRL(J3) S(ROW,1)=S(ROW,1)+SMD(3,3) IF(RL(K1)) 129,130,129 130 COL=K1-CRL(K1)-ROW+1 S(ROW,COL)=SMD(3,4) 129 IF(RL(K2)) 131,132,131 132 COL=K2-CRL(K2)-ROW+1 S(ROW,COL)=SMD(3,5) 131 IF(RL(K3)) 133,134,133 134 COL=K3-CRL(K3)-ROW+1 S(ROW,COL)=SMD(3,6) 133 IF(COL-IUBW) 116,116,135 135 IUBW=COL 116 IF(RL(K1)) 136,137,136 137 ROW=K1-CRL(K1) S(ROW,1)=S(ROW,1)+SMD(4,4) IF(RL(K2)) 138,139,138 139 S(ROW,I2)=S(ROW,I2)+SMD(4,5) 138 IF(RL(K3)) 136,141,136 141 COL=K3-CRL(K3)-ROW+1 S(ROW,COL)=S(ROW,COL)+SMD(4,6) 136 IF(RL(K2)) 142,143,142 143 ROW=K2-CRL(K2) S(ROW,1)=S(ROW,1)+SMD(5,5) IF(RL(K3)) 142,145,142 145 S(ROW,I2)=S(ROW,I2)+SMD(5,6) 142 IF(RL(K3)) 7,147,7 147 ROW=K3-CRL(K3) S(ROW,1)=S(ROW,1)+SMD(6,6) 7 CONTINUE RETURN END SUBROUTINE DCOMP(N,A,NSR,IQ) IMPLICIT REAL*8 (A-H,O-Z) DIMENSION A(18,18) DO 14 I=1,N DO 14 J=I,N SUM=A(I,J) K1=I-1 IF(I-1) 21,10,21 21 DO 11 K=1,K1 11 SUM=SUM-A(K,I)*A(K,J) 10 IF(J-I) 12,22,12 22 IF(SUM) 13,13,23 23 NSR=0 TEMP=1.0/DSQRT(SUM) A(I,J)=TEMP GO TO 14 12 A(I,J)=SUM*TEMP 14 CONTINUE GO TO 15 13 NSR=1 WRITE(6,600) IQ 600 FORMAT(///' INPUT FOR NON-PRISMATIC MEMBER',I5,' IN ERROR'///) 15 RETURN END SUBROUTINE INVRT(N,U) IMPLICIT REAL*8 (A-H,O-Z) DIMENSION U(18,18) I1=N-1 DO 2 I=1,I1 J1=I+1 DO 2 J=J1,N SUM=0.0 K1=J-1 DO 3 K=I,K1 3 SUM=SUM-U(K,I)*U(K,J) 2 U(J,I)=SUM*U(J,J) DO 4 I=1,N DO 4 J=I,N SUM=0.0 DO 5 K=J,N 5 SUM=SUM+U(K,I)*U(K,J) U(I,J)=SUM 4 U(J,I)=SUM RETURN END SUBROUTINE FEND(KK,NN,LDID,PCOS,PSIN,BK,P,W,AMC,AML1,AML2,AML3, 1AML4,AML5,AML6,Q, IQ,IDMEM,L) IMPLICIT REAL*8 (A-H,O-Z) INTEGER*4 Q REAL*8 L(1),IZZ(7),LM(1001) DIMENSION NN(1),LDID(1),PCOS(1),PSIN(1),BK(1),P(1),W(1), *AMC(1),IDMEM(1),XL(7),XLL(7),RM(1001),X(1001),AM1(10),AM2(10), *AM3(10),AM4(10),AM5(10),AM6(10),PM(1001) C SP=SPAN LENGTH C KK=NUMBER OF LOADINGS IN A MEMBER C NN=1, WHEN LOADING LEFT TO RIGHT C NN=2, WHEN LOADING RIGHT TO LEFT C LDID=LOAD IDENTIFICATION NO. AS DEFINED BELOW C LDID=1 CONCENTRATED LOAD C LDID=2 UNIFORMLY DISTRIBUTED LOAD C LDID=3 DISTRIBUTED INCREASING TO THE RIGHT C LDID=4 DISTRIBUTED DECREASING TO THE RIGHT C LDID=5 PARABOLICALLY DISTRIBUTED LOAD C LDID=6 COUNTER CLOCKWISE APPLIED MOMENT C PCOS=COSINE OF CLOCKWISE ANGLE BETWEEN THE LOAD AND POSITIVE C MEMBER X-AXIS C PSIN=SINE OF THE PREVIOUS ANGLE C BK=FRACTION OF SPAN C C FOR GRAVITY LOADS, P AND W ARE POSITIVE C C P=CONCENTRATED LOAD C W=UNIFORM LOAD INTENSITY, WITH RESPECT TO MEMBER SPAN LENGTH C C AMC=APPLIED COUNTER CLOCKWISE MOMENT C ND=IDMEM(IQ) IF(ND) 565,566,565 565 Q=Q+1 READ(3,REC=Q) (IZZ(I), I=1,ND) READ(4,REC=Q) (XL(I), I=1,ND) AN=1000. DO 556 I=1,ND 556 XLL(I)=0. XLL(1)=XL(1) DO 555 I=2,ND 555 XLL(I)=XLL(I-1)+XL(I) 566 AML1=0. AML2=0. AML3=0. AML4=0. AML5=0. AML6=0. SP=L(IQ) DO 1 J=1,KK ID=LDID(J) BKL=BK(J)*SP IF(ND) 31,400,31 400 GO TO (10,20,30,40,50,60), ID 200 IF(NN(J)-2) 202,201,202 10 CALL FXCON(P,AM3,AM6,SP,BKL,PSIN,J) 41 CALL EACON(P,PCOS,PSIN,BK,SP,AM1,AM2,AM3,AM4,AM5,AM6,J) GO TO 200 20 CALL FXUNI(W,PSIN,SP,BK,AM3,AM6,J) 42 CALL EAUNI(W,PCOS,PSIN,SP,BKL,BK,AM1,AM2,AM3,AM4,AM5,AM6,J) GO TO 200 30 CALL FXTIN(W,PSIN,SP,BK,AM3,AM6,J) 43 CALL EATIN(W,PCOS,PSIN,SP,BKL,BK,AM1,AM2,AM3,AM4,AM5,AM6,J) GO TO 200 40 CALL FXTDE(W,PSIN,SP,BK,AM3,AM6,J) 44 CALL EATDE(W,PCOS,PSIN,BKL,SP,BK,AM1,AM2,AM3,AM4,AM5,AM6,J) GO TO 200 50 CALL FXPAR(W,PSIN,SP,AM3,AM6,J) 45 CALL EAPAR(W,PCOS,PSIN,SP,AM1,AM2,AM4,AM5,J) GO TO 200 60 CALL FXCMT(AMC,BK,AM3,AM6,J) 46 CALL EACMT(AMC,SP,AM1,AM2,AM3,AM4,AM5,AM6,J) GO TO 200 31 DO 32 K=1,1001 X(K)=0. PM(K)=0. LM(K)=0. 32 RM(K)=0. DO 33 K=1,1001 CALL CALC8(SP,AN,ID,BKL,PM,LM,RM,X,P,W,AMC,BK,PSIN,K,J) 33 CONTINUE SUMPM=0. SUMLM=0. SUMRM=0. H=SP/AN SPL=0. SML=0. SMR=0. DO 66 K=1,1000 CALL CALC9(SUMPM,SUMLM,SUMRM,H,SPL,SML,SMR,X,XLL,IZZ,PM,LM,RM,K,SP 1) 66 CONTINUE AM3(J)=-(SPL*SUMRM-SUMPM*SMR)/(SUMLM*SMR-SML*SUMRM) AM6(J)=-(SPL*SUMLM-SUMPM*SML)/(SUMLM*SMR-SML*SUMRM) GO TO (41,42,43,44,45,46), ID 201 FM=-AM3(J) AM3(J)=-AM6(J) AM6(J)=FM HH=AM1(J) AM1(J)=AM4(J) AM4(J)=HH V=AM2(J) AM2(J)=AM5(J) AM5(J)=V 202 AML1=AML1+AM1(J) AML2=AML2+AM2(J) AML3=AML3+AM3(J) AML4=AML4+AM4(J) AML5=AML5+AM5(J) AML6=AML6+AM6(J) 1 CONTINUE RETURN END SUBROUTINE EQACT(AE,JJ,JK,CX,CY,I) IMPLICIT REAL*8 (A-H,O-Z) DIMENSION AE(1),JJ(1),JK(1),CX(1),CY(1),AML(6) READ(8,REC=I) (AML(J), J=1,6) J1=3*JJ(I)-2 J2=3*JJ(I)-1 J3=3*JJ(I) K1=3*JK(I)-2 K2=3*JK(I)-1 K3=3*JK(I) AE(J1)=AE(J1)-AML( 1)*CX(I)+AML( 2)*CY(I) AE(J2)=AE(J2)-AML( 1)*CY(I)-AML( 2)*CX(I) AE(J3)=AE(J3)-AML( 3) AE(K1)=AE(K1)-AML( 4)*CX(I)+AML( 5)*CY(I) AE(K2)=AE(K2)-AML( 4)*CY(I)-AML( 5)*CX(I) AE(K3)=AE(K3)-AML( 6) RETURN END SUBROUTINE CALC8(SP,AN,ID,BKL,PM,LM,RM,X,P,W,AMC,BK,PSIN,K,J) IMPLICIT REAL*8 (A-H,O-Z) REAL*8 LM(1) DIMENSION PM(1),RM(1),X(1),P(1),W(1),AMC(1),BK(1),PSIN(1) SI=K CI=SI-1. X(K)=SP/AN*CI GO TO (11,12,13,14,15,16), ID 11 IF(X(K)-BKL) 300,300,3 300 PM(K)=P(J)*PSIN(J)*(1.-BK(J))*X(K) GO TO 103 3 PM(K)=P(J)*PSIN(J)*BK(J)*(SP-X(K)) GO TO 103 12 IF(X(K)-BKL) 302,302,4 302 PM(K)=W(J)*PSIN(J)*BKL *(1.-BK(J)/2.)*X(K)-W(J)*PSIN(J)*X(K)** 12/2. GO TO 103 4 PM(K)=W(J)*PSIN(J)*BK(J)**2*SP/2.*(SP-X(K)) GO TO 103 13 IF(X(K)-BKL) 303,303,5 303 PM(K)=W(J)*PSIN(J)*BKL /2.*(1.-2./3.*BK(J))*X(K)-W(J)*PSIN(J)* 1 X(K)**3/(BKL*6.) GO TO 103 5 PM(K)=W(J)*PSIN(J)*BKL /2.*2./3.*BK(J)*(SP-X(K)) GO TO 103 14 IF(X(K)-BKL)304,304,6 304 PM(K)=W(J)*PSIN(J)*BKL /2.*(1.-BK(J)/3.)*X(K)-W(J)*PSIN(J)*(1. 1+(BKL-X(K))/BKL)*X(K)/2.*((2.+(BKL-X(K))/BKL)/(3.*(1.+(BKL-X(K))/B 2KL))*X(K)) GO TO 103 6 PM(K)=W(J)*PSIN(J)*BKL /2.*BK(J)/3.*(SP-X(K)) GO TO 103 15 PM(K)=W(J)*PSIN(J)*SP/3.*X(K)-(4.*W(J)*PSIN(J)/SP*(-(X(K)**4)/(4.* 1SP)+X(K)**3/3.)) GO TO 103 16 IF(X(K)-BKL) 305,305,8 305 PM(K)=AMC(J)/SP*X(K) GO TO 103 8 PM(K)=-AMC(J)/SP*(SP-X(K)) 103 LM(K)=(SP-X(K))/SP RM(K)=X(K)/SP RETURN END SUBROUTINE CALC9(SUMPM,SUMLM,SUMRM,H,SPL,SML,SMR,X,XLL,IZZ,PM,LM, 1RM,K,SP) IMPLICIT REAL*8 (A-H,O-Z) REAL*8 LM(1),IZZ(1) DIMENSION X(1),XLL(7),PM(1),RM(1) N=K+1 XMDX=X(N)-0.0000001 IF(XMDX-XLL(1)) 321,321,322 321 IJK=1 GO TO 350 322 IF(XMDX-XLL(2)) 323,323,324 323 IJK=2 GO TO 350 324 IF(XMDX-XLL(3)) 325,325,326 325 IJK=3 GO TO 350 326 IF(XMDX-XLL(4)) 327,327,328 327 IJK=4 GO TO 350 328 IF(XMDX-XLL(5)) 329,329,330 329 IJK=5 GO TO 350 330 IF(XMDX-XLL(6)) 331,331,332 331 IJK=6 GO TO 350 332 IF(XMDX-XLL(7)) 334,334,350 334 IJK=7 350 DVD=2./H*IZZ(IJK) SUMPM=SUMPM+(PM(K)+PM(N ))/DVD SUMLM=SUMLM+(LM(K)+LM(N ))/DVD SUMRM=SUMRM+(RM(K)+RM(N ))/DVD SPL=SPL+(PM(K)+PM(N ))/DVD*(SP-(X(K)+ (PM(K)+2.*PM(N ))*H/(3.*(P 1M(K)+PM(N ))))) SML=SML+(LM(K)+LM(N ))/DVD*(SP-(X(K)+ (LM(K)+2.*LM(N ))*H/(3.*(L 1M(K)+LM(N ))))) SMR=SMR+(RM(K)+RM(N ))/DVD*(SP-(X(K)+ (RM(K)+2.*RM(N ))*H/(3.*(R 1M(K)+RM(N ))))) RETURN END