| 1 | c *********************************************************************** |
|---|
| 2 | |
|---|
| 3 | subroutine interdp_limits ( yy,zz,m, i1,i2, y,z,n, j1,j2, opt) |
|---|
| 4 | |
|---|
| 5 | c Interpolation soubroutine. |
|---|
| 6 | c Returns values between indexes i1 & i2, donde 1 =< i1 =< i2 =< m |
|---|
| 7 | c Solo usan los indices de los inputs entre j1,j2, 1 =< j1 =< j2 =< n |
|---|
| 8 | c Input values: y(n) , z(n) (solo se usan los valores entre j1,j2) |
|---|
| 9 | c zz(m) (solo se necesita entre i1,i2) |
|---|
| 10 | c Output values: yy(m) (solo se calculan entre i1,i2) |
|---|
| 11 | c Options: opt=1 -> lineal ,, opt=2 -> logarithmic |
|---|
| 12 | c Difference with interdp: |
|---|
| 13 | c here interpolation proceeds between indexes i1,i2 only |
|---|
| 14 | c if i1=1 & i2=m, both subroutines are exactly the same |
|---|
| 15 | c thus previous calls to interdp or interdp2 could be easily replaced |
|---|
| 16 | |
|---|
| 17 | c JAN 98 MALV Version for mz1d |
|---|
| 18 | c jul 2011 malv+fgg Adapted to LMD-MGCM |
|---|
| 19 | c *********************************************************************** |
|---|
| 20 | |
|---|
| 21 | implicit none |
|---|
| 22 | |
|---|
| 23 | ! Arguments |
|---|
| 24 | integer n,m ! I. Dimensions |
|---|
| 25 | integer i1, i2, j1, j2, opt ! I |
|---|
| 26 | real*8 zz(m),yy(m) ! O |
|---|
| 27 | real*8 z(n),y(n) ! I |
|---|
| 28 | |
|---|
| 29 | ! Local variables |
|---|
| 30 | integer i,j |
|---|
| 31 | real*8 zmin,zzmin,zmax,zzmax |
|---|
| 32 | |
|---|
| 33 | c ******************************* |
|---|
| 34 | |
|---|
| 35 | ! type *, ' d interpolating ' |
|---|
| 36 | call mindp_limits (z,n,zmin, j1,j2) |
|---|
| 37 | call mindp_limits (zz,m,zzmin, i1,i2) |
|---|
| 38 | call maxdp_limits (z,n,zmax, j1,j2) |
|---|
| 39 | call maxdp_limits (zz,m,zzmax, i1,i2) |
|---|
| 40 | |
|---|
| 41 | if(zzmin.lt.zmin)then |
|---|
| 42 | write (*,*) 'from d interp: new variable out of limits' |
|---|
| 43 | write (*,*) zzmin,'must be .ge. ',zmin |
|---|
| 44 | stop |
|---|
| 45 | ! elseif(zzmax.gt.zmax)then |
|---|
| 46 | ! type *,'from interp: new variable out of limits' |
|---|
| 47 | ! type *,zzmax, 'must be .le. ',zmax |
|---|
| 48 | ! stop |
|---|
| 49 | end if |
|---|
| 50 | |
|---|
| 51 | do 1,i=i1,i2 |
|---|
| 52 | |
|---|
| 53 | do 2,j=j1,j2-1 |
|---|
| 54 | if(zz(i).ge.z(j).and.zz(i).lt.z(j+1)) goto 3 |
|---|
| 55 | 2 continue |
|---|
| 56 | c in this case (zz(i2).eq.z(j2)) and j leaves the loop with j=j2-1+1=j2 |
|---|
| 57 | if(opt.eq.1)then |
|---|
| 58 | yy(i)=y(j2-1)+(y(j2)-y(j2-1))*(zz(i)-z(j2-1))/(z(j2)-z(j2-1)) |
|---|
| 59 | elseif(opt.eq.2)then |
|---|
| 60 | if(y(j2).eq.0.0d0.or.y(j2-1).eq.0.0d0)then |
|---|
| 61 | yy(i)=0.0d0 |
|---|
| 62 | else |
|---|
| 63 | yy(i)=exp(log(y(j2-1))+log(y(j2)/y(j2-1))* |
|---|
| 64 | @ (zz(i)-z(j2-1))/(z(j2)-z(j2-1))) |
|---|
| 65 | end if |
|---|
| 66 | else |
|---|
| 67 | write (*,*) ' d interp : opt must be 1 or 2, opt= ',opt |
|---|
| 68 | end if |
|---|
| 69 | goto 1 |
|---|
| 70 | 3 continue |
|---|
| 71 | if(opt.eq.1)then |
|---|
| 72 | yy(i)=y(j)+(y(j+1)-y(j))*(zz(i)-z(j))/(z(j+1)-z(j)) |
|---|
| 73 | ! type *, ' ' |
|---|
| 74 | ! type *, ' z(j),z(j+1) =', z(j),z(j+1) |
|---|
| 75 | ! type *, ' t(j),t(j+1) =', y(j),y(j+1) |
|---|
| 76 | ! type *, ' zz, tt = ', zz(i), yy(i) |
|---|
| 77 | elseif(opt.eq.2)then |
|---|
| 78 | if(y(j+1).eq.0.0d0.or.y(j).eq.0.0d0)then |
|---|
| 79 | yy(i)=0.0d0 |
|---|
| 80 | else |
|---|
| 81 | yy(i)=exp(log(y(j))+log(y(j+1)/y(j))* |
|---|
| 82 | @ (zz(i)-z(j))/(z(j+1)-z(j))) |
|---|
| 83 | end if |
|---|
| 84 | else |
|---|
| 85 | write (*,*) ' interp : opt must be 1 or 2, opt= ',opt |
|---|
| 86 | end if |
|---|
| 87 | 1 continue |
|---|
| 88 | return |
|---|
| 89 | end |
|---|
| 90 | |
|---|
| 91 | |
|---|
| 92 | |
|---|
| 93 | |
|---|
| 94 | |
|---|
| 95 | |
|---|
| 96 | |
|---|
