|
|
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: 6243 (0x1863)
Types: TextFile
Names: »S00096.f«
└─⟦db229ac7e⟧ Bits:30007240 EUUGD20: SSBA 1.2 / AFW Benchmarks
└─⟦this⟧ »EUUGD20/AFUU-ssba1.21/ssba1.21E/doduc/S00096.f«
└─⟦this⟧ »EUUGD20/AFUU-ssba1.21/ssba1.21F/doduc/S00096.f«
SUBROUTINE S00096(PP,HF,HG,T,VF,VG,DVFDP,DVGDP,DHFDP,DHGDP,
1 DTSAT)
IMPLICITDOUBLEPRECISION(A-H,O-Z)
DATA A0,A1,A2,A3,A4,A5/
1 0.0168896951589D+00,89.7563708097D-7, -95.3392512069D-10,
2 76.4433456620D-13, -28.1881717776D-16, 40.5307653492D-20/
DATA B0,B1,B2,B3,B4,B5,B6,B7/
1 300.12985208D+00, -252.638119855D+00, 97.9981947188D+00,
2 -22.4207151267D+00, 3.22500188803D+00, -0.288260253918D+00,
3 .0146831531571D+00,-32.6352964583D-5/
DATA C0,C1,C2,C3,C4/
1 71.5171806566D+00, 56.4133540077D+00, -3.73181288419D+00,
2 .737563606575D+00, .00809293492177D+00/
DATA D0,D1,D2,D3,D4,D5/
1 -501.911804844D+00, 643.013652461D+00, -254.053681062D+00,
2 53.4172368776D+00, -5.47296691662D+00, .227574393371D+00/
DATA E0,E1,E2,E3,E4,E5,E6/
1-983.676282822D+00, 2649.64781997D+00, -1365.75884763D+00,
2 373.419845898D+00, -56.7876969779D+00, 4.56687019374D+00,
3 -.152528030277D+00/
DATA DD0,DD1,DD2,DD3/
1 -310295.234948D+00, 121447.323002D+00, -15841.5422032D+00,
2 690.18449767D+00/
DATA EE0,EE1,EE2,EE3/
1 464392.898586D+00, -181216.034989D+00, 23651.1207875D+00,
2 -1029.9067531D+00/
DATA CC0,CC1,CC2,CC3,CC4,CC5 /
1-0.603754D+00, -0.195861D+00, 1.90488D-2,
2-8.98731D-4, 1.93828D-5, -1.59293D-7 /
DATA AA0,AA1,AA2,AA3,AA4,AA5 /
1-9.62997D-6, -6.26013D-7, 5.86957D-8,
2-2.84574D-9, 6.23361D-11, -5.23200D-13/
DATA BB0,BB1,BB2,BB3 /
1 0.834155D+00, 392.019D+00, -173.129D+00, 161.554D+00/
DATA DF0,DF1,DF2,DF3,DF4,DF5 /
1-0.640476D+00, -0.194453D+00, 1.89171D-2,
2-8.92998D-4, 1.92670D-5, -1.58399D-7 /
DATA EG0,EG1,EG2,EG3,EG4,EG5 /
1-9.33315D-2, -8.71131D-2, 8.43181D-3,
2-3.95457D-4, 8.50339D-6, -6.97062D-8 /
DATA TA,VFA,HFA,HGA/281.03D+00,0.017269D+00,250.24D+00,1174.4D+0/
P = PP
IF(P .LT. 41.) GO TO 3500
W = DLOG(DABS(P))
RP = 1./P
IF(P .GE. 2005.)GO TO 100
HF = D0 + W*(D1+W*(D2+W*(D3+W*(D4+W*D5))))
HG = E0 + W*(E1+W*(E2+W*(E3+W*(E4+W*(E5+W*E6)))))
IF(P .LE. 1995.)GO TO 2000
FCTR =(P - 1995.)/10.
HF1 = DD0 + W*(DD1+W*(DD2+W*DD3))
HG1 = EE0 + W*(EE1+W*(EE2+W*EE3))
HF = HF*(1.-FCTR)+ HF1*FCTR
HG = HG*(1.-FCTR)+ HG1*FCTR
GO TO 2000
100 HF = DD0 + W*(DD1+W*(DD2+W*DD3))
HG = EE0 + W*(EE1+W*(EE2+W*EE3))
2000 CONTINUE
2500 VF = A0 + P*(A1+P*(A2+P*(A3+P*(A4+P*A5))))
VG = B0 + W*(B1+W*(B2+W*(B3+W*(B4+W*(B5+W*(B6+W*B7))))))
T = C0 + W*(C1+W*(C2+W*(C3+W*C4)))
DTSAT=(C1+W*(2.*C2+W*(3.*C3+4.*C4*W)))/P
DVFDP = A1 + P*(2.*A2+P*(3.*A3+P*(4.*A4+P*5.*A5)))
DVGDP = RP*(B1 + W*(2.*B2+W*(3.*B3+W*(4.*B4+W*(5.*B5+W*(6.*B6
1 +W*7.*B7))))))
IF(P .GE. 2005.) GO TO 2600
DHFDP = RP*(D1 + W*(2.*D2+W*(3.*D3+W*(4.*D4+W*5.*D5))))
DHGDP = RP*(E1 + W*(2.*E2+W*(3.*E3+W*(4.*E4+W*(5.*E5+W*6.*E6)))))
IF(P .LE. 1995.) GO TO 3000
FCTR =(P - 1995.)/10.
DHFDP1 = RP*(DD1+W*(2.*DD2+W*3.*DD3))
DHGDP1 = RP*(EE1+W*(2.*EE2+W*3.*EE3))
DHFDP = DHFDP*(1.-FCTR) + DHFDP1*FCTR
DHGDP = DHGDP*(1.-FCTR) + DHGDP1*FCTR
GO TO 3000
2600 CONTINUE
DHFDP = RP*(DD1+ W*(2.*DD2+W*3.*DD3))
DHGDP = RP*(EE1+ W*(2.*EE2+W*3.*EE3))
3000 RETURN
3500 IF(P .LT. 40) GO TO 4000
FCTR = P - 40.
W = DLOG(DABS(P))
RP = 1.0/P
X = 50. - PP
HF1 = D0 + W*(D1+W*(D2+W*(D3+W*(D4+W*D5))))
HG1 = E0 + W*(E1+W*(E2+W*(E3+W*(E4+W*(E5+W*E6)))))
VF1= A0 + P*(A1+P*(A2+P*(A3+P*(A4+P*A5))))
VG1 = B0 + W*(B1+W*(B2+W*(B3+W*(B4+W*(B5+W*(B6+W*B7))))))
T1 = C0 + W*(C1+W*(C2+W*(C3+W*C4)))
T = TA+ X*(CC0 + X*(CC1 + X*(CC2 + X*(CC3 + X*(CC4 + X*CC5)))))
T2=T
VF=VFA+ X*(AA0 + X*(AA1 + X*(AA2 + X*(AA3 + X*(AA4 + X*AA5)))))
VG = BB0 + RP*(BB1 + RP*(BB2 + RP*BB3))
HF=HFA+ X*(DF0 + X*(DF1 + X*(DF2 + X*(DF3 + X*(DF4 + X*DF5)))))
HG=HGA+ X*(EG0 + X*(EG1 + X*(EG2 + X*(EG3 + X*(EG4 + X*EG5)))))
T = T*(1.0 - FCTR) + T1*FCTR
DT1DP= (C1+W*(2.*C2+W*(3.*C3+4.*C4*W)))/P
DT2DP=-(CC0+X*(2.*CC1+X*(3.*CC2+X*(4.*CC3+X*(5.*CC4+6.*CC5*X)))))
DTSAT=DT1DP*FCTR+(1.-FCTR)*DT2DP+T1-T2
VF = VF*(1.0 - FCTR) + VF1*FCTR
VG = VG*(1.0 - FCTR) + VG1*FCTR
HF = HF*(1.0 - FCTR) + HF1*FCTR
HG = HG*(1.0 - FCTR) + HG1*FCTR
DVFDP1= A1 + P*(2.*A2+P*(3.*A3+P*(4.*A4+P*5.*A5)))
DVGDP1= RP*(B1 + W*(2.*B2+W*(3.*B3+W*(4.*B4+W*(5.*B5+W*(6.*B6
1 +W*7.*B7))))))
DHFDP1= RP*(D1 + W*(2.*D2+W*(3.*D3+W*(4.*D4+W*5.*D5))))
DHGDP1= RP*(E1 + W*(2.*E2+W*(3.*E3+W*(4.*E4+W*(5.*E5+W*6.*E6)))))
DVFDP = -AA0 - X*(2.*AA1 + X*(3.*AA2 + X*(4.*AA3 + X*(5.*AA4 + X
1*6.*AA5))))
DVGDP = -RP**2*(BB1 + RP*(2.*BB2 + RP*3.*BB3))
DHFDP = -DF0 - X*(2.*DF1 + X*(3.*DF2 + X*(4.*DF3 + X*(5.*DF4 + X
1*6.*DF5))))
DHGDP = -EG0 - X*(2.*EG1 + X*(3.*EG2 + X*(4.*EG3 + X*(5.*EG4 + X
1*6.*EG5))))
DVFDP = DVFDP*(1.0 - FCTR) + DVFDP1*FCTR
DVGDP = DVGDP*(1.0 - FCTR) + DVGDP1*FCTR
DHFDP = DHFDP*(1.0 - FCTR) + DHFDP1*FCTR
DHGDP = DHGDP*(1.0 - FCTR) + DHGDP1*FCTR
RETURN
4000 CONTINUE
c PRINT11111,PP,TA,CC0,CC1,VFA,AA0,AA1,BB0,HFA,HGA,DF0,EG0
11111 FORMAT(10F13.3)
X= 50. - PP
RP = 1./PP
T = TA+ X*(CC0 + X*(CC1 + X*(CC2 + X*(CC3 + X*(CC4 + X*CC5)))))
DTSAT=-(CC0+X*(2.*CC1+X*(3.*CC2+X*(4.*CC3+X*(5.*CC4+6.*CC5*X)))))
VF=VFA+ X*(AA0 + X*(AA1 + X*(AA2 + X*(AA3 + X*(AA4 + X*AA5)))))
VG = BB0 + RP*(BB1 + RP*(BB2 + RP*BB3))
HF=HFA+ X*(DF0 + X*(DF1 + X*(DF2 + X*(DF3 + X*(DF4 + X*DF5)))))
HG=HGA+ X*(EG0 + X*(EG1 + X*(EG2 + X*(EG3 + X*(EG4 + X*EG5)))))
DVFDP = -AA0 - X*(2.*AA1 + X*(3.*AA2 + X*(4.*AA3 + X*(5.*AA4 + X
1*6.*AA5))))
DVGDP = -RP**2*(BB1 + RP*(2.*BB2 + RP*3.*BB3))
DHFDP = -DF0 - X*(2.*DF1 + X*(3.*DF2 + X*(4.*DF3 + X*(5.*DF4 + X
1*6.*DF5))))
DHGDP = -EG0 - X*(2.*EG1 + X*(3.*EG2 + X*(4.*EG3 + X*(5.*EG4 + X
1*6.*EG5))))
RETURN
END