geo.f90 11.3 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
MODULE m_geo
  USE m_juDFT
CONTAINS
10
11
  SUBROUTINE geo(atoms,sym,cell,oneD,vacuum,input_in,tote,&
                 forcetot)
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40

    !    *********************************************************************
    !    * calculates the NEW atomic positions after the results%force calculation   *
    !    * SUBROUTINE is based on a BFGS method implemented by jij%M. Weinert    *
    !    *                                [cf. PRB 52 (9) p. 6313 (1995)]    * 
    !    *                                                                   *
    !    * as a first step we READ in the file 'inp' WITH some additional    *
    !    * information (SUBROUTINE rw_inp)                                   *
    !    * THEN recover the old geometry optimisation information from file  *
    !    * 'forces.dat' (SUBROUTINE bfsg0)                                   *
    !    * this input together WITH the NEW forces (forcetot) are now used   *
    !    * to calculate the NEW atomic positions (SUBROUTINE bfsg)           *
    !    * finally the NEW 'inp' file is written (SUBROUTINE rw_inp)         *
    !    *                                                           Gustav  *
    !
    ! input: 
    !        ntype .... total number of atom types
    !        thetad ... approx. debye temperature
    !        zat(ntype) mass number of the atom (or atomic number)
    !        xa ....... mixing factor 
    !        epsdisp .. limit for displacement to be converged
    !        epsforce . the same for force
    !        istepnow . steps to be done in this run
    !
    !    *********************************************************************
    USE m_rwinp
    USE m_bfgs
    USE m_bfgs0
    USE m_types
41
    USE m_constants
42
43
    USE m_rinpXML
    USE m_winpXML
44
45
46
47
48
    IMPLICIT NONE
    TYPE(t_oneD),INTENT(IN)   :: oneD
    TYPE(t_cell),INTENT(IN)   :: cell
    TYPE(t_sym),INTENT(IN)    :: sym
    TYPE(t_atoms),INTENT(IN)  :: atoms
49
50
    TYPE(t_vacuum),INTENT(IN) :: vacuum
    TYPE(t_input),INTENT(IN)  :: input_in
51
52
53
54
55
    ! ..
    ! ..  Scalar Arguments ..
    REAL,    INTENT (IN) :: tote
    ! ..
    ! ..  Array Arguments ..
Daniel Wortmann's avatar
Daniel Wortmann committed
56
    REAL,    INTENT (INOUT) :: forcetot(3,atoms%ntype)
57
58
59
    ! ..
    ! ..  Local Scalars ..
    INTEGER i,j,na ,istep0,istep,itype,jop,ieq
60
    LOGICAL lconv
61
62
63
    TYPE(t_atoms)  :: atoms_new
    ! ..
    ! ..  Local Arrays ..
Daniel Wortmann's avatar
Daniel Wortmann committed
64
65
    REAL xold(3*atoms%ntype),y(3*atoms%ntype),h(3*atoms%ntype,3*atoms%ntype),zat(atoms%ntype)
    REAL tau0(3,atoms%ntype),tau0_i(3,atoms%ntype) 
66
67
68

    TYPE(t_input):: input

69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
    ! temporary variables for XML IO
    TYPE(t_input)                 :: input_temp
    TYPE(t_dimension)             :: dimension_temp
    TYPE(t_atoms)                 :: atoms_temp
    TYPE(t_cell)                  :: cell_temp
    TYPE(t_stars)                 :: stars_temp
    TYPE(t_sym)                   :: sym_temp
    TYPE(t_noco)                  :: noco_temp
    TYPE(t_vacuum)                :: vacuum_temp
    TYPE(t_sliceplot)             :: sliceplot_temp
    TYPE(t_banddos)               :: banddos_temp
    TYPE(t_obsolete)              :: obsolete_temp
    TYPE(t_enpara)                :: enpara_temp
    TYPE(t_xcpot)                 :: xcpot_temp
    TYPE(t_results)               :: results_temp
    TYPE(t_jij)                   :: jij_temp
    TYPE(t_kpts)                  :: kpts_temp
    TYPE(t_hybrid)                :: hybrid_temp
    TYPE(t_oneD)                  :: oneD_temp
