home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / LIBRY51.ZIP / LIBRY8A.DOC < prev    next >
Encoding:
Text File  |  1989-11-10  |  7.6 KB  |  286 lines
  1. .de
  2. .pa
  3.    EXAMPLE OF HOW TO USE AND EVEN REDEFINE THERMODYNAMIC PROPERTY ROUTINES
  4.  
  5.  
  6. $STORAGE:2
  7. $DEBUG
  8.       PROGRAM PTEST
  9. C
  10. C  test thermodynamic property routines
  11. C  developed by Dudley J. Benton, TVA Lab, Norris, (615) 632-1887
  12. C
  13. C  This shows how to call each of the major thermodynamic routines
  14. C  and how to use them to define something other than KKHM water.
  15. C
  16. C  If you remove the "*"s in column 1 at the bottom of the code and
  17. C  recompile you will get van der Waals EOS for steam (which, not
  18. C  surprisingly, doesn't work too well - especially for liquid
  19. C  states). Similarly, you can put in whatever EOS you want.
  20. C
  21.       IMPLICIT INTEGER*2(I-N),REAL*4(A-H,O-Z)
  22.       CHARACTER SUBSTN*12
  23.       COMMON/TPROPS/TMIN,TCRIT,TMAX,PMIN,PCRIT,PMAX,VMIN,VCRIT,VMAX,
  24.      &HMIN,HCRIT,HMAX,SMIN,SCRIT,SMAX,ZCRIT,RGAS,WMOL,SUBSTN
  25.       CHARACTER ANS,CBUF*80
  26.       DIMENSION BUF(2)
  27. C
  28.   100 CALL ERASE
  29.       WRITE(CBUF,1000) SUBSTN
  30.  1000 FORMAT('TESTING THERMODYNAMIC PROPERTIES: ',A12,'<')
  31.       CALL WRTTY(CBUF)
  32.       CALL WRTTY('<')
  33.       CALL WRTTY(' 1. PSAT(TSAT)<')
  34.       CALL WRTTY(' 2. TSAT(PSAT)<')
  35.       CALL WRTTY(' 3. P,H,S(T,V)<')
  36.       CALL WRTTY(' 4. V,H,S(T,P)<')
  37.       CALL WRTTY(' 5. VF,VG,HF,HG,SF,SG(TSAT)<')
  38.       CALL WRTTY(' 6. T,V,S(P,H)<')
  39.       CALL WRTTY(' 7. T,V,H(P,S)<')
  40.       CALL WRTTY('<')
  41.       CALL WRTTY('select one of the above (or RETURN)_')
  42. C
  43.       CALL READ1(ANS)
  44.       CALL ERASE
  45.       IF(ANS.EQ.'1') GO TO 200
  46.       IF(ANS.EQ.'2') GO TO 250
  47.       IF(ANS.EQ.'3') GO TO 300
  48.       IF(ANS.EQ.'4') GO TO 350
  49.       IF(ANS.EQ.'5') GO TO 400
  50.       IF(ANS.EQ.'6') GO TO 450
  51.       IF(ANS.EQ.'7') GO TO 500
  52.       IF(ANS.EQ.CHAR(13)) GO TO 999
  53.       CALL BEEP
  54.       GO TO 100
  55. C
  56.   200 CALL WRTTY('enter TSAT _')
  57.       CALL STRING(BUF,1,IER)
  58.       IF(IER.NE.0) GO TO 100
  59.       T=BUF(1)
  60.       P=FPSAT(T)
  61.       WRITE(CBUF,2000) P
  62.  2000 FORMAT('PSAT=',F13.5,'<')
  63.       CALL WRTTY(CBUF)
  64.       CALL WRTTY('<')
  65.       GO TO 200
  66. C
  67.   250 CALL WRTTY('enter PSAT _')
  68.       CALL STRING(BUF,1,IER)
  69.       IF(IER.NE.0) GO TO 100
  70.       P=BUF(1)
  71.       T=FTSAT(P)
  72.       WRITE(CBUF,2500) T
  73.  2500 FORMAT('TSAT=',F7.2,'<')
  74.       CALL WRTTY(CBUF)
  75.       CALL WRTTY('<')
  76.       GO TO 250
  77. C
  78.   300 CALL WRTTY('enter T,V _')
  79.       CALL STRING(BUF,2,IER)
  80.       IF(IER.NE.0) GO TO 100
  81.       T=BUF(1)
  82.       V=BUF(2)
  83.       CALL TV2PHS(T,V,P,H,S)
  84.       WRITE(CBUF,3000) P,H,S
  85.  3000 FORMAT('P=',F13.5,'  H=',F7.2,'  S=',F8.5,'<')
  86.       CALL WRTTY(CBUF)
  87.       CALL WRTTY('<')
  88.       GO TO 300
  89. C
  90.   350 CALL WRTTY('enter T,P _')
  91.       CALL STRING(BUF,2,IER)
  92.       IF(IER.NE.0) GO TO 100
  93.       T=BUF(1)
  94.       P=BUF(2)
  95.       CALL VOFTP(T,P,V,X,H,S,3)
  96.       WRITE(CBUF,3500) V,H,S
  97.  3500 FORMAT('V=',F13.5,'  H=',F7.2,'  S=',F8.5,'<')
  98.       CALL WRTTY(CBUF)
  99.       CALL WRTTY('<')
  100.       GO TO 350
  101. C
  102.   400 CALL WRTTY('enter TSAT _')
  103.       CALL STRING(BUF,1,IER)
  104.       IF(IER.NE.0) GO TO 100
  105.       TSAT=BUF(1)
  106.       CALL VOFTP(TSAT,PSAT,VF,X,HF,SF,1)
  107.       WRITE(CBUF,2000) PSAT
  108.       CALL WRTTY(CBUF)
  109.       WRITE(CBUF,4000) VF,HF,SF
  110.  4000 FORMAT('VF=',F10.5,'  HF=',F7.2,'  SF=',F8.5,'<')
  111.       CALL WRTTY(CBUF)
  112.       CALL VOFTP(TSAT,PSAT,VG,X,HG,SG,2)
  113.       WRITE(CBUF,4100) VG,HG,SG
  114.  4100 FORMAT('VG=',F10.5,'  HG=',F7.2,'  SG=',F8.5,'<')
  115.       CALL WRTTY(CBUF)
  116.       CALL WRTTY('<')
  117.       GO TO 400
  118. C
  119.   450 CALL WRTTY('enter P,H _')
  120.       CALL STRING(BUF,2,IER)
  121.       IF(IER.NE.0) GO TO 100
  122.       P=BUF(1)
  123.       H=BUF(2)
  124.       CALL TOFPH(T,P,V,X,H,S)
  125.       WRITE(CBUF,4500) T,V,X,S
  126.  4500 FORMAT('T=',F7.2,'  V=',F13.5,'  X=',F6.4,'  S=',F8.5,'<')
  127.       CALL WRTTY(CBUF)
  128.       CALL WRTTY('<')
  129.       GO TO 450
  130. C
  131.   500 CALL WRTTY('enter P,S _')
  132.       CALL STRING(BUF,2,IER)
  133.       IF(IER.NE.0) GO TO 100
  134.       P=BUF(1)
  135.       S=BUF(2)
  136.       CALL TOFPS(T,P,V,X,H,S)
  137.       WRITE(CBUF,5000) T,V,X,H
  138.  5000 FORMAT('T=',F7.2,'  V=',F13.5,'  X=',F6.4,'  H=',F7.2,'<')
  139.       CALL WRTTY(CBUF)
  140.       CALL WRTTY('<')
  141.       GO TO 500
  142. C
  143.   999 STOP
  144.       END
  145.       SUBROUTINE STRING(R,N,IER)
  146. C
  147. C  READ A STRING OF NUMBERS FROM THE TERMINAL
  148. C
  149.       IMPLICIT INTEGER*2(I-N),REAL*4(A-H,O-Z)
  150.       CHARACTER CBUF*20
  151.       DIMENSION R(N)
  152. C
  153.       IER=0
  154.       IF(N.LT.1) GO TO 100
  155. C
  156.       CALL READC(CBUF,20,IERR)
  157.       IF(IERR.NE.0) GO TO 100
  158. C
  159.       NBUF=NBUFC1(CBUF,20)
  160.       IF(NBUF.EQ.0) GO TO 100
  161. C
  162.       CALL DEC0DE(CBUF,NBUF,NCOL,R,N,IER)
  163.       GO TO 999
  164. C
  165.   100 IER=1
  166. C
  167.   999 RETURN
  168.       END
  169. *     SUBROUTINE TV2PHS(T,V,P,H,S)
  170. C
  171. C  P,H,S AS FUNCTION OF T,V
  172. C
  173. C     P....... PRESSURE [PSIA]
  174. C     H....... ENTHALPY [BTU/LBM]
  175. C     S....... ENTROPY [BTU/LBM/R]
  176. C     T....... TEMPERATURE [F]
  177. C     V....... SPECIFIC VOLUME [CU.FT/LBM]
  178. C
  179. *     IMPLICIT INTEGER*2(I-N),REAL*4(A-H,O-Z)
  180. *     CHARACTER SUBSTN*12
  181. *     COMMON/TPROPS/TMIN,TCRIT,TMAX,PMIN,PCRIT,PMAX,VMIN,VCRIT,VMAX,
  182. *    &HMIN,HCRIT,HMAX,SMIN,SCRIT,SMAX,ZCRIT,RGAS,WMOL,SUBSTN
  183. *     LOGICAL*2 FIRST
  184. *     COMMON/VANDER/FIRST,AGAS,BGAS,CGAS
  185. C
  186. *     IF(T.LT.TMIN.OR.V.LT.VMIN) THEN
  187. *       P=PMAX
  188. *       H=HMAX
  189. *       S=SMAX
  190. *       GO TO 999
  191. *     ENDIF
  192. *     IF(T.GT.TMAX.OR.V.GT.VMAX) THEN
  193. *       P=PMIN
  194. *       H=HMIN
  195. *       S=SMIN
  196. *       GO TO 999
  197. *     ENDIF
  198. C
  199. *     CALL SETPRP
  200. C
  201. C  this is van der Waals' Equation of State
  202. C
  203. *     P=(RGAS*(T+459.67)/(V-BGAS)-AGAS/V/V)/144.
  204. *     H=HCRIT+(144.*(P*V-PCRIT*VCRIT)-AGAS*(1./V-1./VCRIT))/778.3
  205. *    &+CGAS*(T-TCRIT)
  206. *     S=SCRIT+ALOG((V-BGAS)/(VCRIT-BGAS))*RGAS/778.3
  207. *    &+CGAS*ALOG((T+459.67)/(TCRIT+459.67))
  208. C
  209. * 999 RETURN
  210. *     END
  211. *     FUNCTION FPSAT(TSAT)
  212. C
  213. C  PSAT AS A FUNCTION OF TSAT
  214. C
  215. *     IMPLICIT INTEGER*2(I-N),REAL*4(A-H,O-Z)
  216. *     CHARACTER SUBSTN*12
  217. *     COMMON/TPROPS/TMIN,TCRIT,TMAX,PMIN,PCRIT,PMAX,VMIN,VCRIT,VMAX,
  218. *    &HMIN,HCRIT,HMAX,SMIN,SCRIT,SMAX,ZCRIT,RGAS,WMOL,SUBSTN
  219. C
  220. C  BELOW TRIPLE POINT
  221. C
  222. *     IF(TSAT.GT.TMIN) GO TO 100
  223. *     FPSAT=PMIN
  224. *     GO TO 999
  225. C
  226. C  ABOVE CRITICAL POINT
  227. C
  228. * 100 IF(TSAT.LT.TCRIT) GO TO 200
  229. *     FPSAT=PCRIT
  230. *     GO TO 999
  231. C
  232. C  this is not the right saturation pressure relationship for van der
  233. C  Waals so it won't come out right, but the correct one is much more
  234. C  complicated and requires iterative solution of simultaneous nonlinear
  235. C  equations
  236. C
  237. * 200 FPSAT=PCRIT*EXP((TCRIT-TSAT)/(TCRIT-212.)*ALOG(14.7/PCRIT))
  238. C
  239. * 999 RETURN
  240. *     END
  241. *     SUBROUTINE SETPRP
  242. C
  243. C  put anything in here you want to initialize
  244. C
  245. *     IMPLICIT INTEGER*2(I-N),REAL*4(A-H,O-Z)
  246. *     CHARACTER SUBSTN*12
  247. *     COMMON/TPROPS/TMIN,TCRIT,TMAX,PMIN,PCRIT,PMAX,VMIN,VCRIT,VMAX,
  248. *    &HMIN,HCRIT,HMAX,SMIN,SCRIT,SMAX,ZCRIT,RGAS,WMOL,SUBSTN
  249. *     LOGICAL*2 FIRST
  250. *     COMMON/VANDER/FIRST,AGAS,BGAS,CGAS
  251. C
  252. *     IF(.NOT.FIRST) GO TO 999
  253. *     FIRST=.FALSE.
  254. *     RGAS=1545.3/WMOL
  255. *     BGAS=RGAS*(TCRIT+459.67)/8./PCRIT/144.
  256. *     AGAS=27.*RGAS*(TCRIT+459.67)*BGAS/8.
  257. *     VCRIT=3.*BGAS
  258. *     ZCRIT=3./8.
  259. *     VMIN=1.01*BGAS
  260. C
  261. * 999 RETURN
  262. *     END
  263. *     BLOCK DATA
  264. *     IMPLICIT INTEGER*2(I-N),REAL*4(A-H,O-Z)
  265. *     CHARACTER SUBSTN*12
  266. *     COMMON/TPROPS/TMIN,TCRIT,TMAX,PMIN,PCRIT,PMAX,VMIN,VCRIT,VMAX,
  267. *    &HMIN,HCRIT,HMAX,SMIN,SCRIT,SMAX,ZCRIT,RGAS,WMOL,SUBSTN
  268. *     LOGICAL*2 FIRST
  269. *     COMMON/VANDER/FIRST,AGAS,BGAS,CGAS
  270. C
  271. C  initialize variables in /TPROPS/
  272. C
  273. *     DATA SUBSTN/'vd Waals H2O'/
  274. *     DATA TMIN,PMIN,VMIN,HMIN,SMIN/32.018,.08866,.015,0.,-.005/
  275. *     DATA TMAX,PMAX,VMAX,HMAX,SMAX/2400.,20000.,10000.,2400.,3./
  276. *     DATA TCRIT,PCRIT,VCRIT,HCRIT,SCRIT/705.44,3203.6,.050531,
  277. *    &902.5,1.058/
  278. *     DATA WMOL/18.016/
  279. C
  280. C  initialize variables in /VANDER/
  281. C
  282. *     DATA FIRST,CGAS/.TRUE.,.445/
  283. C
  284. *     END
  285. .ee
  286.