1 | subroutine tpindex(pw,tw,qvar,pref,tref,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 | |
---|
61 | integer MT, MP, N, M, NP, NVAR |
---|
62 | real*8 PW, TW, Qvar, wratio |
---|
63 | real*8 PWL, LCOEF(4), T, U |
---|
64 | |
---|
65 | C======================================================================C |
---|
66 | |
---|
67 | ! Get the upper and lower temperature grid indicies that bound the |
---|
68 | ! requested temperature. If the requested temperature is outside |
---|
69 | ! the T-grid, set up to extrapolate from the appropriate end. |
---|
70 | ! TW : temperature to be interpolated |
---|
71 | ! TREF : grid array |
---|
72 | ! MT : index of TREF for bounding new temperature |
---|
73 | ! U : new index (real) for temperature interpolated |
---|
74 | |
---|
75 | IF(TW.LE.TREF(1)) THEN |
---|
76 | MT = 1 |
---|
77 | IF (TW.LT.TREF(1)) THEN |
---|
78 | write(*,*) 'tpindex: Caution! Temperature of upper levels lower |
---|
79 | $ than ref temperature for k-coef: k-coeff fixed for upper levels' |
---|
80 | write(*,*) " TW=",TW |
---|
81 | write(*,*) " TREF(1)=",TREF(1) |
---|
82 | ENDIF |
---|
83 | ELSE |
---|
84 | do n=1,L_NTREF-1 |
---|
85 | if(tw.gt.Tref(n) .and. TW.LE.TREF(N+1)) then |
---|
86 | MT = n |
---|
87 | goto 10 |
---|
88 | end if |
---|
89 | end do |
---|
90 | |
---|
91 | MT = L_NTREF-1 |
---|
92 | |
---|
93 | 10 continue |
---|
94 | END IF |
---|
95 | |
---|
96 | !TB15 : case low temp : MT=1: fixed TW right above tref(1) |
---|
97 | IF (MT.eq.1) THEN |
---|
98 | TW=tref(1)*1.00 |
---|
99 | ! write(*,*) 'tpindex: Caution! Temperature of upper levels lower |
---|
100 | ! $than ref temperature for k-coef: k-coeff fixed for upper levels' |
---|
101 | ! write(*,*) " TW=",TW |
---|
102 | ! write(*,*) " TREF(1)=",TREF(1) |
---|
103 | ENDIF |
---|
104 | |
---|
105 | U = (TW-TREF(MT))/(TREF(MT+1)-TREF(MT)) |
---|
106 | |
---|
107 | ! Get the upper and lower pressure grid indicies that bound the |
---|
108 | ! requested pressure. If the requested pressure is outside |
---|
109 | ! the P-grid, set up to extrapolate from the appropriate end. |
---|
110 | |
---|
111 | pwl = log10(pw) |
---|
112 | |
---|
113 | do n=2,L_PINT-1 |
---|
114 | if(pwl.le.Pref(n)) then |
---|
115 | MP = n-1 |
---|
116 | goto 20 |
---|
117 | end if |
---|
118 | end do |
---|
119 | |
---|
120 | MP = L_PINT-1 |
---|
121 | |
---|
122 | 20 continue |
---|
123 | |
---|
124 | !TB15 : case low pressure : n=2 : fixed pwl, right above pref(1) |
---|
125 | IF (MP.eq.1) THEN |
---|
126 | IF (PWL.LT.PREF(1)) THEN |
---|
127 | write(*,*) 'tpindex: Caution! Pressure of upper levels lower |
---|
128 | $than ref pressure for k-coef: k-coeff fixed for upper levels' |
---|
129 | write(*,*) " PWL=",PWL |
---|
130 | write(*,*) " PREF(1)=",PREF(1) |
---|
131 | ENDIF |
---|
132 | PWL=Pref(1)*1.00 |
---|
133 | ENDIF |
---|
134 | |
---|
135 | ! interpolated pressure |
---|
136 | T = (PWL-PREF(MP))/(PREF(MP+1)-PREF(MP)) |
---|
137 | |
---|
138 | ! Fill in the interpolation coefficients |
---|
139 | LCOEF(1) = (1.0-T)*(1.0-U) |
---|
140 | LCOEF(2) = T*(1.0-U) |
---|
141 | LCOEF(3) = T*U |
---|
142 | LCOEF(4) = (1.0-T)*U |
---|
143 | |
---|
144 | ! Get the indicies for abundance of the varying species. There are 10 sets of |
---|
145 | ! k-coefficients with differing amounts of variable vs. constant gas. |
---|
146 | |
---|
147 | NVAR = 1 |
---|
148 | WRATIO = 0.0D0 ! put all the weight on the first point |
---|
149 | |
---|
150 | 30 CONTINUE |
---|
151 | |
---|
152 | return |
---|
153 | end |
---|