60 lines
1.7 KiB
Fortran
60 lines
1.7 KiB
Fortran
SUBROUTINE PRSENT(R,T,FP,FS)
|
|
C ============================
|
|
C
|
|
C interpolates pressure and entropy from tables
|
|
C
|
|
INCLUDE 'IMPLIC.FOR'
|
|
COMMON/THERM/SL(330,100),PL(330,100)
|
|
COMMON/TABLTD/R1,R2,T1,T2,T12,T22,INDEX
|
|
common/tdedge/redge,pedge(100),sedge(100),cvedge(100),
|
|
& cpedge(100),gammaedge(100),tedge(100)
|
|
common/tdflag/JON
|
|
C
|
|
JON=0
|
|
RL = DLOG10(R)
|
|
ALPHA=T1+(RL-R1)/(R2-R1)*(T12-T1)
|
|
BETA=T2-T1+((T22-T12)-(T2-T1))*(RL-R1)/(R2-R1)
|
|
QL = (DLOG10(T) - ALPHA)/BETA
|
|
DELTA=(RL-R1)/(R2-R1)*FLOAT(INDEX-1)
|
|
JR = 1 + IDINT(DELTA)
|
|
JQ = 1 + IDINT(99.*QL)
|
|
IF(JR.LT.2) GO TO 300
|
|
IF(JR.GT.(INDEX-1)) GO TO 300
|
|
IF(JQ.LT.2) GO TO 300
|
|
IF(JQ.GT.99) GO TO 300
|
|
P = DELTA - (JR-1)
|
|
Q = 99.*QL - (JQ-1)
|
|
C interpolate:
|
|
FS = 0.5D0*Q*(Q-1.D0)*SL(JR,JQ-1)
|
|
1 + 0.5D0*P*(P-1.D0)*SL(JR-1,JQ)
|
|
2 + (1.D0+P*Q-P*P-Q*Q)*SL(JR,JQ)
|
|
3 + 0.5D0*P*(P-2.D0*Q+1.D0)*SL(JR+1,JQ)
|
|
4 + 0.5D0*Q*(Q-2.D0*P+1.D0)*SL(JR,JQ+1)
|
|
5 + P*Q*SL(JR+1,JQ+1)
|
|
FS = 10.D0**FS
|
|
C
|
|
FP = 0.5D0*Q*(Q-1.D0)*PL(JR,JQ-1)
|
|
1 + 0.5D0*P*(P-1.D0)*PL(JR-1,JQ)
|
|
2 + (1.D0+P*Q-P*P-Q*Q)*PL(JR,JQ)
|
|
3 + 0.5D0*P*(P-2.D0*Q+1.D0)*PL(JR+1,JQ)
|
|
4 + 0.5D0*Q*(Q-2.D0*P+1.D0)*PL(JR,JQ+1)
|
|
5 + P*Q*PL(JR+1,JQ+1)
|
|
FP = 10.D0**FP
|
|
RETURN
|
|
C
|
|
C off the table
|
|
C
|
|
300 CONTINUE
|
|
C
|
|
write(60,*) ' Off the table!'
|
|
C
|
|
JQ = min(98,max(JQ, 2))
|
|
JON = JQ
|
|
FP = pedge(JQ)*R*T/(redge*tedge(JQ))
|
|
FS = sedge(JQ) + 1.d0/(gammaedge(JQ)-1.d0)*
|
|
& dlog(FP/pedge(JQ)*(redge/R)**gammaedge(JQ))
|
|
write(60,*) JQ, R, T, FP, FS
|
|
C
|
|
RETURN
|
|
END
|