read_inpgen_input.f90 13 KB
Newer Older
Daniel Wortmann's avatar
Daniel Wortmann committed
1 2 3 4 5 6 7 8
!--------------------------------------------------------------------------------
! 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.
!--------------------------------------------------------------------------------

MODULE m_read_inpgen_input
  USE m_judft
9
  USE m_calculator
Daniel Wortmann's avatar
Daniel Wortmann committed
10
  IMPLICIT NONE
Daniel Wortmann's avatar
Daniel Wortmann committed
11 12
  private
  public read_inpgen_input
Daniel Wortmann's avatar
Daniel Wortmann committed
13
CONTAINS
Daniel Wortmann's avatar
Daniel Wortmann committed
14

Daniel Wortmann's avatar
Daniel Wortmann committed
15
  SUBROUTINE read_inpgen_input(atom_pos,atom_id,atom_label,kpts_str,&
16
       input,sym,noco,vacuum,stars,xcpot,cell,hybrid)
Daniel Wortmann's avatar
Daniel Wortmann committed
17
    !Subroutine reads the old-style input for inpgen
Daniel Wortmann's avatar
Daniel Wortmann committed
18
    use m_atompar
19 20 21 22 23 24 25 26 27 28
    USE m_types_input
    USE m_types_sym
    USE m_types_noco
    USE m_types_vacuum
    USE m_types_stars
    USE m_types_xcpot_inbuild_nofunction
    USE m_types_cell
    USE m_types_hybrid
    USE m_process_lattice_namelist
    
Daniel Wortmann's avatar
Daniel Wortmann committed
29
    use m_inv3
Daniel Wortmann's avatar
Daniel Wortmann committed
30 31
    REAL,    ALLOCATABLE,INTENT(OUT) :: atom_pos(:, :),atom_id(:)
    CHARACTER(len=20), ALLOCATABLE,INTENT(OUT) :: atom_Label(:)
Daniel Wortmann's avatar
Daniel Wortmann committed
32 33 34 35 36 37
    character(len=40),INTENT(OUT):: kpts_str
    TYPE(t_input),INTENT(out)    :: input
    TYPE(t_sym),INTENT(OUT)      :: sym
    TYPE(t_noco),INTENT(OUT)     :: noco
    TYPE(t_vacuum),INTENT(OUT)   :: vacuum
    TYPE(t_stars),INTENT(OUT)    :: stars
38
    TYPE(t_xcpot_inbuild_nf),INTENT(OUT)    :: xcpot
Daniel Wortmann's avatar
Daniel Wortmann committed
39
    TYPE(t_cell),INTENT(OUT)     :: cell
40 41
    TYPE(t_hybrid),INTENT(OUT)   :: hybrid
    
Daniel Wortmann's avatar
Daniel Wortmann committed
42
    
Daniel Wortmann's avatar
Daniel Wortmann committed
43
    !locals
44
    REAL                :: a1(3),a2(3),a3(3),aa,SCALE(3),mat(3,3),det
Daniel Wortmann's avatar
Daniel Wortmann committed
45 46 47 48 49 50 51 52 53
    integer             :: ios,n,i
    CHARACTER(len=100)  :: filename
    logical             :: l_exist
    CHARACTER(len=16384):: line
    type(t_atompar)     :: ap
     
    !
    !read file and create normalized scratch file
    !
Daniel Wortmann's avatar
Daniel Wortmann committed
54 55 56 57
    filename=juDFT_string_for_argument("-f")
    INQUIRE(file=filename,exist=l_exist)
    IF (.NOT.l_exist) CALL judft_error("Input file specified is not readable")
    OPEN(97,file=filename)
Daniel Wortmann's avatar
Daniel Wortmann committed
58 59
    !OPEN(98,status='scratch')
    OPEN(98,file="scratch")
Daniel Wortmann's avatar
Daniel Wortmann committed
60
    CALL  normalize_file(97,98)
Daniel Wortmann's avatar
Daniel Wortmann committed
61 62
    close(97)
    
