Changeset 716 for trunk/LMDZ.GENERIC/libf/phystd/bilinear.F90

Timestamp:

Jul 3, 2012, 8:09:54 PM (13 years ago)

Author:

rwordsworth

Message:

Mainly updates to radiative transfer and gas management scheme.
Most CIA data now read from standard HITRAN datafiles. For the H2O
continuum, two options have been added: the standard CKD continuum,
and the empirical formula in PPC (Pierrehumbert 2010). Use the toggle
'H2Ocont_simple' in callphys.def to choose.

Note to Martians: I've changed the default values of 'sedimentation' and
'co2cond' in inifis to false. Both these are defined in the standard deftank
callphys.def file, so there shouldn't be any compatibility problems.

File:

• trunk/LMDZ.GENERIC/libf/phystd/bilinear.F90 (modified) (1 diff)

trunk/LMDZ.GENERIC/libf/phystd/bilinear.F90

@@ -1 +1 @@
 !-------------------------------------------------------------------------
-      subroutine bilinear(x_arr,y_arr,nX,nY,f2d_arr,x_in,y_in,f)
-!     Necessary for interpolation of continuum data
+subroutine bilinear(f,f11,f21,f12,f22,x,x1,x2,y,y1,y2)  
+! Used for interpolation of continuum data
 
-      implicit none
+  implicit none
 
-      integer nX,nY,i,j,a,b
+  real*8 x,y,x1,x2,y1,y2
+  real*8 f,f11,f12,f21,f22,fA,fB
 
-      real*8 x_in,y_in,x,y,x1,x2,y1,y2
-      real*8 f,f11,f12,f21,f22,fA,fB
-      real*8 x_arr(nX)
-      real*8 y_arr(nY)
-      real*8 f2d_arr(nX,nY)
-      
-      integer strlen
-      character*100 label
-      label='subroutine bilinear'
+  ! 1st in x-direction
+  fA=f11*(x2-x)/(x2-x1)+f21*(x-x1)/(x2-x1)
+  fB=f12*(x2-x)/(x2-x1)+f22*(x-x1)/(x2-x1)
 
-      x=x_in
-      y=y_in
+  ! then in y-direction
+  f=fA*(y2-y)/(y2-y1)+fB*(y-y1)/(y2-y1)
 
-!     1st check we're within the wavenumber range
-      if ((x.lt.x_arr(2)).or.(x.gt.x_arr(nX-2))) then
-         f=0.0D+0
-         return
-      else
-         
-!     in the x (wavenumber) direction 1st
-         i=1
- 10      if (i.lt.(nX+1)) then
-            if (x_arr(i).gt.x) then
-               x1=x_arr(i-1)
-               x2=x_arr(i)
-               a=i-1
-               i=9999
-            endif
-            i=i+1
-            goto 10
-         endif
-      endif
-      
-      if ((y.lt.y_arr(1)).or.(y.gt.y_arr(nY))) then
-         write(*,*) 'Warning from bilinear.for:'
-         write(*,*) 'Outside continuum temperature range!'
-         if(y.lt.y_arr(1))then
-            y=y_arr(1)+0.01
-         endif
-         if(y.gt.y_arr(nY))then
-            y=y_arr(nY)-0.01
-         endif
-      else
-
-!     in the y (temperature) direction 2nd
-         j=1
- 20      if (j.lt.(nY+1)) then
-            if (y_arr(j).gt.y) then
-               y1=y_arr(j-1)
-               y2=y_arr(j)
-               b=j-1
-               j=9999
-            endif
-            j=j+1
-            goto 20
-         endif
-      endif
-      
-      f11=f2d_arr(a,b)
-      f21=f2d_arr(a+1,b)
-      f12=f2d_arr(a,b+1)
-      f22=f2d_arr(a+1,b+1)
-      
-!     1st in x-direction
-      fA=f11*(x2-x)/(x2-x1)+f21*(x-x1)/(x2-x1)
-      fB=f12*(x2-x)/(x2-x1)+f22*(x-x1)/(x2-x1)
-      
-!     then in y-direction
-      f=fA*(y2-y)/(y2-y1)+fB*(y-y1)/(y2-y1)
-      
-      return
-    end subroutine bilinear
+  return
+end subroutine bilinear