88
    TYPE(t_wann)                  :: wann_temp
Daniel Wortmann's avatar
Daniel Wortmann committed
89
    LOGICAL                       :: l_kpts_temp, l_gga_temp
90
91
92
93
94
95
96
97
98
99
100
101
102
103
    INTEGER                       :: numSpecies
    INTEGER                       :: div(3)
    INTEGER, ALLOCATABLE          :: xmlElectronStates(:,:)
    INTEGER, ALLOCATABLE          :: atomTypeSpecies(:)
    INTEGER, ALLOCATABLE          :: speciesRepAtomType(:)
    REAL, ALLOCATABLE             :: xmlCoreOccs(:,:,:)
    LOGICAL, ALLOCATABLE          :: xmlPrintCoreStates(:,:)
    CHARACTER(len=3), ALLOCATABLE :: noel_temp(:)
    CHARACTER(len=4)              :: namex_temp
    CHARACTER(len=12)             :: relcor_temp
    CHARACTER(LEN=20)             :: filename
    REAL                          :: a1_temp(3),a2_temp(3),a3_temp(3)
    REAL                          :: scale_temp, dtild_temp

104
    input=input_in
105
106
    atoms_new=atoms

107
108
109
110
111
    istep0 = 0
    xold = 0.0
    y = 0.0
    h= 0.0

112
113
    na = 1
    DO i = 1,atoms_new%ntype
114
       zat(i)=real(atoms%nz(i))
115
       tau0(:,i)=atoms%pos(:,na)
116
117
       na = na + atoms_new%neq(i)
    END DO
118

119
    CALL bfgs0(atoms%ntype, istep0,xold,y,h)
120
121
122

    DO itype=1,atoms%ntype
       IF (atoms%l_geo(itype)) THEN
123
          WRITE (6,'(6f10.5)') (tau0(j,itype),j=1,3), (forcetot(i,itype),i=1,3)
124
125
126
127
          DO i = 1,3
             forcetot(i,itype)=forcetot(i,itype)*REAL(atoms%relax(i,itype))
          ENDDO
          WRITE (6,'(6f10.5,a,3i2)') (tau0(j,itype),j=1,3),&
128
               &     (forcetot(i,itype),i=1,3),' atoms%relax: ', (atoms%relax(i,itype),i=1,3)
129
130
131
132
133
134
135
136
       ELSE
          DO i = 1,3
             forcetot(i,itype)=0.0
          ENDDO
       ENDIF
    ENDDO

    istep = 1
137
    CALL bfgs(atoms%ntype,istep,istep0,forcetot,&
138
         &          zat,input%xa,input%thetad,input%epsdisp,input%epsforce,tote,&
139
         &          xold,y,h,tau0, lconv)
140

141
142
    IF (lconv) THEN
       WRITE (6,'(a)') "Des woars!"
143
       CALL juDFT_end(" GEO Des woars ", 0) ! The 0 is temporarily. Should be mpi%irank.
144
145
146
    ELSE
       na = 0
       DO itype=1,atoms%ntype
147
          tau0_i(:,itype)=MATMUL(cell%bmat,tau0(:,itype))/tpi_const
148
149
150
151
152
153
154
155
          DO ieq = 1,atoms%neq(itype)
             na = na + 1
             jop = sym%invtab(atoms%ngopr(na))
             IF (oneD%odi%d1) jop = oneD%ods%ngopr(na)
             DO i = 1,3
                atoms_new%taual(i,na) = 0.0
                DO j = 1,3
                   IF (.NOT.oneD%odi%d1) THEN
156
                      atoms_new%taual(i,na) = atoms_new%taual(i,na) + sym%mrot(i,j,jop) * tau0_i(j,itype)
157
                   ELSE
