|
Last change
on this file since 650 was
305,
checked in by rwordsworth, 13 years ago
|
|
Several new files added as part of the climate evolution model
(main program kcm.F90). Some general cleanup in physiq.F90 and
callcorrk.F90. Bugs in dust radiative transfer and H2 Rayleigh
scattering corrected.
|
|
File size:
1.9 KB
|
| Rev | Line | |
|---|
| [305] | 1 | !------------------------------------------------------------------------- |
|---|
| 2 | subroutine bilinear(x_arr,y_arr,nX,nY,f2d_arr,x_in,y_in,f) |
|---|
| 3 | ! Necessary for interpolation of continuum data |
|---|
| 4 | |
|---|
| 5 | implicit none |
|---|
| 6 | |
|---|
| 7 | integer nX,nY,i,j,a,b |
|---|
| 8 | |
|---|
| 9 | real*8 x_in,y_in,x,y,x1,x2,y1,y2 |
|---|
| 10 | real*8 f,f11,f12,f21,f22,fA,fB |
|---|
| 11 | real*8 x_arr(nX) |
|---|
| 12 | real*8 y_arr(nY) |
|---|
| 13 | real*8 f2d_arr(nX,nY) |
|---|
| 14 | |
|---|
| 15 | integer strlen |
|---|
| 16 | character*100 label |
|---|
| 17 | label='subroutine bilinear' |
|---|
| 18 | |
|---|
| 19 | x=x_in |
|---|
| 20 | y=y_in |
|---|
| 21 | |
|---|
| 22 | ! 1st check we're within the wavenumber range |
|---|
| 23 | if ((x.lt.x_arr(2)).or.(x.gt.x_arr(nX-2))) then |
|---|
| 24 | f=0.0D+0 |
|---|
| 25 | return |
|---|
| 26 | else |
|---|
| 27 | |
|---|
| 28 | ! in the x (wavenumber) direction 1st |
|---|
| 29 | i=1 |
|---|
| 30 | 10 if (i.lt.(nX+1)) then |
|---|
| 31 | if (x_arr(i).gt.x) then |
|---|
| 32 | x1=x_arr(i-1) |
|---|
| 33 | x2=x_arr(i) |
|---|
| 34 | a=i-1 |
|---|
| 35 | i=9999 |
|---|
| 36 | endif |
|---|
| 37 | i=i+1 |
|---|
| 38 | goto 10 |
|---|
| 39 | endif |
|---|
| 40 | endif |
|---|
| 41 | |
|---|
| 42 | if ((y.lt.y_arr(1)).or.(y.gt.y_arr(nY))) then |
|---|
| 43 | write(*,*) 'Warning from bilinear.for:' |
|---|
| 44 | write(*,*) 'Outside continuum temperature range!' |
|---|
| 45 | if(y.lt.y_arr(1))then |
|---|
| 46 | y=y_arr(1)+0.01 |
|---|
| 47 | endif |
|---|
| 48 | if(y.gt.y_arr(nY))then |
|---|
| 49 | y=y_arr(nY)-0.01 |
|---|
| 50 | endif |
|---|
| 51 | else |
|---|
| 52 | |
|---|
| 53 | ! in the y (temperature) direction 2nd |
|---|
| 54 | j=1 |
|---|
| 55 | 20 if (j.lt.(nY+1)) then |
|---|
| 56 | if (y_arr(j).gt.y) then |
|---|
| 57 | y1=y_arr(j-1) |
|---|
| 58 | y2=y_arr(j) |
|---|
| 59 | b=j-1 |
|---|
| 60 | j=9999 |
|---|
| 61 | endif |
|---|
| 62 | j=j+1 |
|---|
| 63 | goto 20 |
|---|
| 64 | endif |
|---|
| 65 | endif |
|---|
| 66 | |
|---|
| 67 | f11=f2d_arr(a,b) |
|---|
| 68 | f21=f2d_arr(a+1,b) |
|---|
| 69 | f12=f2d_arr(a,b+1) |
|---|
| 70 | f22=f2d_arr(a+1,b+1) |
|---|
| 71 | |
|---|
| 72 | ! 1st in x-direction |
|---|
| 73 | fA=f11*(x2-x)/(x2-x1)+f21*(x-x1)/(x2-x1) |
|---|
| 74 | fB=f12*(x2-x)/(x2-x1)+f22*(x-x1)/(x2-x1) |
|---|
| 75 | |
|---|
| 76 | ! then in y-direction |
|---|
| 77 | f=fA*(y2-y)/(y2-y1)+fB*(y-y1)/(y2-y1) |
|---|
| 78 | |
|---|
| 79 | return |
|---|
| 80 | end subroutine bilinear |
|---|
Note: See
TracBrowser
for help on using the repository browser.