Daniel Wortmann's avatar
Daniel Wortmann committed
63 64
    REWIND(98)
    READ(98,"(a)",iostat=ios) input%comment
Daniel Wortmann's avatar
Daniel Wortmann committed
65 66 67 68 69 70
    if (input%comment(1:1)=='&') then
       input%comment="No title"
       backspace(98)
    endif

    aa=0.0
Daniel Wortmann's avatar
Daniel Wortmann committed
71
    DO WHILE(ios==0)
Daniel Wortmann's avatar
Daniel Wortmann committed
72 73 74 75 76 77
       READ(98,"(a)",iostat=ios) line
       IF (ios.NE.0) EXIT
       IF (line(1:1)=="&") THEN
          !process the namelist
          SELECT CASE(line(2:5)) !e.g. atom
          CASE ('latt')
Daniel Wortmann's avatar
Daniel Wortmann committed
78
             CALL process_lattice(line,a1,a2,a3,aa,scale,mat)
Daniel Wortmann's avatar
Daniel Wortmann committed
79
          CASE('inpu')
80
             CALL process_input(line,input%film,sym%symor,hybrid%l_hybrid)
Daniel Wortmann's avatar
Daniel Wortmann committed
81 82 83
          CASE('atom')
             CALL read_atom_params_old(98,ap)
             call add_atompar(ap)
Daniel Wortmann's avatar
Daniel Wortmann committed
84 85 86 87 88 89 90 91 92 93 94 95 96
          CASE('qss ')
             CALL process_qss(line,noco)
          CASE('soc ')
             CALL process_soc(line,noco)
          CASE('shif')
             CALL process_shift(line,atom_pos)
          CASE('fact')
             CALL process_factor(line,atom_pos)
          CASE('exco')
             CALL process_exco(line,xcpot)
          CASE('comp')
             CALL process_comp(line,input%jspins,input%frcor,input%ctail,input%kcrel,stars%gmax,xcpot%gmaxxc,input%rkmax)
          CASE('kpt ')
Daniel Wortmann's avatar
Daniel Wortmann committed
97
             CALL process_kpts(line,kpts_str,input%tria,input%tkb)
Daniel Wortmann's avatar
Daniel Wortmann committed
98
          CASE('film')
99
             CALL process_film(line,vacuum%dvac,cell%amat(3,3))
