      SUBROUTINE ALG09
C
      REAL LOSS,LAMI,LAMIP1,LAMIM1
C
      DIMENSION XX1(21),XX2(21),XX3(21),XX4(21),XX5(21),XX6(21),SOL(21),
     1WPARA(21),WD(21),DIF(21),WS(21),PM1(21),XINC(21),BETA1(21),TALPH1(
     221),ANG(21),HIGHM(21),WT(21),XMR(21)
C
      COMMON /UD3PRT/ IPRTC
      COMMON /UD300C/ NSTNS,NSTRMS,NMAX,NFORCE,NBL,NCASE,NSPLIT,NREAD,
     1NPUNCH,NPAGE,NSET1,NSET2,ISTAG,ICASE,IFAILO,IPASS,I,IVFAIL,IFFAIL,
     2NMIX,NTRANS,NPLOT,ILOSS,LNCT,ITUB,IMID,IFAIL,ITER,LOG1,LOG2,LOG3,
     3LOG4,LOG5,LOG6,IPRINT,NMANY,NSTPLT,NEQN,NSPEC(30),NWORK(30),
     4NLOSS(30),NDATA(30),NTERP(30),NMACH(30),NL1(30),NL2(30),NDIMEN(30)
     5,IS1(30),IS2(30),IS3(30),NEVAL(30),NDIFF(4),NDEL(30),NLITER(30),
     6NM(2),NRAD(2),NCURVE(30),NWHICH(30),NOUT1(30),NOUT2(30),NOUT3(30),
     7NBLADE(30),DM(11,5,2),WFRAC(11,5,2),R(21,30),XL(21,30),X(21,30),
     8H(21,30),S(21,30),VM(21,30),VW(21,30),TBETA(21,30),DIFF(15,4),
     9FDHUB(15,4),FDMID(15,4),FDTIP(15,4),TERAD(5,2),DATAC(100),
     1DATA1(100),DATA2(100),DATA3(100),DATA4(100),DATA5(100),DATA6(100),
     2DATA7(100),DATA8(100),DATA9(100),FLOW(10),SPEED(30),SPDFAC(10),
     3BBLOCK(30),BDIST(30),WBLOCK(30),WWBL(30),XSTN(150),RSTN(150),
     4DELF(30),DELC(100),DELTA(100),TITLE(18),DRDM2(30),RIM1(30),
     5XIM1(30),WORK(21),LOSS(21),TANEPS(21),XI(21),VV(21),DELW(21),
     6LAMI(21),LAMIM1(21),LAMIP1(21),PHI(21),CR(21),GAMA(21),SPPG(21),
     7CPPG(21),HKEEP(21),SKEEP(21),VWKEEP(21),DELH(30),DELT(30),VISK,
     8SHAPE,SCLFAC,EJ,G,TOLNCE,XSCALE,PSCALE,PLOW,RLOW,XMMAX,RCONST,
     9FM2,HMIN,C1,PI,CONTR,CONMX
C
      WMAX=0.7
      L1=I+NL1(I)
      XN=SPEED(I)*SPDFAC(ICASE)*PI/(30.0*SCLFAC)
      IF(IPRINT.EQ.0)GO TO 116
      L2=ABS(FLOAT(NEVAL(I)))
      CALL ALG03(LNCT,7+NSTRMS)
      LNCT=LNCT-3
      IF(NEVAL(I).GT.0.AND.IPRTC.EQ.1) WRITE(LOG2,100) L1,I,L2
      IF(NEVAL(I).LT.0.AND.IPRTC.EQ.1) WRITE(LOG2,110) L1,I,L2
100   FORMAT(2X,/,8X,57HLOSS COEFFICIENT DETERMINATION FOR BLADE BETWEEN
     1 STATIONS,I3,4H AND,I3,47H - AS INCORPORATED IN ABOVE RESULTS  BLA
     1DE TYPE,I2,/,8X,116(1H*),/,2X)
110   FORMAT(2X,/,8X,57HLOSS COEFFICIENT DETERMINATION FOR BLADE BETWEEN
     1 STATIONS,I3,4H AND,I3,47H - FOR PURPOSES OF COMPARISON ONLY   BLA
     2DE TYPE,I2,/,8X,116(1H*),/,2X)
116   L2=NDIMEN(I)+1
      GO TO(120,140,160,180),L2
120   DO 130 J=1,NSTRMS
      XX2(J)=R(J,L1)
130   XX6(J)=R(J,I)
      GO TO 200
140   DO 150 J=1,NSTRMS
      XX2(J)=R(J,L1)/R(NSTRMS,L1)
150   XX6(J)=R(J,I)/R(NSTRMS,I)
      GO TO 200
160   DO 170 J=1,NSTRMS
      XX2(J)=XL(J,L1)
170   XX6(J)=XL(J,I)
      GO TO 200
180   DO 190 J=1,NSTRMS
      XX2(J)=XL(J,L1)/XL(NSTRMS,L1)
