DataMuseum.dk

top - metrics - download

    Length: 4639 (0x121f)
    Types: TextFile
    Names: »S00011.f«

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

TextFile

      SUBROUTINE S00011
      IMPLICITDOUBLEPRECISION(A-H,O-Z)
      COMMON/AAA33/VCO,XL0055,D876,DINT,DEXT,VOL002,VOL005,LCO,NCRAY
      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/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/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/AAA13/TEM,P,DT,HNIV(22),VITESS
     1            ,ZNIV,RI(2),ISS,NITERA,NIV,ISLNI,IBTR,IHTR,ITYP(22)
      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/AAA66/TS,HFS,HGS,HFGS,DHFPS,DHGPS,VVFS,VVGS,DVVFPS,DVVGPS
     1             ,DHFGS,VV1,VV2,DVV1P,DVV2P,T1,T2
      DOUBLEPRECISION M,X(3),Y(3),XY(3)
      DOUBLEPRECISION BIDON(2000)
      PI=3.14159
      I6FT=NC1/2
      I8FT=2*NC1/3
      J6FT=1
      J8FT=1
      Z6=XL0055/2.
      Z8=2.*XL0055/3.
      DO 50 I=2,NC1
      NI=NASL(I)
      ZMINC=ZCOT(I-1)
      ZINT=XL(I)/NI
      DO 50 J=1,NI
      ZMIN=ZMINC+(J-1.)*ZINT
      ZMAX=ZMIN+ZINT
      IF(Z6.GT.ZMAX)GOTO 50
      IF(Z6.LT.ZMIN)GOTO 45
      I6FT=I
      J6FT=J
  45  IF(Z8.GT.ZMAX)GOTO 50
      I8FT=I
      J8FT=J
      GOTO 55
   50 CONTINUE
   55 CONTINUE
      SEC=PI*(DEXT*DEXT-DINT*DINT)*NCRAY/4.
      VOL002=SEC*XL0055
      VOL005=PI*D876*D876/4.*XL0055*NCRAY
      XMGAI=RGAI*VOL002
      XM876=R876*VOL005
      XMCGAI=CPGAI*XMGAI
      XMC876=CP876*XM876
      PERIM=NCRAY*PI*DEXT
      DIAHY=4.*SCAPA(2)/PERIM
      DO 100 I=2,NC1
      N1=NSL(I)
      XMG=XMCGAI*XL(I)/XL0055/N1
      XMU=XMC876*XL(I)/XL0055/N1
      SHTC(I)=XL(I)*DEXT*PI
      SHTC(I)=SHTC(I)*NCRAY
      XHT=SHTC(I)/N1
      DO 100 J=1,N1
      XMCGA(I,J)=XMG
      XMCUO(I,J)=XMU
      XHTC(I,J)=XHT
 100  CONTINUE
      DO 200 I=2,NC1
      N1=NSL(I)
      DO 200J=1,N1
      QREPA(I,J)=PL(I,J)*XL(I)/N1/XL0055
 200  CONTINUE
        PLMOY=QINIT/NCRAY/XL0055
      CALL S00934(TPUI,QPUI,QPUI,TEM,RPUI,XX,6)
      PLMOY=PLMOY*RPUI
      DO 150 I=2,NC1
      HGAP=HGAPP(I)
      HCG(I)=2.*PI/(DLOG(DEXT/DINT)/XLGAI+2./(D876*HGAP)+1./(4.*XL876))
  150 CONTINUE
      IF(KTGAI.EQ.0)GOTO 101
      DO 201 I=2,NC1
      N1=NSL(I)
      DO 201 J=1,N1
      TGAI(I,J)=T(I,1)
      IF(ITYP(I).EQ.2)TGAI(I,J)=T(I,2)
 201  CONTINUE
 101  CONTINUE
      TPE=TGAI(IBCH,1)
      X(3)=XL(2)/(2.*NSL(2))
      X(2)=-X(3)
      X(1)=-3.*X(3)
      Y(3)=TGAI(2,1)
      Y(2)=T(1,1)
      Y(1)=2.*Y(2)-TS+20.
      NSL(1)=1
      NASL(1)=1
      CALL S00099(3,X,Y,XY)
      QCON(1,1)=2.*XY(1)*XLGAI*SEC*XL(2)/ NSL(2)
      CALL S66832
      ISLNI=0
      CALL S33055(IBTR)
      CALL S33055(IHTR)
      IF(ICAT(2).LE.2)GOTO 1200
      I=NIV
      N1=NASL(I)
      ISLNI=HNIV(I)/XL(I)*N1+1
      DO 900 J=1,ISLNI
  900 TGAI(I,J)=T(I,1)
      IF(ISLNI.EQ.N1)GOTO 930
      ISL2=ISLNI+1
      DO 910 J=ISL2,N1
  910 TGAI(I,J)=T(I,2)
  930 TMI(1)=T(I,1)
      TMI(2)=T(I,2)
 1200 CONTINUE
      IF(KT876.EQ.0)GOTO 1400
      DO 1300 I=2,NC1
      HCGG=HCG(I)
      N1=NASL(I)
      DO 1300 J=1,N1
 1300 T876(I,J)=TGAI(I,J)+PL(I,J)*PLMOY/HCGG
      I=NIV
      J=ISLNI
      HCGG=HCG(I)
      TMU(1)=TMI(1)+PL(I,J)*PLMOY/HCGG
      TMU(2)=TMI(2)+PL(I,J)*PLMOY/HCGG
 1400 CONTINUE
      DO 1500 I=2,NC1
      N1=NASL(I)
      DO 1500 J=1,N1
      PI=3.14159
      TUMAX(I,J)=T876(I,J)+PL(I,J)*PLMOY/(8.*PI*XL876)
      TUMIN(I,J)=T876(I,J)-PL(I,J)*PLMOY/(8.*PI*XL876)
      TGAII(I,J)=TGAI(I,J)+PL(I,J)*DLOG(DEXT/DINT)*PLMOY/(2.*PI*XLGAI)
 1500 CONTINUE
       STOT=0.
      DO 180 I=IBCH,IHCH
  180 STOT=STOT+SHTC(I)
      ECART=QINIT/(STOT*HLCF)
      DO 190 I=2,NC1
      XG=HGAPP(I)*3600.
190   CONTINUE
      DO 700 II=2,NC1
      I=NC1+2-II
      N1=NSL(I)
      DO 700 JJ=1,N1
      J=N1+1-JJ
  700  CONTINUE
      RETURN
      END