DataMuseum.dk

top - metrics - download

    Length: 5006 (0x138e)
    Types: TextFile
    Names: »S44553.f«

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

TextFile

      SUBROUTINE S44553(I,J,K,ALFF,HCOEF,HRAY)
      IMPLICITDOUBLEPRECISION(A-H,O-Z)
      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/AAA55/KPRESS,KDEB,KCON,KTGAI,KT876,ICAT(3),KIMP,KGLISS
      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/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/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/AAA66/TS,HFS,HGS,HFGS,DHFPS,DHGPS,VVFS,VVGS,DVVFPS,DVVGPS
     1             ,DHFGS,VV1,VV2,DVV1P,DVV2P,T1,T2
      COMMON/AAA13/TEM,P,DT,HNIV(22),VITESS
     1            ,ZNIV,RI(2),ISS,NITERA,NIV,ISLNI,IBTR,IHTR,ITYP(22)
      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)
      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
      DOUBLEPRECISION M
      DATA Y1 /0.D+00/
      HVCF=HVCFF(I)
      IF(ITYP(I).EQ.2)HVCF=HVCFO
      IF(I.LT.NIV)IOPT=2
      IF(I.GT.NIV)IOPT=0
      IF(I.EQ.NIV.AND.J.EQ.1)IOPT=2
      IF(I.EQ.NIV.AND.J.EQ.2)IOPT=0
      IF(ICAT(2).LE.2)IOPT=3
      TMUR=TGAI(I,K)
      IF(I.EQ.NIV.AND.K.EQ.ISLNI)TMUR=TMI(J)
      TFLUI=TS
      IF(ITYP(I).NE.2)TFLUI=T(I,J)
      HRAY=F00113(ICAT(2),P,DIAHY,TMUR,TFLUI,ALFF)
      XX=TS-TFLUI
      XTS=.025+2.34/(2.4+XX*XX)
      IF(XX.LT.0.)XTS=1.
       XSI=1.
       IF(TFLUI.LE.TMUR)GOTO 900
      XSI=.1+1.8/(TFLUI-TMUR+2.)
  900 CONTINUE
      KK=IOPT+1
      GOTO (1000,2000,3000,4000),KK
 1000 IF(ALFF.GT.0.)GOTO 1100
      V66077=HLCF
      GOTO 5000
 1100 IF(ALFF.GT..5)GOTO 1200
      X=4.*DLOG(60.*HLCF)
      ZA=240.*HVCF+X-4.
      ZB=-120.*HVCF-X+2.
      V66077=HLCF*DEXP((ZA*ALFF+ZB)*ALFF)
      GOTO 5000
 1200 IF(ALFF.GT.1.)GOTO 1300
       V66077=(2.*HVCF-1./30.)*ALFF+1./30.-HVCF
      GOTO 5000
 1300 V66077=HVCF
      GOTO 5000
2000  PRINT99887
99887 FORMAT(21H S44553/ECART/ERREUR                )
      V66077=HLCF*DABS(TMUR-TFLUI)/ECART
      GOTO 5000
 3000 V66077=HLCF
      GOTO 5000
 4000 CONTINUE
      HMIL=100./3600.
      ZZ1=ZCOT(IBCH-1)
      ZZ2=ZCOT(IHCH)
      ZZ=ZCOT(I-1)+(XL(I)*(J-.5))/NASL(I)
      XX=((ZZ-ZZ1)/(ZZ2-ZZ1))-.5
      TBORD=700.
      TMIL=900.
      ACO=(TMIL-TBORD)*4.
      TMOY=TMIL-ACO*XX*XX
      TMIN=TMOY-100.
      TMAX=TMOY+100.
      ECT=TMAX-TMIN
      Z1=(TMAX-TMUR)/ECT
      Z2=(TMUR-TMIN)/ECT
      IF(TMUR.LE.TMAX)GOTO 4010
      Z1=0.
      Z2=1.
      GOTO 4510
 4010 CONTINUE
      IF(ALFF.GT.1.D-4)GOTO 4100
      Y1=HLCF
      GOTO 4500
 4100 CONTINUE
      PT1=-.1
      PT2=2.*(HVCF-HMIL)/HVCF
      QT1=1.
      QT2=1.-PT2
      AL1=.625
      AL2=.95
      IF(ALFF.GT.AL1)GOTO 4200
      Y1=(PT1*ALFF+QT1)*HLCF
      GOTO 4500
 4200 IF(ALFF.GT.AL2)GOTO 4300
      XLA=AL2-AL1
      X1=PT1*AL1+QT1
      X2=PT2*AL2+QT2
      H1=X1*HLCF
      H2=X2*HVCF
      U1=-PT1/X1
      U2=-PT2/X2
      P1=(ALFF-AL2)*(ALFF-AL2)*((2.-U1*XLA)*(ALFF-AL1)+XLA)
     1/(XLA*XLA*XLA)
      P2=(ALFF-AL1)*(ALFF-AL1)*((2.+U2*XLA)*(AL2-ALFF)+XLA)
     1/(XLA*XLA*XLA)
      Y1=(H1*P1+H2*P2)
      GOTO 4500
 4300 Y1=(PT2*ALFF+QT2)*HVCF
 4500 IF(TMUR.GT.TMIN)GOTO 4510
      Z2=0.
      Z1=1.
      GOTO 4900
 4510 CONTINUE
      IF(ALFF.GT..5)GOTO 4600
      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
      GOTO 4900
 4600 Y2=2.*(HVCF-HMIL)*(ALFF-1.)+HVCF
      Y2=2.*(HVCF-HMIL)*(ALFF-1.)+HVCF
 4900 V66077=Z1*Y1+Z2*Y2
 5000 CONTINUE
      HCOEF=V66077
      IF(ITYP(I).EQ.2)RETURN
      HCOEF=HCOEF*XSI*XTS
      RETURN
      END