├── sivells ├── data.txt ├── Sivells.pdf ├── OREZ.f ├── PLATE.f ├── HEAT.f ├── input.txt ├── input2d.txt ├── FMV.f ├── SCOND.f ├── TWIXT.f ├── TORIC.f ├── CONIC.f ├── makefile ├── SORCE.f ├── XYZ.f ├── FVDGE.f ├── CUBIC.f ├── SPLIND.f ├── OFELD.f ├── NEO.f ├── readme.txt ├── TRANS.f ├── MAIN.f ├── PERFC.f ├── BOUND.f └── AXIAL.f ├── src ├── mod_fg.f ├── mod_troat.f ├── mod_jack.f ├── mod_prop.f ├── mod_gg.f ├── plate.f ├── mod_coef.f ├── mod_corr.f ├── heat.f ├── mod_httr.f ├── mod_cline.f ├── kinddefine.f ├── mod_param.f ├── mod_coord.f ├── mod_contr.f ├── mod_work.f ├── input.txt ├── input2d.txt ├── fmv.f ├── toric.f ├── conic.f ├── sorce.f ├── scond.f ├── xyz.f ├── makefile ├── twixt.f ├── fvdge.f ├── cubic.f ├── splind.f ├── ofeld.f ├── neo.f ├── readme.txt ├── trans.f ├── main.f ├── perfc.f └── bound.f ├── LICENSE.txt └── README.txt /sivells/data.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/aldorona/contur/HEAD/sivells/data.txt -------------------------------------------------------------------------------- /sivells/Sivells.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/aldorona/contur/HEAD/sivells/Sivells.pdf -------------------------------------------------------------------------------- /src/mod_fg.f: -------------------------------------------------------------------------------- 1 | module fg 2 | use kinddefine 3 | implicit none 4 | real(kind=K8),save :: gc,gd,ge,gf,gh,gi,ha,hb,hc,he 5 | end module fg 6 | 7 | -------------------------------------------------------------------------------- /src/mod_troat.f: -------------------------------------------------------------------------------- 1 | module troat 2 | use kinddefine 3 | implicit none 4 | real(kind=K8),dimension(6,51),save :: fc 5 | end module troat 6 | 7 | -------------------------------------------------------------------------------- /src/mod_jack.f: -------------------------------------------------------------------------------- 1 | module jack 2 | use kinddefine 3 | implicit none 4 | real(kind=K8),dimension(30),save :: sj,xj,yj,aj 5 | end module jack 6 | 7 | -------------------------------------------------------------------------------- /src/mod_prop.f: -------------------------------------------------------------------------------- 1 | module prop 2 | use kinddefine 3 | implicit none 4 | real(kind=K8),save :: ar,zo,ro,visc,vism,sfoa,xbl,conv 5 | end module prop 6 | -------------------------------------------------------------------------------- /sivells/OREZ.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE OREZ (A,NA) 2 | IMPLICIT REAL*8(A-H,O-Z) 3 | DIMENSION A(1) 4 | DO 1 K=1,NA 5 | 1 A(K)=0.0D+0 6 | RETURN 7 | END -------------------------------------------------------------------------------- /src/mod_gg.f: -------------------------------------------------------------------------------- 1 | module gg 2 | use kinddefine 3 | implicit none 4 | real(kind=K8),save :: gam,gm,g1,g2,g3,g4,g5,g6,g7,g8,g9,ga,rga,qt 5 | end module gg 6 | -------------------------------------------------------------------------------- /src/plate.f: -------------------------------------------------------------------------------- 1 | subroutine plate 2 | ! dummy to be modified for special calculations for flexible plate 3 | use jack 4 | implicit none 5 | end subroutine plate 6 | -------------------------------------------------------------------------------- /src/mod_coef.f: -------------------------------------------------------------------------------- 1 | module coef 2 | use kinddefine 3 | implicit none 4 | integer(kind=K4),save :: ne 5 | real(kind=K8),dimension(5,200),save :: e 6 | end module coef 7 | 8 | -------------------------------------------------------------------------------- /src/mod_corr.f: -------------------------------------------------------------------------------- 1 | module corr 2 | use kinddefine 3 | implicit none 4 | real(kind=K8),dimension(200),save :: dla,rco,dax,drx,sl 5 | real(kind=K8),save :: dr2 6 | end module corr 7 | -------------------------------------------------------------------------------- /src/heat.f: -------------------------------------------------------------------------------- 1 | subroutine heat 2 | ! dummy to be modified for special calculations of heat transfer 3 | use httr, only:qfun,qfunw 4 | implicit none 5 | qfunw=qfun 6 | end subroutine heat 7 | -------------------------------------------------------------------------------- /src/mod_httr.f: -------------------------------------------------------------------------------- 1 | module httr 2 | use kinddefine 3 | implicit none 4 | integer(kind=K4),save :: ipq,ij,iv,iw 5 | real(kind=K8),save :: hair,taw,twq,tw,twat,qfun,qfunw 6 | end module httr 7 | 8 | -------------------------------------------------------------------------------- /sivells/PLATE.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE PLATE 2 | C DUMMY TO BE MODIFIED FOR SPECIAL CALCULATIONS FOR FLEXIBLE PLATE 3 | IMPLICIT REAL*8(A-H,O-Z) 4 | COMMON /JACK/ SJ(30),XJ(30),YJ(30),AJ(30) 5 | RETURN 6 | END -------------------------------------------------------------------------------- /src/mod_cline.f: -------------------------------------------------------------------------------- 1 | module cline 2 | use kinddefine 3 | implicit none 4 | real(kind=K8),dimension(5,150),save :: axis,taxi 5 | real(kind=K8),save :: wip,x1,frip,zonk,seo,cse 6 | end module cline 7 | 8 | -------------------------------------------------------------------------------- /sivells/HEAT.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE HEAT 2 | C DUMMY TO BE MODIFIED FOR SPECIAL CALCULATIONS OF HEAT TRANSFER 3 | IMPLICIT REAL*8(A-H,O-Z) 4 | COMMON /HTTR/ HAIR,TAW,TWQ,TWT,TWAT,QFUN,QFUNW,IPQ,IJ,IV,IW 5 | QFUNW=QFUN 6 | RETURN 7 | END -------------------------------------------------------------------------------- /src/kinddefine.f: -------------------------------------------------------------------------------- 1 | module kinddefine 2 | implicit none 3 | integer, parameter :: K3 = SELECTED_CHAR_KIND("DEFAULT") 4 | integer, parameter :: K4 = SELECTED_INT_KIND( 9 ) 5 | integer, parameter :: K8 = SELECTED_REAL_KIND( 15, 307 ) 6 | end module kinddefine 7 | -------------------------------------------------------------------------------- /src/mod_param.f: -------------------------------------------------------------------------------- 1 | module param 2 | use kinddefine 3 | implicit none 4 | real(kind=K8),save :: etad,rc,amach,bmach,cmach,emach,gmach,frc,sf 5 | real(kind=K8),save :: wwo,wwop,qm,we,cbet,xe,eta,epsi,bpsi,xo,yo 6 | real(kind=K8),save :: rrc,sdo,xb,xc,ah,pp,se,tye,xa 7 | end module param 8 | 9 | -------------------------------------------------------------------------------- /src/mod_coord.f: -------------------------------------------------------------------------------- 1 | module coord 2 | use kinddefine 3 | implicit none 4 | real(kind=K8),dimension(200),save :: s,fs,waltan,sd 5 | real(kind=K8),dimension(200),save :: wmn,ttr,dmdx,spr,bta 6 | real(kind=K8),dimension(200),save :: dpx,secd,sref 7 | real(kind=K8),save :: xbin,xcin,gma,gmb,gmc,gmd 8 | end module coord 9 | 10 | -------------------------------------------------------------------------------- /src/mod_contr.f: -------------------------------------------------------------------------------- 1 | module contr 2 | use kinddefine 3 | implicit none 4 | character(len=4,kind=K3),dimension(3) :: itle 5 | character(len=4,kind=K3) :: mc 6 | integer(kind=K4),save :: ie,lr,it,jb,jq,jx,kat,kbl,king,ko,lv 7 | integer(kind=K4),save :: nocon,in,mcp,ip,iq,ise,jc,m,mp,mq,n,np 8 | integer(kind=K4),save :: nf,nut,nr,lc,md,mf,mt,nd,nt 9 | end module contr 10 | 11 | -------------------------------------------------------------------------------- /src/mod_work.f: -------------------------------------------------------------------------------- 1 | module work 2 | use kinddefine 3 | implicit none 4 | integer(kind=K8),save :: noup,npct,nodo 5 | real(kind=K8),dimension(5,200),save :: wall 6 | real(kind=K8),dimension(200),save :: wax,way,wan 7 | real(kind=K8),dimension(5,150),save :: a,b,fclast 8 | real(kind=K8),dimension(400),save :: e,z,x,y,yst 9 | real(kind=K8),dimension(250),save :: wtn 10 | end module work 11 | 12 | -------------------------------------------------------------------------------- /sivells/input.txt: -------------------------------------------------------------------------------- 1 | M A C H 4 0 2 | 1.4 1716.563 1. 0.896 2.26968E-8 198.72 0 1000. 3 | 8.67 6. 0 3. 4. -12.25 60. 0 4 | 41 21 0 10 0 41 49 -61 0 0 1 0 10 0 -21 13 5 | 50 85 50 6 | 200. 1638. 900. 540. .38 0 0 0 1 5 7 | 1000. 46. 172. 2. 0 0 0 0 -------------------------------------------------------------------------------- /src/input.txt: -------------------------------------------------------------------------------- 1 | M A C H 4 -1 2 | 1.4 1716.563 1. 0.896 2.26968E-8 198.72 0 1000. 3 | 8.67 6. 0 3.2 4. -12.25 60. 0 4 | 41 21 0 10 0 41 49 -61 0 0 1 0 10 0 -21 13 5 | 50 85 50 6 | 200. 1638. 900. 540. .38 0 0 0 1 5 7 | 1000. 46. 172. 2. 0 0 0 0 8 | -------------------------------------------------------------------------------- /src/input2d.txt: -------------------------------------------------------------------------------- 1 | M A C H 4 -1 2 | 1.4 1716.563 1. 0.896 2.26968E-8 198.72 0 1000. 3 | 8.67 6. 0 3.2 4. -12.25 60. 0 4 | 41 21 0 10 0 41 49 -61 0 0 1 0 10 0 -21 13 5 | 50 85 50 6 | 200. 1638. 900. 540. .38 0 0 0 1 5 7 | 1000. 46. 172. 2. 0 0 0 0 8 | -------------------------------------------------------------------------------- /sivells/input2d.txt: -------------------------------------------------------------------------------- 1 | M A C H 4 -1 2 | 1.4 1716.563 1. 0.896 2.26968E-8 198.72 0 1000. 3 | 8.67 6. 0 3.2 4. -12.25 60. 0 4 | 41 21 0 10 0 41 49 -61 0 0 1 0 10 0 -21 13 5 | 50 85 50 6 | 200. 1638. 900. 540. .38 0 0 0 1 5 7 | 1000. 46. 172. 2. 0 0 0 0 8 | -------------------------------------------------------------------------------- /sivells/FMV.f: -------------------------------------------------------------------------------- 1 | FUNCTION FMV (PMA) 2 | C TO OBTAIN MACH NUMBER FROM PRANDTL MEYER ANGLE 3 | IMPLICIT REAL*8(A-H,O-Z) 4 | COMMON /GG/ GAM,GM,G1,G2,G3,G4,G5,G6,G7,G8,G9,GA,RGA,QT 5 | ONE=1.D+0 6 | THIRD=ONE/3.D+0 7 | VM=(DASIN(ONE)*(PMA/(G2-ONE))**2)**THIRD 8 | Z=ONE+.895D+0*((G7*(G2-ONE))**2)**THIRD*DTAN(VM) 9 | DO 1 I=1,100 10 | ZBET=DSQRT(Z*Z-ONE) 11 | ANG=G2*DATAN(ZBET/G2)-DATAN(ZBET) 12 | REM=(ANG-PMA)*Z*(Z*Z+G9)/G9/ZBET 13 | IF (DABS(REM) .LT. 1.D-10) GO TO 2 14 | 1 Z=Z-REM 15 | 2 FMV=Z-REM 16 | RETURN 17 | END -------------------------------------------------------------------------------- /sivells/SCOND.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE SCOND (A,B,C,KING) 2 | C TO OBTAIN PARABOLIC DERIVATIVE OF CURVE (UNEQUALLY SPACED POINTS) 3 | IMPLICIT REAL*8(A-H,O-Z) 4 | DIMENSION A(150), B(150), C(150) 5 | N=KING-1 6 | DO 1 K=2,N 7 | S=A(K)-A(K-1) 8 | T=A(K+1)-A(K) 9 | 1 C(K)=((B(K+1)-B(K))*S*S+(B(K)-B(K-1))*T*T)/(S*S*T+S*T*T) 10 | SO=A(2)-A(1) 11 | T0=A(3)-A(2) 12 | QO=SO+T0 13 | C(1)=(-T0*(QO+SO)*B(1)+QO*QO*B(2)-SO*SO*B(3))/QO/SO/T0 14 | SF=A(KING-1)-A(KING-2) 15 | TF=A(KING)-A(KING-1) 16 | QF=SF+TF 17 | QST=QF*SF*TF 18 | C(KING)=(SF*(QF+TF)*B(KING)-QF*QF*B(KING-1)+TF*TF*B(KING-2))/QST 19 | RETURN 20 | END -------------------------------------------------------------------------------- /sivells/TWIXT.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE TWIXT (S,GMA,GMB,GMC,GMD,XBL,KAT,KBL) 2 | C TO DETERMINE INTERPOLATION COEFFICIENTS 3 | IMPLICIT REAL*8 (A-H,O-Z) 4 | DIMENSION S(200) 5 | DO 1 L=1,KAT 6 | IF (S(KAT-L) .LT. XBL) GO TO 2 7 | 1 CONTINUE 8 | 2 J=KAT-L+1 9 | XBB=S(J)-XBL 10 | KBL=J+1 11 | DU=S(J+1)-S(J) 12 | DT=S(J)-S(J-1) 13 | DS=S(J-1)-S(J-2) 14 | DST=DS+DT 15 | DSTU=DST+DU 16 | DTU=DT+DU 17 | GMA=-XBB*(DT-XBB)*(DU+XBB)/DS/DST/DSTU 18 | GMB=XBB*(DST-XBB)*(DU+XBB)/DS/DT/DTU 19 | GMC=(DST-XBB)*(DT-XBB)*(DU+XBB)/DST/DT/DU 20 | GMD=-XBB*(DST-XBB)*(DT-XBB)/DSTU/DTU/DU 21 | RETURN 22 | END -------------------------------------------------------------------------------- /sivells/TORIC.f: -------------------------------------------------------------------------------- 1 | FUNCTION TORIC (WIP,SE) 2 | C TO OBTAIN THROAT RADIUS OF CURVATURE FROM VELOCITY GRADIENT 3 | IMPLICIT REAL*8(A-H,O-Z) 4 | COMMON /FG/ GC,GD,GE,GF,GH,GI,HA,HB,HC,HE 5 | COMMON /GG/ GAM,GM,G1,G2,G3,G4,G5,G6,G7,G8,G9,GA,RGA,QT 6 | DATA ONE/1.D+0/,THR/3.D+0/,FIV/5.D+0/ 7 | IE=ONE/QT-ONE 8 | FW=WIP*SE*DSQRT(QT*(GAM+ONE)) 9 | TRR=FW*(ONE+(GC+(THR*GC**2-GD)*FW**2)*FW**2) 10 | 1 TR2=TRR**2 11 | TK=(ONE-G7*(ONE+(GE+GF*TR2)*TR2)*TR2**2/(45.D+0+3*IE))**QT 12 | FF=FW/TK-TRR*(ONE-TR2*(GC-GD*TR2)) 13 | FP=ONE-TR2*(THR*GC-FIV*GD*TR2) 14 | TRR=TRR+FF/FP 15 | IF (DABS(FF) .GT. 1.D-1) GO TO 1 16 | TORIC=ONE/TRR**2 17 | RETURN 18 | END -------------------------------------------------------------------------------- /sivells/CONIC.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE CONIC (XM,B) 2 | C TO OBTAIN MACH NUMRER DERIVATIVES IN RADIAL FLOW 3 | IMPLICIT REAL*8(A-H,O-Z) 4 | COMMON /GG/ GAM,GM,G1,G2,G3,G4,G5,G6,G7,G8,G9,GA,RGA,QT 5 | DATA ONE/1.D+0/,TWO/2.D+0/,THR/3.D+0/,FOUR/4.D+0/ 6 | DIMENSION B(4) 7 | XMM=XM*XM 8 | XMM1=XMM-ONE 9 | XMM2=XMM1**2 10 | BMM=ONE+G8*XMM 11 | AREA=(G6+G5*XMM)**GA/XM 12 | B(1)=AREA**QT 13 | B(2)=XM*BMM/QT/XMM1/B(1) 14 | C2=TWO-(ONE+THR*G8)/QT 15 | C4=G8/QT-ONE 16 | CMM=XMM*(C2+XMM*C4)-ONE-ONE/QT 17 | B(3)=B(2)*CMM/XMM2/B(1) 18 | DMM=(FOUR*C4*XMM+TWO*C2)/CMM-FOUR/XMM1 19 | B(4)=B(3)*(B(3)/B(2)+XM*B(2)*DMM-ONE/B(1)) 20 | RETURN 21 | END -------------------------------------------------------------------------------- /sivells/makefile: -------------------------------------------------------------------------------- 1 | # 2 | # makefile to compile Contur's code by Sivells AEDC-TR-78-63(1978) 3 | # 4 | FC=ifort 5 | FFLAGS= -ansi-alias -diag-enable=all -I. -f77rtl -fast -fno-common \ 6 | -noextend-source -no-fast-transcendentals -fixed -fp-model precise 7 | 8 | modules=\ 9 | AXIAL.o \ 10 | BOUND.o \ 11 | CONIC.o \ 12 | CUBIC.o \ 13 | FMV.o \ 14 | FVDGE.o \ 15 | HEAT.o \ 16 | NEO.o \ 17 | OFELD.o \ 18 | OREZ.o \ 19 | PERFC.o \ 20 | PLATE.o \ 21 | SCOND.o \ 22 | SORCE.o \ 23 | SPLIND.o \ 24 | TRANS.o \ 25 | TORIC.o \ 26 | TWIXT.o \ 27 | XYZ.o 28 | 29 | default: ${modules} MAIN.o 30 | $(FC) $(FFLAGS) ${modules} MAIN.o -o MAIN.exe 31 | 32 | .SUFFIXES: .f .o 33 | 34 | clean: 35 | /bin/rm MAIN.o MAIN.exe ${modules} 36 | 37 | -------------------------------------------------------------------------------- /src/fmv.f: -------------------------------------------------------------------------------- 1 | function fmv(pma) 2 | ! to obtain mach number from prandtl meyer angle 3 | use kinddefine 4 | use gg, only:g2,g7,g9 5 | ! 6 | implicit none 7 | integer(kind=K4) :: i 8 | real(kind=K8) :: ang,fmv,one,rem,third,vm,z,zbet 9 | real(kind=K8),intent(in) :: pma 10 | one=1.d+0 11 | third=one/3.d+0 12 | vm=(dasin(one)*(pma/(g2-one))**2)**third 13 | z=one+.895d+0*((g7*(g2-one))**2)**third*dtan(vm) 14 | do i=1,100 15 | zbet=dsqrt(z*z-one) 16 | ang=g2*datan(zbet/g2)-datan(zbet) 17 | rem=(ang-pma)*z*(z*z+g9)/g9/zbet 18 | if (dabs(rem) .lt. 1.d-10) goto 2 19 | z=z-rem 20 | enddo 21 | 2 fmv=z-rem 22 | end function fmv 23 | -------------------------------------------------------------------------------- /sivells/SORCE.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE SORCE (W,B) 2 | C TO OBTAIN VELOCITY DERIVATIVES IN RADIAL FLOW 3 | IMPLICIT REAL*8(A-H,O-Z) 4 | COMMON /GG/ GAM,GM,G1,G2,G3,G4,G5,G6,G7,G8,G9,GA,RGA,QT 5 | DATA ONE/1.D+0/,TWO/2.D+0/,THR/3.D+0/,FOUR/4.D+0/ 6 | DIMENSION B(4) 7 | WW=W*W 8 | AL=G7*G9 9 | AWW=AL-WW 10 | WW1=WW-ONE 11 | AREA=(((AL-ONE)/AWW)**G1)/W 12 | B(1)=AREA**QT 13 | AXW=AL*WW1*B(1) 14 | B(2)=W*AWW/AXW/QT 15 | C2=THR/QT+AL*(TWO-ONE/QT) 16 | C4=AL+ONE/QT 17 | CWW=WW*(C2-WW*C4)-AL*(ONE+ONE/QT) 18 | B(3)=B(2)*CWW/AXW/WW1 19 | DWW=(TWO*C2-FOUR*C4*WW)/CWW-FOUR/WW1 20 | B(4)=B(3)*(B(3)/B(2)+W*B(2)*DWW-ONE/B(1)) 21 | RETURN 22 | END -------------------------------------------------------------------------------- /src/toric.f: -------------------------------------------------------------------------------- 1 | function toric(wip,se) 2 | ! to obtain throat radius of curvature from velocity gradient 3 | use kinddefine 4 | use fg, only:gc,gd,ge,gf 5 | use gg, only:gam,g7,qt 6 | implicit none 7 | real(kind=K8) :: ie,ff,fiv,fp,fw,one,thr,tk,toric,tr2,trr 8 | real(kind=K8),intent(in) :: se,wip 9 | data one/1.d+0/,thr/3.d+0/,fiv/5.d+0/ 10 | ie=one/qt-one 11 | fw=wip*se*dsqrt(qt*(gam+one)) 12 | trr=fw*(one+(gc+(thr*gc**2-gd)*fw**2)*fw**2) 13 | 1 tr2=trr**2 14 | tk=(one-g7*(one+(ge+gf*tr2)*tr2)*tr2**2/(45.d+0+3*ie))**qt 15 | ff=fw/tk-trr*(one-tr2*(gc-gd*tr2)) 16 | fp=one-tr2*(thr*gc-fiv*gd*tr2) 17 | trr=trr+ff/fp 18 | if(dabs(ff).gt.1.d-1) go to 1 19 | toric=one/trr**2 20 | end function toric 21 | -------------------------------------------------------------------------------- /sivells/XYZ.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE XYZ (XX,YY,YYP,YYPP) 2 | C COMPUTE Y,Y',Y'' FOR A CURVE DESCRIBED BY CUBIC'S A(5,*) 3 | C WHERE (1) = X-MAX (2) = HIGH ORDER COEFFICIENT. 4 | IMPLICIT REAL*8(A-H,O-Z) 5 | COMMON /COEF/ A(5,200),NA 6 | DATA ZERO/0.0D+0/ 7 | X=XX 8 | IF (X .GE. A(1,1)) GO TO 2 9 | 1 Y=ZERO 10 | YP=ZERO 11 | YPP=ZERO 12 | GO TO 5 13 | 2 DO 3 K=2,200 14 | IF (X .LE. A(1,K)) GO TO 4 15 | 3 CONTINUE 16 | GO TO 1 17 | 4 A3=A(2,K) 18 | A2=A(3,K) 19 | A1=A(4,K) 20 | AZ=A(5,K) 21 | T=A2+A2 22 | S=A3*3.0D+0 23 | R=S+S 24 | Y=AZ+X*(A1+X*(A2+X*A3)) 25 | YP=A1+X*(T+X*S) 26 | YPP=T+R*X 27 | 5 YY=Y 28 | YYP=YP 29 | YYPP=YPP 30 | RETURN 31 | END -------------------------------------------------------------------------------- /src/conic.f: -------------------------------------------------------------------------------- 1 | subroutine conic(xm,b) 2 | ! to obtain mach number derivatives in radial flow 3 | use kinddefine 4 | use gg, only:g5,g6,g8,ga,qt 5 | implicit none 6 | real(kind=K8),dimension(4),intent(out) :: b 7 | real(kind=K8),intent(in) :: xm 8 | real(kind=K8) :: area,bmm,c2,c4,cmm,dmm,four,one,thr,two 9 | real(kind=K8) :: xmm,xmm1,xmm2 10 | data one/1.d+0/,two/2.d+0/,thr/3.d+0/,four/4.d+0/ 11 | xmm=xm*xm 12 | xmm1=xmm-one 13 | xmm2=xmm1**2 14 | bmm=one+g8*xmm 15 | area=(g6+g5*xmm)**ga/xm 16 | b(1)=area**qt 17 | b(2)=xm*bmm/qt/xmm1/b(1) 18 | c2=two-(one+thr*g8)/qt 19 | c4=g8/qt-one 20 | cmm=xmm*(c2+xmm*c4)-one-one/qt 21 | b(3)=b(2)*cmm/xmm2/b(1) 22 | dmm=(four*c4*xmm+two*c2)/cmm-four/xmm1 23 | b(4)=b(3)*(b(3)/b(2)+xm*b(2)*dmm-one/b(1)) 24 | end subroutine conic 25 | -------------------------------------------------------------------------------- /src/sorce.f: -------------------------------------------------------------------------------- 1 | subroutine sorce(w,b) 2 | ! to obtain velocity derivatives in radial flow 3 | use kinddefine 4 | use gg, only:g1,g7,g9,qt 5 | implicit none 6 | real(kind=K8) :: al,area,axw,aww,c2,c4,cww,dww,four,one,thr,two,ww 7 | real(kind=K8) :: ww1 8 | real(kind=K8),intent(in) :: w 9 | real(kind=K8),dimension(4),intent(out) :: b 10 | data one/1.d+0/,two/2.d+0/,thr/3.d+0/,four/4.d+0/ 11 | ww=w*w 12 | al=g7*g9 13 | aww=al-ww 14 | ww1=ww-one 15 | area=(((al-one)/aww)**g1)/w 16 | b(1)=area**qt 17 | axw=al*ww1*b(1) 18 | b(2)=w*aww/axw/qt 19 | c2=thr/qt+al*(two-one/qt) 20 | c4=al+one/qt 21 | cww=ww*(c2-ww*c4)-al*(one+one/qt) 22 | b(3)=b(2)*cww/axw/ww1 23 | dww=(two*c2-four*c4*ww)/cww-four/ww1 24 | b(4)=b(3)*(b(3)/b(2)+w*b(2)*dww-one/b(1)) 25 | end subroutine sorce 26 | -------------------------------------------------------------------------------- /src/scond.f: -------------------------------------------------------------------------------- 1 | subroutine scond(a,b,c,king) 2 | ! to obtain parabolic derivative of curve (unequally spaced points) 3 | use kinddefine 4 | implicit none 5 | integer(kind=K4),intent(in) :: king 6 | integer(kind=K4) :: k,n 7 | real(kind=K8),dimension(150),intent(in) :: a,b 8 | real(kind=K8),dimension(150),intent(out) :: c 9 | real(kind=K8) :: qf,qo,qst,s,sf,so,t,t0,tf 10 | n=king-1 11 | do k=2,n 12 | s=a(k)-a(k-1) 13 | t=a(k+1)-a(k) 14 | c(k)=((b(k+1)-b(k))*s*s+(b(k)-b(k-1))*t*t)/(s*s*t+s*t*t) 15 | enddo 16 | so=a(2)-a(1) 17 | t0=a(3)-a(2) 18 | qo=so+t0 19 | c(1)=(-t0*(qo+so)*b(1)+qo*qo*b(2)-so*so*b(3))/qo/so/t0 20 | sf=a(king-1)-a(king-2) 21 | tf=a(king)-a(king-1) 22 | qf=sf+tf 23 | qst=qf*sf*tf 24 | c(king)=(sf*(qf+tf)*b(king)-qf*qf*b(king-1)+tf*tf*b(king-2))/qst 25 | end subroutine scond 26 | -------------------------------------------------------------------------------- /src/xyz.f: -------------------------------------------------------------------------------- 1 | subroutine xyz(xx,yy,yyp,yypp) 2 | ! compute y,y',y'' for a curve described by cubic's e(5,*) 3 | ! where (1) = x-max (2) = high order coefficient. 4 | use kinddefine 5 | use coef, only:e 6 | implicit none 7 | integer(kind=K4) :: k 8 | real(kind=K8),intent(in) :: xx 9 | real(kind=K8),intent(out) :: yy,yyp,yypp 10 | real(kind=K8) :: a1,a2,a3,az,t,s,r,x,y,yp,ypp,zero 11 | data zero/0.0d+0/ 12 | x=xx 13 | if(x.ge.e(1,1)) goto 2 14 | 1 y=zero 15 | yp=zero 16 | ypp=zero 17 | goto 5 18 | 2 do k=2,200 19 | if(x.le.e(1,k)) goto 4 20 | enddo 21 | goto 1 22 | 4 a3=e(2,k) 23 | a2=e(3,k) 24 | a1=e(4,k) 25 | az=e(5,k) 26 | t=a2+a2 27 | s=a3*3.0d+0 28 | r=s+s 29 | y=az+x*(a1+x*(a2+x*a3)) 30 | yp=a1+x*(t+x*s) 31 | ypp=t+r*x 32 | 5 yy=y 33 | yyp=yp 34 | yypp=ypp 35 | end subroutine xyz 36 | -------------------------------------------------------------------------------- /src/makefile: -------------------------------------------------------------------------------- 1 | # 2 | # makefile to compile Contur's code by Sivells AEDC-TR-78-63(1978) 3 | # 4 | FC=ifort 5 | FFLAGS= -ansi-alias -diag-enable=all -I. -f77rtl -fast -fno-common \ 6 | -noextend-source -no-fast-transcendentals -fixed -fp-model precise \ 7 | -warn all -check all 8 | 9 | modules=\ 10 | kinddefine.o\ 11 | mod_cline.o\ 12 | mod_coef.o\ 13 | mod_contr.o\ 14 | mod_fg.o\ 15 | mod_gg.o\ 16 | mod_httr.o\ 17 | mod_coord.o\ 18 | mod_corr.o\ 19 | mod_prop.o\ 20 | mod_param.o\ 21 | mod_jack.o\ 22 | mod_troat.o\ 23 | mod_work.o\ 24 | axial.o \ 25 | bound.o \ 26 | conic.o \ 27 | cubic.o \ 28 | fmv.o \ 29 | fvdge.o \ 30 | heat.o \ 31 | neo.o \ 32 | ofeld.o \ 33 | perfc.o \ 34 | plate.o \ 35 | scond.o \ 36 | sorce.o \ 37 | splind.o \ 38 | toric.o \ 39 | trans.o \ 40 | twixt.o \ 41 | xyz.o 42 | 43 | default: ${modules} main.o 44 | $(FC) $(FFLAGS) ${modules} main.o -o main.exe 45 | 46 | .SUFFIXES: .f .o 47 | 48 | clean: 49 | /bin/rm main.o main.exe ${modules} *.mod 50 | 51 | -------------------------------------------------------------------------------- /src/twixt.f: -------------------------------------------------------------------------------- 1 | subroutine twixt(s,gma,gmb,gmc,gmd,xbl,kat,kbl) 2 | ! to determine interpolation coefficients 3 | use kinddefine 4 | implicit none 5 | integer(kind=K4) :: j,l 6 | integer(kind=K4),intent(in) :: kat 7 | integer(kind=K4),intent(out) :: kbl 8 | real(kind=K8) :: ds,dst,dstu,dt,dtu,du,xbb 9 | real(kind=K8),intent(out) :: gma,gmb,gmc,gmd 10 | real(kind=K8),intent(in) :: xbl 11 | real(kind=K8),dimension(200),intent(in) :: s 12 | do l=1,kat 13 | if(s(kat-l).lt.xbl) goto 2 14 | enddo 15 | 2 j=kat-l+1 16 | xbb=s(j)-xbl 17 | kbl=j+1 18 | du=s(j+1)-s(j) 19 | dt=s(j)-s(j-1) 20 | ds=s(j-1)-s(j-2) 21 | dst=ds+dt 22 | dstu=dst+du 23 | dtu=dt+du 24 | gma=-xbb*(dt-xbb)*(du+xbb)/ds/dst/dstu 25 | gmb=xbb*(dst-xbb)*(du+xbb)/ds/dt/dtu 26 | gmc=(dst-xbb)*(dt-xbb)*(du+xbb)/dst/dt/du 27 | gmd=-xbb*(dst-xbb)*(dt-xbb)/dstu/dtu/du 28 | end subroutine twixt 29 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | Copyright 2021 Aldo Rona 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: 4 | 5 | The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 8 | -------------------------------------------------------------------------------- /sivells/FVDGE.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE FVDGE (X,Y,DS,DY) 2 | C 3 | IMPLICIT REAL*8(A-H,O-Z) 4 | DIMENSION X(5), Y(5) 5 | DATA H/0.5D+0/,TWO/2.0D+0/ 6 | C 7 | X1=X(1) 8 | X2=X(2) 9 | X3=X(3) 10 | X4=X(4) 11 | X5=X(5) 12 | C 13 | Y1=Y(1) 14 | Y2=Y(2) 15 | Y3=Y(3) 16 | Y4=Y(4) 17 | Y5=Y(5) 18 | C 19 | C FIND DELTA-Y 20 | F1=(X3-X1)*(X3-X2) 21 | F1=TWO/F1 22 | C 23 | F2=(X4-X3)*(X3-X2) 24 | F2=-TWO/F2 25 | C 26 | F3=(X5-X3)*(X4-X3) 27 | F3=TWO/F3 28 | C 29 | Z13=X1+X2+X2-X4-X4-X5 30 | A1=(X2+X3-X4-X5)/Z13 31 | A3=(X1+X2-X3-X4)/Z13 32 | C 33 | YP21=(Y2-Y1)/(X2-X1) 34 | YP32=(Y3-Y2)/(X3-X2) 35 | YP43=(Y4-Y3)/(X4-X3) 36 | YP54=(Y5-Y4)/(X5-X4) 37 | C 38 | X21=H*(X2+X1) 39 | X32=H*(X3+X2) 40 | X43=H*(X4+X3) 41 | X54=H*(X5+X4) 42 | C 43 | YPP1=(YP32-YP21)/(X32-X21) 44 | YPP2=(YP43-YP32)/(X43-X32) 45 | YPP3=(YP54-YP43)/(X54-X43) 46 | DS=A1*YPP1+A3*YPP3-YPP2 47 | FX=F2-A1*F1-A3*F3 48 | DY=DS/FX 49 | C 50 | RETURN 51 | END -------------------------------------------------------------------------------- /src/fvdge.f: -------------------------------------------------------------------------------- 1 | subroutine fvdge(x,y,ds,dy) 2 | ! 3 | use kinddefine 4 | implicit none 5 | real(kind=K8),dimension(5),intent(in) :: x,y 6 | real(kind=K8),intent(out) :: ds,dy 7 | real(kind=K8) :: a1,a3,f1,f2,f3,fx,h,two 8 | real(kind=K8) :: x1,x2,x3,x4,x5,x21,x32,x43,x54 9 | real(kind=K8) :: y1,y2,y3,y4,y5,yp21,yp32,yp43,yp54,ypp1,ypp2,ypp3 10 | real(kind=K8) :: z13 11 | data h/0.5d+0/,two/2.0d+0/ 12 | ! 13 | x1=x(1) 14 | x2=x(2) 15 | x3=x(3) 16 | x4=x(4) 17 | x5=x(5) 18 | ! 19 | y1=y(1) 20 | y2=y(2) 21 | y3=y(3) 22 | y4=y(4) 23 | y5=y(5) 24 | ! 25 | ! find delta-y 26 | f1=(x3-x1)*(x3-x2) 27 | f1=two/f1 28 | ! 29 | f2=(x4-x3)*(x3-x2) 30 | f2=-two/f2 31 | ! 32 | f3=(x5-x3)*(x4-x3) 33 | f3=two/f3 34 | ! 35 | z13=x1+x2+x2-x4-x4-x5 36 | a1=(x2+x3-x4-x5)/z13 37 | a3=(x1+x2-x3-x4)/z13 38 | ! 39 | yp21=(y2-y1)/(x2-x1) 40 | yp32=(y3-y2)/(x3-x2) 41 | yp43=(y4-y3)/(x4-x3) 42 | yp54=(y5-y4)/(x5-x4) 43 | ! 44 | x21=h*(x2+x1) 45 | x32=h*(x3+x2) 46 | x43=h*(x4+x3) 47 | x54=h*(x5+x4) 48 | ! 49 | ypp1=(yp32-yp21)/(x32-x21) 50 | ypp2=(yp43-yp32)/(x43-x32) 51 | ypp3=(yp54-yp43)/(x54-x43) 52 | ds=a1*ypp1+a3*ypp3-ypp2 53 | fx=f2-a1*f1-a3*f3 54 | dy=ds/fx 55 | ! 56 | end subroutine fvdge 57 | -------------------------------------------------------------------------------- /sivells/CUBIC.f: -------------------------------------------------------------------------------- 1 | FUNCTION CUBIC (EA,EB,EC,ED) 2 | IMPLICIT REAL*8(A-H,O-Z) 3 | C TO OBTAIN POSITIVE REAL ROOT OF CUBIC EQUATION 4 | DATA ZRO/0.D+0/,ONE/1.D+0/,TWO/2.D+0/,THR/3.D+0/ 5 | E3=EB/THR 6 | Q1=EA*EC/THR-E3**2 7 | R1=EA*(E3*EC-EA*ED)/TWO-E3**3 8 | QR=Q1**3+R1**2 9 | RQ=DSQRT(DABS(QR)) 10 | Q=DSQRT(DABS(Q1)) 11 | B=DSIGN(ONE,R1) 12 | CBB=-ONE 13 | CBC=-ONE 14 | CBT1=ZRO 15 | CBT2=ZRO 16 | A=ZRO 17 | IF (QR .GT. ZRO) GO TO 1 18 | IF (QR .NE. ZRO) A=DASIN(-RQ/Q1/Q)/THR 19 | CSA=DCOS(A) 20 | CSNA=DSQRT(THR)*DSIN(A) 21 | CBA=(TWO*B*Q*CSA-E3)/EA 22 | CBB=-(B*Q*(CSA+CSNA)+E3)/EA 23 | CBC=-(B*Q*(CSA-CSNA)+E3)/EA 24 | GO TO 2 25 | 1 IF (R1+RQ .NE. ZRO) CBT1=DSIGN(DEXP(DLOG(DABS(R1+RQ))/THR),R1+RQ) 26 | IF (R1-RQ .NE. ZRO) CBT2=DSIGN(DEXP(DLOG(DABS(R1-RQ))/THR),R1-RQ) 27 | CBA=(CBT1+CBT2-E3)/EA 28 | 2 IA=DSIGN(ONE,CBA) 29 | IB=DSIGN(ONE,CBB) 30 | IC=DSIGN(ONE,CBC) 31 | IF (IA+IB+IC+1) 11,3,7 32 | 3 IF (IA .EQ. 1) GO TO 5 33 | IF (IB .EQ. 1) GO TO 6 34 | 4 CUBIC=CBC 35 | RETURN 36 | 5 CUBIC=CBA 37 | RETURN 38 | 6 CUBIC=CBB 39 | RETURN 40 | 7 IF (IA+2*IB+3*IC-2) 8,9,10 41 | 8 IF (CBA .GT. CBB) GO TO 6 42 | GO TO 5 43 | 9 IF (CBA .GT. CBC) GO TO 4 44 | GO TO 5 45 | 10 IF (CBB .GT. CBC) GO TO 4 46 | GO TO 6 47 | 11 AA=A*9.D+1/DASIN(ONE) 48 | WRITE (2,12) EA,EB,EC,ED,Q1,R1,QR,RQ,Q,AA,CBA,CBB,CBC 49 | CUBIC=-ONE 50 | RETURN 51 | C 52 | 12 FORMAT (1HO,3HEA=E14.7,5H EB=E14.7,5H EC=E14.7,5H ED=E14.7, 53 | 15H Q1=E14.7,5H R1=E14.7,5H QR=E14.7,5H RQ=E14.7,5H Q=E14.7, 54 | 2', AA=',E14.7,',CBA=',E14.7,',CBB=',E14.7,',CBC=',E14.7 /) 55 | END 56 | -------------------------------------------------------------------------------- /sivells/SPLIND.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE SPLIND (X,Y,TN2,TNL,L) 2 | C COMPUTE CUBIC COEFFICIENTS FOR A CURVE X-Y 3 | IMPLICIT REAL*8(A-H,O-Z) 4 | COMMON /COEF/ E(5,200),NE 5 | COMMON /WORK/ A(300),B(300),C(300),D(300),G(300),SB(300),XM(300),D 6 | 1X(300),DY(300) 7 | DIMENSION X(1), Y(1) 8 | DATA ZERO/0.0D+0/,ONE/1.D+0/,THR/3.D+0/,SIX/6.D+0/ 9 | CALL OREZ (E,5*200) 10 | CALL OREZ (A,9*300) 11 | DX(1)=ZERO 12 | DY(1)=ZERO 13 | N=L-1 14 | DO 1 K=2,L 15 | DX(K)=X(K)-X(K-1) 16 | 1 DY(K)=Y(K)-Y(K-1) 17 | C 18 | B(1)=DX(2)/THR 19 | C(1)=DX(2)/SIX 20 | D(1)=DY(2)/DX(2)-TN2 21 | A(L)=DX(L)/SIX 22 | B(L)=DX(L)/THR 23 | D(L)=TNL-DY(L)/DX(L) 24 | A(1)=ZERO 25 | DO 2 K=2,N 26 | A(K)=DX(K)/SIX 27 | B(K)=(DX(K)+DX(K+1))/THR 28 | D(K)=DY(K+1)/DX(K+1)-DY(K)/DX(K) 29 | 2 C(K)=DX(K+1)/SIX 30 | SW=ONE/B(1) 31 | SB(1)=SW*C(1) 32 | G(1)=SW*D(1) 33 | DO 3 K=2,L 34 | SW=ONE/(B(K)-A(K)*SB(K-1)) 35 | SB(K)=SW*C(K) 36 | 3 G(K)=SW*(D(K)-A(K)*G(K-1)) 37 | XM(L)=G(L) 38 | DO 4 K=1,N 39 | J=L-K 40 | 4 XM(J)=G(J)-SB(J)*XM(J+1) 41 | DO 5 K=2,L 42 | DXR=ONE/DX(K) 43 | Q=DXR/SIX 44 | P=-XM(K-1)*Q 45 | Q=Q*XM(K) 46 | R=DX(K)*XM(K-1)/SIX-DXR*Y(K-1) 47 | S=Y(K)*DXR-DX(K)*XM(K)/SIX 48 | XK=X(K) 49 | PX=XK*P 50 | PXX=PX*XK 51 | PXXX=PXX*XK 52 | XJ=X(K-1) 53 | QX=XJ*Q 54 | QXX=QX*XJ 55 | QXXX=QXX*XJ 56 | E(2,K)=P+Q 57 | E(3,K)=-THR*(PX+QX) 58 | E(4,K)=THR*(PXX+QXX)+R+S 59 | E(5,K)=-PXXX-QXXX-R*XK-S*XJ 60 | 5 CONTINUE 61 | DO 6 K=2,L 62 | E(1,K)=X(K) 63 | 6 CONTINUE 64 | E(1,1)=X(1) 65 | NE=L 66 | RETURN 67 | END -------------------------------------------------------------------------------- /sivells/OFELD.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE OFELD (A,B,C,NOCON) 2 | C TO OBTAIN POINTS IN CHARACTERISTIC NETWORK 3 | IMPLICIT REAL*8(A-H,O-Z) 4 | COMMON /CONTR/ ITLE(3),IE 5 | DATA ZRO/0.0D+0/,ONE/1.D+0/,TWO/2.D+0/,HALF/5.D-1/ 6 | DIMENSION A(5), B(5), C(5) 7 | A1=DASIN(ONE/A(3)) 8 | A2=DASIN(ONE/B(3)) 9 | T1=A(5) 10 | T2=B(5) 11 | IF (IE .EQ. 0) GO TO 8 12 | IF (A(2) .EQ. ZRO) GO TO 5 13 | FSY1=DSIN(A(5))/A(2)/A(3) 14 | GO TO 6 15 | 5 T1=ZRO 16 | FSY1=A(5) 17 | 6 IF (B(2) .EQ. ZRO) GO TO 7 18 | FSY2=DSIN(B(5))/B(2)/B(3) 19 | GO TO 8 20 | 7 T2=ZRO 21 | FSY2=B(5) 22 | 8 TNI=DTAN(T1-A1) 23 | IF (B(3) .NE. ONE) TN2=DTAN(T2+A2) 24 | I=-1 25 | HDPSI=HALF*(A(4)-B(4)) 26 | HT3=HALF*(T1+T2)+HDPSI 27 | T3=HT3-HALF*IE*HDPSI 28 | HPSI3=HALF*(A(4)+B(4)+T1-T2) 29 | PSI3=HPSI3+HALF*IE*(T1-T2) 30 | C(3)=FMV(PSI3) 31 | TOLD=T3 32 | 1 I=I+1 33 | FM3=C(3) 34 | A3=DASIN(ONE/C(3)) 35 | TNA=HALF*(TNI+DTAN(T3-A3)) 36 | IF (B(3) .NE. ONE) TNB=HALF*(DTAN(T3+A3)+TN2) 37 | IF (B(3) .EQ. ONE) TNB=TWO*DTAN(T3+A3) 38 | DTN=TNB-TNA 39 | X3=(B(1)*TNB-A(1)*TNA+A(2)-B(2))/DTN 40 | Y3=(A(2)*TNB-B(2)*TNA+(B(1)-A(1))*TNA*TNB)/DTN 41 | IF ((IE .EQ. 0) .OR. (DABS(Y3) .LT. 1.D-9)) GO TO 4 42 | FSY3=DSIN(T3)/Y3/FM3 43 | P1=HALF*(FSY1+FSY3)*(X3-A(1))*DSQRT(ONE+TNA**2) 44 | P2=HALF*(FSY2+FSY3)*(X3-B(1))*DSQRT(ONE+TNB**2) 45 | T3=HT3+HALF*(P1-P2) 46 | PSI3=HPSI3+HALF*(P1+P2) 47 | C(3)=FMV(PSI3) 48 | IF (DABS(T3-TOLD) .GT. 1.D-9) GO TO 2 49 | IF (DABS(C(3)-FM3) .LT. 1.D-9) GO TO 4 50 | 2 IF (I .EQ. 40) GO TO 3 51 | TEMP=T3 52 | T3=(T3+TOLD)*HALF 53 | TOLD=TEMP 54 | GO TO 1 55 | 3 NOCON=1 56 | 4 C(1)=X3 57 | C(2)=Y3 58 | C(4)=PSI3 59 | C(5)=T3 60 | RETURN 61 | END -------------------------------------------------------------------------------- /src/cubic.f: -------------------------------------------------------------------------------- 1 | function cubic(ea,eb,ec,ed) 2 | use kinddefine 3 | ! 4 | implicit none 5 | integer(kind=K4) :: ia,ib,ic 6 | real(kind=K8),intent(in) :: ea,eb,ec,ed 7 | real(kind=K8) :: a,aa,b,cba,cbb,cbc,cbt1,cbt2,csa,csna,cubic,e3 8 | real(kind=K8) :: one,q,q1,qr,r1,rq,thr,two,zro 9 | ! to obtain positive real root of cubic equation 10 | data zro/0.d+0/,one/1.d+0/,two/2.d+0/,thr/3.d+0/ 11 | e3=eb/thr 12 | q1=ea*ec/thr-e3**2 13 | r1=ea*(e3*ec-ea*ed)/two-e3**3 14 | qr=q1**3+r1**2 15 | rq=dsqrt(dabs(qr)) 16 | q=dsqrt(dabs(q1)) 17 | b=dsign(one,r1) 18 | cbb=-one 19 | cbc=-one 20 | cbt1=zro 21 | cbt2=zro 22 | a=zro 23 | if (qr .gt. zro) goto 1 24 | if (qr .ne. zro) a=dasin(-rq/q1/q)/thr 25 | csa=dcos(a) 26 | csna=dsqrt(thr)*dsin(a) 27 | cba=(two*b*q*csa-e3)/ea 28 | cbb=-(b*q*(csa+csna)+e3)/ea 29 | cbc=-(b*q*(csa-csna)+e3)/ea 30 | goto 2 31 | 1 if (r1+rq .ne. zro) cbt1=dsign(dexp(dlog(dabs(r1+rq))/thr),r1+rq) 32 | if (r1-rq .ne. zro) cbt2=dsign(dexp(dlog(dabs(r1-rq))/thr),r1-rq) 33 | cba=(cbt1+cbt2-e3)/ea 34 | 2 ia=dsign(one,cba) 35 | ib=dsign(one,cbb) 36 | ic=dsign(one,cbc) 37 | if (ia+ib+ic+1) 11,3,7 38 | 3 if (ia .eq. 1) goto 5 39 | if (ib .eq. 1) goto 6 40 | 4 cubic=cbc 41 | return 42 | 5 cubic=cba 43 | return 44 | 6 cubic=cbb 45 | return 46 | 7 if (ia+2*ib+3*ic-2) 8,9,10 47 | 8 if (cba .gt. cbb) goto 6 48 | goto 5 49 | 9 if (cba .gt. cbc) goto 4 50 | goto 5 51 | 10 if (cbb .gt. cbc) goto 4 52 | goto 6 53 | 11 aa=a*9.d+1/dasin(one) 54 | write (2,12) ea,eb,ec,ed,q1,r1,qr,rq,q,aa,cba,cbb,cbc 55 | cubic=-one 56 | return 57 | ! 58 | 12 format ('O','EA=',e14.7,' EB=',e14.7,' EC=',e14.7,' ED=',e14.7, 59 | &' Q1=',e14.7,' R1=',e14.7,' QR=',e14.7,' RQ=',e14.7,' Q=',e1 60 | &4.7,', AA=',e14.7,',CBA=',e14.7,',CBB=',e14.7,',CBC=',e14.7 /) 61 | end function cubic 62 | -------------------------------------------------------------------------------- /src/splind.f: -------------------------------------------------------------------------------- 1 | subroutine splind(x,y,tn2,tnl,l) 2 | ! compute cubic coefficients for a curve x-y 3 | use kinddefine 4 | use coef, only:e,ne 5 | implicit none 6 | integer(kind=K4),intent(in) :: l 7 | integer(kind=K4) :: j,k,n 8 | real(kind=K8),dimension(300) :: a,b,c,d,dx,dy,g,sb,xm 9 | real(kind=K8),dimension(l),intent(in) :: x,y 10 | real(kind=K8),intent(in) :: tn2,tnl 11 | real(kind=K8) :: dxr,one,p,px,pxx,pxxx,q,qx,qxx,qxxx,r,s,six,sw 12 | real(kind=K8):: thr,xj,xk,zero 13 | data zero/0.0d+0/,one/1.d+0/,thr/3.d+0/,six/6.d+0/ 14 | ! call orez (e,5*200) 15 | ! call orez (a,9*300) 16 | e(:,:)=0.0d0 17 | a(:)=0.0d0 18 | b(:)=0.0d0 19 | c(:)=0.0d0 20 | d(:)=0.0d0 21 | dx(:)=0.0d0 22 | dy(:)=0.0d0 23 | g(:)=0.0d0 24 | sb(:)=0.0d0 25 | xm(:)=0.0d0 26 | ! 27 | dx(1)=zero 28 | dy(1)=zero 29 | n=l-1 30 | do k=2,l 31 | dx(k)=x(k)-x(k-1) 32 | dy(k)=y(k)-y(k-1) 33 | enddo 34 | ! 35 | b(1)=dx(2)/thr 36 | c(1)=dx(2)/six 37 | d(1)=dy(2)/dx(2)-tn2 38 | a(l)=dx(l)/six 39 | b(l)=dx(l)/thr 40 | d(l)=tnl-dy(l)/dx(l) 41 | a(1)=zero 42 | do k=2,n 43 | a(k)=dx(k)/six 44 | b(k)=(dx(k)+dx(k+1))/thr 45 | d(k)=dy(k+1)/dx(k+1)-dy(k)/dx(k) 46 | c(k)=dx(k+1)/six 47 | enddo 48 | sw=one/b(1) 49 | sb(1)=sw*c(1) 50 | g(1)=sw*d(1) 51 | do k=2,l 52 | sw=one/(b(k)-a(k)*sb(k-1)) 53 | sb(k)=sw*c(k) 54 | g(k)=sw*(d(k)-a(k)*g(k-1)) 55 | enddo 56 | xm(l)=g(l) 57 | do k=1,n 58 | j=l-k 59 | xm(j)=g(j)-sb(j)*xm(j+1) 60 | enddo 61 | do k=2,l 62 | dxr=one/dx(k) 63 | q=dxr/six 64 | p=-xm(k-1)*q 65 | q=q*xm(k) 66 | r=dx(k)*xm(k-1)/six-dxr*y(k-1) 67 | s=y(k)*dxr-dx(k)*xm(k)/six 68 | xk=x(k) 69 | px=xk*p 70 | pxx=px*xk 71 | pxxx=pxx*xk 72 | xj=x(k-1) 73 | qx=xj*q 74 | qxx=qx*xj 75 | qxxx=qxx*xj 76 | e(2,k)=p+q 77 | e(3,k)=-thr*(px+qx) 78 | e(4,k)=thr*(pxx+qxx)+r+s 79 | e(5,k)=-pxxx-qxxx-r*xk-s*xj 80 | enddo 81 | do k=2,l 82 | e(1,k)=x(k) 83 | enddo 84 | e(1,1)=x(1) 85 | ne=l 86 | end subroutine splind 87 | -------------------------------------------------------------------------------- /src/ofeld.f: -------------------------------------------------------------------------------- 1 | subroutine ofeld(a,b,c,nocon) 2 | ! to obtain points in characteristic network 3 | use kinddefine 4 | use contr, only:ie 5 | implicit none 6 | ! 7 | interface 8 | function fmv(psi) 9 | use kinddefine 10 | implicit none 11 | real(kind=K8) :: fmv 12 | real(kind=K8), intent(in) :: psi 13 | end function fmv 14 | end interface 15 | ! 16 | integer(kind=K4) :: i 17 | integer(kind=K4),intent(out) :: nocon 18 | real(kind=K8),dimension(5),intent(in) :: a,b 19 | real(kind=K8),dimension(5),intent(out) :: c 20 | real(kind=K8) :: a1,a2,a3,dtn,fm3,fsy1,fsy2,fsy3,half,hdpsi,hpsi3 21 | real(kind=K8) :: ht3,one,p1,p2,psi3 22 | real(kind=K8) :: t1,t2,t3,temp,tn2,tna,tnb,tni,told,two,x3,y3,zro 23 | data zro/0.0d+0/,one/1.d+0/,two/2.d+0/,half/5.d-1/ 24 | a1=dasin(one/a(3)) 25 | a2=dasin(one/b(3)) 26 | t1=a(5) 27 | t2=b(5) 28 | if (ie .eq. 0) goto 8 29 | if (a(2) .eq. zro) goto 5 30 | fsy1=dsin(a(5))/a(2)/a(3) 31 | goto 6 32 | 5 t1=zro 33 | fsy1=a(5) 34 | 6 if (b(2) .eq. zro) goto 7 35 | fsy2=dsin(b(5))/b(2)/b(3) 36 | goto 8 37 | 7 t2=zro 38 | fsy2=b(5) 39 | 8 tni=dtan(t1-a1) 40 | if (b(3) .ne. one) tn2=dtan(t2+a2) 41 | i=-1 42 | hdpsi=half*(a(4)-b(4)) 43 | ht3=half*(t1+t2)+hdpsi 44 | t3=ht3-half*ie*hdpsi 45 | hpsi3=half*(a(4)+b(4)+t1-t2) 46 | psi3=hpsi3+half*ie*(t1-t2) 47 | c(3)=fmv(psi3) 48 | told=t3 49 | 1 i=i+1 50 | fm3=c(3) 51 | a3=dasin(one/c(3)) 52 | tna=half*(tni+dtan(t3-a3)) 53 | if (b(3) .ne. one) tnb=half*(dtan(t3+a3)+tn2) 54 | if (b(3) .eq. one) tnb=two*dtan(t3+a3) 55 | dtn=tnb-tna 56 | x3=(b(1)*tnb-a(1)*tna+a(2)-b(2))/dtn 57 | y3=(a(2)*tnb-b(2)*tna+(b(1)-a(1))*tna*tnb)/dtn 58 | if ((ie .eq. 0) .or. (dabs(y3) .lt. 1.d-9)) goto 4 59 | fsy3=dsin(t3)/y3/fm3 60 | p1=half*(fsy1+fsy3)*(x3-a(1))*dsqrt(one+tna**2) 61 | p2=half*(fsy2+fsy3)*(x3-b(1))*dsqrt(one+tnb**2) 62 | t3=ht3+half*(p1-p2) 63 | psi3=hpsi3+half*(p1+p2) 64 | c(3)=fmv(psi3) 65 | if (dabs(t3-told) .gt. 1.d-9) goto 2 66 | if (dabs(c(3)-fm3) .lt. 1.d-9) goto 4 67 | 2 if (i .eq. 40) goto 3 68 | temp=t3 69 | t3=(t3+told)*half 70 | told=temp 71 | goto 1 72 | 3 nocon=1 73 | 4 c(1)=x3 74 | c(2)=y3 75 | c(4)=psi3 76 | c(5)=t3 77 | end subroutine ofeld 78 | -------------------------------------------------------------------------------- /sivells/NEO.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE NEO 2 | C 3 | C SMOOTH BY LINEAR SECOND DERIVATIVE 4 | C 5 | IMPLICIT REAL*8(A-H,O-Z) 6 | COMMON /WORK/ E(400),Z(400),X(400),Y(400),YST(400),WTN(250),WALL(5 7 | 1,200),WAX(200),WAY(200),WAN(200) 8 | COMMON /CONTR/ ITLE(3),IE,LR,IT,JB,JQ,JX,KAT,KBL,KING,KO,LV,NOCON, 9 | 1IN,MC,MCP,IP,IQ,ISE,JC,M,MP,MQ,N,NP,NF,NUT,NR 10 | DATA ZERO/0.0D+0/,ONE/1.D+0/,TWO/2.D+0/ 11 | DATA J0/4H UP/,J1/4HDOWN/ 12 | SAVE NOUP,NPCT,NODO 13 | C 14 | CONV=90.D+0/DASIN(ONE) 15 | TNI=DTAN(WALL(5,1)) 16 | C 17 | IF (JQ.EQ.0.OR.IQ.LT.0) READ (1,14,END=13)NOUP,NPCT,NODO 18 | C IF ((JQ.EQ.0) .OR. (IQ.LT.0)) READ (1,14,END=13)NOUP,NPCT,NODO 19 | IF (JQ .GT. 0) GO TO 2 20 | JN=J0 21 | LIM=NUT 22 | NOTM=NOUP 23 | DO 1 J=1,LIM 24 | X(J+1)=WAX(J) 25 | Y(J+1)=WAY(J) 26 | 1 YST(J+1)=Y(J+1) 27 | X(1)=TWO*X(2)-X(3) 28 | Y(1)=Y(3) 29 | X(LIM+2)=TWO*X(LIM+1)-X(LIM) 30 | Y(LIM+2)=Y(LIM+1)+TNI*(X(LIM+2)-X(LIM+1)) 31 | GO TO 4 32 | 2 LIM=N+NP-1 33 | NOTM=NODO 34 | JN=J1 35 | DO 3 J=1,LIM 36 | X(J+1)=WALL(1,J) 37 | Y(J+1)=WALL(2,J) 38 | 3 YST(J+1)=Y(J+1) 39 | X(1)=TWO*X(2)-X(3) 40 | Y(1)=Y(2)-TNI*(X(2)-X(1)) 41 | X(LIM+2)=TWO*X(LIM+1)-X(LIM) 42 | Y(LIM+2)=Y(LIM+1) 43 | 4 LUS=1+(LIM-3)/6 44 | IF (NOTM .EQ. 0) RETURN 45 | YST(1)=Y(1) 46 | YST(LIM+2)=Y(LIM+2) 47 | SMP=1.D-2*NPCT 48 | WRITE (2,16) ITLE,JN,NOTM,SMP 49 | C 50 | DO 8 M=1,NOTM 51 | CALL OREZ(E,800) 52 | C 53 | DO 5 K=3,LIM 54 | CALL FVDGE (X(K-2),Y(K-2),E(K),Z(K)) 55 | 5 CONTINUE 56 | E(1)=ZERO 57 | E(2)=ZERO 58 | E(LIM+1)=ZERO 59 | E(LIM+2)=ZERO 60 | C SEARCH ARRAY AND FIND MAX ERR 61 | DO 7 LU=1,LUS 62 | EMAX=ZERO 63 | DO 6 K=3,LIM 64 | TEST=DABS(E(K)) 65 | IF (EMAX .GT. TEST) GO TO 6 66 | J=K 67 | EMAX=TEST 68 | 6 CONTINUE 69 | C APPLY CORRECTION 70 | E(J)=ZERO 71 | E(J+1)=ZERO 72 | E(J+2)=ZERO 73 | E(J-1)=ZERO 74 | E(J-2)=ZERO 75 | Y(J)=Y(J)+SMP*Z(J) 76 | 7 CONTINUE 77 | 8 CONTINUE 78 | C 79 | ERR=ZERO 80 | DO 9 J=1,LIM 81 | K=J+1 82 | E(K)=Y(K)-YST(K) 83 | IF (ERR .LT. DABS(E(K))) MAX=J 84 | IF (ERR .LT. DABS(E(K))) ERR=DABS(E(K)) 85 | WRITE (2,15) J,X(K),Y(K),YST(K),E(K),J 86 | 9 IF (MOD(J,10) .EQ. 0) WRITE (2,17) 87 | WRITE (2,19) ERR,MAX 88 | C 89 | LM=LIM-1 90 | CALL SCOND (X,Y,WTN,LIM+2) 91 | IF (JQ .EQ. 1) GO TO 11 92 | DO 10 J=2,LM 93 | WAY(J)=Y(J+1) 94 | 10 WAN(J)=CONV*DATAN(WTN(J+1)) 95 | RETURN 96 | C 97 | 11 DO 12 J=2,LM 98 | WALL(2,J)=Y(J+1) 99 | 12 WALL(5,J)=DATAN(WTN(J+1)) 100 | RETURN 101 | C 102 | 13 WRITE (2,18) 103 | STOP 104 | C 105 | 14 FORMAT (3I5) 106 | 15 FORMAT (1H ,20X,I5,2X,0P4F13.7,I8) 107 | 16 FORMAT (1H1,3A4,2X,A4,24HSTREAM CONTOUR, SMOOTHED,I5,19H TIMES WIT 108 | 1H FACTOR=,F4.2 109 | 2//34X,1HX,11X,6HY-CALC,7X,4HY-IN,10X,4HDIFF /) 110 | 17 FORMAT (1H ) 111 | 18 FORMAT (1H0,10X,34HCARD NOT AVAILABLE FOR NEGATIVE NF) 112 | 19 FORMAT (1H0,26X,21HMAX. ABSOLUTE ERROR=,1PG15.6,10H AT POINT,I5) 113 | END 114 | -------------------------------------------------------------------------------- /src/neo.f: -------------------------------------------------------------------------------- 1 | subroutine neo 2 | ! 3 | ! smooth by linear second derivative 4 | ! 5 | use kinddefine 6 | use work, only: wall,wax,way,wan,nodo,noup,npct,e,z,x,y,yst,wtn 7 | use contr, only: itle,jq,iq,n,np,nut 8 | ! 9 | implicit none 10 | ! 11 | interface 12 | subroutine fvdge(x,y,ds,dy) 13 | use kinddefine 14 | implicit none 15 | real(kind=K8),dimension(5),intent(in) :: x,y 16 | real(kind=K8),intent(out) :: ds,dy 17 | end subroutine fvdge 18 | ! 19 | subroutine scond(a,b,c,king) 20 | use kinddefine 21 | implicit none 22 | integer(kind=K4),intent(in) :: king 23 | real(kind=K8),dimension(150),intent(in) :: a,b 24 | real(kind=K8),dimension(150),intent(out) :: c 25 | end subroutine scond 26 | end interface 27 | ! 28 | integer(kind=K4) :: lim,lm,lu,lus,j,k,m,maxej 29 | integer(kind=K4) :: notm 30 | real(kind=K8) :: conv,emax,error,one,smp,test,tni,two,zero 31 | character(len=4,kind=K3) :: j0,j1,jn 32 | ! COMMON /WORK/ WALL(5,200),WAX(200),WAY(200),WAN(200),E(400),Z(400) 33 | ! 1,X(400),Y(400),YST(400),WTN(250) 34 | ! COMMON /CONTR/ ITLE(3),IE,LR,IT,JB,JQ,JX,KAT,KBL,KING,KO,LV,NOCON, 35 | ! 1IN,MC,MCP,IP,IQ,ISE,JC,M,MP,MQ,N,NP,NR,NUT,NF 36 | data zero/0.0d+0/,one/1.d+0/,two/2.d+0/ 37 | data j0/' UP'/,j1/'DOWN'/ 38 | ! 39 | conv=90.d+0/dasin(one) 40 | tni=dtan(wall(5,1)) 41 | ! 42 | if (jq.eq.0.or.iq.lt.0) read (1,14,end=13) noup,npct,nodo 43 | if (jq .gt. 0) goto 2 44 | jn=j0 45 | lim=nut 46 | notm=noup 47 | do j=1,lim 48 | x(j+1)=wax(j) 49 | y(j+1)=way(j) 50 | yst(j+1)=y(j+1) 51 | enddo 52 | x(1)=two*x(2)-x(3) 53 | y(1)=y(3) 54 | x(lim+2)=two*x(lim+1)-x(lim) 55 | y(lim+2)=y(lim+1)+tni*(x(lim+2)-x(lim+1)) 56 | goto 4 57 | 2 lim=n+np-1 58 | notm=nodo 59 | jn=j1 60 | do j=1,lim 61 | x(j+1)=wall(1,j) 62 | y(j+1)=wall(2,j) 63 | yst(j+1)=y(j+1) 64 | enddo 65 | x(1)=two*x(2)-x(3) 66 | y(1)=y(2)-tni*(x(2)-x(1)) 67 | x(lim+2)=two*x(lim+1)-x(lim) 68 | y(lim+2)=y(lim+1) 69 | 4 lus=1+(lim-3)/6 70 | if (notm .eq. 0) return 71 | yst(1)=y(1) 72 | yst(lim+2)=y(lim+2) 73 | smp=1.d-2*npct 74 | write (2,16) itle,jn,notm,smp 75 | ! I HAVE NOT UNDERSTOOD WHY m IS KEPT IN THE COMMON BLOCK contr 76 | do m=1,notm 77 | ! call orez(e,800) 78 | e(:)=0.0d0 79 | z(:)=0.0d0 80 | ! 81 | do k=3,lim 82 | call fvdge (x(k-2:k+2),y(k-2:k+2),e(k),z(k)) 83 | enddo 84 | e(1)=zero 85 | e(2)=zero 86 | e(lim+1)=zero 87 | e(lim+2)=zero 88 | ! search array and find max error 89 | do lu=1,lus 90 | emax=zero 91 | do k=3,lim 92 | test=dabs(e(k)) 93 | if (emax .gt. test) goto 6 94 | j=k 95 | emax=test 96 | 6 continue 97 | enddo 98 | ! apply correction 99 | e(j)=zero 100 | e(j+1)=zero 101 | e(j+2)=zero 102 | e(j-1)=zero 103 | e(j-2)=zero 104 | y(j)=y(j)+smp*z(j) 105 | enddo 106 | enddo 107 | ! 108 | error=zero 109 | do j=1,lim 110 | k=j+1 111 | e(k)=y(k)-yst(k) 112 | if (error .lt. dabs(e(k))) maxej=j 113 | if (error .lt. dabs(e(k))) error=dabs(e(k)) 114 | write (2,15) j,x(k),y(k),yst(k),e(k),j 115 | if (mod(j,10) .eq. 0) write (2,17) 116 | enddo 117 | write (2,19) error,maxej 118 | ! 119 | lm=lim-1 120 | call scond (x,y,wtn,lim+2) 121 | if (jq .eq. 1) goto 11 122 | do j=2,lm 123 | way(j)=y(j+1) 124 | wan(j)=conv*datan(wtn(j+1)) 125 | enddo 126 | return 127 | ! 128 | 11 do j=2,lm 129 | wall(2,j)=y(j+1) 130 | wall(5,j)=datan(wtn(j+1)) 131 | enddo 132 | return 133 | ! 134 | 13 write (2,18) 135 | stop 136 | ! 137 | 14 format (3i5) 138 | 15 format (1x,20x,i5,2x,0p4f13.7,i8) 139 | 16 format (1x,3a4,2x,a4,'STREAM CONTOUR, SMOOTHED',i5,' TIMES WITH FA 140 | &CTOR=',f4.2//35x,'X',11x,'Y-CALC',7x,'Y-IN',10x,'DIFF' /) 141 | 17 format (1x) 142 | 18 format ('0',10x,'CARD NOT AVAILABLE FOR NEGATIVE NF') 143 | 19 format (1x,26x,'MAX. ABSOLUTE ERROR =',1pg15.6,' AT POINT ',i5/) 144 | end subroutine neo 145 | -------------------------------------------------------------------------------- /src/readme.txt: -------------------------------------------------------------------------------- 1 | This respository contains a FORTRAN90 translation of the CONTUR code in 2 | Appendix D of J.C. Sivells, A computer program for the aerodynamic 3 | design of axisymmetric and planar nozzles for supersonic and hypersonic 4 | wind tunnels, ARO Inc., a Sverdrup Corporation Company, ADEC TR 78 63, 5 | December 1978. 6 | 7 | The code uses a combination of analytical solutions, the method of 8 | characteristics, and centerline distributions in order to calculate the 9 | divergent section of a convergent-divergent de Laval nozzle. 10 | 11 | It is a FORTRAN90 code which runs through a series of 16 subroutines 12 | and uses 7 user-defined input cards describing the flow conditions of 13 | the desired nozzle profile. 14 | 15 | Sivells reports the input cards and output file of a MACH 4 16 | axisymmetric nozzle. The version of the code in this repository was 17 | run in May 2019 on this test case and the same output was obtained. 18 | 19 | Florentina-Luiza Zavalan, under the guide of project 20 | supervisor Aldo Rona, typeset Appendix D from the freely available 21 | source code listing at 22 | https://apps.dtic.mil/dtic/tr/fulltext/u2/a062944.pdf 23 | Significant effort was put in to interpret the low-resolution scan and 24 | to disambigue similar typographical symbols (e.g. * from +, 5 from S). 25 | 26 | Aldo Rona translated the code in FORTRAN90. 27 | 28 | If you find any bug while testing, please report it to the authors: 29 | aldo.rona@le.ac.uk, flz1@leicester.ac.uk 30 | 31 | License: See LICENSE.txt. Code users must acknowledge the 32 | provenance of the listing by using the following acknowledgement in 33 | their published work: "This work used the CONTUR source code by 34 | F.L. Zavalan and A. Rona, based on the computer program by J.C. Sivells". 35 | 36 | Compilation instructions 37 | 38 | Linux/Unix users: 39 | 1. Create a new directory, suggested name: sivells 40 | 2. Download in the SAME directory the bundle of 20 *.f source files, 41 | one input.txt file, and makefile. 42 | 3. You are advised to also download Sivells.pdf, which is article by 43 | Sivells, and output.txt, which is the sample output from the MACH 4 44 | test case. These files are in folders sivells/ and docs/. 45 | 4. Compile the code by just typing: make. This will create the object 46 | files *.o and the executable MAIN.exe 47 | 5. Run the executably MAIN.exe 48 | 49 | Windows users: 50 | 1. Download and install Microsoft Visual Studio 51 | 2. Open Microsoft Visual Studio and create a new Project, suggested name: contur 52 | 3. Move input.txt and input2d.txt from the /src directory into the 53 | 'resources' directory of the Project. 54 | 4. Move all .f files from the /src directory to the 'source' directory of the Project. 55 | Make sure you only move the .f files from /src, which have all small case names, do 56 | not add any of the .f files from the /sivells directory, which have CAPITAL CASE names, 57 | as this will over-define symbols in the compilation. 58 | 5. Right click on the makefile you have downloaded and open it with a text editor. 59 | Do not double click on it. Check the list of files you now have in 'source' 60 | of your Project. You should only have files with root names .f matching 61 | the object list root names .o in makefile, e.g. axial.f -> axial.o. You should 62 | also have main.f in your 'source'. You should not 63 | have any .txt, makefile, or .pdf files in your 'source'. 64 | 6. Remove makefile. You do not need this file for compiling under Windows. 65 | 7. Select Compile and Run from the taskbar of Microsoft Visual Studio 66 | 67 | Frequently Asked Questions 68 | 1. You may need to let makefile know what compiler you are using. To 69 | do so, use a text editor to edit makefile and change FC=ifort to your 70 | own compiler, e.g. gfort. Run the command "man -k fortran" to find out 71 | what compiler is installed on your system. 72 | 73 | 2. You may need to change the compiler flags according to what is 74 | available from your compiler. In unix/linux, you can type 75 | "man mycompiler" to find out what flags are available. 76 | 77 | 08 May 2019 - A. Rona, F.L. Zavalan 78 | 79 | Card notes: 80 | 81 | Card 5: Use an integer value for XJ as JX=XJ and JX is integer 82 | 83 | Code updates: 84 | 14May2019: AR moved label 5 from line BOU 72 to BOU 69 to avoid jumping 85 | into the DO IV=1,IW loop. 86 | 16May2019: AR variables ns and nc removed from AXIAL.f as not used 87 | 16May2019: AR removed M from common block of NEO.f 88 | 11Jun2019: AR code changed to f90. Added input2d.txt as sample input 89 | file to generate a two-dimensional contoured nozzle. To use rename 90 | input2d.txt as input.txt and rund the code 91 | 92 | ----- 93 | end of notes 94 | -------------------------------------------------------------------------------- /README.txt: -------------------------------------------------------------------------------- 1 | # contur 2 | CONTUR code for contoured nozzle design by J.C. Sivells ADEC TR 78 63 December 1978 3 | 4 | This respository contains the CONTUR code in 5 | Appendix D of J.C. Sivells, A computer program for the aerodynamic 6 | design of axisymmetric and planar nozzles for supersonic and hypersonic 7 | wind tunnels, ARO Inc., a Sverdrup Corporation Company, ADEC TR 78 63, 8 | December 1978. 9 | 10 | The code uses a combination of analytical solutions, the method of 11 | characteristics, and centerline distributions in order to calculate the 12 | divergent section of a convergent-divergent de Laval nozzle. 13 | 14 | Folder sivells contains a FORTRAN77 source code which runs through 15 | a series of 16 subroutines and uses 7 user-defined input cards 16 | describing the flow conditions of the desired nozzle profile. 17 | 18 | Folder src contains the FORTRAN90 source code version of folder sivells 19 | 20 | Sivells reports the input cards and output file of a MACH 4 21 | axisymmetric nozzle. The version of the code in this repository was 22 | run in May 2019 on this test case and the same output was obtained. 23 | 24 | Florentina-Luiza Zavalan, under the guide of project 25 | supervisor Aldo Rona, typeset Appendix D from the freely available 26 | source code listing at 27 | https://apps.dtic.mil/dtic/tr/fulltext/u2/a062944.pdf 28 | Significant effort was put in to interpret the low-resolution scan and 29 | to disambigue similar typographical symbols (e.g. * from +, 5 from S). 30 | 31 | Aldo Rona translated the code in FORTRAN90. If you find any bug 32 | while testing, please report it to the authors: 33 | aldo.rona@le.ac.uk, flz1@leicester.ac.uk 34 | 35 | License: See LICENSE.txt. Code users must acknowledge the 36 | provenance of the listing by using the following acknowledgement in 37 | their published work: "This work 38 | used the CONTUR source code by L.F. Zavalan and A. Rona, based on the 39 | computer program by J.C. Sivells". 40 | 41 | Compilation instructions 42 | 43 | Linux/Unix users: 44 | 1. Create a new directory, suggested name: sivells 45 | 2. Download in the SAME directory the bundle of 20 *.f source files, 46 | one input.txt file, and makefile. 47 | 3. You are advised to also download Sivells.pdf, which is article by 48 | Sivells, and output.txt, which is the sample output from the MACH 4 49 | test case. These files are in folders sivells/ and docs/. 50 | 4. Compile the code by just typing: make. This will create the object 51 | files *.o and the executable MAIN.exe 52 | 5. Run the executable MAIN.exe 53 | 54 | Windows users: 55 | 1. Download and install Microsoft Visual Studio 56 | 2. Open Microsoft Visual Studio and create a new Project, suggested name: contur 57 | 3. Move input.txt and input2d.txt from the /src directory into the 58 | 'resources' directory of the Project. 59 | 4. Move all .f files from the /src directory to the 'source' directory of the Project. 60 | Make sure you only move the .f files from /src, which have all small case names, do 61 | not add any of the .f files from the /sivells directory, which have CAPITAL CASE names, 62 | as this will over-define symbols in the compilation. 63 | 5. Right click on the makefile you have downloaded and open it with a text editor. 64 | Do not double click on it. Check the list of files you now have in 'source' 65 | of your Project. You should only have files with root names .f matching 66 | the object list root names .o in makefile, e.g. axial.f -> axial.o. You should 67 | also have main.f in your 'source'. You should not 68 | have any .txt, makefile, or .pdf files in your 'source'. 69 | 6. Remove makefile. You do not need this file for compiling under Windows. 70 | 7. Select Compile and Run from the taskbar of Microsoft Visual Studio 71 | 72 | Frequently Asked Questions 73 | 1. You may need to let makefile know what compiler you are using. To 74 | do so, use a text editor to edit makefile and change FC=ifort to your 75 | own compiler, e.g. gfort. Run the command "man -k fortran" to find out 76 | what compiler is installed on your system. 77 | 78 | 2. You may need to change the compiler flags according to what is 79 | available from your compiler. In unix/linux, you can type 80 | "man mycompiler" to find out what flags are available. 81 | 82 | 08 May 2019 - A. Rona, F.L. Zavalan 83 | 84 | Card notes: 85 | 86 | Card 5: Use an integer value for XJ as JX=XJ and JX is integer 87 | 88 | Code updates: 89 | 14May2019: AR moved label 5 from line BOU 72 to BOU 69 to avoid jumping 90 | into the DO IV=1,IW loop. 91 | 16May2019: AR variables ns and nc removed from AXIAL.f as not used 92 | 16May2019: AR removed M from common block of NEO.f 93 | 11Jun2019: AR code changed to f90. Added input2d.txt as sample input 94 | file to generate a two-dimensional contoured nozzle. To use rename 95 | input2d.txt as input.txt and rund the code 96 | 97 | ----- 98 | end of notes 99 | -------------------------------------------------------------------------------- /sivells/readme.txt: -------------------------------------------------------------------------------- 1 | This respository contains the CONTUR code in 2 | Appendix D of J.C. Sivells, A computer program for the aerodynamic 3 | design of axisymmetric and planar nozzles for supersonic and hypersonic 4 | wind tunnels, ARO Inc., a Sverdrup Corporation Company, ADEC TR 78 63, 5 | December 1978. 6 | 7 | The code uses a combination of analytical solutions, the method of 8 | characteristics, and centerline distributions in order to calculate the 9 | divergent section of a convergent-divergent de Laval nozzle. 10 | 11 | This is a FORTRAN 77 code which runs through a series of 16 subroutines 12 | and uses 7 user-defined input cards describing the flow conditions of 13 | the desired nozzle profile. 14 | 15 | Sivells reports the input cards and output file of a MACH 4 16 | axisymmetric nozzle. The version of the code in this repository was 17 | run in May 2019 on this test case and the same output was obtained. 18 | 19 | The "JD" parameter allows for the direct control of the nozzle geometry. 20 | By changing the JD parameter and the BMACH parameter in the proposed 21 | input file (JD=-1 and BMACH=3.2), a planar nozzle contour will be 22 | obtained. BMACH represents the Mach number at point B, which is the 23 | point at which the downstream method of characteristics solution is 24 | initiated. It is recommended to keep the Mach number at this point equal 25 | to 80% of the design Mach number (CMC parameter). 26 | 27 | The author, Florentina-Luiza Zavalan, under the guide of project 28 | supervisor Aldo Rona, typeset Appendix D from the freely available 29 | source code listing at 30 | https://apps.dtic.mil/dtic/tr/fulltext/u2/a062944.pdf 31 | Significant effort was put in to interpret the low-resolution scan and 32 | to disambigue similar typographical symbols (e.g. * from +). 33 | 34 | If you find any bug while testing, please report it to the authors: 35 | aldo.rona@le.ac.uk, flz1@leicester.ac.uk 36 | 37 | License: This code is license free. Code users must acknowledge the 38 | provenance of the listing by using the following acknowledgement in 39 | their published work: "This work 40 | used the CONTUR source code by F.L. Zavalan and A. Rona, based on the 41 | computer program by J.C. Sivells". 42 | 43 | Compilation instructions 44 | 45 | Linux/Unix users: 46 | 1. Create a new directory, suggested name: sivells 47 | 2. Download in the SAME directory the bundle of 20 *.f source files, 48 | one input.txt file, makefile. 49 | 3. You are advised to also download Sivells.pdf, which is article by 50 | Sivells, data.txt, which is the sample output from the MACH 4 test case. 51 | 4. Compile the code by just typing: make. This will create the object 52 | files *.o and the executable MAIN.exe 53 | 5. Run the executable MAIN.exe 54 | 55 | Windows users: 56 | 1. Download and install Microsoft Visual Studio 57 | 2. Open Microsoft Visual Studio and create a new Project, suggested name: sivells 58 | 3. Move input.txt and input2d.txt from the /sivells directory into the 59 | 'resources' directory of the Project. 60 | 4. Move all .f files from the /sivells directory to the 'source' directory of the Project. 61 | Make sure you only move the .f files from /sivells, which have all CAPITAL CASE names, do 62 | not add any of the .f files from the /src directory, which have lower case names, 63 | as this will over-define symbols in the compilation. 64 | 5. Right click on the makefile you have downloaded and open it with a text editor. 65 | Do not double click on it. Check the list of files you now have in 'source' 66 | of your Project. You should only have files with root names .f matching 67 | the object list root names .o in makefile, e.g. AXIAL.f -> AXIAL.o. You should 68 | also have MAIN.f in your 'source'. You should not 69 | have any .txt, makefile, or .pdf files in your 'source'. 70 | 6. Remove makefile. You do not need this file for compiling under Windows. 71 | 7. Select Compile and Run from the taskbar of Microsoft Visual Studio 72 | 73 | Frequently Asked Questions 74 | 1. You may need to let makefile know what compiler you are using. To 75 | do so, use a text editor to edit makefile and change FC=ifort to your 76 | own compiler, e.g. gfort. Run the command "man -k fortran" to find out 77 | what compiler is installed on your system. 78 | 79 | 2. You may need to change the compiler flags according to what is 80 | available from your compiler. In unix/linux, you can typeset 81 | "man mycompiler" to find out what flags are available. 82 | 83 | 08 May 2019 - A. Rona, F.L. Zavalan 84 | ----- 85 | Version 1.1 11 June 2019 86 | 87 | Fixed code typesetting errors in: 88 | AXIAL,BOUND,CUBIC,MAIN,NEO,OFELD,PERFC,TRANS 89 | 90 | Successfully tested code for 2D nozzle design, added a sample input file 91 | for 2D design. To run the 2D nozzle design, mv input2d.txt input.txt and 92 | then run the code. 93 | ----- 94 | end of notes 95 | -------------------------------------------------------------------------------- /sivells/TRANS.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE TRANS (RTO,TK,WO,AMN,AMP,AMPP,W,AWP,AWPP,CWOPPP,AXN) 2 | C TO DETERMINE THROAT CHARACTERISTIC 3 | IMPLICIT REAL*8(A-H,O-Z) 4 | COMMON /GG/ GAM,GM,G1,G2,G3,G4,G5,G6,G7,G8,G9,GA,RGA,QT 5 | COMMON /CONTR/ ITLE(3),IE,LR 6 | COMMON /TROAT/ FC(6,51) 7 | DATA ZRO/0.0D+0/,ONE/1.D+0/,TWO/2.D+0/,SIX/6.D+0/,HALF/5.D-1/ 8 | DATA TRHV/1.5D+0/,THR/3.D+0/,FOUR/4.D+0/,EIT/8.D+0/,TLV/1.2D+1/ 9 | NN=IABS(LR) 10 | JJ=240/(NN-1) 11 | IF (MOD(JJ,2).NE.0) JJ=JJ+1 12 | IF (JJ.LT.10) JJ=10 13 | KK=JJ*NN-JJ 14 | GB=IE/EIT 15 | GK=(GAM*(GAM+2.25D+0*IE-16.5D+0)+2.25D+0*(2+IE))/TLV 16 | GU=ONE-GAM/TRHV 17 | GV=(HALF*(5-3*IE)*GAM+IE)/(9-IE) 18 | GZ=DSQRT(QT*(GAM+ONE)) 19 | U22=GB+GAM/THR/(3-IE) 20 | U42=(GAM+(4-IE)*TRHV)/SIX/(3-IE) 21 | IF (IE.EQ.0) GO TO 1 22 | GT=(GAM*(GAM*92.D+0+180.D+0)-9.D+0)/1152.D+0 23 | U23=(GAM*(304.D+0*GAM+255.D+0)-54.D+0)/1728.D+0 24 | U43=(GAM*(388.D+0*GAM+777.D+0)+153.D+0)/2304.D+0 25 | U63=(GAM*(556.D+0*GAM+1737.D+0)+3069.D+0)/10368.D+0 26 | UP0=(GAM*(52.D+0*GAM+75.D+0)-9.D+0)/192.D+0 27 | UP2=(GAM*(52.D+0*GAM+51.D+0)+327.D+0)/384.D+0 28 | V02=(28.D+0*GAM-15.D+0)/288.D+0 29 | V22=(20.D+0*GAM+27.D+0)/96.D+0 30 | V42=(GAM/THR+ONE)/THR 31 | V03=(GAM*(7100.D+0*GAM+2151.D+0)+2169.D+0)/82944.D+0 32 | V23=(GAM*(3424.D+0*GAM+4071.D+0)-972.D+0)/13824.D+0 33 | V43=(GAM*(3380.D+0*GAM+7551.D+0)+3771.D+0)/13824.D+0 34 | V63=(GAM*(6836.D+0*GAM+23031.D+0)+30627.D+0)/82944.D+0 35 | GO TO 2 36 | 1 GT=(GAM*(GAM*134.D+0+429.D+0)+123.D+0)/4320.D+0 37 | U23=(GAM*(854.D+0*GAM+807.D+0)+279.D+0)/12960.D+0 38 | U43=(GAM*(194.D+0*GAM+549.D+0)-63.D+0)/2592.D+0 39 | U63=(GAM*(362.D+0*GAM+1449.D+0)+3177.D+0)/12960.D+0 40 | UP0=(GAM*(26.D+0*GAM+51.D+0)-27.D+0)/144.D+0 41 | UP2=(GAM*(26.D+0*GAM+27.D+0)+237.D+0)/288.D+0 42 | V02=(34.D+0*GAM-75.D+0)/1080.D+0 43 | V22=(10.D+0*GAM+15.D+0)/108.D+0 44 | V42=(22.D+0*GAM+75.D+0)/360.D+0 45 | V03=(GAM*(7570.D+0*GAM+3087.D+0)+23157.D+0)/544320.D+0 46 | V23=(GAM*(5026.D+0*GAM+7551.D+0)-4923.D+0)/77760.D+0 47 | V43=(GAM*(2254.D+0*GAM+6153.D+0)+2979.D+0)/25920.D+0 48 | V63=(GAM*(6574.D+0*GAM+26481.D+0)+40059.D+0)/181440.D+0 49 | 2 WWO=WO+(HALF+(U42-U22+(U63-U43+U23)/RTO)/RTO)/RTO 50 | WOP=(ONE-(GB-GT/RTO)/RTO)/DSQRT(RTO) 51 | WOPP=(GU-GV/RTO)/RTO 52 | HOPPP=GK/RTO/DSQRT(RTO) 53 | HVPPP=(3*IE-(10-3*IE)*GAM)/FOUR/RTO/DSQRT(RTO) 54 | AMN=WWO/DSQRT(G7-G8*WWO**2) 55 | BET=DSQRT(AMN**2-ONE) 56 | PSI1=G2*DATAN(BET/G2)-DATAN(BET) 57 | P1=ZRO 58 | T1=ZRO 59 | X1=ZRO 60 | Y1=ONE 61 | FSY1=ZRO 62 | TN2=-ONE/BET 63 | FC(1,NN)=X1 64 | FC(2,NN)=Y1 65 | FC(3,NN)=AMN 66 | FC(4,NN)=PSI1 67 | FC(5,NN)=ZRO 68 | FC(6,NN)=ZRO 69 | BX=ONE 70 | SUM=ZRO 71 | FSA=(IE+1)*AMN/(G6+G5*AMN**2)**GA 72 | DO 8 J=1,KK 73 | Y=DFLOAT(KK-J)/KK 74 | IF (IE .EQ. 1) BX=Y+Y 75 | YY=Y*Y 76 | TN1=TN2 77 | VO=(((YY*(YY*(YY*V63-V43)+V23)-V03)/RTO+YY*(YY*V42-V22)+V02)/RTO+H 78 | 1ALF*(YY-ONE)/(3-IE))/RTO 79 | VP=(ONE+((YY*(TWO*GAM+3*(4-IE))-TWO*GAM-TRHV*IE)/(3-IE)/THR+(YY*(S 80 | 1IX*U63*YY-FOUR*U43)+TWO*U23)/RTO)/RTO)/DSQRT(RTO) 81 | VPP=TWO*(ONE+(TWO*UP2*YY-UP0)/RTO)/RTO 82 | C ITERATE FOR X AND MACH NUMBER FROM CHARACTERISTIC EQUATIONS 83 | DO 4 I=1,10 84 | TNA=HALF*(TN1+TN2) 85 | X=X1+(Y-Y1)/TNA 86 | DXI=DSQRT((Y-Y1)**2+(X-X1)**2) 87 | XOT=X/GZ 88 | VY=GZ*(VO+XOT*(VP+XOT*(HALF*VPP+XOT*HVPPP/THR)))/DSQRT(RTO) 89 | W=AMN/DSQRT(G6+G5*AMN**2) 90 | T=DASIN(VY*Y/W) 91 | FSY=IE*VY/W/AMN 92 | P1=HALF*(FSY1+FSY)*DXI 93 | 3 PSI=P1+PSI1+T1-T 94 | FMA=FMV(PSI) 95 | IF (DABS(AMN-FMA) .LT. 1.D-10) GO TO 5 96 | FMU=DASIN(ONE/FMA) 97 | TN2=DTAN(T-FMU) 98 | AMN=FMA 99 | 4 CONTINUE 100 | C ITERATION COMPLETE 101 | 5 IF (MOD(J,2) .EQ. 0) GO TO 6 102 | AS=Y1-Y 103 | FSB=BX/DSIN(FMU-T)/(G6+G5*FMA**2)**GA 104 | GO TO 7 105 | 6 BS=Y1-Y 106 | CS=AS+BS 107 | S1=(TWO-BS/AS)*CS/SIX 108 | S3=(TWO-AS/BS)*CS/SIX 109 | S2=CS-S1-S3 110 | FSC=BX/DSIN(FMU-T)/(G6+G5*FMA**2)**GA 111 | ADD=S1*FSA+S2*FSB+S3*FSC 112 | SUM=ADD+SUM 113 | FSA=FSC 114 | 7 X1=X 115 | Y1=Y 116 | T1=T 117 | FSY1=FSY 118 | PSI1=PSI 119 | IF (MOD(J,JJ) .NE. 0) GO TO 8 120 | K=NN-J/JJ 121 | FC(1,K)=X 122 | FC(2,K)=Y 123 | FC(3,K)=FMA 124 | FC(4,K)=PSI 125 | FC(5,K)=T 126 | FC(6,K)=SUM 127 | 8 CONTINUE 128 | DO 9 J=1,NN 129 | FC(1,J)=FC(1,J)/TK 130 | FC(2,J)=FC(2,J)/TK 131 | 9 FC(6,J)=ONE-FC(6,J)/SUM 132 | AXN=FC(1,1) 133 | AWOP=WOP*TK/GZ 134 | AWOPP=WOPP*(TK/GZ)**2 135 | AWOPPP=TWO*HOPPP*(TK/GZ)**3 136 | CWOPPP=SIX*(W-WO-AXN*(AWOP+AXN*AWOPP/TWO))/AXN**3 137 | IF (CWOPPP .LT. AWOPPP) CWOPPP=AWOPPP 138 | AWP=AWOP+AXN*(AWOPP+AXN*CWOPPP/TWO) 139 | AWPP=AWOPP+AXN*CWOPPP 140 | AMP=AWP*G7*(AMN/W)**3 141 | AMPP=AMP*(AWPP/AWP+THR*G5*AMP*W*W/AMN) 142 | IF (LR .GT. 0) RETURN 143 | LR=NN 144 | RC=RTO-ONE 145 | WRITE (2,12) ITLE,RC,AWOP,AWOPP,AWOPPP 146 | DO 10 J=1,NN 147 | Y=DFLOAT(J-1)/(NN-1) 148 | YY=Y*Y 149 | Y4=YY**2 150 | Y6=YY**3 151 | DUY=(HALF*YY+(U42*Y4-U22*YY+(U63*Y6-U43*Y4+U23*YY)/RTO)/RTO)/RTO 152 | UY=WO+DUY 153 | VO=(((YY*(YY*(YY*V63-V43)+V23)-V03)/RTO+YY*(YY*V42-V22)+V02)/RTO+H 154 | 1ALF*(YY-ONE)/(3-IE))/RTO 155 | VY=GZ*VO*Y/DSQRT(RTO) 156 | WY=DSQRT(UY**2+VY**2) 157 | YM=WY/DSQRT(G7-G8*WY**2) 158 | WRITE (2,13) Y,UY,VY,WY,YM 159 | 10 IF (MOD(J,10) .EQ. 0) WRITE (2,14) 160 | XX1=CUBIC(CWOPPP/SIX,AWOPP/TWO,AWOP,WO-ONE) 161 | XXI=CUBIC(AWOPPP/SIX,AWOPP/TWO,AWOP,WO-W) 162 | WRITE (2,15) XX1,XXI,W,CWOPPP,TK 163 | WRITE (2,16) 164 | PX=AXN+1.D-1 165 | DO 11 J=1,11 166 | X=.1D+0*(J-1) 167 | XW=WO+X*(AWOP+X*(AWOPP/TWO+X*CWOPPP/SIX)) 168 | XWP=AWOP+X*(AWOPP+X*CWOPPP/TWO) 169 | XWPP=AWOPP+X*CWOPPP 170 | XM=XW/DSQRT(G7-G8*XW**2) 171 | XMP=XWP*G7*(XM/XW)**3 172 | XMPP=XMP*(XWPP/XWP+THR*G5*XMP*XW*XW/XM) 173 | IF (X.LT.AXN .OR. X.GT.PX) GO TO 11 174 | WRITE (2,18) AXN,W,AWP,AWPP,AMN,AMP,AMPP 175 | 11 WRITE (2,17) X,XW,XWP,XWPP,XM,XMP,XMPP 176 | RETURN 177 | C 178 | 12 FORMAT (1H1,8X,3A4,39H THROAT VELOCITY DISTRIBUTION, X=O, RC=,F10. 179 | 16//10X,44HDERIVATIVES TAKEN WITH RESPECT TO X/Y*, WOP=,F11.8//10X, 180 | 25HWOPP=,1PE15.7,5X,6HWOPPP=,E15.7//10X,4HY/YO,7X,4HU/A*,10X,4HV/A* 181 | 3,11X,1HW,11X,8HMACH NO. /) 182 | 13 FORMAT (1H ,F14.4,4F14.8 ) 183 | 14 FORMAT (1H ) 184 | 15 FORMAT (1H0,9X,18HFROM CUBIC, X/Y* =,F11.8,11H FOR W= 1.0 //22X,6H 185 | 1X/Y* =,F11.8,7H FOR W=,F11.8 //10X,16HCORRECTED WOPPP=,1PE15.7 // 186 | 210X,15HRMASS = Y*/YO =,0PF13.10 //) 187 | 16 FORMAT (1H0,9X,32HAXIAL VELOCITY DISTRIBUTION, Y=0 //10X,4HX/Y*,9X 188 | 1,1HW,17X,2HWP,16X,3HWPP,15X,1HM,17X,2HMP,16X,3HMPP /) 189 | 17 FORMAT (1H ,F13.3,1P6E18.7 ) 190 | 18 FORMAT (1H ,F16.8,1PE15.7,5E18.7 ) 191 | END 192 | -------------------------------------------------------------------------------- /sivells/MAIN.f: -------------------------------------------------------------------------------- 1 | C MAIN PART OF 2 | C PROGRAM CONTUR(INPUT,OUTPUT,TAPE5=INPUT,TAPE6=OUTPUT) 3 | C 4 | C NOZZLE CONTOUR PROGRAM VEV00028 FOR AXISYMMETRIC OR PLANAR FLOW 5 | C WITH RADIAL FLOW REGION AND/OR WITH CENTER-LINE VELOCITY OR MACH 6 | C NUMBER DISTRIBUTIONS DEFINED BY POLYNOMIALS. 7 | C 8 | C CORRECTION APPLIED FOR GROWTH OF TURBULENT BOUNDARY LAYER. 9 | C PERFECT GAS IS ASSUMED WITH CONSTANT SPECIFIC HEAT RATIO, GAM, 10 | C COMPRESSIBILITY FACTOR, ZO, AND RECOVERY FACTOR, RO, AS INPUTS. 11 | C ALSO INPUT IS GAS CONSTANT, AR, IN SQ FT PER SQ SECOND PER DEG R. 12 | C IF VISM IS SUTHERLANDS TEMPERATURE, VISCOSITY FOLLOWS SUTHERLANDS 13 | C LAW ABOVE VISM, BUT IS LINEAR WITH TEMPERATURE BELOW VISM. 14 | C IF (VISM .LE. 1.D+0) VISCOSITY=VISC*TEMPERATURE**VISM MAI 15 | C 16 | IMPLICIT REAL*8(A-H,O-Z) 17 | COMMON /GG/ GAM,GM,G1,G2,G3,G4,G5,G6,G7,G8,G9,GA,RGA,QT 18 | COMMON /COORD/ S(200),FS(200),WALTAN(200),SD(200),WMN(200),TTR(200 19 | 1),DMDX(200),SPR(200),DPX(200),SREF(200),XBIN,XCIN,GMA,GHB,GMC,GMD 20 | COMMON /CORR/ DLA(200),RCO(200),DAX(200),DRX(200),SL(200),DR2 21 | COMMON /PROP/ AR,ZO,RO,VISC,VISM,SFOA,XBL,CONV 22 | COMMON /PARAM/ ETAD,RC,AMACH,BMACH,CMACH,EMACH,GMACH,FRC,SF,WWO,WW 23 | 1OP,QM,WE,CBET,XE,ETA,EPSI,BPSI,XO,YO,RRC,SDO,XB,XC,AH,PP,SE,TYE,XA 24 | COMMON /JACK/ SJ(30),XJ(30),YJ(30),AJ(30) 25 | COMMON /CONTR/ ITLE(3),IE,LR,IT,JB,JQ,JX,KAT,KBL,KING,KO,LV,NOCON 26 | DATA ZRO/0.0D+0/,ONE/1.D+0/,TWO/2.D+0/,DC7/8HCURVATUR/ 27 | DATA DC1/8H D2Y/DX2/,DC2/8H /,DC3/8H ANGLE/ 28 | DATA DC4/8H DY/DX/,DC5/8H DY/DS/,DC6/8H DX/DS/ 29 | DATA L1/4H X/,L2/4H Y/,L3/4H S/,L4/4H /,L5/4HDIFF/ 30 | CONV=90.D+0/DASIN(ONE) 31 | IT=0 32 | NC=0 33 | LA=L1 34 | LB=L4 35 | DCA=DC4 36 | DCB=DC2 37 | JJ=1000 38 | DCC=DC1 39 | C 40 | OPEN(1,FILE='input.txt',STATUS='OLD',ACCESS='SEQUENTIAL', 41 | 1FORM='FORMATTED',ACTION='READ',BLANK='NULL') 42 | OPEN(UNIT=2, FILE='data.txt', STATUS='OLD') 43 | 1 READ (1,30,END=24) ITLE,JD 44 | IF (ITLE(1) .EQ. L4) GO TO 24 45 | IE=1+JD 46 | QT=ONE/(1+IE) 47 | C 48 | READ (1,28) GAM,AR,ZO,RO,VISC,VISM,SFOA,XBL 49 | C FOR GAMMA=1.4, G9=5, G8=.2, G7=1.2, G6=5/6, G5=1/6, G4=1/SQRT(6), 50 | C G3=1.5, G2=SQRT(6), G1=2.5 51 | GM=GAM-ONE 52 | G1=ONE/GM 53 | G9=TWO*G1 54 | G8=ONE/G9 55 | G7=ONE+G8 56 | G6=ONE/G7 57 | G5=G8*G6 58 | RGA=TWO*G5 59 | GA=ONE/RGA 60 | G4=DSQRT(G5) 61 | G3=GA/TWO 62 | G2=ONE/G4 63 | IF (IE .EQ. 0) AH=ZO 64 | IF (IE .EQ. 0) ZO=ONE 65 | QM=ONE 66 | JX=0 67 | 2 JQ=0 68 | LV=0 69 | 3 CALL AXIAL 70 | IF (LV .LT. 0) GO TO 1 71 | CALL PERFC 72 | IF (NOCON .NE. 0) GO TO 24 73 | IF ((JQ .GT. 0) .OR. (JX .GT. 0)) GO TO 3 74 | IF (JB .GT. 0) CALL BOUND 75 | IF (XBL .EQ. 1.D+3) GO TO 5 76 | IF (IT .LT. 1) GO TO 4 77 | LA=L3 78 | DCA=DC5 79 | DCC=DC7 80 | KUP=IT 81 | KAP=KUP+1 82 | XEND=ZRO 83 | C 84 | READ (1,28,END=24) (SJ(K),K=1,KUP),XST 85 | CSK=ONE/DSQRT(ONE+DRX(KAT)**2) 86 | SNK=CSK*DRX(KAT) 87 | CALL SPLIND (SL,RCO,ZRO,SNK,KAT) 88 | GO TO 6 89 | 4 IF (LV .GT. 0) GO TO 24 90 | IF (JX .LT. 0) GO TO 1 91 | GO TO 2 92 | 5 CONTINUE 93 | C 94 | READ (1,28,END=24) XST,XLOW,XEND,XINC,BJ,XMID,XINC2,CN 95 | IF (XST .EQ. XBL) XST=S(1) 96 | NC=CN-ONE 97 | IF (JB .LE. 0) CALL SPLIND (S,FS,WALTAN(1),WALTAN(KING),KING) 98 | IF (JB .GT. 0) CALL SPLIND (S,RCO,DRX(1),DRX(KAT),KAT) 99 | IF (XEND .GT. ZRO) GO TO 6 100 | LB=L5 101 | DCB=DC4 102 | 6 SLONG=S(KING)-S(1) 103 | IPP=0 104 | WRITE (2,25) ITLE,SLONG 105 | WRITE (2,31) LA,L2,DCA,DC3,DCC,DCB,LB 106 | IF (JB .GT. 0) GO TO 7 107 | WRITE (2,26) XST,FS(1),WALTAN(1),ZRO,SD(1) 108 | XMAX=SLONG+XST 109 | YMAX=FS(KING) 110 | TMAX=WALTAN(KING) 111 | GO TO 8 112 | 7 WRITE (2,26) XST,RCO(1),DRX(1),ZRO,DR2 113 | XMAX=S(KAT)-S(1)+XST 114 | YMAX=RCO(KAT) 115 | TMAX=DRX(KAT) 116 | 8 IF (IT .GT. 0) GO TO 11 117 | JB=BJ 118 | IF (XEND .GT. ZRO) GO TO 10 119 | IF (JB .LT. 0) GO TO 9 120 | KUP=KING-1 121 | KAP=KING-1 122 | GO TO 11 123 | 9 KUP=-JB 124 | KAP=KUP+1 125 | C 126 | READ (1,28,END=24) (SJ(K),K=1,KUP) 127 | GO TO 11 128 | 10 IF (XINC .GT. ZRO) KUP=(XEND-XLOW)/XINC+1.D-2 129 | IF (XMID .NE. ZRO) JJ=(XMID-XLOW)/XINC+1.D-2 130 | IF (XMID .NE. ZRO) KUP=JJ+(XEND-XMID)/XINC2+1.D-2 131 | IF (JB .GT. 10) KUP=JB 132 | IF (JB .GT. 10) XINC=SLONG/BJ 133 | KAP=(XMAX-XLOW)/XINC+1 134 | IF (XMID .NE. ZRO) KAP=JJ+(XMAX-XMID)/XINC2+1 135 | 11 DO 19 K=1,KUP 136 | IF (XEND .EQ. ZRO) GO TO 12 137 | X=XLOW+K*XINC 138 | IF (K .GT. JJ) X=XMID+(K-JJ)*XINC2 139 | GO TO 13 140 | 12 IF ((IT .LT. 1) .AND. (JB .GE.0)) X=S(K+1) 141 | IF ((IT .GT. 0) .OR. (JB .LT.0)) X=SJ(K) 142 | 13 XX=X-XST+S(1) 143 | IF (K .LT. KAP) CALL XYZ (XX,YY,YYP,YYPP) 144 | IF (K .EQ. KAP) X=XMAX 145 | IF (K .GE. KAP) YY=YMAX 146 | IF (K .GE. KAP) YYP=TMAX 147 | IF (K .GE. KAP) YYPP=ZRO 148 | IF (IT .LT. 1) GO TO 16 149 | IF (IPP .GT. 0) GO TO 14 150 | YJ(K)=YY 151 | AJ(K)=DASIN(YYP) 152 | WANG=CONV*AJ(K) 153 | CURV=YYPP/DCOS(AJ(K)) 154 | WRITE (2,26) X,YY,YYP,WANG,CURV 155 | GO TO 18 156 | 14 YY=YY-S(1)+XST 157 | XJ(K)=YY 158 | WANG=CONV*DACOS(YYP) 159 | WRITE (2,26) X,YY,YYP,WANG 160 | GO TO 18 161 | 16 WANG=CONV*DATAN(YYP) 162 | IF ((XEND .EQ. ZRO) .AND. (JB .GE. 0)) DY=YYP-WALTAN(K+1) 163 | IF (JB .LE. 0) GO TO 17 164 | FS(K+1)=YY 165 | WALTAN(K+1)=YYP 166 | SD(K+1)=YYPP 167 | 17 IF (XEND.GT.ZRO.OR.JB.LT.0) WRITE (2,26) X,YY,YYP,WANG,YYPP 168 | IF (XEND.EQ.ZRO.AND.JB.GE.0) WRITE (2,26) X,YY,YYP,WANG,YYPP,DY 169 | 18 IF (MOD(K,10) .EQ. 0) WRITE (2,29) 170 | IF (MOD(K,50) .NE. 0) GO TO 19 171 | WRITE (2,25) ITLE,SLONG 172 | WRITE (2,31) LA, L2, DCA, DC3, DCC, DCB, LB 173 | 19 CONTINUE 174 | IF ((IT .GT. 0) .AND. (IPP .EQ. 1)) CALL PLATE 175 | IF (IPP .GE. NC) GO TO 20 176 | IPP= IPP+1 177 | WRITE (2,25) ITLE, SLONG 178 | WRITE (2,31) LA,L2,DCA,DC3,DCC 179 | WRITE (2,26) XST,RCO(1),DRX(1),ZRO,DR2 180 | GO TO 11 181 | 20 IF ((IPP .GT. 0) .OR. (JX .LT. 0)) GO TO 1 182 | IF (IT .EQ. 0) GO TO 21 183 | IPP=1 184 | CALL SPLIND (SL,S,ONE,CSK,KAT) 185 | WRITE (2,29) 186 | WRITE (2,31) L3,L1,DC6,DC3 187 | WRITE (2,26) XST,XST,ONE,ZRO 188 | GO TO 11 189 | 21 IF (JB) 1,2,22 190 | 22 CALL SPLIND (S,WMN,DMDX(1),DMDX(KING),KING) 191 | DO 23 K=1,KUP 192 | X=XLOW+K*XINC 193 | IF (XEND .EQ. ZRO) X=S(K+1) 194 | XX=X-XST+S(1) 195 | IF (K .LT. KAP) CALL XYZ (XX,YY,YYP,YYPP) 196 | IF (K .GE. KAP) YY=CMACH 197 | IF (K .GE. KAP) YYP=ZRO 198 | S(K+1)=X 199 | WMN(K+1)=YY 200 | TTR(K+1)=ONE+G8*YY**2 201 | SPR(K+1)=ONE/TTR(K+1)**(ONE+G1) 202 | DMDX(K+1)=YYP 203 | 23 DPX(K+1)=-GAM*YY*YYP*SPR(K+1)/TTR(K+1) 204 | S(1)=XST 205 | KAT=KUP+1 206 | KBL=KAT+4 207 | KO=1 208 | CALL BOUND 209 | IF (JB .EQ. 7) STOP 210 | IF (JB .GT. 10) GO TO 1 211 | WRITE (2,25) ITLE, SLONG 212 | WRITE (2,31) L1,L2,DC4 213 | WRITE (2,27) (S(K),RCO(K),DRX(K),K=1,KAT) 214 | GO TO 1 215 | 24 CLOSE(1) 216 | CLOSE(2) 217 | STOP 218 | C 219 | 25 FORMAT (1H1,9X,3A4,'COORDINATES AND DERIVATIVES, LENGTH=',F12.7) 220 | 26 FORMAT (1H ,8X,2F15.6,1P4E20.8) 221 | 27 FORMAT (10(9X,0P2F15.6,1PE20.8/)) 222 | 28 FORMAT (8E10.3) 223 | 29 FORMAT (1H ) 224 | 30 FORMAT (3A4,I3) 225 | 31 FORMAT (1H0,14X,A4,'(IN)',7X,A4,'(IN)',6X,A8,12X,A8,14X,A8,9X,A8,2 226 | 1X,A4 /) 227 | END 228 | -------------------------------------------------------------------------------- /src/trans.f: -------------------------------------------------------------------------------- 1 | subroutine trans(rto,tk,wo,amn,amp,ampp,w,awp,awpp,cwoppp,axn) 2 | ! to determine throat characteristic 3 | use kinddefine 4 | use gg, only:gam,g2,g5,g6,g7,g8,ga,qt 5 | use contr, only:itle,ie,lr 6 | use troat 7 | implicit none 8 | ! 9 | interface 10 | function fmv(psi) 11 | use kinddefine 12 | implicit none 13 | real(kind=K8) :: fmv 14 | real(kind=K8), intent(in) :: psi 15 | end function fmv 16 | ! 17 | function cubic(ea,eb,ec,ed) 18 | use kinddefine 19 | implicit none 20 | real(kind=K8) :: cubic 21 | real(kind=K8), intent(in) :: ea,eb,ec,ed 22 | end function cubic 23 | end interface 24 | ! 25 | integer(kind=K4) :: i,j,jj,k,kk,nn 26 | real(kind=K8) :: add,amn,amp,ampp,as,awop,awopp,awoppp,awp,awpp 27 | real(kind=K8) :: axn,bet,bs,cs,bx,cwoppp,duy,dxi,eit,four,fma,fmu 28 | real(kind=K8) :: fsa,fsb,fsc,fsy,fsy1,gb,gk,gt,gu,gv,gz,half,hoppp 29 | real(kind=K8) :: hvppp,one,p1,psi,psi1,px,rc,rto,s1,s2,s3,six,sum 30 | real(kind=K8) :: t,t1,thr,tk,tlv,tn1,tn2,tna,trhv,two 31 | real(kind=K8) :: u22,u23,u42,u43,u63,up0,up2,uy 32 | real(kind=K8) :: v02,v03,v22,v23,v42,v43,v63,vo,vp,vpp,vy 33 | real(kind=K8) :: w,wo,wop,wopp,wwo,wy,x,x1,xm,xmp,xmpp,xot,xx1,xxi 34 | real(kind=K8) :: xw,xwp,xwpp,y,y1,y4,y6,ym,yy,zro 35 | data zro/0.0d+0/,one/1.d+0/,two/2.d+0/,six/6.d+0/,half/5.d-1/ 36 | data trhv/1.5d+0/,thr/3.d+0/,four/4.d+0/,eit/8.d+0/,tlv/1.2d+1/ 37 | nn=iabs(lr) 38 | jj=240/(nn-1) 39 | if(mod(jj,2).ne.0) jj=jj+1 40 | if(jj.lt.10) jj=10 41 | kk=jj*nn-jj 42 | gb=ie/eit 43 | gk=(gam*(gam+2.25d+0*ie-16.5d+0)+2.25d+0*(2+ie))/tlv 44 | gu=one-gam/trhv 45 | gv=(half*(5-3*ie)*gam+ie)/(9-ie) 46 | gz=dsqrt(qt*(gam+one)) 47 | u22=gb+gam/thr/(3-ie) 48 | u42=(gam+(4-ie)*trhv)/six/(3-ie) 49 | if (ie.eq.0) goto 1 50 | gt=(gam*(gam*92.d+0+180.d+0)-9.d+0)/1152.d+0 51 | u23=(gam*(304.d+0*gam+255.d+0)-54.d+0)/1728.d+0 52 | u43=(gam*(388.d+0*gam+777.d+0)+153.d+0)/2304.d+0 53 | u63=(gam*(556.d+0*gam+1737.d+0)+3069.d+0)/10368.d+0 54 | up0=(gam*(52.d+0*gam+75.d+0)-9.d+0)/192.d+0 55 | up2=(gam*(52.d+0*gam+51.d+0)+327.d+0)/384.d+0 56 | v02=(28.d+0*gam-15.d+0)/288.d+0 57 | v22=(20.d+0*gam+27.d+0)/96.d+0 58 | v42=(gam/thr+one)/thr 59 | v03=(gam*(7100.d+0*gam+2151.d+0)+2169.d+0)/82944.d+0 60 | v23=(gam*(3424.d+0*gam+4071.d+0)-972.d+0)/13824.d+0 61 | v43=(gam*(3380.d+0*gam+7551.d+0)+3771.d+0)/13824.d+0 62 | v63=(gam*(6836.d+0*gam+23031.d+0)+30627.d+0)/82944.d+0 63 | goto 2 64 | 1 gt=(gam*(gam*134.d+0+429.d+0)+123.d+0)/4320.d+0 65 | u23=(gam*(854.d+0*gam+807.d+0)+279.d+0)/12960.d+0 66 | u43=(gam*(194.d+0*gam+549.d+0)-63.d+0)/2592.d+0 67 | u63=(gam*(362.d+0*gam+1449.d+0)+3177.d+0)/12960.d+0 68 | up0=(gam*(26.d+0*gam+51.d+0)-27.d+0)/144.d+0 69 | up2=(gam*(26.d+0*gam+27.d+0)+237.d+0)/288.d+0 70 | v02=(34.d+0*gam-75.d+0)/1080.d+0 71 | v22=(10.d+0*gam+15.d+0)/108.d+0 72 | v42=(22.d+0*gam+75.d+0)/360.d+0 73 | v03=(gam*(7570.d+0*gam+3087.d+0)+23157.d+0)/544320.d+0 74 | v23=(gam*(5026.d+0*gam+7551.d+0)-4923.d+0)/77760.d+0 75 | v43=(gam*(2254.d+0*gam+6153.d+0)+2979.d+0)/25920.d+0 76 | v63=(gam*(6574.d+0*gam+26481.d+0)+40059.d+0)/181440.d+0 77 | 2 wwo=wo+(half+(u42-u22+(u63-u43+u23)/rto)/rto)/rto 78 | wop=(one-(gb-gt/rto)/rto)/dsqrt(rto) 79 | wopp=(gu-gv/rto)/rto 80 | hoppp=gk/rto/dsqrt(rto) 81 | hvppp=(3*ie-(10-3*ie)*gam)/four/rto/dsqrt(rto) 82 | amn=wwo/dsqrt(g7-g8*wwo**2) 83 | bet=dsqrt(amn**2-one) 84 | psi1=g2*datan(bet/g2)-datan(bet) 85 | p1=zro 86 | t1=zro 87 | x1=zro 88 | y1=one 89 | fsy1=zro 90 | tn2=-one/bet 91 | fc(1,nn)=x1 92 | fc(2,nn)=y1 93 | fc(3,nn)=amn 94 | fc(4,nn)=psi1 95 | fc(5,nn)=zro 96 | fc(6,nn)=zro 97 | bx=one 98 | sum=zro 99 | fsa=(ie+1)*amn/(g6+g5*amn**2)**ga 100 | do j=1,kk 101 | y=dfloat(kk-j)/kk 102 | if(ie.eq.1) bx=y+y 103 | yy=y*y 104 | tn1=tn2 105 | vo=(((yy*(yy*(yy*v63-v43)+v23)-v03)/rto+yy*(yy*v42-v22)+v02)/rto+ 106 | &half*(yy-one)/(3-ie))/rto 107 | vp=(one+((yy*(two*gam+3*(4-ie))-two*gam-trhv*ie)/(3-ie)/thr+(yy*( 108 | &six*u63*yy-four*u43)+two*u23)/rto)/rto)/dsqrt(rto) 109 | vpp=two*(one+(two*up2*yy-up0)/rto)/rto 110 | ! iterate for x and mach number from characteristic equations 111 | do i=1,10 112 | tna=half*(tn1+tn2) 113 | x=x1+(y-y1)/tna 114 | dxi=dsqrt((y-y1)**2+(x-x1)**2) 115 | xot=x/gz 116 | vy=gz*(vo+xot*(vp+xot*(half*vpp+xot*hvppp/thr)))/dsqrt(rto) 117 | w=amn/dsqrt(g6+g5*amn**2) 118 | t=dasin(vy*y/w) 119 | fsy=ie*vy/w/amn 120 | p1=half*(fsy1+fsy)*dxi 121 | 3 psi=p1+psi1+t1-t 122 | fma=fmv(psi) 123 | if(dabs(amn-fma).lt.1.d-10) goto 5 124 | fmu=dasin(one/fma) 125 | tn2=dtan(t-fmu) 126 | amn=fma 127 | enddo 128 | ! iteration complete 129 | 5 if(mod(j,2).eq.0) goto 6 130 | as=y1-y 131 | fsb=bx/dsin(fmu-t)/(g6+g5*fma**2)**ga 132 | goto 7 133 | 6 bs=y1-y 134 | cs=as+bs 135 | s1=(two-bs/as)*cs/six 136 | s3=(two-as/bs)*cs/six 137 | s2=cs-s1-s3 138 | fsc=bx/dsin(fmu-t)/(g6+g5*fma**2)**ga 139 | add=s1*fsa+s2*fsb+s3*fsc 140 | sum=add+sum 141 | fsa=fsc 142 | 7 x1=x 143 | y1=y 144 | t1=t 145 | fsy1=fsy 146 | psi1=psi 147 | if(mod(j,jj).ne.0) goto 8 148 | k=nn-j/jj 149 | fc(1,k)=x 150 | fc(2,k)=y 151 | fc(3,k)=fma 152 | fc(4,k)=psi 153 | fc(5,k)=t 154 | fc(6,k)=sum 155 | 8 enddo 156 | do j=1,nn 157 | fc(1,j)=fc(1,j)/tk 158 | fc(2,j)=fc(2,j)/tk 159 | fc(6,j)=one-fc(6,j)/sum 160 | enddo 161 | axn=fc(1,1) 162 | awop=wop*tk/gz 163 | awopp=wopp*(tk/gz)**2 164 | awoppp=two*hoppp*(tk/gz)**3 165 | cwoppp=six*(w-wo-axn*(awop+axn*awopp/two))/axn**3 166 | if(cwoppp.lt.awoppp) cwoppp=awoppp 167 | awp=awop+axn*(awopp+axn*cwoppp/two) 168 | awpp=awopp+axn*cwoppp 169 | amp=awp*g7*(amn/w)**3 170 | ampp=amp*(awpp/awp+thr*g5*amp*w*w/amn) 171 | if(lr.gt.0) return 172 | lr=nn 173 | rc=rto-one 174 | write (2,12) itle,rc,awop,awopp,awoppp 175 | do j=1,nn 176 | y=dfloat(j-1)/(nn-1) 177 | yy=y*y 178 | y4=yy**2 179 | y6=yy**3 180 | duy=(half*yy+(u42*y4-u22*yy+(u63*y6-u43*y4+u23*yy)/rto)/rto)/rto 181 | uy=wo+duy 182 | vo=(((yy*(yy*(yy*v63-v43)+v23)-v03)/rto+yy*(yy*v42-v22)+v02)/rto+ 183 | &half*(yy-one)/(3-ie))/rto 184 | vy=gz*vo*y/dsqrt(rto) 185 | wy=dsqrt(uy**2+vy**2) 186 | ym=wy/dsqrt(g7-g8*wy**2) 187 | write (2,13) y,uy,vy,wy,ym 188 | if(mod(j,10).eq.0) write (2,14) 189 | enddo 190 | xx1=cubic(cwoppp/six,awopp/two,awop,wo-one) 191 | xxi=cubic(awoppp/six,awopp/two,awop,wo-w) 192 | write (2,15) xx1,xxi,w,cwoppp,tk 193 | write (2,16) 194 | px=axn+1.d-1 195 | do j=1,11 196 | x=.1d+0*(j-1) 197 | xw=wo+x*(awop+x*(awopp/two+x*cwoppp/six)) 198 | xwp=awop+x*(awopp+x*cwoppp/two) 199 | xwpp=awopp+x*cwoppp 200 | xm=xw/dsqrt(g7-g8*xw**2) 201 | xmp=xwp*g7*(xm/xw)**3 202 | xmpp=xmp*(xwpp/xwp+thr*g5*xmp*xw*xw/xm) 203 | if(x.lt.axn.or.x.gt.px) goto 11 204 | write (2,18) axn,w,awp,awpp,amn,amp,ampp 205 | 11 write (2,17) x,xw,xwp,xwpp,xm,xmp,xmpp 206 | enddo 207 | return 208 | ! 209 | 12 format (1x,8x,3a4,' THROAT VELOCITY DISTRIBUTION, X=O, RC=',f10.6/ 210 | &/10x,'DERIVATIVES TAKEN WITH RESPECT TO X/Y*, WOP=',f11.8//10x,'WO 211 | &PP=',1pe15.7,5x,'WOPPP=',e15.7//10x,'Y/YO',7x,'U/A*',10x,'V/A*',11 212 | &x,'W',11x,'MACH NO.'/) 213 | 13 format (1x,f14.4,4f14.8) 214 | 14 format (1x) 215 | 15 format (1x,9x,'FROM CUBIC, X/Y* =',f11.8,' FOR W= 1.0'//22x,'X/Y* 216 | &=',f11.8,' FOR W=',f11.8 //10x,'CORRECTED WOPPP=',1pe15.7//10x,'RM 217 | &ASS = Y*/YO =',0pf13.10//) 218 | 16 format (1x,9x,'AXIAL VELOCITY DISTRIBUTION, Y=0'//10x,'X/Y*',9x,'W 219 | &',17x,'WP',16x,'WPP',15x,'M',17x,'MP',16x,'MPP'/) 220 | 17 format (1x,f13.3,1p6e18.7) 221 | 18 format (1x,f16.8,1pe15.7,5e18.7) 222 | end subroutine trans 223 | -------------------------------------------------------------------------------- /src/main.f: -------------------------------------------------------------------------------- 1 | ! main part of 2 | ! program contur(input,output,unit(1)=input,unit(2)=output) 3 | ! 4 | ! nozzle contour program vev00028 for axisymmetric or planar flow 5 | ! with radial flow region and/or with center-line velocity or mach 6 | ! number distributions defined by polynomials. 7 | ! 8 | ! correction applied for growth of turbulent boundary layer. 9 | ! perfect gas is assumed with constant specific heat ratio, gam, 10 | ! compressibility factor, zo, and recovery factor, ro, as inputs. 11 | ! also input is gas constant, ar, in sq ft per sq second per deg r. 12 | ! if vism is sutherlands temperature, viscosity follows sutherlands 13 | ! law above vism, but is linear with temperature below vism. 14 | ! if (vism .le. 1.d+0) viscosity=visc*temperature**vism mai 15 | ! 16 | program contur 17 | use kinddefine 18 | use gg, only:gam,gm,g1,g2,g3,g4,g5,g6,g7,g8,g9,ga,rga,qt 19 | use coord, only:dmdx,dpx,fs,s,sd,spr,ttr,waltan,wmn 20 | use corr, only:dr2,rco,drx,sl 21 | use prop, only:ar,zo,ro,visc,vism,sfoa,xbl,conv 22 | use param, only:ah,cmach,qm 23 | use jack, only:aj,sj,xj,yj 24 | use contr, only:itle,ie,it,jb,jq,jx,kat,kbl,king,ko,lv,nocon 25 | ! 26 | implicit none 27 | ! 28 | interface 29 | subroutine splind(x,y,tn2,tnl,l) 30 | use kinddefine 31 | implicit none 32 | integer(kind=K4),intent(in) :: l 33 | real(kind=K8),dimension(1),intent(in) :: x,y 34 | real(kind=K8),intent(in) :: tn2,tnl 35 | end subroutine splind 36 | ! 37 | subroutine xyz(xx,yy,yyp,yypp) 38 | use kinddefine 39 | implicit none 40 | real(kind=K8),intent(in) :: xx 41 | real(kind=K8),intent(out) :: yy,yyp,yypp 42 | end subroutine xyz 43 | end interface 44 | ! 45 | integer(kind=K4) :: ipp,jd,jj,k,kap,kup,nc 46 | real(kind=K8) :: bj,cn,csk,curv 47 | real(kind=K8) :: dy,one,slong,snk,tmax,two 48 | real(kind=K8) :: x,xend,xinc,xinc2 49 | real(kind=K8) :: xlow,xmax,xmid,xst,xx,ymax,yy,yyp,yypp,wang,zro 50 | character(len=4,kind=K3) :: l1,l2,l3,l4,l5,la,lb 51 | character(len=8,kind=K3) ::dc1,dc2,dc3,dc4,dc5,dc6,dc7,dca,dcb,dcc 52 | data zro/0.0d+0/,one/1.d+0/,two/2.d+0/,dc7/'CURVATUR'/ 53 | data dc1/' D2Y/DX2'/,dc2/' '/,dc3/' ANGLE'/ 54 | data dc4/' DY/DX'/,dc5/' DY/DS'/,dc6/' DX/DS'/ 55 | data l1/' X'/,l2/' Y'/,l3/' S'/,l4/' '/,l5/'DIFF'/ 56 | conv=90.d+0/dasin(one) 57 | it=0 58 | nc=0 59 | la=l1 60 | lb=l4 61 | dca=dc4 62 | dcb=dc2 63 | jj=1000 64 | dcc=dc1 65 | ! 66 | open(unit=1,file='input.txt',status='old',access='sequential', 67 | &form='formatted',action='read',blank='null') 68 | open(unit=2,file='output.txt',status='unknown',access='sequential' 69 | &,form='formatted',action='write') 70 | 1 read (1,30,end=24) itle,jd 71 | if (itle(1) .eq. l4) goto 24 72 | ie=1+jd 73 | qt=one/(1+ie) 74 | ! 75 | read (1,28) gam,ar,zo,ro,visc,vism,sfoa,xbl 76 | ! for gamma=1.4, g9=5, g8=.2, g7=1.2, g6=5/6, g5=1/6, g4=1/sqrt(6), 77 | ! g3=1.5, g2=sqrt(6), g1=2.5 78 | gm=gam-one 79 | g1=one/gm 80 | g9=two*g1 81 | g8=one/g9 82 | g7=one+g8 83 | g6=one/g7 84 | g5=g8*g6 85 | rga=two*g5 86 | ga=one/rga 87 | g4=dsqrt(g5) 88 | g3=ga/two 89 | g2=one/g4 90 | if (ie .eq. 0) ah=zo 91 | if (ie .eq. 0) zo=one 92 | qm=one 93 | jx=0 94 | 2 jq=0 95 | lv=0 96 | 3 call axial 97 | if (lv .lt. 0) goto 1 98 | call perfc 99 | if (nocon .ne. 0) goto 24 100 | if ((jq .gt. 0) .or. (jx .gt. 0)) goto 3 101 | if (jb .gt. 0) call bound 102 | if (xbl .eq. 1.d+3) goto 5 103 | if (it .lt. 1) goto 4 104 | la=l3 105 | dca=dc5 106 | dcc=dc7 107 | kup=it 108 | kap=kup+1 109 | xend=zro 110 | ! 111 | read (1,28,end=24) (sj(k),k=1,kup),xst 112 | csk=one/dsqrt(one+drx(kat)**2) 113 | snk=csk*drx(kat) 114 | call splind(sl,rco,zro,snk,kat) 115 | goto 6 116 | 4 if (lv .gt. 0) goto 24 117 | if (jx .lt. 0) goto 1 118 | goto 2 119 | 5 continue 120 | ! 121 | read (1,28,end=24) xst,xlow,xend,xinc,bj,xmid,xinc2,cn 122 | if (xst .eq. xbl) xst=s(1) 123 | nc=cn-one 124 | if (jb .le. 0) call splind(s,fs,waltan(1),waltan(king),king) 125 | if (jb .gt. 0) call splind(s,rco,drx(1),drx(kat),kat) 126 | if (xend .gt. zro) goto 6 127 | lb=l5 128 | dcb=dc4 129 | 6 slong=s(king)-s(1) 130 | ipp=0 131 | write (2,25) itle,slong 132 | write (2,31) la,l2,dca,dc3,dcc,dcb,lb 133 | if (jb .gt. 0) goto 7 134 | write (2,26) xst,fs(1),waltan(1),zro,sd(1) 135 | xmax=slong+xst 136 | ymax=fs(king) 137 | tmax=waltan(king) 138 | goto 8 139 | 7 write (2,26) xst,rco(1),drx(1),zro,dr2 140 | xmax=s(kat)-s(1)+xst 141 | ymax=rco(kat) 142 | tmax=drx(kat) 143 | 8 if (it .gt. 0) goto 11 144 | jb=int(bj) 145 | if (xend .gt. zro) goto 10 146 | if (jb .lt. 0) goto 9 147 | kup=king-1 148 | kap=king-1 149 | goto 11 150 | 9 kup=-jb 151 | kap=kup+1 152 | ! 153 | read (1,28,end=24) (sj(k),k=1,kup) 154 | goto 11 155 | 10 if (xinc .gt. zro) kup=(xend-xlow)/xinc+1.d-2 156 | if (xmid .ne. zro) jj=(xmid-xlow)/xinc+1.d-2 157 | if (xmid .ne. zro) kup=jj+(xend-xmid)/xinc2+1.d-2 158 | if (jb .gt. 10) kup=jb 159 | if (jb .gt. 10) xinc=slong/bj 160 | kap=(xmax-xlow)/xinc+1 161 | if (xmid .ne. zro) kap=jj+(xmax-xmid)/xinc2+1 162 | 11 do k=1,kup 163 | if (xend .eq. zro) goto 12 164 | x=xlow+k*xinc 165 | if (k .gt. jj) x=xmid+(k-jj)*xinc2 166 | goto 13 167 | 12 if ((it .lt. 1) .and. (jb .ge.0)) x=s(k+1) 168 | if ((it .gt. 0) .or. (jb .lt.0)) x=sj(k) 169 | 13 xx=x-xst+s(1) 170 | if (k .lt. kap) call xyz(xx,yy,yyp,yypp) 171 | if (k .eq. kap) x=xmax 172 | if (k .ge. kap) yy=ymax 173 | if (k .ge. kap) yyp=tmax 174 | if (k .ge. kap) yypp=zro 175 | if (it .lt. 1) goto 16 176 | if (ipp .gt. 0) goto 14 177 | yj(k)=yy 178 | aj(k)=dasin(yyp) 179 | wang=conv*aj(k) 180 | curv=yypp/dcos(aj(k)) 181 | write (2,26) x,yy,yyp,wang,curv 182 | goto 18 183 | 14 yy=yy-s(1)+xst 184 | xj(k)=yy 185 | wang=conv*dacos(yyp) 186 | write (2,26) x,yy,yyp,wang 187 | goto 18 188 | 16 wang=conv*datan(yyp) 189 | if ((xend .eq. zro) .and. (jb .ge. 0)) dy=yyp-waltan(k+1) 190 | if (jb .le. 0) goto 17 191 | fs(k+1)=yy 192 | waltan(k+1)=yyp 193 | sd(k+1)=yypp 194 | 17 if (xend.gt.zro.or.jb.lt.0) write (2,26) x,yy,yyp,wang,yypp 195 | if (xend.eq.zro.and.jb.ge.0) write (2,26) x,yy,yyp,wang,yypp,dy 196 | 18 if (mod(k,10) .eq. 0) write (2,29) 197 | if (mod(k,50) .ne. 0) goto 19 198 | write (2,25) itle,slong 199 | write (2,31) la,l2,dca,dc3,dcc,dcb,lb 200 | 19 continue 201 | enddo 202 | if ((it .gt. 0) .and. (ipp .eq. 1)) call plate 203 | if (ipp .ge. nc) goto 20 204 | ipp=ipp+1 205 | write (2,25) itle,slong 206 | write (2,31) la,l2,dca,dc3,dcc 207 | write (2,26) xst,rco(1),drx(1),zro,dr2 208 | goto 11 209 | 20 if ((ipp .gt. 0) .or. (jx .lt. 0)) goto 1 210 | if (it .eq. 0) goto 21 211 | ipp=1 212 | call splind(sl,s,one,csk,kat) 213 | write (2,29) 214 | write (2,31) l3,l1,dc6,dc3 215 | write (2,26) xst,xst,one,zro 216 | goto 11 217 | 21 if (jb) 1,2,22 218 | 22 call splind(s,wmn,dmdx(1),dmdx(king),king) 219 | do k=1,kup 220 | x=xlow+k*xinc 221 | if (xend .eq. zro) x=s(k+1) 222 | xx=x-xst+s(1) 223 | if (k .lt. kap) call xyz(xx,yy,yyp,yypp) 224 | if (k .ge. kap) yy=cmach 225 | if (k .ge. kap) yyp=zro 226 | s(k+1)=x 227 | wmn(k+1)=yy 228 | ttr(k+1)=one+g8*yy**2 229 | spr(k+1)=one/ttr(k+1)**(one+g1) 230 | dmdx(k+1)=yyp 231 | dpx(k+1)=-gam*yy*yyp*spr(k+1)/ttr(k+1) 232 | enddo 233 | s(1)=xst 234 | kat=kup+1 235 | kbl=kat+4 236 | ko=1 237 | call bound 238 | if (jb .eq. 7) stop 239 | if (jb .gt. 10) goto 1 240 | write (2,25) itle,slong 241 | write (2,31) l1,l2,dc4 242 | write (2,27) (s(k),rco(k),drx(k),k=1,kat) 243 | goto 1 244 | 24 close(1) 245 | close(2) 246 | stop 247 | ! 248 | 25 format (1x,9x,3a4,'COORDINATES AND DERIVATIVES, LENGTH=',f12.7/) 249 | 26 format (1x,8x,2f15.6,1p4e20.8) 250 | 27 format (10(9x,0P2f15.6,1pe20.8/)) 251 | 28 format (8e10.3) 252 | 29 format (1x) 253 | 30 format (3a4,i3) 254 | 31 format (1x,14x,a4,'(IN)',7x,a4,'(IN)',6x,a8,12x,a8,14x,a8,9x,a8,2x 255 | &,a4 /) 256 | end program contur 257 | -------------------------------------------------------------------------------- /sivells/PERFC.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE PERFC 2 | C 3 | C TO OBTAIN THE INVISCID CONTOUR OF THE NOZZLE 4 | C 5 | IMPLICIT REAL*8(A-H,O-Z) 6 | COMMON /GG/ GAM,GM,G1,G2,G3,G4,G5,G6,G7,G8,G9,GA,RGA,QT 7 | COMMON /CLINE/ AXIS(5,150),TAXI(5,150),WIP,X1,FRIP,ZONK,SEO,CSE 8 | COMMON /COORD/ S(200),FS(200),WALTAN(200),SD(200),WMN(200),TTR(200 9 | 1),DMDX(200),SPR(200),DPX(200),SECD(200),XBIN,XCIN,GMA,GMB,GMC,GMD 10 | COMMON /WORK/ A(5,150),B(5,150),FINAL(5,150),WALL(5,200),WAX(200), 11 | 1WAY(200),WAN(200) 12 | COMMON /PROP/ AR,ZO,RO,VISC,VISM,SFOA,XBL,CONV 13 | COMMON /PARAM/ ETAD,RC,AMACH,BMACH,CMACH,EMACH,GMACH,FRC,SF,WWO,WW 14 | 1OP,QM,WE,CBET,XE,ETA,EPSI,BPSI,XO,YO,RRC,SDO,XB,XC,AH,PP,SE,TYE,XA 15 | COMMON /TROAT/ FC(6,51) 16 | COMMON /CONTR/ ITLE(3),IE,LR,IT,JB,JQ,JX,KAT,KBL,KING,KO,LV,NOCON, 17 | 1IN,MC,MCP,IP,IQ,ISE,JC,M,MP,MQ,N,NP,NF,NUT 18 | DIMENSION CHAR(6,150), SU(150), WDX(200), WTAN(200), SCDF(200), YI 19 | 1(100) 20 | DATA ZRO/0.0D+0/,ONE/1.D+0/,TWO/2.D+0/,SIX/6.D+0/,HALF/5.D-1/ 21 | DATA IFR/4HFIRS/,IWL/4HWALL/,LST/4HLAST/,IBL/4H /,THR/3.D+0/ 22 | CALL OREZ (A,4*750+250) 23 | CPSI=G2*DATAN(G4*CBET)-DATAN(CBET) 24 | IF (JQ.GT.0) GO TO 6 25 | IF (LR.EQ.0) GO TO 4 26 | C 27 | C THROAT CHARACTERISTIC VALUES 28 | SUMAX=(SE/SEO)**(IE+1) 29 | IF (QM.EQ.ONE) SUMAX=ONE 30 | LQ=ZONK*(LR-1)+1 31 | NL=N+LQ-1 32 | DO 3 J=1,LQ 33 | IF (QM.NE.ONE) GO TO 1 34 | FC(1,J)=FC(1,J)*SE+XO 35 | FC(2,J)=FC(2,J)*SE 36 | 1 FINAL(1,J)=FC(1,J) 37 | FINAL(2,J)=FC(2,J) 38 | FINAL(3,J)=FC(3,J) 39 | FINAL(4,J)=FC(4,J) 40 | FINAL(5,J)=FC(5,J) 41 | IF (MQ.LT.0) GO TO 3 42 | IF (J.GT.1) GO TO 2 43 | WRITE (2,93) ITLE 44 | WRITE (2,99) IBL 45 | 2 XMU=CONV*DASIN(ONE/FINAL(3,J)) 46 | PSI=CONV*FINAL(4,J) 47 | AN=CONV*FINAL(5,J) 48 | XINCH=SF*FINAL(1,J)+FRIP 49 | YINCH=SF*FINAL(2,J) 50 | WRITE (2,103) J,(FINAL(K,J),K=1,3),XMU,PSI,AN,XINCH,YINCH 51 | IF (MOD(J,10).EQ.0) WRITE (2,98) 52 | 3 SU(J)=FC(6,J)/SUMAX 53 | 4 IF (ISE.EQ.0) GO TO 8 54 | C 55 | C INITIAL CHARACTERISTIC VALUES IF NON-RADIAL FLOW 56 | DO 5 K=1,M 57 | A(2,K)=(K-1)*TYE/(M-1) 58 | A(1,K)=A(2,K)*CBET+XE 59 | A(3,K)=CMACH 60 | A(4,K)=CPSI 61 | 5 A(5,K)=ZRO 62 | GO TO 10 63 | C 64 | C FINAL CHARACTERISTIC VALUES IF RADIAL FLOW 65 | 6 NL=N+NP-1 66 | FN=NP-1 67 | DO 7 JJ=1,NP 68 | IF (IE.EQ.0) F=(JJ-1)/FN 69 | IF (IE.EQ.1) F=TWO*DSIN(HALF*ETA*(JJ-1)/FN)/SE 70 | FINAL(2,JJ)=F*TYE 71 | FINAL(1,JJ)=FINAL(2,JJ)*CBET+XC 72 | FINAL(3,JJ)=CMACH 73 | FINAL(4,JJ)=CPSI 74 | FINAL(5,JJ)=ZRO 75 | 7 SU(JJ)=F**(IE+1) 76 | C 77 | C INITIAL CHARACTERISTIC VALUES IF RADIAL FLOW 78 | 8 EM=ETA/(M-1) 79 | DO 9 K=1,M 80 | T=(K-1)*EM 81 | IF (IP.EQ.0) XM=FMV(EPSI+T/QT) 82 | IF (IP.NE.0) XM=FMV(BPSI-T/QT) 83 | R=((G6+G5*XM**2)**GA/XM)**QT 84 | XBET=DSQRT(XM**2-ONE) 85 | A(1,K)=R*DCOS(T) 86 | A(2,K)=R*DSIN(T) 87 | A(3,K)=XM 88 | A(4,K)=G2*DATAN(G4*XBET)-DATAN(XBET) 89 | 9 A(5,K)=T 90 | IF (IE.EQ.1 .AND. IP.EQ.0) A(5,1)=TAXI(5,1) 91 | IF (IE.EQ.1 .AND. IP.NE.0) A(5,1)=AXIS(5,1) 92 | 10 DO 11 J=1,5 93 | 11 WALL(J,1)=A(J,M) 94 | LINE=1 95 | IF (MQ.LT.0)GO TO 14 96 | IF (ISE.EQ.1) GO TO 12 97 | IF (JQ.EQ.0) WRITE (2,91) ITLE 98 | IF (JQ.EQ.1) WRITE (2,94) ITLE 99 | GO TO 13 100 | 12 WRITE (2,102) ITLE 101 | 13 WRITE (2,106) LINE 102 | 14 SU(1)=ZRO 103 | IF (IE.EQ.0) BX=ONE/SE 104 | NN=1 105 | DO 15 K=1,M 106 | DO 15 J=1,5 107 | 15 B(J,K)=A(J,K) 108 | LAST=M-1 109 | GO TO 20 110 | 16 LAST=M 111 | LINE=2 112 | IF (IP.NE.0) GO TO 38 113 | 17 DO 18 J=1,5 114 | 18 B(J,1)=TAXI(J,LINE) 115 | DO 19 J=1,LAST 116 | K=J 117 | CALL OFELD(A(1,K),B(1,K),B(1,K+1),NOCON) 118 | IF (NOCON.NE.0) GO TO 83 119 | 19 CONTINUE 120 | 20 LASTP=LAST+1 121 | IF (LINE.LT.LASTP) LP=LINE 122 | NK=1+LP/52 123 | LA=CONV*DASIN(ONE/B(3,NN)) 124 | IPRNT=0 125 | ICHAR=0 126 | IF (JC.EQ.0) GO TO 21 127 | KC=IABS(JC) 128 | IF (JC.GT.0 .AND. JQ.NE.0) GO TO 21 129 | IF (JC.LT.0 .AND. JQ.EQ.0) GO TO 21 130 | ICHAR=1 131 | IF (KC.GT.100 .AND. KC.LT.101+LINE) IPRNT=1 132 | IF (NN.EQ.1 .AND. MOD(LINE-1,KC).EQ.0) IPRNT=1 133 | IF (NN.GT.1 .AND. MOD(NN-1,KC).EQ.0) IPRNT=1 134 | 21 DO 27 J=NN,LASTP 135 | IF (IE.EQ.1) BX=TWO*B(2,J)/SE**2 136 | XM=B(3,J) 137 | XMUR=DASIN(ONE/XM) 138 | XMU=CONV*XMUR 139 | PSI=B(4,J)*CONV 140 | AN=B(5,J)*CONV 141 | IF (B(2,J).EQ.ZRO) AN=ZRO 142 | IF (IP.EQ.0 .OR. LA.GT.45) GO TO 22 143 | S(J)=B(1,NN)-B(1,J) 144 | C MASS INTEGRATION WITH RESPECT TO X 145 | DSX=ONE/DCOS(B(5,J)-XMUR) 146 | IF (B(2,J).EQ.ZRO) DSX=XM/DSQRT(XM**2-ONE) 147 | GO TO 23 148 | 22 S(J)=B(2,J)-B(2,NN) 149 | C MASS INTEGRATION WITH RESPECT TO Y 150 | IF (IP.EQ.0) DSX=ONE/DSIN(XMUR+B(5,J)) 151 | IF (IP.NE.0) DSX=ONE/DSIN(XMUR-B(5,J)) 152 | IF (B(2,J).EQ.ZRO) DSX=XM 153 | 23 IF (ICHAR.EQ.0 .OR. J.NE.LINE) GO TO 24 154 | CHAR(1,J)=B(1,J) 155 | CHAR(2,J)=B(2,J) 156 | CHAR(3,J)=XM 157 | CHAR(4,J)=XMU 158 | CHAR(5,J)=PSI 159 | CHAR(6,J)=AN 160 | 24 FS(J)=DSX*BX/(G6+G5*XM**2)**GA 161 | IF (MQ.GE.0 .AND. LINE.EQ.1) GO TO 25 162 | IF (IPRNT.EQ.0) GO TO 27 163 | IF (J.GT.NN) GO TO 25 164 | IF (IP.EQ.0) WRITE (2,104) ITLE 165 | IF (IP.NE.0) WRITE (2,105) ITLE 166 | WRITE (2,106) LINE 167 | 25 IF ((NK.GT.1) .AND. (MOD(J,NK).EQ.0)) GO TO 26 168 | XINCH=SF*B(1,J)+FRIP 169 | YINCH=SF*B(2,J) 170 | WRITE (2,103) J,B(1,J),B(2,J),XM,XMU,PSI,AN,XINCH,YINCH 171 | 26 IF (MOD(J,10*NK).EQ.0) WRITE (2,98) 172 | 27 CONTINUE 173 | C 174 | C INTEGRATION AND INTERPOLATION FOR MASS FLOW 175 | SA=ZRO 176 | SB=ZRO 177 | SC=ZRO 178 | SUM=SU(NN) 179 | KAN=(LASTP-NN)/2 180 | DO 28 J=1,KAN 181 | K=NN+2*J 182 | KT=K 183 | AS=S(K-1)-S(K-2) 184 | BS=S(K)-S(K-1) 185 | CS=AS+BS 186 | S1=(TWO-BS/AS)*CS/SIX 187 | S3=(TWO-AS/BS)*CS/SIX 188 | S2=CS-S1-S3 189 | ADD=S1*FS(K-2)+S2*FS(K-1)+S3*FS(K) 190 | SUM=ADD+SUM 191 | IF (LINE.EQ.1) GO TO 28 192 | DEL=ONE-SUM 193 | IF (DEL) 30,29,28 194 | 28 CONTINUE 195 | IF (LINE.EQ.1) WRITE (2,96) SUM 196 | IF (LINE.EQ.1) GO TO 16 197 | BS=S(K+1)-S(K) 198 | KT=K+1 199 | DN=TWO*DEL/BS 200 | SC=DN/(FS(K)+DSQRT(FS(K)**2+(FS(KT)-FS(K))*DN)) 201 | SB=ONE-SC 202 | GO TO 34 203 | 29 SC=ONE 204 | GO TO 34 205 | 30 S2=BS*(TWO+CS/AS)/SIX 206 | S3=BS*(TWO+AS/CS)/SIX 207 | S1=BS-S2-S3 208 | BDD=S1*FS(K-2)+S2*FS(K-1)+S3*FS(K) 209 | IF (BDD+DEL) 31,32,33 210 | 31 DN=TWO*(ADD+DEL)/AS 211 | SB=DN/(FS(K-2)+DSQRT(FS(K-2)**2+(FS(K-1)-FS(K-2))*DN)) 212 | SA=ONE-SB 213 | GO TO 34 214 | 32 SB=ONE 215 | GO TO 34 216 | 33 DN=TWO*DEL/BS 217 | SC=ONE+DN/(FS(K)+DSQRT(FS(K)**2+(FS(K)-FS(K-1))*DN)) 218 | SB=ONE-SC 219 | 34 DO 35 J=1,5 220 | 35 WALL(J,LINE)=B(J,KT-2)*SA+B(J,KT-1)*SB+B(J,KT)*SC 221 | IF (IPRNT.EQ.1) WRITE (2,107) (WALL(J,LINE),J=1,3) 222 | LAST=KT 223 | IF (N-LINE) 42,41,36 224 | 36 LINE=LINE+1 225 | DO 37 K=1,5 226 | DO 37 L=1,150 227 | 37 A(K,L)=B(K,L) 228 | IF (IP.EQ.0) GO TO 17 229 | 38 DO 39 J=1,5 230 | 39 B(J,1)=AXIS(J,LINE) 231 | DO 40 J=1,LAST 232 | K=J 233 | CALL OFELD (B(1,K),A(1,K),B(1,K+1),NOCON) 234 | IF (NOCON.NE.0) GO TO 83 235 | 40 CONTINUE 236 | GO TO 20 237 | 41 IF (IP.NE.0) GO TO 42 238 | IF (LR.EQ.0 .OR. IT.NE.0) GO TO 49 239 | 42 IF (LINE.EQ.NL-1) GO TO 48 240 | NN=NN+1 241 | LINE=LINE+1 242 | DO 43 K=1,5 243 | DO 43 L=1,150 244 | 43 A(K,L)=B(K,L) 245 | DO 44 K=1,5 246 | DO 44 L=1,150 247 | 44 B(K,L)=FINAL(K,L) 248 | IF ((LR.NE.0) .AND. (JQ.EQ.0)) GO TO 46 249 | DO 45 J=NN,LAST 250 | K=J 251 | CALL OFELD(B(1,K),A(1,K),B(1,K+1),NOCON) 252 | IF (NOCON.NE.0) GO TO 83 253 | 45 CONTINUE 254 | GO TO 20 255 | 46 DO 47 J=NN,LAST 256 | K=J 257 | CALL OFELD(A(1,K),B(1,K),B(1,K+1),NOCON) 258 | IF (NOCON.NE.0) GO TO 83 259 | 47 CONTINUE 260 | GO TO 20 261 | 48 IF (IP.NE.0) GO TO 64 262 | C 263 | C INTEGRATION OF SLOPES 264 | 49 IB=1 265 | IF (IABS(JB).GT.1) IB=2 266 | LT=0 267 | IF (IT.NE.0) LT=IB 268 | NUT=(LINE-1)/IB+2-LT 269 | WALL(1,LINE+1)=XO 270 | WALL(5,LINE+1)=ZRO 271 | YI(NUT)=WALL(2,1) 272 | Y=YI(NUT) 273 | LIN=2*((LINE-LT)/2) 274 | DO 50 J=2,LIN,2 275 | I=NUT-J 276 | SS=WALL(1,J)-WALL(1,J-1) 277 | TT=WALL(1,J+1)-WALL(1,J) 278 | ST=SS+TT 279 | S1=SS*(TWO+TT/ST)/SIX 280 | S2=SS*(TWO+ST/TT)/SIX 281 | S3=SS-S1-S2 282 | T3=TT*(TWO+SS/ST)/SIX 283 | T2=TT*(TWO+ST/SS)/SIX 284 | T1=TT-T2-T3 285 | Y=Y+S1*DTAN(WALL(5,J-1))+S2*DTAN(WALL(5,J))+S3*DTAN(WALL(5,J+1)) 286 | IF (IB.EQ.1) YI(I+1)=Y 287 | Y=Y+T1*DTAN(WALL(5,J-1))+T2*DTAN(WALL(5,J))+T3*DTAN(WALL(5,J+1)) 288 | IF (IB.EQ.1) YI(I)=Y 289 | IF (IB.EQ.2) YI(I+J/2)=Y 290 | 50 CONTINUE 291 | IF (LR.NE.0 .AND. LINE.EQ.LIN) GO TO 51 292 | X=WALL(1,LINE-LT)-XO 293 | YI(1)=YI(2)-X*(DTAN(WALL(5,LINE-LT))+HALF*X*SDO)/THR 294 | 51 DO 52 L=2,NUT 295 | JJ=1+IB*(NUT-L) 296 | WAX(L)=WALL(1,JJ) 297 | WAY(L)=WALL(2,JJ) 298 | WMN(L)=WALL(3,JJ) 299 | WAN(L)=CONV*WALL(5,JJ) 300 | 52 WALTAN(L)=DTAN(WALL(5,JJ)) 301 | WAX(1)=XO 302 | WAY(1)=YO 303 | WAN(1)=ZRO 304 | WMN(1)=WWO/DSQRT(G7-G8*WWO**2) 305 | WALTAN(1)=ZRO 306 | IF (NF.GE.0) GO TO 54 307 | C 308 | C SMOOTH UPSTREAM CONTOUR IF DESIRED 309 | CALL NEO 310 | DO 53 J=1,NUT 311 | 53 WALTAN(J)=DTAN(WAN(J)/CONV) 312 | 54 CALL SCOND (WAX,WALTAN,SECD,NUT) 313 | SECD(1)=SDO 314 | SECD(NUT)=ZRO 315 | KO=NUT+MP 316 | IF (MP.EQ.0) GO TO 56 317 | C 318 | C RADIAL FLOW SECTION COORDINATES 319 | SNE=DSIN(ETA) 320 | TNE=DTAN(ETA) 321 | DM=(AMACH-GMACH)/MP 322 | DO 55 L=1,MP 323 | LL=NUT+L 324 | WMN(LL)=GMACH+L*DM 325 | RL=((G5*WMN(LL)**2+G6)**GA/WMN(LL))**QT 326 | WAX(LL)=RL*CSE 327 | WAY(LL)=RL*SNE 328 | WAN(LL)=ETAD 329 | WALTAN(LL)=TNE 330 | 55 SECD(LL)=ZRO 331 | 56 IF (MQ.LT.0) GO TO 60 332 | IF (JC.LE.0) GO TO 58 333 | WRITE (2,105) ITLE 334 | WRITE (2,99) LST 335 | DO 57 K=1,LP,NK 336 | I=(K-1)/NK+1 337 | XINCH=SF*CHAR(1,K)+FRIP 338 | YINCH=SF*CHAR(2,K) 339 | WRITE (2,103) K,(CHAR(J,K),J=1,6),XINCH,YINCH 340 | 57 IF (MOD(I,10).EQ.0) WRITE (2,98) 341 | 58 IF (ISE.EQ.0) WRITE (2,91) ITLE 342 | IF (ISE.EQ.1) WRITE (2,102) ITLE 343 | WRITE (2,84) RC,ETAD,AMACH,BMACH,CMACH,EMACH,MC,AH 344 | IF (NOCON.NE.0) GO TO 59 345 | WRITE (2,100) IWL 346 | WRITE (2,85) (K,WAX(K),WAY(K),WMN(K),WAN(K),WALTAN(K),SECD(K),K=1, 347 | 1NUT) 348 | IF ((LR.EQ.0) .AND. (N.LT.42)) GO TO 59 349 | IF ((LR.NE.0) .AND. (N+LR.LT.27)) GO TO 59 350 | NOCON=1 351 | GO TO 58 352 | 59 WRITE (2,87) 353 | NOCON=0 354 | C 355 | C COMPARISON OF CONTOUR WITH PARABOLA ANO HYPERBOLA 356 | 60 DO 62 J=1,NUT 357 | XS=(WAX(J)-XO)/YO 358 | XS2=XS**2 359 | XS3=XS**3 360 | YS=WAY(J)/YO 361 | YE=YI(J)/YO 362 | PS=ONE+HALF*XS2*RRC 363 | DHP=ONE+XS2*RRC 364 | HS=DSQRT(DHP) 365 | IF (J.GT.1) GO TO 61 366 | IF (MQ.LT.0) GO TO 62 367 | WRITE (2,88) J,XS,YS,YE,PS,HS 368 | GO TO 62 369 | 61 YPX=WALTAN(J)/XS 370 | CY=(PS-YS)/XS3 371 | CI=(PS-YE)/XS3 372 | IF (J.EQ.2) ICY=1.D+6*(DABS(CY)-DABS(CI)) 373 | IF (MQ.LT.0) GO TO 63 374 | CYP=(RRC-YPX)/XS/THR 375 | WRITE (2,88) J,XS,YS,YE,PS,HS,CY,CI,CYP 376 | 62 IF (MOD(J,10).EQ.0) WRITE (2,98) 377 | 63 WRITE (2,97) ICY 378 | IF (IQ.GT.0) GO TO 70 379 | JQ=1 380 | RETURN 381 | 64 LINE=NL 382 | DO 65 J=1,5 383 | 65 WALL(J,NL)=FINAL(J,NP) 384 | C 385 | C SMOOTH DOWNSTREAM CONTOUR IF DESIRED 386 | IF (NF.LT.0) CALL NEO 387 | DO 66 J=1,NL 388 | WDX(J)=WALL(1,J) 389 | 66 WTAN(J)=DTAN(WALL(5,J)) 390 | CALL SCOND (WDX,WTAN,SCDF,NL) 391 | SCDF(1)=ZRO 392 | SCDF(NL)=ZRO 393 | IF (JC.GE.0) GO TO 68 394 | WRITE (2,104) ITLE 395 | WRITE (2,99) IFR 396 | DO 67 K=1,LP,NK 397 | I=(K-1)/NK+1 398 | XINCH=SF*CHAR(1,K)+FRIP 399 | YINCH=SF*CHAR(2,K) 400 | WRITE (2,103) K,(CHAR(J,K),J=1,6),XINCH,YINCH 401 | 67 IF (MOD(I,10).EQ.0) WRITE (2,98) 402 | 68 IF (IQ.LT.0) KO=1 403 | NAG=KO-1 404 | KING=LINE+NAG 405 | DO 69 L=1,LINE 406 | WAX(NAG+L)=WALL(1,L) 407 | WAY(NAG+L)=WALL(2,L) 408 | WMN(NAG+L)=WALL(3,L) 409 | WAN(NAG+L)=CONV*WALL(5,L) 410 | WALTAN(NAG+L)=WTAN(L) 411 | 69 SECD(NAG+L)=SCDF(L) 412 | IF (MQ.LT.0) GO TO 71 413 | WRITE (2,94) ITLE 414 | WRITE (2,84) RC,ETAD,AMACH,BMACH,CMACH,EMACH,MC,AH 415 | WRITE (2,100) IWL 416 | WRITE (2,85) (K,WAX(K),WAY(K),WMN(K),WAN(K),WALTAN(K),SECD(K),K=KO 417 | 1,KING) 418 | GO TO 71 419 | 70 KING=KO 420 | C 421 | C APPLICATION OF SCALE FACTOR TO NON-DIMENSIONAL COORDINATES 422 | 71 DO 72 K=1,KING 423 | S(K)=SF*WAX(K)+FRIP 424 | FS(K)=SF*WAY(K) 425 | TTR(K)=ONE+G8*WMN(K)**2 426 | SPR(K)=ONE/TTR(K)**(ONE+G1) 427 | 72 SD(K)=SECD(K)/SF 428 | IF (ISE.EQ.1) XBIN=ZRO 429 | IF (ISE.EQ.0) XBIN=XB*SF+FRIP 430 | XCIN=XC*SF+FRIP 431 | CALL SCOND (S,WMN,DMDX,KING) 432 | DMDX(1)=G7*WWOP*WMN(1)**3/WWO**3/SF 433 | IF (MP.EQ.0 .OR. IQ.LT.0) GO TO 74 434 | DO 73 K=NUT,KO 435 | 73 DMDX(K)=WMN(K)*TTR(K)/(WMN(K)**2-ONE)/QT/SF/WAX(K) 436 | GO TO 75 437 | 74 IF (ISE.EQ.0) DMDX(KO)=AMACH*TTR(KO)/(AMACH**2-ONE)/QT/SF/XA 438 | 75 IF (IQ.LT.1 .OR. ISE.EQ.1) DMDX(KING)=ZRO 439 | DO 76 K=1,KING 440 | 76 DPX(K)=-GAM*WMN(K)*DMDX(K)*SPR(K)/TTR(K) 441 | JQ=0 442 | KAT=KING 443 | IF (IABS(MQ).LT.2) GO TO 78 444 | C 445 | C EXTENSION OF PARALLEL-FLOW CONTOUR 446 | KIT=KING+1 447 | KAT=KING+IABS(MQ) 448 | KUT=S(KING)+HALF 449 | INC=S(KING)-S(KING-1) 450 | IF (INC.LT.1) INC=1 451 | DO 77 K=KIT,KAT 452 | S(K)=KUT+(K-KING)*INC 453 | FS(K)=FS(KING) 454 | WMN(K)=WMN(KING) 455 | TTR(K)=TTR(KING) 456 | SPR(K)=SPR(KING) 457 | WAN(K)=ZRO 458 | WALTAN(K)=ZRO 459 | DMDX(K)=ZRO 460 | DPX(K)=ZRO 461 | 77 SD(K)=ZRO 462 | 78 IF (XBL.EQ.ZRO) GO TO 79 463 | IF (S(KING-1).LT.XBL) GO TO 79 464 | C 465 | C INTERPOLATE FOR VALUES AT SPECIFIED STATION 466 | CALL TWIXT (S,GMA,GMB,GMC,GMD,XBL,KING,KBL) 467 | GO TO 80 468 | 79 KBL=KAT+4 469 | 80 IF (JB.GT.0) RETURN 470 | IF (ISE.EQ.0) GO TO 81 471 | WRITE (2,102) ITLE 472 | WRITE (2,92) RC,SE,XCIN 473 | GO TO 82 474 | 81 IF (IQ.GT.0) WRITE (2,91) ITLE 475 | IF (IQ.LE.0) WRITE (2,95) ITLE,XBIN,XCIN,SF 476 | WRITE (2,84) RC,ETAD,AMACH,BMACH,CMACH,EMACH,MC,AH 477 | 82 WRITE (2,89) 478 | WRITE (2,90) (K,S(K),FS(K),WALTAN(K),SD(K),WMN(K),DMDX(K),SPR(K),D 479 | 1PX(K),K=1,KING) 480 | IF (KBL.GT.KAT) RETURN 481 | J=KBL-1 482 | FSX=GMA*FS(J-2)+GMB*FS(J-1)+GMC*FS(J)+GMD*FS(J+1) 483 | WMNX=GMA*WMN(J-2)+GMB*WMN(J-1)+GMC*WMN(J)+GMD*WMN(J+1) 484 | DMXX=GMA*DMDX(J-2)+GMB*DMDX(J-1)+GMC*DMDX(J)+GMD*DMDX(J+1) 485 | DYDX=GMA*WALTAN(J-2)+GMB*WALTAN(J-1)+GMC*WALTAN(J)+GMD*WALTAN(J+1) 486 | SDX=GMA*SD(J-2)+GMB*SD(J-1)+GMC*SD(J)+GMD*SD(J+1) 487 | SPRX=GMA*SPR(J-2)+GMB*SPR(J-1)+GMC*SPR(J)+GMD*SPR(J+1) 488 | DPXX=GMA*DPX(J-2)+GMB*DPX(J-1)+GMC*DPX(J)+GMD*DPX(J+1) 489 | WRITE (2,101) XBL,FSX,DYDX,SDX,WMNX,DMXX,SPRX,DPXX 490 | RETURN 491 | 83 WRITE (2,86) IP,NN,LINE,J 492 | RETURN 493 | C 494 | 84 FORMAT (1H ,4H RC=,F11.6,3X,5HETAD=F8.4,4H DEG,3X,6HAMACH=F10.7,3X 495 | 1,6HBMACH=F10.7,3X,6HCMACH=F10.7,3X,6HEMACH=F10.7,3X,A4,2HH=F11.7/) 496 | 85 FORMAT (10(8X,I3,2X,1P6E15.7/)) 497 | 86 FORMAT (1H0,9HOFELD,IP=,I3,5H, NN=,I3,7H, LINE=,I3,8H, POINT=,I3 ) 498 | 87 FORMAT (1H ,9X, 'POINT X/YO',8X,'Y/YO',7X,'INT.Y/YO',7X,'PAR/YO 499 | 1',7X,'HYP/YO C(Y)',11X,'C(YI)',10X,'C(YP)' /) 500 | 88 FORMAT (1H ,9X,I3,5F13.7,1P3E15.6 ) 501 | 89 FORMAT (1H ,9X,5HPOINT,7X,5HX(IN),9X,5HY(IN),9X,5HDY/DX,8X,7HD2Y/D 502 | 1X2,7X,8HMACH NO.,7X,5HDM/DX,9X,5HPE/PO,11X,6HDPR/DX/) 503 | 90 FORMAT (10(10X,I3,2X,0P6F14.7,1P2E16.5/)) 504 | 91 FORMAT (1H1,3A4,17H UPSTREAM CONTOUR/) 505 | 92 FORMAT (1H ,' RC=',F11.7,', STREAMLINE RATIO=',F11.8,', TEST 506 | 1 CONE BEGINS AT',F12.7,' IN.' / ) 507 | 93 FORMAT (1H1,3A4,22H THROAT CHARACTERISTIC ) 508 | 94 FORMAT (1H1,3A4,19H DOWNSTREAM CONTOUR/) 509 | 95 FORMAT (1H1,3A4,45H INVISCID NOZZLE CONTOUR, RADIAL FLOW ENDS ATF1 510 | 11.6,25H IN., TEST CONE BEGINS ATF11.6,19H IN., SCALE FACTOR=F9.4/) 511 | 96 FORMAT (1H0,8X,6HMASS =,F13.10) 512 | 97 FORMAT (1H0,9X,5HICY =, I13 / ) 513 | 98 FORMAT (1H ) 514 | 99 FORMAT (1H ,8X,A4/8X,5HPOINT,8X,1HX,14X,1HY,10X,68HMACH NO. M 515 | 1ACH ANG.(D) PSI (D) FLOW ANG.(D)CDI X(IN),9X,5HY(IN)/) 516 | 100 FORMAT (1H ,8X,A4/8X,5HPOINT,8X,1HX,14X,1HY,10X,37HMACH NO. F 517 | 1LOW ANG.(D) WALTAN,9X,6HSECDIF/) 518 | 101 FORMAT (1H0,14X,6F14.7,1P2E16.5) 519 | 102 FORMAT (1H1,3A4,17H INVISCID CONTOUR/) 520 | 103 FORMAT (1H ,I10,2X,1P6E15.7,0P2F14.7) 521 | 104 FORMAT (1H1,3A4,33H INTERMEDIATE LEFT CHARACTERISTIC/) 522 | 105 FORMAT (1H1,3A4,34H INTERMEDIATE RIGHT CHARACTERISTIC /) 523 | 106 FORMAT (1H ,8H CHARACT,I4/8X,5HPOINT,8X,1HX,14X,1HY,10X,68HMACH NO 524 | 1. MACH ANG.(D) PSI (D) FLOW ANG.(D) X(IN),9X,5 525 | 2HY(IN) /) 526 | 107 FORMAT (1H0,12H CONTOUR ,1P3E15.7 ) 527 | END 528 | -------------------------------------------------------------------------------- /sivells/BOUND.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE BOUND 2 | C 3 | C TO OBTAIN THE CORRECTION DUE TO THE TURBULENT BOUNDARY LAYER 4 | C 5 | IMPLICIT REAL*8(A-H,O-Z) 6 | COMMON /GG/ GAM,GM,G1,G2,G3,G4,G5,G6,G7,G8,G9,GA,RGA,QT 7 | COMMON /CORR/ DLA(200),RCO(200),DAX(200),DRX(200),SL(200),DR2 8 | COMMON /COORD/ S(200),FS(200),WALTAN(200),SD(200),WMN(200),TTR(200 9 | 1),DMDX(200),SPR(200),BTA(200),SREF(200),XBIN,XCIN,GMA,GMB,GMC,GMD 10 | COMMON /PROP/ AR,ZO,RO,VISC,VISM,SFOA,SBL,CONV 11 | COMMON /PARAM/ ETAD,RC,AMACH,BMACH,CMACH,EMACH,GMACH,FRC,SF,WWO,WW 12 | 1OP,QM,WE,CBET,XE,ETA,EPSI,BPSI,XO,YO,RRC,SDO,XB,XC,AH,PP,SE,TYE,XA 13 | COMMON /HTTR/ HAIR,TAW,TWQ,TW,TWAT,QFUN,QFUNW,IPQ,IJ,IV,IW 14 | COMMON /CONTR/ ITLE(3),IE,LR,IT,JB,JQ,JX,KAT,KBL,KING,KO,LV,NOCON, 15 | 1IN,MC,MCP 16 | DIMENSION Z(16), D(16), SCV(200), SK(200), CDS(200), RW(200) 17 | DATA ZRO/0.0D+0/,ONE/1.D+0/,TWO/2.D+0/,SIX/6.D+0/,HALF/5.D-1/ 18 | DATA THR/3.D+0/,FOUR/4.D+0/,TEN/1.D+1/,TLV/1.2D+1/ 19 | DATA CF1/3.865D-2/,CF2/4.561D+0/,CF3/5.46D-1/,FSI/3.17897971D+0/ 20 | DATA LY/4H Y/,LS/4H S/,DD/8HD2Y/DX2 /,DK/8H CURV. / 21 | DATA Z(1)/.052995325D-1/,Z(4)/.1222977958D+0/,Z(7)/.3591982246D+0/ 22 | DATA Z(2)/.277124885D-1/,Z(5)/.1910618778D+0/,Z(8)/.4524937451D+0/ 23 | DATA Z(3)/.671843988D-1/,Z(6)/.2709916112D+0/ 24 | DATA D(1)/.135762297D-1/,D(2)/.31126762D-1/,D(3)/.475792558D-1/ 25 | DATA D(4)/.623144856D-1/,D(5)/.747979944D-1/,D(6)/.845782597D-1/ 26 | DATA D(7)/.913017075D-1/,D(8)/.947253052D-1/ 27 | DO 1 J=9,16 28 | D(J)=D(17-J) 29 | 1 Z(J)=ONE-Z(17-J) 30 | DO 2 J=1,KAT 31 | 2 SREF(J)=S(J) 32 | SBIN=XBIN 33 | SCIN=XCIN 34 | TRPI=CONV/90.D+0 35 | FCC=2.05D+0+DLOG(.41D+0) 36 | CHAIR=GAM*G1*AR/RO/RO/777.64885D+0 37 | IF (IT .EQ. 0) XBL=SBL 38 | C 39 | 3 READ (1,66,END=65) PPQ,T0,TWT,TWAT,QFUN,ALPH,IHT,IR,LD,LV 40 | C 41 | PPS=PPQ 42 | RHO=144.D+0*PPS/ZO/AR/T0 43 | ID=IABS(LD) 44 | KOR=KO 45 | IF (IABS(IN) .EQ. 10) KOR=1 46 | IF (MCP .LT. 0) KOR=KING 47 | ROY=ONE 48 | IF (IE .EQ. 0) HW=AH 49 | IF ((ID .EQ. 0) .OR. (IE .EQ. 1)) HW=ZRO 50 | IF (HW .EQ. ZRO) YOH=ZRO 51 | IF (HW .EQ. ZRO) YOHA=ZRO 52 | ALF=DABS(ALPH) 53 | ARC=FRC 54 | IF (IHT .LT. 0) ARC=FRC**(IE+1) 55 | IPQ=0 56 | IW=1 57 | IF (LV .NE. 0) IW=IABS(LV) 58 | DO 4 J=1,KAT 59 | S(J)=SREF(J) 60 | SL(J)=S(J) 61 | RW(J)=FS(J) 62 | RCO(J)=FS(J) 63 | SCW=DSQRT(ONE+WALTAN(J)**2) 64 | SK(J)=SD(J)/SCW**3 65 | IF (KAT .EQ. KING) GO TO 4 66 | IF (S(J) .LT. SBL) KBL=J+2 67 | 4 DRX(J)=WALTAN(J) 68 | IF (KBL .GT. KAT) KBL=KAT+4 69 | 5 DO 58 IV=1,IW 70 | IF ((IV .GT. 1) .AND. (IV .LT. IW)) GO TO 15 71 | IF (LD .GE. 0) WRITE (2,80) ITLE,PPS,T0 72 | IF (ALPH .GT. ZRO) GO TO 6 73 | ALPHA=ZRO 74 | IF ((LD .GE. 0) .OR. (PPQ .EQ. ZRO)) WRITE (2,71) 75 | GO TO 7 76 | 6 ALPHA=ALPH 77 | IF ((LD .GE. 0) .OR. (PPQ .EQ. ZRO)) WRITE (2,70) 78 | 7 IF (IR .EQ. 2) GO TO 13 79 | IF (ALF .EQ. ONE) GO TO 8 80 | IF ((LD .GE. 0) .OR. (PPQ .EQ. ZRO)) WRITE (2,75) 81 | GO TO 9 82 | 8 IF ((LD .GE. 0) .OR. (PPQ .EQ. ZRO)) WRITE (2,72) 83 | 9 IF (IR) 10,11,12 84 | 10 IF ((LD .GE. 0) .OR. (PPQ .EQ. ZRO)) WRITE (2,74) 85 | GO TO 14 86 | 11 IF ((LD .GE. 0) .OR. (PPQ .EQ. ZRO)) WRITE (2,73) 87 | GO TO 14 88 | 12 IF ((LD .GE. 0) .OR. (PPQ .EQ. ZRO)) WRITE (2,76) 89 | GO TO 14 90 | 13 IF ((LD .GE. 0) .OR. (PPQ .EQ. ZRO)) WRITE (2,77) 91 | 14 IF (PPQ .EQ. ZRO) GO TO 60 92 | 15 CAPI=.55D+0 93 | IPP=0 94 | IJ=1 95 | DO 56 J=1,KAT 96 | BET=TTR(J)-ONE 97 | STR=ONE/TTR(J) 98 | TE=T0*STR 99 | RAJ=WMN(J)*(G7*STR)**GA 100 | IF (IHT .GE. 0) RAJ=RAJ**QT 101 | SCW=DSQRT(ONE+DRX(J)**2) 102 | EMU=VISC*TE*DSQRT(TE)/(TE+VISM) 103 | IF (TE .LT. VISM) EMU=HALF*VISC*TE/DSQRT(VISM) 104 | IF (VISM .LE. ONE) EMU=VISC*TE**VISM 105 | TAW=TE*(ONE+RO*BET) 106 | RHOE=RHO*STR**G1 107 | VE=WMN(J)*DSQRT(GAM*AR*TE) 108 | REO=RHOE*VE/EMU/TLV 109 | IF (HW .GT. ZRO) YOH=FS(J)/HW 110 | IF (IE .EQ. 0 .AND. HW .GT. ZRO) ROY=(HW/FS(J)+ONE)*TRPI 111 | K=J 112 | IF (J .EQ. 1) GO TO 19 113 | IF (J .GT. KOR) K=J-KOR+1 114 | IF (K-3) 16,17,18 115 | 16 DS=S(J)-S(J-1) 116 | SMD=HALF*DS 117 | GO TO 19 118 | 17 DT=S(J)-S(J-1) 119 | DST=DS+DT 120 | SMA=DST*(TWO-DT/DS)/SIX 121 | SMC=DST*(TWO-DS/DT)/SIX 122 | SMB=DST-SMA-SMC 123 | HB=H 124 | IF (IV .GT. 1) GO TO 19 125 | BMA=TWO/DS/DST 126 | BMB=-TWO/DS/DT 127 | BMC=TWO/DT/DST 128 | GO TO 19 129 | 18 DU=S(J)-S(J-1) 130 | DT=S(J-1)-S(J-2) 131 | DS=S(J-2)-S(J-3) 132 | DST=DS+DT 133 | DSTU=DST+DU 134 | DTU=DT+DU 135 | DUT=DU-DT 136 | DTS=DS-DT 137 | DTUS=DT+TWO*(DU-DS) 138 | DTSU=DT+TWO*(DS-DU) 139 | DSTTU=TWO*(DST+DTU) 140 | HA=HB 141 | HB=H 142 | QMA=HALF*DS*(ONE-DS*(THR+(DTU+DU)/DST)/DSTU/SIX) 143 | QMB=HALF*DS*(ONE+DS*(TWO+(DST+DT)/DTU)/DT/SIX) 144 | QMC=-DS**3*(ONE+(DTU+DU)/DST)/DT/DU/TLV 145 | QMD=DS**3*(DST+DT)/DU/DTU/DSTU/TLV 146 | SMA=HALF*DS+(DUT*DTU**3/DS-DS*DS*(DS+DSTTU))/DST/DSTU/TLV 147 | SMB=HALF*DST+(DS*DS*(DSTTU-DS)/DT+DT*DT*DTUS/DS-DU**3*(DSTU+DST)/D 148 | 1S/DT)/DTU/TLV 149 | SMC=HALF*DTU+(DT*DT*DTSU/DU+DU*DU*(DSTTU-DU)/DT-DS**3*(DSTU+DTU)/D 150 | 1T/DU)/DST/TLV 151 | SMD=HALF*DU+(DTS*DST**3/DU-DU*DU*(DU+DSTTU))/DTU/DSTU/TLV 152 | 19 IF (TWT .NE. ZRO) GO TO 20 153 | TW=TAW 154 | GO TO 21 155 | 20 TWD=(ARC*RAJ-ONE)*(TWT-TWAT)/(ARC-ONE) 156 | IF (TWD .LT. ZRO) TWD=ZRO 157 | TW=TWD+TWAT 158 | 21 WMU=VISC*TW*DSQRT(TW)/(TW+VISM) 159 | IF (VISM .LE. ONE) WMU=VISC*TW**VISM 160 | DL=TW/TE 161 | DM=ALPHA*(TAW-TW)/TE 162 | DN=ONE-DL-DM 163 | DA=ALF*(TAW-TW) 164 | DB=DA+TW-TE 165 | IF (DB) 22,23,24 166 | 22 DG=DSQRT(-DB*TE) 167 | DH=DSQRT(-DB*TW) 168 | DI=(TWO*(DG+TE-TW)-DA)/(TWO*DH+DA) 169 | DJ=DLOG(DI) 170 | TP=-DB/DJ/DJ 171 | GO TO 25 172 | 23 TP=(DSQRT(TE)+DSQRT(TW))**2/FOUR 173 | GO TO 25 174 | 24 DC=DSQRT(DA*DA+FOUR*TW*DB) 175 | DF=DASIN((DB+TW-TE)/DC) 176 | DE=DASIN(DA/DC) 177 | TP=DB/(DF+DE)/(DF+DE) 178 | 25 IF (IR) 26,27,28 179 | 26 FRD=TW*EMU/WMU/TP 180 | GO TO 29 181 | 27 FRD=EMU/WMU 182 | GO TO 29 183 | 28 FRD=TE*EMU/WMU/DSQRT(TP*TW) 184 | 29 IF (IPP .GT. 0) GO TO 31 185 | RTHI=1.D-2*REO*FS(1) 186 | RTII=RTHI 187 | RDLI=TEN*RTHI 188 | IF (IR .EQ. 1) GO TO 32 189 | 30 RTHG=DLOG10(RTHI) 190 | CFI=CF1/(RTHG+CF2)/(RTHG-CF3) 191 | 31 IF (IR .NE. 2) GO TO 33 192 | SCFI=DSQRT(CFI) 193 | TC=TW+17.2D+0*SCFI*DA-305.D+0*CFI*DB 194 | CMU=VISC*TC*DSQRT(TC)/(TC+VISM) 195 | IF (VISM .LE. ONE) CMU=VISC*TC**VISM 196 | TP=TW*CMU/WMU 197 | FRD=EMU/CMU 198 | GO TO 33 199 | 32 RDLG=DLOG10(RDLI) 200 | CFI=0.0444D+0/(RDLG+4.6221D+0)/(RDLG-1.4402D+0) 201 | 33 CF=CFI*TE/TP 202 | CFS=CF*SCW 203 | RTIG=DLOG10(RTII) 204 | XCF=.41D+0*DSQRT((RTIG+CF2)*(RTIG-CF3)/CF1) 205 | 34 C3=TWO+CAPI*(FSI+1.5D+0*CAPI) 206 | C2=ONE+CAPI 207 | C1=C2-C3/XCF 208 | FXCF=XCF+DLOG(C1/RTII)-FCC-TWO*CAPI 209 | FPCP=(XCF-FSI-THR*CAPI)/XCF/C1-TWO 210 | CAPI=CAPI-FXCF/FPCP 211 | IF (DABS(FXCF) .GT. 1.D-8) GO TO 34 212 | DOTI=XCF/C1 213 | XN=HALF*(DOTI+DSQRT(DOTI*(DOTI-SIX)+ONE)-THR) 214 | HI=ONE+TWO/XN 215 | SUMA=ZRO 216 | SUMB=ZRO 217 | SUMC=ZRO 218 | SUMD=ZRO 219 | DO 35 L=1,16 220 | UN=Z(L)**XN 221 | TR=DL+Z(L)*(DM+Z(L)*DN) 222 | ADD=D(L)*XN*UN/TR 223 | BDD=ADD*Z(L) 224 | CDD=ADD*UN 225 | DDD=BDD*UN 226 | SUMA=SUMA+ADD 227 | SUMB=SUMB+BDD 228 | SUMC=SUMC+CDD 229 | 35 SUMD=SUMD+DDD 230 | DOT=ONE/(SUMA-SUMB) 231 | DSOD=ONE-SUMA 232 | DSM=HALF-SUMC 233 | THM=SUMC-SUMD 234 | HU=DSOD*DOT 235 | IF (IPP .GT. 0) GO TO 36 236 | H=HU 237 | DOTR=DOT 238 | 36 FMY=(H+TWO-G9*BET)*DMDX(J)*STR/WMN(J)+ID*DRX(J)/(RW(J)+HW) 239 | IF (J.EQ.1) TH=CFS/FMY 240 | IF (K.EQ.2) TH=(THA+SMD*(DTHA+CFS))/(ONE+SMD*FMY) 241 | IF (K.EQ.3) TH=(THA+SMA*DTHA+SMB*DTHB+SMC*CFS)/(ONE+SMC*FMY) 242 | IF (K.GT.3) TH=(THA+SMA*DTHA+SMB*DTHB+SMC*DTHC+SMD*CFS)/(ONE+SMD*F 243 | 1MY) 244 | DELST=H*TH 245 | ASEC=DELST+DSQRT(ID*DELST**2+(FS(J)*SCW*ROY)**2) 246 | DOR=ID*DOTR*TH/ASEC 247 | DSROD=DSOD-DOR*DSM 248 | IPP=1 249 | DOTR=ONE/(ONE/DOT-THM*DOR) 250 | HR=DSROD*DOTR 251 | IF (DABS(H-HR) .LT. 5.D-7) GO TO 37 252 | H=HR 253 | GO TO 36 254 | 37 DELTA=DOTR*TH 255 | THU=DELTA/DOT 256 | DSU=DELTA*DSOD 257 | RDEL=REO*DELTA 258 | RTII=RDEL/DOTI 259 | RDLX=FRD*RDEL 260 | RTHX=RDLX/DOT 261 | IF (RTHX .LT. 100.D+0) GO TO 38 262 | IF (IR .EQ. 1) GO TO 39 263 | IF (DABS(ONE-RTHX/RTHI) .LT. 1.D-6) GO TO 41 264 | RTHI=RTHX 265 | GO TO 30 266 | 38 WRITE (2,88) RTHX,REO,FRD,TH,DELTA,DOT 267 | RETURN 268 | 39 IF (DABS(ONE-RDLX/RDLI) .LT. 1.D-6) GO TO 40 269 | RDLI=RDLX 270 | GO TO 32 271 | 40 RTHG=HALF*(DSQRT((CF2+CF3)**2+FOUR*CF1/CF1)-CF2+CF3) 272 | RTHX=TEN**RTHG 273 | 41 IF (J .GT. 1) GO TO 42 274 | DTH=ZRO 275 | HAIR=RHOE*VE*CF*CHAIR 276 | TAIR=HAIR 277 | IF (TWAT.EQ.TWT .OR. QFUN.EQ.ZRO) GO TO 46 278 | TWQ=(HAIR*TAW+QFUN*(TWAT-15.D+0))/(HAIR+QFUN) 279 | CALL HEAT 280 | IF (IPQ .GT. 100) GO TO 65 281 | IF (DABS(TW-TWQ).LT.1.D-2.AND.DABS(QFUN-QFUNW).LT.1.D-5) GO TO 46 282 | TWT=TWAT+(TWQ-TWAT)*(ARC-ONE)/(ARC*RAJ-ONE) 283 | QFUN=QFUNW 284 | GO TO 20 285 | 42 DTH=CFS-TH*FMY 286 | IF (DTH .LT. ZRO) DTH=ZRO 287 | IF (J .EQ. KOR) GO TO 46 288 | IF (K-3) 43,45,44 289 | 43 DTHB=DTH 290 | GO TO 47 291 | 44 THA=THA+QMA*DTHA+QMB*DTHB+QMC*DTHC+QMD*DTH 292 | DTHA=DTHB 293 | DTHB=DTHC 294 | IF (K .GT. 5) GO TO 45 295 | SCU=DSQRT(ONE+DRX(J-2)**2) 296 | DELA=HA*THA 297 | IF ((IE .EQ. 1).OR.(ID .EQ. 0)) YSEC=FS(J-2)*SCU 298 | IF ((IE .EQ. 0).AND.(HW .GT. ZRO)) YSEC=SCU*(FS(J-2)+HW)*TRPI 299 | IF (HW .GT. ZRO) YOHA=FS(J-2)/HW 300 | ASCA=DELA+DSQRT(ID*DELA**2+YSEC**2) 301 | RW(J-2)=ASCA/SCU 302 | DLA(J-2)=SCU*(ASCA-YSEC)*(ONE+YOHA) 303 | RCO(J-2)=FS(J-2)+DLA(J-2) 304 | 45 DTHC=DTH 305 | GO TO 47 306 | 46 THA=TH 307 | DTHA=DTH 308 | IF ((IV .GT. 1) .AND. (IV .LT. IW)) GO TO 47 309 | IF (J .EQ. 1 .AND. LD .GE. 0) WRITE (2,82) 310 | 47 CDS(J)=ASEC-SCW*FS(J)*ROY 311 | DLA(J)=SCW*CDS(J)*(ONE+YOH) 312 | RCO(J)=FS(J)+DLA(J) 313 | RW(J)=ASEC/SCW 314 | IF (IV .LT. IW) GO TO 48 315 | BTA(J)=-DMDX(J)*DSU/WMN(J)/TTR(J)/SCW/CFI 316 | IF (J.EQ.1 .OR. J.GT.KO .OR. IHT.EQ.0) GO TO 48 317 | IF (MOD(J,IHT) .NE. 1) GO TO 48 318 | IJ=J 319 | HAIR=RHOE*VE*CF*CHAIR 320 | CALL HEAT 321 | 48 IF (LD.LT.0) GO TO 56 322 | IF ((IV.GT.1).AND.(IV.LT.IW)) GO TO 56 323 | CFIK=2000.D+0*CFI 324 | CFK=2000.D+0*CF 325 | CFSK=2000.D+0*CFS 326 | DTHK=1000.D+0*DTH 327 | CTH=TWO*TH/(ONE+DSQRT(ONE-TWO*TH*ID/ASEC)) 328 | CH=CDS(J)/CTH 329 | IEO=REO+HALF 330 | ITHX=RTHX+HALF 331 | WRITE (2,83) J,TW,TE,TAW,TP,IEO,ITHX,FRD,CFIK,CFK,CFSK,H,HI,FMY,DT 332 | 1HK,TH,DELTA,DELST 333 | IF (J.LT.KBL-3) GO TO 54 334 | IF (J-KBL+2) 49,50,51 335 | 49 CTHA=CTH 336 | XNA=XN 337 | DLTA=DELTA 338 | REOA=REO 339 | GO TO 55 340 | 50 CTHB=CTH 341 | XNB=XN 342 | DLTB=DELTA 343 | REOB=REO 344 | GO TO 55 345 | 51 IF (J-KBL) 52,53,54 346 | 52 CTHC=CTH 347 | XNC=XN 348 | DLTC=DELTA 349 | REOC=REO 350 | GO TO 55 351 | 53 IF (IT.GT.0) GO TO 55 352 | DLST=GMA*CDS(J-3)+GMB*CDS(J-2)+GMC*CDS(J-1)+GMD*CDS(J) 353 | THBL=GMA*CTHA+GMB*CTHB+GMC*CTHC+GMD*CTH 354 | HBL=DLST/THBL 355 | DLTBL=GMA*DLTA+GMB*DLTB+GMC*DLTC+GMD*DELTA 356 | REOBL=GMA*REOA+GMB*REOB+GMC*REOC+GMD*REO 357 | REOFT=TLV*REOBL 358 | RETH=THBL*REOBL 359 | REDL=DLTBL*REOBL 360 | RETHG=DLOG10(RETH) 361 | REDLG=DLOG10(REDL) 362 | XNBL=GMA*XNA+GMB*XNB+GMC*XNC+GMD*XN 363 | GO TO 55 364 | 54 IF ((J.GT.3) .AND. (MOD(J,10).NE.0)) GO TO 56 365 | 55 WRITE (2,86) S(J),DSU,THU,CTH,HU,H,CH,XN 366 | 56 CONTINUE 367 | RW(1)=RCO(1) 368 | CALL SCOND(S,DLA,DAX,KAT) 369 | DO 57 J=1,KAT 370 | 57 DRX(J)=WALTAN(J)+DAX(J) 371 | IF ((IT.GT.0) .OR. (LD.LT.0)) GO TO 58 372 | IF ((IV.GT.1) .AND. (IV.LT.IW)) GO TO 58 373 | IF (KBL.LE.KAT) WRITE (2,85) XBL,DLST,THBL,HBL,XNBL,DLTBL,REOFT,RE 374 | 1TH,RETHG,REDL,REDLG 375 | IF (KBL.LE.KAT) GO TO 58 376 | HBL=CDS(KAT)/CTH 377 | REOFT=TLV*REO 378 | RETH=CTH*REO 379 | REDL=DELTA*REO 380 | RETHG=DLOG10(RETH) 381 | REDLG=DLOG10(REDL) 382 | IF (KBL.GT.KAT) WRITE (2,85) S(KAT),CDS(KAT),CTH,HBL,XN,DELTA,REOF 383 | 1T,RETH,RETHG,REDL,REDLG 384 | 58 CONTINUE 385 | DD2=BMA*DLA(1)+BMB*DLA(2)+BMC*DLA(3) 386 | DR2=SD(1)+DD2 387 | DXS=DAX(1)/DR2 388 | XST=S(1)-DXS 389 | YST=RCO(1)-HALF*DAX(1)**2/DR2 390 | SCW=DSQRT(ONE+DAX(1)**2) 391 | DR2=DR2/SCW**3 392 | RCV=ONE/DR2/YST 393 | IF (IT.GT.0) XBIN=SBIN-XST 394 | IF (IT.GT.0) XCIN=SCIN-XST 395 | WRITE (2,78) ITLE,XBIN,XCIN,SF 396 | PPQ=ZRO 397 | WRITE (2,67) RC,ETAD,AMACH,BMACH,CMACH,EMACH,MC,AH 398 | IF (TWT.NE.ZRO) GO TO 59 399 | WRITE (2,81) PPS,T0 400 | GO TO 5 401 | 59 WRITE (2,79) PPS,T0,TWT,TWAT,TAIR 402 | GO TO 5 403 | 60 IF (IT.EQ.0) GO TO 63 404 | DO 61 K=1,KAT 405 | S(K)=SREF(K)-XST 406 | 61 SCV(K)=DSQRT(ONE+DRX(K)**2) 407 | SCV(1)=ONE 408 | SL(1)=ZRO 409 | IM=(KAT-1)/2 410 | DO 62 I=1,IM 411 | J=2*I 412 | SS=S(J)-S(J-1) 413 | IF (I.EQ.1) SS=S(2) 414 | TT=S(J+1)-S(J) 415 | ST=SS+TT 416 | S1=(TWO-TT/SS)*ST/SIX 417 | S3=(TWO-SS/TT)*ST/SIX 418 | S2=ST-S1-S3 419 | SA=(TWO+TT/ST)*SS/SIX 420 | SB=(TWO+ST/TT)*SS/SIX 421 | SC=SS-SA-SB 422 | SL(J)=SL(J-1)+SA*SCV(J-1)+SB*SCV(J)+SC*SCV(J+1) 423 | 62 SL(J+1)=SL(J-1)+S1*SCV(J-1)+S2*SCV(J)+S3*SCV(J+1) 424 | XST=ZRO 425 | WRITE (2,68) LS,DK 426 | WRITE (2,69) (K,S(K),SL(K),DLA(K),RCO(K),WALTAN(K),SK(K),DAX(K),DR 427 | 1X(K),WMN(K),DMDX(K),SPR(K),BTA(K),K=1,KAT) 428 | IF (KBL.GT.KAT) GO TO 64 429 | CALL TWIXT (SL,GMA,GMB,GMC,GMD,SBL,KAT,KBL) 430 | XBL=GMA*S(KBL-3)+GMB*S(KBL-2)+GMC*S(KBL-1)+GMD*S(KBL) 431 | DLAB=GMA*DLA(KBL-3)+GMB*DLA(KBL-2)+GMC*DLA(KBL-1)+GMD*DLA(KBL) 432 | RCOB=GMA*RCO(KBL-3)+GMB*RCO(KBL-2)+GMC*RCO(KBL-1)+GMD*RCO(KBL) 433 | WRITE (2,89) XBL,SBL,DLAB,RCOB,GMA,GMB,GMC,GMD 434 | GO TO 64 435 | 63 WRITE (2,68) LY,DD 436 | WRITE (2,69) (K,S(K),FS(K),DLA(K),RCO(K),WALTAN(K),SD(K),DAX(K),DR 437 | 1X(K),WMN(K),DMDX(K),SPR(K),BTA(K),K=1,KAT) 438 | IF (KBL.GT.KAT) GO TO 64 439 | CALL TWIXT (S,GMA,GMB,GMC,GMD,XBL,KAT,KBL) 440 | DLAB=GMA*DLA(KBL-3)+GMB*DLA(KBL-2)+GMC*DLA(KBL-1)+GMD*DLA(KBL) 441 | RCOB=GMA*RCO(KBL-3)+GMB*RCO(KBL-2)+GMC*RCO(KBL-1)+GMD*RCO(KBL) 442 | YBL=RCOB-DLAB 443 | WRITE (2,84) XBL,YBL,DLAB,RCOB,GMA,GMB,GMC,GMD 444 | 64 WRITE (2,87) XST,YST,DD2,DR2,RCV 445 | S(1)=XST 446 | RCO(1)=YST 447 | DRX(1)=ZRO 448 | IF (SBL .EQ. 1.D+3) RETURN 449 | IF (LV .GT. 0) GO TO 3 450 | 65 CONTINUE 451 | IF (J .EQ. 1) WRITE (2,90) IPQ,QFUNW,TWT 452 | RETURN 453 | C 454 | 66 FORMAT (6E10.3,4I5) 455 | 67 FORMAT (1H ,4H RC=,F11.6,3X,5HETAD=,F8.4,4H DEG,3X,6HAMACH=,F10.7, 456 | &3X,6HBMACH=,F10.7,3X,6HCMACH=,F10.7,3X,6HEMACH=,F10.7,3X,A4,2HH=,F 457 | &11.7/) 458 | 68 FORMAT (1H ,7X,9HSTA(IN) ,A4,40H(IN) DELR(IN) R(IN) DY/D 459 | &X ,A8,50H DA/DX DR/DX MACH NO. DM/DX PE/PO,7X 460 | &,4HBETA/) 461 | 69 FORMAT (10(I4,0P2F11.6,2F11.7,4F10.7,F11.7,F10.7,1P2E12.4/)) 462 | 70 FORMAT (1H+,5X,34HQUADRATIC TEMPERATURE DISTRIBUTION) 463 | 71 FORMAT (1H+,5X,34HPARABOLIC TEMPERATURE DISTRIBUTION) 464 | 72 FORMAT (1H+,44X,34HSPALDING-CHI REFERENCE TEMPERATURE) 465 | 73 FORMAT (1H+,83X,36HVAN DRIEST REFERENCE REYNOLDS NUMBER /) 466 | 74 FORMAT (1H+,83X,35HCOLES LAW REFERENCE REYNOLDS NUMBER /) 467 | 75 FORMAT (1H+,44X,34HMODIF. SPALDING-CHI REFERENCE TEMP) 468 | 76 FORMAT (1H+,83X,40HREFERENCE REYNOLDS NUMBER BASED ON DELTA /) 469 | 77 FORMAT (1H+,44X,29HMODIFIED COLES TRANSFORMATION /) 470 | 78 FORMAT (1H1,3A4,39HNOZZLE CONTOUR, RADIAL FLOW ENDS AT STA,F12.7,2 471 | &5H, TEST CONE BEGINS AT STA,F12.7,16H, SCALE FACTOR =,F13.8/) 472 | 79 FORMAT (1H ,1X,15HSTAG. PRESSURE=,F5.0,24H PSI, STAG. TEMPERATURE= 473 | &,F5.0,21H DEG R, THROAT TEMP.=,F5.0,19H DEG R, WALL TEMP.=,F4.0,24 474 | &H DEG R, THROAT HT COEF.=,F8.5//) 475 | 80 FORMAT (1H1,3A4,49HBOUNDARY LAYER CALCULATIONS, STAGNATION PRESSUR 476 | &E=,F5.0,28HPSI, STAGNATION TEMPERATURE=,F5.0,27H DEG R, N BASED ON 477 | & RE,DELTA //) 478 | 81 FORMAT (1H ,5X,15HSTAG. PRESSURE=,F5.0,24H PSI STAG. TEMPERATURE=, 479 | &F5.0,34H DEG R ADIABATIC WALL TEMPERATURE//) 480 | 82 FORMAT (1H ,5X,38HTW TE TAW TP RE/IN RTHI,4X,3HFRD, 481 | &5X,4HKCF1,4X,3HKCF,5X,4HRCFS,5X,1HH,6X,2HHI,5X,38HFMY KTHP THE 482 | &TA-1 DELTA DELTA*-1 /) 483 | 83 FORMAT (1H ,I3,2F6.1,F7.1,F6.1,I9,I7,4F8.5,F8.4,F7.4,2F8.5,F9.6,F7 484 | &.4,F9.6) 485 | 84 FORMAT (1H ,3HSTA,2F11.6,2F11.7,7X,27HINTERPOLATION COEFFICIENTS,, 486 | & F12.8,1H,,F11.8,1H,,F11.8,1H,,F12.8 /) 487 | 85 FORMAT (1H0,5H X=,F7.3,11H, DELTA*=,F10.7,10H, THETA=,F9.7,6 488 | &H, H=,F10.6,6H, N=,F10.7,10H, DELTA=,F11.7,10H, RE/FT=,F11 489 | &.0//35X,9HRE,THETA=,F9.0,8H, LOG=,F8.5,1H,,16X,9HRE,DELTA=,F11.0 490 | &,8H, LOG=,F8.5) 491 | 86 FORMAT (1H ,3X,2HX=,F7.3,8H, DSU=,F8.5,8H, THU=,F9.7,8H, CTH 492 | &=,F9.7,7H, HU=,F10.6,6H, H=,F10.6,7H, CH=,F10.6,6H, N=,F8. 493 | &5) 494 | 87 FORMAT (1H ,3HSTA,F11.6,9H Y*=,F11.7,14H, D2A/DX2=,F12.9, 495 | &14H, D2R/DX2=,F12.9,16H, VISCID RC=,F14.8) 496 | 88 FORMAT (1H ,5HRTHX=,1PE12.5,6H, REO=,E12.5,6H, FRO=,0PF8.5,5H, TH= 497 | &,F8.5,8H, DELTA=,F8.5,6H, DOT=,F9.5) 498 | 89 FORMAT (1H ,3HSTA,2F11.6,2F11.7,7X,27HINTERPOLATION COEFFICIENTS,, 499 | &F12.8,1H,,F11.8,1H,,F11.8,1H,,F12.8 /) 500 | 90 FORMAT (1H0,10H ITERATION,I4,11H, QFUN =,F8.5,18H, THROAT TEM 501 | &P =,F6.1 /) 502 | END 503 | -------------------------------------------------------------------------------- /src/perfc.f: -------------------------------------------------------------------------------- 1 | subroutine perfc 2 | ! 3 | ! to obtain the inviscid contour of the nozzle 4 | ! 5 | use kinddefine 6 | use gg, only:gam,g1,g2,g4,g5,g6,g7,g8,ga,qt 7 | use cline, only:axis,taxi,frip,zonk,seo,cse 8 | use coord, only:s,fs,waltan,sd,wmn,ttr,dmdx,spr,dpx,secd,xbin,xcin 9 | &,gma,gmb,gmc,gmd 10 | use work, only:wall,wax,way,wan,a,b,fclast 11 | use prop, only:xbl,conv 12 | use param, only:etad,rc,amach,bmach,cmach,emach,gmach,sf,wwo,wwop, 13 | &qm,cbet,xe,eta,epsi,bpsi,xo,yo,rrc,sdo,xb,xc,ah,se,tye,xa 14 | use troat 15 | use contr, only:itle,ie,lr,it,jb,jq,kat,kbl,king,ko,nocon,mc,ip,iq 16 | &,ise,jc,m,mp,mq,n,np,nf,nut 17 | ! 18 | implicit none 19 | ! 20 | interface 21 | function fmv(psi) 22 | use kinddefine 23 | implicit none 24 | real(kind=K8) :: fmv 25 | real(kind=K8), intent(in) :: psi 26 | end function fmv 27 | ! 28 | subroutine ofeld(a,b,c,nocon) 29 | use kinddefine 30 | implicit none 31 | integer(kind=K4),intent(out) :: nocon 32 | real(kind=K8),dimension(5),intent(in) :: a,b 33 | real(kind=K8),dimension(5),intent(out) :: c 34 | end subroutine ofeld 35 | ! 36 | subroutine scond(a,b,c,king) 37 | use kinddefine 38 | implicit none 39 | integer(kind=K4),intent(in) :: king 40 | real(kind=K8),dimension(150),intent(in) :: a,b 41 | real(kind=K8),dimension(150),intent(out) :: c 42 | end subroutine scond 43 | ! 44 | subroutine twixt(s,gma,gmb,gmc,gmd,xbl,kat,kbl) 45 | use kinddefine 46 | implicit none 47 | integer(kind=K4),intent(in) :: kat 48 | integer(kind=K4),intent(out) :: kbl 49 | real(kind=K8),intent(out) :: gma,gmb,gmc,gmd 50 | real(kind=K8),intent(in) :: xbl 51 | real(kind=K8),dimension(200),intent(in) :: s 52 | end subroutine twixt 53 | end interface 54 | ! 55 | integer(kind=K4) :: i,ib,ichara,icy,inc,iprnt,j,jj,k,kan,kc,kit,kt 56 | integer(kind=K4) :: kut,l,last,lastp,lin,line,ll,lp,lq,lt,nag,nk 57 | integer(kind=K4) :: nl,nn 58 | real(kind=K8),dimension(6,150) :: chara 59 | real(kind=K8),dimension(150) :: su 60 | real(kind=K8),dimension(200) :: wdx,wtan,scdf 61 | real(kind=K8),dimension(100) :: yi 62 | real(kind=K8) :: add,an,as,bdd,bs,bx,ci,cpsi,cs,cy,cyp 63 | real(kind=K8) :: del,dhp,dm,dmxx,dn,dpxx,dsx,dydx,em,f,fn,fsx,half 64 | real(kind=K8) :: hs,la,one,ps,psi,r,rl,s1,s2,s3,sa,sb,sc,sdx 65 | real(kind=K8) :: six,sne,sprx,ss,st,sum1 66 | real(kind=K8) :: sumax,t,t1,t2,t3,thr,tne,tt,two,wmnx,x,xbet,xinch 67 | real(kind=K8) :: xm,xmu,xmur,xs,xs2,xs3,y,ye,yinch,ypx,ys,zro 68 | character(len=4,kind=K3) :: ifr,iwl,lst,ibl 69 | ! COMMON /GG/ GAM,GM,G1,G2,G3,G4,G5,G6,G7,G8,G9,GA,RGA,QT 70 | ! COMMON /CLINE/ AXIS(5,150),TAXI(5,150),WIP,X1,FRIP,ZONK,SEO,CSE 71 | ! COMMON /COORD/ S(200),FS(200),WALTAN(200),SD(200),WMN(200),TTR(200 72 | ! 1),DMDX(200),SPR(200),DPX(200),SECD(200),XBIN,XCIN,GMA,GMB,GMC,GMD 73 | ! COMMON /WORK/ WALL(5,200),WAX(200),WAY(200),WAN(200),A(5,150),B(5, 74 | ! 1150),FCLAST(5,150) 75 | ! COMMON /PROP/ AR,ZO,RO,VISC,VISM,SFOA,XBL,CONV 76 | ! COMMON /PARAM/ ETAD,RC,AMACH,BMACH,CMACH,EMACH,GMACH,FRC,SF,WWO,WW 77 | ! 1OP,QM,WE,CBET,XE,ETA,EPSI,BPSI,XO,YO,RRC,SDO,XB,XC,AH,PP,SE,TYE,XA 78 | ! COMMON /TROAT/ FC(6,51) 79 | ! COMMON /CONTR/ ITLE(3),IE,LR,IT,JB,JQ,JX,KAT,KBL,KING,KO,LV,NOCON, 80 | ! 1IN,MC,MCP,IP,IQ,ISE,JC,M,MP,MQ,N,NP,NF,NUT 81 | ! DIMENSION CHARA(6,150), SU(150), WDX(200), WTAN(200), SCDF(200), YI 82 | ! 1(100) 83 | data zro/0.0d+0/,one/1.d+0/,two/2.d+0/,six/6.d+0/,half/5.d-1/ 84 | data ifr/'FIRS'/,iwl/'WALL'/,lst/'LAST'/,ibl/' '/,thr/3.d+0/ 85 | ! call orez (a,4*750+250) 86 | a(:,:)=0.0d0 87 | b(:,:)=0.0d0 88 | fclast(:,:)=0.0d0 89 | wall(:,:)=0.0d0 90 | ! 91 | chara(:,:)=0.0d0 92 | su(:)=0.0d0 93 | wdx(:)=0.0d0 94 | wtan(:)=0.0d0 95 | scdf(:)=0.0d0 96 | yi(:)=0.0d0 97 | ! 98 | cpsi=g2*datan(g4*cbet)-datan(cbet) 99 | if (jq.gt.0) goto 6 100 | if (lr.eq.0) goto 4 101 | ! 102 | ! throat characteristic values 103 | sumax=(se/seo)**(ie+1) 104 | if (qm.eq.one) sumax=one 105 | lq=zonk*(lr-1)+1 106 | nl=n+lq-1 107 | do j=1,lq 108 | if (qm.ne.one) goto 1 109 | fc(1,j)=fc(1,j)*se+xo 110 | fc(2,j)=fc(2,j)*se 111 | 1 fclast(1,j)=fc(1,j) 112 | fclast(2,j)=fc(2,j) 113 | fclast(3,j)=fc(3,j) 114 | fclast(4,j)=fc(4,j) 115 | fclast(5,j)=fc(5,j) 116 | if (mq.lt.0) goto 3 117 | if (j.gt.1) goto 2 118 | write (2,93) itle 119 | write (2,99) ibl 120 | 2 xmu=conv*dasin(one/fclast(3,j)) 121 | psi=conv*fclast(4,j) 122 | an=conv*fclast(5,j) 123 | xinch=sf*fclast(1,j)+frip 124 | yinch=sf*fclast(2,j) 125 | write (2,103) j,(fclast(k,j),k=1,3),xmu,psi,an,xinch,yinch 126 | if (mod(j,10).eq.0) write (2,98) 127 | 3 su(j)=fc(6,j)/sumax 128 | enddo 129 | 4 if (ise.eq.0) goto 8 130 | ! 131 | ! initial characteristic values if non-radial flow 132 | do k=1,m 133 | a(2,k)=(k-1)*tye/(m-1) 134 | a(1,k)=a(2,k)*cbet+xe 135 | a(3,k)=cmach 136 | a(4,k)=cpsi 137 | a(5,k)=zro 138 | enddo 139 | goto 10 140 | ! 141 | ! final characteristic values if radial flow 142 | 6 nl=n+np-1 143 | fn=np-1 144 | do jj=1,np 145 | if (ie.eq.0) f=(jj-1)/fn 146 | if (ie.eq.1) f=two*dsin(half*eta*(jj-1)/fn)/se 147 | fclast(2,jj)=f*tye 148 | fclast(1,jj)=fclast(2,jj)*cbet+xc 149 | fclast(3,jj)=cmach 150 | fclast(4,jj)=cpsi 151 | fclast(5,jj)=zro 152 | su(jj)=f**(ie+1) 153 | enddo 154 | ! 155 | ! initial characteristic values if radial flow 156 | 8 em=eta/(m-1) 157 | do k=1,m 158 | t=(k-1)*em 159 | if (ip.eq.0) xm=fmv(epsi+t/qt) 160 | if (ip.ne.0) xm=fmv(bpsi-t/qt) 161 | r=((g6+g5*xm**2)**ga/xm)**qt 162 | xbet=dsqrt(xm**2-one) 163 | a(1,k)=r*dcos(t) 164 | a(2,k)=r*dsin(t) 165 | a(3,k)=xm 166 | a(4,k)=g2*datan(g4*xbet)-datan(xbet) 167 | a(5,k)=t 168 | enddo 169 | if (ie.eq.1 .and. ip.eq.0) a(5,1)=taxi(5,1) 170 | if (ie.eq.1 .and. ip.ne.0) a(5,1)=axis(5,1) 171 | 10 do j=1,5 172 | wall(j,1)=a(j,m) 173 | enddo 174 | line=1 175 | if (mq.lt.0) goto 14 176 | if (ise.eq.1) goto 12 177 | if (jq.eq.0) write (2,91) itle 178 | if (jq.eq.1) write (2,94) itle 179 | goto 13 180 | 12 write (2,102) itle 181 | 13 write (2,106) line 182 | 14 su(1)=zro 183 | if (ie.eq.0) bx=one/se 184 | nn=1 185 | do k=1,m 186 | do j=1,5 187 | b(j,k)=a(j,k) 188 | enddo 189 | enddo 190 | last=m-1 191 | goto 20 192 | 16 last=m 193 | line=2 194 | if (ip.ne.0) goto 38 195 | 17 do j=1,5 196 | b(j,1)=taxi(j,line) 197 | enddo 198 | do j=1,last 199 | k=j 200 | call ofeld(a(1,k),b(1,k),b(1,k+1),nocon) 201 | if (nocon.ne.0) goto 83 202 | enddo 203 | 20 lastp=last+1 204 | if (line.lt.lastp) lp=line 205 | nk=1+lp/52 206 | la=conv*dasin(one/b(3,nn)) 207 | iprnt=0 208 | ichara=0 209 | if (jc.eq.0) go to 21 210 | kc=iabs(jc) 211 | if (jc.gt.0 .and. jq.ne.0) go to 21 212 | if (jc.lt.0 .and. jq.eq.0) go to 21 213 | ichara=1 214 | if (kc.gt.100 .and. kc.lt.101+line) iprnt=1 215 | if (nn.eq.1 .and. mod(line-1,kc).eq.0) iprnt=1 216 | if (nn.gt.1 .and. mod(nn-1,kc).eq.0) iprnt=1 217 | 21 do j=nn,lastp 218 | if (ie.eq.1) bx=two*b(2,j)/se**2 219 | xm=b(3,j) 220 | xmur=dasin(one/xm) 221 | xmu=conv*xmur 222 | psi=b(4,j)*conv 223 | an=b(5,j)*conv 224 | if (b(2,j).eq.zro) an=zro 225 | if (ip.eq.0.or.la.gt.45) goto 22 226 | s(j)=b(1,nn)-b(1,j) 227 | ! mass integration with respect to x 228 | dsx=one/dcos(b(5,j)-xmur) 229 | if (b(2,j).eq.zro) dsx=xm/dsqrt(xm**2-one) 230 | goto 23 231 | 22 s(j)=b(2,j)-b(2,nn) 232 | ! mass integration with respect to y 233 | if (ip.eq.0) dsx=one/dsin(xmur+b(5,j)) 234 | if (ip.ne.0) dsx=one/dsin(xmur-b(5,j)) 235 | if (b(2,j).eq.zro) dsx=xm 236 | 23 if (ichara.eq.0 .or. j.ne.line) goto 24 237 | chara(1,j)=b(1,j) 238 | chara(2,j)=b(2,j) 239 | chara(3,j)=xm 240 | chara(4,j)=xmu 241 | chara(5,j)=psi 242 | chara(6,j)=an 243 | 24 fs(j)=dsx*bx/(g6+g5*xm**2)**ga 244 | if (mq.ge.0 .and. line.eq.1) goto 25 245 | if (iprnt.eq.0) goto 27 246 | if (j.gt.nn) goto 25 247 | if (ip.eq.0) write (2,104) itle 248 | if (ip.ne.0) write (2,105) itle 249 | write (2,106) line 250 | 25 if ((nk.gt.1) .and. (mod(j,nk).eq.0)) goto 26 251 | xinch=sf*b(1,j)+frip 252 | yinch=sf*b(2,j) 253 | write (2,103) j,b(1,j),b(2,j),xm,xmu,psi,an,xinch,yinch 254 | 26 if (mod(j,10*nk).eq.0) write (2,98) 255 | 27 continue 256 | enddo 257 | ! 258 | ! integration and interpolation for mass flow 259 | sa=zro 260 | sb=zro 261 | sc=zro 262 | sum1=su(nn) 263 | kan=(lastp-nn)/2 264 | do j=1,kan 265 | k=nn+2*j 266 | kt=k 267 | as=s(k-1)-s(k-2) 268 | bs=s(k)-s(k-1) 269 | cs=as+bs 270 | s1=(two-bs/as)*cs/six 271 | s3=(two-as/bs)*cs/six 272 | s2=cs-s1-s3 273 | add=s1*fs(k-2)+s2*fs(k-1)+s3*fs(k) 274 | sum1=add+sum1 275 | if (line.eq.1) goto 28 276 | del=one-sum1 277 | if (del) 30,29,28 278 | 28 continue 279 | enddo 280 | if (line.eq.1) write (2,96) sum1 281 | if (line.eq.1) goto 16 282 | bs=s(k+1)-s(k) 283 | kt=k+1 284 | dn=two*del/bs 285 | sc=dn/(fs(k)+dsqrt(fs(k)**2+(fs(kt)-fs(k))*dn)) 286 | sb=one-sc 287 | goto 34 288 | 29 sc=one 289 | goto 34 290 | 30 s2=bs*(two+cs/as)/six 291 | s3=bs*(two+as/cs)/six 292 | s1=bs-s2-s3 293 | bdd=s1*fs(k-2)+s2*fs(k-1)+s3*fs(k) 294 | if (bdd+del) 31,32,33 295 | 31 dn=two*(add+del)/as 296 | sb=dn/(fs(k-2)+dsqrt(fs(k-2)**2+(fs(k-1)-fs(k-2))*dn)) 297 | sa=one-sb 298 | go to 34 299 | 32 sb=one 300 | go to 34 301 | 33 dn=two*del/bs 302 | sc=one+dn/(fs(k)+dsqrt(fs(k)**2+(fs(k)-fs(k-1))*dn)) 303 | sb=one-sc 304 | 34 do j=1,5 305 | wall(j,line)=b(j,kt-2)*sa+b(j,kt-1)*sb+b(j,kt)*sc 306 | enddo 307 | if (iprnt.eq.1) write (2,107) (wall(j,line),j=1,3) 308 | last=kt 309 | if (n-line) 42,41,36 310 | 36 line=line+1 311 | do k=1,5 312 | do l=1,150 313 | a(k,l)=b(k,l) 314 | enddo 315 | enddo 316 | if (ip.eq.0) go to 17 317 | 38 do j=1,5 318 | b(j,1)=axis(j,line) 319 | enddo 320 | do j=1,last 321 | k=j 322 | call ofeld (b(1,k),a(1,k),b(1,k+1),nocon) 323 | if (nocon.ne.0) goto 83 324 | enddo 325 | goto 20 326 | 41 if (ip.ne.0) goto 42 327 | if (lr.eq.0.or.it.ne.0) goto 49 328 | 42 if (line.eq.nl-1) goto 48 329 | nn=nn+1 330 | line=line+1 331 | do k=1,5 332 | do l=1,150 333 | a(k,l)=b(k,l) 334 | enddo 335 | enddo 336 | do k=1,5 337 | do l=1,150 338 | b(k,l)=fclast(k,l) 339 | enddo 340 | enddo 341 | if ((lr.ne.0).and.(jq.eq.0)) goto 46 342 | do j=nn,last 343 | k=j 344 | call ofeld(b(1,k),a(1,k),b(1,k+1),nocon) 345 | if (nocon.ne.0) goto 83 346 | enddo 347 | goto 20 348 | 46 do j=nn,last 349 | k=j 350 | call ofeld(a(1,k),b(1,k),b(1,k+1),nocon) 351 | if (nocon.ne.0) go to 83 352 | enddo 353 | goto 20 354 | 48 if (ip.ne.0) goto 64 355 | ! 356 | ! integration of slopes 357 | 49 ib=1 358 | if (iabs(jb).gt.1) ib=2 359 | lt=0 360 | if (it.ne.0) lt=ib 361 | nut=(line-1)/ib+2-lt 362 | wall(1,line+1)=xo 363 | wall(5,line+1)=zro 364 | yi(nut)=wall(2,1) 365 | y=yi(nut) 366 | lin=2*((line-lt)/2) 367 | do j=2,lin,2 368 | i=nut-j 369 | ss=wall(1,j)-wall(1,j-1) 370 | tt=wall(1,j+1)-wall(1,j) 371 | st=ss+tt 372 | s1=ss*(two+tt/st)/six 373 | s2=ss*(two+st/tt)/six 374 | s3=ss-s1-s2 375 | t3=tt*(two+ss/st)/six 376 | t2=tt*(two+st/ss)/six 377 | t1=tt-t2-t3 378 | y=y+s1*dtan(wall(5,j-1))+s2*dtan(wall(5,j))+s3*dtan(wall(5,j+1)) 379 | if (ib.eq.1) yi(i+1)=y 380 | y=y+t1*dtan(wall(5,j-1))+t2*dtan(wall(5,j))+t3*dtan(wall(5,j+1)) 381 | if (ib.eq.1) yi(i)=y 382 | if (ib.eq.2) yi(i+j/2)=y 383 | enddo 384 | if (lr.ne.0.and.line.eq.lin) goto 51 385 | x=wall(1,line-lt)-xo 386 | yi(1)=yi(2)-x*(dtan(wall(5,line-lt))+half*x*sdo)/thr 387 | 51 do l=2,nut 388 | jj=1+ib*(nut-l) 389 | wax(l)=wall(1,jj) 390 | way(l)=wall(2,jj) 391 | wmn(l)=wall(3,jj) 392 | wan(l)=conv*wall(5,jj) 393 | waltan(l)=dtan(wall(5,jj)) 394 | enddo 395 | wax(1)=xo 396 | way(1)=yo 397 | wan(1)=zro 398 | wmn(1)=wwo/dsqrt(g7-g8*wwo**2) 399 | waltan(1)=zro 400 | if (nf.ge.0) goto 54 401 | ! 402 | ! smooth upstream contour if desired 403 | call neo 404 | do j=1,nut 405 | waltan(j)=dtan(wan(j)/conv) 406 | enddo 407 | 54 call scond (wax,waltan,secd,nut) 408 | secd(1)=sdo 409 | secd(nut)=zro 410 | ko=nut+mp 411 | if (mp.eq.0) goto 56 412 | ! 413 | ! radial flow section coordinates 414 | sne=dsin(eta) 415 | tne=dtan(eta) 416 | dm=(amach-gmach)/mp 417 | do l=1,mp 418 | ll=nut+l 419 | wmn(ll)=gmach+l*dm 420 | rl=((g5*wmn(ll)**2+g6)**ga/wmn(ll))**qt 421 | wax(ll)=rl*cse 422 | way(ll)=rl*sne 423 | wan(ll)=etad 424 | waltan(ll)=tne 425 | secd(ll)=zro 426 | enddo 427 | 56 if (mq.lt.0) goto 60 428 | if (jc.le.0) goto 58 429 | write (2,105) itle 430 | write (2,99) lst 431 | do k=1,lp,nk 432 | i=(k-1)/nk+1 433 | xinch=sf*chara(1,k)+frip 434 | yinch=sf*chara(2,k) 435 | write (2,103) k,(chara(j,k),j=1,6),xinch,yinch 436 | if (mod(i,10).eq.0) write (2,98) 437 | enddo 438 | 58 if (ise.eq.0) write (2,91) itle 439 | if (ise.eq.1) write (2,102) itle 440 | write (2,84) rc,etad,amach,bmach,cmach,emach,mc,ah 441 | if (nocon.ne.0) goto 59 442 | write (2,100) iwl 443 | write (2,85) (k,wax(k),way(k),wmn(k),wan(k),waltan(k),secd(k),k=1, 444 | &nut) 445 | if ((lr.eq.0) .and. (n.lt.42)) goto 59 446 | if ((lr.ne.0) .and. (n+lr.lt.27)) goto 59 447 | nocon=1 448 | goto 58 449 | 59 write (2,87) 450 | nocon=0 451 | ! 452 | ! comparison of contour with parabola and hyperbola 453 | 60 do j=1,nut 454 | xs=(wax(j)-xo)/yo 455 | xs2=xs**2 456 | xs3=xs**3 457 | ys=way(j)/yo 458 | ye=yi(j)/yo 459 | ps=one+half*xs2*rrc 460 | dhp=one+xs2*rrc 461 | hs=dsqrt(dhp) 462 | if (j.gt.1) goto 61 463 | if (mq.lt.0) goto 62 464 | write (2,88) j,xs,ys,ye,ps,hs 465 | goto 62 466 | 61 ypx=waltan(j)/xs 467 | cy=(ps-ys)/xs3 468 | ci=(ps-ye)/xs3 469 | if (j.eq.2) icy=int(1.d+6*(dabs(cy)-dabs(ci)),K4) 470 | if (mq.lt.0) go to 63 471 | cyp=(rrc-ypx)/xs/thr 472 | write (2,88) j,xs,ys,ye,ps,hs,cy,ci,cyp 473 | 62 if (mod(j,10).eq.0) write (2,98) 474 | enddo 475 | 63 write (2,97) icy 476 | if (iq.gt.0) goto 70 477 | jq=1 478 | return 479 | 64 line=nl 480 | do j=1,5 481 | wall(j,nl)=fclast(j,np) 482 | enddo 483 | ! 484 | ! smooth downstream contour if desired 485 | if (nf.lt.0) call neo 486 | do j=1,nl 487 | wdx(j)=wall(1,j) 488 | wtan(j)=dtan(wall(5,j)) 489 | enddo 490 | call scond (wdx,wtan,scdf,nl) 491 | scdf(1)=zro 492 | scdf(nl)=zro 493 | if (jc.ge.0) goto 68 494 | write (2,104) itle 495 | write (2,99) ifr 496 | do k=1,lp,nk 497 | i=(k-1)/nk+1 498 | xinch=sf*chara(1,k)+frip 499 | yinch=sf*chara(2,k) 500 | write (2,103) k,(chara(j,k),j=1,6),xinch,yinch 501 | if (mod(i,10).eq.0) write (2,98) 502 | enddo 503 | 68 if (iq.lt.0) ko=1 504 | nag=ko-1 505 | king=line+nag 506 | do l=1,line 507 | wax(nag+l)=wall(1,l) 508 | way(nag+l)=wall(2,l) 509 | wmn(nag+l)=wall(3,l) 510 | wan(nag+l)=conv*wall(5,l) 511 | waltan(nag+l)=wtan(l) 512 | secd(nag+l)=scdf(l) 513 | enddo 514 | if (mq.lt.0) goto 71 515 | write (2,94) itle 516 | write (2,84) rc,etad,amach,bmach,cmach,emach,mc,ah 517 | write (2,100) iwl 518 | write (2,85) (k,wax(k),way(k),wmn(k),wan(k),waltan(k),secd(k),k=ko 519 | &,king) 520 | goto 71 521 | 70 king=ko 522 | ! 523 | ! application of scale factor to non-dimensional coordinates 524 | 71 do k=1,king 525 | s(k)=sf*wax(k)+frip 526 | fs(k)=sf*way(k) 527 | ttr(k)=one+g8*wmn(k)**2 528 | spr(k)=one/ttr(k)**(one+g1) 529 | sd(k)=secd(k)/sf 530 | enddo 531 | if (ise.eq.1) xbin=zro 532 | if (ise.eq.0) xbin=xb*sf+frip 533 | xcin=xc*sf+frip 534 | call scond (s,wmn,dmdx,king) 535 | dmdx(1)=g7*wwop*wmn(1)**3/wwo**3/sf 536 | if (mp.eq.0 .or. iq.lt.0) go to 74 537 | do k=nut,ko 538 | dmdx(k)=wmn(k)*ttr(k)/(wmn(k)**2-one)/qt/sf/wax(k) 539 | enddo 540 | goto 75 541 | 74 if (ise.eq.0) dmdx(ko)=amach*ttr(ko)/(amach**2-one)/qt/sf/xa 542 | 75 if (iq.lt.1 .or. ise.eq.1) dmdx(king)=zro 543 | do k=1,king 544 | dpx(k)=-gam*wmn(k)*dmdx(k)*spr(k)/ttr(k) 545 | enddo 546 | jq=0 547 | kat=king 548 | if (iabs(mq).lt.2) goto 78 549 | ! 550 | ! extension of parallel-flow contour 551 | kit=king+1 552 | kat=king+iabs(mq) 553 | kut=s(king)+half 554 | inc=s(king)-s(king-1) 555 | if (inc.lt.1) inc=1 556 | do k=kit,kat 557 | s(k)=kut+(k-king)*inc 558 | fs(k)=fs(king) 559 | wmn(k)=wmn(king) 560 | ttr(k)=ttr(king) 561 | spr(k)=spr(king) 562 | wan(k)=zro 563 | waltan(k)=zro 564 | dmdx(k)=zro 565 | dpx(k)=zro 566 | sd(k)=zro 567 | enddo 568 | 78 if (xbl.eq.zro) goto 79 569 | if (s(king-1).lt.xbl) goto 79 570 | ! 571 | ! interpolate for values at specified station 572 | call twixt (s,gma,gmb,gmc,gmd,xbl,king,kbl) 573 | goto 80 574 | 79 kbl=kat+4 575 | 80 if (jb.gt.0) return 576 | if (ise.eq.0) goto 81 577 | write (2,102) itle 578 | write (2,92) rc,se,xcin 579 | goto 82 580 | 81 if (iq.gt.0) write (2,91) itle 581 | if (iq.le.0) write (2,95) itle,xbin,xcin,sf 582 | write (2,84) rc,etad,amach,bmach,cmach,emach,mc,ah 583 | 82 write (2,89) 584 | write (2,90) (k,s(k),fs(k),waltan(k),sd(k),wmn(k),dmdx(k),spr(k),d 585 | &px(k),k=1,king) 586 | if (kbl.gt.kat) return 587 | j=kbl-1 588 | fsx=gma*fs(j-2)+gmb*fs(j-1)+gmc*fs(j)+gmd*fs(j+1) 589 | wmnx=gma*wmn(j-2)+gmb*wmn(j-1)+gmc*wmn(j)+gmd*wmn(j+1) 590 | dmxx=gma*dmdx(j-2)+gmb*dmdx(j-1)+gmc*dmdx(j)+gmd*dmdx(j+1) 591 | dydx=gma*waltan(j-2)+gmb*waltan(j-1)+gmc*waltan(j)+gmd*waltan(j+1) 592 | sdx=gma*sd(j-2)+gmb*sd(j-1)+gmc*sd(j)+gmd*sd(j+1) 593 | sprx=gma*spr(j-2)+gmb*spr(j-1)+gmc*spr(j)+gmd*spr(j+1) 594 | dpxx=gma*dpx(j-2)+gmb*dpx(j-1)+gmc*dpx(j)+gmd*dpx(j+1) 595 | write (2,101) xbl,fsx,dydx,sdx,wmnx,dmxx,sprx,dpxx 596 | return 597 | 83 write (2,86) ip,nn,line,j 598 | return 599 | ! 600 | 84 format (1x,' RC=',f11.6,3x,'ETAD=',f8.4,' DEG',3x,'AMACH=',f10.7,3 601 | &x,'BMACH=',f10.7,3x,'CMACH=',f10.7,3x,'EMACH=',f10.7,3x,A4,'H=',f1 602 | &1.7/) 603 | 85 format (10(8x,i3,2x,1p6e15.7/)) 604 | 86 format ('0','OFELD,IP=',i3,', NN=',i3,', LINE=',i3,', POINT=',i3) 605 | 87 format (1x,9x,'POINT X/YO',8x,'Y/YO',7x,'INT.Y/YO',7x,'PAR/YO',7x, 606 | &'HYP/YO C(Y)',11x,'C(YI)',10x,'C(YP)'/) 607 | 88 format (1x,9x,i3,5f13.7,1p3e15.6) 608 | 89 format (1x,9x,'POINT',7x,'X(IN)',9x,'Y(IN)',9x,'DY/DX',8x,'D2Y/DX2 609 | &',7x,'MACH NO.',7x,'DM/DX',9x,'PE/PO',11x,'DPR/DX'/) 610 | 90 format (10(10x,i3,2x,0p6f14.7,1p2e16.5/)) 611 | 91 format (1x,3a4,' UPSTREAM CONTOUR'/) 612 | 92 format (1x,' RC=',f11.7,', STREAMLINE RATIO=',f11.8,', TEST 613 | &CONE BEGINS AT',f12.7,' IN.'/) 614 | 93 format (1x,3a4,' THROAT CHARACTERISTIC') 615 | 94 format (1x,3a4,' DOWNSTREAM CONTOUR'/) 616 | 95 format ('1',3a4,' INVISCID NOZZLE CONTOUR, RADIAL FLOW ENDS AT',f1 617 | &1.6,' IN., TEST CONE BEGINS AT',f11.6,' IN., SCALE FACTOR=',f9.4/) 618 | 96 format (1x,8x,'MASS =',f13.10/) 619 | 97 format (1x,9x,'ICY =',i13) 620 | 98 format (1x) 621 | 99 format (1x,8x,a4/8x,'POINT',8x,'X',14x,'Y',10x,'MACH NO. MACH 622 | & ANG.(D) PSI (D) FLOW ANG.(D) X(IN)',9x,'Y(IN)'/) 623 | 100 format (1x,8x,a4/8x,'POINT',8x,'X',14x,'Y',10x,'MACH NO. FLOW 624 | & ANG.(D) WALTAN',9x,'SECDIF'/) 625 | 101 format ('0',14x,6f14.7,1p2e16.5) 626 | 102 format ('1',3a4,' INVISCID CONTOUR'/) 627 | 103 format (1x,i10,2x,1p6e15.7,0p2f14.7) 628 | 104 format (1x,3a4,' INTERMEDIATE LEFT CHARACTERISTIC'/) 629 | 105 format (1x,3a4,' INTERMEDIATE RIGHT CHARACTERISTIC'/) 630 | 106 format (1x,' CHARACT',i4/8x,'POINT',8x,'X',14x,'Y',10x,'MACH NO. 631 | & MACH ANG.(D) PSI (D) FLOW ANG.(D) X(IN)',9X,'Y( 632 | &IN)'/) 633 | 107 format (1x,' CONTOUR ',1p3e15.7/) 634 | end subroutine perfc 635 | -------------------------------------------------------------------------------- /src/bound.f: -------------------------------------------------------------------------------- 1 | subroutine bound 2 | ! 3 | ! to obtain the correction due to the turbulent boundary layer 4 | ! 5 | use kinddefine 6 | use gg, only:gam,g1,g7,g9,ga,qt 7 | use coord, only:s,fs,waltan,sd,wmn,ttr,dmdx,spr,bta,sref,xbin,xcin 8 | &,gma,gmb,gmc,gmd 9 | use corr, only:dla,rco,dax,drx,sl,dr2 10 | use prop, only:ar,zo,ro,visc,vism,xbl,conv 11 | use param, only:etad,rc,amach,bmach,cmach,emach,frc,sf,ah 12 | use httr, only:hair,taw,twq,tw,twat,qfun,qfunw,ipq,ij,iv,iw 13 | use contr, only:itle,ie,it,kat,kbl,king,ko,lv,in,mc,mcp 14 | ! 15 | implicit none 16 | ! 17 | interface 18 | subroutine scond(a,b,c,king) 19 | use kinddefine 20 | implicit none 21 | integer(kind=K4),intent(in) :: king 22 | real(kind=K8),dimension(150),intent(in) :: a,b 23 | real(kind=K8),dimension(150),intent(out) :: c 24 | end subroutine scond 25 | ! 26 | subroutine twixt(s,gma,gmb,gmc,gmd,xbl,kat,kbl) 27 | use kinddefine 28 | implicit none 29 | integer(kind=K4),intent(in) :: kat 30 | integer(kind=K4),intent(out) :: kbl 31 | real(kind=K8),intent(out) :: gma,gmb,gmc,gmd 32 | real(kind=K8),intent(in) :: xbl 33 | real(kind=K8),dimension(200),intent(in) :: s 34 | end subroutine twixt 35 | end interface 36 | ! 37 | integer(kind=K4) :: i,id,ieo,iht,im,ipp,ir,ithx,j,k,kor,l,ld 38 | real(kind=K8) :: add,alf,alph,alpha,arc,asca,asec 39 | real(kind=K8) :: bdd,bet,bma,bmb,bmc 40 | real(kind=K8) :: c1,c2,c3,capi,cdd,ch,chair,cf 41 | real(kind=K8) :: cf1,cf2,cf3,cfi,cfik,cfk 42 | real(kind=K8) :: cfs,cfsk,cmu,cth,ctha,cthb,cthc 43 | real(kind=K8) :: da,db,dc,dd2,ddd,de,dela,delta,delst,df,dg 44 | real(kind=K8) :: dh,di,dj,dl,dlab,dlst,dlta,dltb,dltbl,dltc 45 | real(kind=K8) :: dm,dn,dor,dot,doti,dotr 46 | real(kind=K8) :: ds,dsm,dsod,dsrod,dst,dstu,dsttu,dsu 47 | real(kind=K8) :: dt,dth,dtha,dthb,dthc,dthk,dts,dtsu,dtu,dtus,du 48 | real(kind=K8) :: dut,dxs,emu,fcc,fmy,four,fpcp,frd,fsi,fxcf 49 | real(kind=K8) :: h,ha,half,hb,hbl,hi,hr,hu,hw 50 | real(kind=K8) :: one,ppq,pps,qma,qmb,qmc,qmd,raj,rcob,rcv,rdel 51 | real(kind=K8) :: rdlg,rdli,rdlx,redl,redlg,reo,reoa,reob,reobl 52 | real(kind=K8) :: reoc,reoft,reth,rethg 53 | real(kind=K8) :: rho,rhoe,roy,rthg,rthx,rtig 54 | real(kind=K8) :: rthi,rtii,s1,s2,s3,sa,sb,sbin,sc,scfi,scin,scu 55 | real(kind=K8) :: scw,six,sma,smb,smc,smd,ss 56 | real(kind=K8) :: suma,sumb,sumc,sumd,st,str 57 | real(kind=K8) :: t0,tair,tc,te,ten 58 | real(kind=K8) :: th,tha,thbl,thm,thr,thu,tlv 59 | real(kind=K8) :: tp,tr,trpi,tt,twd,two,twt,un 60 | real(kind=K8) :: ve,wmu,xbl1,xcf,xn,xna,xnb,xnbl,xnc,xst 61 | real(kind=K8) :: ybl,yoh,yoha,ysec,yst,zro 62 | real(kind=K8),dimension(16) :: d,z 63 | real(kind=K8),dimension(200) :: cds,rw,scv,sk 64 | character(len=4,kind=K3) :: ly,ls 65 | character(len=8,kind=K3) :: dd,dk 66 | ! COMMON /GG/ GAM,GM,G1,G2,G3,G4,G5,G6,G7,G8,G9,GA,RGA,QT 67 | ! COMMON /CORR/ DLA(200),RCO(200),DAX(200),DRX(200),SL(200),DR2 68 | ! COMMON /COORD/ S(200),FS(200),WALTAN(200),SD(200),WMN(200),TTR(200 69 | ! 1),DMDX(200),SPR(200),BTA(200),SREF(200),XBIN,XCIN,GMA,GMB,GMC,GMD 70 | ! COMMON /PROP/ AR,ZO,RO,VISC,VISM,SFOA,XBL,CONV 71 | ! COMMON /PARAM/ ETAD,RC,AMACH,BMACH,CMACH,EMACH,GMACH,FRC,SF,WWO,WW 72 | ! 1OP,QM,WE,CBET,XE,ETA,EPSI,BPSI,XO,YO,RRC,SDO,XB,XC,AH,PP,SE,TYE,XA 73 | ! COMMON /HTTR/ HAIR,TAW,TWQ,TW,TWAT,QFUN,QFUNW,IPQ,IJ,IV,IW 74 | ! COMMON /CONTR/ ITLE(3),IE,LR,IT,JB,JQ,JX,KAT,KBL,KING,KO,LV,NOCON, 75 | ! 1IN,MC,MCP 76 | ! DIMENSION Z(16), D(16), SCV(200), SK(200), CDS(200), RW(200) 77 | data zro/0.0d+0/,one/1.d+0/,two/2.d+0/,six/6.d+0/,half/5.d-1/ 78 | data thr/3.d+0/,four/4.d+0/,ten/1.d+1/,tlv/1.2d+1/ 79 | data cf1/3.865d-2/,cf2/4.561d+0/,cf3/5.46d-1/,fsi/3.17897971d+0/ 80 | data ly/' Y'/,ls/' S'/,dd/'D2Y/DX2 '/,dk/' CURV. '/ 81 | data z(1)/.052995325d-1/,z(4)/.1222977958d+0/,z(7)/.3591982246d+0/ 82 | data z(2)/.277124885d-1/,z(5)/.1910618778d+0/,z(8)/.4524937451d+0/ 83 | data z(3)/.671843988d-1/,z(6)/.2709916112d+0/ 84 | data d(1)/.135762297d-1/,d(2)/.31126762d-1/,d(3)/.475792558d-1/ 85 | data d(4)/.623144856d-1/,d(5)/.747979944d-1/,d(6)/.845782597d-1/ 86 | data d(7)/.913017075d-1/,d(8)/.947253052d-1/ 87 | do j=9,16 88 | d(j)=d(17-j) 89 | z(j)=one-z(17-j) 90 | enddo 91 | do j=1,kat 92 | sref(j)=s(j) 93 | enddo 94 | sbin=xbin 95 | scin=xcin 96 | trpi=conv/90.d+0 97 | fcc=2.05d+0+dlog(.41d+0) 98 | chair=gam*g1*ar/ro/ro/777.64885d+0 99 | if (it .eq. 0) xbl1=xbl 100 | ! 101 | 3 read (1,66,end=65) ppq,t0,twt,twat,qfun,alph,iht,ir,ld,lv 102 | ! 103 | pps=ppq 104 | rho=144.d+0*pps/zo/ar/t0 105 | id=iabs(ld) 106 | kor=ko 107 | if (iabs(in) .eq. 10) kor=1 108 | if (mcp .lt. 0) kor=king 109 | roy=one 110 | if (ie .eq. 0) hw=ah 111 | if ((id .eq. 0) .or. (ie .eq. 1)) hw=zro 112 | if (hw .eq. zro) yoh=zro 113 | if (hw .eq. zro) yoha=zro 114 | alf=dabs(alph) 115 | arc=frc 116 | if (iht .lt. 0) arc=frc**(ie+1) 117 | ipq=0 118 | iw=1 119 | if (lv .ne. 0) iw=iabs(lv) 120 | do j=1,kat 121 | s(j)=sref(j) 122 | sl(j)=s(j) 123 | rw(j)=fs(j) 124 | rco(j)=fs(j) 125 | scw=dsqrt(one+waltan(j)**2) 126 | sk(j)=sd(j)/scw**3 127 | if (kat .eq. king) goto 4 128 | if (s(j) .lt. xbl) kbl=j+2 129 | 4 drx(j)=waltan(j) 130 | enddo 131 | if (kbl .gt. kat) kbl=kat+4 132 | 5 do iv=1,iw 133 | if ((iv .gt. 1) .and. (iv .lt. iw)) goto 15 134 | if (ld .ge. 0) write (2,80) itle,pps,t0 135 | if (alph .gt. zro) goto 6 136 | alpha=zro 137 | if ((ld .ge. 0) .or. (ppq .eq. zro)) write (2,71,advance="no") 138 | goto 7 139 | 6 alpha=alph 140 | if ((ld .ge. 0) .or. (ppq .eq. zro)) write (2,70,advance="no") 141 | 7 if (ir .eq. 2) goto 13 142 | if (alf .eq. one) goto 8 143 | if ((ld .ge. 0) .or. (ppq .eq. zro)) write (2,75,advance="no") 144 | goto 9 145 | 8 if ((ld .ge. 0) .or. (ppq .eq. zro)) write (2,72,advance="no") 146 | 9 if (ir) 10,11,12 147 | 10 if ((ld .ge. 0) .or. (ppq .eq. zro)) write (2,74) 148 | goto 14 149 | 11 if ((ld .ge. 0) .or. (ppq .eq. zro)) write (2,73) 150 | goto 14 151 | 12 if ((ld .ge. 0) .or. (ppq .eq. zro)) write (2,76) 152 | goto 14 153 | 13 if ((ld .ge. 0) .or. (ppq .eq. zro)) write (2,77) 154 | 14 if (ppq .eq. zro) goto 60 155 | 15 capi=.55d+0 156 | ipp=0 157 | ij=1 158 | do j=1,kat 159 | bet=ttr(j)-one 160 | str=one/ttr(j) 161 | te=t0*str 162 | raj=wmn(j)*(g7*str)**ga 163 | if (iht .ge. 0) raj=raj**qt 164 | scw=dsqrt(one+drx(j)**2) 165 | emu=visc*te*dsqrt(te)/(te+vism) 166 | if (te .lt. vism) emu=half*visc*te/dsqrt(vism) 167 | if (vism .le. one) emu=visc*te**vism 168 | taw=te*(one+ro*bet) 169 | rhoe=rho*str**g1 170 | ve=wmn(j)*dsqrt(gam*ar*te) 171 | reo=rhoe*ve/emu/tlv 172 | if (hw .gt. zro) yoh=fs(j)/hw 173 | if (ie .eq. 0 .and. hw .gt. zro) roy=(hw/fs(j)+one)*trpi 174 | k=j 175 | if (j .eq. 1) goto 19 176 | if (j .gt. kor) k=j-kor+1 177 | if (k-3) 16,17,18 178 | 16 ds=s(j)-s(j-1) 179 | smd=half*ds 180 | goto 19 181 | 17 dt=s(j)-s(j-1) 182 | dst=ds+dt 183 | sma=dst*(two-dt/ds)/six 184 | smc=dst*(two-ds/dt)/six 185 | smb=dst-sma-smc 186 | hb=h 187 | if (iv .gt. 1) goto 19 188 | bma=two/ds/dst 189 | bmb=-two/ds/dt 190 | bmc=two/dt/dst 191 | goto 19 192 | 18 du=s(j)-s(j-1) 193 | dt=s(j-1)-s(j-2) 194 | ds=s(j-2)-s(j-3) 195 | dst=ds+dt 196 | dstu=dst+du 197 | dtu=dt+du 198 | dut=du-dt 199 | dts=ds-dt 200 | dtus=dt+two*(du-ds) 201 | dtsu=dt+two*(ds-du) 202 | dsttu=two*(dst+dtu) 203 | ha=hb 204 | hb=h 205 | qma=half*ds*(one-ds*(thr+(dtu+du)/dst)/dstu/six) 206 | qmb=half*ds*(one+ds*(two+(dst+dt)/dtu)/dt/six) 207 | qmc=-ds**3*(one+(dtu+du)/dst)/dt/du/tlv 208 | qmd=ds**3*(dst+dt)/du/dtu/dstu/tlv 209 | sma=half*ds+(dut*dtu**3/ds-ds*ds*(ds+dsttu))/dst/dstu/tlv 210 | smb=half*dst+(ds*ds*(dsttu-ds)/dt+dt*dt*dtus/ds-du**3*(dstu+dst) 211 | &/ds/dt)/dtu/tlv 212 | smc=half*dtu+(dt*dt*dtsu/du+du*du*(dsttu-du)/dt-ds**3*(dstu+dtu) 213 | &/dt/du)/dst/tlv 214 | smd=half*du+(dts*dst**3/du-du*du*(du+dsttu))/dtu/dstu/tlv 215 | 19 if (twt .ne. zro) goto 20 216 | tw=taw 217 | goto 21 218 | 20 twd=(arc*raj-one)*(twt-twat)/(arc-one) 219 | if (twd .lt. zro) twd=zro 220 | tw=twd+twat 221 | 21 wmu=visc*tw*dsqrt(tw)/(tw+vism) 222 | if (vism .le. one) wmu=visc*tw**vism 223 | dl=tw/te 224 | dm=alpha*(taw-tw)/te 225 | dn=one-dl-dm 226 | da=alf*(taw-tw) 227 | db=da+tw-te 228 | if (db) 22,23,24 229 | 22 dg=dsqrt(-db*te) 230 | dh=dsqrt(-db*tw) 231 | di=(two*(dg+te-tw)-da)/(two*dh+da) 232 | dj=dlog(di) 233 | tp=-db/dj/dj 234 | goto 25 235 | 23 tp=(dsqrt(te)+dsqrt(tw))**2/four 236 | goto 25 237 | 24 dc=dsqrt(da*da+four*tw*db) 238 | df=dasin((db+tw-te)/dc) 239 | de=dasin(da/dc) 240 | tp=db/(df+de)/(df+de) 241 | 25 if (ir) 26,27,28 242 | 26 frd=tw*emu/wmu/tp 243 | goto 29 244 | 27 frd=emu/wmu 245 | goto 29 246 | 28 frd=te*emu/wmu/dsqrt(tp*tw) 247 | 29 if (ipp .gt. 0) goto 31 248 | rthi=1.d-2*reo*fs(1) 249 | rtii=rthi 250 | rdli=ten*rthi 251 | if (ir .eq. 1) goto 32 252 | 30 rthg=dlog10(rthi) 253 | cfi=cf1/(rthg+cf2)/(rthg-cf3) 254 | 31 if (ir .ne. 2) goto 33 255 | scfi=dsqrt(cfi) 256 | tc=tw+17.2d+0*scfi*da-305.d+0*cfi*db 257 | cmu=visc*tc*dsqrt(tc)/(tc+vism) 258 | if (vism .le. one) cmu=visc*tc**vism 259 | tp=tw*cmu/wmu 260 | frd=emu/cmu 261 | goto 33 262 | 32 rdlg=dlog10(rdli) 263 | cfi=0.0444d+0/(rdlg+4.6221d+0)/(rdlg-1.4402d+0) 264 | 33 cf=cfi*te/tp 265 | cfs=cf*scw 266 | rtig=dlog10(rtii) 267 | xcf=.41d+0*dsqrt((rtig+cf2)*(rtig-cf3)/cf1) 268 | 34 c3=two+capi*(fsi+1.5d+0*capi) 269 | c2=one+capi 270 | c1=c2-c3/xcf 271 | fxcf=xcf+dlog(c1/rtii)-fcc-two*capi 272 | fpcp=(xcf-fsi-thr*capi)/xcf/c1-two 273 | capi=capi-fxcf/fpcp 274 | if (dabs(fxcf) .gt. 1.d-8) goto 34 275 | doti=xcf/c1 276 | xn=half*(doti+dsqrt(doti*(doti-six)+one)-thr) 277 | hi=one+two/xn 278 | suma=zro 279 | sumb=zro 280 | sumc=zro 281 | sumd=zro 282 | do l=1,16 283 | un=z(l)**xn 284 | tr=dl+z(l)*(dm+z(l)*dn) 285 | add=d(l)*xn*un/tr 286 | bdd=add*z(l) 287 | cdd=add*un 288 | ddd=bdd*un 289 | suma=suma+add 290 | sumb=sumb+bdd 291 | sumc=sumc+cdd 292 | sumd=sumd+ddd 293 | enddo 294 | dot=one/(suma-sumb) 295 | dsod=one-suma 296 | dsm=half-sumc 297 | thm=sumc-sumd 298 | hu=dsod*dot 299 | if (ipp .gt. 0) goto 36 300 | h=hu 301 | dotr=dot 302 | 36 fmy=(h+two-g9*bet)*dmdx(j)*str/wmn(j)+id*drx(j)/(rw(j)+hw) 303 | if (j.eq.1) th=cfs/fmy 304 | if (k.eq.2) th=(tha+smd*(dtha+cfs))/(one+smd*fmy) 305 | if (k.eq.3) th=(tha+sma*dtha+smb*dthb+smc*cfs)/(one+smc*fmy) 306 | if (k.gt.3) th=(tha+sma*dtha+smb*dthb+smc*dthc+smd*cfs)/(one+smd 307 | &*fmy) 308 | delst=h*th 309 | asec=delst+dsqrt(id*delst**2+(fs(j)*scw*roy)**2) 310 | dor=id*dotr*th/asec 311 | dsrod=dsod-dor*dsm 312 | ipp=1 313 | dotr=one/(one/dot-thm*dor) 314 | hr=dsrod*dotr 315 | if (dabs(h-hr) .lt. 5.d-7) goto 37 316 | h=hr 317 | goto 36 318 | 37 delta=dotr*th 319 | thu=delta/dot 320 | dsu=delta*dsod 321 | rdel=reo*delta 322 | rtii=rdel/doti 323 | rdlx=frd*rdel 324 | rthx=rdlx/dot 325 | if (rthx .lt. 100.d+0) goto 38 326 | if (ir .eq. 1) goto 39 327 | if (dabs(one-rthx/rthi) .lt. 1.d-6) goto 41 328 | rthi=rthx 329 | goto 30 330 | 38 write (2,88) rthx,reo,frd,th,delta,dot 331 | return 332 | 39 if (dabs(one-rdlx/rdli) .lt. 1.d-6) goto 40 333 | rdli=rdlx 334 | goto 32 335 | 40 rthg=half*(dsqrt((cf2+cf3)**2+four*cf1/cf1)-cf2+cf3) 336 | rthx=ten**rthg 337 | 41 if (j .gt. 1) goto 42 338 | dth=zro 339 | hair=rhoe*ve*cf*chair 340 | tair=hair 341 | if (twat.eq.twt .or. qfun.eq.zro) goto 46 342 | twq=(hair*taw+qfun*(twat-15.d+0))/(hair+qfun) 343 | call heat 344 | if (ipq .gt. 100) goto 65 345 | if (dabs(tw-twq).lt.1.d-2.and.dabs(qfun-qfunw).lt.1.d-5) goto 46 346 | twt=twat+(twq-twat)*(arc-one)/(arc*raj-one) 347 | qfun=qfunw 348 | goto 20 349 | 42 dth=cfs-th*fmy 350 | if (dth .lt. zro) dth=zro 351 | if (j .eq. kor) goto 46 352 | if (k-3) 43,45,44 353 | 43 dthb=dth 354 | goto 47 355 | 44 tha=tha+qma*dtha+qmb*dthb+qmc*dthc+qmd*dth 356 | dtha=dthb 357 | dthb=dthc 358 | if (k .gt. 5) goto 45 359 | scu=dsqrt(one+drx(j-2)**2) 360 | dela=ha*tha 361 | if ((ie .eq. 1).or.(id .eq. 0)) ysec=fs(j-2)*scu 362 | if ((ie .eq. 0).and.(hw .gt. zro)) ysec=scu*(fs(j-2)+hw)*trpi 363 | if (hw .gt. zro) yoha=fs(j-2)/hw 364 | asca=dela+dsqrt(id*dela**2+ysec**2) 365 | rw(j-2)=asca/scu 366 | dla(j-2)=scu*(asca-ysec)*(one+yoha) 367 | rco(j-2)=fs(j-2)+dla(j-2) 368 | 45 dthc=dth 369 | goto 47 370 | 46 tha=th 371 | dtha=dth 372 | if ((iv .gt. 1) .and. (iv .lt. iw)) goto 47 373 | if (j .eq. 1 .and. ld .ge. 0) write (2,82) 374 | 47 cds(j)=asec-scw*fs(j)*roy 375 | dla(j)=scw*cds(j)*(one+yoh) 376 | rco(j)=fs(j)+dla(j) 377 | rw(j)=asec/scw 378 | if (iv .lt. iw) goto 48 379 | bta(j)=-dmdx(j)*dsu/wmn(j)/ttr(j)/scw/cfi 380 | if (j.eq.1 .or. j.gt.ko .or. iht.eq.0) goto 48 381 | if (mod(j,iht) .ne. 1) goto 48 382 | ij=j 383 | hair=rhoe*ve*cf*chair 384 | call heat 385 | 48 if (ld.lt.0) goto 56 386 | if ((iv.gt.1).and.(iv.lt.iw)) goto 56 387 | cfik=2000.d+0*cfi 388 | cfk=2000.d+0*cf 389 | cfsk=2000.d+0*cfs 390 | dthk=1000.d+0*dth 391 | cth=two*th/(one+dsqrt(one-two*th*id/asec)) 392 | ch=cds(j)/cth 393 | ieo=int(reo+half) 394 | ithx=int(rthx+half) 395 | write (2,83) j,tw,te,taw,tp,ieo,ithx,frd,cfik,cfk,cfsk,h,hi,fmy, 396 | &dthk,th,delta,delst 397 | if (j.lt.kbl-3) goto 54 398 | if (j-kbl+2) 49,50,51 399 | 49 ctha=cth 400 | xna=xn 401 | dlta=delta 402 | reoa=reo 403 | goto 55 404 | 50 cthb=cth 405 | xnb=xn 406 | dltb=delta 407 | reob=reo 408 | goto 55 409 | 51 if (j-kbl) 52,53,54 410 | 52 cthc=cth 411 | xnc=xn 412 | dltc=delta 413 | reoc=reo 414 | goto 55 415 | 53 if (it.gt.0) goto 55 416 | dlst=gma*cds(j-3)+gmb*cds(j-2)+gmc*cds(j-1)+gmd*cds(j) 417 | thbl=gma*ctha+gmb*cthb+gmc*cthc+gmd*cth 418 | hbl=dlst/thbl 419 | dltbl=gma*dlta+gmb*dltb+gmc*dltc+gmd*delta 420 | reobl=gma*reoa+gmb*reob+gmc*reoc+gmd*reo 421 | reoft=tlv*reobl 422 | reth=thbl*reobl 423 | redl=dltbl*reobl 424 | rethg=dlog10(reth) 425 | redlg=dlog10(redl) 426 | xnbl=gma*xna+gmb*xnb+gmc*xnc+gmd*xn 427 | goto 55 428 | 54 if ((j.gt.3) .and. (mod(j,10).ne.0)) goto 56 429 | 55 write (2,86) s(j),dsu,thu,cth,hu,h,ch,xn 430 | 56 continue 431 | enddo 432 | rw(1)=rco(1) 433 | call scond(s,dla,dax,kat) 434 | do j=1,kat 435 | drx(j)=waltan(j)+dax(j) 436 | enddo 437 | if ((it.gt.0) .or. (ld.lt.0)) goto 58 438 | if ((iv.gt.1) .and. (iv.lt.iw)) goto 58 439 | if (kbl .le. kat) write(2,85) xbl1,dlst,thbl,hbl,xnbl,dltbl,reoft 440 | &,reth,rethg,redl,redlg 441 | if (kbl.le.kat) goto 58 442 | hbl=cds(kat)/cth 443 | reoft=tlv*reo 444 | reth=cth*reo 445 | redl=delta*reo 446 | rethg=dlog10(reth) 447 | redlg=dlog10(redl) 448 | if(kbl.gt.kat) write(2,85) s(kat),cds(kat),cth,hbl,xn,delta,reoft 449 | &,reth,rethg,redl,redlg 450 | 58 continue 451 | enddo 452 | dd2=bma*dla(1)+bmb*dla(2)+bmc*dla(3) 453 | dr2=sd(1)+dd2 454 | dxs=dax(1)/dr2 455 | xst=s(1)-dxs 456 | yst=rco(1)-half*dax(1)**2/dr2 457 | scw=dsqrt(one+dax(1)**2) 458 | dr2=dr2/scw**3 459 | rcv=one/dr2/yst 460 | if (it.gt.0) xbin=sbin-xst 461 | if (it.gt.0) xcin=scin-xst 462 | write (2,78) itle,xbin,xcin,sf 463 | ppq=zro 464 | write (2,67) rc,etad,amach,bmach,cmach,emach,mc,ah 465 | if (twt.ne.zro) goto 59 466 | write (2,81) pps,t0 467 | goto 5 468 | 59 write (2,79) pps,t0,twt,twat,tair 469 | goto 5 470 | 60 if (it.eq.0) goto 63 471 | do k=1,kat 472 | s(k)=sref(k)-xst 473 | scv(k)=dsqrt(one+drx(k)**2) 474 | enddo 475 | scv(1)=one 476 | sl(1)=zro 477 | im=(kat-1)/2 478 | do i=1,im 479 | j=2*i 480 | ss=s(j)-s(j-1) 481 | if (i.eq.1) ss=s(2) 482 | tt=s(j+1)-s(j) 483 | st=ss+tt 484 | s1=(two-tt/ss)*st/six 485 | s3=(two-ss/tt)*st/six 486 | s2=st-s1-s3 487 | sa=(two+tt/st)*ss/six 488 | sb=(two+st/tt)*ss/six 489 | sc=ss-sa-sb 490 | sl(j)=sl(j-1)+sa*scv(j-1)+sb*scv(j)+sc*scv(j+1) 491 | sl(j+1)=sl(j-1)+s1*scv(j-1)+s2*scv(j)+s3*scv(j+1) 492 | enddo 493 | xst=zro 494 | write (2,68) ls,dk 495 | write (2,69) (k,s(k),sl(k),dla(k),rco(k),waltan(k),sk(k),dax(k),dr 496 | &x(k),wmn(k),dmdx(k),spr(k),bta(k),k=1,kat) 497 | if (kbl.gt.kat) goto 64 498 | call twixt (sl,gma,gmb,gmc,gmd,xbl,kat,kbl) 499 | xbl1=gma*s(kbl-3)+gmb*s(kbl-2)+gmc*s(kbl-1)+gmd*s(kbl) 500 | dlab=gma*dla(kbl-3)+gmb*dla(kbl-2)+gmc*dla(kbl-1)+gmd*dla(kbl) 501 | rcob=gma*rco(kbl-3)+gmb*rco(kbl-2)+gmc*rco(kbl-1)+gmd*rco(kbl) 502 | write (2,89) xbl1,xbl,dlab,rcob,gma,gmb,gmc,gmd 503 | goto 64 504 | 63 write (2,68) ly,dd 505 | write (2,69) (k,s(k),fs(k),dla(k),rco(k),waltan(k),sd(k),dax(k),dr 506 | &x(k),wmn(k),dmdx(k),spr(k),bta(k),k=1,kat) 507 | if (kbl.gt.kat) goto 64 508 | call twixt (s,gma,gmb,gmc,gmd,xbl1,kat,kbl) 509 | dlab=gma*dla(kbl-3)+gmb*dla(kbl-2)+gmc*dla(kbl-1)+gmd*dla(kbl) 510 | rcob=gma*rco(kbl-3)+gmb*rco(kbl-2)+gmc*rco(kbl-1)+gmd*rco(kbl) 511 | ybl=rcob-dlab 512 | write (2,84) xbl1,ybl,dlab,rcob,gma,gmb,gmc,gmd 513 | 64 write (2,87) xst,yst,dd2,dr2,rcv 514 | s(1)=xst 515 | rco(1)=yst 516 | drx(1)=zro 517 | if (xbl .eq. 1.d+3) return 518 | if (lv .gt. 0) goto 3 519 | 65 continue 520 | if (j .eq. 1) write (2,90) ipq,qfunw,twt 521 | return 522 | ! 523 | 66 format (6e10.3,4i5) 524 | 67 format (1x,' RC=',f11.6,3x,'ETAD=',f8.4,' DEG',3x,'AMACH=',f10.7,3 525 | &x,'BMACH=',f10.7,3x,'CMACH=',f10.7,3x,'EMACH=',f10.7,3x,a4,'H=',f1 526 | &1.7/) 527 | 68 format (1x,7x,'STA(IN) ',a4,'(IN) DELR(IN) R(IN) DY/DX 528 | & ',a8,' DA/DX DR/DX MACH NO. DM/DX PE/PO',7x,'B 529 | &ETA'/) 530 | 69 format (10(i4,0p2f11.6,2f11.7,4f10.7,f11.7,f10.7,1p2e12.4/)) 531 | 70 format (1x,5x,'QUADRATIC TEMPERATURE DISTRIBUTION') 532 | 71 format (1x,5x,'PARABOLIC TEMPERATURE DISTRIBUTION') 533 | 72 format (1x,5x,'SPALDING-CHI REFERENCE TEMPERATURE') 534 | 73 format (1x,5x,'VAN DRIEST REFERENCE REYNOLDS NUMBER'/) 535 | 74 format (1x,5x,'COLES LAW REFERENCE REYNOLDS NUMBER'/) 536 | 75 format (1x,5x,'MODIF. SPALDING-CHI REFERENCE TEMP') 537 | 76 format ('+',83x,'REFERENCE REYNOLDS NUMBER BASED ON DELTA'/) 538 | 77 format ('+',44x,'MODIFIED COLES TRANSFORMATION'/) 539 | 78 format (1x,3a4,'NOZZLE CONTOUR, RADIAL FLOW ENDS AT STA',f12.7,', 540 | &TEST CONE BEGINS AT STA',f12.7,', SCALE FACTOR =',f13.8/) 541 | 79 format (1x,1x,'STAG. PRESSURE=',f5.0,' PSI, STAG. TEMPERATURE=',f5 542 | &.0,' DEG R, THROAT TEMP.=',f5.0,' DEG R, WALL TEMP.=',f4.0,' DEG R 543 | &, THROAT HT COEF.=',f8.5//) 544 | 80 format (1x,3a4,'BOUNDARY LAYER CALCULATIONS, STAGNATION PRESSURE=' 545 | &,f5.0,'PSI, STAGNATION TEMPERATURE=',f5.0,' DEG R, N BASED ON RE,D 546 | &ELTA'//) 547 | 81 format (1x,5x,'STAG. PRESSURE=',f5.0,' PSI STAG. TEMPERATURE=',f5. 548 | &0,' DEG R ADIABATIC WALL TEMPERATURE'//) 549 | 82 format (1x,5x,'TW TE TAW TP RE/IN RTHI',4x,'FRD',5x 550 | &,'KCF1',4x,'KCF',5x,'RCFS',5x,'H',6x,'HI',5x,'FMY KTHP THETA-1 551 | & DELTA DELTA*-1'/) 552 | 83 format (1x,i3,2f6.1,f7.1,f6.1,i9,i7,4f8.5,f8.4,f7.4,2f8.5,f9.6,f7. 553 | &4,f9.6) 554 | 84 format (1x,'STA',2f11.6,2f11.7,7x,'INTERPOLATION COEFFICIENTS,',f1 555 | &2.8,',',f11.8,',',f11.8,',',f12.8/) 556 | 85 format (1x,' X=',f7.3,', DELTA*=',f10.7,', THETA=',f9.7,', 557 | & H=',f10.6,', N=',f10.7,', DELTA=',f11.7,', RE/FT=',f11.0//3 558 | &5x,'RE,THETA=',f9.0,', LOG=',f8.5,',',16x,'RE,DELTA=',f11.0,', 559 | & LOG=',f8.5/) 560 | 86 format (1x,3x,'X=',f7.3,', DSU=',f8.5,', THU=',f9.7,', CTH=' 561 | &,f9.7,', HU=',f10.6,', H=',f10.6,', CH=',f10.6,', N=',f8.5 562 | &) 563 | 87 format (1x,'STA',f11.6,' Y*=',f11.7,', D2A/DX2=',f12.9,', 564 | & D2R/DX2=',f12.9,', VISCID RC=',f14.8/) 565 | 88 format (1x,'RTHX=',1pe12.5,', REO=',e12.5,', FRO=',0pf8.5,', TH=', 566 | &f8.5,', DELTA=',f8.5,', DOT=',f9.5) 567 | 89 format (1x,'STA',2f11.6,2f11.7,7x,'INTERPOLATION COEFFICIENTS,',f1 568 | &2.8,',',f11.8,',',f11.8,',',f12.8/) 569 | 90 format ('0',' ITERATION',i4,', QFUN =',f8.5,', THROAT TEMP = 570 | &',f6.1/) 571 | end subroutine bound 572 | -------------------------------------------------------------------------------- /sivells/AXIAL.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE AXIAL 2 | C 3 | C TO OBTAIN THE AXIAL DISTRIBUTIUN OF VELOCITY AND/OR MACH NUMBER 4 | C 5 | IMPLICIT REAL*8(A-H,O-Z) 6 | COMMON /FG/ GC,GD,GE,GF,GH,GI,HA,HB,HC,HE 7 | COMMON /GG/ GAM,GM,G1,G2,G3,G4,G5,G6,G7,G8,G9,GA,RGA,QT 8 | COMMON /CLINE/ AXIS(5,150),TAXI(5,150),WIP,X1,FRIP,ZONK,SEO,CSE 9 | COMMON /PROP/ AR,ZO,RO,VISC,VISM,SFOA,XBL,CONV 10 | COMMON /PARAM/ ETAD,RC,AMACH,BMACH,CMACH,EMACH,GMACH,FRC,SF,WWO,WW 11 | 1OP,QM,WE,CBET,XE,ETA,EPSI,BPSI,XO,YO,RRC,SDO,XB,XC,AH,PP,SE,TYE,XA 12 | COMMON /CONTR/ ITLE(3),IE,LR,IT,JB,JQ,JX,KAT,KBL,KING,KO,LV,NOCON, 13 | 1IN,MC,MCP,IP,IQ,ISE,JC,M,MP,MQ,N,NP,NF,NUT,NR,LC,MD,MF,MT,ND,NT 14 | DATA ZRO/0.0D+0/,ONE/1.D+0/,TWO/2.D+0/,SIX/6.D+0/,HALF/5.D-1/ 15 | DATA THR/3.D+0/,FOUR/4.D+0/,FIV/5.D+0/,TEN/1.D+1/,TLV/1.2D+1/ 16 | DATA SEV/7.D+0/,EIT/8.D+0/,FFTN/1.5D+1/,TRTY/3.D+1/,SXTY/6.D+1/ 17 | DATA M1/4HGMAC/,M2/4H2-D /,IAXIS/4HAXIS/,NS/4H SPE/,NC/4HCIAL/ 18 | DATA N3/4H 3RD/,N4/4H 4TH/,N5/4H 5TH/,N0/4H-DEG/ 19 | DIMENSION C(6), D(4), AX(150), AXM(150), AXMP(150) 20 | C 21 | NPI=9.D+1/CONV 22 | IF (JQ.EQ.0.AND.JX.EQ.0) CALL OREZ(AXIS,2*750) 23 | IF (JQ .GT. 0) GO TO 50 24 | IF (JX .EQ. 0) GO TO 2 25 | C 26 | C CARD USED TO OBTAIN INTERNAL STREAMLINES (JX > 0) 27 | C 28 | READ (1,93,END=91) ETAD,QM,XJ 29 | C 30 | JX=INT(XJ) 31 | IF (ETAD .EQ. SXTY) GO TO 1 32 | ETA=ETAD/CONV 33 | IF (IE .EQ. 0) SE=ETA 34 | IF (IE .EQ. 1) SE=TWO*DSIN(HALF*ETA) 35 | CSE=DCOS(ETA) 36 | APSI=BPSI-ETA/QT 37 | AMACH=FMV(APSI) 38 | RA=((G6+G5*AMACH**2)**GA/AMACH)**QT 39 | GPSI=EPSI+ETA/QT 40 | GMACH=FMV(GPSI) 41 | RG=((G6+G5*GMACH**2)**GA/GMACH)**QT 42 | MP=ONE+THR*(RA-RG) 43 | GO TO 14 44 | 1 SE=QM*SEO 45 | GO TO 14 46 | C 47 | C CONSTANTS USED IN TRANSONIC SOLUTION 48 | 2 GC=(TWO*GAM/QT-THR)/SIX/(3+IE) 49 | GE=(THR*(8+IE)-FOUR*GAM/QT)/THR/(7+IE) 50 | GH=(FFTN+(2-6*IE)*GAM)/TLV/(5+IE) 51 | GJ=(GAM*(GAM+9.25D+0*IE-26.5D+0)+.75D+0*(6-IE))/TLV/(3-IE) 52 | GK=(GAM*(GAM+2.25D+0*IE-16.5D+0)+2.25D+0*(2+IE))/SIX 53 | GR=(FFTN-(1+9*IE)*GAM)/(15+IE)/18.D+0 54 | HB=(14.D+0*GAM-75.D+0+18*IE)/(270.D+0+18*IE) 55 | IF (IE .EQ. 0) GO TO 3 56 | GD=(GM*(652.D+0*GM+1319.D+0)+1000.D+0)/6912.D+0 57 | GF=(3612.D+0+GM*(751.D+0+GM*754.D+0))/2880.D+0 58 | GI=(909.D+0+GAM*(270.D+0+GAM*412.D+0))/10368.D+0 59 | GS=(GAM*(GAM*2708.D+0+2079.D+0)+2115.D+0)/82944.D+0 60 | HC=(GAM*(2364.D+0*GAM-3915.D+0)+14337.D+0)/82944.D+0 61 | HE=(GAM*(64.D+0*GAM+117.D+0)-1026.D+0)/1152.D+0 62 | GO TO 4 63 | C 64 | C AXISYM FLOW, IE=1, QT=0.5, GAM=1.4, GC=0.10833333, GD=0.236099537, 65 | C GE=0.65833333, GF=1.40036111, GH=0.13055556, GI=0.2020177469, 66 | C GJ=0.76833333, GK=-1.87333333, GR=0.003472222, GS=0.1245814043, 67 | C HB=0.12986111, HC=0.1626331019, HE=-0.6395486111 68 | C 69 | 3 GD=(GM*(32.D+0*GM-14.D+0)+221.D+0)/1080.D+0 70 | GF=(4230.D+0+GM*(211.D+0+GM*334.D+0))/3780.D+0 71 | GI=(738.D+0+GAM*(273.D+0-GAM*82.D+0))/7560.D+0 72 | GS=(GAM*(GAM*782.D+0+3507.D+0)+7767.D+0)/272160.D+0 73 | HC=(GAM*(274.D+0*GAM-861.D+0)+4464.D+0)/17010.D+0 74 | HE=(GAM*(32.D+0*GAM+87.D+0)-561.D+0)/540.D+0 75 | C 76 | C PLANAR FLOW, IE=0, QT=1.0,GAM=1.4, GC=-0.011111, GD=0.2041851852, 77 | C GE=0.8761904762, GF=1.155513228, GH=0.29666667, GI=0.1269153439, 78 | C GJ=-0.85111111, GK=-2.7733333, GR=0.05037037037, GS=0.05221017049, 79 | C HB=-0.2051851852, HC=0.2231416814, HE=-0.6971851852 80 | C 81 | C CARD USED TO ESTABLISH INVISCID PARAMETERS 82 | C 83 | 4 READ (1,93,END=91) ETAD,RC,FMACH,BMACH,CMC,SF,PP,XC 84 | C 85 | C CARD USED TO CONTROL CALCULATIONS 86 | C 87 | READ (1,92) MT,NT,IX,IN,IQ,MD,ND,NF,MP,MQ,JB,JX,JC,IT,LR,NX 88 | C 89 | LC=INT(XC) 90 | IF (XC .GT. ONE) LC=INT(XC+ONE) 91 | NR=SIX*RC 92 | MF=FMACH 93 | IF (IE .EQ. 1) MC=M1 94 | IF (IE .EQ. 0) MC=M2 95 | NOCON=0 96 | ETA=ETAD/CONV 97 | IF (IE .EQ. 0) SE=ETA 98 | IF (IE .EQ. 1) SE=TWO*DSIN(HALF*ETA) 99 | IF (ETAD .EQ. SXTY) SE=ONE 100 | SEO=SE 101 | ISE=INT(SE) 102 | CSE=DCOS(ETA) 103 | RT=RC+ONE 104 | AM=ONE 105 | WI=ONE 106 | WIPP=ZRO 107 | MCP=CMC 108 | CMACH=DABS(CMC) 109 | CBET=DSQRT(CMACH*CMACH-ONE) 110 | FRC=((G6+G5*CMACH**2)**GA/CMACH)**QT 111 | TYE=FRC*SE 112 | IF (SF .LT. ZRO) SF=-SF/TYE 113 | IF (ISE .EQ. 0) GO TO 5 114 | C 115 | C NON-RADIAL FLOW AT INFLECTION POINT 116 | IQ=1 117 | AMACH=CMACH 118 | BMACH=CMACH 119 | EMACH=CMACH 120 | FMACH=CMACH 121 | GMACH=CMACH 122 | IF (IE .EQ. 1) AM=GMACH 123 | WE=G2*EMACH/DSQRT(EMACH**2+G9) 124 | DW=WE-WI 125 | XO=ZRO 126 | EOE=ZRO 127 | GO TO 15 128 | C 129 | C RADIAL FLOW AT INFLECTION POINT 130 | 5 IF (IN .EQ. 0) GO TO 6 131 | IF ((LC .LT. 0) .AND. (IN .LT. 0)) IN=-1 132 | IF ((LC .EQ. 0) .OR. (MCP .LT. 0)) IN=ISIGN(10,IN) 133 | 6 BBET=DSQRT(BMACH*BMACH-ONE) 134 | BPSI=G2*DATAN(G4*BBET)-DATAN(BBET) 135 | IF (FMACH) 9,8,7 136 | 7 FBET=DSQRT(FMACH*FMACH-ONE) 137 | FPSI=G2*DATAN(G4*FBET)-DATAN(FBET) 138 | GO TO 10 139 | 8 FMACH=-BPSI/ETA 140 | IF (BPSI/ETA .GT. 7.5D+0) FMACH=-7.5D+0 141 | 9 FPSI=-FMACH*ETA 142 | FMACH=FMV(FPSI) 143 | 10 EPSI=FPSI-TWO*ETA/QT 144 | EMACH=FMV(EPSI) 145 | WE=G2*EMACH/DSQRT(EMACH*EMACH+G9) 146 | DW=WE-WI 147 | CALL SORCE(WE,D) 148 | XE=D(1) 149 | WEP=D(2) 150 | WEPP=D(3) 151 | WRPPP=D(4) 152 | IF (NR .NE. 0) GO TO 15 153 | IF ((LR .NE. 0) .OR. (IQ .LT. 0)) GO TO 11 154 | IF (IX .EQ. 0) WRITE (2,106) ITLE,N3 155 | IF (IX .NE. 0) WRITE (2,106) ITLE,N4 156 | C 157 | C ITERATION TO DETERMINE RC IF NOT SPECIFIED (NR = 0) 158 | 11 EA=WRPPP 159 | EB=-FIV*WEPP-WIPP 160 | EC=TLV*WEP 161 | ED=-TLV*DW 162 | XIE=CUBIC(EA,EB,EC,ED) 163 | IF (XIE .LE. ZRO) GO TO 89 164 | 12 WIP=TWO*(WE-ONE)/XIE-WEP+(WEPP-WIPP)*XIE/SIX 165 | 13 NOCON=NOCON+1 166 | IF (NOCON .GT. 100) GO TO 90 167 | 14 RT=TORIC(WIP,SE) 168 | RC=RT-ONE 169 | 15 TK=(ONE-G7*(ONE+(GE+GF/RT)/RT)/RT**2/(15+IE)/THR)**QT 170 | YO=SE/TK 171 | AA=DSQRT(QT*(GAM+ONE)*RT) 172 | IF (QM .NE. ONE) GO TO 19 173 | WHPP=(ONE-GAM/1.5D+0+GJ/RT)/(AA*YO)**2 174 | IF ((NR .NE. 0) .OR. (ISE.EQ. 1)) GO TO 18 175 | IF (DABS(WHPP-WIPP) .LT. 1.D-10) GO TO 18 176 | WIPP=WHPP 177 | IF (IX) 11,17,16 178 | 16 EA=GK/(AA*YO)**3 179 | EB=THR*(WIPP+WEPP) 180 | EC=-TLV*WEP 181 | ED=TLV*DW 182 | XIE=CUBIC(EA,EB,EC,ED) 183 | IF (XIE .LE. ZRO) GO TO 89 184 | GO TO 12 185 | 17 H=(EIT*WIP+SEV*WEP)/(THR*WIPP-TWO*WEPP) 186 | HH=TRTY*DW/(THR*WIPP-TWO*WEPP) 187 | XIE=HH/(DSQRT(H*H+HH)+H) 188 | WIP=WEP-HALF*XIE*(WEPP+WIPP) 189 | GO TO 13 190 | C 191 | C ITERATION FOR RC COMPLETED, REMAINDER OF TRANSONIC VALUES COMPUTED 192 | 18 WIP=(ONE-(GC-GD/RT)/RT)/YO/AA 193 | WHP=WIP 194 | WIPP=WHPP 195 | AMP=G7*WIP 196 | AMPP=G7*(WHPP+THR*G8*WIP**2) 197 | 19 XOI=YO*DSQRT(G7/TWO/(9-IE)/RT)*(ONE+(GH+GI/RT)/RT) 198 | IF (QM .NE. ONE) GO TO 21 199 | IF (ISE .EQ. 1) XI=XOI 200 | XO1=XOI 201 | WO=ONE-(HALF/(3-IE)+(GR+GS/RT)/RT)/RT 202 | OM=WO/DSQRT(G7-G8*WO**2) 203 | WOPPP=GK/(AA*YO)**3 204 | IF (LR .EQ. 0) GO TO 21 205 | C 206 | C CALL FOR THROAT CHARACTERISTIC VALUES 207 | CALL TRANS (RT,TK,WO,AM,AMP,AMPP,WI,AWP,AWPP,AWPPP,XI) 208 | IF ((NX .LT. 0) .AND. (NT.LT.0)) GO TO 87 209 | IF (NX .LT. 0) GO TO 4 210 | AMP=AMP/SE 211 | AMPP=AMPP/SE**2 212 | WAP=AWP/SE 213 | WAPP=AWPP/SE**2 214 | WOPPP=AWPPP/SE**3 215 | IF (ISE .EQ. 1) GO TO 21 216 | DW=WE-WI 217 | XOI=XI*SE 218 | IF (NR .GT. 0) GO TO 20 219 | X1=XE-XIE 220 | XO=XE-XIE-XO1 221 | C2=XIE*WIP 222 | C3=HALF*WIPP*XIE**2 223 | C4=WE-ONE-C2-C3 224 | IF (IX .NE. 0) C4=FOUR*C4+TWO*C3+C2-XIE*WEP 225 | IF (IQ .LT. 0) GO TO 20 226 | WRITE (2,110) ITLE,N4,LR 227 | WRITE (2,96) XIE,C2,C3,C4,X1 228 | 20 WIP=WAP 229 | WIPP=WAPP 230 | 21 WWO=ONE+(ONE/(IE+3)-(HB-HC/RT)/RT)/RT 231 | WWOP=(ONE+(ONE-IE/EIT-HE/RT)/RT)/YO/AA 232 | RRC=ONE/RC 233 | SDO=RRC/YO 234 | ZONK=QM+1.0D-03 235 | NP=ZONK*(IABS(NF)-1)+1 236 | IF (SF .GT. ZRO) GO TO 22 237 | SF=ONE/YO 238 | 22 IF (IQ .LT. 0) GO TO 31 239 | IP=0 240 | JQ=0 241 | M=ZONK*(MT-1)+1 242 | N=NT 243 | IF (QM .EQ. ONE) GO TO 23 244 | XO=X1-XOI 245 | RETURN 246 | 23 CALL OREZ (C,6) 247 | IF (ISE .EQ. 0) GO TO 31 248 | C 249 | C LENGTH OF AXIAL DISTRIBUTION FOR NON-RADIAL FLOW 250 | X1=XOI 251 | AEM=EMACH-AM 252 | C(1)=AM 253 | IF (LC) 25,24,27 254 | 24 AMSQ=AMP**2+AEM*AMPP*FOUR/THR 255 | IF (LR .EQ. 0) WRITE (2,122) ITLE,N4,N0 256 | IF (LR .NE. 0) WRITE (2,107) ITLE,N4,N0,LR 257 | IF (AMSQ .LT. ZRO) GO TO 28 258 | XIE=FOUR*AEM/(DSQRT(AMSQ)+AMP) 259 | XE=XIE+XI 260 | C(5)=THR*AEM-AMP*XIE 261 | GO TO 26 262 | 25 XIE=THR*AEM/AMP 263 | XE=XIE+XI 264 | IF (LR .EQ. 0) WRITE (2,122) ITLE,N3,N0 265 | IF (LR .NE. 0) WRITE (2,107) ITLE,N3,N0,LR 266 | 26 C(2)=AMP*XIE 267 | C(3)=SIX*AEM-THR*C(2) 268 | C(4)=THR*C(2)-EIT*AEM 269 | GO TO 46 270 | 27 IF (LC .EQ. 1) GO TO 29 271 | XE=XC/TK 272 | XIE=FIV*AEM/(DSQRT(AMP**2+IN*AEM*AMPP/EIT)+AMP) 273 | IF (XE .GT. XI+XIE) XE=XI+XIE 274 | XIE=XE-XI 275 | C(2)=AMP*XIE 276 | C(3)=HALF*IN*AMPP*XIE**2/TEN 277 | C(4)=TEN*AEM-SIX*C(2)-THR*C(3) 278 | C(5)=-FFTN*AEM+EIT*C(2)+THR*C(3) 279 | C(6)=SIX*AEM-THR*C(2)-C(3) 280 | IF (LR .EQ. 0) WRITE (2,122) ITLE,N5,N0 281 | IF (LR .NE. 0) WRITE (2,107) ITLE,N5,N0,LR 282 | GO TO 46 283 | 28 C(2)=TWO*AEM 284 | C(4)=-C(2) 285 | C(5)=AEM 286 | XIE=TWO*AEM/AMP 287 | XE=XIE+XI 288 | GO TO 46 289 | 29 DO 30 J=1,NT 290 | K=NT+1-J 291 | READ(9) AX(K),AXM(K),AXMP(K) 292 | IF (J .EQ. 1) DX=XI-AX(K) 293 | 30 AXIS(1,K)=AX(K)+DX 294 | AXM(NT)=AM 295 | AXMP(NT)=AMP 296 | XE=AXIS(1,1) 297 | XIE=XE-XI 298 | IF (LR .EQ. 0) WRITE (2,122) ITLE,N5,N0 299 | IF (LR .NE. 0) WRITE (2,107) ITLE,N5,N0,LR 300 | GO TO 46 301 | C 302 | C LENGTH OF UPSTREAM AXIAL DISTRIBUTION FOR RADIAL FLOW 303 | 31 IF (SFOA .EQ. ZRO) GO TO 32 304 | IF (LR .EQ. 0) WRITE (2,106) ITLE,N5 305 | IF (LR .NE. 0) WRITE (2,110) ITLE,N5,LR 306 | GO TO 44 307 | 32 IF (LR .EQ. 0) GO TO 33 308 | IF ((NR .EQ. 0) .AND. (IX .EQ. 0)) GO TO 41 309 | IF ((NR .EQ. 0) .AND. (IX .NE. 0)) MF=0 310 | IF (MF .NE. 0) GO TO 40 311 | IF ((IQ .LT. 0) .OR. (NR .EQ. 0)) GO TO 35 312 | IF (IX .EQ. 0) WRITE (2,110) ITLE,N3,LR 313 | IF (IX .NE. 0) WRITE (2,110) ITLE,N4,LR 314 | GO TO 35 315 | 33 IF (MF .EQ. 0) GO TO 34 316 | IF (NR .EQ. 0) GO TO 45 317 | IF (IQ .GE. 0) WRITE (2,106) ITLE,N4 318 | GO TO 41 319 | C 320 | C ITERATION FOR EMACH IF NOT SPECIFIED (MF = 0) 321 | 34 IF (IQ .LT. 0) GO TO 35 322 | IF (IX .EQ. 0) WRITE (2,106) ITLE,N3 323 | IF (IX .NE. 0) WRITE (2,106) ITLE,N4 324 | 35 IF (NOCON .GT. 100) GO TO 90 325 | IF (IX) 41,36,37 326 | 36 XIE=SIX*DW/(DSQRT((WIP+WEP+WEP)**2-SIX*DW*WEPP)+WIP+WEP+WEP) 327 | FXW=HALF*XIE*(WEPP+WIPP)/(WEP-WIP) 328 | IF (FXW .LE. ZRO) EW=WE+.1D+0 329 | IF (FXW .LE. ZRO) GO TO 39 330 | IF (FXW .LT. ONE) EW=WI+DW*(FOUR+FXW**2)/FIV 331 | IF ((FXW .GT. ONE) .OR. (IE .EQ. 0)) EW=WI+DW*(9.D+0+FXW)/TEN 332 | GO TO 39 333 | 37 EA=WOPPP 334 | EB=FIV*WIPP+WEPP 335 | EC=TLV*WIP 336 | ED=-TLV*DW 337 | XIE=CUBIC(EA,EB,EC,ED) 338 | IF (XIE .GT. ZRO) GO TO 38 339 | EW=WE-.1D+0 340 | IF (EW .GT. WI) GO TO 39 341 | WRITE (2,113) 342 | GO TO 4 343 | 38 EW=WI+HALF*XIE*(WIP+WEP+XIE*(WIPP-WEPP)/SIX) 344 | 39 WE=EW 345 | C IF (WE .GT. G2) GO TO 79 346 | IF (WE .GT. G2) STOP 347 | IF (DABS(EW-DW-WI) .LT. 1.D-9) GO TO 43 348 | DW=WE-WI 349 | CALL SORCE(WE,D) 350 | XE=D(1) 351 | WEP=D(2) 352 | WEPP=D(3) 353 | WRPPP=D(4) 354 | NOCON=NOCON+1 355 | GO TO 35 356 | 40 IF (IQ .LT. 0) GO TO 41 357 | WRITE (2,110) ITLE,N4,LR 358 | 41 H=THR*(WEP+WIP)/(WIPP-WEPP) 359 | HH=TLV*DW/(WIPP-WEPP) 360 | XIE=HH/(DSQRT(H*H+HH)+H) 361 | IF (MF) 44,42,45 362 | 42 EW=WI+XIE*(WIP+THR*WEP-XIE*(WEPP-XIE*WRPPP/SIX))/FOUR 363 | GO TO 39 364 | 43 EMACH=WE/DSQRT(G7-G8*WE*WE) 365 | C 366 | C ITERATION FOR EMACH COMPLETED 367 | EBET=DSQRT(EMACH*EMACH-ONE) 368 | EPSI=G2*DATAN(G4*EBET)-DATAN(EBET) 369 | FPSI=EPSI+TWO*ETA/QT 370 | FMACH=FMV(FPSI) 371 | 44 IF (BMACH .GT. FMACH) GO TO 45 372 | BMACH=FMACH 373 | BPSI=FPSI 374 | MP=0 375 | 45 GPSI=FPSI-ETA/QT 376 | GMACH=FMV(GPSI) 377 | IF (IE .EQ. 1) AH=GMACH 378 | RG=((G6+G5*GMACH**2)**GA/GMACH)**QT 379 | APSI=BPSI-ETA/QT 380 | AMACH=FMV(APSI) 381 | RA=((G6+G5*AMACH**2)**GA/AMACH)**QT 382 | XA=RA*CSE 383 | IF (SFOA .GT. ZRO) XIE=SFOA/SF+XE-XA-XOI 384 | IF (SFOA .LT. ZRO) XIE=XE-SFOA/SF-RG*CSE-XOI 385 | XI=XE-XIE 386 | XO=XI-XOI 387 | X1=XO+XO1 388 | IF (IQ .LT. 0) GO TO 48 389 | XB=((G6+G5*BMACH**2)**GA/BMACH)**QT 390 | IF (LC .LT. 2) XC=((G6+G5*CMACH**2)**GA/CMACH)**QT 391 | C(1)=WI 392 | C(2)=XIE*WIP 393 | C(3)=HALF*WIPP*XIE*XIE 394 | C(4)=TEN*DW-XIE*(FOUR*WEP-HALF*XIE*WEPP)-SIX*C(2)-THR*C(3) 395 | C(5)=XIE*(SEV*WEP+EIT*WIP-XIE*(WEPP-THR*WIPP/TWO))-FFTN*DW 396 | C(6)=SIX*DW-THR*XIE*(WEP+WIP)+HALF*XIE*XIE*(WEPP-WIPP) 397 | IF (MF .EQ. 0 .AND. IX .EQ. 0) C(5)=ZRO 398 | IF (NR .EQ. 0 .AND. IX .EQ. 0 .AND. LR .EQ. 0) C(5)=ZRO 399 | IF (SFOA .EQ. ZRO) C(6)=ZRO 400 | EOE=EPSI/ETA 401 | WIPPP=SIX*C(4)/XIE/XIE/XIE 402 | WEPPP=SIX*(C(4)+FOUR*C(5)+TEN*C(6))/XIE/XIE/XIE 403 | 46 WRITE (2,99) M,N,EOE,BMACH,CMACH,GAM,ETAD,RC,SF 404 | WRITE (2,102) SE,TK,WWO,WWOP,EMACH,FMACH,MC,AH 405 | IF (LR .NE. 0) WRITE (2,123) WI,WAP,WAPP,AM,AMP,AMPP 406 | IF (ISE.EQ.1 .AND. LR.EQ.0) WRITE (2,123) WI,WIP,WHPP,AM,AMP,AMPP 407 | IF (ISE .EQ. 1) GO TO 47 408 | WRITE (2,101) WI,WIP,WIPP,WIPPP,WOPPP 409 | WRITE (2,98) WE,WEP,WEPP,WEPPP,WRPPP 410 | 47 WRITE (2,94) C(1),C(2),C(3),C(4),C(5),C(6) 411 | WRITE (2,95) XOI,XI,XO,YO,XIE,XE,NOCON 412 | IF (ISE .EQ. 1) XC=XE 413 | IF (ISE .EQ. 1) XA=XE+TYE*CBET 414 | 48 NOCON=0 415 | WIP=WHP 416 | IF (QM .NE. ONE) GO TO 49 417 | IF (PP .LT. ZRO) FRIP=ZRO 418 | IF (PP .EQ. ZRO) FRIP=-XO*SF 419 | IF (PP .GT. ZRO) FRIP=PP-SF*XA 420 | IF (IQ .LT. 0) GO TO 50 421 | XOIN=SF*XO+FRIP 422 | X1IN=SF*X1+FRIP 423 | XIIN=SF*XI+FRIP 424 | WRITE (2,125) OM,XOIN,X1IN,AM,XIIN 425 | IF (IQ .GT. 0) GO TO 67 426 | 49 IF (N) 87,50,68 427 | 50 M=ZONK*(MD-1)+1 428 | JQ=1 429 | N=ND 430 | IP=IN 431 | IF (QM .NE. ONE) RETURN 432 | CALL OREZ(C,6) 433 | IF (IQ .LT. 0) GO TO 51 434 | IF (MQ .GE. 0 .AND. N .GT. 0) GO TO 51 435 | WRITE (2,104) 436 | GO TO 52 437 | 51 WRITE (2,105) 438 | 52 IF (IP) 53,67,58 439 | C 440 | C LENGTH OF DOWNSTREAM VELOCITY DISTRIBUTION, RADIAL FLOW 441 | 53 WC=G2*CMACH/DSQRT(CMACH*CMACH+G9) 442 | WB=G2*BMACH/DSQRT(BMACH*BMACH+G9) 443 | WCB=WC-WB 444 | CALL SORCE(WB,D) 445 | XB=D(1) 446 | WBP=D(2) 447 | WSPP=D(3) 448 | WSPPP=D(4) 449 | C(1)=WB 450 | WCP=ZRO 451 | IF (LC) 54,55,56 452 | 54 XBC=THR*WCB/WBP 453 | WBPP=-TWO*WBP/XBC 454 | WRITE (2,109) ITLE,N3 455 | GO TO 57 456 | 55 WBPP=WSPP 457 | IF (MCP .LT. 0) WRITE (2,109) ITLE,N3 458 | IF (MCP .LT. 0) XBCN=THR*WCB/WBP 459 | IF (MCP .LT. 0) XBCM=-TWO*WBP/WBPP 460 | IF (MCP .GT. 0) WRITE (2,109) ITLE,N4 461 | IF (MCP .GT. 0) XBCN=FOUR*WCB/WBP 462 | IF (MCP .GT. 0) XBCM=-THR*WBP/WBPP 463 | ABCM=ONE-XBCN/XBCM 464 | IF (ABCM .LT. ZRO) GO TO 88 465 | XBC=XBCN/(DSQRT(ABCM)+ONE) 466 | GO TO 57 467 | 56 WBPP=-WSPP*IP/TEN 468 | IF (MCP.GT.0) XBCMN=CUBIC(WSPPP/THR,THR*WBPP,TLV*WBP,-TWO*TEN*WCB) 469 | IF (MCP.LT.0) XBCMN=CUBIC(WSPPP/SIX,WBPP,THR*WBP,-FOUR*WCB) 470 | XBCMX=FIV*WCB/(DSQRT(WBP**2-IP*WCB*WSPP/EIT)+WBP) 471 | IF (XC .GT. XB+XBCMX) XC=XB+XBCMX 472 | IF (XC .LT. XB+XBCMN) XC=XB+XBCMN 473 | XBC=XC-XB 474 | IF (MCP .LT. 0) WRITE (2,109) ITLE,N4 475 | IF (MCP .GT. 0) WRITE (2,109) ITLE,N5 476 | 57 C(2)=XBC*WBP 477 | C(3)=HALF*XBC*XBC*WBPP 478 | IF (MCP .LT. 0) C(4)=FOUR*WCB-THR*C(2)-TWO*C(3) 479 | IF (MCP .LT. 0) C(5)=-THR*WCB+TWO*C(2)+C(3) 480 | IF (MCP .GT. 0) C(4)=TEN*WCB-SIX*C(2)-THR*C(3) 481 | IF (MCP .GT. 0) C(5)=-FFTN*WCB+EIT*C(2)+THR*C(3) 482 | IF (MCP .GT. 0) C(6)=SIX*WCB-THR*C(2)-C(3) 483 | IF (LC .LT. 0) C(5)=ZRO 484 | IF (LC .LE. 0) C(6)=ZRO 485 | XC=XB+XBC 486 | GO TO 63 487 | C 488 | C LENGTH OF DOWNSTREAM MACH NO. DISTRIBUTION, RADIAL FLOW 489 | 58 CALL CONIC(BMACH,D) 490 | XB=D(1) 491 | BMP=D(2) 492 | SMPP=D(3) 493 | SMPPP=D(4) 494 | CBM=CMACH-BMACH 495 | C(1)=BMACH 496 | BMPP=SMPP*IP/TEN 497 | IF (LC .NE. 0) GO TO 59 498 | IF (MCP .LT. 0) WRITE (2,108) ITLE,N3 499 | IF (MCP .LT. 0) XBCN=THR*CBM/BMP 500 | IF (MCP .LT. 0) XBCM=-TWO*BMP/BMPP 501 | IF (MCP .GT. 0) WRITE (2,108) ITLE,N4 502 | IF (MCP .GT. 0) XBCN=FOUR*CBM/BMP 503 | IF (MCP .GT. 0) XBCM=-THR*BMP/BMPP 504 | ABCM=ONE-XBCN/XBCM 505 | IF (ABCM .LT. ZRO) GO TO 88 506 | XBC=XBCN/(DSQRT(ABCM)+ONE) 507 | XC=XB+XBC 508 | GO TO 62 509 | 59 IF (LC .NE. 1) GO TO 61 510 | DO 60 K=1,ND 511 | READ (9) AX(K),AXM(K),AXMP(K) 512 | IF (K .EQ. 1) DX=XB-AX(1) 513 | 60 AXIS(1,K)=AX(K)+DX 514 | IF (AXMP(2) .EQ. ZRO) CALL SCOND(AX,AXM,AXMP,ND) 515 | AXM(1)=BMACH 516 | AXMP(1)=BMP 517 | XC=AXIS(1,ND) 518 | XBC=XC-XB 519 | WRITE (2,111) ITLE 520 | GO TO 63 521 | 61 IF (MCP.GT.0) XBCMN=CUBIC(SMPPP/THR,THR*BMPP,TLV*BMP,-TWO*TEN*CBM) 522 | IF (MCP.LT.0) XBCMN=CUBIC(SMPPP/SIX,BMPP,THR*BMP,-FOUR*CBM) 523 | XBCMX=FIV*CBM/(DSQRT(BMP**2+IP*CBM*SMPP/EIT)+BMP) 524 | IF (XC .GT. XB+XBCMX) XC=XB+XBCMX 525 | IF (XC .LT. XB+XBCMN) XC=XB+XBCMN 526 | XBC=XC-XB 527 | IF (MCP .LT. 0) WRITE (2,108) ITLE,N4 528 | IF (MCP .GT. 0) WRITE (2,108) ITLE,N5 529 | 62 C(2)=XBC*BMP 530 | C(3)=HALF*XBC*XBC*BMPP 531 | IF (MCP .LT. 0) C(4)=FOUR*CBM-THR*C(2)-TWO*C(3) 532 | IF (MCP .LT. 0) C(5)=-THR*CBM+TWO*C(2)+C(3) 533 | IF (MCP .GT. 0) C(4)=TEN*CBM-SIX*C(2)-THR*C(3) 534 | IF (MCP .GT. 0) C(5)=-FFTN*CBM+EIT*C(2)+THR*C(3) 535 | IF (MCP .GT. 0) C(6)=SIX*CBM-THR*C(2)-C(3) 536 | IF (LC .LE. 0) C(6)=ZRO 537 | 63 CPP=ZRO 538 | CMP=ZRO 539 | IF (MCP .LT. 0) CPP=(TWO*C(3)+SIX*C(4)+TLV*C(5))/XBC**2 540 | BPPP=SIX*C(4)/XBC/XBC/XBC 541 | CPPP=SIX*(C(4)+FOUR*C(5)+TEN*C(6))/XBC/XBC/XBC 542 | XD=XC+TYE*CBET 543 | WRITE (2,100) M,N,NP,GAM,ETAD,RC,SF 544 | IF (IP) 64,67,65 545 | 64 WRITE (2,116) WB,WBP,WBPP,BPPP,WSPP,WC,WCP,CPP,CPPP,WSPPP 546 | GO TO 66 547 | 65 WRITE (2,117) BMACH,BMP,BMPP,BPPP,SMPP,CMACH,CMP,CPP,CPPP,SMPPP 548 | 66 WRITE (2,94) C(1),C(2),C(3),C(4),C(5),C(6) 549 | WRITE (2,118) AMACH,XA,XB,XBC,XC,XD 550 | XAIN=SF*XA+FRIP 551 | YAIN=SF*XA*DTAN(ETA) 552 | XBIN=SF*XB+FRIP 553 | XCIN=SF*XC+FRIP 554 | XDIN=SF*XD+FRIP 555 | TYIN=SF*TYE 556 | WRITE (2,120) XAIN,YAIN,XBIN,XCIN,XDIN,TYIN 557 | 67 IF (N) 87,4,68 558 | 68 IF (MQ .LT. 0) GO TO 69 559 | C 560 | C CALCULATE AXIAL DISTRIBUTION 561 | WRITE (2,103) IAXIS 562 | 69 FN=N-1 563 | L=(N+40)/41 564 | IF (IP .NE. 0) XIE=XBC 565 | IF (IP .NE. 0) XI=XB 566 | Q=ZRO 567 | DO 84 K=1,N 568 | IF (ISE .EQ. 1 .AND. LC .EQ. 1) GO TO 72 569 | IF (IP .NE. 0) GO TO 70 570 | IF (NX .EQ. 0) Q=((N-K)/FN)**2 571 | IF (NX .NE. 0) Q=((N-K)/FN)**(NX*1.D-1) 572 | GO TO 71 573 | 70 IF (LC .EQ. 1) GO TO 72 574 | Q=(K-1)/FN 575 | 71 AXIS(1,K)=XIE*Q+XI 576 | 72 RMACH=ONE 577 | IF (ISE .EQ. 1) GO TO 75 578 | IF (AXIS(1,K) .LT. ONE+1.D-9) GO TO 74 579 | AB=AXIS(1,K)**(RGA/QT) 580 | IF (AB .LT. TWO) SM=((ONE+DSQRT(AB*GM-GM))**GA)**2 581 | IF (AB .GE. TWO) SM=(AB/G5)**G7 582 | 73 CM=SM**G5 583 | FQ=SM*(G6+G5*SM-CM*AB)/(SM-ONE)/G5/G6 584 | SM=SM-FQ 585 | IF (DABS(FQ) .GT. 1.D-9) GO TO 73 586 | RMACH=DSQRT(SM) 587 | 74 IF (IP .LT. 1) GO TO 78 588 | 75 IF (LC .EQ. 1) GO TO 76 589 | XM=C(1)+Q*(C(2)+Q*(C(3)+Q*(C(4)+Q*(C(5)+Q*C(6))))) 590 | IF (ISE .EQ. 1 .OR. K .EQ. 1) GO TO 77 591 | IF (RMACH .LT. XM) WRITE (2,124) K,RMACH,XM 592 | GO TO 77 593 | 76 XM=AXM(K) 594 | 77 XMP=(C(2)+Q*(TWO*C(3)+Q*(THR*C(4)+Q*(FOUR*C(5)+Q*FIV*C(6)))))/XIE 595 | IF (LC .EQ. 1) XMP=AXMP(K) 596 | XMPP=TWO*(C(3)+Q*(THR*C(4)+Q*(SIX*C(5)+Q*TEN*C(6))))/XIE/XIE 597 | XMPPP=SIX*(C(4)+Q*(FOUR*C(5)+TEN*Q*C(6)))/XIE/XIE/XIE 598 | GMM=XM*XM+G9 599 | GQ=DSQRT(GMM) 600 | W=G2*XM/GQ 601 | WM=G9*G2/GQ/GMM 602 | WP=WM*XMP 603 | WPP=WM*(XMPP-THR*XM*XMP*XMP/GMM) 604 | GMP=FIV*XM*XM*XMP*XMP/GMM-THR*XM*XMPP-XMP*XMP 605 | WPPP=WM*(XMPPP+THR*XMP*GMP/GMM) 606 | IF (MQ .LT. 0) GO TO 83 607 | IF (MOD(K-1,L) .NE. 0) GO TO 83 608 | GO TO 82 609 | 78 W=C(1)+Q*(C(2)+Q*(C(3)+Q*(C(4)+Q*(C(5)+Q*C(6))))) 610 | WP=(C(2)+Q*(TWO*C(3)+Q*(THR*C(4)+Q*(FOUR*C(5)+Q*FIV*C(6)))))/XIE 611 | WPP=TWO*(C(3)+Q*(THR*C(4)+Q*(SIX*C(5)+Q*TEN*C(6))))/XIE/XIE 612 | WPPP=SIX*(C(4)+Q*(FOUR*C(5)+TEN*Q*C(6)))/XIE/XIE/XIE 613 | GWW=G7-W*W*G8 614 | IF (GWW .GT. ZRO) GO TO 80 615 | 79 WRITE (2,119) 616 | GO TO 4 617 | 80 GW=DSQRT(GWW) 618 | XM=W/GW 619 | IF (K .EQ. 1 .OR. K .EQ. N) GO TO 81 620 | IF (IP .EQ. 0 .AND. RMACH .GT. XM) WRITE (2,124) K,RMACH,XM 621 | IF (IP .NE. 0 .AND. RMACH .LT. XM) WRITE (2,124) K,RMACH,XM 622 | 81 XMW=G7/GW/GWW 623 | XMP=XMW*WP 624 | XMPP=XMW*(WPP+THR*G8*W*WP*WP/GWW) 625 | GWP=FIV*W*W*WP*WP*G8/GWW+THR*W*WPP+WP*WP 626 | XMPPP=XMW*(WPPP+THR*WP*G8*GWP/GWW) 627 | IF (MQ .LT. 0) GO TO 83 628 | IF (MOD(K-1,L) .NE. 0) GO TO 83 629 | 82 XINCH=SF*AXIS(1,K)+FRIP 630 | WRITE (2,97) K,AXIS(1,K),XINCH,XM,XMP,XMPP,XMPPP,W,WP,WPP,WPPP 631 | IF (MOD(K+L-1,10*L) .EQ. 0) WRITE (2,115) 632 | 83 AXIS(3,K)=XM 633 | AXIS(2,K)=ZRO 634 | AXIS(5,K)=IE*HALF*(XM-ONE/XM)*WP/W 635 | XBET=DSQRT(XM**2-ONE) 636 | 84 AXIS(4,K)=G2*DATAN(G4*XBET)-DATAN(XBET) 637 | IF (IQ .EQ. 0 .AND. IP .EQ. 0 .AND. M .LE. 0) GO TO 50 638 | IF (M) 87,4,85 639 | 85 IF (IP .NE. 0) RETURN 640 | DO 86 K=1,N 641 | DO 86 J=1,5 642 | 86 TAXI(J,K)=AXIS(J,K) 643 | RETURN 644 | 87 LV=-1 645 | RETURN 646 | 88 WRITE (2,114) 647 | GO TO 4 648 | 89 WRITE (2,112) 649 | GO TO 4 650 | 90 WRITE (2,121) NOCON 651 | GO TO 4 652 | 91 STOP 653 | C 654 | 92 FORMAT (16I5) 655 | 93 FORMAT (8F10.3) 656 | 94 FORMAT (1H0,9X,3HC1=F11.7,3X,3HC2=F12.8,3X,3HC3=1PE15.7,3X,3HC4=, 657 | 1E15.7,3X,3HC5=,E15.7,3X,3HC6=,E15.7) 658 | 95 FORMAT (1H0,9X,4HXOI=F12.8,3X,3HXI=F12.8,3X,3HXO=F12.8,3X,3HYO=F12 659 | 1.8,3X,4HXIE=F12.8,3X,3HXE=F12.8,I5,11H ITERATIONS/) 660 | 96 FORMAT (1H ,4X,26HCURVE FROM MACH 1, XIE=F12.8,6H C2=F12.8,6H 661 | 1 C3=1PE15.7,6H C4=E15.7,6H X1=0PF12.8 /) 662 | 97 FORMAT (1H ,I3,2F10.5,F10.6,1P3E14.6,0PF10.6,1P3E14.6 ) 663 | 98 FORMAT (1H0,9X,3HWE=F12.8,4X,4HWEP=F12.8,4X,5HWEPP=,1PE15.7,4X,6HW 664 | 1EPPP=,E15.7,4X,6HWRPPP=,E15.7) 665 | 99 FORMAT (1H ,4X,31HNO. OF POINTS ON 1ST CHAR. (M)=I3,5X,26HNO. OF P 666 | 1OINTS ON AXIS (N)=I3,5X,9HEPSI/ETA=F8.5,4X,6HBMACH=F9.5,4X,6HCMACH 667 | 2=F9.5//5X,6HGAMMA=F7.4,5X,22HINFLECTION ANG. (ETA)=F8.4,2X,7HDEGRE 668 | 3ES,5X,19HRAD. OF CURV. (RC)=F11.6,5X,18HSCALE FACTOR (SF)=F13.8) 669 | 100 FORMAT (1H ,4X,31HNO. OF POINTS ON 1ST CHAR. (M)=I3,5X,26HNO. OF P 670 | 1OINTS ON AXIS (N)=I3,5X,33HNO. OF POINTS ON LAST CHAR. (NP)=I3//5X 671 | 2,6HGAMMA=F7.4,5X,22HINFLECTION ANG. (ETA)=F8.4,2X,7HDEGREES,5X,19H 672 | 3RAD. OF CURV. (RC)=F13.8,5X,18HSCALE FACTOR (SF)=F11.6) 673 | 101 FORMAT (1H0,9X,3HWI=F12.8,4X,4HWIP=F12.8,4X,5HWIPP=,1PE15.7,4X,6HW 674 | 1IPPP=,E15.7,4X,6HWOPPP=,E15.7) 675 | 102 FORMAT (1H0,4X,3HY*=F10.8,4X,6HRMASS=F10.8,4X,4HWWO=F10.7,4X,5HWWO 676 | 1P=,F11.8,4X,6HEMACH=,F8.5,4X,6HFMACH=F10.7,4X,A4,2HH=F9.5) 677 | 103 FORMAT (1H ,1X,A4/6H POINT,4X,1HX,7X,5HX(IN),3X,8HMACH NO.,4X,5HDM 678 | 1/DX,8X,7HD2M/DX2,7X,7HD3M/DX3,7X,6HW=Q/A*,5X,5HDW/DX,8X,7HD2W/DX2, 679 | 27X,7HD3W/DX3/) 680 | 104 FORMAT (1H0,//) 681 | 105 FORMAT (1H1) 682 | 106 FORMAT (1H1,3A4,16H THROAT CONTOUR,,A4,49H-DEG AXIAL VELOCITY DIST 683 | 1RIBUTION FROM SONIC POINT/) 684 | 107 FORMAT (1H1,3A4,18H INVISCID CONTOUR,,A4,A4,68H AXIAL MACH NUMBER 685 | 1DISTRIBUTION FROM THROAT CHARACTERISTIC WHICH HAS,I4,7H POINTS /) 686 | 108 FORMAT (1H ,3A4,20H DOWNSTREAM CONTOUR,,A4,35H-DEG AXIAL MACH NUMB 687 | 1ER DISTRIBUTION/) 688 | 109 FORMAT (1H ,3A4,20H DOWNSTREAM CONTOUR,,A4,32H-DEG AXIAL VELOCITY 689 | 1DISTRIBUTION/) 690 | 110 FORMAT (1H1,3A4,16H THROAT CONTOUR,,A4,69H-DEG AXIAL VELOCITY DIST 691 | 1RIBUTION FROM THROAT CHARACTERISTIC WHICH HAS,I4,7H POINTS /) 692 | 111 FORMAT (1H ,3A4,19H DOWNSTREAM CONTOUR/) 693 | 112 FORMAT (1H0,38HSOLUTION TO CUBIC EQUATION IS NEGATIVE) 694 | 113 FORMAT (1H0,35HRC IS TOO LARGE TO ALLOW A SOLUTION) 695 | 114 FORMAT (1H0,38HBMACH IS TOO SMALL TO ALLOW A SOLUTION) 696 | 115 FORMAT (1H ) 697 | 116 FORMAT (1H0,9X,3HWB=F12.8,4X,4HWBP=F12.8,4X,5HWBPP=,1PE15.7,4X,6HW 698 | 1BPPP=,E15.7,5X,5HWSPP=,E15.7//10X,3HWC=0PF12.8,4X,4HWCP=F12.8,4X, 699 | 25HWCPP=,1PE15.7,4X,6HWCPPP=,E15.7,4X,6HWSPPP=,E15.7 ) 700 | 117 FORMAT (1H0,9X,6HBMACH=F9.5,4X,4HBMP=F12.8,4X,5HBMPP=,1PE15.7,4X, 701 | 16HBMPPP=,E15.7,5X,5HSMPP=,E15.7//10X,6HCMACH=0PF9.5,4X,4HCMP=,F12. 702 | 28,4X,5HCMPP=,1PE15.7,4X,6HCMPPP=,E15.7,4X,6HSMPPP=,E15.7) 703 | 118 FORMAT (1H0,9X,6HAMACH=F11.7,4X,3HXA=,F11.7,4X,3HXB=,F11.7,4X, 704 | 14HXBC=,F11.7,4X,3HXC=,F12.7,4X,3HXD=,F12.7/) 705 | 119 FORMAT (1H0,47HVELOCITY GREATER THAN THEORETICAL MAXIMUM VALUE) 706 | 120 FORMAT (1H ,9X,7HXA(IN)=,F11.7,9H, YA(IN)=,F11.7,9H, XB(IN)=,F12.7 707 | 1,9H, XC(IN)=,F12.7,9H, XD(IN)=,F12.7,9H, YD(IN)=,F11.7 /) 708 | 121 FORMAT (1H1,'NO CONVERGENCE IN',I4, 'ITERATIONS' ) 709 | 122 FORMAT (1H1,3A4,18H INVISCID CONTOUR,,A4,A4,48H AXIAL MACH NUMBER 710 | 1DISTRIBUTION FROM SONIC POINT /) 711 | 123 FORMAT (1H0,9X,3HWI=F12.8,4X,4HWIP=F12.8,4X,5HWIPP=1PE15.7,4X,3HMI 712 | 1=0PF12.8,4X,4HMIP=F12.8,4X,5HMIPP=1PE15.7 ) 713 | 124 FORMAT (1H ,I3,8H RMACH=,2F12.8 ) 714 | 125 FORMAT (1H ,9X,4HMACH,F11.8,3H AT,F11.7,17H IN., MACH 1 AT,F11.7 715 | 1,12H IN., MACH,F11.8,3H AT,F11.7,4H IN. /) 716 | END 717 | --------------------------------------------------------------------------------