LCOV - code coverage report
Current view: top level - wannier - wann_wan90prep.F (source / functions) Hit Total Coverage
Test: FLEUR test coverage Lines: 129 261 49.4 %
Date: 2024-03-28 04:22:06 Functions: 2 2 100.0 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       3             : ! This file is part of FLEUR and available as free software under the conditions
       4             : ! of the MIT license as expressed in the LICENSE file in more detail.
       5             : !--------------------------------------------------------------------------------
       6             : 
       7             :       MODULE m_wann_wan90prep
       8             :       use m_juDFT
       9             :       USE m_types
      10             : c**********************************************************
      11             : c         prepares WF//spin12(jspin)//.win for
      12             : c         input to wannier90 and creates bkpts file
      13             : c                FF, September 2006
      14             : c**********************************************************
      15             :       CONTAINS
      16           1 :       SUBROUTINE wann_wan90prep(input,kpts,
      17           1 :      >      jspins,amat,bmat,natd,taual_inp,zatom,ntype,
      18           1 :      >      ntypd,neq,l_bzsym,film,l_ms,l_sgwf,l_socgwf,
      19             :      >      aux_latt_const,param_file,l_dim,wan90version)
      20             : 
      21             :       USE m_wann_postproc_setup
      22             :       USE m_wann_postproc_setup2
      23             :       USE m_wann_postproc_setup4
      24             :       USE m_wann_postproc_setup5
      25             :       use m_wann_get_mp
      26             :       use m_wann_get_kpts
      27             :       use m_wann_get_qpts
      28             :       use m_wann_gwf_tools, only : get_index_kq,get_shift,get_dimension
      29             :       use m_wann_gwf_auxbrav
      30             : 
      31             :       IMPLICIT NONE
      32             : 
      33             : 
      34             :       TYPE(t_input), INTENT(IN) :: input
      35             :       TYPE(t_kpts), INTENT(IN)  :: kpts
      36             :       integer,intent(in)  :: jspins
      37             :       integer,intent(in)  :: ntype
      38             :       integer,intent(in)  :: ntypd
      39             :       logical,intent(in)  :: l_bzsym
      40             :       logical,intent(in)  :: film
      41             :       real,intent(in)     :: amat(3,3),aux_latt_const
      42             :       real,intent(in)     :: bmat(3,3)
      43             :       integer,intent(in)  :: natd
      44             :       real,intent(in)     :: taual_inp(3,natd)
      45             :       real,intent(in)     :: zatom(ntype)
      46             :       integer,intent(in)  :: neq(ntypd)
      47             :      
      48             :       integer,intent(in)  :: wan90version
      49             : 
      50             : 
      51             :       character(len=20),intent(in) :: param_file
      52             : 
      53             :       real             :: scale,scale_q
      54           1 :       real             :: taual(3,natd)
      55             :       real             :: amat_ang(3,3)
      56             :       real             :: bmat_ang(3,3)
      57             :       integer          :: at,j,n,bb
      58             :       integer          :: nkpts,iter,len,num_wann,num_bands,nn,i
      59             :       integer          :: num(3),dim,jspin,num_iter,nntot
      60             :       real             :: weight,maxi,mini,increm,compare
      61           1 :       real,allocatable :: kpoints(:,:)
      62             :       logical          :: l_file
      63             :       character(len=1) :: spin12(2)
      64             :       data spin12/'1','2'/
      65             :       integer          :: nkptd,ikpt_help,ikpt,iqpt
      66             :       character*2      :: namat(0:103)
      67             :       real,parameter   :: bohr=0.5291772108
      68             :       character(len=2) :: spin012(0:2)
      69             :       data spin012/'  ', '.1', '.2'/
      70             :       character(len=6) :: filename
      71             : 
      72             : 
      73           1 :       real,allocatable :: qpoints(:,:)
      74             :       real             :: amat_ang_q(3,3),bmat_ang_q(3,3)
      75             :       real             :: amat_q(3,3),bmat_q(3,3)
      76           1 :       real             :: taual_q(3,natd)
      77             :       integer          :: nqpts=1,nqptd=1
      78             :       integer          :: numq(3)
      79             :       logical, intent(in) :: l_ms,l_sgwf,l_socgwf
      80             :       logical, intent(in) :: l_dim(3)
      81             :       character(len=20) :: win_filename
      82             : 
      83           1 :       real,allocatable :: kqpoints(:,:)
      84             :       integer          :: nkqpts,ikqpt
      85           1 :       integer,allocatable :: numkq(:)
      86           1 :       real,allocatable :: amat_kq(:,:),bmat_kq(:,:)
      87           1 :       real,allocatable :: taual_kq(:,:)
      88             :       real             :: tpi,dummy_omtil
      89             :       integer :: arr_len,shift(3)
      90             : 
      91             :       DATA namat/'va',' h','he','li','be',' b',' c',' n',' o',' f','ne',
      92             :      +     'na','mg','al','si',' p',' s','cl','ar',' k','ca','sc','ti',
      93             :      +     ' v','cr','mn','fe','co','ni','cu','zn','ga','ge','as','se',
      94             :      +     'br','kr','rb','sr',' y','zr','nb','mo','tc','ru','rh','pd',
      95             :      +     'ag','cd','in','sn','sb','te',' j','xe','cs','ba','la','ce',
      96             :      +     'pr','nd','pm','sm','eu','gd','tb','dy','ho','er','tm','yb',
      97             :      +     'lu','hf','ta',' w','re','os','ir','pt','au','hg','tl','pb',
      98             :      +     'bi','po','at','rn','fr','ra','ac','th','pa',' u','np','pu',
      99             :      +     'am','cm','bk','cf','es','fm','md','no','lw'/
     100           1 :       num_iter=100
     101             : 
     102           1 :       call timestart("wann_wan90prep")
     103             : 
     104           1 :       call get_dimension(l_dim,arr_len)
     105           1 :       call get_shift(l_dim,shift)
     106             : 
     107             : c**********************************************************
     108             : c     Read in kpoints from kpts/w90kpts file.
     109             : c**********************************************************
     110             :       call wann_get_kpts(input,kpts,
     111             :      >         l_bzsym,film,.false.,
     112           1 :      <         nkpts,kpoints)
     113           3 :       allocate(kpoints(3,nkpts))
     114             :       call wann_get_kpts(input,kpts,
     115             :      >         l_bzsym,film,.true.,
     116           1 :      <         nkpts,kpoints)
     117             : 
     118             : 
     119             : c**********************************************************
     120             : c     Read in qpoints from qpts file.
     121             : c**********************************************************
     122           1 :       IF(l_sgwf.or.l_socgwf)THEN
     123             :       call wann_get_qpts(
     124             :      >         .false.,.false.,.false.,
     125           0 :      <         nqpts,qpoints,param_file)
     126           0 :       allocate(qpoints(3,nqpts))
     127             :       call wann_get_qpts(
     128             :      >         .false.,.false.,.true.,
     129           0 :      <         nqpts,qpoints,param_file)
     130             :       ELSE
     131           1 :          allocate(qpoints(3,1))
     132           5 :          qpoints=0.
     133             :       ENDIF
     134             : c*********************************************************
     135             : c     Find out the structure of k-point set.
     136             : c*********************************************************
     137             :       call wann_get_mp(
     138             :      >         nkpts,kpoints,
     139           1 :      <         num)
     140             : 
     141             : 
     142           9 :       taual=taual_inp
     143           1 :       if(film)then
     144           0 :          do n=1,natd
     145           0 :            taual(1,n)=taual_inp(1,n)+0.5
     146           0 :            taual(2,n)=taual_inp(2,n)+0.5
     147             :          enddo
     148             :       elseif(film)then
     149             :          do n=1,natd
     150             :            taual(3,n)=taual_inp(3,n)+0.5
     151             :          enddo
     152             :       endif
     153             : 
     154             : c*********************************************************
     155             : c     Find out the structure of q-point set.
     156             : c*********************************************************
     157           1 :       IF(l_sgwf.or.l_socgwf)THEN
     158             :       call wann_get_mp(
     159             :      >         nqpts,qpoints,
     160           0 :      <         numq)
     161             :       ELSE
     162           4 :          numq=1
     163             :       ENDIF
     164             : 
     165             : c*******************************************************
     166             : c     Write information to WF//spin12(jspin)//.win
     167             : c*******************************************************
     168           1 :       if(l_ms) nqptd = nqpts
     169             : 
     170           2 :       do jspin=1,jspins
     171             : c        proj file provides num_wann and num_bands
     172           1 :          l_file=.false.
     173           2 :          do j=jspin,0,-1
     174           2 :            inquire(file=trim('proj'//spin012(j)),exist=l_file)
     175           2 :            if(l_file)then
     176           1 :              filename='proj'//spin012(j)
     177           1 :              exit
     178             :            endif
     179             :          enddo
     180           1 :          if(l_file)then
     181           1 :             open(712,file=trim(filename),form='formatted',status='old')
     182           1 :             rewind(712)
     183             :          else
     184             :             CALL juDFT_error("no proj/proj.1/proj.2",calledby
     185           0 :      +           ="wann_wan90prep")
     186             :          endif
     187           1 :          read(712,*)num_wann,num_bands
     188           1 :          close(712)
     189             : 
     190           3 :          do iqpt=1,nqptd
     191           1 :             win_filename = 'WF'//spin12(jspin)
     192           1 :             if(l_ms) then
     193           0 :               write(win_filename,'("WF",a1,"_",i4.4)')spin12(jspin),iqpt
     194             :             endif
     195             : 
     196             :             call wann_write_win(win_filename,film,num_wann,num_bands,
     197             :      >               num_iter,jspin,ntype,ntypd,natd,nkpts,neq,num,amat,
     198           2 :      >               kpoints,zatom,taual,namat,3)
     199             :          enddo
     200             : 
     201             :       enddo!jspin
     202             : 
     203          13 :       amat_ang=amat*bohr
     204          13 :       bmat_ang=bmat/bohr
     205             : 
     206             : c******************************************************
     207             : c     call wannier90 routines to get bkpts
     208             : c******************************************************
     209             : #ifdef CPP_WANN
     210           1 :       IF(wan90version.le.2)then !wanversion 1.1 and 1.2
     211             :         call wann_postproc_setup(
     212             :      >         natd,nkpts,kpoints,amat_ang,bmat_ang,
     213             :      >         num,num_bands,ntype,neq,
     214           0 :      >         zatom,taual,namat,win_filename,'bkpts')
     215             :           else !wanversion 2.0
     216             :         call wann_postproc_setup2(
     217             :      >         natd,nkpts,kpoints,amat_ang,bmat_ang,
     218             :      >         num,num_bands,ntype,neq,
     219           1 :      >         zatom,taual,namat,win_filename,'bkpts')
     220             :           endif
     221             : #else
     222             :       WRITE(*,*) 'The code is supposed to perform the Wannier setup'
     223             :       WRITE(*,*) 'but the Wannier90 library is not linked.'
     224             :       CALL juDFT_error("Wannier setup without Wannier90 library (1)",
     225             :      +                 calledby ="wann_wan90prep")
     226             : #endif
     227             : c******************************************************
     228             : c     call wannier90 routines to get bqpts
     229             : c******************************************************
     230           1 :       if(.not.(l_sgwf.or.l_socgwf)) goto 8765
     231             : 
     232             :       call wann_gwf_auxbrav(aux_latt_const,l_sgwf,l_socgwf,
     233           0 :      >                      amat_q,bmat_q,l_dim)
     234           0 :       amat_ang_q = amat_q*bohr
     235           0 :       bmat_ang_q = bmat_q/bohr
     236             : 
     237           0 :       if(l_sgwf.or.l_socgwf) then
     238           0 :          qpoints = qpoints/2.0
     239             :       endif
     240             : 
     241           0 :       taual_q=0.5
     242           0 :       if(l_dim(1))taual_q(1,:)=0.0
     243           0 :       if(l_dim(2))taual_q(2,:)=0.0
     244           0 :       if(l_dim(3))taual_q(3,:)=0.0
     245             : 
     246             :       call wann_write_win('WF1_q',film,num_wann,num_bands,
     247             :      >      num_iter,1,ntype,ntypd,natd,nqpts,neq,numq,amat_q,
     248           0 :      >      qpoints,zatom,taual_q,namat,3)
     249             : 
     250             : #ifdef CPP_WANN
     251           0 :       if(wan90version.le.2)then !wanversion 1.1 and 1.2
     252             :         call wann_postproc_setup(
     253             :      >         natd,nqpts,qpoints,amat_ang_q,bmat_ang_q,
     254             :      >         numq,num_bands,ntype,neq,
     255           0 :      >         zatom,taual_q,namat,'WF1_q','bqpts')
     256             :           else !wanversion 2.0
     257             :         call wann_postproc_setup2(
     258             :      >         natd,nqpts,qpoints,amat_ang_q,bmat_ang_q,
     259             :      >         numq,num_bands,ntype,neq,
     260           0 :      >         zatom,taual_q,namat,'WF1_q','bqpts')
     261             :           endif
     262             : #else
     263             :       WRITE(*,*) 'The code is supposed to perform the Wannier setup'
     264             :       WRITE(*,*) 'but the Wannier90 library is not linked.'
     265             :       CALL juDFT_error("Wannier setup without Wannier90 library (2)",
     266             :      +                 calledby ="wann_wan90prep")
     267             : #endif
     268             : 
     269             :       !bkqpts part below
     270           0 :       nkqpts = nqpts*nkpts
     271           0 :       allocate(kqpoints(arr_len,nkqpts))
     272           0 :       kqpoints = 0.
     273           0 :       do iqpt=1,nqpts
     274           0 :          do ikpt=1,nkpts
     275           0 :             ikqpt = get_index_kq(ikpt,iqpt,nkpts)
     276           0 :             kqpoints(1,ikqpt) = kpoints(1,ikpt)
     277           0 :             kqpoints(2,ikqpt) = kpoints(2,ikpt)
     278           0 :             kqpoints(3,ikqpt) = kpoints(3,ikpt)
     279           0 :             if(l_dim(1)) kqpoints(4+shift(1),ikqpt)=qpoints(1,iqpt)
     280           0 :             if(l_dim(2)) kqpoints(4+shift(2),ikqpt)=qpoints(2,iqpt)
     281           0 :             if(l_dim(3)) kqpoints(4+shift(3),ikqpt)=qpoints(3,iqpt)
     282             :          enddo
     283             :       enddo
     284             : 
     285           0 :       allocate(numkq(arr_len))
     286           0 :       allocate(taual_kq(arr_len,natd))
     287           0 :       allocate(amat_kq(arr_len,arr_len))
     288           0 :       allocate(bmat_kq(arr_len,arr_len))
     289             : 
     290           0 :       numkq(1)=num(1); numkq(2)=num(2); numkq(3)=num(3)
     291           0 :       if(l_dim(1))numkq(4+shift(1))=numq(1)
     292           0 :       if(l_dim(2))numkq(4+shift(2))=numq(2)
     293           0 :       if(l_dim(3))numkq(4+shift(3))=numq(3)
     294             : 
     295           0 :       taual_kq(1,:) = taual(1,:); taual_kq(2,:) = taual(2,:)
     296           0 :       taual_kq(3,:) = taual(3,:); taual_kq(4:arr_len,:) = 0.0!0.0
     297             : 
     298             :       ! set up amat_kq
     299           0 :       amat_kq = 0.0
     300           0 :       bmat_kq = 0.0
     301           0 :       amat_kq(1:3,1:3) = amat(1:3,1:3)
     302           0 :       bmat_kq(1:3,1:3) = bmat(1:3,1:3)
     303           0 :       if(l_dim(1)) amat_kq(4+shift(1),4+shift(1)) = amat_q(1,1)
     304           0 :       if(l_dim(1)) bmat_kq(4+shift(1),4+shift(1)) = bmat_q(1,1)
     305           0 :       if(l_dim(2)) amat_kq(4+shift(2),4+shift(2)) = amat_q(2,2)
     306           0 :       if(l_dim(2)) bmat_kq(4+shift(2),4+shift(2)) = bmat_q(2,2)
     307           0 :       if(l_dim(3)) amat_kq(4+shift(3),4+shift(3)) = amat_q(3,3)
     308           0 :       if(l_dim(3)) bmat_kq(4+shift(3),4+shift(3)) = bmat_q(3,3)
     309             : 
     310             :       call wann_write_win('WF1_gwf',film,num_wann,num_bands,
     311             :      >      0,1,ntype,ntypd,natd,nkqpts,neq,numkq,amat_kq,
     312           0 :      >      kqpoints,zatom,taual_kq,namat,arr_len)
     313             : 
     314             : 
     315           0 :       if(arr_len.eq.4) then
     316             : #ifdef CPP_WANN4
     317             :          call wann_postproc_setup4(
     318             :      >         natd,nkqpts,kqpoints,amat_kq*bohr,bmat_kq/bohr,
     319             :      >         numkq,num_bands,ntype,neq,
     320             :      >         zatom,taual_kq,namat,'WF1_gwf','bkqpts')
     321             : #else
     322           0 :       WRITE(*,*) 'The code is supposed to perform the Wannier-4 setup'
     323           0 :       WRITE(*,*) 'but the modified Wannier90-4 library is not linked.'
     324             :       CALL juDFT_error("Wannier-4 setup without Wannier90-4 library",
     325           0 :      +                 calledby ="wann_wan90prep")
     326             : #endif
     327           0 :       elseif(arr_len.eq.5) then
     328             : #ifdef CPP_WANN5
     329             :          call wann_postproc_setup5(
     330             :      >         natd,nkqpts,kqpoints,amat_kq*bohr,bmat_kq/bohr,
     331             :      >         numkq,num_bands,ntype,neq,
     332             :      >         zatom,taual_kq,namat,'WF1_gwf','bkqpts')
     333             : #else
     334           0 :       WRITE(*,*) 'The code is supposed to perform the Wannier-5 setup'
     335           0 :       WRITE(*,*) 'but the modified Wannier90-5 library is not linked.'
     336             :       CALL juDFT_error("Wannier-5 setup without Wannier90-5 library",
     337           0 :      +                 calledby ="wann_wan90prep")
     338             : #endif
     339             : !         call juDFT_error("arr_len.eq.5 not yet implemented",
     340             : !     >                  calledby='wann_wan90prep')
     341           0 :       elseif(arr_len.eq.6) then
     342             :          call juDFT_error("arr_len.eq.6 not yet implemented",
     343           0 :      >                  calledby='wann_wan90prep')
     344             :       else
     345             :          call juDFT_error("Dimension arr_len not recognized",
     346           0 :      >                  calledby='wann_wan90prep')
     347             :       endif
     348             : 
     349           0 :       deallocate(kqpoints)
     350           1 :       deallocate(amat_kq,bmat_kq,numkq,taual_kq)
     351             : 
     352             : 8765  continue
     353             : 
     354           1 :       deallocate(kpoints)
     355           1 :       deallocate(qpoints)
     356             : 
     357           1 :       call timestop("wann_wan90prep")
     358           1 :       END SUBROUTINE wann_wan90prep
     359             : 
     360             : 
     361           1 :       subroutine wann_write_win(win_filename,film,num_wann,num_bands,
     362           1 :      >               num_iter,jspin,ntype,ntypd,natd,nkpts,neq,num,amat,
     363           1 :      >               kpoints,zatom,taual,namat,rdim)
     364             :       implicit none
     365             :       character(len=*),intent(in) ::win_filename
     366             :       logical,intent(in) :: film
     367             :       integer,intent(in) :: num_wann,num_iter,num_bands
     368             :       integer,intent(in) :: rdim
     369             :       integer,intent(in) :: jspin,ntype,natd,nkpts,ntypd
     370             :       integer,intent(in) :: neq(ntypd),num(rdim)
     371             :       real,intent(in) :: amat(rdim,rdim),kpoints(rdim,nkpts)
     372             :       real,intent(in) :: zatom(ntype),taual(rdim,natd)
     373             :       character*2,intent(in) :: namat(0:103)
     374             : 
     375             :       integer :: dim,nn,iter,at,i,search_shells
     376             :       logical :: l_exist
     377             : 
     378           1 :       call timestart("wann_write_win")
     379           1 :          open(911,file=trim(win_filename)//'.win')
     380           1 :          write(911,*)"length_unit=Bohr"
     381           1 :          write(911,*)"num_wann=",num_wann
     382           1 :          write(911,*)"num_iter=",num_iter
     383           1 :          write(911,*)"num_bands=",num_bands
     384           1 :          write(911,*)"          "
     385             : 
     386           1 :          if(rdim.gt.3) then
     387           0 :             search_shells=200
     388           0 :             inquire(file='searchshells_inp',exist=l_exist)
     389           0 :             if(l_exist) then
     390           0 :              open(777,file='searchshells_inp')
     391           0 :              read(777,*)search_shells
     392           0 :              close(777)
     393           0 :              write(*,*)'search_shells=',search_shells
     394             :             endif
     395           0 :             inquire(file=trim(win_filename)//'.kshell',exist=l_exist)
     396           0 :             if(l_exist) then
     397           0 :              write(*,*)'found .kshell file; set devel_flag'
     398           0 :              write(911,*)'devel_flag=kmesh_degen'
     399             :             endif
     400           0 :             write(911,*)"!iprint=",5
     401           0 :             write(911,*)"search_shells=",search_shells
     402             :          else
     403           1 :             write(911,*)"search_shells=",200
     404             :          endif
     405             : 
     406           1 :          write(911,*)"!optional parameters for wannierization"
     407           1 :          write(911,*)"!num_cg_steps="
     408           1 :          write(911,*)"!trial_step="
     409           1 :          write(911,*)"!fixed_step="
     410           1 :          write(911,*)"!restart=wannierise"
     411           1 :          write(911,*)"         "
     412             : 
     413           1 :          if(num_bands.ne.num_wann)then
     414           0 :             write(911,*)"! optional parameters for disentangling"
     415           0 :             write(911,*)"!dis_win_min="
     416           0 :             write(911,*)"!dis_win_max="
     417           0 :             write(911,*)"!dis_froz_min="
     418           0 :             write(911,*)"!dis_froz_max="
     419           0 :             write(911,*)"dis_num_iter=10000"
     420           0 :             write(911,*)"!dis_mix_ratio="
     421           0 :             write(911,*)"!dis_conv_tol="
     422           0 :             write(911,*)"!dis_conv_window="
     423           0 :             write(911,*)"            "
     424             :          endif
     425             : 
     426           1 :          write(911,*)"! optional parameters for plotting"
     427           1 :          if(jspin.eq.1)then
     428           1 :             write(911,*)"spin=up"
     429             :          else
     430           0 :             write(911,*)"spin=down"
     431             :          endif
     432           1 :          write(911,*)"!restart=plot"
     433           1 :          write(911,*)"!wannier_plot=true"
     434           1 :          write(911,*)"!wannier_plot_supercell=3"
     435           1 :          write(911,*)"!bands_plot=true"
     436             : 
     437             : 
     438           1 :          write(911,*)"!fermi_surface_plot=true"
     439           1 :          write(911,*)"            "
     440             : 
     441           1 :          write(911,*)"!options for Hamiltonian in Wannier basis"
     442           1 :          write(911,*)"!HR_PLOT=true"
     443           1 :          write(911,*)"!DIST_CUTOFF=3.0"
     444           1 :          write(911,*)"           "
     445             : 
     446           1 :          write(911,*)"!some more options"
     447           1 :          write(911,*)"!WRITE_R2MN=true"
     448           1 :          write(911,*)"!NUM_PRINT_CYCLES=10"
     449             : 
     450           1 :          write(911,*)"begin unit_cell_cart"
     451           1 :          write(911,*)"bohr"
     452           1 :          if(rdim.eq.3) then
     453           4 :             do dim=1,3
     454           4 :                write(911,*)amat(:,dim)
     455             :             enddo
     456           0 :          elseif(rdim.eq.4)then
     457           0 :             do dim=1,4
     458           0 :                write(911,'(4f14.8)')amat(:,dim)
     459             :             enddo
     460           0 :          elseif(rdim.eq.5)then
     461           0 :             do dim=1,5
     462           0 :                write(911,'(5f14.8)')amat(:,dim)
     463             :             enddo
     464           0 :          elseif(rdim.eq.6)then
     465           0 :             do dim=1,6
     466           0 :                write(911,'(6f13.7)')amat(:,dim)
     467             :             enddo
     468             :          endif
     469           1 :          write(911,*)"end unit_cell_cart"
     470           1 :          write(911,*)
     471             : 
     472           1 :          write(911,*)"begin atoms_frac"
     473           1 :          if(film)then
     474           0 :            write(911,*)!for reasons of plotting: shift the
     475           0 :            write(911,*)!coordinates in the 1d and 2d case
     476             :          endif
     477             :          nn=0
     478           2 :          do iter=1,ntype
     479           1 :             at=nint(zatom(iter))
     480           4 :             do i=1,neq(iter)
     481           2 :                nn=nn+1
     482           2 :              if(rdim.eq.3) write(911,*)namat(at),taual(:,nn)
     483           2 :              if(rdim.eq.4) write(911,'(1x,a2,2x,4f12.6)')
     484           0 :      >                     namat(at),taual(:,nn)
     485           2 :              if(rdim.eq.5) write(911,'(1x,a2,2x,5f12.6)')
     486           0 :      >                     namat(at),taual(:,nn)
     487           2 :              if(rdim.eq.6) write(911,'(1x,a2,2x,6f12.6)')
     488           1 :      >                     namat(at),taual(:,nn)
     489             :             enddo
     490             :          enddo
     491           1 :          write(911,*)"end atoms_frac"
     492           1 :          write(911,*)
     493             : 
     494           1 :          if(rdim.eq.3) write(911,*)"mp_grid",(num(dim),dim=1,3)
     495           1 :          if(rdim.eq.4) write(911,'(1x,a7,2x,4(i4,1x))')
     496           0 :      >                 "mp_grid",(num(dim),dim=1,4)
     497           1 :          if(rdim.eq.5) write(911,'(1x,a7,2x,5(i4,1x))')
     498           0 :      >                 "mp_grid",(num(dim),dim=1,5)
     499           1 :          if(rdim.eq.6) write(911,'(1x,a7,2x,6(i4,1x))')
     500           0 :      >                 "mp_grid",(num(dim),dim=1,6)
     501           1 :          write(911,*)
     502             : 
     503           1 :          write(911,*)"begin kpoints"
     504           1 :          if(rdim.eq.3) then
     505           9 :             do iter=1,nkpts
     506           9 :                write(911,*)kpoints(:,iter)
     507             :             enddo
     508           0 :          elseif(rdim.eq.4)then
     509           0 :             do iter=1,nkpts
     510           0 :                write(911,'(4f19.15)')kpoints(:,iter)
     511             :             enddo
     512           0 :          elseif(rdim.eq.5)then
     513           0 :             do iter=1,nkpts
     514           0 :                write(911,'(5f15.11)')kpoints(:,iter)
     515             :             enddo
     516           0 :          elseif(rdim.eq.6)then
     517           0 :             do iter=1,nkpts
     518           0 :                write(911,'(6f13.9)')kpoints(:,iter)
     519             :             enddo
     520             :          endif
     521           1 :          write(911,*)"end kpoints"
     522           1 :          write(911,*)
     523             : 
     524           1 :          write(911,*)"!begin kpoint_path"
     525           1 :          if(rdim.eq.3) then
     526           1 :             write(911,*)"!X -0.5   0.0   0.0   G  0.0   0.0   0.0"
     527           1 :             write(911,*)"!G  0.0   0.0   0.0   X  0.5   0.0   0.0"
     528           0 :          elseif(rdim.eq.4) then
     529           0 :             write(911,*)"!X  0.0   0.0  -0.5   0.0    ",
     530           0 :      >                   "G  0.0   0.0   0.0   0.0"
     531           0 :             write(911,*)"!G  0.0   0.0   0.0   0.0    ",
     532           0 :      >                   "X  0.0   0.0   0.5   0.0"
     533           0 :          elseif(rdim.eq.5) then
     534           0 :             write(911,*)"!X  0.0  0.0 -0.5  0.0  0.0   ",
     535           0 :      >                   "G  0.0  0.0  0.0  0.0  0.0"
     536           0 :             write(911,*)"!G  0.0  0.0  0.0  0.0  0.0   ",
     537           0 :      >                   "X  0.0  0.0  0.5  0.0  0.0"
     538           0 :          elseif(rdim.eq.6) then
     539           0 :             write(911,*)"!X  0.0  0.0 -0.5  0.0  0.0  0.0   ",
     540           0 :      >                   "G  0.0  0.0  0.0  0.0  0.0  0.0"
     541           0 :             write(911,*)"!G  0.0  0.0  0.0  0.0  0.0  0.0   ",
     542           0 :      >                   "X  0.0  0.0  0.5  0.0  0.0  0.0"
     543             :          endif
     544           1 :          write(911,*)"!end kpoint_path"
     545           1 :          write(911,*)
     546             : 
     547           1 :          write(911,*)"wvfn_formatted=.true."
     548             : 
     549           1 :          close(911)
     550             : 
     551           1 :          call timestop("wann_write_win")
     552           1 :       end subroutine wann_write_win
     553             : 
     554             : 
     555             :       END MODULE m_wann_wan90prep

Generated by: LCOV version 1.14