|
DataMuseum.dkPresents historical artifacts from the history of: DKUUG/EUUG Conference tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about DKUUG/EUUG Conference tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: S T
Length: 4308 (0x10d4)
Types: TextFile
Names: »S00001.f«
└─⟦db229ac7e⟧ Bits:30007240 EUUGD20: SSBA 1.2 / AFW Benchmarks
└─⟦this⟧ »EUUGD20/AFUU-ssba1.21/ssba1.21E/doduc/S00001.f«
└─⟦this⟧ »EUUGD20/AFUU-ssba1.21/ssba1.21F/doduc/S00001.f«
SUBROUTINE S00001
IMPLICITDOUBLEPRECISION(A-H,O-Z)
COMMON/AAA66/TS,HFS,HGS,HFGS,DHFPS,DHGPS,VVFS,VVGS,DVVFPS,DVVGPS
1 ,DHFGS,VV1,VV2,DVV1P,DVV2P,T1,T2
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/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/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
COMMON/AAA55/KPRESS,KDEB,KCON,KTGAI,KT876,ICAT(3),KIMP,KGLISS
COMMON/AAA22/DH(22,2),DM(22,2),DPDT,DUU(22,2),DV(22,2),DNU(22,2)
DOUBLEPRECISION M
COEF=144.D+00/778.D+00
CALL S00096(P,HFS,HGS,TS,VVFS,VVGS,DVVFPS,DVVGPS,DHFPS,DHGPS,
1 DTSAT)
H1=HFS-5.
CALL S55199(H1,P, T1,R,X1,X2,DTDH1,DTDP1)
VV1=1./R
H2=HGS+10.
CALL S55198(H2,P,T2,R,X1,X2,DTDH2,DTDP2)
VV2=1./R
H3=1850.
H4=1860.
CALL S55198(H3,P,T3,R,X1,X2,X3,X4)
VV3=1./R
DVP3=X2
DTP3=X4
CALL S55198(H4,P,T4,R,X1,X2,X3,X4)
VV4=1./R
DVP4=X2
DTP4=X4
HFGS=HGS-HFS
DHFGS=DHGPS-DHFPS
VFGS=VVGS-VVFS
DVFGS=DVVGPS-DVVFPS
CALL S00934(TENT,DBENT,HENT,TEM,DEBE,H(1,1),20)
CALL S00934(THSOR,HSOR,HSOR,TEM,ENTS,X,2)
H(NC2,1)=ENTS
IF(KPRESS.EQ.1)GOTO 18
CALL S00934(TSOR,DBSOR,DBSOR,TEM,DEBS,X,NDBSOR)
GOTO 19
18 CALL S00934(TDPDT,DPDTT,DPDTT,TEM,P,X,13)
19 CONTINUE
DO 100 I=1,NC2
J1=2
IF(ITYP(I).EQ.1)J1=1
IF(ITYP(I).NE.2)GOTO 20
IF(H(I,1).GE.HFS)H(I,1)=HFS-1.D-6
IF(H(I,2).LE.HGS)H(I,2)=HGS+1.D-6
VMIN=1.D-7*VC(I)
IF(V(I,1).GE.VMIN)GOTO 21
V(I,1)=0.
V(I,2)=VC(I)
GOTO 20
21 IF(V(I,2).GE.VMIN)GOTO 20
V(I,1)=VC(I)
V(I,2)=0.
20 CONTINUE
DO 110 J=1,J1
IF(H(I,J).LT.10.)H(I,J)=10.
XT(I,J)=(H(I,J)-HFS)/HFGS
XTI=XT(I,J)
IF(XTI.GE.0.)GOTO 30
IST(I,J)=1
ALFA(I,J)=0.
XM(I,J)=0.
HF(I,J)=H(I,J)
HG(I,J)=HGS
CALL S55199(H(I,J),P,T(I,J),R,DVVH(I,J),DVVP(I,J),DTDH(I,J),
1 DTDP(I,J))
DNUHP(I,J)=0.
DNUPP(I,J)=0.
VV(I,J)=1./R
IF(H(I,J).LE.H1)GOTO 150
X=1.-(HFS-H(I,J))/5.
T(I,J)=(1.-X)*T1+X*TS
VV(I,J)=(1.-X)*VV1+X*VVFS
DVVH(I,J)=(VVFS-VV1)/5.
DXDH=1./5.
DTDH(I,J)=(TS-T1)*DXDH
GOTO 150
30 IF(XTI.GT.1.)GOTO 40
IST(I,J)=2
DVFGS=DVVGPS-DVVFPS
VFGS=VVGS-VVFS
T(I,J)=TS
DTDP(I,J)=DTSAT
DTDH(I,J)=0.
XM(I,J)=XTI
ALFA(I,J)=XTI/((1.-XTI)*VVFS/VVGS+XTI)
VV(I,J)=(1.-XTI)*VVFS+XTI*VVGS
DXDP=-(DHFPS+DHFGS*XTI)/HFGS
DVVDPX=DVVFPS+XTI*DVFGS
DVVP(I,J)=VFGS*DXDP+DVVDPX
DVVH(I,J)=VFGS/HFGS
XX=VFGS*DHFGS/HFGS
DNUHP(I,J)=(DVFGS-XX)/HFGS
DNUPP(I,J)=DXDP*(-2.*XX+DVFGS)
HF(I,J)=HFS
HG(I,J)=HGS
GOTO 150
40 IST(I,J)=3
ALFA(I,J)=1.
XM(I,J)=1.
HF(I,J)=HFS
HG(I,J)=H(I,J)
CALL S55198(H(I,J),P,T(I,J),R,DVVH(I,J),DVVP(I,J),DTDH(I,J),
1 DTDP(I,J))
DNUHP(I,J)=0.
DNUPP(I,J)=0.
VV(I,J)=1./R
IF(H(I,J).GE.H2)GOTO 50
X=(H(I,J)-HGS)/10.
T(I,J)=(1.-X)*TS+X*T2
VV(I,J)=(1.-X)*VVGS+X*VV2
DVVH(I,J)=(VV2-VVGS)/10.
DXDH=1./10.
DTDH(I,J)=(T2-TS)*DXDH
GOTO 150
50 IF(H(I,J).LE.H4)GOTO 150
X=(H(I,J)-1860.)/10.
T(I,J)=T4+(T4-T3)*X
VV(I,J)=VV4+(VV4-VV3)*X
DTDH(I,J)=(T4-T3)/10.
DVVH(I,J)=(VV4-VV3)/10.
DTDP(I,J)=DTP4+(DTP4-DTP3)*X
DVVP(I,J)=DVP4+(DVP4-DVP3)*X
150 M(I,J)=V(I,J)/VV(I,J)
U(I,J)=M(I,J)*H(I,J)-COEF*P*V(I,J)
DELH(I,J)=VV(I,J)-H(I,J)*DVVH(I,J)
DELP(I,J)=DVVP(I,J)+VV(I,J)*DVVH(I,J)*COEF
BB(I,J)=M(I,J)*DELP(I,J)
110 CONTINUE
100 CONTINUE
RETURN
END