LCOV - code coverage report
Current view: top level - inpgen - inpgen.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 117 124 94.4 %
Date: 2019-09-08 04:53:50 Functions: 2 2 100.0 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       3             : ! This file is part of FLEUR and available as free software under the conditions
       4             : ! of the MIT license as expressed in the LICENSE file in more detail.
       5             : !--------------------------------------------------------------------------------
       6             : 
       7           3 : PROGRAM inpgen
       8             : !----------------------------------------------------------------------------+
       9             : !   Set up a FLEUR inp-file from basic input data; for use and docu please   !
      10             : !   refer to inpgen.html (or see http://www.flapw.de/docs/inpgen.html)       !
      11             : !                                                                            |
      12             : !   The program is based on the input conventions of the FLAIR-code, so that !
      13             : !   some compatibility is ensured. The symmetry generator was written by     ! 
      14             : !   M.Weinert and implemented in the FLAIR-code by G.Schneider.              !
      15             : !                                                                    gb`02   |
      16             : !----------------------------------------------------------------------------+
      17           3 :       use m_juDFT
      18             :       USE m_structinput
      19             :       USE m_crystal
      20             :       USE m_socorssdw
      21             :       USE m_rwsymfile
      22             :       USE m_setinp
      23             :       USE m_writestruct
      24             :       USE m_xsf_io, ONLY : xsf_write_atoms
      25             :       USE m_types
      26             :       USE m_inpgen_help
      27             :       USE m_constants
      28             :       IMPLICIT NONE
      29             :     
      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           3 :       INTEGER, ALLOCATABLE :: mmrot(:,:,:)
      40           9 :       REAL,    ALLOCATABLE :: ttr(:, :),atompos(:, :),atomid(:) 
      41           3 :       REAL,    ALLOCATABLE :: idlist(:)
      42           3 :       INTEGER, ALLOCATABLE ::  ntyrep(:)              ! these variables are allocated with
      43           3 :       INTEGER, ALLOCATABLE :: natype(:),natrep(:),natmap(:)  ! or  'nat'
      44           6 :       INTEGER, ALLOCATABLE :: speciesRepAtomType(:),atomTypeSpecies(:)
      45             :      
      46             :       INTEGER, PARAMETER :: xl_buffer=16384              ! maximum length of read record
      47             :       CHARACTER(len=xl_buffer) :: buffer
      48             : 
      49             :       CHARACTER(len=80):: title
      50             :       CHARACTER(len=7) :: symfn
      51             :       CHARACTER(len=4) :: dispfn
      52             :       CHARACTER(LEN=8) :: tempNumberString
      53           3 :       CHARACTER(len=20), ALLOCATABLE :: atomLabel(:)
      54             : 
      55             :       TYPE(t_input)    :: input
      56           3 :       TYPE(t_atoms)    :: atoms
      57             :       TYPE(t_cell)     :: cell
      58           3 :       TYPE(t_sym)      :: sym
      59           3 :       TYPE(t_noco)     :: noco
      60           3 :       TYPE(t_vacuum)   :: vacuum
      61             :       
      62           3 :       CALL inpgen_help()
      63             : 
      64           3 :       nop48 = 48
      65           3 :       natmax = 9999
      66           3 :       ngen = 0
      67           3 :       infh = 5
      68           3 :       errfh = 6 ; warnfh = 6 ; dbgfh = 6 ; outfh = 6
      69           3 :       symfh = 94
      70           3 :       symfn = 'sym    '
      71           3 :       dispfh = 97
      72           3 :       dispfn='disp'
      73           3 :       nline = 0
      74             : 
      75           3 :       bfh = 93
      76             : 
      77           3 :       input%l_inpXML = .TRUE.
      78             :    
      79           3 :       ALLOCATE ( mmrot(3,3,nop48), ttr(3,nop48) )
      80           3 :       ALLOCATE ( atompos(3,natmax),atomid(natmax) )
      81           3 :       ALLOCATE (atomLabel(natmax))
      82       30000 :       atomLabel = ''
      83             : 
      84             : !      OPEN (5,file='inp2',form='formatted',status='old')
      85           3 :       OPEN (6,file='out',form='formatted',status='unknown')
      86           3 :       OPEN (bfh,file='bfh.txt',form='formatted',status='unknown')
      87             : 
      88           3 :       noco%l_ss = .FALSE.
      89             :       CALL struct_input(&
      90             :      &                  infh,errfh,warnfh,symfh,symfn,bfh,&
      91             :      &                  natmax,nop48,&
      92             :      &                  nline,xl_buffer,buffer,&
      93             :      &                  title,input%film,cal_symm,checkinp,sym%symor,&
      94             :      &                  cartesian,oldfleur,a1,a2,a3,vacuum%dvac,aa,scale,i_c,&
      95             :      &                 factor,natin,atomid,atompos,ngen,mmrot,ttr,atomLabel,&
      96           3 :      &                  l_hyb,noco%l_soc,noco%l_ss,noco%theta,noco%phi,noco%qss,inistop)!keep
      97             : 
      98             : !      CLOSE (5)
      99             : 
     100           3 :       IF (.not.input%film) vacuum%dvac=a3(3)
     101           3 :       WRITE (6,*)
     102           3 :       WRITE (6,*) title
     103           3 :       WRITE (6,*) 'film=',input%film,'cartesian=',cartesian
     104           3 :       WRITE (6,*) 'checkinp=',checkinp,'symor=',sym%symor
     105           3 :       WRITE (6,*)
     106           3 :       WRITE (6,'(a5,3f10.5)') 'a1 = ',a1(:)
     107           3 :       WRITE (6,'(a5,3f10.5)') 'a2 = ',a2(:)
     108           3 :       WRITE (6,'(a5,3f10.5)') 'a3 = ',a3(:)
     109           3 :       WRITE (6,*)
     110           3 :       WRITE (6,'(2(a5,f10.5))') 'dvac=',vacuum%dvac,' aa =',aa
     111           3 :       WRITE (6,'(a8,3f10.5)') 'scale = ',scale(:)
     112           3 :       WRITE (6,*)
     113           3 :       WRITE (6,'(a6,i3,a6,999i5)') 'natin=',natin,' Z = ',&
     114           6 :      &                             (nint(atomid(i)),i=1,abs(natin))
     115           3 :       WRITE (6,*) 'positions: '
     116           3 :       WRITE (6,'(3(3x,f10.5))') ((atompos(j,i),j=1,3),i=1,abs(natin))
     117           3 :       WRITE (6,*)
     118           3 :       WRITE (6,*) 'generators: ',ngen,'(excluding identity)'
     119           3 :       DO i = 2, ngen+1
     120           0 :          WRITE (6,*) i
     121           0 :          WRITE (6,'(3i5,f8.3)') (mmrot(1,j,i),j=1,3),ttr(1,i)
     122           0 :          WRITE (6,'(3i5,f8.3)') (mmrot(2,j,i),j=1,3),ttr(2,i)
     123           3 :          WRITE (6,'(3i5,f8.3)') (mmrot(3,j,i),j=1,3),ttr(3,i)
     124             :       ENDDO
     125           3 :       IF (noco%l_soc) WRITE(6,'(a4,2f10.5)') 'soc:',noco%theta,noco%phi
     126           3 :       IF (noco%l_ss)  WRITE(6,'(a4,3f10.5)') 'qss:',noco%qss(:)
     127             : !
     128             : ! --> generate symmetry from input (atomic positions, generators or whatever)
     129             : !     
     130             :       CALL crystal(&
     131             :      &             dbgfh,errfh,outfh,dispfh,dispfn,&
     132             :      &             cal_symm,cartesian,sym%symor,input%film,&
     133             :      &             natin,natmax,nop48,&
     134             :      &             atomid,atompos,a1,a2,a3,aa,scale,i_c,&
     135             :      &             sym%invs,sym%zrfs,sym%invs2,sym%nop,sym%nop2,&
     136             :      &             ngen,mmrot,ttr,atoms%ntype,atoms%nat,nops,&
     137             :      &             atoms%neq,ntyrep,atoms%zatom,natype,natrep,natmap,&
     138           3 :      &             sym%mrot,sym%tau,atoms%pos,cell%amat,cell%bmat,cell%omtil)
     139             : 
     140           3 :       IF (noco%l_ss.OR.noco%l_soc)  THEN
     141             :          CALL soc_or_ssdw(&
     142             :      &                    noco%l_soc,noco%l_ss,noco%theta,noco%phi,noco%qss,cell%amat,&
     143             :      &                    sym%mrot,sym%tau,sym%nop,sym%nop2,atoms%nat,atomid,atompos,&
     144             :      &                    mmrot,ttr,no3,no2,atoms%ntype,atoms%neq,natmap,&
     145           0 :      &                    ntyrep,natype,natrep,atoms%zatom,atoms%pos)
     146           0 :          sym%nop = no3 ; sym%nop2 = no2
     147           0 :          sym%mrot(:,:,1:sym%nop) = mmrot(:,:,1:sym%nop)
     148           0 :          sym%tau(:,1:sym%nop) = ttr(:,1:sym%nop)
     149             :       ENDIF
     150           3 :       DEALLOCATE ( mmrot, ttr, atompos )
     151             : 
     152           3 :       ALLOCATE ( atoms%taual(3,atoms%nat),idlist(atoms%ntype) )
     153           3 :       ALLOCATE (atoms%label(atoms%nat))
     154           3 :       WRITE (6,*)
     155           3 :       WRITE (6,'(a6,i3,a6,i3)') 'atoms%ntype=',atoms%ntype,' atoms%nat= ',atoms%nat
     156           3 :       na = 0
     157           6 :       DO i = 1, atoms%ntype
     158           3 :         WRITE (6,'(a3,i3,a2,i3,a6,i3)') ' Z(',i,')=',nint(atoms%zatom(i)),&
     159           6 :      &                                             ' atoms%neq= ',atoms%neq(i)
     160           9 :         DO j = 1, atoms%neq(i)
     161             :            WRITE (6,'(3f10.6,10x,i7)')&
     162           6 :      &           atoms%pos(:,natmap(na+j)),natmap(na+j)
     163           6 :            atoms%taual(:,na+j) = atoms%pos(:,natmap(na+j))      ! reorder coordinates
     164           6 :            idlist(i)           = atomid(natmap(na+j))           ! and atomic id's
     165           9 :            atoms%label(na+j)      = atomLabel(natmap(na+j))        ! and labels
     166             :         ENDDO
     167           6 :         na = na + atoms%neq(i)
     168             :       ENDDO
     169           9 :       DO i=1,atoms%nat
     170           9 :         atoms%pos(:,i) = matmul( cell%amat , atoms%taual(:,i) )
     171             :       ENDDO
     172           3 :       DEALLOCATE(atomLabel)
     173             : 
     174             : !
     175             : ! --> write a file 'sym.out' with accepted symmetry operations
     176             : !
     177           3 :       nops = sym%nop
     178           3 :       symfn = 'sym.out'
     179           3 :       IF (.not.input%film) sym%nop2=sym%nop
     180           3 :       IF ((.NOT.juDFT_was_argument("-explicit"))) THEN
     181           1 :          CALL rw_symfile('W',symfh,symfn,nops,cell%bmat,sym%mrot,sym%tau,sym%nop,sym%nop2,sym%symor)
     182             :       END IF
     183             : 
     184           3 :       ALLOCATE (atomTypeSpecies(atoms%ntype))
     185           3 :       ALLOCATE (speciesRepAtomType(atoms%nat))
     186           3 :       ALLOCATE (atoms%speciesName(atoms%nat))
     187           3 :       elementNumSpecies = 0
     188           3 :       numSpecies = 0
     189           9 :       speciesRepAtomType = -1
     190           6 :       atomTypeSpecies = -1
     191           9 :       atoms%speciesName = ''
     192           9 :       DO i = 1, atoms%nat
     193             :          newSpecies = .TRUE.
     194           6 :          DO j = 1, i-1
     195           6 :             IF(atomid(i).EQ.atomid(j)) THEN
     196           3 :                newSpecies = .FALSE.
     197           3 :                atomTypeSpecies(natype(i)) = atomTypeSpecies(natype(j))
     198             :                EXIT
     199             :             END IF
     200             :          END DO
     201           3 :          IF(newSpecies) THEN
     202           3 :             numSpecies = numSpecies + 1
     203           3 :             speciesRepAtomType(numSpecies) = natype(i)
     204           3 :             atomTypeSpecies(natype(i)) = numSpecies
     205           3 :             element = nint(atoms%zatom(natype(i)))
     206           3 :             elementNumSpecies(element) = elementNumSpecies(element) + 1
     207           3 :             tempNumberString = ''
     208           3 :             WRITE(tempNumberString,'(i0)') elementNumSpecies(element)
     209             :             atoms%speciesName(numSpecies) = &
     210           3 :                TRIM(ADJUSTL(namat_const(element))) // '-' // TRIM(ADJUSTL(tempNumberString))
     211             :          END IF
     212             :       END DO
     213             : 
     214             : !
     215             : ! --> set defaults for FLEUR inp-file
     216             : !
     217           3 :       ALLOCATE ( atoms%rmt(atoms%ntype) )
     218           3 :       atoms%nlod=9  ! This fixed dimensioning might have to be made more dynamical!
     219             :       CALL set_inp(&
     220             :      &             infh,nline,xl_buffer,bfh,buffer,l_hyb,&
     221             :      &             atoms,sym,cell,title,idlist,&
     222             :      &             input,vacuum,noco,&
     223             :      &             atomTypeSpecies,speciesRepAtomType,numSpecies,&
     224           3 :      &             a1,a2,a3)
     225             : 
     226           3 :       DEALLOCATE (atoms%speciesName,atomTypeSpecies,speciesRepAtomType)
     227           3 :       DEALLOCATE ( ntyrep, natype, natrep, atomid )
     228             : 
     229           3 :       CLOSE(bfh,STATUS='delete')
     230             : 
     231             : !
     232             : ! --> Structure in povray or xsf-format
     233             : !
     234             :       IF (.false.) THEN
     235             :          CALL write_struct(&
     236             :      &                  atoms%ntype,atoms%nat,atoms%neq,&
     237             :      &                  atoms%rmt,atoms%pos,natmap,cell%amat)!keep
     238             :       ELSE 
     239           3 :          OPEN (55,file="struct.xsf")
     240             :          CALL xsf_WRITE_atoms(&
     241           3 :      &                        55,atoms,input%film,.false.,cell%amat)
     242           3 :          CLOSE (55)
     243             :       ENDIF
     244             : 
     245           3 :       DEALLOCATE (vacuum%izlay)
     246           3 :       DEALLOCATE ( atoms%taual,sym%mrot,sym%tau,atoms%neq,atoms%zatom,atoms%rmt,natmap,atoms%pos,idlist )
     247             : 
     248           3 :       IF (inistop)  CALL juDFT_end("Symmetry done",1)
     249             : 
     250           3 :       END 

Generated by: LCOV version 1.13