[135] | 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 |
---|