source: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/bilinearbig.F90 @ 222

Last change on this file since 222 was 222, checked in by ymipsl, 10 years ago

Creating temporary dynamico/lmdz/saturn branche

YM
  • Property svn:executable set to *
File size: 2.0 KB
Line 
1      subroutine bilinearbig(nX,nY,x_arr,y_arr,f2d_arr,x_in,y_in,f,ind)
2
3!     Necessary for interpolation of continuum data
4!     optimized by A. Spiga 01/2013
5
6      implicit none
7
8      integer nX,nY,i,j,ind,b
9
10      real*8 x_in,y_in,x1,x2,y1,y2
11      real*8 f,f11,f12,f21,f22,fA,fB
12      real*8 x_arr(nX)
13      real*8 y_arr(nY)
14      real*8 f2d_arr(nX,nY)
15      real*8,save :: x,y
16
17      integer strlen
18      character*100 label
19      label='subroutine bilinear'
20
21
22      x=x_in
23      y=y_in
24
25   !! AS: important to optimize here because the array is quite large
26   !! ... and actually calculations only need to be done once
27   !! IF ind=-9999 we have not calculated yet
28   if ( ind == -9999) then
29      !1st check we're within the wavenumber range
30      if ((x.lt.x_arr(2)).or.(x.gt.x_arr(nX-2))) then
31         ind=-1
32      else
33        i=1
34        x2=x_arr(i)
35        do while ( x2 .le. x )
36          x1=x2
37          i=i+1
38          x2=x_arr(i)
39          ind=i-1
40        end do
41      endif
42   endif
43
44   !! Either we already saw we are out of wavenumber range
45   !! ... and we just have to set f=0 and exit
46   if ( ind == -1) then
47      f=0.0D+0
48      return
49   !! Or we already determined ind -- so we just proceed
50   else
51      x1=x_arr(ind)
52      x2=x_arr(ind+1)
53   endif
54
55!     ... and for y within the temperature range
56      if ((y.lt.y_arr(1)).or.(y.gt.y_arr(nY))) then
57         write(*,*) 'Warning from bilinearH2H2:'
58         write(*,*) 'Outside continuum temperature range!'
59         if(y.lt.y_arr(1))then
60            y=y_arr(1)+0.01
61         endif
62         if(y.gt.y_arr(nY))then
63            y=y_arr(nY)-0.01
64         endif
65      else
66        j=1
67        y2=y_arr(j)
68        do while ( y2 .le. y )
69          y1=y2
70          j=j+1
71          y2=y_arr(j)
72          b=j-1
73        end do
74      endif
75     
76      f11=f2d_arr(ind,b)
77      f21=f2d_arr(ind+1,b)
78      f12=f2d_arr(ind,b+1)
79      f22=f2d_arr(ind+1,b+1)
80
81      call bilinear(f,f11,f21,f12,f22,x,x1,x2,y,y1,y2)
82
83      return
84    end subroutine bilinearbig
Note: See TracBrowser for help on using the repository browser.