File: writeftm.f90

package info (click to toggle)
elkcode 5.4.24-2
  • links: PTS, VCS
  • area: main
  • in suites: buster, sid
  • size: 12,840 kB
  • sloc: f90: 48,415; fortran: 22,457; perl: 965; makefile: 384; sh: 369; python: 105; ansic: 67
file content (53 lines) | stat: -rw-r--r-- 1,593 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53

! Copyright (C) 2014 J. K. Dewhurst, S. Sharma and E. K. U. Gross.
! This file is distributed under the terms of the GNU General Public License.
! See the file COPYING for license details.

subroutine writeftm
use modmain
use moddftu
implicit none
! local variables
integer is,ia,ias,i
integer l,n,k,p,r,t,x,y
! allocatable arrays
complex(8), allocatable :: tm2(:,:),tm3(:)
allocate(tm2(-lmmaxdm:lmmaxdm,-1:1),tm3(-lmmaxdm:lmmaxdm))
! open FTM.OUT
open(50,file='FTM.OUT',form='FORMATTED')
do i=1,ntmfix
  is=itmfix(1,i)
  ia=itmfix(2,i)
  ias=idxas(ia,is)
  l=itmfix(3,i)
  n=itmfix(4,i)
  k=itmfix(5,i)
  p=itmfix(6,i)
  write(50,*)
  write(50,'("Species : ",I4," (",A,"), atom : ",I4)') is,trim(spsymb(is)),ia
  write(50,'(" l = ",I2,", n = ",I2)') l,n
  if (n.eq.2) then
    x=itmfix(7,i)
    y=itmfix(8,i)
    write(50,'(" k = ",I2,", p = ",I2,", x = ",I2,", y = ",I2)') k,p,x,y
! decompose density matrix in 2-index tensor moment components
    call dmtotm2(l,nspinor,k,p,lmmaxdm,dmatmt(:,:,:,:,ias),tm2)
    write(50,'(" tensor moment")')
    write(50,'("  current : ",2G18.10)') tm2(x,y)
    write(50,'("  target  : ",2G18.10)') tmfix(i)
  else
    r=itmfix(7,i)
    t=itmfix(8,i)
    write(50,'(" k = ",I2,", p = ",I2,", r = ",I2,", t = ",I2)') k,p,r,t
! decompose density matrix in 3-index tensor moment components
    call dmtotm3(l,nspinor,k,p,r,lmmaxdm,dmatmt(:,:,:,:,ias),tm3)
    write(50,'(" tensor moment")')
    write(50,'("  current : ",2G18.10)') tm3(t)
    write(50,'("  target  : ",2G18.10)') tmfix(i)
  end if
end do
close(50)
deallocate(tm2,tm3)
return
end subroutine