1#include "f_defs.h"
2
3!*************************************************************************
4Module MinimizeMod
5!*************************************************************************
6
7  use NormalizeMod,  only : SelfBandOrthogonalize, VecNormalize
8  use push_pop_m
9  implicit none
10
11  contains
12
13!*************************************************************************
14  Subroutine StDescentVec( eigenStates, minVec, iBand, kPoint )
15!*************************************************************************
16
17    use TypeMod, only : minVecT
18    use EigenStatesMod, only : eigenStatesT
19
20    integer, intent(in) :: iBand, kPoint
21    type(eigenStatesT), pointer :: eigenStates
22    type(minVecT), pointer :: minVec
23
24    PUSH_SUB(StDescentVec)
25
26    ! Evaluate the Steepest Descent direction for iBand
27    minVec%StDesc = - eigenStates%ePsi( : , kPoint ) + &
28         & eigenStates%eigenValues( iBand, kPoint)* &
29         & eigenStates%eigenVectors( :, iBand, kPoint )
30
31    POP_SUB(StDescentVec)
32  end Subroutine StDescentVec
33
34!*************************************************************************
35  Subroutine ConjDirection( eigenStates, minVec, oldVec, iBand, kPoint )
36!*************************************************************************
37
38    use SysParams, only : double
39    use TypeMod, only : minVecT
40    use EigenStatesMod, only : eigenStatesT
41
42    integer, intent(in) :: iBand, kPoint
43    type(eigenStatesT), pointer :: eigenStates
44    type(minVecT), pointer :: minVec,oldVec
45
46    real( double ) :: Gamma,numer,denom
47
48    PUSH_SUB(ConjDirection)
49
50    !   Calculate Gamma, the phi is adjusted such that in the first
51    ! iteration Gamma becomes inconsequential
52    numer = Dot_Product(( minVec%StDesc - oldVec%StDesc ), minVec%StDesc )
53    denom = Dot_Product(( minVec%StDesc - oldVec%StDesc ), oldVec%Phi )
54
55!   Gamma = 0.d0     ! This makes it the steepest descent method
56    Gamma = -numer / ( denom + 10.d-40 )
57
58    minVec%Phi = minVec%StDesc + Gamma * oldVec%Phi
59
60    ! Orthogonalize Phi against the state-vector of the same band 'iBand'
61    call SelfBandOrthogonalize( eigenStates, minVec%Phi, iBand, kPoint )
62
63    ! Normalize Phi
64    call VecNormalize( minVec%Phi )
65
66!    print *, 'Conjgdir:',minVec%Phi
67
68    ! Roll the current values into oldVec
69    oldVec%sine = minVec%sine
70    oldVec%cosine = minVec%cosine
71    oldVec%Phi = minVec%Phi
72    oldVec%EPhi = minVec%EPhi
73    oldVec%StDesc = minVec%StDesc
74
75    POP_SUB(ConjDirection)
76  end Subroutine ConjDirection
77
78end Module MinimizeMod
79