LCOV - code coverage report
Current view: top level - init/old_inp - dimen7.F90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 108 162 66.7 %
Date: 2019-09-08 04:53:50 Functions: 1 1 100.0 %

          Line data    Source code
       1             :       MODULE m_dimen7
       2             :       use m_juDFT
       3             :       CONTAINS
       4          14 :       SUBROUTINE dimen7(&
       5             :      &                  input,sym,stars,&
       6             :      &                  atoms,sphhar,dimension,vacuum,&
       7             :      &                  obsolete,kpts,oneD,hybrid,cell)
       8             : 
       9             : !
      10             : ! This program reads the input files of the flapw-programm (inp & kpts)
      11             : ! and creates a file 'fl7para' that contains dimensions 
      12             : ! for the main flapw-programm.
      13             : !
      14             : 
      15             :       USE m_localsym
      16             :       USE m_socsym
      17             :       USE m_sssym
      18             :       USE m_spg2set
      19             :       USE m_constants
      20             :       USE m_rwinp
      21             :       USE m_inpnoco
      22             :       USE m_julia
      23             :       USE m_od_kptsgen
      24             :       USE m_types
      25             :       USE m_firstglance
      26             :       USE m_inv3
      27             :       USE m_rwsymfile
      28             :       USE m_strgndim
      29             :       USE m_convndim
      30             :       USE m_inpeigdim
      31             :       USE m_ylm
      32             :       IMPLICIT NONE
      33             : !
      34             : ! dimension-parameters for flapw:
      35             : !
      36             :       TYPE(t_input),INTENT(INOUT)   :: input
      37             :       TYPE(t_sym),INTENT(INOUT)     :: sym
      38             :       TYPE(t_stars),INTENT(INOUT)   :: stars 
      39             :       TYPE(t_atoms),INTENT(INOUT)   :: atoms
      40             :       TYPE(t_sphhar),INTENT(INOUT)  :: sphhar
      41             :       TYPE(t_dimension),INTENT(INOUT) :: dimension
      42             :       TYPE(t_vacuum),INTENT(INOUT)   :: vacuum
      43             :       TYPE(t_obsolete),INTENT(INOUT) :: obsolete
      44             :       TYPE(t_kpts),INTENT(INOUT)     :: kpts
      45             :       TYPE(t_oneD),INTENT(INOUT)     :: oneD
      46             :       TYPE(t_hybrid),INTENT(INOUT)   :: hybrid
      47             :       TYPE(t_cell),INTENT(INOUT)     :: cell
      48             :  
      49          14 :       TYPE(t_noco)      :: noco
      50             :       TYPE(t_sliceplot) :: sliceplot
      51             :       TYPE(t_banddos)   :: banddos
      52          14 :       TYPE(t_xcpot_inbuild)     :: xcpot
      53             : 
      54             : !
      55             : !
      56             : !-------------------------------------------------------------------
      57             : ! ..  Local Scalars ..
      58             :       REAL   :: thetad,xa,epsdisp,epsforce ,rmtmax,arltv1,arltv2,arltv3   
      59             :       REAL   :: s,r,d ,idsprs
      60             :       INTEGER :: ok,ilo,n,nstate,i,j,na,n1,n2,jrc,nopd,symfh
      61             :       INTEGER :: nmopq(3)
      62             :       
      63             :       CHARACTER(len=1) :: rw
      64             :       CHARACTER(len=4) :: namex 
      65             :       CHARACTER(len=7) :: symfn
      66             :       CHARACTER(len=12):: relcor
      67             :       LOGICAL  ::l_kpts,l_qpts,l_inpexist,l_tmp(2)
      68             : ! ..
      69             :       REAL    :: a1(3),a2(3),a3(3)  
      70             :       REAL    :: q(3)
      71             : 
      72          14 :       CHARACTER(len=3), ALLOCATABLE :: noel(:)
      73          14 :       LOGICAL, ALLOCATABLE :: error(:) 
      74             :      
      75             :       INTEGER ntp1,ii
      76          28 :       INTEGER, ALLOCATABLE :: lmx1(:), nq1(:), nlhtp1(:)
      77             : 
      78             : !     added for HF and hybrid functionals
      79             :       LOGICAL               ::  l_gamma=.false.
      80             : 
      81             :       EXTERNAL prp_xcfft_box,parawrite
      82             : !     ..
      83             :       
      84             :     
      85             : !---> First, check whether an inp-file exists
      86             : !
      87          14 :       INQUIRE (file='inp',exist=l_inpexist)
      88          14 :       IF (.not.l_inpexist) THEN
      89           0 :          CALL juDFT_error("no inp- or input-file found!",calledby ="dimen7")
      90             :       ENDIF
      91             : !
      92             : !---> determine ntype,nop,natd,nwdd,nlod and layerd
      93             : !
      94             :       CALL first_glance(atoms%ntype,sym%nop,atoms%nat,atoms%nlod,vacuum%layerd,&
      95          14 :                         input%itmax,l_kpts,l_qpts,l_gamma,kpts%nkpt,kpts%nkpt3,nmopq)
      96          14 :       atoms%ntype=atoms%ntype
      97          14 :       atoms%nlod = max(atoms%nlod,1)
      98             : 
      99             :       ALLOCATE (&
     100             :      & atoms%lmax(atoms%ntype),atoms%ntypsy(atoms%nat),atoms%neq(atoms%ntype),atoms%nlhtyp(atoms%ntype),&
     101             :      & atoms%rmt(atoms%ntype),atoms%zatom(atoms%ntype),atoms%jri(atoms%ntype),atoms%dx(atoms%ntype), &
     102             :      & atoms%nlo(atoms%ntype),atoms%llo(atoms%nlod,atoms%ntype),atoms%nflip(atoms%ntype),atoms%bmu(atoms%ntype),&
     103             :      & noel(atoms%ntype),vacuum%izlay(vacuum%layerd,2),atoms%ncst(atoms%ntype),atoms%lnonsph(atoms%ntype),&
     104             :      & atoms%taual(3,atoms%nat),atoms%pos(3,atoms%nat),&
     105             :      & atoms%nz(atoms%ntype),atoms%relax(3,atoms%ntype),&
     106             :      & atoms%l_geo(atoms%ntype),noco%alph(atoms%ntype),noco%beta(atoms%ntype),&
     107             :      & atoms%lda_u(atoms%ntype),noco%l_relax(atoms%ntype),&
     108             :      & noco%b_con(2,atoms%ntype),&
     109             :      & sphhar%clnu(1,1,1),sphhar%nlh(1),sphhar%llh(1,1),sphhar%nmem(1,1),sphhar%mlh(1,1,1),&
     110             :      & hybrid%select1(4,atoms%ntype),hybrid%lcutm1(atoms%ntype),&
     111          14 :      & hybrid%lcutwf(atoms%ntype), STAT=ok)
     112             : !
     113             : !---> read complete input and calculate nvacd,llod,lmaxd,jmtd,neigd and 
     114             : !
     115             :       CALL rw_inp('r',&
     116             :      &            atoms,obsolete,vacuum,input,stars,sliceplot,banddos,&
     117             :      &                  cell,sym,xcpot,noco,oneD,hybrid,kpts,&
     118          14 :      &                  noel,namex,relcor,a1,a2,a3)
     119             : 
     120             : !---> pk non-collinear
     121             : !---> read the angle and spin-spiral information from nocoinp
     122          56 :       noco%qss = 0.0
     123          14 :       noco%l_ss = .false.
     124          14 :       IF (noco%l_noco) THEN 
     125           3 :          CALL inpnoco(atoms,input,vacuum,noco)
     126             :       ENDIF
     127             : 
     128          14 :       vacuum%nvacd = 2
     129          14 :       IF (sym%zrfs .OR. sym%invs .OR. oneD%odd%d1) vacuum%nvacd = 1
     130          14 :       atoms%llod  = 0
     131             :       atoms%lmaxd = 0
     132             :       atoms%jmtd  = 0
     133             :       rmtmax      = 0.0
     134          14 :       dimension%neigd = 0
     135          14 :       dimension%nstd  = maxval(atoms%ncst)
     136          14 :       atoms%lmaxd = maxval(atoms%lmax)
     137          14 :       atoms%jmtd  = maxval(atoms%jri)
     138          14 :       rmtmax      = maxval(atoms%rmt)
     139          46 :       DO n = 1,atoms%ntype
     140          39 :         DO ilo = 1,atoms%nlo(n)
     141             : !+apw
     142           7 :           IF (atoms%llo(ilo,n).LT.0) THEN
     143           0 :              atoms%llo(ilo,n) = -atoms%llo(ilo,n) - 1
     144             :           ELSE
     145           7 :              dimension%neigd = dimension%neigd + atoms%neq(n)*(2*abs(atoms%llo(ilo,n)) +1)
     146             :           ENDIF
     147             : !-apw
     148          39 :           atoms%llod = max(abs(atoms%llo(ilo,n)),atoms%llod)
     149             :         ENDDO
     150          32 :         nstate = 4
     151             :         IF ((atoms%nz(n).GE.21.AND.atoms%nz(n).LE.29) .OR. &
     152          32 :      &      (atoms%nz(n).GE.39.AND.atoms%nz(n).LE.47) .OR.&
     153             :      &      (atoms%nz(n).GE.57.AND.atoms%nz(n).LE.79)) nstate = 9
     154          32 :         IF ((atoms%nz(n).GE.58.AND.atoms%nz(n).LE.71) .OR.&
     155           0 :      &      (atoms%nz(n).GE.90.AND.atoms%nz(n).LE.103)) nstate = 16
     156          46 :         dimension%neigd = dimension%neigd + nstate*atoms%neq(n)
     157             : !
     158             :       ENDDO
     159          14 :       CALL ylmnorm_init(atoms%lmaxd)
     160             : !      IF (mod(lmaxd,2).NE.0) lmaxd = lmaxd + 1
     161          14 :       IF (2*DIMENSION%neigd.LT.MAX(5.0,input%zelec)) THEN
     162           0 :         WRITE(6,*) dimension%neigd,' states estimated in dimen7 ...'
     163           0 :         DIMENSION%neigd = MAX(5,NINT(0.75*input%zelec))
     164           0 :         WRITE(6,*) 'changed dimension%neigd to ',dimension%neigd
     165             :       ENDIF
     166          14 :       IF (noco%l_soc .and. (.not. noco%l_noco)) dimension%neigd=2*dimension%neigd 
     167          14 :       IF (noco%l_soc .and. noco%l_ss) dimension%neigd=(3*dimension%neigd)/2  
     168             :        ! not as accurate, but saves much time
     169             : 
     170          14 :       rmtmax = rmtmax*stars%gmax
     171          14 :       CALL convn_dim(rmtmax,dimension%ncvd)
     172             : !
     173             : ! determine core mesh
     174             : !
     175          14 :       dimension%msh = 0
     176          46 :       DO n = 1,atoms%ntype
     177          32 :          r = atoms%rmt(n)
     178          32 :          d = exp(atoms%dx(n))
     179          32 :          jrc = atoms%jri(n)
     180        8516 :          DO WHILE (r < atoms%rmt(n) + 20.0)
     181        4242 :             jrc = jrc + 1
     182        4274 :             r = r*d
     183             :          ENDDO
     184          46 :          dimension%msh = max( dimension%msh, jrc ) 
     185             :       ENDDO
     186             : !
     187             : ! ---> now, set the lattice harmonics, determine nlhd
     188             : !
     189          14 :       cell%amat(:,1) = a1(:)*input%scaleCell
     190          56 :       cell%amat(:,2) = a2(:)*input%scaleCell
     191          56 :       cell%amat(:,3) = a3(:)*input%scaleCell
     192          14 :       CALL inv3(cell%amat,cell%bmat,cell%omtil)
     193          14 :       IF (input%film) cell%omtil = cell%omtil/cell%amat(3,3)*vacuum%dvac
     194             : !-odim
     195          14 :       IF (oneD%odd%d1) cell%omtil = cell%amat(3,3)*pimach()*(vacuum%dvac**2)/4.
     196             : !+odim
     197          56 :       cell%bmat=tpi_const*cell%bmat
     198             :     
     199          14 :       na = 0
     200          46 :       DO n = 1,atoms%ntype
     201          67 :         DO n1 = 1,atoms%neq(n)
     202          35 :             na = na + 1
     203          35 :             IF (input%film) atoms%taual(3,na) = atoms%taual(3,na)/a3(3)
     204          67 :             atoms%pos(:,na) = matmul(cell%amat,atoms%taual(:,na))
     205             :         ENDDO
     206          46 :         atoms%zatom(n) = real( atoms%nz(n) )
     207             :       ENDDO
     208          14 :       ALLOCATE (sym%mrot(3,3,sym%nop),sym%tau(3,sym%nop))
     209          14 :       IF (sym%namgrp.EQ.'any ') THEN
     210           7 :          nopd = sym%nop ; rw = 'R'
     211           7 :          symfh = 94 ; symfn = 'sym.out'
     212           7 :          CALL rw_symfile(rw,symfh,symfn,nopd,cell%bmat,sym%mrot,sym%tau,sym%nop,sym%nop2,sym%symor)
     213             :       ELSE
     214           7 :          CALL spg2set(sym%nop,sym%zrfs,sym%invs,sym%namgrp,cell%latnam,sym%mrot,sym%tau,sym%nop2,sym%symor)
     215             :       ENDIF
     216          14 :       sphhar%ntypsd = 0
     217          14 :       IF (.NOT.oneD%odd%d1) THEN
     218             :         CALL local_sym(atoms%lmaxd,atoms%lmax,sym%nop,sym%mrot,sym%tau,&
     219             :                        atoms%nat,atoms%ntype,atoms%neq,cell%amat,cell%bmat,&
     220             :                        atoms%taual,sphhar%nlhd,sphhar%memd,sphhar%ntypsd,.true.,&
     221             :                        atoms%nlhtyp,atoms%ntypsy,sphhar%nlh,sphhar%llh,&
     222          14 :                        sphhar%nmem,sphhar%mlh,sphhar%clnu)
     223             : !-odim
     224             :       ELSEIF (oneD%odd%d1) THEN
     225           0 :         ntp1 = atoms%nat
     226           0 :         ALLOCATE (nq1(ntp1),lmx1(ntp1),nlhtp1(ntp1))
     227             :         ii = 1
     228           0 :         nq1=1
     229           0 :         DO i = 1,atoms%ntype
     230           0 :           DO j = 1,atoms%neq(i)
     231           0 :             lmx1(ii) = atoms%lmax(i)
     232           0 :             ii = ii + 1
     233             :           END DO
     234             :         END DO
     235             :         CALL local_sym(atoms%lmaxd,lmx1,sym%nop,sym%mrot,sym%tau,&
     236             :               atoms%nat,ntp1,nq1,cell%amat,cell%bmat,atoms%taual,&
     237             :               sphhar%nlhd,sphhar%memd,sphhar%ntypsd,.true.,nlhtp1,&
     238             :               atoms%ntypsy,sphhar%nlh,sphhar%llh,sphhar%nmem,&
     239           0 :               sphhar%mlh,sphhar%clnu)        
     240           0 :         ii = 1
     241           0 :         DO i = 1,atoms%ntype
     242           0 :           atoms%nlhtyp(i) = nlhtp1(ii)
     243           0 :           ii = ii + atoms%neq(i)
     244             :         END DO
     245           0 :         DEALLOCATE (nq1,lmx1,nlhtp1)
     246             :       END IF
     247             : !+odim
     248             : !
     249             : ! Check if symmetry is compatible with SOC or SSDW
     250             : !
     251          14 :       IF (noco%l_soc .and. (.not.noco%l_noco)) THEN  
     252             :         ! test symmetry for spin-orbit coupling
     253           3 :         ALLOCATE ( error(sym%nop) )
     254           3 :         CALL soc_sym(sym%nop,sym%mrot,noco%theta,noco%phi,cell%amat,error)
     255           6 :         IF ( ANY(error(:)) ) THEN
     256           2 :           WRITE(*,fmt='(1x)')
     257           2 :           WRITE(*,fmt='(A)') 'Symmetry incompatible with SOC spin-quantization axis ,'  
     258           2 :           WRITE(*,fmt='(A)') 'do not perform self-consistent calculations !'    
     259           2 :           WRITE(*,fmt='(1x)')
     260           2 :           IF ( input%eonly .or. (noco%l_soc.and.noco%l_ss) .or. input%gw.ne.0 ) THEN  ! .or. .
     261             :             CONTINUE 
     262             :           ELSE 
     263           2 :             IF (input%itmax>1) THEN
     264           0 :                CALL juDFT_error("symmetry & SOC",calledby ="dimen7")
     265             :             ENDIF 
     266             :           ENDIF 
     267             :         ENDIF           
     268           3 :         DEALLOCATE ( error )
     269             :       ENDIF
     270          14 :       IF (noco%l_ss) THEN  ! test symmetry for spin-spiral
     271           0 :         ALLOCATE ( error(sym%nop) )
     272           0 :         CALL ss_sym(sym%nop,sym%mrot,noco%qss,error)
     273           0 :         IF ( ANY(error(:)) )  CALL juDFT_error("symmetry & SSDW", calledby="dimen7")
     274           0 :         DEALLOCATE ( error )
     275             :       ENDIF
     276             : !
     277             : ! Dimensioning of the stars
     278             : !
     279          14 :       IF (input%film.OR.(sym%namgrp.ne.'any ')) THEN
     280             :          CALL strgn1_dim(stars%gmax,cell%bmat,sym%invs,sym%zrfs,sym%mrot,&
     281             :                     sym%tau,sym%nop,sym%nop2,stars%mx1,stars%mx2,stars%mx3,&
     282           8 :                     stars%ng3,stars%ng2,oneD%odd)
     283             : 
     284             :       ELSE
     285             :          CALL strgn2_dim(stars%gmax,cell%bmat,sym%invs,sym%zrfs,sym%mrot,&
     286             :                     sym%tau,sym%nop,stars%mx1,stars%mx2,stars%mx3,&
     287           6 :                     stars%ng3,stars%ng2)
     288           6 :          oneD%odd%n2d = stars%ng2
     289           6 :          oneD%odd%nq2 = stars%ng2
     290           6 :          oneD%odd%nop = sym%nop
     291             :       ENDIF
     292             : 
     293          14 :       IF ( xcpot%gmaxxc .le. 10.0**(-6) ) THEN
     294           0 :          WRITE (6,'(" xcpot%gmaxxc=0 : xcpot%gmaxxc=stars%gmax choosen as default value")')
     295           0 :          WRITE (6,'(" concerning memory, you may want to choose a smaller value for stars%gmax")')
     296           0 :          xcpot%gmaxxc=stars%gmax
     297             :       END IF
     298             : 
     299          14 :       CALL prp_xcfft_box(xcpot%gmaxxc,cell%bmat,stars%kxc1_fft,stars%kxc2_fft,stars%kxc3_fft)
     300             : !
     301             : ! k-point generator provides kpts-file, if it's missing:
     302             : !
     303          14 :       IF (.not.l_kpts) THEN
     304           2 :        IF (.NOT.oneD%odd%d1) THEN
     305           2 :           IF(l_gamma .AND. banddos%ndir .EQ. 0) THEN
     306           0 :          call judft_error("gamma swtich not supported in old inp file anymore",calledby="dimen7")
     307             :          ELSE
     308           2 :          CALL julia(sym,cell,input,noco,banddos,kpts,.false.,.FALSE.)
     309             :          ENDIF
     310             :        ELSE
     311           0 :         CALL od_kptsgen (kpts%nkpt)
     312             :        ENDIF
     313             :       ELSE
     314          12 :         IF(input%gw.eq.2) THEN
     315           0 :           INQUIRE(file='QGpsi',exist=l_kpts) ! Use QGpsi if it exists ot
     316           0 :           IF(l_kpts) THEN
     317           0 :             WRITE(6,*) 'QGpsi exists and will be used to generate kpts-file'
     318           0 :             OPEN (15,file='QGpsi',form='unformatted',status='old',action='read')
     319           0 :             OPEN (41,file='kpts',form='formatted',status='unknown')
     320           0 :             REWIND(41)
     321           0 :             READ (15) kpts%nkpt
     322           0 :             WRITE (41,'(i5,f20.10)') kpts%nkpt,1.0
     323           0 :             DO n = 1, kpts%nkpt
     324           0 :               READ (15) q
     325           0 :               WRITE (41,'(4f10.5)') MATMUL(TRANSPOSE(cell%amat),q)/input%scaleCell,1.0
     326           0 :               READ (15)
     327             :             ENDDO
     328           0 :             CLOSE (15)
     329           0 :             CLOSE (41)
     330             :           ENDIF
     331             :         ENDIF
     332             :       ENDIF
     333             :       
     334          14 :       dimension%neigd = max(dimension%neigd,input%gw_neigd)
     335             : 
     336             : !
     337             : ! Using the k-point generator also for creation of q-points for the
     338             : ! J-constants calculation:
     339          14 :       IF(.not.l_qpts)THEN
     340           0 :         kpts%nkpt3=nmopq
     341           0 :         l_tmp=(/noco%l_ss,noco%l_soc/)
     342           0 :         noco%l_ss=.false.
     343           0 :         noco%l_soc=.false.
     344           0 :         CALL julia(sym,cell,input,noco,banddos,kpts,.true.,.FALSE.)
     345           0 :         noco%l_ss=l_tmp(1); noco%l_soc=l_tmp(2)
     346             :       ENDIF
     347             : 
     348             : !
     349             : ! now proceed as usual
     350             : !
     351          14 :       CALL inpeig_dim(input,obsolete,cell,noco,oneD,kpts,dimension,stars)
     352          14 :       vacuum%layerd = max(vacuum%layerd,1)
     353          14 :       dimension%nstd = max(dimension%nstd,30)
     354             :       atoms%ntype = atoms%ntype
     355          14 :       IF (noco%l_noco) dimension%neigd = 2*dimension%neigd
     356             : 
     357          14 :       atoms%nlod = max(atoms%nlod,2) ! for chkmt
     358             :       input%jspins=input%jspins
     359          14 :       CALL parawrite(sym,stars,atoms,sphhar,DIMENSION,vacuum,obsolete,kpts,oneD,input)
     360             : 
     361           0 :       DEALLOCATE( sym%mrot,sym%tau,&
     362           0 :      & atoms%lmax,atoms%ntypsy,atoms%neq,atoms%nlhtyp,atoms%rmt,atoms%zatom,atoms%jri,atoms%dx,atoms%nlo,atoms%llo,atoms%nflip,atoms%bmu,noel,&
     363           0 :      & vacuum%izlay,atoms%ncst,atoms%lnonsph,atoms%taual,atoms%pos,atoms%nz,atoms%relax,&
     364           0 :      & atoms%l_geo,noco%alph,noco%beta,atoms%lda_u,noco%l_relax,noco%b_con,sphhar%clnu,sphhar%nlh,&
     365           0 :      & sphhar%llh,sphhar%nmem,sphhar%mlh,hybrid%select1,hybrid%lcutm1,&
     366         504 :      & hybrid%lcutwf)
     367             : 
     368          14 :       RETURN
     369          14 :       END SUBROUTINE dimen7
     370             :       END MODULE m_dimen7

Generated by: LCOV version 1.13