⟦5e8c965a2⟧

TextFile

      SUBROUTINE S00089(I,AL ,DAL,DTF,XX)
      IMPLICITDOUBLEPRECISION(A-H,O-Z)
      COMMON/AAA44/SC(21),SCAPA(22),SHTC(22),VC(22),XL(22)
     1,VFIX,ZCOT(21),I6FT,J6FT,I8FT,J8FT,NC,NC1,NC2,IBCH,IHCH
      COMMON/AAA66/TS,HFS,HGS,HFGS,DHFPS,DHGPS,VVFS,VVGS,DVVFPS,DVVGPS
     1             ,DHFGS,VV1,VV2,DVV1P,DVV2P,T1,T2
      COMMON/AAA77/QINIT,TPUI(20),QPUI(20),RPUI,PLMOY,
     1    XHTC(22,12),PL(22,12),QREPA(22,12),
     2              XMCGA(22,12),XMCUO(22,12),QCED(22,12),QCON(22,12)
     3            ,QUGA(22,12),QFOU(22,12),QCEI(2),QCONI(2),QUGII(2)
     4            ,TMI(2),DTMI(2),QTOTAL,QTUG,QTGF,TERC(2)
     4             ,TGAI(22,12),TGAII(22,12),T876(22,12),TUMAX(22,12)
     5            ,TUMIN(22,12),DTGAI(22,12),DT876(22,12)
     6            ,TERCO(22,12),TMU(2),DTMU(2),NPUI,NASL(22),NSL(22)
      COMMON/AAA99/HLCF,HVCFO,HVAP,HCON,HVIN,HLIN,R876,RGAI
     1             ,XM876,XMGAI,XL876,XLGAI,CP876,CPGAI,XMC876,XMCGAI
     2            ,DIAHY,HGAPP(22),HCG(22),HTC(22,12),HVCFF(22)
      COMMON/AAA22/DH(22,2),DM(22,2),DPDT,DUU(22,2),DV(22,2),DNU(22,2)
      COMMON/AAA10/V(22,2),VV(22,2),H(22,2),HF(22,2),HG(22,2),
     1   DNUHP(22,2),U(22,2),XM(22,2),XT(22,2),ALFA(22,2),
     2             T(22,2),DVVH(22,2),DELH(22,2),DVVP(22,2),DELP(22,2)
     3            ,AA(22,2),BB(22,2),DTDH(22,2),DTDP(22,2),DTSAT,
     4   DNUPP(22,2),A(22),B(22),C(22),TVID(22,12),M(22,2),IST(22,2)
      COMMON/AAA13/TEM,P,DT,HNIV(22),VITESS
     1            ,ZNIV,RI(2),ISS,NITERA,NIV,ISLNI,IBTR,IHTR,ITYP(22)
      COMMON/AAA55/KPRESS,KDEB,KCON,KTGAI,KT876,ICAT(3),KIMP,KGLISS
      COMMON/AAA88/FLUP(22,2),FLUV(22,2),FLUL(22,2),FLUIV(22,2),
     2DEBIL(22,2),FLUIL(22,2),DEBI(22),DEBHI(22),DEBIV(22,2)
      COMMON/AAA17/DDPDT,DDH(22,2),DDV(22,2),DDM(22,2),DDU(22,2)
      COMMON/AAA20/DQP(22,2),DFLUL(22),DFLUV(22),DFLUIL(22),DFLUIV(22)
     1            ,DDEBIL(22),DDEBIV(22),DQCEI(2),DQCED(22,12),
     2             DDTUO(22,12),DDTGA(22,12),DDTMI(2),DDTMU(2)
      DOUBLEPRECISION DAL(12),DTF(22,2),XX(8),AL(12),DQ(2),XTSS(2)
      DOUBLEPRECISION M,DXTSS(2),TFF(2),DTFF(2)
      IF(ITYP(I).EQ.3)GOTO 3000
      HVCF=HVCFF(I)
      N1=NASL(I)
      TFL=T(I,1)
      DTFL=DTF(I,1)
      DQPA=0.D+00
      IF(ICAT(2).LE.2)GOTO 1000
      IND=1+(NC1+I-NIV)/NC1
      DO 900 J=1,N1
      TGA=TGAI(I,J)
      DTGA=DTGAI(I,J)
      HCOE=HTC(I,J)
      XTS=1.D+00
      DXTS=0.D+00
      IF(TFL.GE.TS)GOTO 840
      ECT=TS-TFL
      X=1./(2.4+ECT*ECT)
      XTS=.025+2.34*X
      DXTS=4.68*ECT*X*X*(DTFL-DTSAT)
  840 CONTINUE
      XSI=1.D+00
      DXSI=0.D+00
      IF(TFL.LE.TGA)GOTO 850
      ECT=TFL-TGA+2.D+00
      XSI=.1+1.8/ECT
      DXSI=-1.8*(DTFL-DTGA)/(ECT*ECT)
  850 CONTINUE
      H1=HLCF*(2-IND)+HVCF*(IND-1)
      DHVCF=0.D+00
      DH1=DHVCF*(IND-1)
      HR=HCOE-H1*XTS*XSI
      DHR=S22202(AL(J),DAL(J),TGA,DTGA,TFL,DTFL,X1,X2,X3,3)
      DHCOE=H1*(XSI*DXTS+DXSI*XTS)+DH1*XSI*XTS+DHR
      DQPA=DQPA+XHTC(I,J)*(HCOE*(DTGA-DTFL)+DHCOE*(TGA-TFL))
  900 CONTINUE
      XX(1)=DQPA
      RETURN
 1000 CONTINUE
      TVAP=T(I,1)
      DTVAP=DTF(I,1)
      IF(ITYP(I).EQ.1)GOTO 1010
      TVAP=T(I,2)
      DTVAP=DTF(I,2)
      TFL=TS
      DTFL=DTSAT
      DFLUV1=0.D+00
      DFLUV2=0.D+00
      DFLUL1=0.D+00
      DFLUL2=0.D+00
      DFLVME=0.D+00
      DFLVMS=0.D+00
 1010 CONTINUE
       CALL S00061(I,HV,HVT,HVME,HVMS,YNU,RE,TVAP,DTVAP,1)
      DO 2000 J=1,N1
      IF(ITYP(I).EQ.1)GOTO  1011
      HVCF=HVCFO
      DHVCF=0.D+00
 1011 CONTINUE
      TGA=TGAI(I,J)
      DTGA=DTGAI(I,J)
      ALFF=AL(J)
      DALF=DAL(J)
      XSI=1.D+00
      DXSI=0.D+00
      IF(TFL.LE.TGA)GOTO 1050
      ECT=TFL-TGA+2.D+00
      XSI=.1+1.8/ECT
      DXSI=-1.8*(DTFL-DTGA)/(ECT*ECT)
 1050 XTS=1.D+00
      DXTS=0.D+00
      IF(TFL.GE.TS)GOTO 1100
      ECT=TS-TFL
      ECTC=ECT*ECT+2.4
      XTS=.025+2.34/ECTC
      DXTS=(4.68*ECT/(ECTC*ECTC))*(DTFL-DTSAT)
 1100 CONTINUE
      HMIL=100./3600.D+00
      ZZ1=ZCOT(IBCH-1)
      ZZ2=ZCOT(IHCH)
      ZZ=ZCOT(I-1)+(XL(I)*(J-.5))/N1
      YY=((ZZ-ZZ1)/(ZZ2-ZZ1))-.5
      TBORD=700.D+00
      TMIL=900.D+00
      ACO=(TMIL-TBORD)*4.D+00
      TMOY=TMIL-ACO*YY*YY
      TMIN=TMOY-100.D+00
      TMAX=TMOY+100.D+00
      ECT=TMAX-TMIN
      Z1=(TMAX-TGA)/ECT
      DZ1=-DTGA/ECT
      Z2=(TGA-TMIN)/ECT
      DZ2=DTGA/ECT
      IF(TGA.LE.TMAX)GOTO 1210
      Z1=0.D+00
      Z2=1.D+00
      DZ1=0.D+00
      DZ2=0.D+00
      GOTO 1300
 1210 IF(TGA.GE.TMIN)GOTO 1300
      Z1=1.D+00
      Z2=0.D+00
      DZ1=0.D+00
      DZ2=0.D+00
 1300 CONTINUE
      IF(ALFF.GT.1.D-4)GOTO 1310
      Y1=HLCF
      DY1=0.D+00
      GOTO 1400
 1310 CONTINUE
      PT1=-.1
      PT2=2.*(HVCF-HMIL)/HVCF
      QT1=1.D+00
      QT2=1.-PT2
      AL1=.625
      AL2=.95
      IF(ALFF.GT.AL1)GOTO 1320
      Y1=(PT1*ALFF+QT1)*HLCF
      DY1=PT1*HLCF*DAL(J)
      GOTO 1400
 1320 IF(ALFF.GT.AL2)GOTO 1330
      XLA=AL2-AL1
      X1=PT1*AL1+QT1
      X2=PT2*AL2+QT2
      H1=X1*HLCF
      H2=X2*HVCF
      U1=-PT1/X1
      U2=-PT2/X2
      TC1=2.-U1*XLA
      TC2=2.+U2*XLA
      XLA3=XLA*XLA*XLA
      TE1=ALFF-AL1
      TE2=AL2-ALFF
      P1=TE2*TE2*(TC1*TE1+XLA)/XLA3
      P2=TE1*TE1*(TC2*TE2+XLA)/XLA3
      Y1=(H1*P1+H2*P2)
      DP1DT=-TE2*(TC1*(3.*ALFF-2.*AL1-AL2)+2.*XLA)*DAL(J)/XLA3
      DP2DT=-TE1*(TC2*(3.*ALFF-2.*AL2-AL1)-2.*XLA)*DAL(J)/XLA3
      DH2=(PT2*AL2+QT2)*DHVCF
      DY1=DP1DT*H1+DP2DT*H2+DH2*P2
      GOTO 1400
 1330 Y1=(PT2*ALFF+QT2)*HVCF
      DY1=2.*(HVCF-HMIL)*DALF+(2.*ALFF-1.)*DHVCF
 1400 CONTINUE
      IF(ALFF.GT..5)GOTO 1420
      BETA=(HMIL-HVCF)/(HLCF-HVCF)
       ZB=(.5-BETA)/(.5*(1.-BETA))
      ZA=ZB*ZB/(1.-ZB)
      ZC=-1./(ZA+ZB)
      Y2=1./(ZA*ALFF+ZB)+ZC
       Y2=Y2*(HLCF-HVCF)+HVCF
      DNOM=ZA*ALFF+ZB
      DY2=-(HLCF-HVCF)*ZA*DALF/(DNOM*DNOM)+(1.-1./DNOM-ZC)*DHVCF
      GOTO 1450
 1420 Y2=2.*(HVCF-HMIL)*(ALFF-1.)+HVCF
      DY2=2.*(HVCF-HMIL)*DALF+(2.*ALFF-1.)*DHVCF
 1450 DHC=DZ1*Y1+DZ2*Y2+Z1*DY1+Z2*DY2
      HCOEF=Z1*Y1+Z2*Y2
      IF(ITYP(I).EQ.2)GOTO 1800
      X1=TEM
      DHR=S22202(X1,X2,TGA,DTGA,TFL,DTFL,P,DPDT,DIAHY,1)
      DHTC=DHR+DHC*XSI*XTS+HCOEF*(DXSI*XTS+XSI*DXTS)
      DQCED(I,J)=XHTC(I,J)*(DHTC*(TGA-TFL)+HTC(I,J)*(DTGA-DTFL))
      DQPA=DQPA+DQCED(I,J)
      GOTO 2000
 1800 Y=(HCOEF-HVCF)/(HLCF-HVCF)
      DYDT=DHC/(HLCF-HVCF)
      HVCF=HVCFF(I)
      DHVCF=HVT
      SUR=XHTC(I,J)
      HR1=F00113(1,P,DIAHY,TGA,T(I,1),0.)
      HR2=F00113(1,P,DIAHY,TGA,T(I,2),1.)
      DHR1=S22202(X1,X2,TGA,DTGA,T(I,1),DTF(I,1),P,DPDT,DIAHY,1)
      DHR2=S22202(X1,X2,TGA,DTGA,T(I,2),DTF(I,2),P,DPDT,DIAHY,1)
      HL1=HLCF+HR1
      HV1=HVAP+HR1
      HL2=HCON+HR2
      HV2=HVCF+HR2
      DHL1=DHR1
      DHV1=DHR1
      DHL2=DHR2
      DHV2=DHR2+DHVCF
      S1=SUR*Y
      S2=SUR*(1.-Y)
      DS1=SUR*DYDT
      DS2=-DS1
      DTF1=DTF(I,1)
      DTF2=DTF(I,2)
      TF1=T(I,1)
      TF2=T(I,2)
      IF(TS.LT.TGA)GOTO 1850
      DUV1=0.D+00
      DUV2=HV2*((DTSAT-DTF2)*S2+(TS-TF2)*DS2)+DHV2*(TS-TF2)*S2
      DUVME=HVME*(TS-TF2)*S2
      DUVMS=HVMS*(TS-TF2)*S2
      DUL1=HL1*((DTGA-DTF1)*S1+(TGA-TF1)*DS1)+DHL1*(TGA-TF1)*S1
      DUL2=HL2*((DTGA-DTSAT)*S2+(TGA-TS  )*DS2)+DHL2*(TGA-TS  )*S2
      FLUVV2=HV2*(TS  -TF2)*S2
      FLULL1=HL1*(TGA-TF1)*S1
      GOTO 1900
 1850 CONTINUE
      DUL1=HL1*((DTSAT-DTF1)*S1+(TS-TF1)*DS1)+DHL1*(TS-TF1)*S1
      DUL2=0.D+00
      DUV1=HV1*((DTGA-DTSAT)*S1+(TGA-TS)*DS1)+DHV1*(TGA-TS)*S1
      DUV2=HV2*((DTGA-DTF2)*S2+(TGA-TF2)*DS2)+DHV2*(TGA-TF2)*S2
      DUVME=HVME*(TGA-TF2)*S2
      DUVMS=HVMS*(TGA-TF2)*S2
      FLUVV2=HV2*(TGA-TF2)*S2
      FLULL1=HL1*(TS-TF1)*S1
 1900 DTCOR=0.D+00
      DUV1=DUV1+DTCOR
      DUV2=DUV2-DTCOR
      DFLUV1=DFLUV1+DUV1
      DFLUV2=DFLUV2+DUV2
      DFLUL1=DFLUL1+DUL1
      DFLUL2=DFLUL2+DUL2
      DFLVME=DFLVME+DUVME
      DFLVMS=DFLVMS+DUVMS
      DQCED(I,J)=DUL1+DUL2+DUV1+DUV2
 2000 CONTINUE
      IF(ITYP(I).EQ.2)GOTO 2200
      XX(1)=DQPA
      RETURN
 2200 XX(1)=DFLUL1
      XX(2)=DFLUV2
      XX(7)=DFLVME
      XX(8)=DFLVMS
      DQP(I,1)=DFLUL1+DFLUV1
      DQP(I,2)=DFLUL2+DFLUV2
      X=V(I,2)/VC(I)
      DX=DV(I,2)/VC(I)
      SMAX=1.8*SHTC(I)
      IF(X.GE..8)GOTO 2201
      SI=SMAX*(-1.5625*X+2.5)*X
      DSI=SMAX*(-3.125*X+2.5)*DX
      GOTO 2206
 2201 RO=.0295/12.D+00
      IF(X.GE..95)GOTO 2202
      XLA=.15
      Y2=.15*VC(I)/RO
      RAP=-20.D+00
      TC1=.95-X
      TC2=X-.8
      SI1=SMAX*TC1*TC1*(2.*TC2+XLA)
      SI2=Y2*TC2*TC2*((2.-RAP*XLA)*TC1+XLA)
      SI=(SI1+SI2)/3.375D-3
      DSI=DX*TC2*(-6.*SMAX*TC1+Y2*((2.-RAP*XLA)*(2.7-3.*X)+2.*XLA))
     1  /3.375D-3
      GOTO 2206
 2202 IF(X.GE..99)GOTO 2203
      R=RO
      RP=0.D+00
      GOTO 2205
 2203 IF(X.GE..999)GOTO 2204
      R=RO*(89.-.8*X/.009)
      RP=-.8*RO/.009
      GOTO 2205
 2204 R=RO/5.D+00
      RP=0.D+00
 2205 SI=3.*(1.-X)*VC(I)/R
      DSI=-3.*VC(I)*(1.+(1.-X)*RP/R)*DX/R
 2206 CONTINUE
      DFISUP=HVIN*(SI*(DTF(I,2)-DTSAT)+DSI*(T(I,2)-TS))
      DFIINF=HLIN*(SI*(DTSAT-DTF(I,1))+DSI*(TS-T(I,1)))
      DUIV1=DFISUP
      XX(3)=DFIINF
      XX(4)=-DFISUP
      DUIL2=-DFIINF
      XX(5)=(DFLUV1+DUIV1+DEBIL(I,1)*(DH(I,1)-DHGPS*DPDT))/(HGS-H(I,1))
      XX(6)=(DFLUL2+DUIL2+DEBIV(I,2)*(DH(I,2)-DHFPS*DPDT))/(HFS-H(I,2))
      RETURN
 3000 CONTINUE
      DQ(1)=0.D+00
      DQ(2)=0.D+00
      TFF(1)=T(I,1)
      TFF(2)=T(I,2)
      DTFF(1)=DTF(I,1)
      DTFF(2)=DTF(I,2)
      N1=NASL(I)
      XTSS(1)=1.D+00
      XTSS(2)=1.D+00
      DXTSS(1)=0.D+00
      DXTSS(2)=0.D+00
      IF(TS.LE.TFF(1))GOTO 3010
      ECT=TS-TFF(1)
      ECTC=ECT*ECT+2.4
      XTSS(1)=.025+2.34/ECTC
      DXTSS(1)=(4.68*ECT/(ECTC*ECTC))*(DTFF(1)-DTSAT)
 3010 CONTINUE
      DO 3100 J=1,N1
      IF(J.EQ.ISLNI)GOTO 3100
      TGA=TGAI(I,J)
      DTGA=DTGAI(I,J)
      IND=(N1+J-ISLNI)/N1+1
      XTS=XTSS(IND)
      TFL=TFF(IND)
      DTFL=DTFF(IND)
      XSI=1.D+00
      DXSI=0.D+00
      IF(TFL.LE.TGA)GOTO 3020
      ECT=TFL-TGA+2.D+00
      XSI=.1+1.8/ECT
      DXSI=-1.8*(DTFL-DTGA)/(ECT*ECT)
 3020 CONTINUE
      HCOEF=HLCF*(2-IND)+HVCF*(IND-1)
      DHVCF=0.D+00
      DHCOE=(IND-1)*HVCF
      HR=HTC(I,J)-HCOEF*XSI*XTS
      DHR=S22202(AL(IND),DAL(IND),TGA,DTGA,TFL,DTFL,X1,X2,X3,3)
      DHR=S22202(AL(J  ),DAL(J  ),TGA,DTGA,TFL,DTFL,X1,X2,X3,3)
      DH1=HCOEF*(XSI*DXTSS(IND)+DXSI*XTS)+DHCOE*XSI*XTS+DHR
      DQCED(I ,J)=(HTC(I,J)*(DTGA-DTFL)+DH1*(TGA-TFL))*XHTC(I,J)
      DQ(IND)=DQ(IND)+DQCED(I,J)
 3100 CONTINUE
      DO 3200 J=1,2
      TFL=TFF(J)
      DTFL=DTFF(J)
      TGA=TMI(J)
      DTGA=DTMI(J)
      XSI=1.D+00
      DXSI=0.D+00
      IF(TFL.LE.TGA)GOTO 3110
      ECT=TFL-TGA+2.D+00
      XSI=.1+1.8/ECT
      DXSI=-1.8*(DTFL-DTGA)/(ECT*ECT)
 3110 XY=RI(J)
      DXY=DV(I,J)*N1/VC(I)
      XTS=XTSS(J)
      DXTS=DXTSS(J)
      X=XSI*DXTS+DXSI*XTS
      HCOEF=HLCF*(2-J)+HVCF*(J-1)
      DHVCF=0.D+00
      DHCOE=(J-1)*DHVCF
      DHR=S22202(AL(J),DAL(J),TGA,DTGA,TFL,DTFL,X1,X2,X3,3)
      DH1=DHCOE*XSI*XTS+HCOEF*X+DHR
      DQCEI(J)=(HTC(I,J)*(XY*(DTGA-DTFL)+DXY*(TGA-TFL))+(TGA-TFL)*XY*
     1 DH1)*XHTC(I,ISLNI)
 3200 DQ(J)=DQ(J)+DQCEI(J)
      XX(1)=DQ(1)
      XX(2)=DQ(2)
      RETURN
      END
DataMuseum.dk

DKUUG/EUUG Conference tapes

⟦5e8c965a2⟧ TextFile

Derivation

TextFile
