SUBROUTINE TYPE79 (TIME,XIN,OUT,T,DTDT,PAR,INFO,ICNTRL,*) C************************************************************************ C* Copyright ASHRAE A Toolkit for Primary HVAC System Energy C* Calculation C*********************************************************************** C* SUBROUTINE: TYPE79 (SCOMPLID) C* C* LANGUAGE: FORTRAN 77 C* C* PURPOSE: Identification of the pressure jump C* encountered by the fluid by-passed in the C* screw compressor working in part-load C* (compressor alone) C*********************************************************************** C* INPUT VARIABLES C* Ifluid Selection of the refrigerant (-) C* If Ifluid C* =1: Refrigerant 12 C* =2: Refrigerant 134a C* =3: Refrigerant 114 C* =4: Refrigerant 22 C* =5: Refrigerant 502 C* =6: Refrigerant 717 (Ammonia) C* xin(1) (-) C* Tev Evaporating temperature (K) C* xin(2) (øC) C* Tcd Condensing temperature (K) C* xin(3) (øC) C* DTsupheat Superheating in the evaporator (same in part-load (K) C* then in full-load) C* xin(4) (øC) C* DTsubcool Subcooling in the condenser (same in part-load (K) C* then in full-load) C* xin(5) (øC) C* PLorFL =1 if the user knows the power consumed by the (-) C* compressor working in part-load regime at the C* given evaporating and condensing temperatures; C* =2 if the user only knows the power comsumed by C* the compressor working in full-load regime at C* the given evaporating and condensing temperatures. C* xin(6) (-) C* W If PLorFL (W) C* =1: power consumed by the compressor working in C* part-load regime at the given evaporating and C* condensing temperatures C* =2: power consumed by the compressor working in C* full-load regime at the given evaporating and C* condensing temperatures C* xin(7) (kJ/hr) C* Pev If PLorFL (W) C* =1: cooling capacity of the compressor in C* part-load regime at the given evaporating and C* condensing temperatures C* =2: cooling capacity of the compressor in C* full-load regime at the given evaporating and C* condensing temperatures C* xin(8) (kJ/hr) C* PevRatio Ratio of the cooling capacity in part-load (-) C* to the cooling capacity in full-load regime C* at the same evaporating and condensing temperatures C* ( 0.2 < PevRatio < 1 ; for example, PevRatio=0.5 C* if PLorFL=2) C* xin(9) (-) C* Mismatch = 0: the internal volume ratio is equal to the (-) C* system volume ratio C* = 1: the internal volume ratio is NOT equal to C* the system volume ratio C* xin(10) (-) C* vratio Value of the internal volume ratio (0 if Mismatch=0) C* xin(11) (-) C* C* OUTPUT VARIABLES C* Vpumping Refrigerant volume flow rate by-passed when (m**3/s) C* the screw compressor is working in part-load C* out(1) (m**3/hr) C* dpPumping Pressure jump encountered by the fluid (Pa) C* by-passed when the screw compressor is working C* in part-load C* out(2) (atm) C* ErrDetec This variable is equal to 1 if the routine does (-) C* not converge C* out(3) (-) C* C* PARAMETERS C* Losses Constant part of the electromechanical losses (W) C* par(1) (kJ/hr) C* Alpha Loss factor allowing to define another (-) C* electromechanical loss which is assumed to be C* proportional to the internal power C* par(2) (-) C* VsFL Refrigerant volume flow rate at the (m**3/s) C* beginning of the compression in full-load regime C* par(3) (m**3/hr) C* Al Leakage area (m**2) C* par(4) (m**2) C* C* REFRIGERANT PROPERTIES C* To Reference temperature (K) C* cpliq Mean specific heat in saturated liquid state (J/kg/K) C* hfo Enthalpy of the saturated liquid at the (J/kg) C* reference temperature C* cpvap Mean specific heat at constant pressure (J/kg/K) C* in superheated vapor state for saturation C* temperatures ranging from 253 K to 283 K C* cpvapcd Mean specific heat at constant pressure (J/kg/K) C* in superheated vapor state for saturation C* temperatures ranging from 303 K to 333 K C* hfgb Vaporization enthalpy at standard boiling (J/kg) C* point (101325 Pa) C* Tb Standard boiling temperature (K) C* Tc Critical temperature (K) C* b Coefficient used in the calculation of the (-) C* vaporization enthalpy C* r Gas constant (J/kg/K) C* Zeta Mean compressibility factor for saturation (-) C* temperatures ranging from 253 K to 283 K C* Zetacd Mean compressibility factor for saturation (-) C* temperatures ranging from 303 K to 333 K C* Gamma Mean isentropic coefficient (-) C* Acl First coefficient in the Clausius-Clapeyron (-) C* equation C* Bcl Second coefficient in the Clausius-Clapeyron (K) C* equation C*********************************************************************** C MAJOR RESTRICTIONS: The surrounding heat exchanges are C neglected. C An internal leakage is taken into account. C Perfect gas properties are used. C C DEVELOPER: Jean Lebrun C Jean-Pascal Bourdouxhe C Marc Grodent C University of LiŠge, Belgium C C DATE: March 1, 1995 C C SUBROUTINE CALLED: PROPERTY C LINKCK C*********************************************************************** C INTERNAL VARIABLES: C p1 Evaporating pressure (Pa) C p2 Condensing pressure (Pa) C MfrRefPl Refrigerant mass flow rate in part-load (kg/s) C T1 Temperature at the evaporator exhaust (K) C T3 Temperature at the condenser exhaust (K) C dhfg Vaporization enthalpy (J/kg) C h1 Enthalpy at the evaporator exhaust (J/kg) C h3 Enthalpy at the condenser exhaust (J/kg) C T1p Temperature after the heating-up (K) C v1p Refrigerant specific volume at point 1 prime(m**3/kg) C PevPL Cooling capacity in part-load regime (W) C Wpl Power consumed by the compressor in part-load (W) C WinPL Internal compression power for specified (W) C working conditions in part-load regime C WinReduc Reduced internal power consumed by the (W) C compressor in part-load regime C Wpump Power consumed by the compressor to by-pass the (W) C fluid in part-load regime C pratio Ratio of the condensing pressure to the (-) C evaporating pressure C pratioi Built-in pressure ratio (-) C pratiomax Maximum of pratio and pratiomax (-) C TolRel Relative error tolerance (-) C ErrRel Relative error (-) C Iter Loop counter (-) C Itermax Iteration maximum (-) C Vpumpingp is a storage variable C*********************************************************************** INTEGER*4 INFO DOUBLE PRECISION XIN,OUT REAL MfrRefPL,Ifluid,Mismatch,Losses DIMENSION PAR(4),XIN(11),OUT(3),INFO(15) COMMON /LUNITS/ LUR,LUW,IFORM,LUK COMMON /SIM/ TIME0,TFINAL,DELT,IWARN COMMON /STORE/ NSTORE,IAV,S(5000) COMMON /CONFIG/ TRNEDT,PERCOM,HEADER,PRTLAB,LNKCHK,PRUNIT,IOCHEK, & PRWARN INFO(6)=3 DATA TolRel,IterMax/1E-05,200/ C*** INPUTS 11 (converted in SI units) C************* Ifluid=SNGL(xin(1)) Tev=SNGL(xin(2)+273.15) Tcd=SNGL(xin(3)+273.15) DTsupheat=SNGL(xin(4)) DTsubcool=SNGL(xin(5)) PLorFL=SNGL(xin(6)) W=SNGL(xin(7)/3.6) Pev=SNGL(xin(8)/3.6) Pevratio=SNGL(xin(9)) Mismatch=SNGL(xin(10)) vratio=SNGL(xin(11)) C*** PARAMETERS 4 (converted in SI units) C**************** Losses=par(1)/3.6 Alpha=par(2) VsFL=par(3)/3600. Al=par(4) C2*** Selection of the refrigerant CALL PROPERTY (Ifluid,To,cpliq,hfo,cpvap,cpvapcd,hfgb,Tb,Tc, & b,r,Zeta,Zetacd,Gamma,Acl,Bcl,*1) CALL LINKCK('TYPE79','PROPERTY',1,99) 1 CONTINUE Gm1G=(Gamma-1)/Gamma C1*** Calculate the evaporating pressure and the enthalpy C1*** at the evaporator exhaust p1=1000*EXP(Acl+Bcl/Tev) T1=Tev+DTsupheat dhfg=hfgb*((Tc-Tev)/(Tc-Tb))**b h1=hfo+cpliq*(Tev-To)+dhfg+cpvap*DTsupheat C1*** Calculate the condensing pressure and the enthalpy at C1*** the condenser exhaust p2=1000*EXP(Acl+Bcl/Tcd) T3=Tcd-DTsubcool h3=hfo+cpliq*(T3-To) C2*** Calculate the power consumed by the compressor in C2*** part-load regime IF (PLorFL.EQ.2) THEN PevPL=Pev*PevRatio Wpl=W*(0.3+0.567*PevRatio+0.133*PevRatio**2) ELSE PevPL=Pev Wpl=W ENDIF C1*** Calculate the internal power in part-load regime WinPL=(Wpl-Losses)/(1+Alpha) C1*** Calculate the cooling mass flow rate in part-load MfrRefPL=PevPL/(h1-h3) C1*** First guess of Vpumping Vpumping=VsFL*0.5 Iter=0 10 Iter=Iter+1 C1*** Calculate the reduced internal power of the compressor C1*** working in part-load regime pratio=p2/p1 IF (Mismatch.EQ.1) THEN pratioi=vratio**Gamma WinReduc=p1*(VsFL-Vpumping)*(Gm1G*pratio/vratio+pratioi**Gm1G & /Gamma-1)/Gm1G pratiomax=Max(pratio,pratioi) ELSE WinReduc=p1*(VsFL-Vpumping)*(pratio**Gm1G-1)/Gm1G pratiomax=pratio ENDIF C1*** Calculate the temperature after the heating-up T1p=T1+(Wpl-WinReduc)/(MfrRefPL*cpvap) C2*** Calculate the refrigerant specific volume at point 1 prime v1p=Zeta*r*T1p/p1 C1*** Calculate a nem value of the refrigerant volume flow rate C1*** by-passed when the screw chiller is working in part-load regime X=SQRT(p1*v1p)*pratiomax**((Gamma+1)/(2*Gamma))* & SQRT(Gamma*(2/(Gamma+1))**((Gamma+1)/(Gamma-1))) Vpumpingp=Vpumping Vpumping=VsFL-Al*X-MfrRefPL*v1p ErrRel=ABS((Vpumping-Vpumpingp)/Vpumpingp) C2*** If converged, then leave the loop IF ((ErrRel.GT.TolRel).AND.(Iter.LE.IterMax)) GOTO 10 IF (Iter.GT.IterMax) THEN ErrDetec=1 ELSE C1*** Calculate the pumping power Wpump=WinPL-WinReduc C1*** Calculate the pressure jump encountered by C1*** the fluid by-passed when the compressor is working in C1*** part-load regime dpPumping=Wpump/Vpumping ENDIF C*** OUTPUTS 3 (converted in TRNSYS units) C************* out(1)=DBLE(Vpumping*3600.) out(2)=DBLE(dpPumping/101325.) out(3)=DBLE(ErrDetec) RETURN 1 END SUBROUTINE LINKCK(ENAME1,ENAME2,ILINK,LNKTYP) C*************************************************************************** C THIS SUBROUTINE WAS WRITTEN FOR TRNSYS 14.0 LINK CHECKING - THIS ROUTINE C IS CALLED BY OTHER SUBROUTINES WHEN AN UNLINKED SUBROUTINE HAS BEEN C FOUND. LINKCK IS NEEDED IN ORDER TO AVOID PUTTING COMMON BLOCKS LUNITS C AND CONFIG IN THE TRNSYS TYPES - JWT -- 3/93 C*************************************************************************** COMMON /LUNITS/ LUR,LUW,IFORM,LUK COMMON /CONFIG/ TRNEDT,PERCOM,HEADER,PRTLAB,LNKCHK,PRUNIT,IOCHEK, 1 PRWARN COMMON /SIM/TIME0,TFINAL,DELT,IWARN CHARACTER*1 TRNEDT,PERCOM,HEADER,PRTLAB,LNKCHK,PRUNIT,IOCHEK, 1 PRWARN CHARACTER*6 ENAME1,ENAME2 INTEGER ILINK,LNKTYP C ILINK = 1 --> GENERATE AN ERROR MESSAGE AND STOP TRNSYS C ILINK = 2 --> GENERATE A WARNING BUT DON'T STOP TRNSYS C ILINK = 3 --> TRNSYS HAS FOUND AN UNLINKED TYPE - GENERATE AN ERROR AND C STOP THE PROGRAM C ILINK = 4 --> WARN THE USER THAT A ROUTINE REQUIRES AN EXTERNAL FUNCTION C ENAME1 --> CALLING PROGRAM THAT NEEDED THE UNLINKED FILE C ENAME2 --> FILE THAT WAS NOT FOUND BY ENAME1 SUBROUTINE C LNKTYP --> TYPE NUMBER THAT IS UNLINKED IF((LNKCHK.EQ.'Y').OR.(LNKCHK.EQ.'y')) THEN IF(ILINK.EQ.1) THEN WRITE(LUW,20) 104,ENAME1,ENAME2 WRITE(LUW,15) CALL MYSTOP(104) ELSE IF(ILINK.EQ.2) THEN WRITE(LUW,20) 104,ENAME1,ENAME2 IWARN=IWARN+1 ELSE IF(ILINK.EQ.3) THEN WRITE(LUW,25) 105,LNKTYP,LNKTYP WRITE(LUW,15) CALL MYSTOP(105) ELSE IF(ILINK.EQ.4) THEN WRITE(LUW,35) LNKTYP,ENAME1,ENAME2 IWARN=IWARN+1 ELSE IF(ILINK.EQ.5) THEN WRITE(LUW,40) 105,LNKTYP,LNKTYP WRITE(LUW,15) CALL MYSTOP(105) ELSE WRITE(LUW,30) ENAME1 IWARN=IWARN+1 ENDIF ENDIF 15 FORMAT(//2X,47H*** SIMULATION TERMINATED WITH ERROR STATUS ***/) 20 FORMAT(//,1X,'***** ERROR *****',8X,'TRNSYS ERROR # ',I3,/1X,A6, 1' REQUIRES THE FILE "',A6,'" WHICH WAS CALLED BUT NOT LINKED.',/1X 1,'PLEASE LINK IN THE REQUIRED FILE AND RERUN THE SIMULATION.') 25 FORMAT(//,1X,'***** ERROR *****',8X,'TRNSYS ERROR # ',I3,/1X, 1'TYPE ',I3,' WAS CALLED IN THE TRNSYS INPUT FILE BUT NOT LINKED.', 1/1X,'LINK TYPE ',I3,' BEFORE RUNNING THIS SIMULATION.') 30 FORMAT(/1X,'*****WARNING*****',/1X,'THE LINKCK SUBROUTINE WAS CALL 1ED WITH AN INVALID OPERAND.',/1X,'THE PROGRAM WHICH CALLED LINKCK 1WITH THE IMPROPER OPERAND WAS ',A6,'.',/1X,'PLEASE MAKE SURE THAT 1THE CALLING PROGRAM IS FIXED OR UNLINKED SUBROUTINES MAY ',/1X,'GO 1 UNNOTICED.') 35 FORMAT(/1X,'*****WARNING*****',/1X,'UNIT ',I2,' ',A6,' REQUIRES TH 1E SUBROUTINE ',A6,/1X,'MAKE SURE THAT THIS SUBROUTINE IS LINKED IN 1 TO AVOID PROBLEMS. IT MAY ALREADY BE LINKED IN.',/) 40 FORMAT(//,1X,'***** ERROR *****',8X,'TRNSYS ERROR # ',I3,/1X, 1'TYPE',I3,' WAS CALLED IN THE TRNSYS INPUT FILE BUT NOT LINKED.', 1/1X,'A DUMMY TYPE SUBROUTINE WAS CALLED IN ITS PLACE. PLEASE LINK' 1,/1X,'TYPE',I3,' BEFORE RUNNING THIS SIMULATION OR TURN OFF THE CH 1ECK'/1X,'FOR UNLINKED SUBROUTINES OPTION IN THE CONFIGURATION FILE 1.') RETURN END SUBROUTINE PROPERTY (Ifluid,To,cpliq,hfo,cpvap,cpvapcd,hfgb,Tb,Tc, & b,r,Zeta,Zetacd,Gamma,Acl,Bcl,*) C************************************************************************ C* Copyright ASHRAE A Toolkit for Primary HVAC System Energy C* Calculation C*********************************************************************** C* SUBROUTINE: PROPERTY C* C* LANGUAGE: FORTRAN 77 C* C* PURPOSE: Selection of the thermodynamic properties C* of a given refrigerant. C*********************************************************************** C* INPUT VARIABLES: C* Ifluid Selection of the refrigerant (-) C* If Ifluid C* =1: Refrigerant 12 C* =2: Refrigerant 134a C* =3: Refrigerant 114 C* =4: Refrigerant 22 C* =5: Refrigerant 502 C* =6: Refrigerant 717 (Ammonia) C*********************************************************************** C* OUTPUT VARIABLES: C* To Reference temperature (K) C* cpliq Mean specific heat in saturated liquid state (J/kg/K) C* hfo Enthalpy of the saturated liquid at the (J/kg) C* reference temperature C* cpvap Mean specific heat at constant pressure (J/kg/K) C* in superheated vapor state for saturation C* temperatures ranging from 253 K to 283 K C* cpvapcd Mean specific heat at constant pressure (J/kg/K) C* in superheated vapor state for saturation C* temperatures ranging from 303 K to 333 K C* hfgb Vaporization enthalpy at standard boiling (J/kg) C* point (101325 Pa) C* Tb Standard boiling temperature (K) C* Tc Critical temperature (K) C* b Coefficient used in the calculation of the (-) C* vaporization enthalpy C* r Gas constant (J/kg/K) C* Zeta Mean compressibility factor for saturation (-) C* temperatures ranging from 253 K to 283 K C* Zetacd Mean compressibility factor for saturation (-) C* temperatures ranging from 303 K to 333 K C* Gamma Mean isentropic coefficient (-) C* Acl First coefficient in the Clausius-Clapeyron (-) C* equation C* Bcl Second coefficient in the Clausius-Clapeyron (K) C* equation C*********************************************************************** C MAJOR RESTRICTION: Perfect gas approximation is used C C DEVELOPER: Claudio Saavedra C University of Concepcion, Chile C Marc Grodent, Jean-Pascal Bourdouxhe C University of LiŠge, Belgium C C DATE: March 1, 1995 C*********************************************************************** REAL Ifluid To=233.15 IF (Ifluid.EQ.1) THEN cpliq=917 hfo=0 cpvap=641.6 cpvapcd=779 hfgb=165300 Tb=243.4 Tc=385.2 b=0.37 r=68.7539 Zeta=0.9403 Zetacd=0.8670 Gamma=1.086 Acl=14.669 Bcl=-2443.13 ENDIF IF (Ifluid.EQ.2) THEN cpliq=1265 hfo=0 cpvap=892.5 cpvapcd=1144 hfgb=215100 Tb=246.9 Tc=374.3 b=0.376 r=81.4899 Zeta=0.9411 Zetacd=0.8610 Gamma=1.072 Acl=15.489 Bcl=-2681.99 ENDIF IF (Ifluid.EQ.3) THEN cpliq=925 hfo=0 cpvap=693.6 cpvapcd=784 hfgb=136100 Tb=276.9 Tc=418.9 b=0.359 r=48.6393 Zeta=0.9757 Zetacd=0.9260 Gamma=1.056 Acl=15.107 Bcl=-2908.73 ENDIF IF (Ifluid.EQ.4) THEN cpliq=1144 hfo=0 cpvap=710.4 cpvapcd=936 hfgb=233700 Tb=232.4 Tc=369.2 b=0.369 r=96.1426 Zeta=0.9300 Zetacd=0.8440 Gamma=1.114 Acl=15.070 Bcl=-2421.94 ENDIF IF (Ifluid.EQ.5) THEN cpliq=1090 hfo=0 cpvap=732 cpvapcd=965 hfgb=172500 Tb=227.8 Tc=355.4 b=0.374 r=74.4752 Zeta=0.9130 Zetacd=0.8150 Gamma=1.065 Acl=14.809 Bcl=-2312.21 ENDIF IF (Ifluid.EQ.6) THEN cpliq=4575 hfo=0 cpvap=2447.1 cpvapcd=3159 hfgb=1372900 Tb=239.8 Tc=405.6 b=0.396 r=488.2214 Zeta=0.9570 Zetacd=0.8960 Gamma=1.230 Acl=16.204 Bcl=-2772.39 ENDIF RETURN 1 END