158
                      atoms_new%taual(i,na) = atoms_new%taual(i,na) + oneD%ods%mrot(i,j,jop) * tau0_i(j,itype)
159
160
161
                   END IF
                ENDDO
                IF (oneD%odi%d1) THEN
162
                   atoms_new%taual(i,na) = atoms_new%taual(i,na) + oneD%ods%tau(i,jop)/cell%amat(3,3)
163
164
165
166
167
168
169
                ELSE
                   atoms_new%taual(i,na) = atoms_new%taual(i,na) + sym%tau(i,jop)
                END IF
             ENDDO
          ENDDO
       ENDDO

170
171
       input%l_f = .FALSE.

172
       IF(.NOT.input%l_inpXML) THEN
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
          ALLOCATE(atoms_temp%nz(atoms%ntype))
          ALLOCATE(atoms_temp%zatom(atoms%ntype))
          ALLOCATE(atoms_temp%jri(atoms%ntype))
          ALLOCATE(atoms_temp%dx(atoms%ntype))
          ALLOCATE(atoms_temp%lmax(atoms%ntype))
          ALLOCATE(atoms_temp%nlo(atoms%ntype))
          ALLOCATE(atoms_temp%ncst(atoms%ntype))
          ALLOCATE(atoms_temp%lnonsph(atoms%ntype))
          ALLOCATE(atoms_temp%nflip(atoms%ntype))
          ALLOCATE(atoms_temp%l_geo(atoms%ntype))
          ALLOCATE(atoms_temp%lda_u(atoms%ntype))
          ALLOCATE(atoms_temp%bmu(atoms%ntype))
          ALLOCATE(atoms_temp%relax(3,atoms%ntype))
          ALLOCATE(atoms_temp%neq(atoms%ntype))
          ALLOCATE(atoms_temp%taual(3,atoms%nat))
          ALLOCATE(atoms_temp%pos(3,atoms%nat))
          ALLOCATE(atoms_temp%rmt(atoms%ntype))

          ALLOCATE(atoms_temp%ncv(atoms%ntype))
          ALLOCATE(atoms_temp%ngopr(atoms%nat))
          ALLOCATE(atoms_temp%lapw_l(atoms%ntype))
          ALLOCATE(atoms_temp%invsat(atoms%nat))

          ALLOCATE(noco_temp%soc_opt(atoms%ntype+2),noco_temp%l_relax(atoms%ntype),noco_temp%b_con(2,atoms%ntype))
          ALLOCATE(noco_temp%alph(atoms%ntype),noco_temp%beta(atoms%ntype))

          ALLOCATE (Jij_temp%alph1(atoms%ntype),Jij_temp%l_magn(atoms%ntype),Jij_temp%M(atoms%ntype))
          ALLOCATE (Jij_temp%magtype(atoms%ntype),Jij_temp%nmagtype(atoms%ntype))

          ALLOCATE(atoms_temp%llo(atoms%nlod,atoms%ntype))
          ALLOCATE(atoms_temp%ulo_der(atoms%nlod,atoms%ntype))
          ALLOCATE(atoms_temp%l_dulo(atoms%nlod,atoms%ntype))

          ALLOCATE(vacuum_temp%izlay(vacuum%layerd,2))
          atoms_temp%ntype = atoms%ntype
Daniel Wortmann's avatar
Daniel Wortmann committed
208
          ALLOCATE(noel_temp(atoms%ntype))
209
210
211

          ALLOCATE (hybrid_temp%nindx(0:atoms%lmaxd,atoms%ntype))
          ALLOCATE (hybrid_temp%select1(4,atoms%ntype),hybrid_temp%lcutm1(atoms%ntype))
Daniel Wortmann's avatar
Daniel Wortmann committed
212
          ALLOCATE (hybrid_temp%lcutwf(atoms%ntype))
