1 | subroutine tpindex(pw,tw,qvar,pref,tref,wrefvar,LCOEF,MT,MP, |
---|
2 | & NVAR,wratio) |
---|
3 | |
---|
4 | !================================================================== |
---|
5 | ! |
---|
6 | ! Purpose |
---|
7 | ! ------- |
---|
8 | ! Interpolate K-coefficients to the given P,T and Qvar values. |
---|
9 | ! |
---|
10 | ! Notes |
---|
11 | ! ----- |
---|
12 | ! The interpolation is the usual one in two dimensions given |
---|
13 | ! in "Numerical Recipes", where the "X" are P, the "Y" are |
---|
14 | ! T, and the F(X,Y) are the CO2 K-coefficients. |
---|
15 | ! |
---|
16 | ! The interpolating box is: |
---|
17 | ! |
---|
18 | ! (PL,TU) (PR,TU) |
---|
19 | ! |
---|
20 | ! (TW,PW) |
---|
21 | ! |
---|
22 | ! |
---|
23 | ! (PL,TL) (PR,TL) |
---|
24 | ! |
---|
25 | ! PL - Pressure left |
---|
26 | ! PR - Pressure right |
---|
27 | ! TL - Temperature lower |
---|
28 | ! TU - Temperature upper |
---|
29 | ! PW - Pressure wanted |
---|
30 | ! TW - Temperature wanted |
---|
31 | ! |
---|
32 | ! Inputs |
---|
33 | ! ------ |
---|
34 | ! PW - The pressure to interpolate to |
---|
35 | ! TW - The temperature to interpolate to |
---|
36 | ! Pref(NP) - The pressure grid array |
---|
37 | ! Tref(NT) - The temperature grid array |
---|
38 | ! |
---|
39 | ! Outputs |
---|
40 | ! ------- |
---|
41 | ! TI - Interpolation term (pressure) |
---|
42 | ! UI - Interpolation term (temperature) |
---|
43 | ! MT - Temperature index (bottom left temperature) |
---|
44 | ! of bounding box |
---|
45 | ! MP - Pressure index (bottom left pressure) |
---|
46 | ! of bounding box |
---|
47 | ! |
---|
48 | ! Authors |
---|
49 | ! ------- |
---|
50 | ! Adapted from the NASA Ames code by R. Wordsworth (2009) |
---|
51 | ! |
---|
52 | !================================================================== |
---|
53 | |
---|
54 | use radinc_h |
---|
55 | |
---|
56 | implicit none |
---|
57 | |
---|
58 | real*8 Tref(L_NTREF) |
---|
59 | real*8 pref(L_PINT) |
---|
60 | real*8 wrefvar(L_REFVAR) |
---|
61 | |
---|
62 | integer MT, MP, N, M, NP, NVAR |
---|
63 | real*8 PW, TW, Qvar, wratio |
---|
64 | real*8 PWL, LCOEF(4), T, U |
---|
65 | |
---|
66 | C======================================================================C |
---|
67 | |
---|
68 | ! Get the upper and lower temperature grid indicies that bound the |
---|
69 | ! requested temperature. If the requested temperature is outside |
---|
70 | ! the T-grid, set up to extrapolate from the appropriate end. |
---|
71 | |
---|
72 | |
---|
73 | IF(TW.LE.TREF(1)) THEN |
---|
74 | MT = 1 |
---|
75 | ELSE |
---|
76 | do n=1,L_NTREF-1 |
---|
77 | if(tw.gt.Tref(n) .and. TW.LE.TREF(N+1)) then |
---|
78 | MT = n |
---|
79 | goto 10 |
---|
80 | end if |
---|
81 | end do |
---|
82 | |
---|
83 | MT = L_NTREF-1 |
---|
84 | |
---|
85 | 10 continue |
---|
86 | END IF |
---|
87 | |
---|
88 | U = (TW-TREF(MT))/(TREF(MT+1)-TREF(MT)) |
---|
89 | |
---|
90 | ! Get the upper and lower pressure grid indicies that bound the |
---|
91 | ! requested pressure. If the requested pressure is outside |
---|
92 | ! the P-grid, set up to extrapolate from the appropriate end. |
---|
93 | |
---|
94 | pwl = log10(pw) |
---|
95 | |
---|
96 | do n=2,L_PINT-1 |
---|
97 | if(pwl.le.Pref(n)) then |
---|
98 | MP = n-1 |
---|
99 | goto 20 |
---|
100 | end if |
---|
101 | end do |
---|
102 | |
---|
103 | MP = L_PINT-1 |
---|
104 | |
---|
105 | 20 continue |
---|
106 | |
---|
107 | T = (PWL-PREF(MP))/(PREF(MP+1)-PREF(MP)) |
---|
108 | |
---|
109 | ! Fill in the interpolation coefficients |
---|
110 | LCOEF(1) = (1.0-T)*(1.0-U) |
---|
111 | LCOEF(2) = T*(1.0-U) |
---|
112 | LCOEF(3) = T*U |
---|
113 | LCOEF(4) = (1.0-T)*U |
---|
114 | |
---|
115 | ! Get the indicies for abundance of the varying species. There are 10 sets of |
---|
116 | ! k-coefficients with differing amounts of variable vs. constant gas. |
---|
117 | |
---|
118 | IF(QVAR.le.WREFVAR(1)) then |
---|
119 | NVAR = 1 |
---|
120 | WRATIO = 0.0D0 |
---|
121 | ELSEIF(QVAR.ge.WREFVAR(L_REFVAR)) then |
---|
122 | NVAR = L_REFVAR |
---|
123 | WRATIO = 0.0D0 |
---|
124 | ELSE |
---|
125 | DO N=2,L_REFVAR |
---|
126 | IF(QVAR.GE.WREFVAR(N-1) .and. QVAR.lt.WREFVAR(N)) then |
---|
127 | NVAR = N-1 |
---|
128 | WRATIO = (QVAR - WREFVAR(N-1))/(WREFVAR(N) - WREFVAR(N-1)) |
---|
129 | GOTO 30 |
---|
130 | END IF |
---|
131 | END DO |
---|
132 | END IF |
---|
133 | |
---|
134 | 30 CONTINUE |
---|
135 | |
---|
136 | return |
---|
137 | end |
---|