home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / h / house_ii.zip / FOR / PSY.FOR < prev    next >
Text File  |  1991-08-15  |  7KB  |  271 lines
  1.       SUBROUTINE PSY(IPSY,TDB,TWB,TDP,RH,W,H)
  2.       LOGICAL SI
  3. C
  4. C  THIS ROUTINE EVALUATES PSYCHOMETRIC CONDITIONS FOR AIR AT 1 ATM
  5. C  REFER TO ASHRAE 1977 FUNDAMENTALS, CHAPTER 5
  6. C   BY F.E.JAKOB, BATTELLE (ABOUT 1984)
  7. C  IPSY IS A KEY INDICATOR TO THE PROGRAM.
  8. C  GIVEN ANY TWO PSYCHOMETRIC VARIABLES, THE OTHER 4 ARE EVALUATED.
  9. C  THE TABLE BELOW SPECIFIES THE VALUE OF IPSY REQUIRED FOR EACH
  10. C  PAIR COMBINATION.  NOTE THAT TDB IS ALWAYS REQUIRED.
  11. C
  12. C  IF(IPSY.GT.ZERO) THEN THE INCOMING DATA IS ASSUMED TO BE IN SI UNITS
  13. C                   AND THEY ARE CONVERTED IN ORDER TO BE COMPATIBLE
  14. C                   WITH THE ASHRAE EQUATIONS PROGRAMMED HERE.
  15. C                   THE VARIABLES ARE CONVERTED BACK TO SI ON OUTPUT.
  16. C
  17. C  IF(IPSY.LT.ZERO) THEN THE INCOMING DATA IS ASSUMED TO BE
  18. C                   IN ENGLISH UNITS. NO CONVERSIONS ARE MADE
  19. C
  20. C     IPSY   DESCRIPTION
  21. C     ****   ************************
  22. C      +-1    TDB AND TWB SPECIFIED
  23. C      +-2    TDB AND TDP SPECIFIED
  24. C      +-3    TDB AND RH  SPECIFIED
  25. C      +-4    TDB AND  W  SPECIFIED
  26. C      +-5    TDB AND  H  SPECIFIED
  27. C
  28. C  UNITS : 
  29. C        VARIABLE  UNITS
  30. C        ********  **********************************************
  31. C        ********  (IPSY.LT.ZERO)************(IPSY.GT.ZERO)******
  32. C        ********  **********************************************
  33. C          TDB     DEG F                     DEG C
  34. C          TWB     DEG F                     DEG C
  35. C          TDP     DEG F                     DEG C
  36. C           RH     PERCENT (%)               PERCENT (%)
  37. C            W     (LBM H20)/(LBM AIR)       (KG H20)/(KG AIR)
  38. C            H     (BTU)/(LBM OF DRY AIR)    KJ/(KG OF DRY AIR)
  39. C
  40. C        PRESSURE  ATMOSPHERES  (29.92 INCHES OF HG PER ATM)
  41. C
  42. C
  43. C
  44. C  RELATIVE HUMIDITY (EQ 25): 
  45.       FRH(W,WS,PWS)=(W/WS)/(1.0-(1.0-W/WS)*PWS/P)*100.
  46. C
  47. C  PARTIAL VAPOR PRESSURE (NOT SATURATION VP) (EQ 36): 
  48.       FPW(W)=P*W/(0.62198+W)
  49. C
  50. C  HUMIDITY RATIO (EQ 32 SOLVED FOR W): 
  51.       FW32(TDB,H)=(H-0.240*TDB)/(1061.0+0.444*TDB)
  52. C
  53. C  ENTHALPY (EQ 32): 
  54.       FH(TDB,W)=0.240*TDB+W*(1061.0+0.444*TDB)
  55. C
  56. C  DEW POINT (PW REQUIRED IN INCHES OF HG) (EQ 37): 
  57.       FTDP(PW)=((ALOG(PW)*1.8893)+30.5790)*ALOG(PW)+79.047
  58. C
  59. C  TEMPERATURE CONVERSIONS
  60.       FTOC(T) = (T - 32.0) / 1.8
  61.       CTOF(T) = T * 1.8 + 32.0
  62. C
  63. C
  64.       P=1.0
  65.       SI = .FALSE.
  66.       IF(IPSY.GT.0) SI = .TRUE.
  67.       IF(.NOT.SI) GO TO 2
  68.       TDB = CTOF(TDB)
  69.       IF( IABS(IPSY).EQ.1 ) TWB = CTOF(TWB)
  70.       IF( IABS(IPSY).EQ.2 ) TDP = CTOF(TDP)
  71.       IF( IABS(IPSY).EQ.5 ) H = H / 2.3278
  72.     2 IF(IABS(IPSY).GE.1.AND.IABS(IPSY).LE.5) GO TO 5
  73.       WRITE(60,1000) IPSY
  74.  1000 FORMAT(1H0,'!!!!!! TROUBLE!, IPSY=',I5,' IN SUBROUTINE PSY')
  75.       RETURN
  76.     5 GO TO (10,20,30,40,50) IABS(IPSY)
  77. C
  78.    10 CONTINUE
  79.       IF(TWB .GT. TDB)THEN
  80.          WRITE(60,1010) TWB,TDB
  81.          TWB=TDB-.001
  82.          ENDIF
  83.       PWSS=FPWS(TWB)
  84.       WSS=FW22(PWSS)
  85.       W=FW35(TDB,TWB,WSS)
  86.       PWS=FPWS(TDB)
  87.       WS=FW22(PWS)
  88.       RH=FRH(W,WS,PWS)
  89.       H=FH(TDB,W)
  90.       PW=FPW(W)
  91.       TDP=FTDP(PW*29.92)
  92.       GO TO 100
  93. C
  94.    20 CONTINUE
  95.       IF(TDP .GT. TDB)THEN
  96.          WRITE(60,1020) TDP,TDB
  97.          TDP=TDB-.001
  98.          ENDIF
  99.       PW=FPWS(TDP)
  100.       W=FW22(PW)
  101.       PWS=FPWS(TDB)
  102.       WS=FW22(PWS)
  103.       RH=FRH(W,WS,PWS)
  104.       H=FH(TDB,W)
  105.       TWB=FTWB(TDB,RH,W)
  106.       GO TO 100
  107. C
  108.    30 CONTINUE
  109.       IF( RH.LT.-0.001.OR. RH.GT.100.001)THEN
  110.          IF(RH.LT.-0.001)THEN
  111.            WRITE(60,1030)RH,TDB
  112.            RH=0.+.001
  113.            ENDIF
  114.          IF(RH.GT.100.001)THEN
  115.            WRITE(60,1040)RH,TDB
  116.            RH=99.999
  117.            ENDIF
  118.          ENDIF
  119.       PWS=FPWS(TDB)
  120.       PW=PWS*RH/100.0
  121.       W=FW22(PW)
  122.       WS=FW22(PWS)
  123.       H=FH(TDB,W)
  124.       TDP=FTDP(PW*29.92)
  125.       TWB=FTWB(TDB,RH,W)
  126.       GO TO 100
  127. C
  128.    40 CONTINUE
  129.       PWS=FPWS(TDB)
  130.       PW=FPW(W)
  131.       RH=PW/PWS*100.0
  132.       IF(RH .LE. 100.001) GO TO 45
  133.       RH=99.999
  134.       GO TO 30
  135.    45 CONTINUE
  136.       WS=FW22(PWS)
  137.       H=FH(TDB,W)
  138.       TDP=FTDP(PW*29.92)
  139.       TWB=FTWB(TDB,RH,W)
  140.       GO TO 100
  141. C
  142.    50 CONTINUE
  143.       PWS=FPWS(TDB)
  144.       W=FW32(TDB,H)
  145.       IF(W .LT. 0.00001) W=0.00001
  146.       PW=FPW(W)
  147.       RH=PW/PWS*100.0
  148.       IF(RH .LE. 100.001) GO TO 55
  149.       RH=99.999
  150.       GO TO 30
  151.    55 CONTINUE
  152.       WS=FW22(PWS)
  153.       TDP=FTDP(PW*29.92)
  154.       TWB=FTWB(TDB,RH,W)
  155.       GO TO 100
  156. C
  157.   100 CONTINUE
  158.       IF(.NOT.SI) RETURN
  159.       TDB = FTOC(TDB)
  160.       TWB = FTOC(TWB)
  161.       TDP = FTOC(TDP)
  162.       H = H * 2.3271
  163.       RETURN
  164.  1010 FORMAT(1H ,'TROUBLE IN PSY: TWB = ',G13.3,' > TDB= ',G13.3)
  165.  1020 FORMAT(1H ,'TROUBLE IN PSY: TDP = ',G13.3,' > TDB= ',G13.3)
  166.  1030 FORMAT(1H ,'TROUBLE IN PSY: RH = ',G13.3,' < 0., TDB= ',G13.3)
  167.  1040 FORMAT(1H ,'TROUBLE IN PSY: RH = ',G13.3,' > 100., TDB= ',G13.3)
  168.       END
  169.       FUNCTION FTWB(TDB,RH,W)
  170. C
  171. C  THIS ROUTINE ITERATIVLY SOLVES THE
  172. C  WET BULB TEMPERATURE EQUATION
  173. C
  174. C     VARIABLE  UNITS
  175. C     ********  ************************
  176. C       TDB     DEG F
  177. C        RH     PERCENT
  178. C         W     (LBM H20)/LBM AIR)
  179. C
  180.       DATA LIMIT /20/ , XL100 /0.1/
  181. C
  182. C  EMPIRICAL APPROXIMATION FOR WET BULB TEMPERATURE
  183. C  (USED FOR INITIAL GUESS)
  184.       FTWBG(TDB,RH)=9.64*EXP(-0.05*RH)+
  185.      + (0.15+0.18*ALOG(RH))*TDB
  186. C
  187. C  WET BULB TEMPERATURE (EQ 35 SOLVED FOR T*=TWB): 
  188.       FTWBN(TDB,W,WSS)=(1093.0*(W-WSS)+
  189.      + (0.444*W+0.240)*TDB)/
  190.      + (W+0.240-0.556*WSS)
  191. C
  192. C  HUMIDITY RATIO (EQ 23): 
  193.       FW(PWS)=0.62198*PWS/(P-PWS)
  194. C-------------------------------------------------------------
  195. C
  196.       IF(ABS(RH - 100.).LE.0.01) GO TO 200
  197.       IF(RH.LT.-0.001 .OR. RH.GT.100.001 )THEN
  198.         IF(RH.LT.-.001)THEN
  199.           RH=0.001
  200.         ELSE IF (RH.GT.100.01)THEN
  201.           RH=99.999
  202.           ENDIF
  203.         ENDIF
  204.       P=1.0
  205.       TWBO=TDB+5.0
  206.       TWBNO=FTWBG(TWBO,RH)
  207.       TWB=TDB
  208.       TWBN=FTWBG(TWB,RH)
  209. C
  210.       DO 100 I100=1,LIMIT
  211.       SLOPE=(TWBN-TWBNO)/(TWB-TWBO)
  212.       XINT=TWBN-SLOPE*TWB
  213.       TWBO=TWB
  214.       TWBNO=TWBN
  215.       TWB=XINT/(1.0-SLOPE)
  216.       PWSS=FPWS(TWB)
  217.       WSS=FW(PWSS)
  218.       TWBN=FTWBN(TDB,W,WSS)
  219.   100 IF(ABS(TWB-TWBN).LE.XL100) GO TO 110
  220. C
  221.       IF(I100.GE.LIMIT) WRITE(60,1000) I100,TDB,RH,W,
  222.      + TWBO,TWBNO,TWB,TWBN,SLOPE,XINT
  223.       STOP 'FTWB CONVERGANCE PROBLEM'
  224. C
  225.   110 FTWB=TWBN
  226.       RETURN
  227.   200 CONTINUE
  228.       FTWB=TDB
  229.       RETURN
  230.  1000 FORMAT(1H0, I10, 3G10.4, (/1X,2G10.4) )
  231.  1010 FORMAT(1H0,'TROUBLE IN FTWB',3G10.3)
  232.       END
  233.       FUNCTION FPWS(TF)
  234. C
  235. C  EVALUATE THE SATURATION PRESSURE OF
  236. C  WATER VAPOR.
  237. C
  238. C  TF IS EXPECTED IN DEG F
  239. C
  240. C
  241. C  KEENAN, KEYES, HILL, MOORE FORMULA (EQ 5)
  242. C
  243.       DIMENSION F(8)
  244.       DATA F/-741.9242,-29.72100,-11.55286,
  245.      + -0.8685635,0.1094098,0.439993,
  246.      + 0.2520658,0.05218684/
  247. C
  248.       TC=(TF-32.0)/1.8
  249.       TK=TC + 273.15
  250.       SUM=F(1)
  251. C
  252.       DO 10 I10=2,8
  253.    10 SUM=F(I10)*(0.65-0.01*TC)**(I10-1)+SUM
  254.       FPWS=217.99*EXP(0.01/TK*(374.136-TC)*SUM)
  255.       RETURN
  256.       END
  257.       FUNCTION FW22(PW)
  258. C  HUMIDITY RATIO (EQ 22): 
  259.       DATA P/1./
  260.       FW22=0.62198*PW/(P-PW)
  261.       RETURN
  262.       END
  263.       FUNCTION FW35(TDB,TWB,WSS)
  264. C  HUMIDITY RATIO (EQ 35): 
  265.       FW35=((1093.0-0.556*TWB)*WSS
  266.      + -0.240*(TDB-TWB))/(1093.0+0.444*TDB-TWB)
  267.       RETURN
  268.       END
  269.       
  270. C
  271.