190   XX6(J)=XL(J,I)/XL(NSTRMS,I)
200   L2=IS2(I)
      CALL ALG01(DATAC(L2),DATA5(L2),NDATA(I),XX6,SOL,X1,NSTRMS,NTERP(I
     1),0)
      Q=1.0
      IF(SPEED(I).LT.0.0)GO TO 208
      IF(SPEED(I).GT.0.0)GO TO 206
      IF(I.LT.3)GO TO 208
      II=I-1
204   IF(SPEED(II).NE.0.0)GO TO 205
      IF(II.EQ.2)GO TO 208
      II=II-1
      GO TO 204
205   IF(SPEED(II).LT.0.0)Q=-1.0
      GO TO 208
206   Q=-1.0
208   DO 210 J=1,NSTRMS
      TALPH1(J)=(VW(J,L1)-XN*R(J,L1))/VM(J,L1)
210   DIF(J)=1.0-VM(J,I)/VM(J,L1)*SQRT((1.0+TBETA(J,I)**2)/(1.0+TALPH1(J
     1)**2))+(VM(J,L1)*TALPH1(J)-VM(J,I)*TBETA(J,I))/(2.0*SOL(J)*VM(J,L1
     2)*SQRT(1.0+TALPH1(J)**2))*Q
      L2=ABS(FLOAT(NEVAL(I)))
      L3=NDIFF(L2)
      CALL ALG01(DIFF(1,L2),FDHUB(1,L2),L3,DIF,XX3,X1,NSTRMS,0,0)
      CALL ALG01(DIFF(1,L2),FDMID(1,L2),L3,DIF,XX4,X1,NSTRMS,0,0)
      CALL ALG01(DIFF(1,L2),FDTIP(1,L2),L3,DIF,XX5,X1,NSTRMS,0,0)
      XX1(1)=0.1
      XX1(2)=0.5
      XX1(3)=0.9
      DO 220 J=1,NSTRMS
      XX1(4)=XX3(J)
      XX1(5)=XX4(J)
      XX1(6)=XX5(J)
      X1=(R(J,I)-R(1,I))/(R(NSTRMS,I)-R(1,I))
220   CALL ALG01(XX1,XX1(4),3,X1,WPARA(J),X1,1,0,0)
      DO 230 J=1,NSTRMS
      XMR(J)=0.0
      HIGHM(J)=0.0
      ANG(J)=0.0
      WS(J)=0.0
      XINC(J)=0.0
      BETA1(J)=0.0
      WD(J)=WPARA(J)*2.0*SOL(J)*SQRT(1.0+TBETA(J,I)**2)
230   WT(J)=WD(J)
      IF(NDEL(I).EQ.0)GO TO 384
      L2=IS3(I)
      CALL ALG01(DELC(L2),DELTA(L2),NDEL(I),XX2,PM1,X1,NSTRMS,1,0)
      IF(NDATA(L1).EQ.0)GO TO 340
      CALL ALG01(R(1,L1),X(1,L1),NSTRMS,R(1,L1),X1,XX1,NSTRMS,0,1)
      L2=NDIMEN(L1)+1
      GO TO(240,260,280,300),L2
240   DO 250 J=1,NSTRMS
250   XX2(J)=R(J,L1)
      GO TO 320
260   DO 270 J=1,NSTRMS
270   XX2(J)=R(J,L1)/R(J,NSTRMS)
      GO TO 320
280   DO 290 J=1,NSTRMS
290   XX2(J)=XL(J,L1)
      GO TO 320
300   DO 310 J=1,NSTRMS
310   XX2(J)=XL(J,L1)/XL(NSTRMS,L1)
320   L2=IS2(L1)
      L3=NDATA(L1)
      CALL ALG01(DATAC(L2),DATA1(L2),L3,XX2,XX3,X1,NSTRMS,NTERP(L1),0)
      CALL ALG01(DATAC(L2),DATA3(L2),L3,XX2,XX4,X1,NSTRMS,NTERP(L1),0)
      DO 330 J=1,NSTRMS
      X1=(ATAN((R(J,L1+1)-R(J,L1))/(X(J,L1+1)-X(J,L1)))+ATAN((R(J,L1)-R(
     1J,L1-1))/(X(J,L1)-X(J,L1-1))))/2.0
      BETA1(J)=ATAN((TAN(XX3(J)/C1)*(1.0-XX1(J)*TAN(X1))-TAN(X1)*TAN(XX4
     1(J)/C1)*SQRT(1.0+XX1(J)**2))*COS(X1))
