source: trunk/LMDZ.COMMON/libf/evolution/derivs.f90 @ 3470

subroutine deriv1(z,nz,y,y0,yNp1,yp)
  ! first derivative of a function y(z) on irregular grid
  ! upper b.c.: y(0)=y0
  ! lower b.c.: yp =0
  implicit none
  integer, intent(IN) :: nz
  real(8), intent(IN) :: z(nz),y(nz),y0,yNp1
  real(8), intent(OUT) :: yp(nz)
  integer j
  real(8) hm,hp,c1,c2,c3

  hp = z(2)-z(1)
  !hm = z(1)
  c1 = z(1)/(hp*z(2))
  c2 = 1/z(1) - 1/(z(2)-z(1))
  c3 = -hp/(z(1)*z(2))
  yp(1) = c1*y(2) + c2*y(1) + c3*y0
  do j=2,nz-1
     hp = z(j+1)-z(j)
     hm = z(j)-z(j-1)
     c1 = +hm/(hp*(z(j+1)-z(j-1)))
     c2 = 1/hm - 1/hp
     c3 = -hp/(hm*(z(j+1)-z(j-1)))
     yp(j) = c1*y(j+1) + c2*y(j) + c3*y(j-1)
  enddo
  yp(nz) = (yNp1 - y(nz-1))/(2.*(z(nz)-z(nz-1)))
end subroutine deriv1



subroutine deriv2_full(z,nz,a,b,a0,b0,bNp1,yp2)
  ! second derivative (a*b_z)_z on irregular grid
  ! upper b.c.: a(0)=a0, b(0)=b0
  ! 2nd order, without cross-terms
  implicit none
  integer, intent(IN) :: nz
  real(8), intent(IN) :: z(nz),a(nz),b(nz),a0,b0,bNp1
  real(8), intent(OUT) :: yp2(nz)
  integer j
  real(8) hm,hp,c1,c2,c3
  
  c1 = 1./(z(1)*z(2))
  c2 = 1./((z(2)-z(1))*z(1))
  c3 = 1./((z(2)-z(1))*z(2))
  yp2(1) = -c2*a(1)*b(1) &   
       &  -c1*a0*b(1) + c1*(a(1)+a0)*b0 &
       &  -c3*a(2)*b(1) + c3*(a(1)+a(2))*b(2)
  do j=2,nz-1
     hp = z(j+1)-z(j)
     hm = z(j)-z(j-1)
     c1 = 1./(hm*(z(j+1)-z(j-1)))
     c2 = 1./(hp*hm)
     c3 = 1./(hp*(z(j+1)-z(j-1)))
     yp2(j) = -c2*a(j)*b(j) &   
          &  -c1*a(j-1)*b(j) + c1*(a(j)+a(j-1))*b(j-1) &
          &  -c3*a(j+1)*b(j) + c3*(a(j)+a(j+1))*b(j+1)
  enddo

  ! lower bc: b_z = 0
  !yp(nz)= 2.*a(nz)*(b(nz-1)-b(nz))/(z(nz)-z(nz-1))**2
  !more general lower bc
  yp2(nz) = a(nz)*(bNp1 - 2*b(nz) + b(nz-1))/(z(nz)-z(nz-1))**2
end subroutine deriv2_full



subroutine deriv2_simple(z,nz,y,y0,yNp1,yp2)
  ! second derivative y_zz on irregular grid
  ! boundary conditions: y(0)=y0, y(nz+1)=yNp1
  implicit none
  integer, intent(IN) :: nz
  real(8), intent(IN) :: z(nz),y(nz),y0,yNp1
  real(8), intent(OUT) :: yp2(nz)
  integer j
  real(8) hm,hp,c1,c2,c3

  c1 = +2./((z(2)-z(1))*z(2))
  c2 = -2./((z(2)-z(1))*z(1))
  c3 = +2./(z(1)*z(2))
  yp2(1) = c1*y(2) + c2*y(1) + c3*y0

  do j=2,nz-1
     hp = z(j+1)-z(j)
     hm = z(j)-z(j-1)
     c1 = +2./(hp*(z(j+1)-z(j-1)))
     c2 = -2./(hp*hm)
     c3 = +2./(hm*(z(j+1)-z(j-1)))
     yp2(j) = c1*y(j+1) + c2*y(j) + c3*y(j-1)
  enddo

  yp2(nz) = (yNp1 - 2*y(nz) + y(nz-1))/(z(nz)-z(nz-1))**2
end subroutine deriv2_simple



real(8) function deriv1_onesided(j,z,nz,y)
  ! first derivative of function y(z) at z(j)
  ! one-sided derivative on irregular grid
  implicit none
  integer, intent(IN) :: nz,j
  real(8), intent(IN) :: z(nz),y(nz)
  real(8) h1,h2,c1,c2,c3
  if (j<1 .or. j>nz-2) then
     deriv1_onesided = -9999.
  else
     h1 = z(j+1)-z(j)
     h2 = z(j+2)-z(j+1)
     c1 = -(2*h1+h2)/(h1*(h1+h2))
     c2 =  (h1+h2)/(h1*h2)
     c3 = -h1/(h2*(h1+h2))
     deriv1_onesided = c1*y(j) + c2*y(j+1) + c3*y(j+2)
  endif
end function deriv1_onesided