Daniel Wortmann's avatar
Daniel Wortmann committed
100 101 102 103 104 105
          CASE('gen ','sym ')
             CALL judft_error("Specifying the symmetries no longer supported in inpgen")
          CASE default
             CALL judft_error(("Unkown input in:"//line))
          END SELECT
       ELSE
Daniel Wortmann's avatar
Daniel Wortmann committed
106
          IF (aa.ne.0) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125
             !cell was set already, so list of atoms follow
             READ(line,*,iostat=ios) n
             IF (ios.NE.0) CALL judft_error(("Surprising error in reading input:"//line))
             ALLOCATE(atom_pos(3,n),atom_label(n),atom_id(n))
             DO i=1,n
                READ(98,"(a)",iostat=ios) line
                IF (ios.NE.0) CALL judft_error(("List of atoms not complete:"//line))
                atom_id(i)=evaluatefirst(line)
                atom_pos(1,i)=evaluatefirst(line)
                atom_pos(2,i)=evaluatefirst(line)
                atom_pos(3,i)=evaluatefirst(line)
                IF(TRIM(ADJUSTL(line)).NE.'') THEN
                   atom_Label(i) = TRIM(ADJUSTL(line))
                ELSE
                   WRITE(atom_Label(i),'(i0)') n
                END IF
             END DO
          ELSE
             !the bravais matrix has to follow
Daniel Wortmann's avatar
Daniel Wortmann committed
126
             a1(1)=evaluatefirst(line);a1(2)=evaluatefirst(line);a1(3)=evaluatefirst(line)
Daniel Wortmann's avatar
Daniel Wortmann committed
127
             READ(98,"(a)",iostat=ios) line
Daniel Wortmann's avatar
Daniel Wortmann committed
128 129
             IF (ios.NE.0) CALL judft_error(("Error reading bravais matrix"))
             a2(1)=evaluatefirst(line);a2(2)=evaluatefirst(line);a2(3)=evaluatefirst(line)
Daniel Wortmann's avatar
Daniel Wortmann committed
130
             READ(98,"(a)",iostat=ios) line
Daniel Wortmann's avatar
Daniel Wortmann committed
131 132 133 134 135 136 137 138
             IF (ios.NE.0) CALL judft_error(("Error reading bravais matrix"))
             a3(1)=evaluatefirst(line);a3(2)=evaluatefirst(line);a3(3)=evaluatefirst(line)
             vacuum%dvac=evaluatefirst(line)
             IF (input%film.AND.(vacuum%dvac <= 0.00)) THEN
                WRITE(*,*)'Film calculation but no reasonable dVac provided'
                WRITE(*,*)'Setting default for dVac'
                vacuum%dvac = ABS(a3(3)) ! This is later set to the real default by the chkmt result
             END IF
Daniel Wortmann's avatar
Daniel Wortmann committed
139
             READ(98,"(a)",iostat=ios) line
Daniel Wortmann's avatar
Daniel Wortmann committed
140 141
             IF (ios.NE.0) CALL judft_error(("Error reading bravais matrix"))
             aa=evaluatefirst(line)
Daniel Wortmann's avatar
Daniel Wortmann committed
142
             READ(98,"(a)",iostat=ios) line
Daniel Wortmann's avatar
Daniel Wortmann committed
143 144 145
             IF (ios.NE.0) CALL judft_error(("Error reading bravais matrix"))
             scale(1)=evaluatefirst(line);scale(2)=evaluatefirst(line);scale(3)=evaluatefirst(line)
             mat=0.0
Daniel Wortmann's avatar
Daniel Wortmann committed
146 147 148
          ENDIF
       ENDIF
    END DO
Daniel Wortmann's avatar
Daniel Wortmann committed
149

Daniel Wortmann's avatar
Daniel Wortmann committed
150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168
    IF (.NOT.ALLOCATED(atom_pos).OR.SUM(ABS(a1))==0.0) CALL judft_error("input not complete")
    !transform hex->trig
    IF (abs(mat(1,1)).GT.0.0000001) THEN
       cell%amat(:,1) = a1(:)
       cell%amat(:,2) = a2(:)
       cell%amat(:,3) = a3(:)
       call inv3(cell%amat,cell%bmat,det)
       DO n = 1, size(atom_pos,2)
          atom_pos(:,n) = matmul(cell%bmat,matmul(mat,atom_pos(:,n)))
       ENDDO
    ENDIF
    
    !set the cell
    cell%amat(:,1) = aa*scale(:)*a1(:)
    cell%amat(:,2) = aa*scale(:)*a2(:)
    cell%amat(:,3) = aa*scale(:)*a3(:)
    IF (input%film) THEN
       CALL cell%init(vacuum%dvac)
    ELSE
169
       CALL cell%init(-1.0)
Daniel Wortmann's avatar
Daniel Wortmann committed
170
    ENDIF
Daniel Wortmann's avatar
Daniel Wortmann committed
171
    
Daniel Wortmann's avatar
Daniel Wortmann committed
172 173
  END SUBROUTINE read_inpgen_input

Daniel Wortmann's avatar
Daniel Wortmann committed
174 175 176 177 178 179 180 181 182 183 184

  SUBROUTINE process_kpts(line,kpts_str,tria,tkb)
      CHARACTER(len=*),INTENT(in)::line
      CHARACTER(len=40),INTENT(out)::kpts_str
      logical,intent(inout)::tria
      real,intent(inout):: tkb


      integer :: div1,div2,div3,nkpt
      real    :: den
      NAMELIST /kpt/nkpt,div1,div2,div3,tkb,tria,den
185
      div1=0;div2=0;div3=0;nkpt=0;den=0.0
Daniel Wortmann's avatar
Daniel Wortmann committed
186 187 188 189 190 191 192

      kpts_str=''
      if (den>0.0) THEN
         write(kpts_str,"(a,f0.6)") "den=",den
      elseif(nkpt>0) then
         write(kpts_str,"(a,i0)") "nk=",nkpt
      elseif(all([div1,div2,div3]>0)) then
193
         write(kpts_str,"(a,i0,a,i0,a,i0)") "grid=",div1,",",div2,",",div3
Daniel Wortmann's avatar
Daniel Wortmann committed
194 195 196
      end if
    end SUBROUTINE process_kpts
      
Daniel Wortmann's avatar
Daniel Wortmann committed
197 198 199 200 201 202
    SUBROUTINE process_input(line,film,symor,hybrid)
      CHARACTER(len=*),INTENT(in)::line
      LOGICAL,INTENT(out)::film,symor,hybrid

      INTEGER :: ios
      LOGICAL :: cartesian, cal_symm, checkinp,inistop,oldfleur
203 204
      NAMELIST /input/ film, cartesian, cal_symm, checkinp, inistop,&
                      symor, oldfleur, hybrid
Daniel Wortmann's avatar
Daniel Wortmann committed
205
      cartesian=.FALSE.
206
      cal_symm=.FALSE.
Daniel Wortmann's avatar
Daniel Wortmann committed
207 208 209 210 211
      oldfleur=.FALSE.
     READ(line,input,iostat=ios)
     IF (ios.NE.0) CALL judft_error(("Error reading:"//line))
     IF (ANY([cal_symm, checkinp,oldfleur])) CALL judft_error("Switches cal_symm, checkinp,oldfleur no longer supported")
   END SUBROUTINE process_input
Daniel Wortmann's avatar
Daniel Wortmann committed
212
   
Daniel Wortmann's avatar
Daniel Wortmann committed
213
   SUBROUTINE process_qss(line,noco)
214
     USE m_types_noco
Daniel Wortmann's avatar
Daniel Wortmann committed
215 216 217
     CHARACTER(len=*),INTENT(in)::line
     TYPE(t_noco),INTENT(INOUT) :: noco
     CHARACTER(len=1000) :: buf
218 219 220
     INTEGER :: ios
 
     buf=ADJUSTL(line(5:len_TRIM(line)-1))
Daniel Wortmann's avatar
Daniel Wortmann committed
221
          
Daniel Wortmann's avatar
Daniel Wortmann committed
222
     READ(buf,*,iostat=ios) noco%qss
Daniel Wortmann's avatar
Daniel Wortmann committed
223 224 225 226
     noco%l_ss=.TRUE.
     noco%l_noco=.TRUE.
     IF (ios.NE.0) CALL judft_error(("Error reading:"//line))
   END SUBROUTINE process_qss
Daniel Wortmann's avatar
Daniel Wortmann committed
227

Daniel Wortmann's avatar
Daniel Wortmann committed
228
   SUBROUTINE process_soc(line,noco)
229
     USE m_types_noco
Daniel Wortmann's avatar
Daniel Wortmann committed
230 231 232
     CHARACTER(len=*),INTENT(in)::line
     TYPE(t_noco),INTENT(INOUT) :: noco
     CHARACTER(len=1000) :: buf
233 234 235
     INTEGER :: ios
 
     buf=ADJUSTL(line(5:len_TRIM(line)-1))
Daniel Wortmann's avatar
Daniel Wortmann committed
236
          
Daniel Wortmann's avatar
Daniel Wortmann committed
237
     READ(buf,*,iostat=ios) noco%theta,noco%phi
Daniel Wortmann's avatar
Daniel Wortmann committed
238 239 240 241
     noco%l_soc=.TRUE.
     IF (ios.NE.0) CALL judft_error(("Error reading:"//line))
   END SUBROUTINE process_soc

Daniel Wortmann's avatar
Daniel Wortmann committed
242 243
   SUBROUTINE process_film(line,dvac,dtild)
     CHARACTER(len=*),INTENT(in):: line
244 245
     REAL,INTENT(out)           :: dvac,dtild
     INTEGER :: ios
Daniel Wortmann's avatar
Daniel Wortmann committed
246 247 248 249 250
     NAMELIST /film/   dvac, dtild
     READ(line,film,iostat=ios)
     IF (ios.NE.0) CALL judft_error(("Error reading:"//line))
   END SUBROUTINE process_film

Daniel Wortmann's avatar
Daniel Wortmann committed
251 252 253 254 255 256 257
   SUBROUTINE process_shift(line,atompos)
     CHARACTER(len=*),INTENT(in)::line
     REAL,INTENT(INOUT) :: atompos(:,:)
     CHARACTER(len=1000) :: buf
     REAL :: shift(3)
     INTEGER :: ios,n
     
258
     buf=ADJUSTL(line(7:len_TRIM(line)-1))    
Daniel Wortmann's avatar
Daniel Wortmann committed
259
     READ(buf,*,iostat=ios) shift
Daniel Wortmann's avatar
Daniel Wortmann committed
260 261 262
     
     IF (ios.NE.0) CALL judft_error(("Error reading:"//line))
     DO n=1,SIZE(atompos,2)
263
        atompos(:,n)=atompos(:,n)+shift
Daniel Wortmann's avatar
Daniel Wortmann committed
264 265
     ENDDO
   END SUBROUTINE process_shift
Daniel Wortmann's avatar
Daniel Wortmann committed
266

Daniel Wortmann's avatar
Daniel Wortmann committed
267 268 269 270 271 272 273
   SUBROUTINE process_factor(line,atompos)
     CHARACTER(len=*),INTENT(in)::line
     REAL,INTENT(INOUT) :: atompos(:,:)
     CHARACTER(len=1000) :: buf
     REAL :: factor(3)
     INTEGER :: ios,n
     
274
     buf=ADJUSTL(line(8:len_TRIM(line)-1))    
Daniel Wortmann's avatar
Daniel Wortmann committed
275
     READ(buf,*,iostat=ios) factor
Daniel Wortmann's avatar
Daniel Wortmann committed
276 277 278
     
     IF (ios.NE.0) CALL judft_error(("Error reading:"//line))
     DO n=1,SIZE(atompos,2)
279
        atompos(:,n)=atompos(:,n)/factor
Daniel Wortmann's avatar
Daniel Wortmann committed
280 281 282 283
     ENDDO
   END SUBROUTINE process_factor

   SUBROUTINE process_exco(line,xcpot)
284
     USE m_types_xcpot_inbuild_nofunction
Daniel Wortmann's avatar
Daniel Wortmann committed
285
     CHARACTER(len=*),INTENT(in)::line
286
     TYPE(t_xcpot_inbuild_nf),INTENT(INOUT) :: xcpot
Daniel Wortmann's avatar
Daniel Wortmann committed
287 288 289 290 291
     LOGICAL::relxc
     CHARACTER(len=4) :: xctyp
     NAMELIST /exco/   xctyp, relxc 
     INTEGER :: ios
     
Daniel Wortmann's avatar
Daniel Wortmann committed
292 293
     relxc=.false.
     xctyp='pbe'
Daniel Wortmann's avatar
Daniel Wortmann committed
294
     READ(line,exco,iostat=ios) 
Daniel Wortmann's avatar
Daniel Wortmann committed
295
     IF (ios.NE.0) CALL judft_error(("Error reading:"//trim(line)))
Daniel Wortmann's avatar
Daniel Wortmann committed
296

Daniel Wortmann's avatar
Daniel Wortmann committed
297
     call xcpot%init(xctyp,relxc,1) !Is it OK to use ntype=1 here??
Daniel Wortmann's avatar
Daniel Wortmann committed
298 299
   END SUBROUTINE process_exco

Daniel Wortmann's avatar
Daniel Wortmann committed
300
   SUBROUTINE process_comp(line,jspins,frcor,ctail,kcrel,gmax,gmaxxc,kmax)
Daniel Wortmann's avatar
Daniel Wortmann committed
301
     CHARACTER(len=*),INTENT(in)::line
302 303
     INTEGER,INTENT(inout):: jspins,kcrel
     LOGICAL,INTENT(inout):: frcor,ctail
Daniel Wortmann's avatar
Daniel Wortmann committed
304
     REAL,intent(inout)   :: gmax,gmaxxc,kmax
Daniel Wortmann's avatar
Daniel Wortmann committed
305 306

     INTEGER :: ios
Daniel Wortmann's avatar
Daniel Wortmann committed
307
     NAMELIST /comp/   jspins, frcor, ctail, kcrel, gmax, gmaxxc, kmax
Daniel Wortmann's avatar
Daniel Wortmann committed
308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324
     
     READ(line,comp,iostat=ios) 
     IF (ios.NE.0) CALL judft_error(("Error reading:"//line))
   END SUBROUTINE process_comp


      SUBROUTINE normalize_file(infh,outfh)
    !***********************************************************************
    !     reads in the file from infh
    ! and:
    !  - deletes comments
    !  - deletes empty line
    !  - combines multiple line namelists into single line
    !
    !  then the input is written to outfh
    ! 
    !***********************************************************************
Daniel Wortmann's avatar
Daniel Wortmann committed
325
    
Daniel Wortmann's avatar
Daniel Wortmann committed
326
      IMPLICIT NONE
Daniel Wortmann's avatar
Daniel Wortmann committed
327

Daniel Wortmann's avatar
Daniel Wortmann committed
328
      INTEGER, INTENT (IN)    :: infh            ! input filehandle (5)
329
      INTEGER, INTENT (IN)    :: outfh            ! Output filehandle
Daniel Wortmann's avatar
Daniel Wortmann committed
330

Daniel Wortmann's avatar
Daniel Wortmann committed
331 332 333
      INTEGER               :: n,ios
      LOGICAL               :: building, complete
      CHARACTER(len=1000)   :: line,buffer
Daniel Wortmann's avatar
Daniel Wortmann committed
334 335 336

      
      
Daniel Wortmann's avatar
Daniel Wortmann committed
337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383
      !---> initialize some variables
      building = .false.
      complete = .false.

      loop: DO
         READ (infh,'(a)',IOSTAT=ios) line
         IF (ios.NE.0) EXIT !done
         
         LINE = ADJUSTL(line)
         n = SCAN(line,'!')                 ! remove end of line comments
         IF ( n>0 ) THEN
            line = line(1:n-1)
         ENDIF
         n = LEN_TRIM( line )               ! length of line without trailing blanks
         IF ( n == 0 ) CYCLE loop

         IF ( line(1:1)=='&' ) THEN         ! check if beginning of namelist
            IF (building) CALL juDFT_error ("missing end of namelist marker / in  or before line")
            building = .TRUE.
            buffer = line
            IF( line(n:n)=='/' ) complete = .TRUE.
         ELSEIF ( line(n:n)=='/' ) THEN     ! check if end of namelist
            IF (building) THEN
               complete = .TRUE.
               buffer = trim(buffer)//' '//line
            ELSE
               CALL juDFT_error ("out of place end of namelist marker / in line")
            ENDIF
         ELSEIF ( building ) THEN           ! add line to buffer
            buffer = trim(buffer)//' '//line
         ELSEIF ( n > 0 ) THEN              ! check for non empty lines outside of namelists
            buffer = line
            complete = .TRUE.
         ENDIF

         IF ( complete ) THEN
            WRITE(outfh,"(a)") TRIM(buffer)
            buffer=''
            building=.FALSE.
            complete=.FALSE.
         END IF
      END DO loop

    END SUBROUTINE normalize_file

  
    
Daniel Wortmann's avatar
Daniel Wortmann committed
384
  END MODULE m_read_inpgen_input