source: trunk/LMDZ.VENUS/libf/phyvenus/tpindex.F

Last change on this file was 2560, checked in by slebonnois, 3 years ago

SL: Implementation of SW computation based on generic model. Switch between this new SW module or old module that reads R. Haus tables implemented with a key (solarchoice)

File size: 4.4 KB
Line 
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
65C======================================================================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
Note: See TracBrowser for help on using the repository browser.