213
214
215

          CALL rw_inp('r',atoms_temp,obsolete_temp,vacuum_temp,input_temp,stars_temp,sliceplot_temp,&
                      banddos_temp,cell_temp,sym_temp,xcpot_temp,noco_temp,Jij_temp,oneD_temp,hybrid_temp,&
216
217
                      kpts_temp,noel_temp,namex_temp,relcor_temp,a1_temp,a2_temp,a3_temp,scale_temp,dtild_temp,&
                      input_temp%comment)
218
219
220
221
222
223
224
225
226
227
          input_temp%l_f = input%l_f
          input_temp%tkb = input%tkb
          input_temp%delgau = input%tkb
          cell_temp = cell
          sym_temp = sym
          vacuum_temp = vacuum
          CALL rw_inp('W',atoms_new,obsolete_temp,vacuum_temp,input_temp,stars_temp,sliceplot_temp,&
               banddos_temp,cell_temp,sym_temp,xcpot_temp,noco_temp,Jij_temp,oneD_temp,hybrid_temp,&
               kpts_temp,noel_temp,namex_temp,relcor_temp,a1_temp,a2_temp,a3_temp,scale_temp,a3_temp(3),&
               input_temp%comment)
Daniel Wortmann's avatar
Daniel Wortmann committed
228
    
229
       ELSE
230
231
          kpts_temp%numSpecialPoints = 1
          ALLOCATE(kpts_temp%specialPoints(3,kpts_temp%numSpecialPoints))
232
233
234
          ALLOCATE(noel_temp(1),atomTypeSpecies(1),speciesRepAtomType(1))
          ALLOCATE(xmlElectronStates(1,1),xmlPrintCoreStates(1,1))
          ALLOCATE(xmlCoreOccs(1,1,1))
235
          CALL r_inpXML(atoms_temp,obsolete_temp,vacuum_temp,input_temp,stars_temp,sliceplot_temp,&
236
                        banddos_temp,dimension_temp,cell_temp,sym_temp,xcpot_temp,noco_temp,Jij_temp,&
237
                        oneD_temp,hybrid_temp,kpts_temp,enpara_temp,wann_temp,noel_temp,&
238
                        namex_temp,relcor_temp,a1_temp,a2_temp,a3_temp,scale_temp,dtild_temp,xmlElectronStates,&
Daniel Wortmann's avatar
Daniel Wortmann committed
239
                        xmlPrintCoreStates,xmlCoreOccs,atomTypeSpecies,speciesRepAtomType,l_kpts_temp,l_gga_temp)
240
241
242
          numSpecies = SIZE(speciesRepAtomType)
          filename = 'inp_new.xml'
          input_temp%l_f = input%l_f
243
          input_temp%gw_neigd = dimension_temp%neigd
Daniel Wortmann's avatar
Daniel Wortmann committed
244
          div(:) = MIN(kpts_temp%nkpt3(:),1)
245
          stars_temp%gmax = stars_temp%gmaxInit
246
          CALL w_inpXML(atoms_new,obsolete_temp,vacuum_temp,input_temp,stars_temp,sliceplot_temp,&
247
                        banddos_temp,cell_temp,sym_temp,xcpot_temp,noco_temp,jij_temp,oneD_temp,hybrid_temp,&
Daniel Wortmann's avatar
Daniel Wortmann committed
248
                        kpts_temp,kpts_temp%nkpt3,kpts_temp%l_gamma,noel_temp,namex_temp,relcor_temp,a1_temp,a2_temp,a3_temp,&
249
                        scale_temp,dtild_temp,input_temp%comment,xmlElectronStates,xmlPrintCoreStates,xmlCoreOccs,&
250
                        atomTypeSpecies,speciesRepAtomType,.FALSE.,filename,.TRUE.,numSpecies,enpara_temp)
251
          DEALLOCATE(atomTypeSpecies,speciesRepAtomType)
252
253
          DEALLOCATE(xmlElectronStates,xmlPrintCoreStates,xmlCoreOccs)
       END IF
254

Daniel Wortmann's avatar
Daniel Wortmann committed
255
    ENDIF
256
257
258
    RETURN
  END SUBROUTINE geo
END MODULE m_geo