330   XINC(J)=(ATAN(TALPH1(J))-BETA1(J))*Q
340   DO 380 J=1,NSTRMS
      ANG(J)=XINC(J)+PM1(J)/C1
      X1=H(J,L1)-(VM(J,L1)**2+VW(J,L1)**2)/(2.0*G*EJ)
      IF(X1.LT.HMIN)X1=HMIN
      X4=ALG8(X1,S(J,L1))
      X2=(X4+1.0)/(X4-1.0)
      X3=SQRT(X2)
      X5=ALG9(X1,S(J,L1),VM(J,L1)**2*(1.0+TALPH1(J)**2))
      XMR(J)=SQRT(X5)
      X6=X5
      IF(X6.LT.1.0)X6=1.0
      X7=X3*ATAN(SQRT(X6-1.0)/X3)-ATAN(SQRT(X6-1.0))+ANG(J)
      X10=0.0
      IF(X7.LE.0.0)GO TO 376
      X8=0.4*PI*(X3-1.0)
      IF(X7.GT.X8)GO TO 374
      X9 = 1.0
      K=1
350   X10=X9-(X2+X9*X9)*(1.0+X9*X9)/(X9*X9*(X2-1.0))*(X3*ATAN(X9/X3)-ATA
     1N(X9)-X7)
      IF(ABS(X10-X9).LE.0.00001)GO TO 376
      IF(K.GT.20)GO TO 360
      K=K+1
      X9=X10
      GO TO 350
360   IF(IPRINT.EQ.0)GO TO 374
      CALL ALG03(LNCT,1)
      WRITE(LOG2,370)IPASS,I,J
370   FORMAT(5X,4HPASS,I3,9H  STATION,I3,12H  STREAMLINE,I3,58H  PRANDTL
     1-MEYER FUNCTION NOT CONVERGED - USE INLET MACH NO)
374   X10=SQRT(X6-1.0)
376   HIGHM(J)=SQRT(1.0+X10*X10)
      X1=(HIGHM(J)+SQRT(X6))/2.0
      IF(X5.LT.1.0)X1=X1*SQRT(X5)
      IF(X1.LE.1.0)GO TO 380
      X1=X1*X1
      WS(J)=(((X4+1.0)*X1/((X4-1.0)*X1+2.0))**(X4/(X4-1.0))*((X4+1.0)/(2
     1.0*X4*X1-X4+1.0))**(1.0/(X4-1.0))-1.0)/((1.0+(X4-1.0)/2.0*X5)**(X4
     2/(1.0-X4))-1.0)
380   WT(J)=WD(J)+WS(J)
384   IF(IPRINT.EQ.1)GO TO 400
      L2=IS2(I)
      L3=NTERP(I)
      L4=NDATA(I)
      IF(NWORK(I).GE.5)
     1CALL ALG01(DATAC(L2),DATA6(L2),L4,XX6,XX5,X1,NSTRMS,L3,0)
      CALL ALG01(DATAC(L2),DATA1(L2),L4,XX6,XX1,X1,NSTRMS,L3,0)
      CALL ALG01(DATAC(L2),DATA4(L2),L4,XX6,XX4,X1,NSTRMS,L3,0)
      CALL ALG01(DATAC(L2),DATA3(L2),L4,XX6,XX3,X1,NSTRMS,L3,0)
      NDATA(I)=NSTRMS
      L2=L2-1
      DO 390 J=1,NSTRMS
      K=L2+J
      DATAC(K)=XX6(J)
      IF(NWORK(I).GE.5)
     1DATA6(K)=XX5(J)
      DATA1(K)=XX1(J)
      IF(WT(J).GT.WMAX)WT(J)=WMAX
      DATA2(K)=WT(J)
      DATA3(K)=XX3(J)
      DATA4(K)=XX4(J)
390   DATA5(K)=SOL(J)
      GO TO 450
400   IF(LNCT+3.LE.NPAGE)GO TO 420
      IF(IPRTC.NE.0) WRITE(LOG2,410)
410   FORMAT(1H1)
      LNCT=4+NSTRMS
  420 IF(IPRTC.EQ.1) WRITE(LOG2,430)
430   FORMAT(5X,   'STREAM  INLET   OUTLET  CASCADE   DIFF       LOSS
     1DIFFUSION  BLADE  INCIDENCE  EXPANSION INLET  EXPANDED SHOCK   TOT
     2AL',/,5X,  '-LINE   RADIUS  RADIUS  SOLIDITY  FACTOR  PARAMETER
     3LOSS     ANGLE    ANGLE      ANGLE    M.NO  MACH NO   LOSS   LOSS
     4',/,2X)
      LNCT=LNCT+3
      DO 440 J=1,NSTRMS
      X1=BETA1(J)*C1*Q
      X2=XINC(J)*C1
      X3=ANG(J)*C1
  440 IF(IPRTC.EQ.1)
     *WRITE(LOG2,460)J,R(J,L1),R(J,I),SOL(J),DIF(J),WPARA(J),WD(J),X1,X2
     1,X3,XMR(J),HIGHM(J),WS(J),WT(J)
450   CONTINUE
460   FORMAT(I9,F10.3,F8.3,2F9.4,F10.5,F9.5,2F9.3,F10.3,F10.4,F8.4,F8.5,
     1F9.5)
      RETURN
      END
