编辑代码

        PROGRAM PREDICTED CHARACTERI FROM MODEL TEST 
        CHARACTER*30 PNAME
        DIMENSION T0C(12),Q0C(12),T0T(12),Q0T(12),TC(12),QC(12)
        DIMENSION TT(12),QT(12),ETAH(12),ETAD(12),ETA0(12),RN(12)
        DIMENSION VS(12),PE(12),PDT(12),TS(12),WS(12),T(12),ETAR(12)
        DIMENSION W1(12),W2(12),W3(12),W4(12)

        OPEN(2,FILE='PRE.DAT',STATUS='OLD')
        READ(2,"(A18)") PNAME
        READ(2,*) nn,DS,Z,DFT,ZP,PD0,RN0
C       DESIGNED DIAMETER[M],BLADE NUMBER,DRAFT[M],SHAFT LINE TO BASE
C       DELIVERED POWER[KW](CSR*ETAS) & RATE OF ENGINE
        SH=DFT-ZP
C       DISTANCE OF SHAFT TO WATER SURFACE [m]
        DO 1 I=1,nn
1       READ(2,*) VS(I),W1(I),W2(I),PE(I),PDT(I),TS(I),W3(I),W4(I)
        DO 2 I=1,nn
        READ(2,*) VS(I),ETAD(I),ETA0(I),ETAH(I),ETAR(I),WS(I),
     &             T(I),W1(I)
2       CONTINUE
        DO 3 I=1,nn
3        READ(2,*) VS(I),W1(I),RN(I),PDT(I),W2(I)
        
        PD1=PD0
        PD2=PD1/1.15

        OPEN(8,FILE='sj',status='unknown')

        CALL LAQ(nn,PDT,VS,PD1,VS1)
        CALL LAQ(nn,PDT,VS,PD2,VS2)
        
        CALL LAQ(nn,VS,PE,VS1,PE1)
        CALL LAQ(nn,VS,PE,VS2,PE2)
        CALL LAQ(nn,VS,TS,VS1,TS1)
        CALL LAQ(nn,VS,TS,VS2,TS2)
        CALL LAQ(nn,VS,RN,VS1,RN1)
        CALL LAQ(nn,VS,RN,VS2,RN2)
        CALL LAQ(nn,VS,WS,VS1,WS1)
        CALL LAQ(nn,VS,WS,VS2,WS2)
        CALL LAQ(nn,VS,T,VS1,T1)
        CALL LAQ(nn,VS,T,VS2,T2)
        CALL LAQ(nn,VS,ETAR,VS1,ETAR1)
        CALL LAQ(nn,VS,ETAR,VS2,ETAR2)

        write(8,"(A18)") PNAME
        write(8,*) Z,DS,0.160,RN0,TS1/9.8*1000.0,PD1/0.7355*etar1,
     &  VS1,SH,T1,ETAR1,7600.0,6.0,104.5
        write(8,*) ('2,2')
        write(8,*) ('0.8,590.0,0.6')
        WRITE(8,*) WS1,WS1,WS1,WS1,WS1,WS1,WS1,WS1,WS1

        OPEN(3,FILE='PRE.RST',STATUS='UNKNOWN')
        WRITE(3,"(A18)") PNAME
        WRITE(3,*) ('DESIGN POWER='),PD1,('KW'),PD1/0.7355,('hp')
        WRITE(3,*) ('VS='),VS1,('Kn')
        WRITE(3,*) ('PE='),PE1,('KW')
        WRITE(3,*) ('THRUST='),TS1,('KN'),TS1/9.8*1000.0,('Kgf')
        WRITE(3,*) ('STOCK PROPELLER ROTATION='),RN1,('R/MIN')
        WRITE(3,*) ('W effective='),WS1,('THRUST deduction='),T1
        WRITE(3,*) ('RELATIVE ROTATIONAL FACTOR='),ETAR1
        
        WRITE(3,*) ('DESIGNED D='),DS,('m')
        WRITE(3,*) ('DESIGNED RN='),RN0,('r/min')
        WRITE(3,*) ('DESIGNED J='),VS1*30.87*(1.0-WS1)/RN0/DS
        WRITE(3,*) ('DESIGNED Kt='),TS1*3514.94/RN0/RN0/DS**4
        WRITE(3,*) ('DESIGNED Kq='),PD1*33568.5/RN0/RN0**2/DS**5*ETAR1
        Dopt=50.0*(PD1/0.985/0.7355*75.0/76.0)**.2/(RN1)**.6/3.28
        WRITE(3,*) ('Dopt='),Dopt,('m')
        EAR=(1.3+0.3*Z)*TS1/(98.3+SH*9.8)/Dopt**2+0.15
        WRITE(3,*) ('ESTIMATED DISC AREA RATIO FOR Dopt'),EAR
        WRITE(3,*) ('SHAFT DEPTH TO WATER SURFACE='),SH,('m')
        EAR=(1.3+0.3*Z)*TS1/(98.3+SH*9.8)/DS**2+0.15
        WRITE(3,*) ('E.A.R FOR Ddesign='),EAR
        WRITE(3,*) ('            ')
        
        WRITE(3,*) ('DESIGN POWER/1.15=  '),PD2,('KW'),PD2/.7355
        WRITE(3,*) ('VS='),VS2,('Kn')
        WRITE(3,*) ('PE='),PE2,('KW')
        WRITE(3,*) ('THRUST='),TS2/9.8*1000.0,('Kgf')
        WRITE(3,*) ('STOCK PROPELLER ROTATION='),RN2,('R/MIN')
        WRITE(3,*) ('W effective='),WS2,('THRUST deduction='),T2
        WRITE(3,*) ('RELATIVE ROTATIONAL FACTOR='),ETAR2
        VSS=VS1-0.25
