DataMuseum.dk

top - metrics - download

    Length: 7565 (0x1d8d)
    Types: TextFile
    Names: »S00013.f«

└─⟦db229ac7e⟧ Bits:30007240 EUUGD20: SSBA 1.2 / AFW Benchmarks
    └─⟦this⟧ »EUUGD20/AFUU-ssba1.21/ssba1.21E/doduc/S00013.f« 
    └─⟦this⟧ »EUUGD20/AFUU-ssba1.21/ssba1.21F/doduc/S00013.f« 

TextFile

      SUBROUTINE S00013
      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/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/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/AAA26/DEB(21),DEBV(21),DEBL(21),ALFAD(21),ALFB(21),
     2ALFT(21),HA(21),HB(21),HE(21,2),HEM(21),VE(21,2),
     3              XA(21),XB(21),XD(21),XEM(21),SDSC
     4             ,TJONC(21),HJONB(21,2),HJONT(21,2),DEBAV(21)
     5            ,GLINF(21),GLSUP(21),PP1,PP2,ALNIV
     6            ,VGJO(21),GLINFP(21),V55198(21),ICAS(21),ICZW(21)
      COMMON/AAA55/KPRESS,KDEB,KCON,KTGAI,KT876,ICAT(3),KIMP,KGLISS
      COMMON/AAA11/V0011N(20),V0012X(20),V0011,V0012,
     1TLIM,ZLIMIN,ZLIMAX,DTVOI,TIMIMP(20),DIFREF(20),DIFMIC(20),
     3V00001,V22202,TEMIMP,TEMMIC,DELM,DELV,DELVI,DELVS,
     6V22201,V22203,DTPRE,DTPHY,DTTEMP,DTCHAN,DTDIS,DTBEF,DTORG
     7,NIMIC,NMULTR,IZONE,N00011(20),ISORT,NECRIT,NSTAR,IPLOT,NZONE
     +,IFRE(20),ICO,IIMP,NPAS1(20),NPAS2(20)
      DOUBLEPRECISION M,XY(3),ALFF(12)
      DO 100 I=2,NC1
      SEC=SCAPA(I)
      IF(ICAT(2).GE.3)GOTO 250
      TFL=T(I,1)
      IF(ITYP(I).EQ.2)TFL=T(I,2)
      CALL S00061(I,HVCF,X1,X2,X3,YNU,RE,TFL,X4,0)
      HVCFF(I)=HVCF
  250 CONTINUE
      N1=NASL(I)
      DO 251 J=1,N1
  251 ALFF(J)=TVID(I,J)
      IDODUC=ITYP(I)
      GOTO (1,2,3),IDODUC
 1    CONTINUE
      N1=NASL(I)
      FI=0.D+00
      DO 11 J=1,N1
      CALL S44553(I,1,J,ALFF(J),HCO,HRAY)
      HCOEF=HCO+HRAY
      HTC(I,J)=HCOEF
      QCED(I,J)=HCOEF*(TGAI(I,J)-T(I,1))*XHTC(I,J)
   11 FI=FI+QCED(I,J)
      FLUP(I,1)=FI
      GO TO 100
 2    CONTINUE
      FLUV(I,1)=0.D+00
      FLUV(I,2)=0.D+00
      FLUL(I,1)=0.D+00
      FLUL(I,2)=0.D+00
      N1=NASL(I)
      X=V(I,2)/VC(I)
      DO 160 J=1,N1
      TGA=TGAI(I,J)
      CALL S44553(I,1,J,ALFF(J),HCOEF,HRAY)
      ICA=ICAT(2)
      HRAY1=F00113(ICA,P,DIAHY,TGA,T(I,1),0.)
      HRAY2=F00113(ICA,P,DIAHY,TGA,T(I,2),1.)
      HLC=HLCF+HRAY1
      HVA=HVAP+HRAY1
      HVC=HVCF+HRAY2
      HCO=HCON+HRAY2
      Y=(HCOEF-HVCFO)/(HLCF-HVCFO)
      HTC(I,J)=HCOEF
      SHT1=XHTC(I,J)*Y
      SHT2=XHTC(I,J)*(1.-Y)
      IF(TS.LT.TGA)GOTO 25
      FLUVV1=0.D+00
      FLULL1=HLC*(TGA-T(I,1))*SHT1
      FLULL2=HCO*(TGA-TS)*SHT2
      FLUVV2=HVC*(TS-T(I,2))*SHT2
      GOTO 28
   25 FLULL1=HLC*(TS-T(I,1))*SHT1
      FLUVV1=HVA*(TGA-TS)*SHT1
      FLULL2=0.D+00
      FLUVV2=HVC*(TGA-T(I,2))*SHT2
  28  TCOR=0.D+00
      FLUV(I,1)=FLUV(I,1)+FLUVV1+TCOR
      FLUV(I,2)=FLUV(I,2)+FLUVV2-TCOR
      FLUL(I,1)=FLUL(I,1)+FLULL1
      FLUL(I,2)=FLUL(I,2)+FLULL2
      QCED(I,J)=FLULL1+FLULL2+FLUVV1+FLUVV2
  160 CONTINUE
      X=V(I,2)/VC(I)
      SMAX=1.8*SHTC(I)
      IF(X.GE..8)GOTO 31
      SINT=SMAX*(-1.5625*X+2.5)*X
      GOTO 35
  31  RO=.0295/12.D+00
      IF(X.GE..95)GOTO 32
      XLA=.15
      Y2=.15*VC(I)/RO
      RAP=-20.D+00
      TC1=.95-X
      TC2=X-.8
      SINT1=SMAX*TC1*TC1*(2.*TC2+XLA)
      SINT2=Y2*TC2*TC2*((2.-RAP*XLA)*TC1+XLA)
      SINT=(SINT1+SINT2)/3.375D-3
      GOTO 35
  32  R=RO
      IF(X.LE..99)GOTO 33
      R=RO/5.D+00
      IF(X.LE..999)R=RO*(89.-.8*X/.009)
  33  SINT=3.*(1.-X)*VC(I)/R
  35  CONTINUE
      FIINF=HLIN*SINT*(TS-T(I,1))
      FISUP=HVIN*SINT*(T(I,2)-TS)
      FLUIV(I,1)=FISUP
      FLUIL(I,1)=FIINF
      FLUIV(I,2)=-FISUP
      FLUIL(I,2)=-FIINF
      FLUP(I,1)=FLUL(I,1)+FLUV(I,1)
      FLUP(I,2)=FLUL(I,2)+FLUV(I,2)
      DEBIL(I,1)=(FLUV(I,1)+FLUIV(I,1))/(HGS-HF(I,1))
      DEBIV(I,2)=(FLUL(I,2)+FLUIL(I,2))/(HFS-HG(I,2))
      DEBIV(I,1)=0.D+00
      DEBIL(I,2)=0.D+00
      DEBI(I)=DEBIL(I,1)+DEBIV(I,1)-DEBIL(I,2)-DEBIV(I,2)
      GO TO 100
 3    CONTINUE
      N1=NASL(I)
      FLUP(I,1)=0.D+00
      FLUP(I,2)=0.D+00
      ISL1=ISLNI-1
      ISL2=ISLNI+1
      IOPT1=2
      IF(ISL1.EQ.0)GOTO 312
      DO 311 J=1,ISL1
      CALL S44553(I,1,J,ALFA(I,1),HCO,HRAY)
      HCOEF=HCO+HRAY
      HTC(I,J)=HCOEF
      QCED(I,J)=HCOEF*(TGAI(I,J)-T(I,1))*XHTC(I,J)
  311 FLUP(I,1)=FLUP(I,1)+QCED(I,J)
  312 J=ISL1+1
      ZZ=HNIV(I)
      HSLAB=XL(I)/N1
      ZS=ZZ-ISL1*HSLAB
      R1=ZS/HSLAB
      R2=1.-R1
      SEC1=XHTC(I ,J)*R1
      SEC2=XHTC(I,J)*R2
      TM1=TMI(1)
      TM2=TMI(2)
      RI(1)=R1
      RI(2)=R2
      CALL S44553(I,1,J,ALFA(I,1),HCO,HRAY)
      HCO1=HCO+HRAY
      CALL S44553(I,2,J,ALFA(I,2),HCO,HRAY)
      HCO2=HCO+HRAY
      Q1=HCO1*(TM1-T(I,1))*SEC1
      Q2=HCO2*(TM2-T(I,2))*SEC2
      QCED(I,J)=Q1+Q2
      FLUP(I,1)=FLUP(I,1)+Q1
      FLUP(I,2)=FLUP(I,2)+Q2
      QCEI(1)=Q1
      QCEI(2)=Q2
      IF(ISL2.GT.N1)GOTO 330
      DO 325 J=ISL2,N1
      CALL S44553(I,2,J,ALFA(I,2),HCO,HRAY)
      HCOEF=HCO+HRAY
      HTC(I,J)=HCOEF
      QCED(I,J)=HCOEF*(TGAI(I,J)-T(I,2))*XHTC(I,J)
  325 FLUP(I,2)=FLUP(I,2)+QCED(I,J)
  330 CONTINUE
  100 CONTINUE
      IF(ICAT(2).LE.2)RETURN
      I=NIV
      VG=VVGS
      VF=VVFS
      IF(IST(I,1).EQ.1)VF=VV(I,1)
      IF(IST(I,1).EQ.3)VG=VV(I,1)
      TEMPE=T(I,1)
      SEC=SCAPA(I)
      I=NIV
      Z1=XL(I-1)/2.D+00
      Z2=HNIV(I)/2.D+00
      HJ=F00111(I-1)
      X=(HJ-HFS)/(HGS-HFS)
      ALB=X/(X+(1.-X)*VVFS/VVGS)
      ALT=ALFA(I,1)
      IF(ALB.LE..05)Z1=Z1*ALB/.05
      IF(ALT.LE..05)Z2=Z2*ALT/.05
      ALFAD(I-1)=(Z2*ALB+Z1*ALT)/(Z1+Z2)
      PP1=(ALT-ALB)/(Z1+Z2)
      IF(HNIV(I).GT.(XL(I)/2.))GOTO 1300
      ALNIV=ALFAD(I-1)+PP1*HNIV(I)
      GOTO 1301
 1300 ALNIV=ALFAD(I-1)+PP1*XL(I)/2.+PP2*(HNIV(I)-XL(I)/2.)
 1301 IF(ALNIV.GT..9999)ALNIV=.9999
      AL=ALNIV
      IF(ALNIV.LT.0.)ALNIV=0.D+00
      GG=1.D+6
      IF(KGLISS.EQ.4)GOTO 331
      GOTO 332
  331  CONTINUE
      CALL F88345(GG,AL,AL,VG,VF,TEMPE,X1,X2,X3,X4,VGJ,
     1 X5,X6,IX,X7,X8,IY)
  332 FLUXG=0.D+00
      IF(AL.GT..99999)GOTO 333
      FLUXG=SEC*VGJ*AL/((1.-AL)*VG)
  333 CONTINUE
      VG=VVGS
      VF=VVFS
      IF(IST(I,2).EQ.1)VF=VV(I,2)
      IF(IST(I,2).EQ.3)VG=VV(I,2)
      TEMPE=T(I,2)
      AL=ALFA(I,2)
      IF(KGLISS.EQ.4)GOTO 340
      GOTO 350
  340  CONTINUE
      CALL F88345(GG,AL,AL,VG,VF,TEMPE,X1,X2,X3,X4,VGJ,
     1 X5,X6,IX,X7,X8,IY)
  350 FLUXF=((1.-AL)*FLUXG*VG/AL-VGJ*SEC)/VF
      DEBI(I)=FLUXG+FLUXF
      DEBHI(I)=FLUXG*HG(I,1)+FLUXF*HF(I,2)
      RETURN
      END