source: trunk/LMDZ.GENERIC/libf/phystd/tpindex.F @ 601

Last change on this file since 601 was 135, checked in by aslmd, 14 years ago

CHANGEMENT ARBORESCENCE ETAPE 2 -- NON COMPLET

File size: 3.6 KB
RevLine 
[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
66C======================================================================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
Note: See TracBrowser for help on using the repository browser.