source: trunk/LMDZ.MARS/libf/aeronomars/intrplf.F

Last change on this file was 3466, checked in by emillour, 5 weeks ago

Mars PCM:
More tidying in aeronomars:

  • remove unused "inv.F" and remove "dtridgl.F" which is not used here and is a duplicate of the "dtridgl" routine in phymars/swr_toon.F
  • turn aeronomars routines to modules, for those which aren't in modules yet.

EM
File size: 1.3 KB
RevLine 
[3466]1      MODULE intrplf_mod
2     
3      IMPLICIT NONE
4     
5      CONTAINS
6     
[38]7c******************************************************
8      SUBROUTINE intrplf(x,y,xd,yd,nd)
9c interpolation, give y = f(x) with array xd,yd known, size nd
10 
11c  Version with CONSTANT values outside limits
12c**********************************************************
13 
14c Variable declaration
15c --------------------
16c  Arguments :
[3466]17      real,intent(in) :: x
18      real,intent(out) :: y
19      real,intent(in) :: xd(nd),yd(nd)
20      integer,intent(in) :: nd
[38]21c  internal
22      integer i,j
23      real y_undefined
24 
25c run
26c ---
27      y_undefined=1.e20
28 
29      y=0.
30      if ((x.le.xd(1)).and.(x.le.xd(nd))) then
31        if (xd(1).lt.xd(nd)) y = yd(1) ! yd(1)
32        if (xd(1).ge.xd(nd)) y = yd(nd) ! yd(1)
33      else if ((x.ge.xd(1)).and.(x.ge.xd(nd))) then
34        if (xd(1).lt.xd(nd)) y = yd(nd) ! yd(1)
35        if (xd(1).ge.xd(nd)) y = yd(1) ! yd(1)
36c        y = yd (nd)
37      else
38        do i=1,nd-1
39         if ( ( (x.ge.xd(i)).and.(x.lt.xd(i+1)) )
40     &     .or. ( (x.le.xd(i)).and.(x.gt.xd(i+1)) ) ) then
41           y=yd(i)+(x-xd(i))*(yd(i+1)-yd(i))/(xd(i+1)-xd(i))
42           goto 99
43         end if
44        end do
45      end if
46 
47 99   continue
[3466]48
49      END SUBROUTINE intrplf
50
51      END MODULE intrplf_mod
Note: See TracBrowser for help on using the repository browser.