PROGRAM SPECTR C C C PROGRAM TO EVALUATE RESPONSE SPECTRA AT UNIFORM PERIOD INTERVAL C ON A LOG-LOG PLOT. C VERSION 1/19/96 C REAL DT,EQMUL,ACC,SDAMP,DD INTEGER NREC,KG,NDAMP,L,NTIMES CHARACTER TITLE*60 COMMON /LOGPLT/ T(50), SV(50,5), NTIMES, NDAMP,SA(50,5),TITLE DIMENSION ACC(6000) DIMENSION PAA(50), PRV(50), RV(50),RD(50), SDAMP(5),aa(50) OPEN(5,FILE = "specti",STATUS = "OLD") OPEN(6,FILE = "specto",STATUS = "UNKNOWN") OPEN(7,FILE = "specto1",STATUS = "UNKNOWN") C************************************************************************ C NREC - NUMBER OF RECORDS C DT - TIME ITERVAL OF RECORD C KG - NUMBER OF VALUES OF ACCELERATION IN RECORD C ACC - ACCELERATION VALUES C TITLE - TITLE OF RECORD C EQMUL - ACCELERATION MULTIPLIER C NDAMP - NUMBER OF DAMPING VALUES C SDAMP - DAMPING C D - DAMPING RATIO C************************************************************************ C COMMON /LOGPLT/ T(50), SV(50,5), NTIMES, NDAMP, SDAMP(5) C DIMENSION ACC(6000) C DIMENSION PAA(50), PRV(50), RV(50), RD(50), AA(50) REWIND 5 READ(5,2) TITLE WRITE(6,3) TITLE READ(5,12) NREC READ(5,12) KG WRITE(6,1) WRITE(6,13) NREC WRITE(6,13) KG READ(5,22) DT, EQMUL WRITE(6, 23) DT, EQMUL READ(5, 12) NDAMP WRITE(6,13) NDAMP READ(5,22) (SDAMP(I),I=1,NDAMP) WRITE(6,23) (SDAMP(I),I=1,NDAMP) DO 1000 NT=1,NREC READ(5,42) (ACC(I), I=1,KG) c WRITE(6,43) (ACC(I),I=1,KG) C C ACCELERATION VALUES SHOULD BE IN G AT EQUAL DT TIME INTERVALS C DO 20 I=1,KG 20 ACC(I)= 32.2 * ACC(I) * EQMUL KUG= KG - 1 WRITE (6,32) TITLE C DO 500 NDR=1,NDAMP D=SDAMP(NDR) WRITE (6,112) D WRITE (6,312) N=1 C C COMPUTE 12 POINTS PER LOG CYCLE STARTING AT T=0.01 SECONDS. C START= -2. NTIMES= 49 YY=SQRT(1. - D * D) DO 200 LOOP=1,NTIMES T(N)=10. ** (START + FLOAT(N-1) * 1./12.) W=6.2831853/T(N) WD=YY * W W2=W * W W3=W2 * W CALL CMPMAX(KUG,ACC,W,W2,W3,WD,D,DT,ZD,ZV,ZA) AA(N)=ZA/32.2 RV(N)=ZV RD(N)=ZD PRV(N)=W*ZD PAA(N)=W2*ZD/32.2 200 N=N+1 C M=N-1 DO 320 N=1,M WRITE(7,323)T(N),PRV(N),AA(N) 320 WRITE (6,322) N,T(N),RD(N),RV(N),PRV(N),AA(N),PAA(N) C C C EVALUATE SPECTRAL INTENSITY (FROM PERIOD 0.10 TO 2.61 SECONDS). C C S1 = 0. S2 = 0. S3 = 0. DO 350 L=14,30 DD = (T(L)-T(L-1))/2. S1=S1+DD*(RV(L)+RV(L-1)) S2=S2+DD*(PRV(L)+PRV(L-1)) 350 S3=S3+(PRV(L)+PRV(L-1))*0.5/12.0 WRITE (6,362)D,S1,S2,S3 C DO 400 I=1,NTIMES SV(I,NDR)=PRV(I) SA(I,NDR)=AA(i) SA(I,NDR)=ALOG10(SA(I,NDR))+2. 400 SV(I,NDR)=ALOG10(SV(I,NDR))+2. C 400 CONTINUE c 500 CONTINUE CALL PLOTT(600) 600 continue CALL PLOTTA 1000 CONTINUE C*************************************************************** C FORMAT HAS BEEN CHANGED !!!!!!!!!!!!!!! C*************************************************************** 1 FORMAT (1X,' INPUT DATA ECHO CHECK',/) 2 FORMAT (A) 3 FORMAT (1H0,20A3,//21H INPUT ACCELERATIONS,) 12 FORMAT (1I5) 13 FORMAT (1H,1I5) 22 FORMAT (6F10.0) 23 FORMAT (1H,6F10.4) 32 FORMAT (1X,A) C FORMAT STATEMENTS FOR ACCELERATION DATA IN 6 AND 8 COLUMNS C 42 FORMAT (6E12.5) 42 FORMAT(8E9.6) 43 FORMAT (1H,6E11.5) 112 FORMAT (/42H DAMPING RATIO FOR RESPONSE SPECTRA EQUALS, F7.3, 15X,I5) 312 FORMAT (/5X,3HNO.,4X,6HPERIOD,5X,10HREL. DISP.,6X,9HREL. VEL.,3X 2 12HPSU.REL.VEL.,6X,9HABS. ACC.,3X,12HPSU.ABS.ACC. /) 322 FORMAT (I8,F10.3,5F15.5) 323 FORMAT (F10.3,2F15.5) 362 FORMAT (/10X,' TRIPARTITE LOGARITHMIC SPECTRAL INTENSITY = ' , 1 F5.2/, 1 22X,' BASED ON REL. VEL., SI = ', F8.3,/, 2 15X,' BASED ON PSUEDO REL. VEL., SI = ', F8.3,/, 3 15X,' TRIPARTITE LOG-LOG, S3= ',F8.3) C 3 15X,' TRIPARITE LOG-LOG , S3 = ',F8.3 ) 412 FORMAT (17H P.R.V. SPECTRUM,, 23H DAMPING RATIO EQUAL TO, F6.2) 422 FORMAT (10F7.3) C**************************************************************** END C C SUBROUTINE CMPMAX (KUG,UG,W,W2,W3,WD,D,DT,ZD,ZV,ZA) REAL ZD,ZV,ZA,XD,XV,F1,F2,F3,F4,F5,F6,E,S,C,G1,G2,H1,H2,Z1,Z2, 1 Z3,Z4,B,A,AA,F,WD,W,W2,W3,H CHARACTER*60 TITLE INTEGER Y,K,KUG COMMON /LOGPLT/ T(50), SV(50,5), NTIMES, NDAMP,SA(50,5),TITLE DIMENSION UG(6000), XD(2), XV(2) C DIMENSION UG(*),XD(2),XV(2),T(3) C ZD=0. ZV=0. ZA=0. XD(1)=0. XV(1)=0. F1=2.*D/(W3*DT) F2=1./W2 F3=D*W F4=1./WD F5=F3*F4 F6=2.*F3 E=EXP(-F3*DT) S=SIN(WD*DT) C=COS(WD*DT) G1=E*S G2=E*C H1=WD*G2-F3*G1 H2=WD*G1+F3*G2 C DO 100 K=1,KUG Y=K-1 DUG = UG(K+1) - UG(K) Z1 = F2 * DUG Z2 = F2 * UG(K) Z3 = F1 * DUG Z4 = Z1 / DT B = XD(1) + Z2 - Z3 A = F4 * XV(1) + F5 * B + F4 * Z4 XD(2) = A * G1 + B * G2 + Z3 - Z2 - Z1 XV(2) = A * H1 - B * H2 - Z4 XD(1) = XD(2) XV(1)=XV(2) AA=-F6*XV(1)-W2*XD(1) F=ABS(XD(1)) G=ABS(XV(1)) H=ABS(AA) IF (F.LE.ZD) GO TO 75 ZD=F 75 IF (G.LE.ZV) GO TO 85 ZV=G 85 IF (H.LE.ZA) GO TO 100 ZA=H 100 CONTINUE RETURN END C C C SUBROUTINE PLOTT(*) C C SUBROUTINE FOR PLOTTING A SET OF SPECTRA TO A LOG-LOG C SCALE. PERIOD AS ABSCISSA AND PSEUDO-RELATIVE VELOCITY C AS ORDINATE. PERIOD BETWEEN 0.01 AND 100 SECONDS. C PSEUDO-RELATIVE VELOCITY BETWEEN 0.01 AND 10 FEET PER SECOND. C CHARACTER*60 TITLE COMMON /LOGPLT/ T(50), SV(50,5), NTIMES, NDAMP,SA(50,5),TITLE DIMENSION DUM(4), ALINE(80), LL(50) C COMMON /LOGPLT/ T(50),SV(50,5),NTIMES,NDAMP,SDAMP(5) C DIMENSION DUM(4),ALINE(80),LL(50) C CHARACTER TITLE*60 C DATA BLANK,DOT,SPOT,PLUS /1H ,1H.,1H*,1H+ / DATA LL /1H ,1H ,1H ,1H ,1H ,1HU,1HN,1HD,1HA,1HM,1HP,1HE,1HD, 1 1H ,1H ,1H ,1HN,1HA,1HT,1HU,1HR,1HA,1HL,1H ,1H ,1H ,1HP, 2 1HE,1HR,1HI,1HO,1HD,1H ,1H ,1H ,1H*,1HS,1HE,1HC,1HO,1HN, 3 1HD,1HS,1H*,1H ,1H ,1H ,1H ,1H , 1H / C YPLOT=3. DUM(1)=.01 DUM(2)=.10 DUM(3)=1. DUM(4)=10. WRITE (6,32) TITLE, (DUM(J), J=1,4) DO 20 J1=10,80 20 ALINE(J1)=BLANK KPLOT =12 DO 100 J2=1,NTIMES KN=(J2/KPLOT)*KPLOT+1 c IF (KN.NE.J2) GO TO 50 DO 30 JKK=1,70 30 ALINE(JKK)=DOT c DO 40 I=10,70,20 40 ALINE(I)=PLUS GO TO 60 50 DO 55 I=10,70,20 55 ALINE(I)=DOT 60 CONTINUE C DO 80 NN=1,NDAMP yplot=3. J1=(60.*(SV(J2,NN)/YPLOT)+10.5) c 80 ALINE(J1)=SPOT c c WRITE(6,52) T(J2),LL(J2),(ALINE(I), I=10,80) DO 90 KK=10,80 c 90 ALINE(KK)=BLANK c 100 CONTINUE return 1 C******************************************************************* 32 FORMAT (1X,A, /20X, 'PSEUDO-RELATIVE VELOCITY (FT/SEC)', // 1 8X,F6.2,14X,F6.2,14X,F6.2,12X,F6.2 /) 52 FORMAT (1X,F7.3, 2X, A1, 1X, 71A1) C******************************************************************* END SUBROUTINE PLOTTA C C SUBROUTINE FOR PLOTTING A SET OF SPECTRA TO A LOG-LOG C SCALE. PERIOD AS ABSCISSA AND absolute acceleratio C AS ORDINATE. PERIOD BETWEEN 0.01 AND 100 SECONDS. C ABSOLUTE ACCELERATIO BETWEEN 0.01 AND 10 FEET PER SECOND2. C CHARACTER*60 TITLE COMMON /LOGPLT/ T(50), SV(50,5), NTIMES, NDAMP,SA(50,5),TITLE DIMENSION DUM(4), ALINE(80), LL(50) C COMMON /LOGPLT/T(50),SV(50,5),NTIMES,NDAMP,SDAMP(5) C DIMENSION DUM(4),ALINE(80),LL(50) c CHARACTER TITLE*80 C DATA BLANK,DOT,SPOT,PLUS /1H ,1H.,1H*,1H+ / DATA LL /1H ,1H ,1H ,1H ,1H ,1HU,1HN,1HD,1HA,1HM,1HP,1HE,1HD, 1 1H ,1H ,1H ,1HN,1HA,1HT,1HU,1HR,1HA,1HL,1H ,1H ,1H ,1HP, 2 1HE,1HR,1HI,1HO,1HD,1H ,1H ,1H ,1H*,1HS,1HE,1HC,1HO,1HN, 3 1HD,1HS,1H*,1H ,1H ,1H ,1H ,1H , 1H / C YPLOT=3. DUM(1)=.01 DUM(2)=.10 DUM(3)=1. DUM(4)=10. WRITE (6,32) TITLE, (DUM(J), J=1,4) DO 20 J1=10,80 20 ALINE(J1)=BLANK KPLOT =12 DO 100 J2=1,NTIMES KN=(J2/KPLOT)*KPLOT+1 IF (KN.NE.J2) GO TO 50 DO 30 JKK=1,70 30 ALINE(JKK)=DOT DO 40 I=10,70,20 40 ALINE(I)=PLUS GO TO 60 50 DO 55 I=10,70,20 55 ALINE(I)=DOT 60 CONTINUE C DO 80 NN=1,NDAMP yplot=3. J1=60.*(SA(J2,NN)/YPLOT)+10.5 80 ALINE(J1)=SPOT WRITE(6,52) T(J2),LL(J2),(ALINE(I), I=10,80) DO 90 KK=10,80 90 ALINE(KK)=BLANK 100 CONTINUE C******************************************************************* 32 FORMAT (//,1X,A60,/,20X,' ABSOLUTE ACCELERATION (FT/SEC2) ' ,// 1 8X,F6.2,14X,F6.2,14X,F6.2,12X,F6.2 /) 52 FORMAT (1X,F7.3, 2X, A1, 1X, 71A1) C******************************************************************* RETURN END