!***********************************************************************
! This file is part of OpenMolcas.                                     *
!                                                                      *
! OpenMolcas is free software; you can redistribute it and/or modify   *
! it under the terms of the GNU Lesser General Public License, v. 2.1. *
! OpenMolcas is distributed in the hope that it will be useful, but it *
! is provided "as is" and without any express or implied warranties.   *
! For more details see the full text of the license in the file        *
! LICENSE or in <http://www.gnu.org/licenses/>.                        *
!                                                                      *
! Copyright (C) 2019, Stefano Battaglia                                *
!***********************************************************************

subroutine Backtransform(Heff,Ueff,U0,nState)
! Back-transform Heff and Ueff to the basis of the original CASSCF states.

use caspt2_module, only: IFRMS, IFXMS
use stdalloc, only: mma_allocate, mma_deallocate
use Constants, only: Zero, One
use Definitions, only: wp, iwp

implicit none
integer(kind=iwp), intent(in) :: Nstate
real(kind=wp), intent(inout) :: Heff(Nstate,Nstate), Ueff(Nstate,Nstate)
real(kind=wp), intent(in) :: U0(Nstate,Nstate)
real(kind=wp), allocatable :: U0transpose(:,:), Utmp(:,:)

if (IFXMS .or. IFRMS) then

  ! First we need to back-transform the effective Hamiltonian in the
  ! basis of original CASSCF states by U0 * Heff * U0^T
  ! Note that in the case of a normal MS-CASPT2 this and the next step
  ! do not have any effect on Heff and Ueff
  call mma_allocate(U0transpose,Nstate,Nstate,Label='U0transpose')
  call trnsps(Nstate,Nstate,U0,U0transpose)
  call transmat(Heff,U0transpose,Nstate)
  call mma_deallocate(U0transpose)

  ! Compute transformation matrix that diagonalizes the effective
  ! Hamiltonian expressed in the basis of original CASSCF states,
  ! i.e. simply combine the two transf matrices: Ueff = U0 * Ueff
  call mma_allocate(Utmp,Nstate,Nstate,Label='Utmp')
  call dgemm_('N','N',Nstate,Nstate,Nstate,One,U0,Nstate,Ueff,Nstate,Zero,Utmp,Nstate)
  Ueff = Utmp
  call mma_deallocate(Utmp)

end if

end subroutine Backtransform
