DataMuseum.dk

Presents historical artifacts from the history of:

DKUUG/EUUG Conference tapes

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about DKUUG/EUUG Conference tapes

Excavated with: AutoArchaeologist - Free & Open Source Software. 

top - metrics - download
Index: S T

⟦82f761ae3⟧ TextFile

    Length: 4375 (0x1117)
    Types: TextFile
    Names: »S00014.f«

Derivation

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

TextFile

      SUBROUTINE S00014
      IMPLICITDOUBLEPRECISION(A-H,O-Z)
      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/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/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/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/AAA66/TS,HFS,HGS,HFGS,DHFPS,DHGPS,VVFS,VVGS,DVVFPS,DVVGPS
     1             ,DHFGS,VV1,VV2,DVV1P,DVV2P,T1,T2
      COMMON/AAA22/DH(22,2),DM(22,2),DPDT,DUU(22,2),DV(22,2),DNU(22,2)
      COMMON/AAA16/DBENT(20),TENT(20),HENT(20),DEBE,ENTE,
     2        DBSOR(20),TSOR(20),DEBS,DPDTT(20),TDPDT(20)
     3  ,HSOR(20),THSOR(20),ENTS,NDBENT,NDPDT,NDBSOR,NHSOR
      DOUBLEPRECISION M,NUM,D(22),E(22),F(22)
      EPS=1.D-8
      DO 100 I=2,NC1
      A(I)=0.D+00
      B(I)=0.D+00
      C(I)=0.D+00
      D(I)=0.D+00
      E(I)=0.D+00
      F(I)=0.D+00
 100  CONTINUE
      IF(KDEB.EQ.0)GOTO 105
      RET=15.D+00
      D1=DEB(1)
      DMCDT=DEB(1)-DEB(NC1)
      D2=DEBE-SDSC*DMCDT
      DEB(1)=D1+(DT/RET)*(D2-D1)
      GOTO 108
  105 DEB(1)=DEBE
  108 CONTINUE
      IF(KPRESS.EQ.1)GOTO 110
      DEB(NC1)=DEBS
  110 CONTINUE
      DO 200 I=2,NC1
      J=I-1
      IDODUC=ITYP(I)
      GOTO (10,20,30),IDODUC
 10   CONTINUE
      A(I)=DVVH(I,1)*(HB(J)-HB(I)+FLUP(I,1))
       B(I)=DELH(I,1)+DVVH(I,1)*HA(J)
      C(I)=-(DELH(I,1)+DVVH(I,1)*HA(I))
      D(I)=BB(I,1)
      GOTO 51
 20   CONTINUE
      XSLI=DELH(I,1)+DVVH(I,1)*HE(I,1)
      XSLJ=DELH(I,1)+DVVH(I,1)*HE(J,1)
      XSVI=DELH(I,2)+DVVH(I,2)*HE(I,2)
      XSVJ=DELH(I,2)+DVVH(I,2)*HE(J,2)
      XSIFS1=DELH(I,1)+DVVH(I,1)*HFS
      XSIFS2=DELH(I,2)+DVVH(I,2)*HFS
      XSIGS1=DELH(I,1)+DVVH(I,1)*HGS
      XSIGS2=DELH(I,2)+DVVH(I,2)*HGS
      XSIFI=DELH(I,1)+DVVH(I,1)*HF(I,1)
      XSIGI=DELH(I,2)+DVVH(I,2)*HG(I,2)
      A(I)=XB(I)*XSLI-XB(J)*XSLJ+DVVH(I,1)*(FLUL(I,1)+FLUIL(I,1))
     1+XB(J)*XSVJ-XB(I)*XSVI+DVVH(I,2)*(FLUV(I,2)+FLUIV(I,2))
     2    +DEBIL(I,1)*(XSIGS2-XSIFI)
     1    +DEBIV(I,2)*(XSIFS1-XSIGI)
     5    +DEBIV(I,1)*(XSIGS2-XSIGS1)
     6    +DEBIL(I,2)*(XSIFS1-XSIFS2)
      B(I)=(1.-XA(J))*XSLJ+XA(J)*XSVJ
      C(I)=-(1.-XA(I))*XSLI-XA(I)*XSVI
      GO TO 50
 30   CONTINUE
      A(I)=(DELH(I,2)-DELH(I,1))*DEBI(I)
     1+DVVH(I,1)*(HB(J)-DEBHI(I)+FLUP(I,1))
     2+DVVH(I,2)*(-HB(I)+DEBHI(I)+FLUP(I,2))
      B(I)=DELH(I,1)+DVVH(I,1)*HA(J)
      C(I)=-(DELH(I,2)+DVVH(I,2)*HA(I))
 50   CONTINUE
      D(I)=BB(I,1)+BB(I,2)
   51 E(I)=-A(I)
 200  CONTINUE
      IF(KPRESS.EQ.1)GOTO 420
      E(2)=E(2)-B(2)*DEB(1)
      E(NC1)=E(NC1)-C(NC1)*DEBS
      DEB(NC1)=DEBS
      F(2)=1.D+00
      NUM=0.D+00
      DENOM=0.D+00
      DO 300 I=2,NC
      NUM=NUM+F(I)*E(I)
      DENOM=DENOM+F(I)*D(I)
      F(I+1)=-F(I)*C(I)/B(I+1)
 300  CONTINUE
      NUM=NUM+F(NC1)*E(NC1)
      DENOM=DENOM+F(NC1)*D(NC1)
      DPDT=NUM/DENOM
      DEB(2)=(E(2)-D(2)*DPDT)/C(2)
      DO 400 I=3,NC
      DEB(I)=(E(I)-B(I)*DEB(I-1)-D(I)*DPDT)/C(I)
 400  CONTINUE
      GOTO 499
  420  CONTINUE
      TAFT=TEM+1.D-4
      CALL S00934(TDPDT,DPDTT,DPDTT,TAFT,PAFT,X,13)
      DPDT=(PAFT-P)/1.D-4
      DO 450 I=2,NC1
      DEB(I)=(-D(I)*DPDT-A(I)-B(I)*DEB(I-1))/C(I)
  450 CONTINUE
  499 DO 500 I=1,NC1
      DEBV(I)=XA(I)*DEB(I)+XB(I)
      DEBL(I)=DEB(I)-DEBV(I)
      XD(I)=0.5
      XEM(I)=0.5
       HEM(I)=0.5
      IF(DABS(DEB(I)).LT.EPS)GOTO 500
      XD(I)=DEBV(I)/DEB(I)
      HEM(I)=(HE(I,1)*DEBL(I)+HE(I,2)*DEBV(I))/DEB(I)
      XEM(I)=(HEM(I)-HFS)/HFGS
 500  CONTINUE
      DEBS=DEB(NC1)
      RETURN
      END