← Back to branch summary

~siesta-ts/siesta/trunk_ts_soc

« back to all changes in this revision

Viewing changes to Util/TS/TBtrans/m_tbt_proj.F90

  • Committer: Nils Wittemeier
  • Date: 2019-02-14 07:45:07 UTC
  • mfrom: (746.1.15 trunk)
  • Revision ID: nils@4wittemeier.de-20190214074507-1mvzbmj9kw19gllr
Merged trunk 761

Show diffs side-by-side

added added

removed removed

Lines of Context:
Util/TS/TBtrans/m_tbt_proj.F90
1
1
! ---
2
 
! Copyright (C) 1996-2016       The SIESTA group
 
2
! Copyright (C) 1996-2016       The SIESTA group
3
3
!  This file is distributed under the terms of the
4
4
!  GNU General Public License: see COPYING in the top directory
5
5
!  or http://www.gnu.org/copyleft/gpl.txt .
2143
2143
                  ' <i|i> = ',rS_sq(i,i)
2144
2144
            end do
2145
2145
          else
2146
 
            call zgemm('C','N',no,no,no,dcmplx(1._dp,0._dp), &
 
2146
            call zgemm('C','N',no,no,no,cmplx(1._dp,0._dp,dp), &
2147
2147
                zv,no,zv,no, &
2148
 
                dcmplx(0._dp,0._dp), zS_sq, no)
 
2148
                cmplx(0._dp,0._dp,dp), zS_sq, no)
2149
2149
            ! Print the norm and the diagonal element
2150
2150
            do i = 1 , no
2151
2151
              zn = VNORM(zS_sq(:,i))
2172
2172
            zS_sq = 0._dp
2173
2173
            ! Print the norm and the diagonal element
2174
2174
            do i = 1 , no
