File: spiralsc.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 (92 lines) | stat: -rw-r--r-- 2,432 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
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92

! Copyright (C) 2012 S. Sharma, J. K. Dewhurst 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 spiralsc

!****** check MPI

use modmain
use modmpi
use modstore
implicit none
! local variables
integer nq,iq,jq
real(8) q
! store original parameters
natoms_(:)=natoms(:)
avec_(:,:)=avec(:,:)
atposl_(:,:,:)=atposl(:,:,:)
bfcmt0_(:,:,:)=bfcmt0(:,:,:)
mommtfix_(:,:,:)=mommtfix(:,:,:)
autokpt_=autokpt
ngridk_(:)=ngridk
! initialise universal variables
call init0
! initialise q-point dependent variables
call init2
! store original parameters
atposc_(:,:,:)=atposc(:,:,:)
10 continue
call sstask(80,filext)
! if nothing more to do then restore input parameters and return
if (iqss.eq.0) then
  filext='.OUT'
  natoms(:)=natoms_(:)
  avec(:,:)=avec_(:,:)
  atposl(:,:,:)=atposl_(:,:,:)
  bfcmt0(:,:,:)=bfcmt0_(:,:,:)
  mommtfix(:,:,:)=mommtfix_(:,:,:)
  autokpt=autokpt_
  ngridk(:)=ngridk_(:)
  return
end if
! spiral dry run: just generate empty SS files
if (task.eq.352) goto 10
if (mp_mpi) then
  write(*,'("Info(spiralsc): working on ",A)') 'SS'//trim(filext)
end if
! determine k-point grid size from radkpt
autokpt=.true.
! generate the spin-spiral supercell
call genscss
! initialise or read the charge density and potentials from file
if (task.eq.350) then
  trdstate=.false.
else
  trdstate=.true.
end if
! run the ground-state calculation
call gndstate
if (mp_mpi) then
  write(80,'(I6,T20," : number of unit cells in supercell")') nscss
  write(80,'(G18.10,T20," : total energy per unit cell")') engytot/dble(nscss)
  write(80,*)
  write(80,'("q-point in lattice and Cartesian coordinates :")')
  write(80,'(3G18.10)') vql(:,iqss)
  write(80,'(3G18.10)') vqc(:,iqss)
  q=sqrt(vqc(1,iqss)**2+vqc(2,iqss)**2+vqc(3,iqss)**2)
  write(80,'(G18.10,T20," : length of q-vector")') q
  write(80,*)
  nq=nint(dble(nqptnr)*wqpt(iqss))
  write(80,'(I6,T20," : number of equivalent q-points")') nq
  write(80,'("Equivalent q-points in lattice and Cartesian coordinates :")')
  do iq=1,nqptnr
    jq=iqmap(ivq(1,iq),ivq(2,iq),ivq(3,iq))
    if (jq.eq.iqss) then
      write(80,'(3G18.10)') vql(:,iq)
      write(80,'(3G18.10)') vqc(:,iq)
      write(80,*)
    end if
  end do
  close(80)
! delete the eigenvector files
  call delevec
end if
! synchronise MPI processes
call mpi_barrier(mpicom,ierror)
goto 10
return
end subroutine