inpgen.f90 8.59 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 26 27 28
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
      IMPLICIT NONE
    
      INTEGER natmax,nop48,nline,natin,ngen,i,j
29
      INTEGER nops,no3,no2,na,numSpecies,i_c
30
      INTEGER infh,errfh,bfh,warnfh,symfh,dbgfh,outfh,dispfh
31
      LOGICAL cal_symm,checkinp,newSpecies
32
      LOGICAL cartesian,oldfleur,l_hyb  ,inistop
33
      REAL    aa
34 35 36 37 38 39 40
 
      REAL a1(3),a2(3),a3(3),scale(3),factor(3)
      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'
41
      INTEGER, ALLOCATABLE :: speciesRepAtomType(:),atomTypeSpecies(:)
42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57
     
      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

            TYPE(t_input)    :: input
          TYPE(t_atoms)    :: atoms
          TYPE(t_cell)     :: cell
          TYPE(t_sym)      :: sym
          TYPE(t_noco)     :: noco
          TYPE(t_vacuum)   :: vacuum
       
      nop48 = 48
58
      natmax = 9999
59 60 61 62 63 64 65 66 67 68
      ngen = 0
      infh = 5
      errfh = 6 ; warnfh = 6 ; dbgfh = 6 ; outfh = 6
      bfh = 93
      symfh = 94
      symfn = 'sym    '
      dispfh = 97
      dispfn='disp'
      nline = 0

69
      input%l_inpXML = .FALSE. 
70

71 72 73 74 75 76 77 78 79 80 81
      ALLOCATE ( mmrot(3,3,nop48), ttr(3,nop48) )
      ALLOCATE ( atompos(3,natmax),atomid(natmax) )

!      OPEN (5,file='inp2',form='formatted',status='old')
      OPEN (6,file='out',form='formatted',status='unknown')

      CALL struct_input(&
     &                  infh,errfh,bfh,warnfh,symfh,symfn,&
     &                  natmax,nop48,&
     &                  nline,xl_buffer,buffer,&
     &                  title,input%film,cal_symm,checkinp,sym%symor,&
82
     &                  cartesian,oldfleur,a1,a2,a3,vacuum%dvac,aa,scale,i_c,&
83 84 85 86 87 88 89 90
     &                 factor,natin,atomid,atompos,ngen,mmrot,ttr,&
     &                  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
91
      WRITE (6,*) 'film=',input%film,'cartesian=',cartesian
92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121
      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,&
122
     &             atomid,atompos,a1,a2,a3,aa,scale,i_c,&
123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157
     &             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 )

      ALLOCATE ( atoms%taual(3,atoms%nat),idlist(atoms%ntype) ) 
      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
           idlist(i)    = atomid(natmap(na+j))      !     and atomic id's
        ENDDO
        na = na + atoms%neq(i)
      ENDDO
      DO i=1,atoms%nat
        atoms%pos(:,i) = matmul( cell%amat , atoms%taual(:,i) )
      ENDDO
158

159 160 161 162 163 164 165 166 167 168
!
! --> write a file 'sym.out' with accepted symmetry operations
!
      nops = sym%nop
      symfn = 'sym.out'
      IF (.not.input%film) sym%nop2=sym%nop
      CALL rw_symfile(&
     &                'W',symfh,symfn,nops,cell%bmat,&
     &                 sym%mrot,sym%tau,sym%nop,sym%nop2,sym%symor)

169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189
      ALLOCATE (atomTypeSpecies(atoms%ntype))
      ALLOCATE (speciesRepAtomType(atoms%nat))
      numSpecies = 0
      speciesRepAtomType = -1
      atomTypeSpecies = -1
      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
         END IF
      END DO

190 191 192 193
!
! --> set defaults for FLEUR inp-file
!
      ALLOCATE ( atoms%rmt(atoms%ntype) )
194
      atoms%nlod=9  ! This fixed dimensioning might have to be made more dynamical!
195 196 197 198
      CALL set_inp(&
     &             infh,nline,xl_buffer,buffer,l_hyb,&
     &             atoms,sym,cell,title,idlist,&
     &             input,vacuum,noco,&
199
     &             atomTypeSpecies,speciesRepAtomType,&
200
     &             a1,a2,a3)
201 202 203 204

      DEALLOCATE (atomTypeSpecies,speciesRepAtomType)
      DEALLOCATE ( ntyrep, natype, natrep, atomid )

205 206 207 208 209 210 211 212 213 214 215 216 217 218
!
! --> 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

219
      DEALLOCATE (vacuum%izlay)
220 221
      DEALLOCATE ( atoms%taual,sym%mrot,sym%tau,atoms%neq,atoms%zatom,atoms%rmt,natmap,atoms%pos,idlist )

222
      IF (inistop)  CALL juDFT_end("Symmetry done",1)
223 224

      END