2175
 
              call zgerc(no,no,dcmplx(1._dp,0._dp),zv(1,i),1,zv(1,i),1, &
 
2175
              call zgerc(no,no,cmplx(1._dp,0._dp,dp),zv(1,i),1,zv(1,i),1, &
2176
2176
                  zS_sq(1,1),no)
2177
2177
            end do
2178
2178
            do i = 1 , no
2714
2714
        ! Read in from Gamma file
2715
2715
        allocate(rp(no,mols(im)%lvls%n))
2716
2716
        call ncdf_get_var(grp,'state',rp)
2717
 
        mols(im)%p = rp
 
2717
        mols(im)%p(:,:) = rp
2718
2718
        deallocate(rp)
2719
2719
      else
2720
2720
        call ncdf_get_var(grp,'state',mols(im)%p,start=(/1,1,ikpt/))
2862
2862
      do i = 1 , mols(im)%orb%n
2863
2863
        
2864
2864
        ! Initialize |><| value
2865
 
        zD(i,:) = dcmplx(0._dp,0._dp)
2866
 
        zP(i,:) = dcmplx(0._dp,0._dp)
 
2865
        zD(i,:) = cmplx(0._dp,0._dp,dp)
 
2866
        zP(i,:) = cmplx(0._dp,0._dp,dp)
2867
2867
        io = mols(im)%orb%r(i)
2868
2868
        lio = index_global_to_local(dit,io)
2869
2869
 
2873
2873
          if ( j == 0 ) cycle
2874
2874
          ! this is per level in the system
2875
2875
          do ip = 1 , Npl
2876
 
            zD(i,ip) = zD(i,ip) + dconjg(mols(im)%p(j,poff+ip)) * M(ind)
 
2876
            zD(i,ip) = zD(i,ip) + conjg(mols(im)%p(j,poff+ip)) * M(ind)
2877
2877
          end do
2878
2878
          ! this is per projection calculating |\sum>_i<\sum| M
2879
2879
          j = ((i-1)*Nsl+ip-1)*no+j
3036
3036
 
3037
3037
        ! In the code bGk is _without_ factor "i".
3038
3038
        ! Hence, we here add factor i
3039
 
        proj_ME(iE)%bGk = proj_ME(iE)%bGk * dcmplx(0._dp, 1._dp)
 
3039
        proj_ME(iE)%bGk = proj_ME(iE)%bGk * cmplx(0._dp, 1._dp, dp)
3040
3040
 
3041
3041
        ! ALL nodes _have_ to participate
3042
3042
        call ncdf_put_var(gmol,ctmp,proj_ME(iE)%bGk, &
3043
3043
            start = idx, count=cnt )
3044
3044
 
3045
3045
        ! and back
3046
 
        proj_ME(iE)%bGk = proj_ME(iE)%bGk * dcmplx(0._dp, -1._dp)
 
3046
        proj_ME(iE)%bGk = proj_ME(iE)%bGk * cmplx(0._dp, -1._dp, dp)
3047
3047
 
3048
3048
      end do
3049
3049
 
3080
3080
        if ( nE%iE(Node) > 0 ) then
3081
3081
          ! In the code bGk is _without_ factor "i".
3082
3082
          ! Hence, we here add factor i
3083
 
          proj_ME(iE)%bGk = proj_ME(iE)%bGk * dcmplx(0._dp, 1._dp)
 
3083
          proj_ME(iE)%bGk = proj_ME(iE)%bGk * cmplx(0._dp, 1._dp, dp)
3084
3084
          call ncdf_put_var(gmol,ctmp,proj_ME(iE)%bGk, &
3085
3085
              start = (/1,1,nE%iE(Node),ikpt/) )
3086
 
          proj_ME(iE)%bGk = proj_ME(iE)%bGk * dcmplx(0._dp, -1._dp)
 
3086
          proj_ME(iE)%bGk = proj_ME(iE)%bGk * cmplx(0._dp, -1._dp, dp)
3087
3087
        end if
3088
3088
#ifdef MPI
3089
3089
        if ( Node == 0 ) then
3091
3091
            if ( nE%iE(iN) <= 0 ) cycle
3092
3092
            call MPI_Recv(tmp,nl*nl,Mpi_double_complex, &
3093
3093
                iN, iN, Mpi_comm_world,status,MPIerror)
3094
 
            tmp = tmp * dcmplx(0._dp, 1._dp)
 
3094
            tmp = tmp * cmplx(0._dp, 1._dp, dp)
3095
3095
            call ncdf_put_var(gmol,ctmp,reshape(tmp,(/nl,nl/)), &
3096
3096
                start = (/1,1,nE%iE(iN),ikpt/) )
3097
3097
          end do
3148
3148
    do j = 1 , mol%proj(ip)%n
3149
3149
      gj = mol%proj(ip)%r(j)
3150
3150
 
3151
 
      p(:) = dcmplx(0._dp,0._dp)
 
3151
      p(:) = cmplx(0._dp,0._dp,dp)
3152
3152
      do i = 1 , mol%proj(ip)%n
3153
3153
        gi = mol%proj(ip)%r(i)
3154
3154
        ! Create summation |i> . <i|Gam|j>
3157
3157
 
3158
3158
      ! Do last product |i> . <i|Gam|j> . <j|
3159
3159
      ! and take the transpose
3160
 
      tmp(:) = dconjg(mol%p(:,gj))
 
3160
      tmp(:) = conjg(mol%p(:,gj))
3161
3161
      if ( j == 1 ) then
3162
3162
        do i = 1 , mol%orb%n
3163
3163
          Mt(:,i) = p(i) * tmp(:)
3203
3203
 
3204
3204
      ! Note that Mt is a transposed matrix, hence we need to 
3205
3205
      ! transpose back
3206
 
      call zgemv('T',orb%n,orb%n,dcmplx(1._dp,0._dp),Mt(1,1),orb%n, &
3207
 
          pl,1,dcmplx(0._dp,0._dp),tmp,1)
 
3206
      call zgemv('T',orb%n,orb%n,cmplx(1._dp,0._dp,dp),Mt(1,1),orb%n, &
 
3207
          pl,1,cmplx(0._dp,0._dp,dp),tmp,1)
3208
3208
 
3209
3209
      ! <i|
3210
3210
      do i = 1 , mol%lvls%n
3227
3227
    
3228
3228
    integer :: ip, i
3229
3229
 
3230
 
    p(:) = dcmplx(0._dp,0._dp)
 
3230
    p(:) = cmplx(0._dp,0._dp,dp)
3231
3231
    do ip = 1 , proj%n
3232
3232
      i = proj%r(ip)
3233
3233
      !         add |ip>_j <ip|
3234
 
      p(:) = p(:) + mol%p(j,i) * dconjg(mol%p(:,i))
 
3234
      p(:) = p(:) + mol%p(j,i) * conjg(mol%p(:,i))
3235
3235
    end do
3236
3236
    
3237
3237
  end subroutine proj_state_bra