├── .gitignore
├── generator.exe
├── .gitattributes
├── Source_Code
├── generator
│ ├── Debug
│ │ ├── DF60.PDB
│ │ ├── SETUP.obj
│ │ ├── TRNSP.obj
│ │ ├── CORE_DE.obj
│ │ ├── CORE_PR.obj
│ │ ├── FLASH2.obj
│ │ ├── MIX_HMX.obj
│ │ ├── REALGAS.obj
│ │ ├── SAT_SUB.obj
│ │ ├── SETUP2.obj
│ │ ├── UTILITY.obj
│ │ ├── CORE_ANC.obj
│ │ ├── CORE_BWR.obj
│ │ ├── CORE_CPP.obj
│ │ ├── CORE_ECS.obj
│ │ ├── CORE_FEQ.obj
│ │ ├── CORE_MLT.obj
│ │ ├── CORE_PH0.obj
│ │ ├── CORE_QUI.obj
│ │ ├── CORE_STN.obj
│ │ ├── FLSH_SUB.obj
│ │ ├── IDEALGAS.obj
│ │ ├── MIX_AGA8.obj
│ │ ├── PASS_FTN.obj
│ │ ├── PROP_SUB.obj
│ │ ├── TRNS_ECS.obj
│ │ ├── TRNS_TCX.obj
│ │ ├── TRNS_VIS.obj
│ │ ├── generator.exe
│ │ ├── generator.exp
│ │ ├── generator.lib
│ │ ├── generator.pdb
│ │ └── RGPgenerator.obj
│ ├── generator.ncb
│ ├── generator.opt
│ ├── generator.dsw
│ ├── generator.plg
│ └── generator.dsp
├── README.md
└── fortran
│ ├── COMTRN.FOR
│ ├── COMTRN.INI
│ ├── REALGAS.FOR
│ ├── CORE_DE.FOR
│ ├── CMNS.FOR
│ ├── IDEALGAS.FOR
│ ├── CORE_PH0.FOR
│ ├── CORE_QUI.FOR
│ ├── CORE_STN.FOR
│ └── CORE_ECS.FOR
└── README.md
/.gitignore:
--------------------------------------------------------------------------------
1 | C++.gitignore
--------------------------------------------------------------------------------
/generator.exe:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/generator.exe
--------------------------------------------------------------------------------
/.gitattributes:
--------------------------------------------------------------------------------
1 | # Auto detect text files and perform LF normalization
2 | * text=auto
3 |
--------------------------------------------------------------------------------
/Source_Code/generator/Debug/DF60.PDB:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/Source_Code/generator/Debug/DF60.PDB
--------------------------------------------------------------------------------
/Source_Code/generator/Debug/SETUP.obj:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/Source_Code/generator/Debug/SETUP.obj
--------------------------------------------------------------------------------
/Source_Code/generator/Debug/TRNSP.obj:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/Source_Code/generator/Debug/TRNSP.obj
--------------------------------------------------------------------------------
/Source_Code/generator/generator.ncb:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/Source_Code/generator/generator.ncb
--------------------------------------------------------------------------------
/Source_Code/generator/generator.opt:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/Source_Code/generator/generator.opt
--------------------------------------------------------------------------------
/Source_Code/generator/Debug/CORE_DE.obj:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/Source_Code/generator/Debug/CORE_DE.obj
--------------------------------------------------------------------------------
/Source_Code/generator/Debug/CORE_PR.obj:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/Source_Code/generator/Debug/CORE_PR.obj
--------------------------------------------------------------------------------
/Source_Code/generator/Debug/FLASH2.obj:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/Source_Code/generator/Debug/FLASH2.obj
--------------------------------------------------------------------------------
/Source_Code/generator/Debug/MIX_HMX.obj:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/Source_Code/generator/Debug/MIX_HMX.obj
--------------------------------------------------------------------------------
/Source_Code/generator/Debug/REALGAS.obj:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/Source_Code/generator/Debug/REALGAS.obj
--------------------------------------------------------------------------------
/Source_Code/generator/Debug/SAT_SUB.obj:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/Source_Code/generator/Debug/SAT_SUB.obj
--------------------------------------------------------------------------------
/Source_Code/generator/Debug/SETUP2.obj:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/Source_Code/generator/Debug/SETUP2.obj
--------------------------------------------------------------------------------
/Source_Code/generator/Debug/UTILITY.obj:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/Source_Code/generator/Debug/UTILITY.obj
--------------------------------------------------------------------------------
/Source_Code/generator/Debug/CORE_ANC.obj:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/Source_Code/generator/Debug/CORE_ANC.obj
--------------------------------------------------------------------------------
/Source_Code/generator/Debug/CORE_BWR.obj:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/Source_Code/generator/Debug/CORE_BWR.obj
--------------------------------------------------------------------------------
/Source_Code/generator/Debug/CORE_CPP.obj:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/Source_Code/generator/Debug/CORE_CPP.obj
--------------------------------------------------------------------------------
/Source_Code/generator/Debug/CORE_ECS.obj:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/Source_Code/generator/Debug/CORE_ECS.obj
--------------------------------------------------------------------------------
/Source_Code/generator/Debug/CORE_FEQ.obj:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/Source_Code/generator/Debug/CORE_FEQ.obj
--------------------------------------------------------------------------------
/Source_Code/generator/Debug/CORE_MLT.obj:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/Source_Code/generator/Debug/CORE_MLT.obj
--------------------------------------------------------------------------------
/Source_Code/generator/Debug/CORE_PH0.obj:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/Source_Code/generator/Debug/CORE_PH0.obj
--------------------------------------------------------------------------------
/Source_Code/generator/Debug/CORE_QUI.obj:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/Source_Code/generator/Debug/CORE_QUI.obj
--------------------------------------------------------------------------------
/Source_Code/generator/Debug/CORE_STN.obj:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/Source_Code/generator/Debug/CORE_STN.obj
--------------------------------------------------------------------------------
/Source_Code/generator/Debug/FLSH_SUB.obj:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/Source_Code/generator/Debug/FLSH_SUB.obj
--------------------------------------------------------------------------------
/Source_Code/generator/Debug/IDEALGAS.obj:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/Source_Code/generator/Debug/IDEALGAS.obj
--------------------------------------------------------------------------------
/Source_Code/generator/Debug/MIX_AGA8.obj:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/Source_Code/generator/Debug/MIX_AGA8.obj
--------------------------------------------------------------------------------
/Source_Code/generator/Debug/PASS_FTN.obj:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/Source_Code/generator/Debug/PASS_FTN.obj
--------------------------------------------------------------------------------
/Source_Code/generator/Debug/PROP_SUB.obj:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/Source_Code/generator/Debug/PROP_SUB.obj
--------------------------------------------------------------------------------
/Source_Code/generator/Debug/TRNS_ECS.obj:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/Source_Code/generator/Debug/TRNS_ECS.obj
--------------------------------------------------------------------------------
/Source_Code/generator/Debug/TRNS_TCX.obj:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/Source_Code/generator/Debug/TRNS_TCX.obj
--------------------------------------------------------------------------------
/Source_Code/generator/Debug/TRNS_VIS.obj:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/Source_Code/generator/Debug/TRNS_VIS.obj
--------------------------------------------------------------------------------
/Source_Code/generator/Debug/generator.exe:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/Source_Code/generator/Debug/generator.exe
--------------------------------------------------------------------------------
/Source_Code/generator/Debug/generator.exp:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/Source_Code/generator/Debug/generator.exp
--------------------------------------------------------------------------------
/Source_Code/generator/Debug/generator.lib:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/Source_Code/generator/Debug/generator.lib
--------------------------------------------------------------------------------
/Source_Code/generator/Debug/generator.pdb:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/Source_Code/generator/Debug/generator.pdb
--------------------------------------------------------------------------------
/Source_Code/generator/Debug/RGPgenerator.obj:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/luvm/RGP_generator/HEAD/Source_Code/generator/Debug/RGPgenerator.obj
--------------------------------------------------------------------------------
/Source_Code/generator/generator.dsw:
--------------------------------------------------------------------------------
1 | Microsoft Developer Studio Workspace File, Format Version 6.00
2 | # WARNING: DO NOT EDIT OR DELETE THIS WORKSPACE FILE!
3 |
4 | ###############################################################################
5 |
6 | Project: "generator"=.\generator.dsp - Package Owner=<4>
7 |
8 | Package=<5>
9 | {{{
10 | }}}
11 |
12 | Package=<4>
13 | {{{
14 | }}}
15 |
16 | ###############################################################################
17 |
18 | Global:
19 |
20 | Package=<5>
21 | {{{
22 | }}}
23 |
24 | Package=<3>
25 | {{{
26 | }}}
27 |
28 | ###############################################################################
29 |
30 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | RGP Generator
2 | =============
3 |
4 | This program was developed to generate custom step size RGP files using the NIST fluid properties.
5 |
6 | Included Files
7 | --------------
8 | fluids(folder) - Includes REFPROP fluids needed for generating the rgp file
9 | Source Code(folder) - Includes the source code for the program (within RGPgenerator.F90, the rest are REFPROP subroutines, and RGP_Generator.prj is the simple fortran project file)
10 | CFX Solver Guide.pdf - ANSYS CFX Documentation which was useful when formatting the RGP gen output file (See section 12.6)
11 | RGP_Generator64.exe - 64 Bit version of the program
12 | RGP_Generator32.exe - 32 Bit version of the program
13 | README.txt
14 |
15 | How to use
16 | -----------
17 | 1) Open either the 32 or 64 bit version of RGP_Generator.exe
18 | 2) Follow the steps to generate the output file
19 | 3) Upload the RGP file to ANSYS CFX
20 |
21 | Licence
22 | =======
23 |
24 | [BSD Licence](http://opensource.org/licenses/bsd-license.php)
25 |
--------------------------------------------------------------------------------
/Source_Code/README.md:
--------------------------------------------------------------------------------
1 | RGP Generator
2 | =============
3 |
4 | This program was developed to generate custom step size RGP files using the NIST fluid properties.
5 |
6 | Included Files
7 | --------------
8 | fluids(folder) - Includes REFPROP fluids needed for generating the rgp file
9 | Source Code(folder) - Includes the source code for the program (within RGPgenerator.F90, the rest are REFPROP subroutines, and RGP_Generator.prj is the simple fortran project file)
10 | CFX Solver Guide.pdf - ANSYS CFX Documentation which was useful when formatting the RGP gen output file (See section 12.6)
11 | RGP_Generator64.exe - 64 Bit version of the program
12 | RGP_Generator32.exe - 32 Bit version of the program
13 | README.txt
14 |
15 | How to use
16 | -----------
17 | 1) Open either the 32 or 64 bit version of RGP_Generator.exe
18 | 2) Follow the steps to generate the output file
19 | 3) Upload the RGP file to ANSYS CFX
20 |
21 | Licence
22 | =======
23 |
24 | [BSD Licence](http://opensource.org/licenses/bsd-license.php)
25 |
--------------------------------------------------------------------------------
/Source_Code/generator/generator.plg:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 | Build Log
5 |
6 | --------------------Configuration: generator - Win32 Debug--------------------
7 |
8 | Command Lines
9 | Creating temporary file "C:\DOCUME~1\Admin\LOCALS~1\Temp\RSP1AA.tmp" with contents
10 | [
11 | /check:bounds /compile_only /dbglibs /debug:full /nologo /traceback /warn:argument_checking /warn:nofileopt /module:"Debug/" /object:"Debug/" /pdbfile:"Debug/DF60.PDB"
12 | "C:\DATA\RGP_generator\Source_Code\fortran\UTILITY.FOR"
13 | "C:\DATA\RGP_generator\Source_Code\fortran\TRNSP.FOR"
14 | "C:\DATA\RGP_generator\Source_Code\fortran\TRNS_VIS.FOR"
15 | "C:\DATA\RGP_generator\Source_Code\fortran\TRNS_TCX.FOR"
16 | "C:\DATA\RGP_generator\Source_Code\fortran\TRNS_ECS.FOR"
17 | "C:\DATA\RGP_generator\Source_Code\fortran\SETUP2.FOR"
18 | "C:\DATA\RGP_generator\Source_Code\fortran\SETUP.FOR"
19 | "C:\DATA\RGP_generator\Source_Code\fortran\SAT_SUB.FOR"
20 | "C:\DATA\RGP_gen_2\RGPgenerator.F90"
21 | "C:\DATA\RGP_generator\Source_Code\fortran\REALGAS.FOR"
22 | "C:\DATA\RGP_generator\Source_Code\fortran\PROP_SUB.FOR"
23 | "C:\DATA\RGP_generator\Source_Code\fortran\PASS_FTN.FOR"
24 | "C:\DATA\RGP_generator\Source_Code\fortran\MIX_HMX.FOR"
25 | "C:\DATA\RGP_generator\Source_Code\fortran\MIX_AGA8.FOR"
26 | "C:\DATA\RGP_generator\Source_Code\fortran\IDEALGAS.FOR"
27 | "C:\DATA\RGP_generator\Source_Code\fortran\FLSH_SUB.FOR"
28 | "C:\DATA\RGP_generator\Source_Code\fortran\FLASH2.FOR"
29 | "C:\DATA\RGP_generator\Source_Code\fortran\CORE_STN.FOR"
30 | "C:\DATA\RGP_generator\Source_Code\fortran\CORE_QUI.FOR"
31 | "C:\DATA\RGP_generator\Source_Code\fortran\CORE_PR.FOR"
32 | "C:\DATA\RGP_generator\Source_Code\fortran\CORE_PH0.FOR"
33 | "C:\DATA\RGP_generator\Source_Code\fortran\CORE_MLT.FOR"
34 | "C:\DATA\RGP_generator\Source_Code\fortran\CORE_FEQ.FOR"
35 | "C:\DATA\RGP_generator\Source_Code\fortran\CORE_ECS.FOR"
36 | "C:\DATA\RGP_generator\Source_Code\fortran\CORE_DE.FOR"
37 | "C:\DATA\RGP_generator\Source_Code\fortran\CORE_CPP.FOR"
38 | "C:\DATA\RGP_generator\Source_Code\fortran\CORE_BWR.FOR"
39 | "C:\DATA\RGP_generator\Source_Code\fortran\CORE_ANC.FOR"
40 | ]
41 | Creating temporary file "C:\DOCUME~1\Admin\LOCALS~1\Temp\RSP1AB.tmp" with contents
42 | [
43 | kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /incremental:no /pdb:"Debug/generator.pdb" /debug /machine:I386 /out:"Debug/generator.exe" /pdbtype:sept
44 | .\Debug\CORE_ANC.OBJ
45 | .\Debug\CORE_BWR.OBJ
46 | .\Debug\CORE_CPP.OBJ
47 | .\Debug\CORE_DE.OBJ
48 | .\Debug\CORE_ECS.OBJ
49 | .\Debug\CORE_FEQ.OBJ
50 | .\Debug\CORE_MLT.OBJ
51 | .\Debug\CORE_PH0.OBJ
52 | .\Debug\CORE_PR.OBJ
53 | .\Debug\CORE_QUI.OBJ
54 | .\Debug\CORE_STN.OBJ
55 | .\Debug\FLASH2.OBJ
56 | .\Debug\FLSH_SUB.OBJ
57 | .\Debug\IDEALGAS.OBJ
58 | .\Debug\MIX_AGA8.OBJ
59 | .\Debug\MIX_HMX.OBJ
60 | .\Debug\PASS_FTN.OBJ
61 | .\Debug\PROP_SUB.OBJ
62 | .\Debug\REALGAS.OBJ
63 | .\Debug\RGPgenerator.obj
64 | .\Debug\SAT_SUB.OBJ
65 | .\Debug\SETUP.OBJ
66 | .\Debug\SETUP2.OBJ
67 | .\Debug\TRNS_ECS.OBJ
68 | .\Debug\TRNS_TCX.OBJ
69 | .\Debug\TRNS_VIS.OBJ
70 | .\Debug\TRNSP.OBJ
71 | .\Debug\UTILITY.OBJ
72 | ]
73 | Creating command line "link.exe @C:\DOCUME~1\Admin\LOCALS~1\Temp\RSP1AB.tmp"
74 | Output Window
75 | Compiling Fortran...
76 | C:\DATA\RGP_generator\Source_Code\fortran\UTILITY.FOR
77 | C:\DATA\RGP_generator\Source_Code\fortran\TRNSP.FOR
78 | C:\DATA\RGP_generator\Source_Code\fortran\TRNS_VIS.FOR
79 | C:\DATA\RGP_generator\Source_Code\fortran\TRNS_TCX.FOR
80 | C:\DATA\RGP_generator\Source_Code\fortran\TRNS_ECS.FOR
81 | C:\DATA\RGP_generator\Source_Code\fortran\SETUP2.FOR
82 | C:\DATA\RGP_generator\Source_Code\fortran\SETUP.FOR
83 | C:\DATA\RGP_generator\Source_Code\fortran\SAT_SUB.FOR
84 | C:\DATA\RGP_gen_2\RGPgenerator.F90
85 | C:\DATA\RGP_generator\Source_Code\fortran\REALGAS.FOR
86 | C:\DATA\RGP_generator\Source_Code\fortran\PROP_SUB.FOR
87 | C:\DATA\RGP_generator\Source_Code\fortran\PASS_FTN.FOR
88 | C:\DATA\RGP_generator\Source_Code\fortran\MIX_HMX.FOR
89 | C:\DATA\RGP_generator\Source_Code\fortran\MIX_AGA8.FOR
90 | C:\DATA\RGP_generator\Source_Code\fortran\IDEALGAS.FOR
91 | C:\DATA\RGP_generator\Source_Code\fortran\FLSH_SUB.FOR
92 | C:\DATA\RGP_generator\Source_Code\fortran\FLASH2.FOR
93 | C:\DATA\RGP_generator\Source_Code\fortran\CORE_STN.FOR
94 | C:\DATA\RGP_generator\Source_Code\fortran\CORE_QUI.FOR
95 | C:\DATA\RGP_generator\Source_Code\fortran\CORE_PR.FOR
96 | C:\DATA\RGP_generator\Source_Code\fortran\CORE_PH0.FOR
97 | C:\DATA\RGP_generator\Source_Code\fortran\CORE_MLT.FOR
98 | C:\DATA\RGP_generator\Source_Code\fortran\CORE_FEQ.FOR
99 | C:\DATA\RGP_generator\Source_Code\fortran\CORE_ECS.FOR
100 | C:\DATA\RGP_generator\Source_Code\fortran\CORE_DE.FOR
101 | C:\DATA\RGP_generator\Source_Code\fortran\CORE_CPP.FOR
102 | C:\DATA\RGP_generator\Source_Code\fortran\CORE_BWR.FOR
103 | C:\DATA\RGP_generator\Source_Code\fortran\CORE_ANC.FOR
104 | Linking...
105 | Creating library Debug/generator.lib and object Debug/generator.exp
106 |
107 |
108 |
109 | Results
110 | generator.exe - 0 error(s), 0 warning(s)
111 |
112 |
113 |
114 |
--------------------------------------------------------------------------------
/Source_Code/fortran/COMTRN.FOR:
--------------------------------------------------------------------------------
1 | c..begin file comtrn.for
2 | parameter (mxeta=40) !max no. coefficients for viscosity
3 | parameter (mxetac=10) !max number additional parameters for chung
4 | parameter (mxtck=40) !max no. coefficients for t.c. crit
5 | parameter (mxtcx=40) !max no. coefficients for thermal cond
6 | parameter (mxtcxc=10) !max number additional parameters for chung
7 | parameter (metar=6) !max add. residual viscosity params (chung)
8 | parameter (mtcxr=6) !max add. residual tc parameters for chung
9 | parameter (mxtrn=10) !max no. coefficients for psi, chi function
10 | parameter (mxomg=15) !max no. coeffs for collision integral
11 |
12 | c..Transport equations-------------------------------------------------
13 | character*3 hetahc,htcxhc
14 | character*3 hetacr,htcxcr,htcxcrecs
15 | character*3 hmdeta,hmdtcx
16 | character*3 hetamx,heta,htcxmx,htcx
17 |
18 | c..pointer to hardcoded models
19 | common /HCMOD/ hetahc(nrf0:ncmax),htcxhc(nrf0:ncmax)
20 | c..pointer to critical enhancement auxiliary functions
21 | common /CREMOD/ hetacr(nrf0:ncmax),htcxcr(nrf0:ncmax),
22 | & htcxcrecs(nrf0:nx)
23 |
24 | c..Dilute gas
25 | common /WCFOM1/ comg(nrf0:nx,mxomg,2)
26 | common /WIFOM1/ ntomg(nrf0:nx),icomg(nrf0:nx,mxomg)
27 | common /WCFOM2/ comg2(nrf0:nx,mxomg,2)
28 | common /WIFOM2/ ntomg2(nrf0:nx),icomg2(nrf0:nx,mxomg)
29 | common /WCEUCK/ cEuck(nrf0:nx,mxtrn,4)
30 | common /OMGMOD/ hmdeta(nrf0:nx),hmdtcx(nrf0:nx)
31 |
32 | c..Thermal conductivity-------------------------------------------------
33 | c..Lennard-Jones parameters
34 | common /WLJTCX/ sigmat(nrf0:nx),epskt(nrf0:nx)
35 | c..limits and reducing parameters
36 | common /WLMTCX/ tmtcx(nrf0:nx),txtcx(nrf0:nx),pxtcx(nrf0:nx),
37 | & Dxtcx(nrf0:nx)
38 | common /WRDTCX/ trddgt(nrf0:nx),tcxdgt(nrf0:nx),
39 | & trdbkt(nrf0:nx),Drdbkt(nrf0:nx),tcxbkt(nrf0:nx),
40 | & trdcrt(nrf0:nx),Drdcrt(nrf0:nx),tcxcrt(nrf0:nx)
41 | c..numbers of terms for the various parts of the model: numerator
42 | c..and denominator for dilute gas and background parts
43 | common /WNTTCX/ ndgnum(nrf0:nx),ndgden(nrf0:nx),
44 | & nbknum(nrf0:nx),nbkden(nrf0:nx)
45 | c..commons storing the (real and integer) coefficients to the thermal
46 | c..conductivity model
47 | common /WCFTCX/ ctcx(nrf0:nx,mxtcx,4)
48 | common /WIFTCX/ itcx(nrf0:nx,mxtcx)
49 |
50 | c..Thermal conductivity critical enhancement----------------------------
51 | c..reducing parameters
52 | common /WLMTCK/ tmtck(nrf0:nx),txtck(nrf0:nx),pxtck(nrf0:nx),
53 | & Dxtck(nrf0:nx)
54 | common /WRDTCK/ trtck(nrf0:nx),Drtck(nrf0:nx),prtck(nrf0:nx),
55 | & tcxred(nrf0:nx),tredex(nrf0:nx),Dredex(nrf0:nx)
56 | c..numbers of terms for the various parts of the model:
57 | c..polynomial (numerator & denominator), exponential, spare
58 | c..the "CO2" terms are stored in the "numerator" area
59 | common /WNTTCK/ nnumtck(nrf0:nx),ndentck(nrf0:nx),
60 | & nexptck(nrf0:nx),nsparek(nrf0:nx)
61 | c..commons storing the (real and integer) coefficients to the model
62 | common /WCFTCKe/ ctcke(nrf0:nx,mxtck,5)
63 | common /WCFTCK/ ctck(nrf0:nx,mxtck,5)
64 | common /WIFTCK/ itck(nrf0:nx,mxtck,0:5)
65 |
66 | c..Viscosity------------------------------------------------------------
67 | common /CRTENH/ tcmxec,pcmxec,dcmxec,etacal
68 | common /WLMETA/ tmeta(nrf0:nx),txeta(nrf0:nx),pxeta(nrf0:nx),
69 | & Dxeta(nrf0:nx)
70 | c..commons storing the real coefficients to the viscosity model
71 | common /WCFETA/ ceta(nrf0:nx,mxeta,4)
72 | common /WIFETA/ ieta(nrf0:nx,mxeta)
73 | common /WLJETA/ sigmav(nrf0:nx),epskv(nrf0:nx)
74 | c..limits and reducing parameters
75 | common /WRDETA/ trddge(nrf0:nx),etadge(nrf0:nx),
76 | & tredB2(nrf0:nx),etarB2(nrf0:nx),
77 | & tredeta(nrf0:nx),Dredeta(nrf0:nx),etared(nrf0:nx)
78 | common /WR3ETA/ trddg3(nrf0:nx),etadg3(nrf0:nx),
79 | & trdbk3(nrf0:nx),Drdbk3(nrf0:nx),etabk3(nrf0:nx),
80 | & trdcr3(nrf0:nx),Drdcr3(nrf0:nx),etacr3(nrf0:nx)
81 | c..numbers of terms for the various parts of the model: dilute gas,
82 | c..second viscosity virial (initial density dependence), residual part
83 | common /WNTETA/ ndgeta(nrf0:nx),nB2eta(nrf0:nx),ndel0(nrf0:nx),
84 | & npoly(nrf0:nx),nnumeta(nrf0:nx),ndeneta(nrf0:nx),
85 | & nexpn(nrf0:nx),nexpd(nrf0:nx),
86 | & ndg2(nrf0:nx),ndg3(nrf0:nx),ndg4(nrf0:nx),
87 | & ndg5(nrf0:nx),ndg6(nrf0:nx)
88 | common /WN3ETA/ ndgnm3(nrf0:nx),ndgdn3(nrf0:nx),
89 | & nbknm3(nrf0:nx),nbkdn3(nrf0:nx)
90 | c..common storing residual coefficients to the FT visc model
91 | common /TRNFT/ ASftm(nrf0:nx,0:4),BSftm(nrf0:nx,0:4),
92 | & CSftm(nrf0:nx,0:4),ABftm(nrf0:nx,0:4),
93 | & BBftm(nrf0:nx,0:4),CBftm(nrf0:nx,0:4),
94 | & DBftm(nrf0:nx,0:4),EBftm(nrf0:nx,0:4)
95 |
96 | c..ECS transport--------------------------------------------------------
97 | common /TRNMOD/ hetamx,heta(nrf0:ncmax),htcxmx,htcx(nrf0:ncmax)
98 | common /TRNBIN/ xljs(nx,nx),xlje(nx,nx),xkij(nx,nx),xlij(nx,nx),
99 | & xaji(nx,nx),xkijk(nx,nx),xlijk(nx,nx),
100 | & xdij(nx,nx),xdij2(nx,nx)
101 | common /WLMTRN/ tmecst(nrf0:nx),txecst(nrf0:nx),pxecst(nrf0:nx),
102 | & Dxecst(nrf0:nx)
103 | common /WLJTRN/ sigtrn(nrf0:nx),epsktr(nrf0:nx)
104 | common /WCFTRN/ cpsi(nrf0:nx,mxtrn,4),cchi(nrf0:nx,mxtrn,4)
105 | c common /WIFTRN/ ipsi(nrf0:nx,0:mxtrn),ichi(nrf0:nx,0:mxtrn)
106 | c..iLJflag: flag for L-J parameters (if 0, estimate)
107 | c..nEuck: factor f_int in Eucken correlation
108 | c..npsi (viscosity shape factor): polynomial term, 2nd poly, spare
109 | c..nchi (conductivity shape factor): polynomial term, 2nd poly, spare
110 | common /WNTTRN/ iLJflag(nrf0:nx),nEuck(nrf0:nx),
111 | & npsi1(nrf0:nx),npsi2(nrf0:nx),npsi3(nrf0:nx),
112 | & nchi1(nrf0:nx),nchi2(nrf0:nx),nchi3(nrf0:nx)
113 |
114 | c..Parameters for Chung method------------------------------------------
115 | common /CHUNGPk/ acchk(nrf0:nx),ddipk(nrf0:nx),sigchk(nrf0:nx),
116 | & epschk(nrf0:nx),cctcx(nrf0:nx,mxtcxc,mtcxr),
117 | & tcx0ch,hbkk(nrf0:nx),naddk(nrf0:nx)
118 | common /CHUNGPv/ acchv(nrf0:nx),ddipv(nrf0:nx),sigchv(nrf0:nx),
119 | & epschv(nrf0:nx),cceta(nrf0:nx,mxetac,metar),
120 | & eta0ch,hbvk(nrf0:nx),naddv(nrf0:nx)
121 |
122 |
123 | !$omp threadprivate(/HCMOD/)
124 | !$omp threadprivate(/CREMOD/)
125 | !$omp threadprivate(/WCFOM1/)
126 | !$omp threadprivate(/WIFOM1/)
127 | !$omp threadprivate(/WCFOM2/)
128 | !$omp threadprivate(/WIFOM2/)
129 | !$omp threadprivate(/WCEUCK/)
130 | !$omp threadprivate(/OMGMOD/)
131 | !$omp threadprivate(/WLJTCX/)
132 | !$omp threadprivate(/WLMTCX/)
133 | !$omp threadprivate(/WRDTCX/)
134 | !$omp threadprivate(/WNTTCX/)
135 | !$omp threadprivate(/WCFTCX/)
136 | !$omp threadprivate(/WIFTCX/)
137 | !$omp threadprivate(/WLMTCK/)
138 | !$omp threadprivate(/WRDTCK/)
139 | !$omp threadprivate(/WNTTCK/)
140 | !$omp threadprivate(/WCFTCKe/)
141 | !$omp threadprivate(/WCFTCK/)
142 | !$omp threadprivate(/WIFTCK/)
143 | !$omp threadprivate(/CRTENH/)
144 | !$omp threadprivate(/WLMETA/)
145 | !$omp threadprivate(/WCFETA/)
146 | !$omp threadprivate(/WIFETA/)
147 | !$omp threadprivate(/WLJETA/)
148 | !$omp threadprivate(/WRDETA/)
149 | !$omp threadprivate(/WR3ETA/)
150 | !$omp threadprivate(/WNTETA/)
151 | !$omp threadprivate(/WN3ETA/)
152 | !$omp threadprivate(/TRNFT/)
153 | !$omp threadprivate(/TRNMOD/)
154 | !$omp threadprivate(/TRNBIN/)
155 | !$omp threadprivate(/WLMTRN/)
156 | !$omp threadprivate(/WLJTRN/)
157 | !$omp threadprivate(/WCFTRN/)
158 | !$omp threadprivate(/WNTTRN/)
159 | !$omp threadprivate(/CHUNGPk/)
160 | !$omp threadprivate(/CHUNGPv/)
161 | c!$omp threadprivate(/WIFTRN/)
162 |
163 | c
164 | c 1 2 3 4 5 6 7
165 | c23456789012345678901234567890123456789012345678901234567890123456789012
166 | c
167 | c ======================================================================
168 | c end file comtrn.for
169 | c ======================================================================
170 |
--------------------------------------------------------------------------------
/Source_Code/fortran/COMTRN.INI:
--------------------------------------------------------------------------------
1 | c..begin file comtrn.for
2 | parameter (mxeta=40) !max no. coefficients for viscosity
3 | parameter (mxetac=10) !max number additional parameters for chung
4 | parameter (mxtck=40) !max no. coefficients for t.c. crit
5 | parameter (mxtcx=40) !max no. coefficients for thermal cond
6 | parameter (mxtcxc=10) !max number additional parameters for chung
7 | parameter (metar=6) !max add. residual viscosity params (chung)
8 | parameter (mtcxr=6) !max add. residual tc parameters for chung
9 | parameter (mxtrn=10) !max no. coefficients for psi, chi function
10 | parameter (mxomg=15) !max no. coeffs for collision integral
11 |
12 | c..Transport equations-------------------------------------------------
13 | character*3 hetahc,htcxhc
14 | character*3 hetacr,htcxcr,htcxcrecs
15 | character*3 hmdeta,hmdtcx
16 | character*3 hetamx,heta,htcxmx,htcx
17 |
18 | c..pointer to hardcoded models
19 | common /HCMOD/ hetahc(nrf0:ncmax),htcxhc(nrf0:ncmax)
20 | c..pointer to critical enhancement auxiliary functions
21 | common /CREMOD/ hetacr(nrf0:ncmax),htcxcr(nrf0:ncmax),
22 | & htcxcrecs(nrf0:nx)
23 |
24 | c..Dilute gas
25 | common /WCFOM1/ comg(nrf0:nx,mxomg,2)
26 | common /WIFOM1/ ntomg(nrf0:nx),icomg(nrf0:nx,mxomg)
27 | common /WCFOM2/ comg2(nrf0:nx,mxomg,2)
28 | common /WIFOM2/ ntomg2(nrf0:nx),icomg2(nrf0:nx,mxomg)
29 | common /WCEUCK/ cEuck(nrf0:nx,mxtrn,4)
30 | common /OMGMOD/ hmdeta(nrf0:nx),hmdtcx(nrf0:nx)
31 |
32 | c..Thermal conductivity-------------------------------------------------
33 | c..Lennard-Jones parameters
34 | common /WLJTCX/ sigmat(nrf0:nx),epskt(nrf0:nx)
35 | c..limits and reducing parameters
36 | common /WLMTCX/ tmtcx(nrf0:nx),txtcx(nrf0:nx),pxtcx(nrf0:nx),
37 | & Dxtcx(nrf0:nx)
38 | common /WRDTCX/ trddgt(nrf0:nx),tcxdgt(nrf0:nx),
39 | & trdbkt(nrf0:nx),Drdbkt(nrf0:nx),tcxbkt(nrf0:nx),
40 | & trdcrt(nrf0:nx),Drdcrt(nrf0:nx),tcxcrt(nrf0:nx)
41 | c..numbers of terms for the various parts of the model: numerator
42 | c..and denominator for dilute gas and background parts
43 | common /WNTTCX/ ndgnum(nrf0:nx),ndgden(nrf0:nx),
44 | & nbknum(nrf0:nx),nbkden(nrf0:nx)
45 | c..commons storing the (real and integer) coefficients to the thermal
46 | c..conductivity model
47 | common /WCFTCX/ ctcx(nrf0:nx,mxtcx,4)
48 | common /WIFTCX/ itcx(nrf0:nx,mxtcx)
49 |
50 | c..Thermal conductivity critical enhancement----------------------------
51 | c..reducing parameters
52 | common /WLMTCK/ tmtck(nrf0:nx),txtck(nrf0:nx),pxtck(nrf0:nx),
53 | & Dxtck(nrf0:nx)
54 | common /WRDTCK/ trtck(nrf0:nx),Drtck(nrf0:nx),prtck(nrf0:nx),
55 | & tcxred(nrf0:nx),tredex(nrf0:nx),Dredex(nrf0:nx)
56 | c..numbers of terms for the various parts of the model:
57 | c..polynomial (numerator & denominator), exponential, spare
58 | c..the "CO2" terms are stored in the "numerator" area
59 | common /WNTTCK/ nnumtck(nrf0:nx),ndentck(nrf0:nx),
60 | & nexptck(nrf0:nx),nsparek(nrf0:nx)
61 | c..commons storing the (real and integer) coefficients to the model
62 | common /WCFTCKe/ ctcke(nrf0:nx,mxtck,5)
63 | common /WCFTCK/ ctck(nrf0:nx,mxtck,5)
64 | common /WIFTCK/ itck(nrf0:nx,mxtck,0:5)
65 |
66 | c..Viscosity------------------------------------------------------------
67 | common /CRTENH/ tcmxec,pcmxec,dcmxec,etacal
68 | common /WLMETA/ tmeta(nrf0:nx),txeta(nrf0:nx),pxeta(nrf0:nx),
69 | & Dxeta(nrf0:nx)
70 | c..commons storing the real coefficients to the viscosity model
71 | common /WCFETA/ ceta(nrf0:nx,mxeta,4)
72 | common /WIFETA/ ieta(nrf0:nx,mxeta)
73 | common /WLJETA/ sigmav(nrf0:nx),epskv(nrf0:nx)
74 | c..limits and reducing parameters
75 | common /WRDETA/ trddge(nrf0:nx),etadge(nrf0:nx),
76 | & tredB2(nrf0:nx),etarB2(nrf0:nx),
77 | & tredeta(nrf0:nx),Dredeta(nrf0:nx),etared(nrf0:nx)
78 | common /WR3ETA/ trddg3(nrf0:nx),etadg3(nrf0:nx),
79 | & trdbk3(nrf0:nx),Drdbk3(nrf0:nx),etabk3(nrf0:nx),
80 | & trdcr3(nrf0:nx),Drdcr3(nrf0:nx),etacr3(nrf0:nx)
81 | c..numbers of terms for the various parts of the model: dilute gas,
82 | c..second viscosity virial (initial density dependence), residual part
83 | common /WNTETA/ ndgeta(nrf0:nx),nB2eta(nrf0:nx),ndel0(nrf0:nx),
84 | & npoly(nrf0:nx),nnumeta(nrf0:nx),ndeneta(nrf0:nx),
85 | & nexpn(nrf0:nx),nexpd(nrf0:nx),
86 | & ndg2(nrf0:nx),ndg3(nrf0:nx),ndg4(nrf0:nx),
87 | & ndg5(nrf0:nx),ndg6(nrf0:nx)
88 | common /WN3ETA/ ndgnm3(nrf0:nx),ndgdn3(nrf0:nx),
89 | & nbknm3(nrf0:nx),nbkdn3(nrf0:nx)
90 | c..common storing residual coefficients to the FT visc model
91 | common /TRNFT/ ASftm(nrf0:nx,0:4),BSftm(nrf0:nx,0:4),
92 | & CSftm(nrf0:nx,0:4),ABftm(nrf0:nx,0:4),
93 | & BBftm(nrf0:nx,0:4),CBftm(nrf0:nx,0:4),
94 | & DBftm(nrf0:nx,0:4),EBftm(nrf0:nx,0:4)
95 |
96 | c..ECS transport--------------------------------------------------------
97 | common /TRNMOD/ hetamx,heta(nrf0:ncmax),htcxmx,htcx(nrf0:ncmax)
98 | common /TRNBIN/ xljs(nx,nx),xlje(nx,nx),xkij(nx,nx),xlij(nx,nx),
99 | & xaji(nx,nx),xkijk(nx,nx),xlijk(nx,nx),
100 | & xdij(nx,nx),xdij2(nx,nx)
101 | common /WLMTRN/ tmecst(nrf0:nx),txecst(nrf0:nx),pxecst(nrf0:nx),
102 | & Dxecst(nrf0:nx)
103 | common /WLJTRN/ sigtrn(nrf0:nx),epsktr(nrf0:nx)
104 | common /WCFTRN/ cpsi(nrf0:nx,mxtrn,4),cchi(nrf0:nx,mxtrn,4)
105 | c common /WIFTRN/ ipsi(nrf0:nx,0:mxtrn),ichi(nrf0:nx,0:mxtrn)
106 | c..iLJflag: flag for L-J parameters (if 0, estimate)
107 | c..nEuck: factor f_int in Eucken correlation
108 | c..npsi (viscosity shape factor): polynomial term, 2nd poly, spare
109 | c..nchi (conductivity shape factor): polynomial term, 2nd poly, spare
110 | common /WNTTRN/ iLJflag(nrf0:nx),nEuck(nrf0:nx),
111 | & npsi1(nrf0:nx),npsi2(nrf0:nx),npsi3(nrf0:nx),
112 | & nchi1(nrf0:nx),nchi2(nrf0:nx),nchi3(nrf0:nx)
113 |
114 | c..Parameters for Chung method------------------------------------------
115 | common /CHUNGPk/ acchk(nrf0:nx),ddipk(nrf0:nx),sigchk(nrf0:nx),
116 | & epschk(nrf0:nx),cctcx(nrf0:nx,mxtcxc,mtcxr),
117 | & tcx0ch,hbkk(nrf0:nx),naddk(nrf0:nx)
118 | common /CHUNGPv/ acchv(nrf0:nx),ddipv(nrf0:nx),sigchv(nrf0:nx),
119 | & epschv(nrf0:nx),cceta(nrf0:nx,mxetac,metar),
120 | & eta0ch,hbvk(nrf0:nx),naddv(nrf0:nx)
121 |
122 |
123 | !$omp threadprivate(/HCMOD/)
124 | !$omp threadprivate(/CREMOD/)
125 | !$omp threadprivate(/WCFOM1/)
126 | !$omp threadprivate(/WIFOM1/)
127 | !$omp threadprivate(/WCFOM2/)
128 | !$omp threadprivate(/WIFOM2/)
129 | !$omp threadprivate(/WCEUCK/)
130 | !$omp threadprivate(/OMGMOD/)
131 | !$omp threadprivate(/WLJTCX/)
132 | !$omp threadprivate(/WLMTCX/)
133 | !$omp threadprivate(/WRDTCX/)
134 | !$omp threadprivate(/WNTTCX/)
135 | !$omp threadprivate(/WCFTCX/)
136 | !$omp threadprivate(/WIFTCX/)
137 | !$omp threadprivate(/WLMTCK/)
138 | !$omp threadprivate(/WRDTCK/)
139 | !$omp threadprivate(/WNTTCK/)
140 | !$omp threadprivate(/WCFTCKe/)
141 | !$omp threadprivate(/WCFTCK/)
142 | !$omp threadprivate(/WIFTCK/)
143 | !$omp threadprivate(/CRTENH/)
144 | !$omp threadprivate(/WLMETA/)
145 | !$omp threadprivate(/WCFETA/)
146 | !$omp threadprivate(/WIFETA/)
147 | !$omp threadprivate(/WLJETA/)
148 | !$omp threadprivate(/WRDETA/)
149 | !$omp threadprivate(/WR3ETA/)
150 | !$omp threadprivate(/WNTETA/)
151 | !$omp threadprivate(/WN3ETA/)
152 | !$omp threadprivate(/TRNFT/)
153 | !$omp threadprivate(/TRNMOD/)
154 | !$omp threadprivate(/TRNBIN/)
155 | !$omp threadprivate(/WLMTRN/)
156 | !$omp threadprivate(/WLJTRN/)
157 | !$omp threadprivate(/WCFTRN/)
158 | !$omp threadprivate(/WNTTRN/)
159 | !$omp threadprivate(/CHUNGPk/)
160 | !$omp threadprivate(/CHUNGPv/)
161 | c!$omp threadprivate(/WIFTRN/)
162 |
163 | c
164 | c 1 2 3 4 5 6 7
165 | c23456789012345678901234567890123456789012345678901234567890123456789012
166 | c
167 | c ======================================================================
168 | c end file comtrn.for
169 | c ======================================================================
170 |
--------------------------------------------------------------------------------
/Source_Code/generator/generator.dsp:
--------------------------------------------------------------------------------
1 | # Microsoft Developer Studio Project File - Name="generator" - Package Owner=<4>
2 | # Microsoft Developer Studio Generated Build File, Format Version 6.00
3 | # ** DO NOT EDIT **
4 |
5 | # TARGTYPE "Win32 (x86) Console Application" 0x0103
6 |
7 | CFG=generator - Win32 Debug
8 | !MESSAGE This is not a valid makefile. To build this project using NMAKE,
9 | !MESSAGE use the Export Makefile command and run
10 | !MESSAGE
11 | !MESSAGE NMAKE /f "generator.mak".
12 | !MESSAGE
13 | !MESSAGE You can specify a configuration when running NMAKE
14 | !MESSAGE by defining the macro CFG on the command line. For example:
15 | !MESSAGE
16 | !MESSAGE NMAKE /f "generator.mak" CFG="generator - Win32 Debug"
17 | !MESSAGE
18 | !MESSAGE Possible choices for configuration are:
19 | !MESSAGE
20 | !MESSAGE "generator - Win32 Release" (based on "Win32 (x86) Console Application")
21 | !MESSAGE "generator - Win32 Debug" (based on "Win32 (x86) Console Application")
22 | !MESSAGE
23 |
24 | # Begin Project
25 | # PROP AllowPerConfigDependencies 0
26 | # PROP Scc_ProjName ""
27 | # PROP Scc_LocalPath ""
28 | CPP=cl.exe
29 | F90=df.exe
30 | RSC=rc.exe
31 |
32 | !IF "$(CFG)" == "generator - Win32 Release"
33 |
34 | # PROP BASE Use_MFC 0
35 | # PROP BASE Use_Debug_Libraries 0
36 | # PROP BASE Output_Dir "Release"
37 | # PROP BASE Intermediate_Dir "Release"
38 | # PROP BASE Target_Dir ""
39 | # PROP Use_MFC 0
40 | # PROP Use_Debug_Libraries 0
41 | # PROP Output_Dir "Release"
42 | # PROP Intermediate_Dir "Release"
43 | # PROP Target_Dir ""
44 | # ADD BASE F90 /compile_only /nologo /warn:nofileopt
45 | # ADD F90 /compile_only /nologo /warn:nofileopt
46 | # ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
47 | # ADD CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
48 | # ADD BASE RSC /l 0x419 /d "NDEBUG"
49 | # ADD RSC /l 0x419 /d "NDEBUG"
50 | BSC32=bscmake.exe
51 | # ADD BASE BSC32 /nologo
52 | # ADD BSC32 /nologo
53 | LINK32=link.exe
54 | # ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386
55 | # ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386
56 |
57 | !ELSEIF "$(CFG)" == "generator - Win32 Debug"
58 |
59 | # PROP BASE Use_MFC 0
60 | # PROP BASE Use_Debug_Libraries 1
61 | # PROP BASE Output_Dir "Debug"
62 | # PROP BASE Intermediate_Dir "Debug"
63 | # PROP BASE Target_Dir ""
64 | # PROP Use_MFC 0
65 | # PROP Use_Debug_Libraries 1
66 | # PROP Output_Dir "Debug"
67 | # PROP Intermediate_Dir "Debug"
68 | # PROP Target_Dir ""
69 | # ADD BASE F90 /check:bounds /compile_only /dbglibs /debug:full /nologo /traceback /warn:argument_checking /warn:nofileopt
70 | # ADD F90 /check:bounds /compile_only /dbglibs /debug:full /nologo /traceback /warn:argument_checking /warn:nofileopt
71 | # ADD BASE CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c
72 | # ADD CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c
73 | # ADD BASE RSC /l 0x419 /d "_DEBUG"
74 | # ADD RSC /l 0x419 /d "_DEBUG"
75 | BSC32=bscmake.exe
76 | # ADD BASE BSC32 /nologo
77 | # ADD BSC32 /nologo
78 | LINK32=link.exe
79 | # ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
80 | # ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /incremental:no /debug /machine:I386 /pdbtype:sept
81 |
82 | !ENDIF
83 |
84 | # Begin Target
85 |
86 | # Name "generator - Win32 Release"
87 | # Name "generator - Win32 Debug"
88 | # Begin Group "Source Files"
89 |
90 | # PROP Default_Filter "cpp;c;cxx;rc;def;r;odl;idl;hpj;bat;f90;for;f;fpp"
91 | # Begin Source File
92 |
93 | SOURCE=..\fortran\COMMONS.INI
94 | # End Source File
95 | # Begin Source File
96 |
97 | SOURCE=..\fortran\COMTRN.INI
98 | # End Source File
99 | # Begin Source File
100 |
101 | SOURCE=..\fortran\CORE_ANC.FOR
102 | DEP_F90_CORE_=\
103 | "..\fortran\COMMONS.INI"\
104 |
105 | # End Source File
106 | # Begin Source File
107 |
108 | SOURCE=..\fortran\CORE_BWR.FOR
109 | DEP_F90_CORE_B=\
110 | "..\fortran\COMMONS.INI"\
111 |
112 | # End Source File
113 | # Begin Source File
114 |
115 | SOURCE=..\fortran\CORE_CPP.FOR
116 | DEP_F90_CORE_C=\
117 | "..\fortran\COMMONS.INI"\
118 |
119 | # End Source File
120 | # Begin Source File
121 |
122 | SOURCE=..\fortran\CORE_DE.FOR
123 | DEP_F90_CORE_D=\
124 | "..\fortran\COMMONS.INI"\
125 |
126 | # End Source File
127 | # Begin Source File
128 |
129 | SOURCE=..\fortran\CORE_ECS.FOR
130 | DEP_F90_CORE_E=\
131 | "..\fortran\COMMONS.INI"\
132 |
133 | # End Source File
134 | # Begin Source File
135 |
136 | SOURCE=..\fortran\CORE_FEQ.FOR
137 | DEP_F90_CORE_F=\
138 | "..\fortran\COMMONS.INI"\
139 |
140 | # End Source File
141 | # Begin Source File
142 |
143 | SOURCE=..\fortran\CORE_MLT.FOR
144 | DEP_F90_CORE_M=\
145 | "..\fortran\COMMONS.INI"\
146 |
147 | # End Source File
148 | # Begin Source File
149 |
150 | SOURCE=..\fortran\CORE_PH0.FOR
151 | DEP_F90_CORE_P=\
152 | "..\fortran\COMMONS.INI"\
153 |
154 | # End Source File
155 | # Begin Source File
156 |
157 | SOURCE=..\fortran\CORE_PR.FOR
158 | DEP_F90_CORE_PR=\
159 | "..\fortran\COMMONS.INI"\
160 |
161 | # End Source File
162 | # Begin Source File
163 |
164 | SOURCE=..\fortran\CORE_QUI.FOR
165 | DEP_F90_CORE_Q=\
166 | "..\fortran\COMMONS.INI"\
167 |
168 | # End Source File
169 | # Begin Source File
170 |
171 | SOURCE=..\fortran\CORE_STN.FOR
172 | DEP_F90_CORE_S=\
173 | "..\fortran\COMMONS.INI"\
174 |
175 | # End Source File
176 | # Begin Source File
177 |
178 | SOURCE=..\fortran\FLASH2.FOR
179 | DEP_F90_FLASH=\
180 | "..\fortran\COMMONS.INI"\
181 |
182 | # End Source File
183 | # Begin Source File
184 |
185 | SOURCE=..\fortran\FLSH_SUB.FOR
186 | DEP_F90_FLSH_=\
187 | "..\fortran\COMMONS.INI"\
188 |
189 | # End Source File
190 | # Begin Source File
191 |
192 | SOURCE=..\fortran\IDEALGAS.FOR
193 | DEP_F90_IDEAL=\
194 | "..\fortran\COMMONS.INI"\
195 |
196 | # End Source File
197 | # Begin Source File
198 |
199 | SOURCE=..\fortran\MIX_AGA8.FOR
200 | DEP_F90_MIX_A=\
201 | "..\fortran\COMMONS.INI"\
202 |
203 | # End Source File
204 | # Begin Source File
205 |
206 | SOURCE=..\fortran\MIX_HMX.FOR
207 | DEP_F90_MIX_H=\
208 | "..\fortran\COMMONS.INI"\
209 | "..\fortran\COMTRN.INI"\
210 |
211 | # End Source File
212 | # Begin Source File
213 |
214 | SOURCE=..\fortran\PASS_FTN.FOR
215 | DEP_F90_PASS_=\
216 | "..\fortran\COMMONS.INI"\
217 |
218 | # End Source File
219 | # Begin Source File
220 |
221 | SOURCE=..\fortran\PROP_SUB.FOR
222 | DEP_F90_PROP_=\
223 | "..\fortran\COMMONS.INI"\
224 |
225 | # End Source File
226 | # Begin Source File
227 |
228 | SOURCE=..\fortran\REALGAS.FOR
229 | DEP_F90_REALG=\
230 | "..\fortran\COMMONS.INI"\
231 |
232 | # End Source File
233 | # Begin Source File
234 |
235 | SOURCE=..\..\..\RGP_gen_2\RGPgenerator.F90
236 | # End Source File
237 | # Begin Source File
238 |
239 | SOURCE=..\fortran\SAT_SUB.FOR
240 | DEP_F90_SAT_S=\
241 | "..\fortran\COMMONS.INI"\
242 |
243 | # End Source File
244 | # Begin Source File
245 |
246 | SOURCE=..\fortran\SETUP.FOR
247 | DEP_F90_SETUP=\
248 | "..\fortran\COMMONS.INI"\
249 | "..\fortran\COMTRN.INI"\
250 |
251 | # End Source File
252 | # Begin Source File
253 |
254 | SOURCE=..\fortran\SETUP2.FOR
255 | DEP_F90_SETUP2=\
256 | "..\fortran\COMMONS.INI"\
257 | "..\fortran\COMTRN.INI"\
258 |
259 | # End Source File
260 | # Begin Source File
261 |
262 | SOURCE=..\fortran\TRNS_ECS.FOR
263 | DEP_F90_TRNS_=\
264 | "..\fortran\COMMONS.INI"\
265 | "..\fortran\COMTRN.INI"\
266 |
267 | # End Source File
268 | # Begin Source File
269 |
270 | SOURCE=..\fortran\TRNS_TCX.FOR
271 | DEP_F90_TRNS_T=\
272 | "..\fortran\COMMONS.INI"\
273 | "..\fortran\COMTRN.INI"\
274 |
275 | # End Source File
276 | # Begin Source File
277 |
278 | SOURCE=..\fortran\TRNS_VIS.FOR
279 | DEP_F90_TRNS_V=\
280 | "..\fortran\COMMONS.INI"\
281 | "..\fortran\COMTRN.INI"\
282 |
283 | # End Source File
284 | # Begin Source File
285 |
286 | SOURCE=..\fortran\TRNSP.FOR
287 | DEP_F90_TRNSP=\
288 | "..\fortran\COMMONS.INI"\
289 | "..\fortran\COMTRN.INI"\
290 |
291 | # End Source File
292 | # Begin Source File
293 |
294 | SOURCE=..\fortran\UTILITY.FOR
295 | DEP_F90_UTILI=\
296 | "..\fortran\COMMONS.INI"\
297 | "..\fortran\COMTRN.INI"\
298 |
299 | # End Source File
300 | # End Group
301 | # Begin Group "Header Files"
302 |
303 | # PROP Default_Filter "h;hpp;hxx;hm;inl;fi;fd"
304 | # End Group
305 | # Begin Group "Resource Files"
306 |
307 | # PROP Default_Filter "ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"
308 | # End Group
309 | # End Target
310 | # End Project
311 |
--------------------------------------------------------------------------------
/Source_Code/fortran/REALGAS.FOR:
--------------------------------------------------------------------------------
1 | c begin file realgas.f
2 | c
3 | c This file contains the routines implementing the real-gas part of
4 | c the thermodynamic functions. They call the corresponding "core"
5 | c routines for the specified component or mixture.
6 | c
7 | c contained here are:
8 | c function PHIK (icomp,itau,idel,tau,del)
9 | c function PHIX (itau,idel,tau,del,x)
10 | c subroutine REDK (icomp,tred,Dred)
11 | c subroutine REDX (x,tred,Dred)
12 | c
13 | c ======================================================================
14 | c ======================================================================
15 | c
16 | function PHIK (icomp,itau,idel,tau,del)
17 | c
18 | c compute reduced Helmholtz energy or a derivative as functions
19 | c of dimensionless temperature and density; calls the appropriate
20 | c core function
21 | c
22 | c inputs:
23 | c icomp--pointer specifying component (1..nc)
24 | c itau--flag specifying order of temperature derivative to calc
25 | c idel--flag specifying order of density derivative to calculate
26 | c when itau = 0 and idel = 0, compute A/RT
27 | c when itau = 0 and idel = 1, compute 1st density derivative
28 | c when itau = 1 and idel = 1, compute cross derivative
29 | c etc.
30 | c tau--dimensionless temperature (To/T)
31 | c del--dimensionless density (D/Do)
32 | c output (as function value):
33 | c phi--residual (real-gas) part of the Helmholtz energy, or one
34 | c of its derivatives (as specified by itau and idel),
35 | c in reduced form (A/RT)
36 | c
37 | c The Helmholtz energy consists of ideal and residual (real-gas)
38 | c terms; this routine calculates only the residual part.
39 | c
40 | c This function computes pure component properties only.
41 | c
42 | c written by M. McLinden, NIST Thermophysics Division, Boulder, Colorado
43 | c 02-07-96 MM, original version
44 | c 02-27-96 MM, parameter n0=-ncmax to accommodate ECS-thermo model
45 | c 03-22-96 MM, replace /MODEL/ with /EOSMOD/
46 | c 03-05-98 MM, do not check mix model (heos) on branch
47 | c 07-21-03 EWL, add Peng-Robinson check
48 | c
49 | implicit double precision (a-h,o-z)
50 | implicit integer (i-n)
51 | character*3 hpheq,heos,hmxeos,hmodcp
52 | c
53 | parameter (ncmax=20) !max number of components in mixture
54 | parameter (nrefmx=10) !max number of fluids for transport E
55 | parameter (n0=-ncmax-nrefmx,nx=ncmax)
56 | common /EOSMOD/ hpheq,heos,hmxeos(n0:nx),hmodcp(n0:nx)
57 | c
58 | if (del.le.1.0d-10) then !trivial solution at zero density
59 | phik=0.0d0 !for any and all derivatives
60 | RETURN
61 | end if
62 | c
63 | if (hmxeos(icomp)(1:2).eq.'FE') then
64 | phik=PHIFEQ (icomp,itau,idel,tau,del)
65 | else if (hmxeos(icomp).eq.'QUI') then
66 | phik=PHIQUI (icomp,itau,idel,tau,del)
67 | else if (hmxeos(icomp).eq.'BWR') then
68 | phik=PHIBWR (icomp,itau,idel,tau,del)
69 | else if (hmxeos(icomp).eq.'ECS') then
70 | phik=PHIECS (icomp,itau,idel,tau,del)
71 | else if (hmxeos(icomp).eq.'PR') then
72 | phik=PHIPR (icomp,itau,idel,tau,del)
73 | else
74 | c model not found, but no way to return an error from here
75 | c write (*,*) ' PHIK--model not found: ',heos,' ',hmxeos(icomp)
76 | phik=-9.99d99
77 | end if
78 | c
79 | RETURN
80 | end !function PHIK
81 | c
82 | c ======================================================================
83 | c
84 | function PHIX (itau,idel,tau,del,x)
85 | c
86 | c compute reduced Helmholtz energy or a derivative as functions
87 | c of dimensionless temperature and density by calling the appropriate
88 | c mixture model
89 | c
90 | c inputs:
91 | c itau--flag specifying order of temperature derivative to calc
92 | c idel--flag specifying order of density derivative to calculate
93 | c when itau = 0 and idel = 0, compute A/RT
94 | c when itau = 0 and idel = 1, compute 1st density derivative
95 | c when itau = 1 and idel = 1, compute cross derivative
96 | c etc.
97 | c tau--dimensionless temperature (To/T)
98 | c del--dimensionless density (D/Do)
99 | c x--composition array (mol frac)
100 | c output (as function value):
101 | c phi--residual (real-gas) part of the Helmholtz energy, or one
102 | c of its derivatives (as specified by itau and idel),
103 | c in reduced form (A/RT)
104 | c
105 | c N.B. The reducing parameters To and Do are often, but not
106 | c necessarily, equal to the critical temperature and density.
107 | c
108 | c The Helmholtz energy consists of ideal gas and residual (real-
109 | c gas) terms. The residual term consists of ideal-solution and
110 | c mixing terms. This routine calculates only the residual term.
111 | c
112 | c written by M. McLinden, NIST Thermophysics Division, Boulder, Colorado
113 | c 02-07-96 MM, original version
114 | c 02-27-96 MM, parameter n0=-ncmax to accommodate ECS-thermo model
115 | c 03-22-96 MM, replace /MODEL/ with /EOSMOD/
116 | c 10-10-96 MM, if (nc = 1) call PHIK, rather than model-specific PHIxxx
117 | c 10-30-02 EWL, add AGA8 mixture model
118 | c 07-21-03 EWL, add Peng-Robinson check
119 | c
120 | implicit double precision (a-h,o-z)
121 | implicit integer (i-k,m,n)
122 | character*3 hpheq,heos,hmxeos,hmodcp
123 | c
124 | parameter (ncmax=20) !max number of components in mixture
125 | parameter (nrefmx=10) !max number of fluids for transport E
126 | parameter (n0=-ncmax-nrefmx,nx=ncmax)
127 | common /NCOMP/ nc,ic
128 | common /EOSMOD/ hpheq,heos,hmxeos(n0:nx),hmodcp(n0:nx)
129 | dimension x(ncmax)
130 | c
131 | c
132 | phix=0.0d0
133 | if (del.le.1.0d-10) RETURN !trivial solution at zero density
134 | c
135 | call ISPURE (x,icomp)
136 | if (icomp.ne.0) then
137 | phix=PHIK(icomp,itau,idel,tau,del)
138 | else
139 | c call HMX model
140 | if (heos.eq.'HMX') then
141 | phix=PHIHMX(itau,idel,tau,del,x)
142 | c call AGA8 model
143 | elseif (heos.eq.'AGA') then
144 | phix=PHIAGA(itau,idel,tau,del,x)
145 | c call Peng-Robinson model
146 | elseif (heos.eq.'PR') then
147 | phix=PHIPRX(itau,idel,tau,del,x)
148 | end if
149 | end if
150 | c
151 | RETURN
152 | end !function PHIX
153 | c
154 | c ======================================================================
155 | c
156 | subroutine REDK (icomp,tred,Dred)
157 | c
158 | c returns reducing parameters associated with a pure fluid EOS;
159 | c used to calculate the 'tau' and 'del' which are the independent
160 | c variables in the EOS
161 | c
162 | c N.B. The reducing parameters are often, but not always, equal
163 | c to the critical temperature and density.
164 | c
165 | c input:
166 | c icomp--component number in mixture (1..nc); 1 for pure fluid
167 | c outputs:
168 | c tred--reducing temperature [K]
169 | c Dred--reducing molar density [mol/L]
170 | c
171 | c written by M. McLinden, NIST Thermophysics Division, Boulder, Colorado
172 | c 02-27-96 MM, original version, adapted from REDFEQ and PHIK
173 | c 03-22-96 MM, replace /MODEL/ with /EOSMOD/
174 | c 03-05-98 MM, do not check mix model (heos) on branch
175 | c
176 | implicit double precision (a-h,o-z)
177 | implicit integer (i-n)
178 | character*3 hpheq,heos,hmxeos,hmodcp
179 | c
180 | parameter (ncmax=20) !max number of components in mixture
181 | parameter (nrefmx=10) !max number of fluids for transport E
182 | parameter (n0=-ncmax-nrefmx,nx=ncmax)
183 | common /EOSMOD/ hpheq,heos,hmxeos(n0:nx),hmodcp(n0:nx)
184 | c
185 | if (hmxeos(icomp)(1:2).eq.'FE') then
186 | call REDFEQ (icomp,tred,Dred)
187 | c write (*,1001) icomp,tred,Dred
188 | else if (hmxeos(icomp).eq.'QUI') then
189 | call REDQUI (icomp,tred,Dred)
190 | c write (*,1001) icomp,tred,Dred
191 | else if (hmxeos(icomp).eq.'BWR') then
192 | call CRTBWR (icomp,tred,pcrit,Dred)
193 | c write (*,1001) icomp,tred,Dred
194 | c1001 format (1x,' REDK--icomp,tred,Dred: ',i2,2e14.6)
195 | else if (hmxeos(icomp).eq.'ECS') then
196 | call CRTECS (icomp,tred,pcrit,Dred)
197 | else if (hmxeos(icomp).eq.'PR') then
198 | call CRTPR (icomp,tred,pcrit,Dred)
199 | else
200 | c model not found, but no way to return an error from here
201 | c write (*,1100) icomp,hmxeos(icomp)
202 | c1100 format (1x,' REDK--model not found for icomp = ',i3,': ',a3)
203 | tred=9.99d99
204 | Dred=9.99d99
205 | end if
206 | c
207 | RETURN
208 | end !subroutine REDK
209 | c
210 | c ======================================================================
211 | c
212 | subroutine REDX (x,tred,Dred)
213 | c
214 | c returns reducing parameters associated with mixture EOS;
215 | c used to calculate the 'tau' and 'del' which are the independent
216 | c variables in the EOS
217 | c
218 | c input:
219 | c x--composition array [mol frac]
220 | c outputs:
221 | c tred--reducing temperature [K]
222 | c Dred--reducing molar density [mol/L]
223 | c
224 | c written by M. McLinden, NIST Thermophysics Division, Boulder, Colorado
225 | c 02-27-96 MM, original version; adapted from REDHMX and PHIX
226 | c 03-11-96 MM, parameter n0=-ncmax to accommodate ECS-thermo model
227 | c (missed in original version)
228 | c 03-22-96 MM, replace /MODEL/ with /EOSMOD/
229 | c 10-10-96 MM, if (nc = 1) call REDK, rather than model-specific routine
230 | c
231 | implicit double precision (a-h,o-z)
232 | implicit integer (i-k,m,n)
233 | c
234 | character*3 hpheq,heos,hmxeos,hmodcp
235 | parameter (ncmax=20) !max number of components in mixture
236 | parameter (nrefmx=10) !max number of fluids for transport E
237 | parameter (n0=-ncmax-nrefmx,nx=ncmax)
238 | common /NCOMP/ nc,ic
239 | common /EOSMOD/ hpheq,heos,hmxeos(n0:nx),hmodcp(n0:nx)
240 | dimension x(ncmax)
241 | c
242 | call ISPURE (x,icomp)
243 | if (icomp.ne.0) then
244 | call REDK (icomp,tred,Dred)
245 | else
246 | if (heos.eq.'HMX') then
247 | call REDHMX (x,tred,Dred)
248 | elseif (heos.eq.'AGA') then
249 | call REDHMX (x,tred,Dred)
250 | elseif (heos.eq.'PR') then
251 | call REDPR (x,tred,Dred)
252 | end if
253 | end if
254 | c
255 | RETURN
256 | end !subroutine REDX
257 | c
258 | c
259 | c 1 2 3 4 5 6 7
260 | c23456789012345678901234567890123456789012345678901234567890123456789012
261 | c
262 | c ======================================================================
263 | c end file realgas.f
264 | c ======================================================================
265 |
--------------------------------------------------------------------------------
/Source_Code/fortran/CORE_DE.FOR:
--------------------------------------------------------------------------------
1 | c begin file core_DE.f
2 | c
3 | c This file contains core routines for the dielectric constant.
4 | c
5 | c contained here are:
6 | c subroutine DIELEC (t,rho,x,de)
7 | c subroutine SETDE (nread,icomp,hcasno,ierr,herr)
8 | c subroutine DEK (icomp,t,rho,de,ierr,herr)
9 | c
10 | c ======================================================================
11 | c ======================================================================
12 | c
13 | subroutine DIELEC (t,rho,x,de)
14 | c
15 | c compute the dielectric constant as a function of temperature, density,
16 | c and composition.
17 | c
18 | c inputs:
19 | c t--temperature [K]
20 | c rho--molar density [mol/L]
21 | c x--composition [array of mol frac]
22 | c output:
23 | c de--dielectric constant
24 | c
25 | c written by E.W. Lemmon, NIST Physical & Chem Properties Div, Boulder, CO
26 | c 07-01-98 EWL, original version
27 | c 08-05-04 EWL, add mixture equation
28 | c 03-02-05 EWL, add error checking
29 | c
30 | implicit double precision (a-h,o-z)
31 | implicit integer (i-k,m,n)
32 | c
33 | cDEC$ ATTRIBUTES DLLEXPORT :: DIELEC
34 | c dll_export DIELEC
35 | c
36 | parameter (ncmax=20) !max number of components in mixture
37 | parameter (nrefmx=10) !max number of fluids for transport ECS
38 | parameter (n0=-ncmax-nrefmx,nx=ncmax)
39 | dimension x(ncmax)
40 | character*1 htab,hnull
41 | character*3 hdiel,hdielk
42 | character*255 herr
43 | common /HCHAR/ htab,hnull
44 | common /NCOMP/ nc,ic
45 | common /DEMOD/ hdiel,hdielk(n0:nx)
46 | common /Gcnst/ R,tz(n0:nx),rhoz(n0:nx)
47 | call ISPURE (x,icomp)
48 | if (icomp.ne.0) then
49 | c special case--pure component
50 | call DEK (icomp,t,rho,de,ierr,herr)
51 | else if (hdiel.eq.'DEX' .or. hdiel.eq.'DEM') then
52 | c mixture calculation (from Harvey and Lemmon, 2005)
53 | vz=0.d0
54 | pm=0.d0
55 | do i=1,nc
56 | vz=vz+x(i)/rhoz(i)
57 | enddo
58 | dr=rho*vz
59 | do i=1,nc
60 | call DEK (i,t,dr*rhoz(i),dei,ierr,herr)
61 | if (ierr.ne.0) then
62 | de=0.d0
63 | RETURN
64 | endif
65 | p=(dei-1.d0)*(2.d0*dei+1.d0)/9.d0/dei
66 | pm=pm+x(i)/rhoz(i)/vz*p
67 | enddo
68 | de=0.25d0*(1.d0+9.d0*pm+3.d0*SQRT(9.d0*pm**2+2.d0*pm+1.d0))
69 | else
70 | ierr=99
71 | de=-9.999d6
72 | write (herr,1199) hdiel,hnull
73 | call ERRMSG (ierr,herr)
74 | 1199 format ('[DE error 99] ',
75 | & 'unknown dielectric constant model: (',a3,')',a1)
76 | c write (*,*) ' DE--output de (ierr = 99): ',de
77 | end if
78 | c
79 | RETURN
80 | end !subroutine DIELEC
81 | c
82 | c ======================================================================
83 | c
84 | subroutine SETDE (nread,icomp,hcasno,ierr,herr)
85 | c
86 | c set up working arrays for use with "DE" dielectric constant model
87 | c
88 | c inputs:
89 | c nread--file to read data from (file should have already been
90 | c opened and pointer set by subroutine SETUP)
91 | c icomp--component number in mixture (1..nc); 1 for pure fluid
92 | c hcasno--CAS number of component icomp (not required, it is here
93 | c to maintain parallel structure with SETBWR and SETFEQ)
94 | c
95 | c outputs:
96 | c ierr--error flag: 0 = successful
97 | c 101 = error (e.g. fluid not found)
98 | c herr--error string (character*255 variable if ierr<>0)
99 | c other quantities returned via arrays in commons
100 | c
101 | c written by E.W. Lemmon, NIST Thermophysics Division, Boulder, Colorado
102 | c 07-01-98 EWL, original version
103 | c
104 | implicit double precision (a-h,o-z)
105 | implicit integer (i-n)
106 | parameter (ncmax=20) !max number of components in mixture
107 | parameter (nrefmx=10) !max number of fluids for transport ECS
108 | parameter (n0=-ncmax-nrefmx,nx=ncmax)
109 | parameter (ndecf=15) !max number of terms in de summation
110 | character*1 htab,hnull
111 | character*3 hdiel,hdielk
112 | character*12 hcasno
113 | character*255 herr
114 | common /HCHAR/ htab,hnull
115 | common /DEMOD/ hdiel,hdielk(n0:nx)
116 | common /WLMDE/ tmin(n0:nx),tmax(n0:nx)
117 | common /WNTDE/ nterm1(n0:nx),nterm2(n0:nx),nterm3(n0:nx),
118 | & nterm4(n0:nx),nterm5(n0:nx),nterm6(n0:nx)
119 | common /WCFDE/ decf(n0:nx,ndecf),deexpt(n0:nx,ndecf),
120 | & deexpd(n0:nx,ndecf),deexpp(n0:nx,ndecf)
121 | common /WRDDE/ tred(n0:nx),dred(n0:nx),pred(n0:nx)
122 | c
123 | if (nread.le.0) then
124 | ierr=101
125 | write (herr,1101) nread,hcasno,hnull
126 | call ERRMSG (ierr,herr)
127 | 1101 format ('[SETDE error 101] illegal file specified; nread = ',
128 | & i4,'; CAS no. = ',a12,a1)
129 | RETURN
130 | else
131 | herr=' '
132 | ierr=0
133 | end if
134 | c
135 | c read data from file
136 | c write (*,*) ' SETDE--read component',icomp,' from unit',nread
137 | read (nread,*) tmin(icomp) !lower temperature limit
138 | read (nread,*) tmax(icomp) !upper temperature limit
139 | c the pressure and density limit are not presently used,
140 | c but are contained in the file for consistency and possible future use;
141 | c skip over them in reading the file
142 | read (nread,*) !pjunk !upper pressure limit (n/a)
143 | read (nread,*) !rhojnk !upper density limit (n/a)
144 | c read reducing parameters and coefficients
145 | read (nread,*) tred(icomp),dred(icomp),pred(icomp)
146 | read (nread,*) nterm1(icomp),nterm2(icomp),nterm3(icomp),
147 | & nterm4(icomp),nterm5(icomp),nterm6(icomp)
148 | do k=1,nterm1(icomp)
149 | read (nread,*) decf(icomp,k),deexpt(icomp,k),deexpd(icomp,k),
150 | & deexpp(icomp,k)
151 | enddo
152 | do k=1,nterm2(icomp)
153 | j=k+nterm1(icomp)
154 | read (nread,*) decf(icomp,j),deexpt(icomp,j),deexpd(icomp,j),
155 | & deexpp(icomp,j)
156 | enddo
157 | do k=1,nterm3(icomp)
158 | j=k+nterm1(icomp)+nterm2(icomp)
159 | read (nread,*) decf(icomp,j),deexpt(icomp,j),deexpd(icomp,j),
160 | & deexpp(icomp,j)
161 | enddo
162 | c
163 | RETURN
164 | end !subroutine SETDE
165 | c
166 | c ======================================================================
167 | c
168 | subroutine DEK (icomp,t,rho,de,ierr,herr)
169 | c
170 | c compute dielectric constant with appropriate core model
171 | c
172 | c inputs:
173 | c icomp--component i
174 | c tau--dimensionless temperature (1 - T/Tc)
175 | c output:
176 | c de--dielectric constant [N/m]
177 | c ierr--error flag: 0 = successful
178 | c 1 = successful
179 | c herr--error string (character*255 variable if ierr<>0)
180 | c
181 | c written by E.W. Lemmon, NIST Physical & Chemical Properties Division, Boulder, Colorado
182 | c 04-17-97 EWL, original version (based on DE)
183 | c 09-02-99 EWL, return if pi<0
184 | c 08-05-04 EWL, add DE3 and DE4
185 | c 02-22-10 EWL, add check for tau=1
186 | c
187 | implicit double precision (a-h,o-z)
188 | implicit integer (i-n)
189 | c
190 | parameter (ncmax=20) !max number of components in mixture
191 | parameter (nrefmx=10) !max number of fluids for transport ECS
192 | parameter (n0=-ncmax-nrefmx,nx=ncmax)
193 | parameter (ndecf=15) !max number of terms in de summation
194 | character*1 htab,hnull
195 | character*3 hdiel,hdielk
196 | character*255 herr
197 | double precision na,mu,kk
198 | dimension x(ncmax)
199 | common /NCOMP/ nc,ic
200 | common /HCHAR/ htab,hnull
201 | common /DEMOD/ hdiel,hdielk(n0:nx)
202 | common /WNTDE/ nterm1(n0:nx),nterm2(n0:nx),nterm3(n0:nx),
203 | & nterm4(n0:nx),nterm5(n0:nx),nterm6(n0:nx)
204 | common /WCFDE/ decf(n0:nx,ndecf),deexpt(n0:nx,ndecf),
205 | & deexpd(n0:nx,ndecf),deexpp(n0:nx,ndecf)
206 | common /WRDDE/ tred(n0:nx),dred(n0:nx),pred(n0:nx)
207 | c
208 | de=0
209 | ierr=0
210 | herr=' '
211 | c
212 | if (rho.lt.1.d-12) then
213 | de=1.d0
214 | elseif (hdielk(icomp).eq.'DE1') then
215 | call press(t,rho,x,p)
216 | pi=p/1000.0d0/pred(icomp)
217 | if (pi.lt.0) return
218 | del=rho/dred(icomp)
219 | tau=t/tred(icomp)
220 | cm=0.0d0
221 | do k=1,nterm1(icomp)
222 | cm=cm+decf(icomp,k)*tau**deexpt(icomp,k)*del**deexpd(icomp,k)
223 | & *pi**deexpp(icomp,k)
224 | enddo
225 | do k=1,nterm2(icomp)
226 | j=k+nterm1(icomp)
227 | cm=cm+decf(icomp,j)*tau**deexpt(icomp,j)*del**deexpd(icomp,j)
228 | & *pi**deexpp(icomp,j)*log(1.0d0+1.0d0/tau)
229 | enddo
230 | de=(1.0d0+2.0d0*cm)/(1.0d0-cm)
231 | elseif (hdielk(icomp).eq.'DE2') then
232 | na=6.0221367d23 !1/mol
233 | alpha=1.636d-40 !C^2.m^2/J
234 | mu=6.138d-30 !C.m
235 | eps=8.854187817d-12 !C^2/J.m
236 | kk=1.380658d-23 !J/K
237 | del=rho/dred(icomp)
238 | tau=tred(icomp)/t
239 | g=1
240 | do k=1,nterm1(icomp)
241 | g=g+decf(icomp,k)*tau**deexpt(icomp,k)*del**deexpd(icomp,k)
242 | enddo
243 | do k=1,nterm2(icomp)
244 | j=k+nterm1(icomp)
245 | t1=t/deexpt(icomp,j)-1.d0
246 | if (t1.le.0) RETURN
247 | g=g+decf(icomp,j)*del**deexpd(icomp,j)/t1**deexpp(icomp,j)
248 | enddo
249 | c
250 | c Harris-Alder model:
251 | a = 1000.d0*na*rho*g*mu**2/(eps*kk*t)
252 | b = 1000.d0*na*rho*alpha/(3.d0*eps)
253 | c = dsqrt(9.d0 + 2.d0*a + 18.d0*b + a**2 + 10.d0*a*b+9.d0*b**2)
254 | de = (1.d0 + a + 5.d0*b + c)/(4.d0 - 4.d0*b)
255 | elseif (hdielk(icomp).eq.'DE3' .or. hdielk(icomp).eq.'DE4') then
256 | del=rho/dred(icomp)
257 | tau= t /tred(icomp)
258 | cm=0.0d0
259 | do k=1,nterm1(icomp)
260 | cm=cm+decf(icomp,k)*tau**deexpt(icomp,k)*del**deexpd(icomp,k)
261 | enddo
262 | do k=1,nterm2(icomp)
263 | j=k+nterm1(icomp)
264 | if (abs(tau-1.d0).lt.1.d-20 .and.
265 | & abs(deexpt(icomp,j)).lt.1.d-20) then
266 | cm=cm+decf(icomp,j)*del**deexpd(icomp,j)
267 | else
268 | cm=cm+decf(icomp,j)*(tau-1.d0)**deexpt(icomp,j)
269 | & *del**deexpd(icomp,j)
270 | endif
271 | enddo
272 | do k=1,nterm3(icomp)
273 | j=k+nterm1(icomp)+nterm2(icomp)
274 | if (abs(tau-1.d0).lt.1.d-20 .and.
275 | & abs(deexpt(icomp,j)).lt.1.d-20) then
276 | cm=cm+decf(icomp,j)*del**deexpd(icomp,j)
277 | else
278 | cm=cm+decf(icomp,j)*(1.d0/tau-1.d0)**deexpt(icomp,j)
279 | & *del**deexpd(icomp,j)
280 | endif
281 | enddo
282 | if (hdielk(icomp).eq.'DE3') then
283 | de=(1.0d0+2.0d0*cm)/(1.0d0-cm)
284 | else
285 | de=0.25d0*(1.d0+9.d0*cm+3.d0*SQRT(9.d0*cm**2+2.d0*cm+1.d0))
286 | endif
287 | else
288 | ierr=1
289 | de=-9.99999d6
290 | write (herr,1099) hdielk(icomp),hnull
291 | call ERRMSG (ierr,herr)
292 | 1099 format ('[DE error 99] ',
293 | & 'unknown dielectric constant model: (',a3,')',a1)
294 | end if
295 | c write (*,1200) icomp,tau,de
296 | c1200 format (' DEK--icomp,tau,de: ',i4,2f11.6)
297 | c
298 | RETURN
299 | end !subroutine DEK
300 | c
301 | c
302 | c 1 2 3 4 5 6 7
303 | c23456789012345678901234567890123456789012345678901234567890123456789012
304 | c
305 | c ======================================================================
306 | c end file core_DE.f
307 | c ======================================================================
308 |
--------------------------------------------------------------------------------
/Source_Code/fortran/CMNS.FOR:
--------------------------------------------------------------------------------
1 | subroutine SETINFOdll (icomp,wmm,ttrp,tnbpt,tc,pc,Dc,Zc,
2 | & acf,dip,Rgas)
3 | cDEC$ ATTRIBUTES DLLEXPORT, Alias: "_SETINFOdll"::SETINFOdll
4 | C cDEC$ ATTRIBUTES STDCALL, REFERENCE::SETINFOdll
5 | implicit double precision (a-h,o-z)
6 | implicit integer (i-n)
7 | c dll_export SETINFOdll
8 | parameter (ncmax=20) !max number of components in mixture
9 | parameter (refmax=10) !max number of fluids for transport ECS
10 | parameter (n0=-ncmax-refmax,nx=ncmax)
11 | common /NCOMP/ nc,ic
12 | common /CCON/ tcrit(n0:nx),pcrit(n0:nx),Dcrit(n0:nx),Zcrit(n0:nx),
13 | & ttp(n0:nx),ptp(n0:nx),dtp(n0:nx),dtpv(n0:nx),
14 | & tnbp(n0:nx),dnbpl(n0:nx),dnbpv(n0:nx),
15 | & wm(n0:nx),accen(n0:nx),dipole(n0:nx),Reos(n0:nx)
16 | common /Gcnst/ R,tz(n0:nx),rhoz(n0:nx)
17 | c
18 | if (abs(icomp).le.nc) then
19 | wm(icomp)=wmm
20 | ttp(icomp)=ttrp
21 | tnbp(icomp)=tnbpt
22 | tcrit(icomp)=tc
23 | pcrit(icomp)=pc
24 | Dcrit(icomp)=Dc
25 | Zcrit(icomp)=Zc
26 | accen(icomp)=acf
27 | dipole(icomp)=dip
28 | R=Rgas
29 | else
30 | wmm=0.0d0
31 | ttrp=0.0d0
32 | tnbpt=0.0d0
33 | tc=0.0d0
34 | pc=0.0d0
35 | Dc=0.0d0
36 | Zc=0.0d0
37 | acf=0.0d0
38 | dip=0.0d0
39 | Rgas=R
40 | end if
41 | c
42 |
43 | end
44 | c ======================================================================
45 | subroutine GETINFOdll (icomp,wmm,ttrp,tnbpt,
46 | & tc,pc,Dc,Zc,acf,dip,Rgas)
47 | implicit double precision (a-h,o-z)
48 | implicit integer (i-n)
49 | cDEC$ ATTRIBUTES DLLEXPORT, Alias: "_GETINFOdll"::GETINFOdll
50 | C cDEC$ ATTRIBUTES STDCALL, REFERENCE::GETINFOdll
51 | c dll_export GETINFOdll
52 | call INFO (icomp,wmm,ttrp,tnbpt,tc,pc,Dc,Zc,acf,dip,Rgas)
53 | end
54 | c ======================================================================
55 | subroutine GETCMNdll (tc,rhoc,pc,tred,rhored,
56 | & n1,n2,coefhmx,n3,n4,coefcp0,coefxk)
57 | implicit double precision (a-h,o-z)
58 | implicit integer (i-n)
59 | parameter (ncmax=20) !max number of components in mixture
60 | parameter (refmax=10) !max number of fluids for transport ECS
61 | parameter (ncppmx=20) !max number of Cp0 terms
62 | parameter (n0=-ncmax-refmax,nx=ncmax)
63 | parameter (mxtrm=72)
64 | parameter (mxcoef=72)
65 | dimension coefhmx(mxcoef),coefcp0(mxcoef),coefxk(mxcoef)
66 | common /Gcnst/ R,tz(n0:nx),rhoz(n0:nx)
67 | common /WNTFEQ/ ntermf(n0:nx),ncoeff(n0:nx),
68 | & ntp(n0:nx),ndp(n0:nx),nlp(n0:nx),
69 | & ncrt(n0:nx),ncfcrt(n0:nx),
70 | & nspare(n0:nx),ncfsp(n0:nx)
71 | common /WCFFEQ/ a(n0:nx,mxtrm),ti(n0:nx,mxtrm),di(n0:nx,mxtrm),
72 | & gi(n0:nx,mxtrm),gi2(n0:nx,mxtrm),
73 | & dli(n0:nx,mxtrm),tli(n0:nx,mxtrm),
74 | & tpower(n0:nx,mxtrm),dpower(n0:nx,mxtrm),
75 | & dlpower(n0:nx,mxtrm),
76 | & rho0feq(n0:nx),t0feq(n0:nx),
77 | & pcfeq(n0:nx),rhocfeq(n0:nx),tcfeq(n0:nx),
78 | & wmf(n0:nx),Rfeq(n0:nx),
79 | & pminfeq(n0:nx),rhotp(n0:nx),tminfeq(n0:nx),
80 | & tmaxfeq(n0:nx),pmaxfeq(n0:nx)
81 | common /WNTCPP/ ntermc(n0:nx),nterme(n0:nx),ncosh(n0:nx),
82 | & nsinh(n0:nx),nsp1(n0:nx),nsp2(n0:nx),nsp3(n0:nx)
83 | common /WCPCPP/ cpc(n0:nx,ncppmx),xk(n0:nx,ncppmx),
84 | & cph(n0:nx,ncppmx),xth(n0:nx,ncppmx),
85 | & xh(n0:nx,ncppmx)
86 | common /CPPSAV/ cp0sav(n0:nx),cpisav(n0:nx),cptsav(n0:nx),
87 | & tsav(n0:nx)
88 | cDEC$ ATTRIBUTES DLLEXPORT, Alias: "_GETCMNdll"::GETCMNdll
89 | C cDEC$ ATTRIBUTES DLLEXPORT, Alias: "_GETCMNdll@48"::GETCMNdll
90 | C cDEC$ ATTRIBUTES STDCALL, REFERENCE::GETCMNdll
91 | c
92 | c dll_export GETCMNdll
93 | do i=1,mxcoef
94 | coefhmx(i)=0.d0
95 | coefcp0(i)=0.d0
96 | coefxk(i)=0.d0
97 | enddo
98 | tred=tz(1)
99 | rhored=rhoz(1)
100 | tc=tcfeq(1)
101 | rhoc=rhocfeq(1)
102 | pc=pcfeq(1)
103 | n1=ntermf(1)
104 | n2=ncrt(1)
105 | do i=1,n1+n2
106 | coefhmx(i)=a(1,i)
107 | enddo
108 | n3=ntermc(1)
109 | n4=nterme(1)
110 | do j=1,n3+n4
111 | coefcp0(j)=cpc(1,j)
112 | coefxk(j)=xk(1,j)
113 | enddo
114 | end
115 | c ======================================================================
116 | subroutine SETCMNdll (tc,rhoc,pc,tred,rhored,
117 | & n1,n2,coefhmx,n3,n4,coefcp0,coefxk)
118 | implicit double precision (a-h,o-z)
119 | implicit integer (i-n)
120 | parameter (ncmax=20) !max number of components in mixture
121 | parameter (refmax=10) !max number of fluids for transport ECS
122 | parameter (ncppmx=20) !max number of Cp0 terms
123 | parameter (n0=-ncmax-refmax,nx=ncmax)
124 | parameter (mxtrm=72)
125 | parameter (mxcoef=72)
126 | dimension coefhmx(mxcoef),coefcp0(mxcoef),coefxk(mxcoef)
127 | common /Gcnst/ R,tz(n0:nx),rhoz(n0:nx)
128 | common /WNTFEQ/ ntermf(n0:nx),ncoeff(n0:nx),
129 | & ntp(n0:nx),ndp(n0:nx),nlp(n0:nx),
130 | & ncrt(n0:nx),ncfcrt(n0:nx),
131 | & nspare(n0:nx),ncfsp(n0:nx)
132 | common /WCFFEQ/ a(n0:nx,mxtrm),ti(n0:nx,mxtrm),di(n0:nx,mxtrm),
133 | & gi(n0:nx,mxtrm),gi2(n0:nx,mxtrm),
134 | & dli(n0:nx,mxtrm),tli(n0:nx,mxtrm),
135 | & tpower(n0:nx,mxtrm),dpower(n0:nx,mxtrm),
136 | & dlpower(n0:nx,mxtrm),
137 | & rho0feq(n0:nx),t0feq(n0:nx),
138 | & pcfeq(n0:nx),rhocfeq(n0:nx),tcfeq(n0:nx),
139 | & wmf(n0:nx),Rfeq(n0:nx),
140 | & pminfeq(n0:nx),rhotp(n0:nx),tminfeq(n0:nx),
141 | & tmaxfeq(n0:nx),pmaxfeq(n0:nx)
142 | common /WNTCPP/ ntermc(n0:nx),nterme(n0:nx),ncosh(n0:nx),
143 | & nsinh(n0:nx),nsp1(n0:nx),nsp2(n0:nx),nsp3(n0:nx)
144 | common /WCPCPP/ cpc(n0:nx,ncppmx),xk(n0:nx,ncppmx),
145 | & cph(n0:nx,ncppmx),xth(n0:nx,ncppmx),
146 | & xh(n0:nx,ncppmx)
147 | common /CPPSAV/ cp0sav(n0:nx),cpisav(n0:nx),cptsav(n0:nx),
148 | & tsav(n0:nx)
149 | cDEC$ ATTRIBUTES DLLEXPORT, Alias: "_SETCMNdll"::SETCMNdll
150 | C cDEC$ ATTRIBUTES STDCALL, REFERENCE::SETCMNdll
151 | c dll_export SETCMNdll
152 | c
153 | if (pc.gt.0.d0) pcfeq(1)=pc
154 | if (tc.gt.0.d0) tcfeq(1)=tc
155 | if (rhoc.gt.0.d0) rhocfeq(1)=rhoc
156 | if (tred.gt.0.d0) tz(1)=tred
157 | if (tred.gt.0.d0) t0feq(1)=tc
158 | if (rhored.gt.0.d0) rhoz(1)=rhored
159 | if (rhored.gt.0.d0) rho0feq(1)=rhoc
160 | if (n1.ne.0) then
161 | ntermf(1)=n1
162 | ncrt(1)=n2
163 | do i=1,n1+n2
164 | a(1,i)=coefhmx(i)
165 | enddo
166 | call SETEXP (1)
167 | endif
168 | if (n3.ne.0) then
169 | tsav(1)=0.d0
170 | ntermc(1)=n3
171 | nterme(1)=n4
172 | do j=1,n3+n4
173 | cpc(1,j)=coefcp0(j)
174 | xk(1,j)=coefxk(j)
175 | enddo
176 | endif
177 | end
178 | c ======================================================================
179 | subroutine GETCMN (tc,rhoc,pc,tred,rhored,acf,
180 | & n1,n2,coefhmx,n3,n4,coefcp0,coefxk)
181 | implicit double precision (a-h,o-z)
182 | implicit integer (i-n)
183 | cDEC$ ATTRIBUTES DLLEXPORT::GETCMN
184 | c dll_export GETCMN
185 | parameter (ncmax=20) !max number of components in mixture
186 | parameter (refmax=10) !max number of fluids for transport ECS
187 | parameter (ncppmx=20) !max number of Cp0 terms
188 | parameter (n0=-ncmax-refmax,nx=ncmax)
189 | parameter (mxtrm=72)
190 | common /Gcnst/ R,tz(n0:nx),rhoz(n0:nx)
191 | common /WNTFEQ/ ntermf(n0:nx),ncoeff(n0:nx),
192 | & ntp(n0:nx),ndp(n0:nx),nlp(n0:nx),
193 | & ncrt(n0:nx),ncfcrt(n0:nx),
194 | & nspare(n0:nx),ncfsp(n0:nx)
195 | common /WCFFEQ/ a(n0:nx,mxtrm),ti(n0:nx,mxtrm),di(n0:nx,mxtrm),
196 | & gi(n0:nx,mxtrm),gi2(n0:nx,mxtrm),
197 | & dli(n0:nx,mxtrm),tli(n0:nx,mxtrm),
198 | & tpower(n0:nx,mxtrm),dpower(n0:nx,mxtrm),
199 | & dlpower(n0:nx,mxtrm),
200 | & rho0feq(n0:nx),t0feq(n0:nx),
201 | & pcfeq(n0:nx),rhocfeq(n0:nx),tcfeq(n0:nx),
202 | & wmf(n0:nx),Rfeq(n0:nx),
203 | & pminfeq(n0:nx),rhotp(n0:nx),tminfeq(n0:nx),
204 | & tmaxfeq(n0:nx),pmaxfeq(n0:nx)
205 | common /WNTCPP/ ntermc(n0:nx),nterme(n0:nx),ncosh(n0:nx),
206 | & nsinh(n0:nx),nsp1(n0:nx),nsp2(n0:nx),nsp3(n0:nx)
207 | common /WCPCPP/ cpc(n0:nx,ncppmx),xk(n0:nx,ncppmx),
208 | & cph(n0:nx,ncppmx),xth(n0:nx,ncppmx),
209 | & xh(n0:nx,ncppmx)
210 | common /CPPSAV/ cp0sav(n0:nx),cpisav(n0:nx),cptsav(n0:nx),
211 | & tsav(n0:nx)
212 | common /CCON/ tcrit(n0:nx),pcrit(n0:nx),Dcrit(n0:nx),Zcrit(n0:nx),
213 | & ttp(n0:nx),ptp(n0:nx),dtp(n0:nx),dtpv(n0:nx),
214 | & tnbp(n0:nx),dnbpl(n0:nx),dnbpv(n0:nx),
215 | & wm(n0:nx),accen(n0:nx),dipole(n0:nx),Reos(n0:nx)
216 |
217 | c
218 | parameter (mxcoef=72)
219 | dimension coefhmx(mxcoef),coefcp0(mxcoef),coefxk(mxcoef)
220 | do i=1,mxcoef
221 | coefhmx(i)=0.d0
222 | coefcp0(i)=0.d0
223 | coefxk(i)=0.d0
224 | enddo
225 | tred=tz(1)
226 | rhored=rhoz(1)
227 | tc=tcfeq(1)
228 | rhoc=rhocfeq(1)
229 | pc=pcfeq(1)
230 | n1=ntermf(1)
231 | n2=ncrt(1)
232 | acf = accen(1)
233 | do i=1,n1+n2
234 | coefhmx(i)=a(1,i)
235 | enddo
236 | n3=ntermc(1)
237 | n4=nterme(1)
238 | do j=1,n3+n4
239 | coefcp0(j)=cpc(1,j)
240 | coefxk(j)=xk(1,j)
241 | enddo
242 | end
243 | c ======================================================================
244 | subroutine SETCMN (tc,rhoc,pc,tred,rhored,acf,
245 | & n1,n2,coefhmx,n3,n4,coefcp0,coefxk)
246 | implicit double precision (a-h,o-z)
247 | implicit integer (i-n)
248 | cDEC$ ATTRIBUTES DLLEXPORT::SETCMN
249 | c dll_export SETCMN
250 |
251 | parameter (ncmax=20) !max number of components in mixture
252 | parameter (refmax=10) !max number of fluids for transport ECS
253 | parameter (ncppmx=20) !max number of Cp0 terms
254 | parameter (n0=-ncmax-refmax,nx=ncmax)
255 | parameter (mxtrm=72)
256 | common /Gcnst/ R,tz(n0:nx),rhoz(n0:nx)
257 | common /WNTFEQ/ ntermf(n0:nx),ncoeff(n0:nx),
258 | & ntp(n0:nx),ndp(n0:nx),nlp(n0:nx),
259 | & ncrt(n0:nx),ncfcrt(n0:nx),
260 | & nspare(n0:nx),ncfsp(n0:nx)
261 | common /WCFFEQ/ a(n0:nx,mxtrm),ti(n0:nx,mxtrm),di(n0:nx,mxtrm),
262 | & gi(n0:nx,mxtrm),gi2(n0:nx,mxtrm),
263 | & dli(n0:nx,mxtrm),tli(n0:nx,mxtrm),
264 | & tpower(n0:nx,mxtrm),dpower(n0:nx,mxtrm),
265 | & dlpower(n0:nx,mxtrm),
266 | & rho0feq(n0:nx),t0feq(n0:nx),
267 | & pcfeq(n0:nx),rhocfeq(n0:nx),tcfeq(n0:nx),
268 | & wmf(n0:nx),Rfeq(n0:nx),
269 | & pminfeq(n0:nx),rhotp(n0:nx),tminfeq(n0:nx),
270 | & tmaxfeq(n0:nx),pmaxfeq(n0:nx)
271 | common /WNTCPP/ ntermc(n0:nx),nterme(n0:nx),ncosh(n0:nx),
272 | & nsinh(n0:nx),nsp1(n0:nx),nsp2(n0:nx),nsp3(n0:nx)
273 | common /WCPCPP/ cpc(n0:nx,ncppmx),xk(n0:nx,ncppmx),
274 | & cph(n0:nx,ncppmx),xth(n0:nx,ncppmx),
275 | & xh(n0:nx,ncppmx)
276 | common /CPPSAV/ cp0sav(n0:nx),cpisav(n0:nx),cptsav(n0:nx),
277 | & tsav(n0:nx)
278 | common /CCON/ tcrit(n0:nx),pcrit(n0:nx),Dcrit(n0:nx),Zcrit(n0:nx),
279 | & ttp(n0:nx),ptp(n0:nx),dtp(n0:nx),dtpv(n0:nx),
280 | & tnbp(n0:nx),dnbpl(n0:nx),dnbpv(n0:nx),
281 | & wm(n0:nx),accen(n0:nx),dipole(n0:nx),Reos(n0:nx)
282 | common /FEQSAV/ phisav(n0:nx,mxtrm),delsav(n0:nx),tausav(n0:nx),
283 | & taup(n0:nx,mxtrm),delp(n0:nx,mxtrm),
284 | & delli(n0:nx,mxtrm),drvsav(n0:nx,16)
285 |
286 | c
287 | parameter (mxcoef=72)
288 | dimension coefhmx(mxcoef),coefcp0(mxcoef),coefxk(mxcoef)
289 |
290 | c (re)initialize contents of /FEQSAV/ and /CPPSAV/ when a fluid's parameter are reset
291 | do 120 i=n0,nx
292 | delsav(i)=0.0d0
293 | tausav(i)=0.0d0
294 | cp0sav(i)=0.0d0
295 | cpisav(i)=0.0d0
296 | cptsav(i)=0.0d0
297 | tsav(i)=0.0d0
298 | do 100 j=1,mxtrm
299 | phisav(i,j)=0.0d0
300 | taup(i,j)=0.0d0
301 | delp(i,j)=0.0d0
302 | delli(i,j)=0.0d0
303 | 100 continue
304 | 120 continue
305 | c
306 | call RESETA
307 | if (pc.gt.0.d0) pcfeq(1)=pc
308 | if (tc.gt.0.d0) tcfeq(1)=tc
309 | if (rhoc.gt.0.d0) rhocfeq(1)=rhoc
310 | if (tred.gt.0.d0) tz(1)=tred
311 | if (tred.gt.0.d0) t0feq(1)=tc
312 | if (rhored.gt.0.d0) rhoz(1)=rhored
313 | if (rhored.gt.0.d0) rho0feq(1)=rhoc
314 | if (abs(acf).gt.1.d-20) accen(1)=acf
315 | if (n1.ne.0) then
316 | ntermf(1)=n1
317 | ncrt(1)=n2
318 | do i=1,n1+n2
319 | a(1,i)=coefhmx(i)
320 | enddo
321 | call SETEXP (1)
322 | endif
323 | if (n3.ne.0) then
324 | tsav(1)=0.d0
325 | ntermc(1)=n3
326 | nterme(1)=n4
327 | do j=1,n3+n4
328 | cpc(1,j)=coefcp0(j)
329 | xk(1,j)=coefxk(j)
330 | enddo
331 | endif
332 | end
333 | c ======================================================================
334 | subroutine GETALLCMN (tc,rhoc,pc,tred,rhored,acf,
335 | & n1,n2,coefhmx,tauexp,denexp,denlnexp
336 | & ,n3,n4,coefcp0,coefxk)
337 | implicit double precision (a-h,o-z)
338 | implicit integer (i-n)
339 | cDEC$ ATTRIBUTES DLLEXPORT::GETALLCMN
340 | c dll_export GETALLCMN
341 |
342 | parameter (ncmax=20) !max number of components in mixture
343 | parameter (refmax=10) !max number of fluids for transport ECS
344 | parameter (ncppmx=20) !max number of Cp0 terms
345 | parameter (n0=-ncmax-refmax,nx=ncmax)
346 | parameter (mxtrm=72)
347 | common /Gcnst/ R,tz(n0:nx),rhoz(n0:nx)
348 | common /WNTFEQ/ ntermf(n0:nx),ncoeff(n0:nx),
349 | & ntp(n0:nx),ndp(n0:nx),nlp(n0:nx),
350 | & ncrt(n0:nx),ncfcrt(n0:nx),
351 | & nspare(n0:nx),ncfsp(n0:nx)
352 | common /WCFFEQ/ a(n0:nx,mxtrm),ti(n0:nx,mxtrm),di(n0:nx,mxtrm),
353 | & gi(n0:nx,mxtrm),gi2(n0:nx,mxtrm),
354 | & dli(n0:nx,mxtrm),tli(n0:nx,mxtrm),
355 | & tpower(n0:nx,mxtrm),dpower(n0:nx,mxtrm),
356 | & dlpower(n0:nx,mxtrm),
357 | & rho0feq(n0:nx),t0feq(n0:nx),
358 | & pcfeq(n0:nx),rhocfeq(n0:nx),tcfeq(n0:nx),
359 | & wmf(n0:nx),Rfeq(n0:nx),
360 | & pminfeq(n0:nx),rhotp(n0:nx),tminfeq(n0:nx),
361 | & tmaxfeq(n0:nx),pmaxfeq(n0:nx)
362 | common /WNTCPP/ ntermc(n0:nx),nterme(n0:nx),ncosh(n0:nx),
363 | & nsinh(n0:nx),nsp1(n0:nx),nsp2(n0:nx),nsp3(n0:nx)
364 | common /WCPCPP/ cpc(n0:nx,ncppmx),xk(n0:nx,ncppmx),
365 | & cph(n0:nx,ncppmx),xth(n0:nx,ncppmx),
366 | & xh(n0:nx,ncppmx)
367 | common /CPPSAV/ cp0sav(n0:nx),cpisav(n0:nx),cptsav(n0:nx),
368 | & tsav(n0:nx)
369 | common /CCON/ tcrit(n0:nx),pcrit(n0:nx),Dcrit(n0:nx),Zcrit(n0:nx),
370 | & ttp(n0:nx),ptp(n0:nx),dtp(n0:nx),dtpv(n0:nx),
371 | & tnbp(n0:nx),dnbpl(n0:nx),dnbpv(n0:nx),
372 | & wm(n0:nx),accen(n0:nx),dipole(n0:nx),Reos(n0:nx)
373 | c
374 | parameter (mxcoef=72)
375 | dimension coefhmx(mxcoef),coefcp0(mxcoef),coefxk(mxcoef)
376 | dimension tauexp(mxcoef),denexp(mxcoef),denlnexp(mxcoef)
377 | do i=1,mxcoef
378 | coefhmx(i)=0.d0
379 | tauexp(i)=0.d0
380 | denexp(i)=0.d0
381 | denlnexp(i)=0.d0
382 | coefcp0(i)=0.d0
383 | coefxk(i)=0.d0
384 | enddo
385 | tred=tz(1)
386 | rhored=rhoz(1)
387 | tc=tcfeq(1)
388 | rhoc=rhocfeq(1)
389 | pc=pcfeq(1)
390 | acf = accen(1)
391 | n1=ntermf(1)
392 | n2=ncrt(1)
393 | do i=1,n1+n2
394 | coefhmx(i)=a(1,i)
395 | tauexp(i)=ti(1,i)
396 | denexp(i)=di(1,i)
397 | denlnexp(i)=dli(1,i)
398 | enddo
399 | n3=ntermc(1)
400 | n4=nterme(1)
401 | do j=1,n3+n4
402 | coefcp0(j)=cpc(1,j)
403 | coefxk(j)=xk(1,j)
404 | enddo
405 | end
406 |
407 | c ======================================================================
408 | subroutine GETTYPE(htype)
409 | cDEC$ ATTRIBUTES DLLEXPORT::GETTYPE
410 | c dll_export GETTYPE
411 |
412 |
413 | character*3 htype
414 | character*3 hpheq,heos,hmxeos,hmodcp
415 | parameter (ncmax=20) !max number of components in mixture
416 | parameter (refmax=10) !max number of fluids for transport ECS
417 | parameter (n0=-ncmax-refmax,nx=ncmax)
418 | common /EOSMOD/ hpheq,heos,hmxeos(n0:nx),hmodcp(n0:nx)
419 |
420 | htype=heos
421 | end
422 |
423 | c ======================================================================
424 | subroutine LIMITSET (tmin,tmax,Dmax,pmax)
425 | cDEC$ ATTRIBUTES DLLEXPORT::LIMITSET
426 |
427 | implicit double precision (a-h,o-z)
428 | implicit integer (i-n)
429 | c dll_export LIMITSET
430 | parameter (ncmax=20) !max number of components in mixture
431 | parameter (refmax=10) !max number of fluids for transport ECS
432 | parameter (n0=-ncmax-refmax,nx=ncmax)
433 |
434 | common /NCOMP/ nc,ic
435 | common /EOSLIM/ tmeos(n0:nx),txeos(n0:nx),peos(n0:nx),Deos(n0:nx)
436 |
437 | c reset limit only for the case of a pure component
438 | if (nc.eq.1) then
439 | c special case--pure component
440 | tmeos(1)=tmin
441 | txeos(1)=tmax
442 | Deos(1)=Dmax
443 | peos(1)=pmax
444 | end if
445 | end
446 | C END LIMITSet
447 |
--------------------------------------------------------------------------------
/Source_Code/fortran/IDEALGAS.FOR:
--------------------------------------------------------------------------------
1 | c begin file idealgas.f
2 | c
3 | c This file contains the routines implementing the ideal-gas part of
4 | c the thermodynamic functions. They call the corresponding "core"
5 | c routines for the specified component(s).
6 | c
7 | c contained here are:
8 | c function CP0 (t,x)
9 | c function CPI (t,x)
10 | c function CPT (t,x)
11 | c function PHI0 (itau,idel,t,rho,x)
12 | c function CP0K (icomp,t)
13 | c function PHI0K (icomp,itau,idel,t,rho)
14 | c block data BDCNST
15 | c
16 | c these routines set the values in the following common blocks
17 | c common /Gcnst/ R,tz(n0:nx),rhoz(n0:nx)
18 | c
19 | c these routines use the following common blocks from other files
20 | c common /CPMOD/ imodcp(n0:nx)
21 | c
22 | c ======================================================================
23 | c ======================================================================
24 | c
25 | function CP0 (t,x)
26 | c
27 | c return mixture Cp0 calculated by appropriate core CP0xxx routine(s)
28 | c
29 | c inputs:
30 | c t--temperature (K)
31 | c x--composition array (mol frac)
32 | c output (as function value):
33 | c cp0--ideal gas heat capacity, Cp0 (J/(mol-K))
34 | c
35 | c written by M. McLinden, NIST Thermophysics Division, Boulder, Colorado
36 | c 07-24-95 MM, original version
37 | c 10-03-95 MM, change /CPMOD/: models specified by strings
38 | c 11-08-95 MM, change to mixtures (x, rather than icomp, is input)
39 | c 11-26-95 MM, rearrange argument list (x at end)
40 | c 11-29-95 MM, variable lower limit on coefficient/constant arrays
41 | c to accommodate ECS reference fluid
42 | c 02-27-96 MM, parameter n0=-ncmax to accommodate ECS-thermo model
43 | c 03-22-96 MM, replace /CPMOD/ with /EOSMOD/
44 | c 05-14-96 MM, add call to PH0 model (Helmholtz form)
45 | c 06-17-96 MM, check only 'CP' rather than 'CPP' to allow CP1
46 | c 12-24-02 EWL, ditto for 'PH' rather than 'PH0'
47 | c 06-13-06 EWL, split into pure fluid and mixture sections
48 | c
49 | implicit double precision (a-h,o-z)
50 | implicit integer (i-n)
51 | parameter (ncmax=20) !max number of components in mixture
52 | parameter (nrefmx=10) !max number of fluids for transport ECS
53 | parameter (n0=-ncmax-nrefmx,nx=ncmax)
54 | character*3 hpheq,heos,hmxeos,hmodcp
55 | common /NCOMP/ nc,ic
56 | common /Gcnst/ R,tz(n0:nx),rhoz(n0:nx)
57 | common /EOSMOD/ hpheq,heos,hmxeos(n0:nx),hmodcp(n0:nx)
58 | dimension x(ncmax)
59 | c
60 | cp0sum=0.0d0
61 | call ISPURE (x,icomp)
62 | if (icomp.ne.0) then
63 | if (hmodcp(icomp)(1:2).eq.'CP') then
64 | cp0sum=CP0CPP(icomp,t)
65 | else if (hmodcp(icomp)(1:2).eq.'PH') then
66 | rho=0.0d0
67 | cp0sum=R*(1.0-PH0PH0(icomp,2,0,t,rho))
68 | else
69 | cp0sum=0.0d0
70 | end if
71 | else
72 | do i=1,nc
73 | if (hmodcp(i)(1:2).eq.'CP') then
74 | c polynomial fit
75 | cp0i=CP0CPP(i,t)
76 | else if (hmodcp(i)(1:2).eq.'PH') then
77 | c Helmholtz form ("fundamental equation")
78 | rho=0.0d0
79 | cp0i=R*(1.0-PH0PH0(i,2,0,t,rho))
80 | else
81 | c write (*,*) ' CP0: ERROR--model input to CP0 not found'
82 | cp0i=0.0d0
83 | end if
84 | cp0sum=cp0sum+x(i)*cp0i
85 | enddo
86 | endif
87 | CP0=cp0sum
88 | c
89 | RETURN
90 | end !function CP0
91 | c
92 | c ======================================================================
93 | c
94 | function CPI (t,x)
95 | c
96 | c return mixture integral of Cp0 over limits of Tref to T
97 | c calculated by appropriate core CPIxxx routine(s),
98 | c for use in enthalpy calculation
99 | c
100 | c inputs:
101 | c t--temperature [K]
102 | c x--composition array [mol frac]
103 | c output (as function value):
104 | c cpi--integral of (Cp0 dT) over limits T-Tref [J/mol]
105 | c
106 | c written by M. McLinden, NIST Thermophysics Division, Boulder, Colorado
107 | c 07-24-95 MM, original version
108 | c 10-03-95 MM, change /CPMOD/: models specified by strings
109 | c 11-08-95 MM, change to mixtures (x, rather than icomp, is input)
110 | c 11-26-95 MM, rearrange argument list (x at end)
111 | c 11-29-95 MM, variable lower limit on coefficient/constant arrays
112 | c to accommodate ECS reference fluid
113 | c 02-27-96 MM, parameter n0=-ncmax to accommodate ECS-thermo model
114 | c 03-22-96 MM, replace /CPMOD/ with /EOSMOD/
115 | c 06-17-96 MM, check only 'CP' rather than 'CPP' to allow CP1
116 | c 06-13-06 EWL, split into pure fluid and mixture sections
117 | c
118 | implicit double precision (a-h,o-z)
119 | implicit integer (i-n)
120 | parameter (ncmax=20) !max number of components in mixture
121 | parameter (nrefmx=10) !max number of fluids for transport ECS
122 | parameter (n0=-ncmax-nrefmx,nx=ncmax)
123 | character*3 hpheq,heos,hmxeos,hmodcp
124 | common /NCOMP/ nc,ic
125 | common /Gcnst/ R,tz(n0:nx),rhoz(n0:nx)
126 | common /EOSMOD/ hpheq,heos,hmxeos(n0:nx),hmodcp(n0:nx)
127 | dimension x(ncmax)
128 | c
129 | cpisum=0.0d0
130 | call ISPURE (x,icomp)
131 | if (icomp.ne.0) then
132 | if (hmodcp(icomp)(1:2).eq.'CP') then
133 | cpisum=CPICPP(icomp,t)
134 | else
135 | cpisum=0.0d0
136 | end if
137 | else
138 | do i=1,nc
139 | if (hmodcp(i)(1:2).eq.'CP') then
140 | c polynomial fit
141 | cpii=CPICPP(i,t)
142 | else
143 | c write (*,*) ' CPI: ERROR--model input to CPI not found'
144 | cpii=0.0d0
145 | end if
146 | cpisum=cpisum+x(i)*cpii
147 | enddo
148 | endif
149 | CPI=cpisum
150 | c
151 | RETURN
152 | end !function CPI
153 | c
154 | c ======================================================================
155 | c
156 | function CPT (t,x)
157 | c
158 | c return mixture integral of Cp0/T over limits of Tref to T
159 | c calculated by appropriate core CPTxxx routine(s),
160 | c for use in entropy calculation
161 | c
162 | c inputs:
163 | c t--temperature [K]
164 | c x--composition array [mol frac]
165 | c output (as function value):
166 | c cpt--integral of (Cp0/T dT) over limits T-Tref [J/(mol-K)]
167 | c
168 | c written by M. McLinden, NIST Thermophysics Division, Boulder, Colorado
169 | c 07-24-95 MM, original version
170 | c 10-03-95 MM, change /CPMOD/: models specified by strings
171 | c 11-08-95 MM, change to mixtures (x, rather than icomp, is input)
172 | c 11-26-95 MM, rearrange argument list (x at end)
173 | c 11-29-95 MM, variable lower limit on coefficient/constant arrays
174 | c to accommodate ECS reference fluid
175 | c 02-27-96 MM, parameter n0=-ncmax to accommodate ECS-thermo model
176 | c 03-22-96 MM, replace /CPMOD/ with /EOSMOD/
177 | c 06-17-96 MM, check only 'CP' rather than 'CPP' to allow CP1
178 | c 06-13-06 EWL, split into pure fluid and mixture sections
179 | c
180 | implicit double precision (a-h,o-z)
181 | implicit integer (i-n)
182 | parameter (ncmax=20) !max number of components in mixture
183 | parameter (nrefmx=10) !max number of fluids for transport ECS
184 | parameter (n0=-ncmax-nrefmx,nx=ncmax)
185 | character*3 hpheq,heos,hmxeos,hmodcp
186 | common /NCOMP/ nc,ic
187 | common /Gcnst/ R,tz(n0:nx),rhoz(n0:nx)
188 | common /EOSMOD/ hpheq,heos,hmxeos(n0:nx),hmodcp(n0:nx)
189 | dimension x(ncmax)
190 | c
191 | cptsum=0.0d0
192 | call ISPURE (x,icomp)
193 | if (icomp.ne.0) then
194 | if (hmodcp(icomp)(1:2).eq.'CP') then
195 | cptsum=CPTCPP(icomp,t)
196 | else
197 | cptsum=0.0d0
198 | end if
199 | else
200 | do i=1,nc
201 | if (hmodcp(i)(1:2).eq.'CP') then
202 | c polynomial fit
203 | cpti=CPTCPP(i,t)
204 | else
205 | c write (*,*) ' CPT: ERROR--model input to CPT not found'
206 | cpti=0.0d0
207 | end if
208 | cptsum=cptsum+x(i)*cpti
209 | enddo
210 | endif
211 | CPT=cptsum
212 | c
213 | RETURN
214 | end !function CPT
215 | c
216 | c ======================================================================
217 | c
218 | function PHI0 (itau,idel,t,rho,x)
219 | c
220 | c compute the ideal gas part of the reduced Helmholtz energy or a
221 | c derivative as functions of temperature and pressure for a mixture;
222 | c for use with the Helmholtz-explicit models (e.g. FEQ and HMX)
223 | c
224 | c inputs:
225 | c itau--flag specifying order of temperature derivative to calc
226 | c idel--flag specifying order of density derivative to calculate
227 | c (the density derivatives are not used in the calculation
228 | c of any property, and are not implemented)
229 | c when itau = 0 and idel = 0, compute A0/RT
230 | c when itau = 1 and idel = 0, 1st temperature derivative
231 | c when itau = 2 and idel = 0, 2nd temperature derivative
232 | c t--temperature [K]
233 | c rho--density [mol/L]
234 | c x--composition array [mol frac]
235 | c output (as function value):
236 | c PHI0--ideal-gas part of the reduced Helmholtz energy (A/RT);
237 | c derivatives (as specified by itau and idel) are multiplied
238 | c by the corresponding power of tau; i.e. when itau = 1, the
239 | c quantity returned is tau*d(PHI0)/d(tau) and when itau = 2,
240 | c the quantity returned is tau*tau*d2(PHI0)/d(tau)**2,
241 | c where the tau's are the Tc/T evaluated for each component
242 | c
243 | c N.B. While the real-gas part of the Helmholtz energy is calculated
244 | c in terms of dimensionless temperature and density, the ideal-
245 | c gas part is calculated in terms of absolute temperature and
246 | c density. (This distinction is necessary for mixtures.)
247 | c
248 | c The Helmholtz energy consists of ideal-gas and residual
249 | c (real-gas) terms; this routine calculates only the ideal part.
250 | c
251 | c written by M. McLinden, NIST Thermophysics Division, Boulder, Colorado
252 | c 08-04-95 MM, original version
253 | c 08-21-95 MM, put saved variables into common (rather than save stmt)
254 | c 10-03-95 MM, change /MODEL/ + /CPMOD/: models specified by strings
255 | c 11-08-95 MM, change to mixtures (x, rather than icomp, is input)
256 | c 11-26-95 MM, rearrange argument list (x at end)
257 | c 11-29-95 MM, variable lower limit on coefficient/constant arrays
258 | c to accommodate ECS reference fluid
259 | c 02-27-96 MM, parameter n0=-ncmax to accommodate ECS-thermo model
260 | c 03-21-96 MM, delete reference to /MODEL/, not used
261 | c 03-22-96 MM, replace /CPMOD/ with /EOSMOD/
262 | c 04-19-96 MM, change input from pressure to density
263 | c 05-14-96 MM, add call to PH0 model (Helmholtz form)
264 | c 06-17-96 MM, check only 'CP' rather than 'CPP' to allow CP1
265 | c 07-03-96 MM, bug fix: x*log(x) terms apply only if itau = 0
266 | c 07-05-96 MM, note that PH0xxx models return tau*phi_tau, etc.
267 | c (no change in this routine)
268 | c 12-02-98 EWL, split into pure fluid and mixture sections
269 | c
270 | implicit double precision (a-h,o-z)
271 | implicit integer (i-n)
272 | parameter (ncmax=20) !max number of components in mixture
273 | parameter (nrefmx=10) !max number of fluids for transport ECS
274 | parameter (n0=-ncmax-nrefmx,nx=ncmax)
275 | character*3 hpheq,heos,hmxeos,hmodcp
276 | common /NCOMP/ nc,ic
277 | common /Gcnst/ R,tz(n0:nx),rhoz(n0:nx)
278 | common /EOSMOD/ hpheq,heos,hmxeos(n0:nx),hmodcp(n0:nx)
279 | dimension x(ncmax)
280 | c
281 | c write (*,1002) itau,idel,t,rho
282 | c1002 format (1x,' PHI0--itau,idel,t,rho: ',2i4,2e14.6)
283 | c write (*,1004) nc,(x(j),j=1,nc)
284 | c1004 format (1x,' PHI0--nc,x(i): ',i4,5f14.8)
285 | c compute reduced Helmholtz energy
286 | c pure fluid calculation
287 | call ISPURE (x,icomp)
288 | if (icomp.ne.0) then
289 | if (hmodcp(icomp)(1:2).eq.'CP') then
290 | c polynomial fit of isobaric heat capacity for the ideal gas state
291 | phisum=PH0CPP(icomp,itau,idel,t,rho)
292 | else if (hmodcp(icomp)(1:2).eq.'PH') then
293 | c Helmholtz form ("fundamental equation")
294 | phisum=PH0PH0(icomp,itau,idel,t,rho)
295 | else
296 | c additional model
297 | c write (*,*) ' PHI0: ERROR--model input to PHI0 not found'
298 | phisum=0.0d0
299 | end if
300 | c write (*,1018) i,phisum
301 | c1018 format (1x,' PHI0--i,PHIsum: ',i3,d25.15)
302 | c mixture calculation
303 | else
304 | phisum=0.0d0
305 | do i=1,nc
306 | c compute only if component composition >0 and <=1
307 | if (x(i).gt.1.0d-10 .and. x(i).le.1.0000000001d0) then
308 | if (hmodcp(i)(1:2).eq.'CP') then
309 | c polynomial fit of isobaric heat capacity for the ideal gas state
310 | phi0i=PH0CPP(i,itau,idel,t,rho)
311 | else if (hmodcp(i)(1:2).eq.'PH') then
312 | c Helmholtz form ("fundamental equation")
313 | phi0i=PH0PH0(i,itau,idel,t,rho)
314 | else
315 | c additional model
316 | c write (*,*) ' PHI0: ERROR--model input to PHI0 not found'
317 | phi0i=0.0d0
318 | end if
319 | phisum=phisum+x(i)*phi0i
320 | if (itau.eq.0) then
321 | phisum=phisum+x(i)*log(x(i))
322 | end if
323 | c write (*,1018) i,x(i),phi0i,phisum
324 | c1018 format (1x,' PHI0--i,x(i),PHIi,PHIsum: ',i3,3d25.15)
325 | else if (x(i).gt.1.0d0) then
326 | c write (*,1020) i,x(i)
327 | c1020 format (1x,' PHI0 ERROR--composition',i4,' out of range:',d16.6)
328 | end if
329 | enddo
330 | endif
331 | PHI0=phisum
332 | c write (*,1022) itau,t,rho,PHI0
333 | c1022 format (1x,' PHI0: itau,t,rho,output phi: ',i4,3e14.6)
334 | c
335 | RETURN
336 | end !function PHI0
337 | c
338 | c ======================================================================
339 | c
340 | function CP0K (icomp,t)
341 | c
342 | c return pure fluid Cp0 calculated by appropriate core CP0xxx routine
343 | c
344 | c inputs:
345 | c icomp--component number in mixture (1..nc)
346 | c 0 for ECS reference fluid
347 | c t--temperature [K]
348 | c output (as function value):
349 | c cp0--ideal gas heat capacity, Cp0 [J/(mol-K)]
350 | c
351 | c written by M. McLinden, NIST Thermophysics Division, Boulder, Colorado
352 | c 12-12-95 MM, original version, adapted from function CP0
353 | c 02-27-96 MM, parameter n0=-ncmax to accommodate ECS-thermo model
354 | c 03-22-96 MM, replace /CPMOD/ with /EOSMOD/
355 | c 05-14-96 MM, add call to PH0 model (Helmholtz form)
356 | c 06-17-96 MM, check only 'CP' rather than 'CPP' to allow CP1
357 | c 10-10-96 MM, this routine never called, comment out
358 | c 10-15-96 MM, needed in some of the new transport routines, restore
359 | c
360 | implicit double precision (a-h,o-z)
361 | implicit integer (i-n)
362 | parameter (ncmax=20) !max number of components in mixture
363 | parameter (nrefmx=10) !max number of fluids for transport ECS
364 | parameter (n0=-ncmax-nrefmx,nx=ncmax)
365 | character*3 hpheq,heos,hmxeos,hmodcp
366 | common /Gcnst/ R,tz(n0:nx),rhoz(n0:nx)
367 | common /EOSMOD/ hpheq,heos,hmxeos(n0:nx),hmodcp(n0:nx)
368 | c
369 | if (hmodcp(icomp)(1:2).eq.'CP') then
370 | c polynomial fit
371 | CP0K=CP0CPP(icomp,t)
372 | else if (hmodcp(icomp)(1:2).eq.'PH') then
373 | c Helmholtz form ("fundamental equation")
374 | rho=0.0d0
375 | CP0K=R*(1.0-PH0PH0(icomp,2,0,t,rho))
376 | else
377 | c write (*,*) ' CP0K: ERROR--model input to CP0K not found'
378 | CP0K=0.0d0
379 | end if
380 | c
381 | RETURN
382 | end !function CP0K
383 | c
384 | c ======================================================================
385 | c
386 | function PHI0K (icomp,itau,idel,t,rho)
387 | c
388 | c compute the ideal gas part of the reduced Helmholtz energy or a
389 | c derivative as functions of temperature and pressure for a specified
390 | c component
391 | c
392 | c analogous to PHI0, except for component icomp, this is used by CVCPK
393 | c which, in turn, is used by transport routines to calculate Cv & Cp
394 | c for the reference fluid (component zero)
395 | c
396 | c inputs:
397 | c icomp--component number in mixture (1..nc); 1 for pure fluid
398 | c itau--flag specifying order of temperature derivative to calc
399 | c idel--flag specifying order of density derivative to calculate
400 | c (the density derivatives are not used in the calculation
401 | c of any property, and are not implemented)
402 | c when itau = 0 and idel = 0, compute A0/RT
403 | c when itau = 1 and idel = 0, 1st temperature derivative
404 | c when itau = 2 and idel = 0, 2nd temperature derivative
405 | c t--temperature [K]
406 | c rho--density [mol/L]
407 | c output (as function value):
408 | c PHI0K--ideal-gas part of the reduced Helmholtz energy (A/RT);
409 | c derivatives (as specified by itau and idel) are multiplied
410 | c by the corresponding power of tau; i.e. when itau = 1, the
411 | c quantity returned is tau*d(PHI0)/d(tau) and when itau = 2,
412 | c the quantity returned is tau*tau*d2(PHI0)/d(tau)**2,
413 | c where the tau's are the Tc/T evaluated for each component
414 | c
415 | c N.B. While the real-gas part of the Helmholtz energy is calculated
416 | c in terms of dimensionless temperature and density, the ideal-
417 | c gas part is calculated in terms of absolute temperature and
418 | c density. (This distinction is necessary for mixtures.)
419 | c
420 | c The Helmholtz energy consists of ideal-gas and residual
421 | c (real-gas) terms; this routine calculates only the ideal part.
422 | c
423 | c written by M. McLinden, NIST Physical & Chem Properties Div, Boulder, CO
424 | c 06-16-97 MM, original version; based on PHIO
425 | c
426 | implicit double precision (a-h,o-z)
427 | implicit integer (i-n)
428 | parameter (ncmax=20) !max number of components in mixture
429 | parameter (nrefmx=10) !max number of fluids for transport ECS
430 | parameter (n0=-ncmax-nrefmx,nx=ncmax)
431 | character*3 hpheq,heos,hmxeos,hmodcp
432 | common /NCOMP/ nc,ic
433 | common /Gcnst/ R,tz(n0:nx),rhoz(n0:nx)
434 | common /EOSMOD/ hpheq,heos,hmxeos(n0:nx),hmodcp(n0:nx)
435 | c
436 | if (hmodcp(icomp)(1:2).eq.'CP') then
437 | c polynomial fit of isobaric heat capacity for the ideal gas state
438 | PHI0K=PH0CPP(icomp,itau,idel,t,rho)
439 | else if (hmodcp(icomp)(1:2).eq.'PH') then
440 | c Helmholtz form ("fundamental equation")
441 | PHI0K=PH0PH0(icomp,itau,idel,t,rho)
442 | else
443 | c additional model
444 | c write (*,*) ' PHI0K: ERROR--model input to PHI0K not found'
445 | PHI0K=0.0d0
446 | end if
447 | c write (*,1022) itau,t,rho,PHI0K
448 | c1022 format (1x,' PHI0K: itau,t,rho,output phi: ',i4,3e14.6)
449 | c
450 | RETURN
451 | end !function PHI0K
452 | c
453 | c 1 2 3 4 5 6 7
454 | c23456789012345678901234567890123456789012345678901234567890123456789012
455 | c
456 | c ======================================================================
457 | c end file idealgas.f
458 | c ======================================================================
459 |
--------------------------------------------------------------------------------
/Source_Code/fortran/CORE_PH0.FOR:
--------------------------------------------------------------------------------
1 | c begin file core_PH0.f
2 | c
3 | c This file contains the functions implementing the ideal-gas part of
4 | c the reduced Helmholtz free energy form of the pure fluid equation of
5 | c state (the so-called "fundamental equation").
6 | c
7 | c The Helmholtz energy consists of ideal and residual (real-gas) terms;
8 | c this routine calculates only the ideal part, and only for pure components.
9 | c
10 | c contained here are:
11 | c subroutine SETPH0 (nread,icomp,hcasno,ierr,herr)
12 | c function PH0PH0 (icomp,itau,idel,t,rho)
13 | c block data SAVPH0
14 | c
15 | c these routines use the following common blocks from other files
16 | c common /CREF/ tref(n0:nx),rhoref(n0:nx),href(n0:nx),sref(n0:nx)
17 | c common /HCHAR/ htab,hnull
18 | c common /Gcnst/ R,tz(n0:nx),rhoz(n0:nx)
19 | c
20 | c various arrays are dimensioned with parameter statements
21 | c parameter (ncmax=20) !max number of components in mixture
22 | c parameter (nrefmx=10) !max number of fluids for transport ECS
23 | c parameter (n0=-ncmax-nrefmx,nx=ncmax)
24 | c parameter (nph0mx=10) !max number of terms in Cp0 polynomial
25 | c
26 | c ======================================================================
27 | c ======================================================================
28 | c
29 | subroutine SETPH0 (nread,icomp,hcasno,ierr,herr)
30 | c
31 | c set up working arrays for ideal-gas part of the Helmholtz energy
32 | c implements an expression of the form:
33 | c phi0 = Sum[ai*log(tau**ti)] + Sum[aj*tau**tj]
34 | c + Sum[ak*log(1-EXP(bk*tau))]
35 | c
36 | c inputs:
37 | c nread--file to read data from
38 | c <= 0 get data from block data (not currently implemented)
39 | c >0 read from logical unit nread (file should have already
40 | c been opened and pointer set by subroutine SETUP)
41 | c icomp--component number in mixture (1..nc); 1 for pure fluid;
42 | c zero and negative numbers designate ECS reference fluids
43 | c hcasno--CAS number of component icomp
44 | c (not req'd if reading from file--included to maintain
45 | c parallel structure with other routines)
46 | c
47 | c outputs:
48 | c ierr--error flag: 0 = successful
49 | c 1 = error (e.g. fluid not found)
50 | c herr--error string (character*255 variable if ierr<>0)
51 | c coefficients, etc. returned via arrays in common /xxxPH0/
52 | c
53 | c written by M. McLinden, NIST Thermophysics Division, Boulder, Colorado
54 | c 05-13-96 MM, original version, based (loosely) on SETCPP
55 | c 06-14-96 MM, fix bug in reading/storing coefficients
56 | c 11-13-97 MM, (re)initialize contents of /PH0SAV/ when a new fluid is read in
57 | c 08-31-98 MEV, reverse order of indices in tsav(i,j)=0 and rhosav(i,j)=0
58 | c 08-13-98 MM, delete obsolete (unused) format statement
59 | c 07-25-06 EWL, add cosh and sinh functions
60 | c
61 | implicit double precision (a-h,o-z)
62 | implicit integer (i-n)
63 | parameter (mxph0=2) !max number of fluids in block data
64 | parameter (ncmax=20) !max number of components in mixture
65 | parameter (nrefmx=10) !max number of fluids for transport ECS
66 | parameter (n0=-ncmax-nrefmx,nx=ncmax)
67 | parameter (nph0mx=10) !max number of terms in phi0 function
68 | character*1 htab,hnull
69 | character*12 hcasno,hcas
70 | character*255 herr
71 | common /HCHAR/ htab,hnull
72 | c commons associated with the nc components of current interest
73 | c ("working" commons and arrays)
74 | common /CASPH0/ hcas(mxph0)
75 | common /WNTPH0/ nlog(n0:nx),ntau(n0:nx),nexp(n0:nx),ncosh(n0:nx),
76 | & nsinh(n0:nx),nsp1(n0:nx),nsp2(n0:nx),nsp3(n0:nx)
77 | common /WLMPH0/ tmin(n0:nx),tmax(n0:nx),pmax(n0:nx),rhomax(n0:nx)
78 | common /WCFPH0/ ai(n0:nx,nph0mx),ti(n0:nx,nph0mx)
79 | common /PH0SAV/ ph0sav(n0:nx),ph1sav(n0:nx),ph2sav(n0:nx),
80 | & tsav(0:2,n0:nx),rhosav(0:2,n0:nx)
81 | c
82 | c (re)initialize contents of /PH0SAV/ when a new fluid is read in
83 | common /Gcnst/ R,tz(n0:nx),rhoz(n0:nx)
84 | common /VERS/ verfl(n0:nx),vermx !fluid & mix file version nos.
85 | do i=n0,nx
86 | ph0sav(i)=0.0d0
87 | ph1sav(i)=0.0d0
88 | ph2sav(i)=0.0d0
89 | do j=0,2
90 | tsav(j,i)=0.0d0
91 | rhosav(j,i)=0.0d0
92 | enddo
93 | enddo
94 | c
95 | if (nread.le.0) then
96 | c get coefficients from block data
97 | c identify specified fluid with entries in database via match of CAS no
98 | do k=1,mxph0
99 | if (hcasno.eq.hcas(k)) then
100 | c write (*,*)' SETPH0--ERROR, block data read not implemented'
101 | ierr=1
102 | herr='[SETPH0 error] Block data option not implemented'//hnull
103 | RETURN
104 | end if
105 | enddo
106 | ierr=1
107 | herr='[SETPH0 error] Input fluid (block data) not found'//hnull
108 | RETURN
109 | else
110 | c read data from file
111 | c write (*,*) ' SETPH0--read component',icomp,' from unit',nread
112 | read (nread,*) tmin(icomp) !lower temperature limit
113 | read (nread,*) tmax(icomp) !upper temperature limit
114 | read (nread,*) pmax(icomp) !upper pressure limit
115 | read (nread,*) rhomax(icomp) !upper density limit
116 | c read number of terms for each of the various types
117 | if (verfl(icomp).ge.8.0d0) then
118 | read (nread,*) nlog(icomp),ntau(icomp),nexp(icomp),
119 | & ncosh(icomp),nsinh(icomp),
120 | & nsp1(icomp),nsp2(icomp),nsp3(icomp) !spares
121 | else
122 | read (nread,*) nlog(icomp),ntau(icomp),nexp(icomp)
123 | ncosh(icomp)=0 !these terms not used in files prior to v8.0
124 | nsinh(icomp)=0
125 | nsp1(icomp)=0
126 | nsp2(icomp)=0
127 | nsp3(icomp)=0
128 | endif
129 | jterm=nlog(icomp)+ntau(icomp)+nexp(icomp)+ncosh(icomp)
130 | & +nsinh(icomp)+nsp1(icomp)+nsp2(icomp)+nsp3(icomp)
131 | if (jterm.ge.1) then
132 | c read coefficients for terms of the form [ai*log(tau**ti)],
133 | c [ai*tau**ti], and [ai*log(1-EXP(bi*tau))]
134 | do i=1,jterm
135 | read (nread,*) ai(icomp,i),ti(icomp,i)
136 | enddo
137 | end if
138 | ierr=0
139 | herr=' '
140 | end if
141 | c
142 | RETURN
143 | end !subroutine SETPH0
144 | c
145 | c ======================================================================
146 | c
147 | function PH0PH0 (icomp,itau,idel,t,rho)
148 | c
149 | c compute the ideal gas part of the reduced Helmholtz energy or a
150 | c derivative as functions of temperature and pressure; for
151 | c use with a Helmholtz-explicit equation of state
152 | c
153 | c inputs:
154 | c icomp--pointer specifying component (1..nc)
155 | c itau--flag specifying order of temperature derivative to calc
156 | c idel--flag specifying order of density derivative to calculate
157 | c (the density derivatives are not used in the calculation
158 | c of any property, and are not implemented)
159 | c when itau = 0 and idel = 0, compute A0/RT
160 | c when itau = 1 and idel = 0, 1st temperature derivative
161 | c when itau = 2 and idel = 0, 2nd temperature derivative
162 | c t--temperature (K)
163 | c rho--density (mol/L)
164 | c output (as function value):
165 | c ph0ph0--ideal-gas part of the Helmholtz energy in reduced form (A/RT)
166 | c derivatives (as specified by itau and idel) are multiplied
167 | c by the corresponding power of tau; i.e. when itau = 1, the
168 | c quantity returned is tau*d(ph0ph0)/d(tau) and when itau = 2,
169 | c the quantity returned is tau*tau*d2(ph0ph0)/d(tau)**2
170 | c
171 | c Note: While the real-gas part of the Helmholtz energy is calculated
172 | c in terms of dimensionless temperature and density, the ideal-
173 | c gas part is calculated in terms of absolute temperature and
174 | c density. (This distinction is necessary for mixtures.)
175 | c
176 | c The Helmholtz energy consists of ideal-gas and residual
177 | c (real-gas) terms; this routine calculates only the ideal part.
178 | c
179 | c This function computes pure component properties only.
180 | c
181 | c written by M. McLinden, NIST Thermophysics Division, Boulder, Colorado
182 | c 05-13-96 MM, original version, based (loosely) on PH0CPP
183 | c 06-14-96 MM, add rhosav to /PH0SAV/
184 | c 07-08-96 MM, change derivative outputs: tau*d(phi)/d(tau), etc
185 | c 08-20-97 MM, call ERRMSG if itau out of range; drop idel=idel
186 | c 07-11-00 EWL, remove krypton pieces
187 | c 07-25-06 EWL, add cosh and sinh functions
188 | c 08-24-06 EWL, add check for PHG in hmodcp (add EOSMOD common block).
189 | c If it is used, multiple by R*/R as described in GERG-2004 eos (of Kunz and Wagner)
190 | c
191 | implicit double precision (a-h,o-z)
192 | implicit integer (i-k,m,n)
193 | implicit logical (l)
194 | parameter (ncmax=20) !max number of components in mixture
195 | parameter (nrefmx=10) !max number of fluids for transport ECS
196 | parameter (n0=-ncmax-nrefmx,nx=ncmax)
197 | parameter (nph0mx=10) !max number of terms in phi0 function
198 | character*1 htab,hnull
199 | character*255 herr
200 | character*3 hpheq,heos,hmxeos,hmodcp
201 | common /HCHAR/ htab,hnull
202 | common /CREF/ tref(n0:nx),rhoref(n0:nx),href(n0:nx),sref(n0:nx)
203 | common /Gcnst/ R,tz(n0:nx),rhoz(n0:nx)
204 | c commons associated with the nc components of current interest
205 | c ("working" commons and arrays)
206 | common /WNTPH0/ nlog(n0:nx),ntau(n0:nx),nexp(n0:nx),ncosh(n0:nx),
207 | & nsinh(n0:nx),nsp1(n0:nx),nsp2(n0:nx),nsp3(n0:nx)
208 | common /WLMPH0/ tmin(n0:nx),tmax(n0:nx),pmax(n0:nx),rhomax(n0:nx)
209 | common /WCFPH0/ ai(n0:nx,nph0mx),ti(n0:nx,nph0mx)
210 | c saved values from previous calls to this routine
211 | common /PH0SAV/ ph0sav(n0:nx),ph1sav(n0:nx),ph2sav(n0:nx),
212 | & tsav(0:2,n0:nx),rhosav(0:2,n0:nx)
213 | common /EOSFLG/ kryptn(n0:nx),ispr1(n0:nx),ispr2(n0:nx),
214 | & ispr3(n0:nx),ispr4(n0:nx),ispr5(n0:nx),
215 | & ispr6(n0:nx)
216 | common /EOSMOD/ hpheq,heos,hmxeos(n0:nx),hmodcp(n0:nx)
217 | c
218 | c compute reduced Helmholtz; first check if t same as previous call
219 | c
220 | PH0PH0=0.0d0 !initialize in case of error
221 | if (t.le.0) RETURN
222 | tau=tz(icomp)/t
223 | del=rho/rhoz(icomp)
224 | if (itau*idel.ne.0) then
225 | PH0PH0=0.0d0
226 | elseif (itau.eq.0 .and. idel.eq.0) then
227 | if (abs(t-tsav(0,icomp)).lt.1.0d-8 .and.
228 | & abs(rho-rhosav(0,icomp)).lt.1.0d-10) then
229 | PH0PH0=ph0sav(icomp)
230 | c write (*,*) ' PH0PH0--using saved phi for itau = 0, t =',t
231 | else
232 | c write (*,1030) icomp,t,rho,t0,D0,tau,del
233 | c1030 format (1x,'PH0PH0--icomp,t,rho,t0,D0,tau,del: ',i4,6e14.6)
234 | iterm=0
235 | phisum=LOG(del)
236 | c & +href(icomp)/R/t-sref(icomp)/R !see U. Idaho class notes
237 | if (nlog(icomp).ge.1) then
238 | c sum terms of the form [ai*log(tau**ti)]
239 | do i=1,nlog(icomp)
240 | iterm=iterm+1
241 | phisum=phisum+ai(icomp,iterm)*LOG(tau**ti(icomp,iterm))
242 | c write (*,1040) iterm,ai(icomp,iterm),ti(icomp,iterm),phisum
243 | c1040 format (' PH0PH0--log term iterm,ai,ti,phisum: ',i3,3f12.6)
244 | enddo
245 | end if
246 | if (ntau(icomp).ge.1) then
247 | c sum terms of the form [ai*tau**ti]
248 | do j=1,ntau(icomp)
249 | iterm=iterm+1
250 | phisum=phisum+ai(icomp,iterm)*tau**ti(icomp,iterm)
251 | c write (*,1060) iterm,ai(icomp,iterm),ti(icomp,iterm),phisum
252 | c1060 format (' PH0PH0--tau term iterm,ai,ti,phisum: ',i3,3f12.6)
253 | enddo
254 | end if
255 | if (nexp(icomp).ge.1) then
256 | c sum terms of the form [ai*log(1-EXP(bi*tau))]
257 | c (the bi coefficients are stored in the ti array)
258 | do k=1,nexp(icomp)
259 | iterm=iterm+1
260 | phisum=phisum+ai(icomp,iterm)
261 | & *LOG(1.0d0-EXP(ti(icomp,iterm)*tau))
262 | c write (*,1080) iterm,ai(icomp,iterm),ti(icomp,iterm),phisum
263 | c1080 format (' PH0PH0--exp term iterm,ai,ti,phisum: ',i3,3f12.6)
264 | enddo
265 | end if
266 | if (ncosh(icomp).ge.1) then
267 | c sum terms of the form [ai*log(cosh(bi*tau))]
268 | do k=1,ncosh(icomp)
269 | iterm=iterm+1
270 | ttau=ti(icomp,iterm)*tau
271 | if (ttau.lt.700.d0) then
272 | phisum=phisum+ai(icomp,iterm)*LOG(COSH(ttau))
273 | else
274 | phisum=phisum+ai(icomp,iterm)*700.d0
275 | endif
276 | enddo
277 | end if
278 | if (nsinh(icomp).ge.1) then
279 | c sum terms of the form [ai*log(sinh(bi*tau))]
280 | do k=1,nsinh(icomp)
281 | iterm=iterm+1
282 | ttau=ti(icomp,iterm)*tau
283 | if (ttau.lt.700.d0) then
284 | phisum=phisum+ai(icomp,iterm)*LOG(SINH(ttau))
285 | else
286 | phisum=phisum+ai(icomp,iterm)*700.d0
287 | endif
288 | enddo
289 | end if
290 | PH0PH0=phisum
291 | c save information for possible use on next call to function
292 | tsav(0,icomp)=t
293 | rhosav(0,icomp)=rho
294 | ph0sav(icomp)=PH0PH0
295 | end if
296 | c
297 | c compute derivative w.r.t. tau (dimensionless temperature)
298 | c
299 | else if (itau.eq.1) then
300 | if (abs(t-tsav(1,icomp)).lt.1.0d-8 .and.
301 | & abs(rho-rhosav(1,icomp)).lt.1.0d-10) then
302 | PH0PH0=ph1sav(icomp)
303 | else
304 | iterm=0
305 | phisum=0.0d0
306 | c phisum=href(icomp)/(R*tz) !see U. Idaho class notes
307 | if (nlog(icomp).ge.1) then
308 | c sum terms of the form [ai*log(tau**ti)]
309 | do i=1,nlog(icomp)
310 | iterm=iterm+1
311 | phisum=phisum+ai(icomp,iterm)*ti(icomp,iterm)/tau
312 | enddo
313 | end if
314 | if (ntau(icomp).ge.1) then
315 | c sum terms of the form [ai*tau**ti]
316 | do j=1,ntau(icomp)
317 | iterm=iterm+1
318 | phisum=phisum+ai(icomp,iterm)*ti(icomp,iterm)
319 | & *tau**(ti(icomp,iterm)-1.0d0)
320 | enddo
321 | end if
322 | if (nexp(icomp).ge.1) then
323 | c sum terms of the form [ai*log(1-EXP(bi*tau))]
324 | c (the bi coefficients are stored in the ti array)
325 | do k=1,nexp(icomp)
326 | iterm=iterm+1
327 | exptau=EXP(ti(icomp,iterm)*tau)
328 | phisum=phisum-ai(icomp,iterm)*ti(icomp,iterm)
329 | & *exptau/(1.0d0-exptau)
330 | enddo
331 | end if
332 | if (ncosh(icomp).ge.1) then
333 | c sum terms of the form [ai*log(cosh(bi*tau))]
334 | do k=1,ncosh(icomp)
335 | iterm=iterm+1
336 | phisum=phisum+ai(icomp,iterm)*ti(icomp,iterm)
337 | & *(TANH(ti(icomp,iterm)*tau))
338 | enddo
339 | end if
340 | if (nsinh(icomp).ge.1) then
341 | c sum terms of the form [ai*log(sinh(bi*tau))]
342 | do k=1,nsinh(icomp)
343 | iterm=iterm+1
344 | phisum=phisum+ai(icomp,iterm)*ti(icomp,iterm)
345 | & /(TANH(ti(icomp,iterm)*tau))
346 | enddo
347 | end if
348 | c save information for possible use on next call to function
349 | PH0PH0=phisum*tau !return tau*d(ph0ph0)/d(tau)
350 | tsav(1,icomp)=t
351 | rhosav(1,icomp)=rho
352 | ph1sav(icomp)=PH0PH0
353 | end if
354 | c
355 | c compute 2nd derivative w.r.t. tau (dimensionless temperature)
356 | c
357 | else if (itau.eq.2) then
358 | if (abs(t-tsav(2,icomp)).lt.1.0d-8 .and.
359 | & abs(rho-rhosav(2,icomp)).lt.1.0d-10) then
360 | PH0PH0=ph2sav(icomp)
361 | else
362 | iterm=0
363 | phisum=0.0d0
364 | if (nlog(icomp).ge.1) then
365 | c sum terms of the form [ai*log(tau**ti)]
366 | do i=1,nlog(icomp)
367 | iterm=iterm+1
368 | phisum=phisum-ai(icomp,iterm)*ti(icomp,iterm)/tau**2
369 | enddo
370 | end if
371 | if (ntau(icomp).ge.1) then
372 | c sum terms of the form [ai*tau**ti]
373 | do j=1,ntau(icomp)
374 | iterm=iterm+1
375 | phisum=phisum+ai(icomp,iterm)*ti(icomp,iterm)
376 | & *(ti(icomp,iterm)-1.0d0)*tau**(ti(icomp,iterm)-2.0d0)
377 | enddo
378 | end if
379 | if (nexp(icomp).ge.1) then
380 | c sum terms of the form [ai*log(1-EXP(bi*tau))]
381 | c (the bi coefficients are stored in the ti array)
382 | do k=1,nexp(icomp)
383 | iterm=iterm+1
384 | exptau=EXP(ti(icomp,iterm)*tau)
385 | phisum=phisum-ai(icomp,iterm)*ti(icomp,iterm)**2
386 | & *exptau/(1.0d0-exptau)**2
387 | enddo
388 | end if
389 | if (ncosh(icomp).ge.1) then
390 | c sum terms of the form [ai*log(cosh(bi*tau))]
391 | do k=1,ncosh(icomp)
392 | iterm=iterm+1
393 | if (ti(icomp,iterm)*tau.lt.500.d0) then
394 | phisum=phisum+ai(icomp,iterm)*ti(icomp,iterm)**2
395 | & /(COSH(ti(icomp,iterm)*tau))**2
396 | endif
397 | enddo
398 | end if
399 | if (nsinh(icomp).ge.1) then
400 | c sum terms of the form [ai*log(sinh(bi*tau))]
401 | do k=1,nsinh(icomp)
402 | iterm=iterm+1
403 | if (ti(icomp,iterm)*tau.lt.500.d0) then
404 | phisum=phisum-ai(icomp,iterm)*ti(icomp,iterm)**2
405 | & /(SINH(ti(icomp,iterm)*tau))**2
406 | endif
407 | enddo
408 | end if
409 | c save information for possible use on next call to function
410 | PH0PH0=phisum*tau*tau
411 | tsav(2,icomp)=t
412 | rhosav(2,icomp)=rho
413 | c return tau**2*d2(ph0ph0)/d(tau**2)
414 | ph2sav(icomp)=PH0PH0
415 | end if
416 | else if (itau.eq.3) then
417 | iterm=0
418 | phisum=0.0d0
419 | if (nlog(icomp).ge.1) then
420 | do i=1,nlog(icomp)
421 | iterm=iterm+1
422 | phisum=phisum+2.d0*ai(icomp,iterm)*ti(icomp,iterm)/tau**3
423 | enddo
424 | end if
425 | if (ntau(icomp).ge.1) then
426 | do j=1,ntau(icomp)
427 | iterm=iterm+1
428 | phisum=phisum+ai(icomp,iterm)*ti(icomp,iterm)
429 | & *(ti(icomp,iterm)-1.0d0)
430 | & *(ti(icomp,iterm)-2.0d0)*tau**(ti(icomp,iterm)-3.0d0)
431 | enddo
432 | end if
433 | if (nexp(icomp).ge.1) then
434 | do k=1,nexp(icomp)
435 | iterm=iterm+1
436 | exptau=EXP(ti(icomp,iterm)*tau)
437 | phisum=phisum-ai(icomp,iterm)*ti(icomp,iterm)**3*
438 | & (exptau/(1.0d0-exptau)**2+
439 | & 2.d0*exptau**2/(1.0d0-exptau)**3)
440 | enddo
441 | end if
442 | if (ncosh(icomp).ge.1) then
443 | do k=1,ncosh(icomp)
444 | iterm=iterm+1
445 | phisum=phisum-2.d0*ai(icomp,iterm)*ti(icomp,iterm)**3
446 | & /(COSH(ti(icomp,iterm)*tau))**3
447 | & *(SINH(ti(icomp,iterm)*tau))
448 | enddo
449 | end if
450 | if (nsinh(icomp).ge.1) then
451 | do k=1,nsinh(icomp)
452 | iterm=iterm+1
453 | phisum=phisum+2.d0*ai(icomp,iterm)*ti(icomp,iterm)**3
454 | & /(SINH(ti(icomp,iterm)*tau))**3
455 | & *(COSH(ti(icomp,iterm)*tau))
456 | enddo
457 | end if
458 | PH0PH0=phisum*tau**3
459 | elseif (idel.eq.1) then
460 | PH0PH0=1.0d0
461 | elseif (idel.eq.2) then
462 | PH0PH0=-1.0d0
463 | elseif (idel.eq.3) then
464 | PH0PH0=2.0d0
465 | else
466 | c
467 | c invalid value of itau
468 | c
469 | ierr=99
470 | write (herr,1099) itau,idel,hnull
471 | 1099 format ('[PH0PH0 warning] invalid input; itau =',i4,'; idel =',
472 | & i4,a1)
473 | call ERRMSG (ierr,herr)
474 | PH0PH0=0.0d0
475 | end if
476 | if (hmodcp(icomp).eq.'PHG') then
477 | PH0PH0=8.31451D0/8.314472D0*PH0PH0
478 | endif
479 | c
480 | c write (*,*) ' PH0PH0: output phi: ',ph0ph0
481 | c
482 | RETURN
483 | end !function PH0PH0
484 | c
485 | c 1 2 3 4 5 6 7
486 | c23456789012345678901234567890123456789012345678901234567890123456789012
487 | c
488 | c ======================================================================
489 | c end file core_PH0.f
490 | c ======================================================================
491 |
--------------------------------------------------------------------------------
/Source_Code/fortran/CORE_QUI.FOR:
--------------------------------------------------------------------------------
1 | c begin file core_QUI.f
2 | c
3 | c This file contains the routines implementing the Helmholtz form of
4 | c the pure fluid equation of state in the Quintic form.
5 | c
6 | c contained here are:
7 | c function PHIQUI (icomp,itau,idel,tau,del)
8 | c subroutine CRTQUI (icomp,tcrit,pcrit,Dcrit)
9 | c subroutine REDQUI (icomp,tred,Dred)
10 | c subroutine SETQUI (nread,icomp,hcasno,ierr,herr)
11 | c
12 | c ======================================================================
13 | c ======================================================================
14 | c
15 | function PHIQUI (icomp,itau,idel,tau,del)
16 | c
17 | c compute reduced Helmholtz energy or a derivative as functions
18 | c of dimensionless temperature and density for the Helmholtz-explicit
19 | c equation of state
20 | c
21 | c inputs:
22 | c icomp--pointer specifying component (1..nc)
23 | c itau--flag specifying order of temperature derivative to calc
24 | c idel--flag specifying order of density derivative to calculate
25 | c when itau = 0 and idel = 0, compute A/RT
26 | c when itau = 0 and idel = 1, compute 1st density derivative
27 | c when itau = 1 and idel = 1, compute cross derivative
28 | c etc.
29 | c tau--dimensionless temperature (To/T)
30 | c del--dimensionless density (D/Do)
31 | c output (as function value):
32 | c phi--residual (real-gas) part of the Helmholtz energy, or one
33 | c of its derivatives (as specified by itau and idel),
34 | c in reduced form (A/RT)
35 | c itau idel output (dimensionless for all cases)
36 | c 0 0 A/RT
37 | c 1 0 tau*[d(A/RT)/d(tau)]
38 | c 2 0 tau**2*[d**2(A/RT)/d(tau)**2]
39 | c 0 1 del*[d(A/RT)/d(del)]
40 | c 0 2 del**2*[d**2(A/RT)/d(del)**2]
41 | c 1 1 tau*del*[d**2(A/RT)/d(tau)d(del)]
42 | c etc.
43 | c
44 | c written by D.E. Cristancho, NIST Thermophysics Division, Boulder, Colorado
45 | c 06-18-09 DEC, original version
46 | c
47 | implicit double precision (a-h,o-z)
48 | implicit integer (i-n)
49 | c
50 | parameter (ncmax=20) !max number of components in mixture
51 | parameter (nrefmx=10) !max number of fluids for transport ECS
52 | parameter (n0=-ncmax-nrefmx,nx=ncmax)
53 | parameter (mxtrm=72)
54 | character*16 drvflg(n0:nx)
55 | c numbers of terms associated with the "normal" Helmholtz function
56 | c (plus numbers of unique powers of temperature, density, etc.),
57 | common /WNTQUI/ neta(n0:nx),neps(n0:nx),nbb(n0:nx),ngam(n0:nx),
58 | & nbet(n0:nx)
59 | common /WCFQUI/ aq(n0:nx,mxtrm),tiq(n0:nx,mxtrm),diq(n0:nx,mxtrm),
60 | & rho0q(n0:nx),t0q(n0:nx),
61 | & pcq(n0:nx),rhocq(n0:nx),tcq(n0:nx),
62 | & wmfq(n0:nx),Rqui(n0:nx),
63 | & pminq(n0:nx),rhotpq(n0:nx),tminq(n0:nx),
64 | & tmaxq(n0:nx),pmaxq(n0:nx)
65 | common /QUISV2/ drvflg
66 | common /QUISAV/ phisav(n0:nx,mxtrm),delsav(n0:nx),tausav(n0:nx),
67 | & taup(n0:nx,mxtrm),delp(n0:nx,mxtrm),
68 | & drvsav(n0:nx,16)
69 | common /QUITERMS/ eta,eta10,eta20,eps,eps10,eps20,
70 | & bb,bb10,bb20,gam,gam10,gam20
71 | c common storing the fluid constants
72 | common /CCON/ tcc(n0:nx),pcc(n0:nx),rhocc(n0:nx),Zcrit(n0:nx),
73 | & ttp(n0:nx),ptp(n0:nx),dtp(n0:nx),dtpv(n0:nx),
74 | & tnbp(n0:nx),dnbpl(n0:nx),dnbpv(n0:nx),
75 | & wm(n0:nx),accen(n0:nx),dipole(n0:nx),Reos(n0:nx)
76 | c
77 | phiqui=0.d0
78 | if (del.le.1.0d-10) RETURN !trivial solution at zero density for
79 | if (tau.le.0.d0) RETURN ! any and all derivatives
80 | c
81 | ncode=idel*4+itau+1
82 | nterm=neta(icomp)+neps(icomp)+nbb(icomp)+ngam(icomp)+nbet(icomp)
83 | if (abs(tau-tausav(icomp)).lt.1.0d-12 .and.
84 | & abs(del-delsav(icomp)).lt.1.0d-16) then
85 | c retrieve value from previous call
86 | if (drvflg(icomp)(ncode:ncode).eq.'1') then
87 | phiqui=drvsav(icomp,ncode)
88 | RETURN
89 | endif
90 | else
91 | c otherwise, compute new values and save for possible future use
92 | c first compute needed powers of tau and del (and save for future use)
93 | drvflg(icomp)='0000000000000000'
94 | if (abs(tau-tausav(icomp)).gt.1.0d-12) then
95 | elntau=log(tau)
96 | tausav(icomp)=tau
97 | do j=1,nterm
98 | taup(icomp,j)=tiq(icomp,j)*elntau
99 | enddo
100 | end if
101 | if (abs(del-delsav(icomp)).gt.1.0d-16) then
102 | elndel=log(del)
103 | delsav(icomp)=del
104 | do j=1,nterm
105 | delp(icomp,j)=diq(icomp,j)*elndel
106 | enddo
107 | end if
108 | c
109 | phisum=0.d0
110 | eta=0.d0
111 | eta10=0.d0
112 | eta20=0.d0
113 | eps=0.d0
114 | eps10=0.d0
115 | eps20=0.d0
116 | bb=0.d0
117 | bb10=0.d0
118 | bb20=0.d0
119 | gam=0.d0
120 | gam10=0.d0
121 | gam20=0.d0
122 | bet=0.d0
123 | bet10=0.d0
124 | bet20=0.d0
125 | j=0
126 | do k=1,neta(icomp)
127 | j=j+1
128 | eta=eta+aq(icomp,j)*tau**tiq(icomp,j)
129 | eta10=eta10+tiq(icomp,j)*aq(icomp,j)*tau**(tiq(icomp,j)-1.d0)
130 | eta20=eta20+tiq(icomp,j)*(tiq(icomp,j)-1.d0)*
131 | & aq(icomp,j)*tau**(tiq(icomp,j)-2.d0)
132 | enddo
133 | do k=1,neps(icomp)
134 | j=j+1
135 | eps=eps+aq(icomp,j)*tau**tiq(icomp,j)
136 | eps10=eps10+tiq(icomp,j)*aq(icomp,j)*tau**(tiq(icomp,j)-1.d0)
137 | eps20=eps20+tiq(icomp,j)*(tiq(icomp,j)-1.d0)*
138 | & aq(icomp,j)*tau**(tiq(icomp,j)-2.d0)
139 | enddo
140 | do k=1,nbb(icomp)
141 | j=j+1
142 | bb=bb+aq(icomp,j)*tau**tiq(icomp,j)
143 | bb10=bb10+tiq(icomp,j)*aq(icomp,j)*tau**(tiq(icomp,j)-1.d0)
144 | bb20=bb20+tiq(icomp,j)*(tiq(icomp,j)-1.d0)*
145 | & aq(icomp,j)*tau**(tiq(icomp,j)-2.d0)
146 | enddo
147 | do k=1,ngam(icomp)
148 | j=j+1
149 | gam=gam+aq(icomp,j)*tau**tiq(icomp,j)
150 | gam10=gam10+tiq(icomp,j)*aq(icomp,j)*tau**(tiq(icomp,j)-1.d0)
151 | gam20=gam20+tiq(icomp,j)*(tiq(icomp,j)-1.d0)*
152 | & aq(icomp,j)*tau**(tiq(icomp,j)-2.d0)
153 | enddo
154 | do k=1,nbet(icomp)
155 | j=j+1
156 | bet=bet+aq(icomp,j)*tau**tiq(icomp,j)
157 | bet10=bet10+tiq(icomp,j)*aq(icomp,j)*tau**(tiq(icomp,j)-1.d0)
158 | bet20=bet20+tiq(icomp,j)*(tiq(icomp,j)-1.d0)*
159 | & aq(icomp,j)*tau**(tiq(icomp,j)-2.d0)
160 | enddo
161 | phisum=eta*(del-log(1.d0-bb*del)/bb)
162 | & -eps*log((1.d0+gam*del)/(1.d0-bet*del))
163 | c ex=taup(icomp,k)+delp(icomp,k)
164 | c if (ex.lt.100.d0 .and. ex.gt.-200.d0) then
165 | c phisav(icomp,k)=aq(icomp,k)*EXP(ex)
166 | c else
167 | c phisav(icomp,k)=0.d0
168 | c endif
169 | c phisum=phisum+phisav(icomp,k)
170 | phiqui=phisum
171 | drvflg(icomp)(1:1)='1'
172 | drvsav(icomp,1)=phiqui
173 | end if
174 | c
175 | c check if derivatives are requested, calculations make use of fact
176 | c that terms in derivative summations are very similar to A/RT terms
177 | c
178 | if (idel.eq.1) then
179 | c compute derivative w.r.t. del (dimensionless density)
180 | c save individual terms for possible use in cross derivative
181 | phisum=0.d0
182 | phisum=eta*(1.d0+1.d0/(1.d0-bb*del))
183 | & -eps*(gam/(1.d0+gam*del)+bet/(1.d0-bet*del))
184 | phiqui=phisum*del
185 | c
186 | elseif (idel.eq.2) then
187 | c compute 2nd derivative w.r.t. del (dimensionless density)
188 | c save individual terms for possible use in cross derivative
189 | phisum=0.d0
190 | c do k=1,nterm
191 | c dik=diq(icomp,k)
192 | c phi02(k)=phisav(icomp,k)*(dik**2-dik)
193 | c phisum+phi02(k)
194 | c phisum=eta*(1.d0+1.d0/(1.d0-bb*del))
195 | c eps*(gam/(1.d0+gam*del)+bet/(1.d0-bet*del))
196 | c enddo
197 | phisum=eta*bb/(1.d0-bb*del)**2
198 | & -eps*(-gam**2/(1.d0+gam*del)**2
199 | & +bet**2/(1.d0-bet*del)**2)
200 | phiqui=phisum*del**2
201 | c
202 | elseif (idel.eq.3) then
203 | c compute 3rd derivative w.r.t. del (dimensionless density)
204 | phisum=0.d0
205 | c do k=1,nterm
206 | c dik=diq(icomp,k)
207 | c phi03(k)=phisav(icomp,k)
208 | c & +6.0d0*dik-3.0d0*dik-3.0d0*dik**2
209 | c phisum=phisum+phi03(k)
210 | c enddo
211 | phisum=2.d0*eta*bb**2/(1.d0-bb*del)**3
212 | & -2.d0*eps*(gam**3/(1.d0+gam*del)**3
213 | & +bet**3/(1.d0-bet*del)**3)
214 | phiqui=phisum*del**3
215 | end if
216 | c
217 | c
218 | c epsi0,bbio,gami0,beti0,etai0 are the i tau derivatives of fitting
219 | c parameters
220 | c
221 | if (itau.eq.1) then
222 | c compute derivative w.r.t. tau (dimensionless temperature)
223 | c save individual terms for possible use in cross derivative
224 | phisum=0.d0
225 | phisum=eta10*(del-log(1.d0-bb*del)/bb)
226 | & +eta*bb10/bb*(log(1.d0-bb*del)/bb+del/(1.d0-bb*del))
227 | & -eps10*log((1.d0+gam*del)/(1.d0-bet*del))
228 | & -eps*del*(gam10/(1.d0+gam*del)
229 | & +bet10/(1.d0-bet*del))
230 | phiqui=phisum*tau
231 | c
232 | elseif (itau.eq.2) then
233 | c compute 2nd derivative w.r.t. tau (dimensionless temperature)
234 | c save individual terms for possible use in cross derivative
235 | phisum=0.d0
236 | c do k=1,nterm
237 | c tik=tiq(icomp,k)
238 | c phi20(k)=phisav(icomp,k)*tik*(tik-1.0d0)
239 | c phisum=phisum+phi20(k)
240 | c enddo
241 | phisum=eta20*(del-log(1.d0-bb*del)/bb)
242 | & +1.d0/bb*(2.d0*eta10*bb10+eta*bb20-eta*bb10**2/bb)
243 | & *(log(1.d0-bb*del)/bb+del/(1.d0-bb*del))
244 | & +eta*bb10**2/bb**2*(del*(2.d0*bb*del-1)/
245 | & (1.d0-bb*del)**2-log(1.d0-bb*del)/bb)
246 | & -eps20*log((1.d0+gam*del)/(1.d0-bet*del))
247 | & -2.d0*eps10*del*(gam10/(1.d0+gam*del)
248 | & +bet10/(1.d0-bet*del))
249 | & -eps*del*(gam20/(1.d0+gam*del)
250 | & +bet20/(1.d0-bet*del)-del*(gam10**2/
251 | & (1.d0+gam*del)**2-bet10**2/(1.d0-bet*del)**2))
252 |
253 | phiqui=phisum*tau**2
254 | c
255 | C not third derivative!!!!!
256 | elseif (itau.eq.3) then
257 | c compute 3rd derivative w.r.t. tau (dimensionless temperature)
258 | phisum=0.d0
259 | do k=1,nterm
260 | tik=tiq(icomp,k)
261 | phisum=phisum+phisav(icomp,k)*tik*(tik-1.d0)*(tik-2.d0)
262 | enddo
263 | phiqui=phisum
264 | end if
265 | c
266 | c
267 | if (itau.eq.1 .and. idel.eq.1) then
268 | c compute cross derivative using terms from 1st derivatives
269 | phisum=0.d0
270 | phisum=eta10*(1.d0+1.d0/(1.d0-bb*del))
271 | & +eta*bb10*del/(1.d0-bb*del)**2
272 | & -eps10*(gam/(1.d0+gam*del)+bet/(1.d0-bet*del))
273 | & -eps*(gam10/(1.d0+gam*del)
274 | & +bet10/(1.d0-bet*del)-del*(gam*gam10/
275 | & (1.d0+gam*del)**2-bet*bet10/(1.d0-bet*del)**2))
276 | phiqui=phisum*del*tau
277 | c
278 | elseif (itau.eq.2 .and. idel.eq.1) then
279 | c compute cross derivative using term from 1st derivative
280 | phisum=0.d0
281 | C do k=1,nterm
282 | C tik=tiq(icomp,k)
283 | C phisum=phisum+(tik*tik-tik)*phi01(k)
284 | C enddo
285 | phiqui=phisum
286 | c
287 | elseif (itau.eq.1 .and. idel.eq.2) then
288 | c compute cross derivative using term from 2nd derivative
289 | phisum=0.d0
290 | C do k=1,nterm
291 | C phisum=phisum+tiq(icomp,k)*phi02(k)
292 | C enddo
293 | phiqui=phisum
294 | c
295 | elseif (itau.eq.2 .and. idel.eq.2) then
296 | c compute cross derivative using terms from 2nd derivative
297 | phisum=0.d0
298 | C do k=1,nterm
299 | C tik=tiq(icomp,k)
300 | C phisum=phisum+(tik*tik-tik)*phi02(k)
301 | C enddo
302 | phiqui=phisum
303 | c
304 | end if
305 | c
306 | drvsav(icomp,ncode)=phiqui
307 | drvflg(icomp)(ncode:ncode)='1'
308 | c
309 | RETURN
310 | end !function PHIQUI
311 | c
312 | c ======================================================================
313 | c
314 | subroutine CRTQUI (icomp,tcrit,pcrit,Dcrit)
315 | c
316 | c returns critical parameters associated with Fundamental EOS
317 | c
318 | c input:
319 | c icomp--pointer specifying component (1..nc)
320 | c outputs:
321 | c tcrit--critical temperature (K)
322 | c pcrit--critical pressure (kPa)
323 | c Dcrit--molar density (mol/L) at critical point
324 | c
325 | c written by D.E. Cristancho, NIST Thermophysics Division, Boulder, Colorado
326 | c 06-18-09 DEC, original version
327 | c
328 | implicit double precision (a-h,o-z)
329 | implicit integer (i-n)
330 | c
331 | c
332 | parameter (mxtrm=72)
333 | parameter (ncmax=20) !max number of components in mixture
334 | parameter (nrefmx=10) !max number of fluids for transport ECS
335 | parameter (n0=-ncmax-nrefmx,nx=ncmax)
336 | common /WCFQUI/ aq(n0:nx,mxtrm),tiq(n0:nx,mxtrm),diq(n0:nx,mxtrm),
337 | & rho0q(n0:nx),t0q(n0:nx),
338 | & pcq(n0:nx),rhocq(n0:nx),tcq(n0:nx),
339 | & wmfq(n0:nx),Rqui(n0:nx),
340 | & pminq(n0:nx),rhotpq(n0:nx),tminq(n0:nx),
341 | & tmaxq(n0:nx),pmaxq(n0:nx)
342 | c
343 | tcrit=tcq(icomp)
344 | pcrit=pcq(icomp)
345 | Dcrit=rhocq(icomp)
346 | c
347 | RETURN
348 | end !subroutine CRTQUI
349 | c
350 | c ======================================================================
351 | c
352 | subroutine REDQUI (icomp,tred,Dred)
353 | c
354 | c returns reducing parameters associated with Fundamental EOS;
355 | c used to calculate the 'tau' and 'del' which are the independent
356 | c variables in the EOS
357 | c
358 | c input:
359 | c icomp--component number in mixture (1..nc); 1 for pure fluid
360 | c outputs:
361 | c tred--reducing temperature (K)
362 | c Dred--reducing molar density (mol/L)
363 | c
364 | c written by D.E. Cristancho, NIST Thermophysics Division, Boulder, Colorado
365 | c 06-18-09 DEC, original version
366 | c
367 | implicit double precision (a-h,o-z)
368 | implicit integer (i-n)
369 | c
370 | c
371 | parameter (mxtrm=72)
372 | parameter (ncmax=20) !max number of components in mixture
373 | parameter (nrefmx=10) !max number of fluids for transport ECS
374 | parameter (n0=-ncmax-nrefmx,nx=ncmax)
375 | common /WCFQUI/ aq(n0:nx,mxtrm),tiq(n0:nx,mxtrm),diq(n0:nx,mxtrm),
376 | & rho0q(n0:nx),t0q(n0:nx),
377 | & pcq(n0:nx),rhocq(n0:nx),tcq(n0:nx),
378 | & wmfq(n0:nx),Rqui(n0:nx),
379 | & pminq(n0:nx),rhotpq(n0:nx),tminq(n0:nx),
380 | & tmaxq(n0:nx),pmaxq(n0:nx)
381 | c
382 | tred=t0q(icomp)
383 | Dred=rho0q(icomp)
384 | c
385 | RETURN
386 | end !subroutine REDQUI
387 | c
388 | c ======================================================================
389 | c
390 | subroutine SETQUI (nread,icomp,hcasno,ierr,herr)
391 | c
392 | c set up working arrays for use with Fundamental equation of state
393 | c
394 | c inputs:
395 | c nread--file to read data from
396 | c <= 0 get data from block data
397 | c >0 read from logical unit nread (file should have already
398 | c been opened and pointer set by subroutine SETUP)
399 | c icomp--component number in mixture (1..nc); 1 for pure fluid
400 | c hcasno--CAS number of component icomp (not req'd if reading from file)
401 | c
402 | c outputs:
403 | c ierr--error flag: 0 = successful
404 | c 1 = error (e.g. fluid not found)
405 | c herr--error string (character*255 variable if ierr<>0)
406 | c other quantities returned via arrays in common /WCFQUI/
407 | c
408 | c written by D.E. Cristancho, NIST Thermophysics Division, Boulder, Colorado
409 | c 06-18-09 DEC, original version
410 | c
411 | implicit double precision (a-h,o-z)
412 | implicit integer (i-n)
413 | parameter (mxtrm=72)
414 | parameter (ncmax=20) !max number of components in mixture
415 | parameter (nrefmx=10) !max number of fluids for transport ECS
416 | parameter (n0=-ncmax-nrefmx,nx=ncmax)
417 | character*1 htab,hnull
418 | character*3 hpheq,heos,hmxeos,hmodcp
419 | character*12 hcasno
420 | character*255 herr
421 | c character*1 dummy
422 | common /NCOMP/ nc,ic
423 | common /HCHAR/ htab,hnull
424 | common /Gcnst/ R,tz(n0:nx),rhoz(n0:nx)
425 | c commons associated with the nc components of current interest
426 | c ("working" commons and arrays)
427 | common /CCON/ tcrit(n0:nx),pcrit(n0:nx),Dcrit(n0:nx),Zcrit(n0:nx),
428 | & ttp(n0:nx),ptp(n0:nx),dtp(n0:nx),dtpv(n0:nx),
429 | & tnbp(n0:nx),dnbpl(n0:nx),dnbpv(n0:nx),
430 | & wm(n0:nx),accen(n0:nx),dipole(n0:nx),Reos(n0:nx)
431 | c common /CPMOD/ hmodcp(n0:nx)
432 | common /EOSMOD/ hpheq,heos,hmxeos(n0:nx),hmodcp(n0:nx)
433 | common /WNTQUI/ neta(n0:nx),neps(n0:nx),nbb(n0:nx),ngam(n0:nx),
434 | & nbet(n0:nx)
435 | common /WCFQUI/ aq(n0:nx,mxtrm),tiq(n0:nx,mxtrm),diq(n0:nx,mxtrm),
436 | & rho0q(n0:nx),t0q(n0:nx),
437 | & pcq(n0:nx),rhocq(n0:nx),tcq(n0:nx),
438 | & wmfq(n0:nx),Rqui(n0:nx),
439 | & pminq(n0:nx),rhotpq(n0:nx),tminq(n0:nx),
440 | & tmaxq(n0:nx),pmaxq(n0:nx)
441 | c limits associated with the equation of state
442 | common /EOSLIM/ tmn(n0:nx),tmx(n0:nx),pmx(n0:nx),rhomx(n0:nx)
443 | common /QUISAV/ phisav(n0:nx,mxtrm),delsav(n0:nx),tausav(n0:nx),
444 | & taup(n0:nx,mxtrm),delp(n0:nx,mxtrm),
445 | & drvsav(n0:nx,16)
446 | c
447 | ierr=0
448 | herr=' '
449 | c (re)initialize contents of /QUISAV/ when a new fluid is read in
450 | do i=n0,nx
451 | delsav(i)=0.d0
452 | tausav(i)=0.d0
453 | do j=1,mxtrm
454 | phisav(i,j)=0.d0
455 | taup(i,j)=0.d0
456 | delp(i,j)=0.d0
457 | enddo
458 | enddo
459 | c
460 | if (nread.le.0 .or. hcasno.eq.' ') then
461 | c get coefficients from block data
462 | c identify specified fluid with entries in database via match of CAS no
463 | ierr=1
464 | herr='[SETQUI error] fluid input to SETQUI not found'//hnull
465 | else
466 | c read data from file
467 | read (nread,*) tminq(icomp) !lower temperature limit
468 | read (nread,*) tmaxq(icomp) !upper temperature limit
469 | read (nread,*) pmaxq(icomp) !upper pressure limit
470 | read (nread,*) rhomx(icomp) !upper density limit
471 | read (nread,2003) hmodcp(icomp) !pointer to Cp0 model
472 | read (nread,*) wm(icomp) !molecular weight
473 | wmfq(icomp)=wm(icomp)
474 | read (nread,*) ttp(icomp) !triple point temperature
475 | read (nread,*) pminq(icomp) !pressure at triple point
476 | read (nread,*) rhotpq(icomp) !density at triple point
477 | read (nread,*) tnbp(icomp) !normal boiling point temperature
478 | read (nread,*) accen(icomp) !acentric factor
479 | read (nread,*) tcq(icomp),pcq(icomp),rhocq(icomp) !critical par
480 | tcrit(icomp)=tcq(icomp)
481 | pcrit(icomp)=pcq(icomp)
482 | Dcrit(icomp)=rhocq(icomp)
483 | ptp(icomp)=pminq(icomp)
484 | dtp(icomp)=rhotpq(icomp)
485 | dtpv(icomp)=0.d0
486 | dnbpl(icomp)=0.d0
487 | dnbpv(icomp)=0.d0
488 | read (nread,*) t0q(icomp),rho0q(icomp) !reducing parameters
489 | tz(icomp)=t0q(icomp)
490 | rhoz(icomp)=rho0q(icomp)
491 | read (nread,*) Rqui(icomp) !gas constant used in fit
492 | if (nc.eq.1 .and. icomp.eq.1) R=Rqui(icomp)
493 | Reos(icomp)=Rqui(icomp)
494 | Zcrit(icomp)=pcq(icomp)/(Rqui(icomp)*tcq(icomp)*rhocq(icomp))
495 | read (nread,*) neta(icomp),neps(icomp),nbb(icomp),ngam(icomp),
496 | & nbet(icomp)
497 | nterm=neta(icomp)+neps(icomp)+nbb(icomp)+ngam(icomp)+nbet(icomp)
498 | do j=1,nterm
499 | read (nread,*) aq(icomp,j),tiq(icomp,j),diq(icomp,j)
500 | enddo
501 | end if
502 | c
503 | c copy limits into /EOSLIM/ arrays
504 | tmn(icomp)=tminq(icomp)
505 | tmx(icomp)=tmaxq(icomp)
506 | pmx(icomp)=pmaxq(icomp)
507 | c rhomx(icomp)=rhomaxq(icomp)
508 | c
509 | RETURN
510 | 2003 format (a3)
511 | end !subroutine SETQUI
512 | c
513 | c ======================================================================
514 | c
515 | c ======================================================================
516 | c end file core_QUI.f
517 | c ======================================================================
518 |
--------------------------------------------------------------------------------
/Source_Code/fortran/CORE_STN.FOR:
--------------------------------------------------------------------------------
1 | c begin file core_STN.f
2 | c
3 | c This file contains core routines for the surface tension.
4 | c
5 | c contained here are:
6 | c subroutine SURFT (t,rhol,xl,sigma,ierr,herr)
7 | c subroutine SURTEN (t,rhol,rhov,xl,xv,sigma,ierr,herr)
8 | c subroutine SETST1 (nread,icomp,hcasno,ierr,herr)
9 | c subroutine STN (t,rhol,xl,tcrit,pcrit,sigma,ierr,herr)
10 | c subroutine STNK (icomp,tau,sigma,ierr,herr)
11 | c subroutine CRITF (zeta,x,tcrit,pcrit,Dcrit,ierr,herr)
12 | c
13 | c ======================================================================
14 | c ======================================================================
15 | c
16 | subroutine SURFT (t,rhol,xl,sigma,ierr,herr)
17 | c
18 | c compute surface tension
19 | c
20 | c inputs:
21 | c t--temperature [K]
22 | c xl--composition of liquid phase [array of mol frac]
23 | c outputs:
24 | c rhol--molar density of liquid phase [mol/L]
25 | c if rho > 0 use as input value
26 | c < 0 call SATT to find density
27 | c sigma--surface tension [N/m]
28 | c ierr--error flag: 0 = successful
29 | c 1 = T < Tmin
30 | c 8 = x out of range
31 | c 9 = T and x out of range
32 | c 120 = CRITP did not converge
33 | c 121 = T > Tcrit
34 | c 122 = TPRHO-liquid did not converge in SATT
35 | c 123 = TPRHO-vapor did not converge in SATT
36 | c 124 = SATT pure fluid iteration did not converge
37 | c 128 = SATT mixture iteration did not converge
38 | c herr--error string if ierr<>0 (character*255)
39 | c
40 | c written by M. McLinden, NIST Thermophysics Division, Boulder, Colorado
41 | c 03-24-96 MM, original version
42 | c 03-27-96 MM, add error checks; move calculations to STN (in core_STN)
43 | c 04-05-96 MM, test for supercritical '.ge. tc' rather than '.gt. tc'
44 | c 05-31-96 MM, if error on call to SATT modify herr and return
45 | c 06-03-96 MM, check input temperature against limits
46 | c 06-07-96 MM, fix loss of LIMITX warnings on calls to SATT, STN
47 | c 04-21-97 MM, delete tcrit from call to STN (t > tcrit check moved to STN)
48 | c 10-01-97 MM, add compiler switch to allow access by DLL
49 | c 12-15-97 MM, pass any ierr,herr from STN as outputs
50 | c 06-02-99 MM, always call SATT (need rhov, xv for STH model)
51 | c [should now call SURTEN; this retained for compatibility]
52 | c
53 | implicit double precision (a-h,o-z)
54 | implicit integer (i-n)
55 | c
56 | cDEC$ ATTRIBUTES DLLEXPORT :: SURFT
57 | c dll_export SURFT
58 | c
59 | parameter (ncmax=20) !max number of components in mixture
60 | character*1 htab,hnull
61 | character*255 herr,herr2
62 | common /HCHAR/ htab,hnull
63 | dimension xl(ncmax),xliq(ncmax),xvap(ncmax)
64 | c
65 | ierr=0
66 | herr=' '
67 | c
68 | c check that input conditions (in this case t and x) are within limits
69 | c (check that t < tcrit done in STN)
70 | c
71 | Ddum=0.d0
72 | pdum=0.d0
73 | sigma=0.d0
74 | call LIMITX ('STN',t,Ddum,pdum,xl,tmin,tmax,Dmx,pmx,ierr,herr2)
75 | if (t.lt.tmin .and. ierr.le.0) then
76 | ierr=1
77 | herr='[SURFT error 1] t Tcrit
145 | c 122 = TPRHO-liquid did not converge in SATT
146 | c 123 = TPRHO-vapor did not converge in SATT
147 | c 124 = SATT pure fluid iteration did not converge
148 | c 128 = SATT mixture iteration did not converge
149 | c herr--error string if ierr<>0 (character*255)
150 | c
151 | c written by M. McLinden, NIST Phys & Chem Properties Div, Boulder, CO
152 | c 06-02-99 MM, original version; based on and replaces SURFT
153 | c
154 | implicit double precision (a-h,o-z)
155 | implicit integer (i-n)
156 | c
157 | cDEC$ ATTRIBUTES DLLEXPORT :: SURTEN
158 | c dll_export SURTEN
159 | c
160 | parameter (ncmax=20) !max number of components in mixture
161 | character*1 htab,hnull
162 | character*255 herr,herr1,herr2
163 | common /HCHAR/ htab,hnull
164 | c common block containing flags to GUI
165 | common /FLAGS/ xnota,x2ph,xsubc,xsuph,xsupc,xinf,x7,xnotd,xnotc
166 | dimension xl(ncmax),xv(ncmax),xliq(ncmax)
167 | c
168 | ierr=0
169 | herr=' '
170 | c
171 | c check that input conditions (in this case t and x) are within limits
172 | c (check that t < tcrit done in STN)
173 | c
174 | Ddum=0.0d0
175 | pdum=0.0d0
176 | call LIMITX ('STN',t,Ddum,pdum,xl,tmin,tmax,Dmx,pmx,ierr1,herr1)
177 | if (rhov.gt.0.0d0) then
178 | c check input vapor composition only if vapor density is specified
179 | c (otherwise, vapor comp is computed by a call to SATT, and input value
180 | c is irrelevant)
181 | call LIMITX ('STN',t,Ddum,pdum,xv,tmin,tmax,Dmx,pmx,ierr2,herr2)
182 | else
183 | ierr2=0
184 | herr2=hnull
185 | end if
186 | if (ierr1.gt.0 .or. ierr2.gt.0) then
187 | c temperature and/or x are outside limits, set error flag
188 | if (ierr1.gt.ierr2) then
189 | ierr=ierr1
190 | herr2=herr1
191 | else
192 | ierr=ierr2
193 | end if
194 | write (herr,1002) ierr,herr2(1:236),hnull
195 | 1002 format ('[SURTEN error',i3,'] ',a236,a1)
196 | call ERRMSG (ierr,herr)
197 | sigma=xnotc
198 | RETURN
199 | else if (ierr1.lt.0) then
200 | c temperature is outside limits, but in region where extrapolation is
201 | c usually reliable, set warning flag
202 | ierr=ierr1-20
203 | write (herr,1004) ierr,herr1(1:233),hnull
204 | 1004 format ('[SURTEN warning',i4,'] ',a233,a1)
205 | call ERRMSG (ierr,herr)
206 | end if
207 | c
208 | c calculate density of saturated liquid, if required
209 | if (rhol.le.0.0d0 .or. rhov.le.0.0d0) then
210 | kph=1
211 | call SATT (t,xl,kph,p,rhol,rhov,xliq,xv,ierr2,herr2)
212 | if (ierr2.ne.0) then
213 | write (herr,1005) ierr2,herr2(1:236),hnull
214 | 1005 format ('[SURTEN error',i3,'] ',a236,a1)
215 | call ERRMSG (ierr,herr)
216 | if (ierr2.gt.0) then
217 | sigma=0.0d0
218 | RETURN
219 | end if
220 | end if
221 | end if
222 | call STN (t,rhol,rhov,xl,xv,sigma,ierr,herr)
223 | c
224 | RETURN
225 | end !subroutine SURTEN
226 | c
227 | c ======================================================================
228 | c
229 | subroutine SETST1 (nread,icomp,hcasno,ierr,herr)
230 | c
231 | c set up working arrays for use with "ST1" surface tension model:
232 | c
233 | c sigma = sum[sigma_k*tau**sigexp_k]
234 | c tau = 1 - t/tcrit
235 | c
236 | c Note: The critical temperature used is that of the current
237 | c equation of state. This may differ slightly from that used
238 | c in the original correlation of surface tension; this change
239 | c is necessary to give proper behavior of surface tension near
240 | c the critical point and to avoid possible numerical crashes.
241 | c
242 | c inputs:
243 | c nread--file to read data from (file should have already been
244 | c opened and pointer set by subroutine SETUP)
245 | c icomp--component number in mixture (1..nc); 1 for pure fluid
246 | c hcasno--CAS number of component icomp (not required, it is here
247 | c to maintain parallel structure with SETBWR and SETFEQ)
248 | c
249 | c outputs:
250 | c ierr--error flag: 0 = successful
251 | c 1 = error (e.g. fluid not found)
252 | c herr--error string (character*255 variable if ierr<>0)
253 | c other quantities returned via arrays in commons
254 | c
255 | c written by M. McLinden, NIST Thermophysics Division, Boulder, Colorado
256 | c 03-24-96 MM, original version (skeleton only)
257 | c 08-16-96 MM, add actual ST1 model
258 | c 08-19-97 MM, get rid of herr=herr (avoid warning); flag nread<=0
259 | c 12-02-97 MM, skip over pressure and density limit and Tc on file read
260 | c
261 | implicit double precision (a-h,o-z)
262 | implicit integer (i-n)
263 | parameter (ncmax=20) !max number of components in mixture
264 | parameter (nrefmx=10) !max number of fluids for transport ECS
265 | parameter (n0=-ncmax-nrefmx,nx=ncmax)
266 | parameter (nsigk=3) !max number of terms in sigma summation
267 | character*1 htab,hnull
268 | character*3 hsten,hstenk
269 | character*12 hcasno
270 | character*255 herr
271 | common /HCHAR/ htab,hnull
272 | common /STNMOD/ hsten,hstenk(n0:nx)
273 | common /WLMSTN/ tmin(n0:nx),tmax(n0:nx)
274 | common /WNTST1/ nterm(n0:nx)
275 | common /WCFST1/ sigmak(n0:nx,nsigk),sigexp(n0:nx,nsigk)
276 | c
277 | if (nread.le.0) then
278 | ierr=101
279 | write (herr,1101) nread,hcasno,hnull
280 | call ERRMSG (ierr,herr)
281 | 1101 format ('[SETST1 error 101] illegal file specified; nread = ',
282 | & i4,'; CAS no. = ',a12,a1)
283 | RETURN
284 | else
285 | herr=' '
286 | ierr=0
287 | end if
288 | c
289 | c read data from file
290 | c write (*,*) ' SETSTN--read component',icomp,' from unit',nread
291 | read (nread,*) tmin(icomp) !lower temperature limit
292 | read (nread,*) tmax(icomp) !upper temperature limit
293 | c the pressure and density limit and the Tc are not presently used,
294 | c but are contained in the file for consistency and possible future use;
295 | c skip over them in reading the file
296 | read (nread,*) !pjunk !upper pressure limit (n/a)
297 | read (nread,*) !rhojnk !upper density limit (n/a)
298 | read (nread,*) nterm(icomp)
299 | read (nread,*) !Tcjunk !Tc in original fit (not used)
300 | do k=1,nterm(icomp)
301 | read (nread,*) sigmak(icomp,k),sigexp(icomp,k)
302 | enddo
303 | c
304 | RETURN
305 | end !subroutine SETST1
306 | c
307 | c ======================================================================
308 | c
309 | subroutine STN (t,rhol,rhov,xl,xv,sigma,ierr,herr)
310 | c
311 | c compute surface tension with appropriate core model
312 | c
313 | c inputs:
314 | c t--temperature [K]
315 | c rhol--molar density of liquid phase [mol/L]
316 | c rhov--molar density of vapor phase [mol/L]
317 | c xl--composition of liquid phase [array of mol frac]
318 | c xv--composition of vapor phase [array of mol frac]
319 | c output:
320 | c sigma--surface tension [N/m]
321 | c ierr--error flag: 0 = successful
322 | c 1 = error (e.g. fluid not found)
323 | c herr--error string (character*255 variable if ierr<>0)
324 | c
325 | c written by M. McLinden, NIST Thermophysics Division, Boulder, Colorado
326 | c 03-27-96 MM, original version (skeleton only)
327 | c 08-16-96 MM, add actual ST1 model
328 | c 04-17-97 MM, add pcrit to argument, break pures to separate STNK
329 | c add mixture model (Holcomb's mod of Moldover & Rainwater)
330 | c 04-21-97 MM, delete critical par from arguments, add call to CRITF
331 | c 12-15-97 MM, return if error from CRITF, set sigma = "not calculated"
332 | c 12-01-98 EWL, add Reos and triple point pressure and density to /CCON/
333 | c 06-02-99 MM, add vapor density and composition to argument list to
334 | c accommodate new mixture model of Holcomb & Higashi
335 | c
336 | implicit double precision (a-h,o-z)
337 | implicit integer (i-n)
338 | c
339 | parameter (ncmax=20) !max number of components in mixture
340 | parameter (nrefmx=10) !max number of fluids for transport ECS
341 | parameter (n0=-ncmax-nrefmx,nx=ncmax)
342 | parameter (nsigk=3) !max number of terms in sigma summation
343 | character*1 htab,hnull
344 | character*3 hsten,hstenk
345 | character*255 herr,herr2
346 | common /NCOMP/ nc,ic
347 | common /HCHAR/ htab,hnull
348 | common /STNMOD/ hsten,hstenk(n0:nx)
349 | common /WLMSTN/ tmin(n0:nx),tmax(n0:nx)
350 | common /WNTST1/ nterm(n0:nx)
351 | common /WCFST1/ sigmak(n0:nx,nsigk),sigexp(n0:nx,nsigk)
352 | common /Gcnst/ R,tz(n0:nx),rhoz(n0:nx)
353 | common /CCON/ tc(n0:nx),pc(n0:nx),rhoc(n0:nx),Zcrit(n0:nx),
354 | & ttp(n0:nx),ptp(n0:nx),dtp(n0:nx),dtpv(n0:nx),
355 | & tnbp(n0:nx),dnbpl(n0:nx),dnbpv(n0:nx),
356 | & wm(n0:nx),accen(n0:nx),dipole(n0:nx),Reos(n0:nx)
357 | c common block containing flags to GUI (initialized in BDSET in setup.f)
358 | common /FLAGS/ xnota,x2ph,xsubc,xsuph,xsupc,xinf,x7,xnotd,xnotc
359 | dimension xl(ncmax),zeta(ncmax),f(ncmax),cx(ncmax),xcritf(ncmax),
360 | & xv(ncmax),zmole(ncmax)
361 | c
362 | ierr=0
363 | herr=' '
364 | c
365 | call CRITP (xl,tcrit,pcrit,Dcrit,ierr,herr2)
366 | if (ierr.gt.0) then
367 | c error condition--set outputs, issue warning, and return
368 | ierr=160
369 | sigma=0.0d0
370 | write (herr,1016) herr2(1:236),hnull
371 | 1016 format ('[STN error 160] ',a236,a1)
372 | call ERRMSG (ierr,herr)
373 | RETURN
374 | end if
375 | if (t.gt.tcrit) then
376 | ierr=121
377 | write (herr,1121) t,tcrit,hnull
378 | call ERRMSG (ierr,herr)
379 | 1121 format ('[STN error 121] ',
380 | & 'temperature input to surface tension routine is ',
381 | & 'greater than critical temperature; T =',g11.5,
382 | & ' K, Tcrit =',g11.5,' K.',a1)
383 | sigma=0.0d0
384 | c write (*,*) ' STN--output sigma (ierr = 121): ',sigma
385 | RETURN
386 | end if
387 | call ISPURE (xl,icomp)
388 | if (icomp.ne.0) then
389 | c special case--pure component
390 | tau=1.0d0-t/tcrit
391 | call STNK (icomp,tau,sigma,ierr,herr)
392 | RETURN
393 | end if
394 | c base surface tensions on critical parameters at same composition,
395 | tau=1.0d0-t/tcrit
396 | tau126=tau**1.26d0
397 | alpha=0.10d0
398 | const=3.74d0**1.5d0*SQRT(R)*alpha*(1.0d0-alpha)*(2.0d0-alpha)
399 | do i=1,nc
400 | c define effective parameter in function sigma = sigma0*tau**1.26
401 | call STNK (i,tau,sigk,ierr,herr)
402 | if (sigk.lt.0) RETURN
403 | sig0=0.d0
404 | if (tau126.gt.0.d0) sig0=sigk/tau126
405 | c write (*,*) ' STN--icomp, effective sigma_0: ',icomp,sig0
406 | cx(i)=sig0**1.50d0/(const*SQRT(tc(i))*pc(i))
407 | enddo
408 | if (hsten.eq.'STX' .or. hsten.eq.'STM') then
409 | c mixture case--apply mixing rules to the cx(i)
410 | c compute fugacities and fugacity fraction
411 | call FGCTY2 (t,rhol,xl,f,ierr,herr)
412 | fsum=0.0d0
413 | do i=1,nc
414 | fsum=fsum+f(i)
415 | enddo
416 | do i=1,nc
417 | zeta(i)=f(i)/fsum
418 | xcritf(i)=xl(i) !initial guess for crit comp at same zeta
419 | enddo
420 | c write (*,1244) (zeta(i),i=1,nc)
421 | c1244 format (1x,' STN--zeta(i): ',5f14.7)
422 | c write (*,1245) (cx(i),i=1,nc)
423 | c1245 format (1x,' STN--cx(i): ',5e14.4)
424 | c find critical parameters at same fugacity fraction
425 | call CRITF (zeta,xcritf,tcritf,pcritf,Dcritf,ierr,herr)
426 | if (ierr.gt.0) then
427 | c error in CRITF--solution not possible
428 | sigma=xnotc
429 | RETURN
430 | end if
431 | else if (hsten.eq.'STH') then
432 | c mixture case--apply Holcomb & Higashi modification of Moldover & Rainwater
433 | c (i.e. apply mixing rules at overall mass composition corresponding to a
434 | c liquid volume fraction of 0.5)
435 | c (M.R. Moldover and J.C. Rainwater, J. Chem. Phys., 88:7772-7780, 1988.)
436 | do i=1,nc
437 | zmole(i)=(xl(i)*rhol+xv(i)*rhov)/(rhol+rhov)
438 | enddo
439 | call XMASS (zmole,zeta,xmw)
440 | call CRITP (zmole,tcritf,pcritf,Dcritf,ierr,herr)
441 | else
442 | ierr=99
443 | sigma=-9.999d6
444 | write (herr,1199) hsten,hnull
445 | 1199 format ('[STN error 99] ',
446 | & 'unknown surface tension model: (',a3,')',a1)
447 | c write (*,*) ' STN--output sigma (ierr = 99): ',sigma
448 | end if
449 | c
450 | cmix=0.0d0
451 | if (hsten.eq.'STM' .or. hsten.eq.'STH') then
452 | c use Moldover & Rainwater or Holcomb & Higashi mod of M & R method
453 | c difference is in the zeta defined above
454 | do i=1,nc
455 | cmix=cmix+zeta(i)*cx(i)
456 | enddo
457 | c write (*,*) ' STN--cmix by M-R: ',cmix
458 | else if (hsten.eq.'STX') then
459 | c use Holcomb's modification of Moldover & Rainwater method
460 | pcsum=0.0d0
461 | do i=1,nc
462 | pcsum=pcsum+zeta(i)**2*pc(i)
463 | enddo
464 | do i=1,nc
465 | c sum i = j terms
466 | cmix=cmix+zeta(i)**2*cx(i)
467 | if (i.lt.nc) then
468 | do j=i+1,nc
469 | c sum cross terms
470 | c cij=0.5d0*(pcritf-pcsum)*SQRT(cx(i)*cx(j)/(pc(i)*pc(j)))
471 | c & /(zeta(i)*zeta(j))
472 | c cmix=cmix+2.0d0*zeta(i)*zeta(j)*cij !factor 2 from ij = ji
473 | c above lines reduce to
474 | cmix=cmix+(pcritf-pcsum)*SQRT(cx(i)*cx(j)/(pc(i)*pc(j)))
475 | enddo
476 | end if
477 | enddo
478 | c write (*,*) ' STN--cmix by Holcomb''s mod to M-R: ',cmix
479 | end if
480 | c
481 | c recover mixture sigma_0 parameter from cmix
482 | c this expression is based on critical parameters at same zeta
483 | sig0=(const*SQRT(tcritf)*pcritf*cmix)**(2.0d0/3.0d0)
484 | sigma=sig0*tau**1.26d0
485 | c write (*,*) ' STN--hsten,sigma: ',hsten,' ',sigma
486 | c
487 | RETURN
488 | end !subroutine STN
489 | c
490 | c ======================================================================
491 | c
492 | subroutine STNK (icomp,tau,sigma,ierr,herr)
493 | c
494 | c compute surface tension with appropriate core model
495 | c
496 | c inputs:
497 | c icomp--component i
498 | c tau--dimensionless temperature (1 - T/Tc)
499 | c output:
500 | c sigma--surface tension [N/m]
501 | c ierr--error flag: 0 = successful
502 | c 1 = error (e.g. fluid not found)
503 | c herr--error string (character*255 variable if ierr<>0)
504 | c
505 | c written by M. McLinden, NIST Physical & Chemical Properties Division, Boulder, Colorado
506 | c 04-17-97 MM, original version (based on STN)
507 | c
508 | implicit double precision (a-h,o-z)
509 | implicit integer (i-n)
510 | c
511 | parameter (ncmax=20) !max number of components in mixture
512 | parameter (nrefmx=10) !max number of fluids for transport ECS
513 | parameter (n0=-ncmax-nrefmx,nx=ncmax)
514 | parameter (nsigk=3) !max number of terms in sigma summation
515 | character*1 htab,hnull
516 | character*3 hsten,hstenk
517 | character*255 herr
518 | common /NCOMP/ nc,ic
519 | common /HCHAR/ htab,hnull
520 | common /STNMOD/ hsten,hstenk(n0:nx)
521 | common /WNTST1/ nterm(n0:nx)
522 | common /WCFST1/ sigmak(n0:nx,nsigk),sigexp(n0:nx,nsigk)
523 | c
524 | ierr=0
525 | herr=' '
526 | c
527 | if (hstenk(icomp).eq.'ST1') then
528 | sigma=0.0d0
529 | do k=1,nterm(icomp)
530 | sigma=sigma+sigmak(icomp,k)*tau**sigexp(icomp,k)
531 | enddo
532 | else
533 | sigma=-999.0d0
534 | write (herr,1099) hstenk(icomp),hnull
535 | call ERRMSG (ierr,herr)
536 | 1099 format ('[STN error 99] ',
537 | & 'unknown surface tension model: (',a3,')',a1)
538 | end if
539 | c write (*,1200) icomp,tau,sigma
540 | c1200 format (' STNK--icomp,tau,sigma: ',i4,2f11.6)
541 | c
542 | RETURN
543 | end !subroutine STNK
544 | c
545 | c ======================================================================
546 | c
547 | subroutine CRITF (zeta,x,tcrit,pcrit,Dcrit,ierr,herr)
548 | c
549 | c critical parameters as a function of fugacity fraction
550 | c
551 | c inputs:
552 | c zeta--fugacity fraction [array of f/f]
553 | c x--initial guess for composition [array of mol frac]
554 | c outputs:
555 | c x--composition [array of mol frac]
556 | c tcrit--critical temperature [K]
557 | c pcrit--critical pressure [kPa]
558 | c Dcrit--critical density [mol/L]
559 | c ierr--error flag: 0 = successful
560 | c 160 = did not converge
561 | c herr--error string (character*255 variable if ierr<>0)
562 | c
563 | c written by M. McLinden, NIST Physical and Chemical Properties Division, Boulder, Colorado
564 | c 04-21-97 MM, original version
565 | c 12-15-97 MM, change value of ierr for non-convergence
566 | c
567 | implicit double precision (a-h,o-z)
568 | implicit integer (i-n)
569 | parameter (ncmax=20) !max number of components in mixture
570 | character*1 htab,hnull
571 | character*255 herr,herr1
572 | common /NCOMP/ nc,ic
573 | common /HCHAR/ htab,hnull
574 | dimension zeta(ncmax),zetaj(ncmax),x(ncmax),f(ncmax),xnew(ncmax)
575 | c
576 | data itmax/20/
577 | tolx=1.0d-5
578 | ierr=0
579 | herr=' '
580 | c
581 | c do i=1,nc
582 | c x(i)=zeta(i) !initial guess for composition
583 | c enddo
584 | do it=1,itmax
585 | call CRITP (x,tcrit,pcrit,Dcrit,ierr1,herr1)
586 | call FGCTY2 (tcrit,Dcrit,x,f,ierr,herr)
587 | fsum=0.0d0
588 | do i=1,nc
589 | fsum=fsum+f(i)
590 | enddo
591 | do i=1,nc
592 | zetaj(i)=f(i)/fsum
593 | enddo
594 | delx=0.0d0
595 | xsum=0.0d0
596 | do i=1,nc
597 | c simple successive substitution
598 | xnew(i)=x(i)-(zetaj(i)-zeta(i))
599 | if (xnew(i).lt.0.0d0) xnew(i)=0.0d0
600 | xsum=xsum+xnew(i)
601 | delx=delx+abs(xnew(i)-x(i))
602 | enddo
603 | c write (*,1160) it,tcrit,pcrit,delx,x(1),zetaj(1),zeta(1)
604 | c1160 format (1x,' CRITF--it,tc,pc,delx,x,zetaj,zeta: ',i4,6f14.6)
605 | if (delx.lt.tolx) then
606 | RETURN !iteration converged
607 | end if
608 | do i=1,nc
609 | xnew(i)=xnew(i)/xsum
610 | x(i)=xnew(i)
611 | enddo
612 | enddo
613 | ierr=160
614 | herr='[SURFT error 160] CRITF (find critical parameters at '//
615 | & 'a specified fugacity fraction) did not converge in the '//
616 | & 'surface tension calculation'//hnull
617 | call ERRMSG (ierr,herr)
618 | c
619 | RETURN
620 | end !subroutine CRITF
621 | c
622 | c
623 | c 1 2 3 4 5 6 7
624 | c23456789012345678901234567890123456789012345678901234567890123456789012
625 | c
626 | c ======================================================================
627 | c end file core_STN.f
628 | c ======================================================================
629 |
--------------------------------------------------------------------------------
/Source_Code/fortran/CORE_ECS.FOR:
--------------------------------------------------------------------------------
1 | c begin file core_ECS.f
2 | c
3 | c This file contains routines implementing an extended corresponding
4 | c states model with temperature- and density-dependent shape factors.
5 | c
6 | c contained here are:
7 | c function PHIECS (icomp,itau,idel,tau,del)
8 | c subroutine CRTECS (icomp,tc,pc,rhoc)
9 | c subroutine SETECS (nread,icomp,hcasno,href,heqn,ierr,herr)
10 | c subroutine FJ (icomp,t,d,f,dfdt,d2fdt2,dfdd,d2fdd2,d2fdtd)
11 | c subroutine HJ (icomp,t,d,h,dhdt,d2hdt2,dhdd,d2hdd2,d2hdtd)
12 | c
13 | c ======================================================================
14 | c ======================================================================
15 | c
16 | function PHIECS (icomp,itau,idel,tau,del)
17 | c
18 | c compute reduced Helmholtz energy or a derivative as functions
19 | c of dimensionless temperature and density for the ECS model
20 | c
21 | c inputs:
22 | c icomp--pointer specifying component (1..nc)
23 | c itau--flag specifying order of temperature derivative to calc
24 | c idel--flag specifying order of density derivative to calculate
25 | c when itau = 0 and idel = 0, compute A/RT
26 | c when itau = 0 and idel = 1, compute 1st density derivative
27 | c when itau = 1 and idel = 1, compute cross derivative
28 | c etc.
29 | c tau--dimensionless temperature (To/T)
30 | c del--dimensionless density (D/Do)
31 | c output (as function value):
32 | c phi--residual (real-gas) part of the Helmholtz energy, or one
33 | c of its derivatives (as specified by itau and idel),
34 | c in reduced form (A/RT)
35 | c itau idel output (dimensionless for all cases)
36 | c 0 0 A/RT
37 | c 1 0 tau*[d(A/RT)/d(tau)]
38 | c 2 0 tau**2*[d**2(A/RT)/d(tau)**2]
39 | c 0 1 del*[d(A/RT)/d(del)]
40 | c 0 2 del**2*[d**2(A/RT)/d(del)**2]
41 | c 1 1 tau*del*[d**2(A/RT)/d(tau)d(del)]
42 | c etc.
43 | c
44 | c The Helmholtz energy consists of ideal and residual (real-gas)
45 | c terms; this routine calculates only the residual part.
46 | c
47 | c This function computes pure component properties only.
48 | c
49 | c written by M. McLinden, NIST Thermophysics Division, Boulder, Colorado
50 | c 02-02-96 MM, original version
51 | c 03-19-96 MM, add dipole moment to /CCON/
52 | c 03-22-96 MM, replace /MODEL/ with /EOSMOD/
53 | c 09-23-96 EWL, change calls to FJ, HJ to include density dependence
54 | c 11-13-97 EWL, check for itau.ge.1 before idel.ge.1
55 | c 12-01-98 EWL, add Reos and triple point pressure and density to /CCON/
56 | c 01-26-00 EWL, add check for del>=0 and tau>=0
57 | c 09-05-00 EWL, return 0 for invalid idel or itau
58 | c 01-17-01 EWL, change tau0.ge.0 to tau0.gt.0 and avoid 0**0
59 | c
60 | implicit double precision (a-h,o-z)
61 | implicit integer (i-n)
62 | character*3 hpheq,heos,hmxeos,hmodcp
63 | c
64 | parameter (ncmax=20) !max number of components in mixture
65 | parameter (nrefmx=10) !max number of fluids for transport ECS
66 | parameter (n0=-ncmax-nrefmx,nx=ncmax)
67 | common /EOSMOD/ hpheq,heos,hmxeos(n0:nx),hmodcp(n0:nx)
68 | common /CCON/ tcrit(n0:nx),pcrit(n0:nx),Dcrit(n0:nx),Zcrit(n0:nx),
69 | & ttp(n0:nx),ptp(n0:nx),dtp(n0:nx),dtpv(n0:nx),
70 | & tnbp(n0:nx),dnbpl(n0:nx),dnbpv(n0:nx),
71 | & wm(n0:nx),accen(n0:nx),dipole(n0:nx),Reos(n0:nx)
72 | common /Gcnst/ Rrr,tz(n0:nx),rhoz(n0:nx)
73 | c
74 | phiecs=0.0d0 !initialize outputs and intermediate results
75 | phi01=0.0d0
76 | phi02=0.0d0
77 | phi10=0.0d0
78 | phi20=0.0d0
79 | phi11=0.0d0
80 | c
81 | if (del.le.1.0d-10) then !trivial solution at zero density
82 | RETURN !for any and all derivatives
83 | end if
84 | c
85 | c recover the temperature and density from tau and del (need to compute
86 | c shape factors at actual temperature rather than reduced temperature)
87 | c
88 | i=icomp
89 | t=tcrit(i)/tau
90 | rho=del*Dcrit(i)
91 | call FJ (icomp,t,rho,f,dfdt,d2fdt2,dfdd,d2fdd2,d2fdtd)
92 | call HJ (icomp,t,rho,h,dhdt,d2hdt2,dhdd,d2hdd2,d2hdtd)
93 | c
94 | c find the reducing temperature to compute tau for the reference fluid
95 | c and then calculate reduced Helmholtz for the reference fluid at the
96 | c conformal temperature and density
97 | c
98 | c note: cannot use the PHIK function here because it calls this one,
99 | c and recursive calls are not generally allowed in fortran
100 | c
101 | iref=-icomp
102 | tred0=tz(iref)
103 | Dred0=rhoz(iref)
104 | if (hmxeos(iref).eq.'BWR') then
105 | call CRTBWR (iref,tc0,pc0,Dc0)
106 | tred0=tc0
107 | Dred0=Dc0
108 | tau0=tred0/t*f
109 | del0=rho*h/Dred0
110 | c compute PHI with same order as input arguments
111 | phixx=PHIBWR (iref,itau,idel,tau0,del0)
112 | phixx=phixx/del0**idel/tau0**itau
113 | c calculate additional PHIs as required
114 | if (itau.ge.1) then
115 | phi01=PHIBWR (iref,0,1,tau0,del0) /del0
116 | if (idel.eq.1) then
117 | phi02=PHIBWR (iref,0,2,tau0,del0) /del0**2
118 | phi10=PHIBWR (iref,1,0,tau0,del0) /tau0
119 | phi20=PHIBWR (iref,2,0,tau0,del0) /tau0**2
120 | else if (itau.eq.2) then
121 | phi10=PHIBWR (iref,1,0,tau0,del0) /tau0
122 | phi11=PHIBWR (iref,1,1,tau0,del0) /del0/tau0
123 | phi02=PHIBWR (iref,0,2,tau0,del0) /del0**2
124 | end if
125 | end if
126 | if (idel.ge.1) then
127 | phi10=PHIBWR (iref,1,0,tau0,del0) /tau0
128 | if (idel.eq.2) then
129 | phi01=PHIBWR (iref,0,1,tau0,del0) /del0
130 | phi11=PHIBWR (iref,1,1,tau0,del0) /del0/tau0
131 | phi20=PHIBWR (iref,2,0,tau0,del0) /tau0**2
132 | end if
133 | end if
134 | else if (hmxeos(iref)(1:2).eq.'FE') then
135 | tau0=tred0/t*f
136 | del0=rho*h/Dred0
137 | c compute PHI with same order as input arguments
138 | phixx=0
139 | if (del0.ge.0 .and. tau0.gt.0) then
140 | phixx=PHIFEQ (iref,itau,idel,tau0,del0)
141 | phixx=phixx/del0**idel/tau0**itau
142 | c calculate additional PHIs as required
143 | if (itau.ge.1) then
144 | phi01=PHIFEQ (iref,0,1,tau0,del0) /del0
145 | if (idel.eq.1) then
146 | phi02=PHIFEQ (iref,0,2,tau0,del0) /del0**2
147 | phi10=PHIFEQ (iref,1,0,tau0,del0) /tau0
148 | phi20=PHIFEQ (iref,2,0,tau0,del0) /tau0**2
149 | else if (itau.eq.2) then
150 | phi10=PHIFEQ (iref,1,0,tau0,del0) /tau0
151 | phi11=PHIFEQ (iref,1,1,tau0,del0) /del0/tau0
152 | phi02=PHIFEQ (iref,0,2,tau0,del0) /del0**2
153 | end if
154 | end if
155 | if (idel.ge.1) then
156 | phi10=PHIFEQ (iref,1,0,tau0,del0) /tau0
157 | if (idel.eq.2) then
158 | phi01=PHIFEQ (iref,0,1,tau0,del0) /del0
159 | phi11=PHIFEQ (iref,1,1,tau0,del0) /del0/tau0
160 | phi20=PHIFEQ (iref,2,0,tau0,del0) /tau0**2
161 | end if
162 | end if
163 | end if
164 | else
165 | c reference fluid not found, but no way to return an error from here
166 | phixx=-9.99d99
167 | end if
168 | c
169 | c check if derivatives are requested
170 | c
171 | if (itau.eq.0) then
172 | if (idel.eq.0) then
173 | c compute dimensionless residual Helmholtz of reference fluid
174 | phiecs=phixx
175 | else if (idel.eq.1 .and. ABS(f).gt.1.d-20) then
176 | c compute 1st derivative w.r.t. del (dimensionless density)
177 | phiecs=Dcrit(i)/Dred0*phixx*(h + rho*dhdd)
178 | & +Dcrit(i)*tau0/f*phi10*dfdd
179 | else if (idel.eq.2) then
180 | c compute 2nd derivative w.r.t. del
181 | phiecs=Dcrit(i)**2*(((phixx*(h+rho*dhdd)/dred0
182 | & +tred0/t*phi11*dfdd)*(h+rho*dhdd)
183 | & +phi01*(2.d0*dhdd+rho*d2hdd2))/dred0
184 | & +tred0/t*((phi11/dred0*(h+rho*dhdd)+tred0/t*phi20*dfdd)*dfdd
185 | & +d2fdd2*phi10))
186 | end if
187 | c
188 | else if (itau.eq.1) then
189 | dtlogh=dhdt/h !equal to temperature derivative of log(h)
190 | if (idel.eq.0) then
191 | c compute 1st derivative w.r.t. tau (dimensionless temperature)
192 | phiecs=tred0/tcrit(i)*(f-t*dfdt)*phixx
193 | & -t*t*del0/tcrit(i)*dtlogh*phi01
194 | else if (idel.eq.1) then
195 | c compute cross derivative
196 | phiecs=Dcrit(i)/Dred0/tcrit(i)*
197 | & (tred0*(f-t*dfdt)*(phixx*(h + rho*dhdd)
198 | & +tred0/t*dred0*phi20*dfdd)
199 | & +tred0*phi10*Dred0*(dfdd - t*d2fdtd)
200 | & -t*t*(phi01*dhdt+rho*dhdt*(phi02/dred0*(h + rho*dhdd)
201 | & +tred0/t*phixx*dfdd)
202 | & +rho*phi01*d2hdtd))
203 | end if
204 | c
205 | else if (itau.eq.2) then
206 | c compute 2nd derivative w.r.t. tau
207 | dtlogh=dhdt/h !equal to temperature derivative of log(h)
208 | phiecs=(1.0d0/tcrit(i)**2)*
209 | & (tred0**2*(f-t*dfdt)**2*phixx
210 | & -2.0d0*t*t*tred0*del0*(f-t*dfdt)*dtlogh*phi11
211 | & +t**4*del0**2*dtlogh**2*phi02
212 | & +tred0*t**3*d2fdt2*phi10
213 | & +t**3*del0/h*(t*d2hdt2+2.0d0*dhdt)*phi01)
214 | else
215 | c invalid itau and/or idel, but no way to return an error from here
216 | c phiecs=-9.99d99
217 | end if
218 | phiecs=phiecs*del**idel*tau**itau
219 | c
220 | RETURN
221 | end !function PHIECS
222 | c
223 | c ======================================================================
224 | c
225 | subroutine CRTECS (icomp,tc,pc,rhoc)
226 | c
227 | c returns critical parameters associated with ECS model
228 | c
229 | c N.B. these critical parameters may not necessarily be most
230 | c accurate values, but they are consistent with the ECS fit
231 | c
232 | c input:
233 | c icomp--pointer specifying component (1..nc)
234 | c outputs:
235 | c tc--critical temperature [K]
236 | c pc--critical pressure [kPa]
237 | c rhoc--molar density [mol/L] at critical point
238 | c
239 | c written by M. McLinden, NIST Thermophysics Division, Boulder, Colorado
240 | c 02-06-96 MM, original version
241 | c 03-19-96 MM, add dipole moment to /CCON/
242 | c 12-01-98 EWL, add Reos and triple point pressure and density to /CCON/
243 | c
244 | implicit double precision (a-h,o-z)
245 | implicit integer (i-n)
246 | c
247 | parameter (ncmax=20) !max number of components in mixture
248 | parameter (nrefmx=10) !max number of fluids for transport ECS
249 | parameter (n0=-ncmax-nrefmx,nx=ncmax)
250 | common /CCON/ tcrit(n0:nx),pcrit(n0:nx),Dcrit(n0:nx),Zcrit(n0:nx),
251 | & ttp(n0:nx),ptp(n0:nx),dtp(n0:nx),dtpv(n0:nx),
252 | & tnbp(n0:nx),dnbpl(n0:nx),dnbpv(n0:nx),
253 | & wm(n0:nx),accen(n0:nx),dipole(n0:nx),Reos(n0:nx)
254 | c
255 | tc=tcrit(icomp)
256 | pc=pcrit(icomp)
257 | rhoc=Dcrit(icomp)
258 | c
259 | RETURN
260 | end !subroutine CRTECS
261 | c
262 | c ======================================================================
263 | c
264 | subroutine SETECS (nread,icomp,hcasno,href,heqn,ierr,herr)
265 | c
266 | c set up working arrays for use with ECS model
267 | c
268 | c inputs:
269 | c nread--file to read data from (file should have already been
270 | c opened and pointer set by subroutine SETUP)
271 | c icomp--component number in mixture (1..nc); 1 for pure fluid
272 | c hcasno--CAS number of component icomp (not required, it is here
273 | c to maintain parallel structure with SETBWR and SETFEQ)
274 | c
275 | c outputs:
276 | c href--file containing reference fluid EOS (character*255)
277 | c heqn--model ('BWR', etc) for reference fluid EOS (character*3)
278 | c ierr--error flag: 0 = successful
279 | c 1 = error (e.g. fluid not found)
280 | c herr--error string (character*255 variable if ierr<>0)
281 | c other quantities returned via arrays in commons
282 | c
283 | c written by M. McLinden, NIST Thermophysics Division, Boulder, Colorado
284 | c 02-06-95 MM, original version
285 | c 03-19-96 MM, add dipole moment to /CCON/
286 | c 03-21-96 MM, delete reference to /MODEL/, not needed
287 | c 03-22-96 MM, replace /CPMOD/ with /EOSMOD/
288 | c 06-03-96 MM, add limits to /EOSLIM/
289 | c 09-23-96 EWL, add density dependent shape factors
290 | c 09-30-96 MM, change order of density factors in .fld files
291 | c 08-19-97 MM, get rid of herr=herr, etc (avoid warning); flag nread<=0
292 | c 07-08-98 EWL, change character strings from *80 to *255
293 | c 12-01-98 EWL, add Reos and triple point pressure and density to /CCON/
294 | c 12-22-98 EWL, set Reos to 8.31451
295 | c 06-22-99 EWL, reset ptp and dtp to zero
296 | c 06-22-99 EWL, change Reos to 8.314472, set R to Reos
297 | c 05-03-04 EWL, change dtp to rhomax
298 | c
299 | implicit double precision (a-h,o-z)
300 | implicit integer (i-n)
301 | parameter (ncmax=20) !max number of components in mixture
302 | parameter (nrefmx=10) !max number of fluids for transport ECS
303 | parameter (n0=-ncmax-nrefmx,nx=ncmax)
304 | parameter (nfh=4)
305 | character*1 htab,hnull
306 | character*3 heqn
307 | character*3 hpheq,heos,hmxeos,hmodcp
308 | character*12 hcas,hcasno
309 | character*255 href
310 | character*255 herr
311 | common /NCOMP/ nc,ic
312 | common /HCHAR/ htab,hnull
313 | c commons associated with the nc components of current interest
314 | c ("working" commons and arrays)
315 | common /CCAS/ hcas(n0:nx)
316 | common /CCON/ tcrit(n0:nx),pcrit(n0:nx),Dcrit(n0:nx),Zcrit(n0:nx),
317 | & ttp(n0:nx),ptp(n0:nx),dtp(n0:nx),dtpv(n0:nx),
318 | & tnbp(n0:nx),dnbpl(n0:nx),dnbpv(n0:nx),
319 | & wm(n0:nx),accen(n0:nx),dipole(n0:nx),Reos(n0:nx)
320 | common /Gcnst/ R,tz(n0:nx),rhoz(n0:nx)
321 | common /EOSMOD/ hpheq,heos,hmxeos(n0:nx),hmodcp(n0:nx)
322 | common /CFECS/ fecs(ncmax,nfh,2),hecs(ncmax,nfh,2),
323 | & fdecs(ncmax,nfh,2),hdecs(ncmax,nfh,2),
324 | & acfecs(ncmax),acfref(ncmax),Zcref(ncmax),
325 | & tmin(ncmax),tmax(ncmax),pmax(ncmax),rhomax(ncmax)
326 | common /ICFECS/ nfecs(ncmax),nhecs(ncmax),
327 | & nfdecs(ncmax),nhdecs(ncmax)
328 | c limits associated with the equation of state
329 | common /EOSLIM/ tmn(n0:nx),tmx(n0:nx),pmx(n0:nx),rhomx(n0:nx)
330 | c
331 | if (nread.le.0) then
332 | ierr=101
333 | write (herr,1101) nread,hcasno,hnull
334 | call ERRMSG (ierr,herr)
335 | 1101 format ('[SETECS error 101] illegal file specified; nread = ',
336 | & i4,'; CAS no. = ',a12,a1)
337 | RETURN
338 | else
339 | herr=' '
340 | ierr=0
341 | end if
342 | c
343 | c read data from file
344 | c write (*,*) ' SETECS--read component',icomp,' from unit',nread
345 | c iref=-icomp
346 | Reos(icomp)=8.314472d0
347 | if (nc.eq.1 .and. icomp.eq.1) R=Reos(icomp)
348 | ptp(icomp)=0.0d0
349 | dtpv(icomp)=0.0d0
350 | dnbpl(icomp)=0.0d0
351 | dnbpv(icomp)=0.0d0
352 | read (nread,*) tmin(icomp) !lower temperature limit
353 | read (nread,*) tmax(icomp) !upper temperature limit
354 | read (nread,*) pmax(icomp) !upper pressure limit
355 | read (nread,*) rhomax(icomp) !upper density limit
356 | read (nread,2003) hmodcp(icomp) !pointer to Cp0 model
357 | read (nread,2080) href !reference fluid .fld file
358 | read (nread,2003) heqn !ref fluid equation of state
359 | read (nread,*) acfref(icomp) !acc fac for reference fluid
360 | read (nread,*) Zcref(icomp) !Zc for reference fluid
361 | read (nread,*) acfecs(icomp) !acentric factor
362 | read (nread,*) tcrit(icomp) !critical temperature [K]
363 | read (nread,*) pcrit(icomp) !critical pressure [kPa]
364 | read (nread,*) Dcrit(icomp) !critical density [mol/L]
365 | tz(icomp)=tcrit(icomp)
366 | rhoz(icomp)=Dcrit(icomp)
367 | c write (*,1020) tcrit(icomp),pcrit(icomp),Dcrit(icomp)
368 | c1020 format (1x,' SETECS--critical T, p, rho: ',f8.3,f8.2,f8.5)
369 | Zcrit(icomp)=pcrit(icomp)/(Reos(icomp)*tcrit(icomp)*Dcrit(icomp))
370 | c copy ECS parameters to general fluid constants common block
371 | c accen(icomp)=acfecs(icomp)
372 | read (nread,*) nfecs(icomp) !no. temperature terms for 'f' ESRR
373 | do j=1,nfecs(icomp)
374 | read (nread,*) fecs(icomp,j,1),fecs(icomp,j,2)
375 | enddo
376 | read (nread,*) nfdecs(icomp) !no. density terms for 'f' ESRR
377 | if (nfdecs(icomp).ge.1) then
378 | do j=1,nfdecs(icomp)
379 | read (nread,*) fdecs(icomp,j,1),fdecs(icomp,j,2)
380 | enddo
381 | end if
382 | read (nread,*) nhecs(icomp) !no. temperature terms for 'h' ESRR
383 | do j=1,nhecs(icomp)
384 | read (nread,*) hecs(icomp,j,1),hecs(icomp,j,2)
385 | enddo
386 | read (nread,*) nhdecs(icomp) !no. density terms for 'h' ESRR
387 | if (nhdecs(icomp).ge.1) then
388 | do j=1,nhdecs(icomp)
389 | read (nread,*) hdecs(icomp,j,1),hdecs(icomp,j,2)
390 | enddo
391 | end if
392 | c
393 | c copy limits into /EOSLIM/ arrays
394 | tmn(icomp)=tmin(icomp)
395 | tmx(icomp)=tmax(icomp)
396 | pmx(icomp)=pmax(icomp)
397 | rhomx(icomp)=rhomax(icomp)
398 | dtp(icomp)=rhomax(icomp)
399 | c
400 | RETURN
401 | 2003 format (a3)
402 | 2080 format (a255)
403 | end !subroutine SETECS
404 | c
405 | c ======================================================================
406 | c
407 | subroutine FJ (icomp,t,d,f,dfdt,d2fdt2,dfdd,d2fdd2,d2fdtd)
408 | c
409 | c compute the equivalent substance reducing ratio (for temperature)
410 | c and its temperature derivative for use in the ECS model
411 | c
412 | c This routine implements the function of Huber & Ely, Int. J. Refrig.
413 | c 17:18-31 (1994) modified by additional general terms in (T/Tc) and by
414 | c density-dependent terms. The beta1, beta2 of Huber & Ely are
415 | c hecs(i,1,1) and hecs(i,2,1) here.
416 | c
417 | c inputs:
418 | c icomp--pointer specifying component (1..nc)
419 | c t--temperature [K]
420 | c d--density [mol/L]
421 | c outputs:
422 | c f--equivalent substance reducing ratio (for temperature)
423 | c this is equal to (Tc,icomp/Tc,ref)*theta(T)
424 | c where theta is the energy (or temperature) shape factor
425 | c dfdt--temperature derivative of f
426 | c d2fdt2--second temperature derivative of f
427 | c dfdd--density derivative of f
428 | c d2fdd2--second density derivative of f
429 | c d2fdtd--temperature-density cross derivative of f
430 | c
431 | c written by M. McLinden, NIST Thermophysics Division, Boulder, Colorado
432 | c 02-06-96 MM, original version
433 | c 03-19-96 MM, add dipole moment to /CCON/
434 | c 09-23-96 EWL, add density dependent shape factors
435 | c 12-01-98 EWL, add Reos and triple point pressure and density to /CCON/
436 | c 01-17-01 EWL, initialize values and return if t<=0
437 | c 11-15-07 MLH, remove dead code
438 | c
439 | implicit double precision (a-h,o-z)
440 | implicit integer (i-n)
441 | c
442 | parameter (ncmax=20) !max number of components in mixture
443 | parameter (nrefmx=10) !max number of fluids for transport ECS
444 | parameter (n0=-ncmax-nrefmx,nx=ncmax)
445 | parameter (nfh=4)
446 | common /CCON/ tcrit(n0:nx),pcrit(n0:nx),Dcrit(n0:nx),Zcrit(n0:nx),
447 | & ttp(n0:nx),ptp(n0:nx),dtp(n0:nx),dtpv(n0:nx),
448 | & tnbp(n0:nx),dnbpl(n0:nx),dnbpv(n0:nx),
449 | & wm(n0:nx),accen(n0:nx),dipole(n0:nx),Reos(n0:nx)
450 | common /CFECS/ fecs(ncmax,nfh,2),hecs(ncmax,nfh,2),
451 | & fdecs(ncmax,nfh,2),hdecs(ncmax,nfh,2),
452 | & acfecs(ncmax),acfref(ncmax),Zcref(ncmax),
453 | & tmin(ncmax),tmax(ncmax),pmax(ncmax),rhomax(ncmax)
454 | common /ICFECS/ nfecs(ncmax),nhecs(ncmax),
455 | & nfdecs(ncmax),nhdecs(ncmax)
456 | c
457 | f=0.d0
458 | dfdt=0.d0
459 | d2fdt2=0.d0
460 | dfdd=0.d0
461 | d2fdd2=0.d0
462 | d2fdtd=0.d0
463 | if (t.le.0.d0) RETURN
464 | i=icomp
465 | iref=-icomp
466 | Tr=t/tcrit(i)
467 | Dr=d/Dcrit(i)
468 | domega=acfecs(i)-acfref(i)
469 | c theta is the density shape factor
470 | theta=1.0d0+domega*(fecs(i,1,1)+fecs(i,2,1)*log(Tr))
471 | c first and second (reduced) temperature derivatives of theta
472 | d1th=domega*fecs(i,2,1)/Tr !first Tr derivative of theta
473 | d2th=-domega*fecs(i,2,1)/(Tr*Tr) !second Tr derivative of theta
474 | c sum terms beyond those in Huber & Ely function
475 | if (nfecs(i).ge.3) then
476 | do j=3,nfecs(i)
477 | theta=theta+fecs(i,j,1)*Tr**fecs(i,j,2)
478 | d1th=d1th+fecs(i,j,1)*fecs(i,j,2)*Tr**(fecs(i,j,2)-1.0d0)
479 | d2th=d2th+fecs(i,j,1)*fecs(i,j,2)*(fecs(i,j,2)-1.0d0)
480 | & *Tr**(fecs(i,j,2)-2.0d0)
481 | enddo
482 | end if
483 | d1thd=0.d0
484 | d2thd=0.d0
485 | if (nfdecs(i).gt.0) then
486 | do j=1,nfdecs(i)
487 | theta=theta+fdecs(i,j,1)*Dr**fdecs(i,j,2)
488 | d1thd=d1thd+fdecs(i,j,1)*fdecs(i,j,2)*Dr**(fdecs(i,j,2)-1.d0)
489 | d2thd=d2thd+fdecs(i,j,1)*fdecs(i,j,2)*(fdecs(i,j,2)-1.d0)
490 | & *Dr**(fdecs(i,j,2)-2.d0)
491 | enddo
492 | end if
493 | c
494 | c convert theta and its derivatives to 'f' and its derivatives
495 | Tcrat=tcrit(icomp)/tcrit(iref)
496 | f=Tcrat*theta
497 | dfdt=d1th/tcrit(iref)
498 | d2fdt2=d2th/(tcrit(icomp)*tcrit(iref))
499 | dfdd=d1thd*Tcrat/Dcrit(icomp)
500 | d2fdd2=d2thd*Tcrat/Dcrit(icomp)**2
501 | !d2fdtd=d1thdt*Tcrat/Dcrit(icomp)/tcrit(icomp)
502 | d2fdtd=0.0d0 !approximation. if needed, calculation of d1thdt is required.
503 | c
504 | RETURN
505 | end !subroutine FJ
506 | c
507 | c ======================================================================
508 | c
509 | subroutine HJ (icomp,t,d,h,dhdt,d2hdt2,dhdd,d2hdd2,d2hdtd)
510 | c
511 | c compute the equivalent substance reducing ratio (for density)
512 | c and its temperature derivative for use in the ECS model
513 | c
514 | c This routine implements the function of Huber & Ely, Int. J. Refrig.
515 | c 17:18-31 (1994) modified by additional general terms in (T/Tc) and by
516 | c density-dependent terms. The beta1, beta2 of Huber & Ely are
517 | c hecs(i,1,1) and hecs(i,2,1) here.
518 | c
519 | c inputs:
520 | c icomp--pointer specifying component (1..nc)
521 | c t--temperature [K]
522 | c d--density [mol/L]
523 | c outputs:
524 | c h--equivalent substance reducing ratio (for density)
525 | c this is equal to (rhoc,ref/rhoc,icomp)*phi(T)
526 | c where phi is the volume (or density) shape factor
527 | c dhdt--temperature derivative of h
528 | c d2hdt2--second temperature derivative of h
529 | c dhdd--density derivative of h
530 | c d2hdd2--second density derivative of h
531 | c d2hdtd--temperature-density cross derivative of h
532 | c
533 | c written by M. McLinden, NIST Thermophysics Division, Boulder, Colorado
534 | c 02-06-96 MM, original version
535 | c 03-19-96 MM, add dipole moment to /CCON/
536 | c 09-23-96 EWL, add density dependent shape factors
537 | c 12-01-98 EWL, add Reos and triple point pressure and density to /CCON/
538 | c 01-17-01 EWL, initialize values and return if t<=0
539 | c 11-15-07 MLH, remove dead code
540 | c
541 | implicit double precision (a-h,o-z)
542 | implicit integer (i-n)
543 | c
544 | parameter (ncmax=20) !max number of components in mixture
545 | parameter (nrefmx=10) !max number of fluids for transport ECS
546 | parameter (n0=-ncmax-nrefmx,nx=ncmax)
547 | parameter (nfh=4)
548 | common /CCON/ tcrit(n0:nx),pcrit(n0:nx),Dcrit(n0:nx),Zcrit(n0:nx),
549 | & ttp(n0:nx),ptp(n0:nx),dtp(n0:nx),dtpv(n0:nx),
550 | & tnbp(n0:nx),dnbpl(n0:nx),dnbpv(n0:nx),
551 | & wm(n0:nx),accen(n0:nx),dipole(n0:nx),Reos(n0:nx)
552 | common /CFECS/ fecs(ncmax,nfh,2),hecs(ncmax,nfh,2),
553 | & fdecs(ncmax,nfh,2),hdecs(ncmax,nfh,2),
554 | & acfecs(ncmax),acfref(ncmax),Zcref(ncmax),
555 | & tmin(ncmax),tmax(ncmax),pmax(ncmax),rhomax(ncmax)
556 | common /ICFECS/ nfecs(ncmax),nhecs(ncmax),
557 | & nfdecs(ncmax),nhdecs(ncmax)
558 | c
559 | h=0.d0
560 | dhdt=0.d0
561 | d2hdt2=0.d0
562 | dhdd=0.d0
563 | d2hdd2=0.d0
564 | d2hdtd=0.d0
565 | if (t.le.0.d0) RETURN
566 | i=icomp
567 | iref=-icomp
568 | Tr=t/tcrit(i)
569 | Dr=d/Dcrit(i)
570 | domega=acfecs(i)-acfref(i)
571 | Zrat=Zcref(i)/Zcrit(i)
572 | c phi is the density shape factor, not to be confused with PHI=A/RT
573 | phi=Zrat*(1.0d0+domega*(hecs(i,1,1)+hecs(i,2,1)*log(Tr)))
574 | c
575 | c first and second (reduced) temperature derivatives of phi
576 | d1phi=Zrat*domega*hecs(i,2,1)/Tr
577 | d2phi=-Zrat*domega*hecs(i,2,1)/(Tr*Tr)
578 | c
579 | c sum terms beyond those in Huber & Ely function
580 | if (nhecs(i).ge.3) then
581 | do j=3,nhecs(i)
582 | phi=phi+hecs(i,j,1)*Tr**hecs(i,j,2)
583 | d1phi=d1phi+hecs(i,j,1)*hecs(i,j,2)*Tr**(hecs(i,j,2)-1.0d0)
584 | d2phi=d2phi+hecs(i,j,1)*hecs(i,j,2)*(hecs(i,j,2)-1.0d0)
585 | & *Tr**(hecs(i,j,2)-2.0d0)
586 | enddo
587 | end if
588 | c
589 | d1phid=0.0d0
590 | d2phid=0.0d0
591 | if (nhdecs(i).gt.0) then
592 | do j=1,nhdecs(i)
593 | phi=phi+hdecs(i,j,1)*Dr**hdecs(i,j,2)
594 | d1phid=d1phid+hdecs(i,j,1)*hdecs(i,j,2)*Dr**(hdecs(i,j,2)-1.d0)
595 | d2phid=d2phid+hdecs(i,j,1)*hdecs(i,j,2)*(hdecs(i,j,2)-1.d0)
596 | & *Dr**(hdecs(i,j,2)-2.d0)
597 | enddo
598 | end if
599 | c
600 | c convert phi and its derivatives to 'h' and its derivatives
601 | Dcrat=Dcrit(iref)/Dcrit(icomp)
602 | h=Dcrat*phi
603 | dhdt=d1phi*Dcrat/tcrit(icomp)
604 | d2hdt2=d2phi*Dcrat/tcrit(icomp)**2
605 | dhdd=d1phid*Dcrat/Dcrit(icomp)
606 | d2hdd2=d2phid*Dcrat/Dcrit(icomp)**2
607 | c
608 | RETURN
609 | end !subroutine HJ
610 | c
611 | c
612 | c 1 2 3 4 5 6 7
613 | c23456789012345678901234567890123456789012345678901234567890123456789012
614 | c
615 | c ======================================================================
616 | c end file core_ECS.f
617 | c ======================================================================
618 |
--------------------------------------------------------------------------------