1 : C PRITH1 SOURCE BECC 09/12/07 21:15:57 6579
2 : subroutine prith1(nordpo, acv, Tmaxcv, T, ether, cvtot)
3 : C
4 : C This subroutine creates ether and cvtot (T and acv given.
5 : C
6 : C INPUT
7 : C *****
8 : C
9 : C nordpo = order of polynomial for cp and cv (see also
10 : C Tmaxcv)
11 : C
12 : C acv = vector such that
13 : C cv = \sum_{i=1,nordpo+1} acv(i) T^{i-1}
14 : C ether = \sum_{i=1,nordpo+1} acv(i) T^{i} / (i)
15 : C
16 : C Tmaxcv = maximum temperature for cv polynomial expansion
17 : C cv(T) = cv(Tmaxcv) if T > Tmaxcv
18 : C
19 : C T = temperature
20 : C
21 : C OUTPUT
22 : C ******
23 : C
24 : C cvtot = cv
25 : C
26 : C ether = sensible energy (0 at 0K)
27 : C
28 : C************************************************************************
29 : C
30 : C HISTORY AND MODIFICATIONS
31 : C
32 : c 07/12/2009 Created.
33 : C
34 : C************************************************************************
35 : C
36 : C implicit none
37 : integer nordpo
38 : real*8 acv(1:(nordpo + 1)), Tmaxcv, T, ether, cvtot
39 : & , t2, funt, funcv
40 : C t2 = min (t, tmaxcv)
41 : t2 = 0.5d0 * ((t + tmaxcv) - abs (t - tmaxcv))
42 : cvtot = acv(1)
43 : ether = t2 * cvtot
44 : funt = 1.0d0
45 : do i1 = 2, nordpo + 1, 1
46 : funt = funt * t2
47 : funcv = acv(i1) * funt
48 : cvtot = cvtot + funcv
49 : ether = ether + (funcv * t2/ i1)
50 : enddo
51 : c t2 = max ((t - tmaxcv),0)
52 : t2 = 0.5d0 * ((t - tmaxcv) + abs (t - tmaxcv))
53 : ether = ether + (cvtot * t2)
54 : return
55 : end
56 : C
57 :
© Cast3M 2003 - All rights reserved.
Disclaimer