[878] | 1 | subroutine bilinearbig(nX,nY,x_arr,y_arr,f2d_arr,x_in,y_in,f,ind) |
---|
[873] | 2 | |
---|
| 3 | ! Necessary for interpolation of continuum data |
---|
| 4 | ! optimized by A. Spiga 01/2013 |
---|
| 5 | |
---|
| 6 | implicit none |
---|
| 7 | |
---|
[878] | 8 | integer nX,nY,i,j,ind,b |
---|
[873] | 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 |
---|
[1315] | 16 | !$OMP THREADPRIVATE(x,y) |
---|
[873] | 17 | |
---|
| 18 | integer strlen |
---|
| 19 | character*100 label |
---|
| 20 | label='subroutine bilinear' |
---|
| 21 | |
---|
[918] | 22 | |
---|
[873] | 23 | x=x_in |
---|
| 24 | y=y_in |
---|
| 25 | |
---|
| 26 | !! AS: important to optimize here because the array is quite large |
---|
| 27 | !! ... and actually calculations only need to be done once |
---|
[903] | 28 | !! IF ind=-9999 we have not calculated yet |
---|
[878] | 29 | if ( ind == -9999) then |
---|
[873] | 30 | !1st check we're within the wavenumber range |
---|
| 31 | if ((x.lt.x_arr(2)).or.(x.gt.x_arr(nX-2))) then |
---|
[878] | 32 | ind=-1 |
---|
[873] | 33 | else |
---|
| 34 | i=1 |
---|
| 35 | x2=x_arr(i) |
---|
| 36 | do while ( x2 .le. x ) |
---|
| 37 | x1=x2 |
---|
| 38 | i=i+1 |
---|
| 39 | x2=x_arr(i) |
---|
[878] | 40 | ind=i-1 |
---|
[873] | 41 | end do |
---|
| 42 | endif |
---|
[903] | 43 | endif |
---|
| 44 | |
---|
| 45 | !! Either we already saw we are out of wavenumber range |
---|
| 46 | !! ... and we just have to set f=0 and exit |
---|
| 47 | if ( ind == -1) then |
---|
[873] | 48 | f=0.0D+0 |
---|
| 49 | return |
---|
[903] | 50 | !! Or we already determined ind -- so we just proceed |
---|
[873] | 51 | else |
---|
[878] | 52 | x1=x_arr(ind) |
---|
| 53 | x2=x_arr(ind+1) |
---|
[873] | 54 | endif |
---|
| 55 | |
---|
| 56 | ! ... and for y within the temperature range |
---|
[2239] | 57 | if ((y.le.y_arr(1)).or.(y.ge.y_arr(nY))) then |
---|
| 58 | !print*,y_arr(1),y_arr(nY) |
---|
[1699] | 59 | !write(*,*) 'Warning from bilinearbig routine:' |
---|
| 60 | !write(*,*) 'Outside continuum temperature range!' |
---|
[2239] | 61 | if(y.le.y_arr(1))then |
---|
[873] | 62 | y=y_arr(1)+0.01 |
---|
[1699] | 63 | b=1 |
---|
| 64 | y1=y_arr(b) |
---|
| 65 | y2=y_arr(b+1) |
---|
[873] | 66 | endif |
---|
[2239] | 67 | if(y.ge.y_arr(nY))then |
---|
[873] | 68 | y=y_arr(nY)-0.01 |
---|
[1699] | 69 | b=nY-1 |
---|
| 70 | y1=y_arr(b) |
---|
| 71 | y2=y_arr(b+1) |
---|
[873] | 72 | endif |
---|
| 73 | else |
---|
| 74 | j=1 |
---|
| 75 | y2=y_arr(j) |
---|
[2239] | 76 | do while ( y2 .lt. y ) |
---|
[873] | 77 | y1=y2 |
---|
| 78 | j=j+1 |
---|
| 79 | y2=y_arr(j) |
---|
| 80 | b=j-1 |
---|
| 81 | end do |
---|
| 82 | endif |
---|
[918] | 83 | |
---|
[878] | 84 | f11=f2d_arr(ind,b) |
---|
| 85 | f21=f2d_arr(ind+1,b) |
---|
| 86 | f12=f2d_arr(ind,b+1) |
---|
| 87 | f22=f2d_arr(ind+1,b+1) |
---|
[873] | 88 | |
---|
| 89 | call bilinear(f,f11,f21,f12,f22,x,x1,x2,y,y1,y2) |
---|
| 90 | |
---|
| 91 | return |
---|
| 92 | end subroutine bilinearbig |
---|