var/da/da_setup_structures/da_gen_eigen.inc

   1 Subroutine da_gen_eigen(kz, covm, eve, val)
   2
   3   implicit none
   4
   5   integer, intent(in) :: kz
   6   real   , dimension(1:kz,1:kz), intent(inout) :: covm
   7   real   , dimension(1:kz,1:kz), intent(out)   :: eve
   8   real   , dimension(1:kz)     , intent(out)   :: val
   9
  10   integer  :: k1, k2
  11
  12 !
  13       call da_1d_eigendecomposition( covm, eve, val )
  14
  15       do k1 = 1, kz
  16         if ( val(k1) < 0.0 ) val(k1) = 0.0
  17       end do
  18
  19       do k1 = 1, kz
  20         do k2 = k1, kz
  21           covm(k1,k2) = SUM( eve(k1,:) * val(:) * eve(k2,:) )
  22         end do
  23       end do
  24
  25       do k1 = 2, kz
  26         do k2 = 1, k1-1
  27           covm(k1,k2) = covm(k2,k1)
  28         end do
  29       end do
  30
  31       call da_1d_eigendecomposition( covm, eve, val )
  32
  33       do k1 = 1, kz
  34         if ( val(k1) < 0.0 ) val(k1) = 0.0
  35       end do
  36 !
  37 end Subroutine da_gen_eigen