C        VSS=VS2-0.5
        DO 4 I=1,10
        VSS=VSS+0.050
        CALL LAQ(8,VS,PE,VSS,PES)
        CALL LAQ(8,VS,TS,VSS,TSS)
        CALL LAQ(8,VS,WS,VSS,WSS)
        CALL LAQ(8,VS,T,VSS,TTS)
        CALL LAQ(8,VS,ETAR,VSS,ETARS)
        CALL LAQ(nn,VS,RN,VSS,RNN)
        WRITE(3,*) ('      ')
        WRITE(3,*) ('VS='),VSS,('Kn')
        WRITE(3,*) ('ROTATIONS='),RNN
        WRITE(3,*) ('PE='),PES,('KW'),(' T='),TSS/9.8*1000.0,('Kgf')
        WRITE(3,*) ('W effective='),WSS,('THRUST deduction='),TTS
        WRITE(3,*) ('RELATIVE ROTATIONAL FACTOR='),ETARS
        WRITE(3,*) (' J FOR RN0='),VSS*30.87*(1.0-WSS)/RN0/DS
        WRITE(3,*) (' Kt FOR RN0='),TSS*3514.94/RN0/RN0/DS**4
4       WRITE(3,*) (' Kq FOR RNO='),PD1*33568.5/RN0/RN0**2/DS**5*ETARS
        
        STOP
        END

        SUBROUTINE LAQ(N,A,B,X,Y)
        DIMENSION A(N),B(N)
        N1=N-2
        DO 1 I=1,N1
        IF(X.LE.A(I+1)) GOTO 2
1       CONTINUE
        I=N-2
2       IF(I.EQ.1) GOTO 3
        IF(X-A(I).GE.A(I+1)-X) GOTO 3
        I=I-1
3       A1=A(I)
        A2=A(I+1)
        A3=A(I+2)
        U=(X-A2)*(X-A3)/((A1-A2)*(A1-A3))
        V=(X-A3)*(X-A1)/((A2-A3)*(A2-A1))
        W=(X-A1)*(X-A2)/((A3-A1)*(A3-A2))
        Y=U*B(I)+V*B(I+1)+W*B(I+2)
        RETURN
        END
       
      SUBROUTINE SIMPS(F,H,N,S)
      DIMENSION F(N)
      S2=0.0
      S4=0.0
      S1=F(1)-F(N)
      DO 108 I=1,(N-1)/2
      S2=S2+F(2*I+1)
 108  S4=S4+F(2*I)
      S=S1+2.0*S2+4.0*S4
      S=S*H/3.0
      RETURN
      END