source: trunk/LMDZ.TITAN/libf/phytitan/tpindex.F @ 3026

Last change on this file since 3026 was 1648, checked in by jvatant, 8 years ago

Modifications to custom radiative transfer to Titan
+ Enables an altitude dependant gfrac for CIA computations

-> many radical changes in su_gases and co ..
-> read vertical CH4 profile with call_profilgases
-> Now you need a 'profile.def' that I will add in the deftank

+ Added interpolate CIA routines for CH4
+ Added temporary mean aerosol profile opacity routine (disr_haze)

File size: 4.1 KB
Line 
1      subroutine tpindex(pw,tw,pref,tref,LCOEF,MT,MP)
2
3!==================================================================
4!     
5!     Purpose
6!     -------
7!     Interpolate K-coefficients to the given P,T.
8!
9!     Notes
10!     -----
11!     The interpolation is the usual one in two dimensions given
12!     in "Numerical Recipes", where the "X" are P, the "Y" are
13!     T, and the F(X,Y) are the CO2 K-coefficients.
14!
15!     The interpolating box is:
16!
17!           (PL,TU)                        (PR,TU)
18!
19!                          (TW,PW)
20!
21!           
22!           (PL,TL)                        (PR,TL)
23!
24!      PL  - Pressure left
25!      PR  - Pressure right
26!      TL  - Temperature lower
27!      TU  - Temperature upper
28!      PW  - Pressure wanted
29!      TW  - Temperature wanted
30!
31!     Inputs
32!     ------
33!     PW                 - The pressure to interpolate to
34!     TW                 - The temperature to interpolate to
35!     Pref(NP)           - The pressure grid array
36!     Tref(NT)           - The temperature grid array
37!   
38!     Outputs
39!     -------
40!     TI                 - Interpolation term (pressure)
41!     UI                 - Interpolation term (temperature)
42!     MT                 - Temperature index (bottom left temperature)
43!                          of bounding box
44!     MP                 - Pressure index (bottom left pressure)
45!                          of bounding box
46!
47!     Authors
48!     -------
49!     Adapted from the NASA Ames code by R. Wordsworth (2009)
50!     
51!==================================================================
52
53      use radinc_h
54
55      implicit none
56
57      real*8 Tref(L_NTREF)
58      real*8 pref(L_PINT)
59
60      integer MT, MP, N, M, NP
61      real*8  PW, TW
62      real*8  PWL, LCOEF(4), T, U
63
64C======================================================================C
65 
66!     Get the upper and lower temperature grid indicies that bound the
67!     requested temperature. If the requested temperature is outside
68!     the T-grid, set up to extrapolate from the appropriate end.
69!     TW : temperature to be interpolated
70!     TREF : grid array
71!     MT : index of TREF for bounding new temperature
72!     U : new index (real) for temperature interpolated
73
74      IF(TW.LE.TREF(1)) THEN
75        MT = 1
76        IF (TW.LT.TREF(1)) THEN
77         write(*,*) 'tpindex: Caution! Temperature of upper levels lower
78     $ than ref temperature for k-coef: k-coeff fixed for upper levels'
79         write(*,*) "         TW=",TW
80         write(*,*) "         TREF(1)=",TREF(1)
81        ENDIF
82      ELSE
83        do n=1,L_NTREF-1
84          if(tw.gt.Tref(n) .and. TW.LE.TREF(N+1)) then
85            MT = n
86            goto 10
87          end if
88        end do
89
90        MT = L_NTREF-1
91     
92   10   continue
93      END IF
94
95      !TB15 : case low temp : MT=1: fixed TW right above tref(1)
96      IF (MT.eq.1) THEN
97         TW=tref(1)*1.00
98!         write(*,*) 'tpindex: Caution! Temperature of upper levels lower
99!     $than ref temperature for k-coef: k-coeff fixed for upper levels'
100!         write(*,*) "         TW=",TW
101!         write(*,*) "         TREF(1)=",TREF(1)
102      ENDIF
103
104      U = (TW-TREF(MT))/(TREF(MT+1)-TREF(MT))
105
106!     Get the upper and lower pressure grid indicies that bound the
107!     requested pressure. If the requested pressure is outside
108!     the P-grid, set up to extrapolate from the appropriate end.
109
110      pwl = log10(pw)
111
112      do n=2,L_PINT-1
113        if(pwl.le.Pref(n)) then
114          MP = n-1
115          goto 20
116        end if
117      end do
118
119      MP = L_PINT-1
120
121   20 continue
122     
123      !TB15 : case low pressure : n=2 : fixed pwl, right above pref(1)
124      IF (MP.eq.1) THEN
125        IF (PWL.LT.PREF(1)) THEN
126         write(*,*) 'tpindex: Caution! Pressure of upper levels lower
127     $than ref pressure for k-coef: k-coeff fixed for upper levels'
128         write(*,*) "         PWL=",PWL
129         write(*,*) "         PREF(1)=",PREF(1)
130        ENDIF
131        PWL=Pref(1)*1.00
132      ENDIF
133
134!     interpolated pressure
135      T = (PWL-PREF(MP))/(PREF(MP+1)-PREF(MP))
136
137!  Fill in the interpolation coefficients
138      LCOEF(1) = (1.0-T)*(1.0-U)
139      LCOEF(2) = T*(1.0-U)
140      LCOEF(3) = T*U
141      LCOEF(4) = (1.0-T)*U
142
143   30 CONTINUE
144
145      return
146      end
Note: See TracBrowser for help on using the repository browser.