inpgen.f90 9.76 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
      input%l_inpXML = .FALSE.
78 79 80
      IF (.NOT.juDFT_was_argument("-old")) THEN
         input%l_inpXML = .TRUE.
      END IF
81

82 83
      ALLOCATE ( mmrot(3,3,nop48), ttr(3,nop48) )
      ALLOCATE ( atompos(3,natmax),atomid(natmax) )
84 85
      ALLOCATE (atomLabel(natmax))
      atomLabel = ''
86 87 88

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

91 92
      noco%l_ss = .FALSE.

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

!      CLOSE (5)

      IF (.not.input%film) vacuum%dvac=a3(3)
      WRITE (6,*)
      WRITE (6,*) title
107
      WRITE (6,*) 'film=',input%film,'cartesian=',cartesian
108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137
      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
      IF (noco%l_soc) WRITE(6,'(a4,2f10.5)') 'soc:',noco%theta,noco%phi
      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,&
138
     &             atomid,atompos,a1,a2,a3,aa,scale,i_c,&
139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155
     &             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(&
     &                    noco%l_soc,noco%l_ss,noco%theta,noco%phi,noco%qss,cell%amat,&
     &                    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 )

156 157
      ALLOCATE ( atoms%taual(3,atoms%nat),idlist(atoms%ntype) )
      ALLOCATE (atoms%label(atoms%nat))
158 159 160 161 162 163 164 165 166 167
      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
168 169
           idlist(i)           = atomid(natmap(na+j))           ! and atomic id's
           atoms%label(na+j)      = atomLabel(natmap(na+j))        ! and labels
170 171 172 173 174 175
        ENDDO
        na = na + atoms%neq(i)
      ENDDO
      DO i=1,atoms%nat
        atoms%pos(:,i) = matmul( cell%amat , atoms%taual(:,i) )
      ENDDO
176
      DEALLOCATE(atomLabel)
177

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

188 189
      ALLOCATE (atomTypeSpecies(atoms%ntype))
      ALLOCATE (speciesRepAtomType(atoms%nat))
190 191
      ALLOCATE (atoms%speciesName(atoms%nat))
      elementNumSpecies = 0
192 193 194
      numSpecies = 0
      speciesRepAtomType = -1
      atomTypeSpecies = -1
195
      atoms%speciesName = ''
196 197 198 199 200 201 202 203 204 205 206 207 208
      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
209 210 211 212 213 214
            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))
215 216 217
         END IF
      END DO

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

230
      DEALLOCATE (atoms%speciesName,atomTypeSpecies,speciesRepAtomType)
231 232
      DEALLOCATE ( ntyrep, natype, natrep, atomid )

233 234
      CLOSE(bfh,STATUS='delete')

235 236 237 238 239 240 241 242 243 244 245 246 247 248
!
! --> 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

249
      DEALLOCATE (vacuum%izlay)
250 251
      DEALLOCATE ( atoms%taual,sym%mrot,sym%tau,atoms%neq,atoms%zatom,atoms%rmt,natmap,atoms%pos,idlist )

252
      IF (inistop)  CALL juDFT_end("Symmetry done",1)
253 254

      END