inpgen.f90 8.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
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
!
! --> write a file 'sym.out' with accepted symmetry operations
!
      nops = sym%nop
      symfn = 'sym.out'
      IF (.not.input%film) sym%nop2=sym%nop
165
166
167
      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
168

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