inpgen.f90 9.64 KB
Newer Older
1 2 3 4 5 6
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------

7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
PROGRAM inpgen
!----------------------------------------------------------------------------+
!   Set up a FLEUR inp-file from basic input data; for use and docu please   !
!   refer to inpgen.html (or see http://www.flapw.de/docs/inpgen.html)       !
!                                                                            |
!   The program is based on the input conventions of the FLAIR-code, so that !
!   some compatibility is ensured. The symmetry generator was written by     ! 
!   M.Weinert and implemented in the FLAIR-code by G.Schneider.              !
!                                                                    gb`02   |
!----------------------------------------------------------------------------+
      use m_juDFT
      USE m_structinput
      USE m_crystal
      USE m_socorssdw
      USE m_rwsymfile
      USE m_setinp
      USE m_writestruct
      USE m_xsf_io, ONLY : xsf_write_atoms
      USE m_types
26
      USE m_inpgen_help
27
      USE m_constants
28 29
      IMPLICIT NONE
    
30
      INTEGER natmax,nop48,nline,natin,ngen,i,j,bfh
31
      INTEGER nops,no3,no2,na,numSpecies,i_c,element
32
      INTEGER infh,errfh,warnfh,symfh,dbgfh,outfh,dispfh
33
      LOGICAL cal_symm,checkinp,newSpecies
34
      LOGICAL cartesian,oldfleur,l_hyb  ,inistop
35
      REAL    aa
36 37
 
      REAL a1(3),a2(3),a3(3),scale(3),factor(3)
38
      INTEGER              :: elementNumSpecies(0:104)
39 40 41 42 43
      INTEGER, ALLOCATABLE :: mmrot(:,:,:)
      REAL,    ALLOCATABLE :: ttr(:, :),atompos(:, :),atomid(:) 
      REAL,    ALLOCATABLE :: idlist(:)
      INTEGER, ALLOCATABLE ::  ntyrep(:)              ! these variables are allocated with
      INTEGER, ALLOCATABLE :: natype(:),natrep(:),natmap(:)  ! or  'nat'
44
      INTEGER, ALLOCATABLE :: speciesRepAtomType(:),atomTypeSpecies(:)
45 46 47 48 49 50 51
     
      INTEGER, PARAMETER :: xl_buffer=16384              ! maximum length of read record
      CHARACTER(len=xl_buffer) :: buffer

      CHARACTER(len=80):: title
      CHARACTER(len=7) :: symfn
      CHARACTER(len=4) :: dispfn
52
      CHARACTER(LEN=8) :: tempNumberString
53
      CHARACTER(len=20), ALLOCATABLE :: atomLabel(:)
54

55 56 57 58 59 60
      TYPE(t_input)    :: input
      TYPE(t_atoms)    :: atoms
      TYPE(t_cell)     :: cell
      TYPE(t_sym)      :: sym
      TYPE(t_noco)     :: noco
      TYPE(t_vacuum)   :: vacuum
61 62 63
      
      CALL inpgen_help()

64
      nop48 = 48
65
      natmax = 9999
66 67 68 69 70 71 72 73 74
      ngen = 0
      infh = 5
      errfh = 6 ; warnfh = 6 ; dbgfh = 6 ; outfh = 6
      symfh = 94
      symfn = 'sym    '
      dispfh = 97
      dispfn='disp'
      nline = 0

75 76
      bfh = 93

77 78
      input%l_inpXML = .TRUE.
   
79 80
      ALLOCATE ( mmrot(3,3,nop48), ttr(3,nop48) )
      ALLOCATE ( atompos(3,natmax),atomid(natmax) )
81 82
      ALLOCATE (atomLabel(natmax))
      atomLabel = ''
83 84 85

!      OPEN (5,file='inp2',form='formatted',status='old')
      OPEN (6,file='out',form='formatted',status='unknown')
86
      OPEN (bfh,file='bfh.txt',form='formatted',status='unknown')
87

88
      noco%l_ss = .FALSE.
89
      CALL struct_input(&
90
     &                  infh,errfh,warnfh,symfh,symfn,bfh,&
91 92 93
     &                  natmax,nop48,&
     &                  nline,xl_buffer,buffer,&
     &                  title,input%film,cal_symm,checkinp,sym%symor,&
94
     &                  cartesian,oldfleur,a1,a2,a3,vacuum%dvac,aa,scale,i_c,&
95
     &                 factor,natin,atomid,atompos,ngen,mmrot,ttr,atomLabel,&
96
     &                  l_hyb,noco%l_soc,noco%l_ss,noco%theta,noco%phi,noco%qss,inistop)!keep
97 98 99 100 101 102

!      CLOSE (5)

      IF (.not.input%film) vacuum%dvac=a3(3)
      WRITE (6,*)
      WRITE (6,*) title
103
      WRITE (6,*) 'film=',input%film,'cartesian=',cartesian
104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124
      WRITE (6,*) 'checkinp=',checkinp,'symor=',sym%symor
      WRITE (6,*)
      WRITE (6,'(a5,3f10.5)') 'a1 = ',a1(:)
      WRITE (6,'(a5,3f10.5)') 'a2 = ',a2(:)
      WRITE (6,'(a5,3f10.5)') 'a3 = ',a3(:)
      WRITE (6,*)
      WRITE (6,'(2(a5,f10.5))') 'dvac=',vacuum%dvac,' aa =',aa
      WRITE (6,'(a8,3f10.5)') 'scale = ',scale(:)
      WRITE (6,*)
      WRITE (6,'(a6,i3,a6,999i5)') 'natin=',natin,' Z = ',&
     &                             (nint(atomid(i)),i=1,abs(natin))
      WRITE (6,*) 'positions: '
      WRITE (6,'(3(3x,f10.5))') ((atompos(j,i),j=1,3),i=1,abs(natin))
      WRITE (6,*)
      WRITE (6,*) 'generators: ',ngen,'(excluding identity)'
      DO i = 2, ngen+1
         WRITE (6,*) i
         WRITE (6,'(3i5,f8.3)') (mmrot(1,j,i),j=1,3),ttr(1,i)
         WRITE (6,'(3i5,f8.3)') (mmrot(2,j,i),j=1,3),ttr(2,i)
         WRITE (6,'(3i5,f8.3)') (mmrot(3,j,i),j=1,3),ttr(3,i)
      ENDDO
125
      IF (noco%l_soc) WRITE(6,'(a4,2f10.5)') 'soc:',noco%theta,noco%phi
126 127 128 129 130 131 132 133
      IF (noco%l_ss)  WRITE(6,'(a4,3f10.5)') 'qss:',noco%qss(:)
!
! --> generate symmetry from input (atomic positions, generators or whatever)
!     
      CALL crystal(&
     &             dbgfh,errfh,outfh,dispfh,dispfn,&
     &             cal_symm,cartesian,sym%symor,input%film,&
     &             natin,natmax,nop48,&
134
     &             atomid,atompos,a1,a2,a3,aa,scale,i_c,&
135 136 137 138 139 140 141
     &             sym%invs,sym%zrfs,sym%invs2,sym%nop,sym%nop2,&
     &             ngen,mmrot,ttr,atoms%ntype,atoms%nat,nops,&
     &             atoms%neq,ntyrep,atoms%zatom,natype,natrep,natmap,&
     &             sym%mrot,sym%tau,atoms%pos,cell%amat,cell%bmat,cell%omtil)

      IF (noco%l_ss.OR.noco%l_soc)  THEN
         CALL soc_or_ssdw(&
142
     &                    noco%l_soc,noco%l_ss,noco%theta,noco%phi,noco%qss,cell%amat,&
143 144 145 146 147 148 149 150 151
     &                    sym%mrot,sym%tau,sym%nop,sym%nop2,atoms%nat,atomid,atompos,&
     &                    mmrot,ttr,no3,no2,atoms%ntype,atoms%neq,natmap,&
     &                    ntyrep,natype,natrep,atoms%zatom,atoms%pos)
         sym%nop = no3 ; sym%nop2 = no2
         sym%mrot(:,:,1:sym%nop) = mmrot(:,:,1:sym%nop)
         sym%tau(:,1:sym%nop) = ttr(:,1:sym%nop)
      ENDIF
      DEALLOCATE ( mmrot, ttr, atompos )

152 153
      ALLOCATE ( atoms%taual(3,atoms%nat),idlist(atoms%ntype) )
      ALLOCATE (atoms%label(atoms%nat))
154 155 156 157 158 159 160 161 162 163
      WRITE (6,*)
      WRITE (6,'(a6,i3,a6,i3)') 'atoms%ntype=',atoms%ntype,' atoms%nat= ',atoms%nat
      na = 0
      DO i = 1, atoms%ntype
        WRITE (6,'(a3,i3,a2,i3,a6,i3)') ' Z(',i,')=',nint(atoms%zatom(i)),&
     &                                             ' atoms%neq= ',atoms%neq(i)
        DO j = 1, atoms%neq(i)
           WRITE (6,'(3f10.6,10x,i7)')&
     &           atoms%pos(:,natmap(na+j)),natmap(na+j)
           atoms%taual(:,na+j) = atoms%pos(:,natmap(na+j))      ! reorder coordinates
164 165
           idlist(i)           = atomid(natmap(na+j))           ! and atomic id's
           atoms%label(na+j)      = atomLabel(natmap(na+j))        ! and labels
166 167 168 169 170 171
        ENDDO
        na = na + atoms%neq(i)
      ENDDO
      DO i=1,atoms%nat
        atoms%pos(:,i) = matmul( cell%amat , atoms%taual(:,i) )
      ENDDO
172
      DEALLOCATE(atomLabel)
173

174 175 176 177 178 179
!
! --> write a file 'sym.out' with accepted symmetry operations
!
      nops = sym%nop
      symfn = 'sym.out'
      IF (.not.input%film) sym%nop2=sym%nop
180
      IF ((.NOT.juDFT_was_argument("-explicit"))) THEN
181 182
         CALL rw_symfile('W',symfh,symfn,nops,cell%bmat,sym%mrot,sym%tau,sym%nop,sym%nop2,sym%symor)
      END IF
183

184 185
      ALLOCATE (atomTypeSpecies(atoms%ntype))
      ALLOCATE (speciesRepAtomType(atoms%nat))
186 187
      ALLOCATE (atoms%speciesName(atoms%nat))
      elementNumSpecies = 0
188 189 190
      numSpecies = 0
      speciesRepAtomType = -1
      atomTypeSpecies = -1
191
      atoms%speciesName = ''
192 193 194 195 196 197 198 199 200 201 202 203 204
      DO i = 1, atoms%nat
         newSpecies = .TRUE.
         DO j = 1, i-1
            IF(atomid(i).EQ.atomid(j)) THEN
               newSpecies = .FALSE.
               atomTypeSpecies(natype(i)) = atomTypeSpecies(natype(j))
               EXIT
            END IF
         END DO
         IF(newSpecies) THEN
            numSpecies = numSpecies + 1
            speciesRepAtomType(numSpecies) = natype(i)
            atomTypeSpecies(natype(i)) = numSpecies
205 206 207 208 209 210
            element = nint(atoms%zatom(natype(i)))
            elementNumSpecies(element) = elementNumSpecies(element) + 1
            tempNumberString = ''
            WRITE(tempNumberString,'(i0)') elementNumSpecies(element)
            atoms%speciesName(numSpecies) = &
               TRIM(ADJUSTL(namat_const(element))) // '-' // TRIM(ADJUSTL(tempNumberString))
211 212 213
         END IF
      END DO

214 215 216 217
!
! --> set defaults for FLEUR inp-file
!
      ALLOCATE ( atoms%rmt(atoms%ntype) )
218
      atoms%nlod=9  ! This fixed dimensioning might have to be made more dynamical!
219
      CALL set_inp(&
220
     &             infh,nline,xl_buffer,bfh,buffer,l_hyb,&
221 222
     &             atoms,sym,cell,title,idlist,&
     &             input,vacuum,noco,&
223
     &             atomTypeSpecies,speciesRepAtomType,numSpecies,&
224
     &             a1,a2,a3)
225

226
      DEALLOCATE (atoms%speciesName,atomTypeSpecies,speciesRepAtomType)
227 228
      DEALLOCATE ( ntyrep, natype, natrep, atomid )

229 230
      CLOSE(bfh,STATUS='delete')

231 232 233 234 235 236 237 238 239 240 241 242 243 244
!
! --> Structure in povray or xsf-format
!
      IF (.false.) THEN
         CALL write_struct(&
     &                  atoms%ntype,atoms%nat,atoms%neq,&
     &                  atoms%rmt,atoms%pos,natmap,cell%amat)!keep
      ELSE 
         OPEN (55,file="struct.xsf")
         CALL xsf_WRITE_atoms(&
     &                        55,atoms,input%film,.false.,cell%amat)
         CLOSE (55)
      ENDIF

245
      DEALLOCATE (vacuum%izlay)
246 247
      DEALLOCATE ( atoms%taual,sym%mrot,sym%tau,atoms%neq,atoms%zatom,atoms%rmt,natmap,atoms%pos,idlist )

248
      IF (inistop)  CALL juDFT_end("Symmetry done",1)
249 250

      END