LCOV - code coverage report
Current view: top level - main - fleur_init.F90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 193 260 74.2 %
Date: 2019-09-08 04:53:50 Functions: 1 1 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             :       MODULE m_fleur_init
       7             :       IMPLICIT NONE
       8             :       CONTAINS
       9         152 :         SUBROUTINE fleur_init(mpi,&
      10             :              input,field,DIMENSION,atoms,sphhar,cell,stars,sym,noco,vacuum,forcetheo,&
      11             :              sliceplot,banddos,obsolete,enpara,xcpot,results,kpts,hybrid,&
      12             :              oneD,coreSpecInput,wann,l_opti)
      13             :           USE m_types
      14             :           USE m_judft
      15             :           USE m_juDFT_init
      16             :           USE m_init_wannier_defaults
      17             :           USE m_rinpXML
      18             :           USE m_postprocessInput
      19             :           USE m_gen_map
      20             :           USE m_dwigner
      21             :           USE m_gen_bz
      22             :           USE m_ylm
      23             :           USE m_InitParallelProcesses
      24             :           USE m_checkInputParams
      25             :           USE m_xmlOutput
      26             :           USE m_constants
      27             :           USE m_winpXML
      28             :           USE m_writeOutParameters
      29             :           USE m_setupMPI
      30             :           USE m_cdn_io
      31             :           USE m_fleur_info
      32             :           USE m_mixing_history
      33             :           USE m_checks
      34             :           USE m_prpqfftmap
      35             :           USE m_writeOutHeader
      36             :           USE m_fleur_init_old
      37             :           USE m_types_xcpot_inbuild
      38             :           USE m_mpi_bc_xcpot
      39             : 
      40             : #ifdef CPP_MPI
      41             :           USE m_mpi_bc_all,  ONLY : mpi_bc_all
      42             : #ifndef CPP_OLDINTEL
      43             :           USE m_mpi_dist_forcetheorem
      44             : #endif
      45             : #endif
      46             : #ifdef CPP_HDF
      47             :           USE m_hdf_tools
      48             : #endif
      49             :           IMPLICIT NONE
      50             :           !     Types, these variables contain a lot of data!
      51             :           TYPE(t_mpi)    ,INTENT(INOUT):: mpi
      52             :           TYPE(t_input)    ,INTENT(OUT):: input
      53             :           TYPE(t_field),    INTENT(OUT) :: field
      54             :           TYPE(t_dimension),INTENT(OUT):: DIMENSION
      55             :           TYPE(t_atoms)    ,INTENT(OUT):: atoms
      56             :           TYPE(t_sphhar)   ,INTENT(OUT):: sphhar
      57             :           TYPE(t_cell)     ,INTENT(OUT):: cell
      58             :           TYPE(t_stars)    ,INTENT(OUT):: stars
      59             :           TYPE(t_sym)      ,INTENT(OUT):: sym
      60             :           TYPE(t_noco)     ,INTENT(OUT):: noco
      61             :           TYPE(t_vacuum)   ,INTENT(OUT):: vacuum
      62             :           TYPE(t_sliceplot),INTENT(OUT):: sliceplot
      63             :           TYPE(t_banddos)  ,INTENT(OUT):: banddos
      64             :           TYPE(t_obsolete) ,INTENT(OUT):: obsolete 
      65             :           TYPE(t_enpara)   ,INTENT(OUT):: enpara
      66             :           CLASS(t_xcpot),ALLOCATABLE,INTENT(OUT):: xcpot
      67             :           TYPE(t_results)  ,INTENT(OUT):: results
      68             :           TYPE(t_kpts)     ,INTENT(OUT):: kpts
      69             :           TYPE(t_hybrid)   ,INTENT(OUT):: hybrid
      70             :           TYPE(t_oneD)     ,INTENT(OUT):: oneD
      71             :           TYPE(t_coreSpecInput),INTENT(OUT) :: coreSpecInput
      72             :           TYPE(t_wann)     ,INTENT(OUT):: wann
      73             :           CLASS(t_forcetheo),ALLOCATABLE,INTENT(OUT)::forcetheo
      74             :           LOGICAL,          INTENT(OUT):: l_opti
      75             : 
      76             : 
      77          76 :           INTEGER, ALLOCATABLE          :: xmlElectronStates(:,:)
      78          76 :           INTEGER, ALLOCATABLE          :: atomTypeSpecies(:)
      79          76 :           INTEGER, ALLOCATABLE          :: speciesRepAtomType(:)
      80          76 :           REAL, ALLOCATABLE             :: xmlCoreOccs(:,:,:)
      81          76 :           LOGICAL, ALLOCATABLE          :: xmlPrintCoreStates(:,:)
      82          76 :           CHARACTER(len=3), ALLOCATABLE :: noel(:)
      83             :           !     .. Local Scalars ..
      84             :           INTEGER    :: i,n,l,m1,m2,isym,iisym,numSpecies,pc,iAtom,iType
      85             :           COMPLEX    :: cdum
      86             :           CHARACTER(len=4)              :: namex
      87             :           CHARACTER(len=12)             :: relcor
      88             :           CHARACTER(LEN=20)             :: filename
      89             :           REAL                          :: a1(3),a2(3),a3(3)
      90             :           REAL                          :: dtild, phi_add
      91             :           LOGICAL                       :: l_found, l_kpts, l_exist
      92             : 
      93             : #ifdef CPP_MPI
      94             :           INCLUDE 'mpif.h'
      95             :           INTEGER ierr(3)
      96          76 :           CALL MPI_COMM_RANK (mpi%mpi_comm,mpi%irank,ierr)
      97          76 :           CALL MPI_COMM_SIZE (mpi%mpi_comm,mpi%isize,ierr)
      98             : #else
      99             :           mpi%irank=0 ; mpi%isize=1; mpi%mpi_comm=1
     100             : #endif
     101             :           !determine if we use an xml-input file
     102          76 :           INQUIRE (file='inp.xml',exist=input%l_inpXML)
     103          76 :           INQUIRE(file='inp',exist=l_found)
     104          76 :           IF (input%l_inpXML) THEN
     105             :              !xml found, we will use it, check if we also have a inp-file
     106          48 :              IF (l_found) CALL judft_warn("Both inp & inp.xml given.", calledby="fleur_init",hint="Please delete one of the input files")
     107             :           ELSE
     108          28 :              IF (.NOT.l_found) CALL judft_error("No input file found",calledby='fleur_init',hint="To use FLEUR, you have to provide either an 'inp' or an 'inp.xml' file in the working directory")
     109             :           END IF
     110             : 
     111          76 :           CALL check_command_line()
     112             : #ifdef CPP_HDF
     113          76 :           CALL hdf_init()
     114             : #endif
     115             :           !call juDFT_check_para()
     116          76 :           CALL field%init(input)
     117             : 
     118          76 :           input%gw                = -1
     119          76 :           input%gw_neigd          =  0
     120             :           !-t3e
     121          76 :           IF (mpi%irank.EQ.0) THEN
     122          38 :              CALL startFleur_XMLOutput()
     123          38 :              IF (judft_was_argument("-info")) THEN
     124           0 :                   CLOSE(6)
     125           0 :                   OPEN (6,status='SCRATCH')
     126             :              ELSE
     127          38 :                   IF (.not.judft_was_argument("-no_out")) &
     128          38 :                   OPEN (6,file='out',form='formatted',status='unknown')
     129             :              ENDIF
     130          38 :              CALL writeOutHeader()
     131             :              !OPEN (16,status='SCRATCH')
     132             :           ENDIF
     133             : 
     134          76 :           input%l_rdmft = .FALSE.
     135             : 
     136          76 :           input%l_wann = .FALSE.
     137          76 :           CALL initWannierDefaults(wann)
     138             : 
     139          76 :           input%minDistance = 0.0
     140          76 :           input%ldauLinMix = .FALSE.
     141          76 :           input%ldauMixParam = 0.05
     142          76 :           input%ldauSpinf = 1.0
     143          76 :           input%pallst = .FALSE.
     144          76 :           input%scaleCell = 1.0
     145          76 :           input%scaleA1 = 1.0
     146          76 :           input%scaleA2 = 1.0
     147          76 :           input%scaleC = 1.0
     148          76 :           input%forcealpha = 1.0
     149          76 :           input%forcemix = 2 ! BFGS is default.
     150          76 :           input%epsdisp = 0.00001
     151          76 :           input%epsforce = 0.00001
     152          76 :           input%numBandsKPoints = -1
     153             : 
     154          76 :           kpts%ntet = 1
     155          76 :           kpts%numSpecialPoints = 1
     156             : 
     157          76 :           sliceplot%iplot=.FALSE.
     158          76 :           sliceplot%kk = 0
     159          76 :           sliceplot%e1s = 0.0
     160          76 :           sliceplot%e2s = 0.0
     161          76 :           sliceplot%nnne = 0
     162             : 
     163          76 :           banddos%l_mcd = .FALSE.
     164          76 :           banddos%e_mcd_lo = -10.0
     165          76 :           banddos%e_mcd_up = 0.0
     166             : 
     167          76 :           banddos%unfoldband = .FALSE.
     168          76 :           banddos%s_cell_x = 1
     169          76 :           banddos%s_cell_y = 1
     170          76 :           banddos%s_cell_z = 1
     171             : 
     172          76 :           noco%l_mtNocoPot = .FALSE.
     173             : 
     174         104 :           IF (input%l_inpXML) THEN            
     175          48 :              ALLOCATE(noel(1))
     176          48 :              IF (mpi%irank.EQ.0) THEN
     177          24 :                 WRITE (6,*) 'XML code path used: Calculation parameters are stored in out.xml'
     178          24 :                 ALLOCATE(kpts%specialPoints(3,kpts%numSpecialPoints))
     179          24 :                 ALLOCATE(atomTypeSpecies(1),speciesRepAtomType(1))
     180          24 :                 ALLOCATE(xmlElectronStates(1,1),xmlPrintCoreStates(1,1))
     181          24 :                 ALLOCATE(xmlCoreOccs(1,1,1))
     182          24 :                 namex = '    '
     183          24 :                 relcor = '            '
     184          24 :                 a1 = 0.0
     185          24 :                 a2 = 0.0
     186          24 :                 a3 = 0.0
     187          24 :                 CALL timestart("r_inpXML") 
     188             :                 CALL r_inpXML(&
     189             :                      atoms,obsolete,vacuum,input,stars,sliceplot,banddos,DIMENSION,forcetheo,field,&
     190             :                      cell,sym,xcpot,noco,oneD,hybrid,kpts,enpara,coreSpecInput,wann,&
     191             :                      noel,namex,relcor,a1,a2,a3,dtild,xmlElectronStates,&
     192             :                      xmlPrintCoreStates,xmlCoreOccs,atomTypeSpecies,speciesRepAtomType,&
     193          24 :                      l_kpts)
     194          24 :                 CALL timestop("r_inpXML") 
     195             :              END IF
     196          48 :              CALL mpi_bc_xcpot(xcpot,mpi)
     197             : #ifdef CPP_MPI
     198             : #ifndef CPP_OLDINTEL
     199          48 :              CALL mpi_dist_forcetheorem(mpi,forcetheo)
     200             : #endif
     201             : #endif
     202             :             
     203          48 :              CALL timestart("postprocessInput") 
     204             :              CALL postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,obsolete,kpts,&
     205             :                                    oneD,hybrid,cell,banddos,sliceplot,xcpot,forcetheo,&
     206          48 :                                    noco,dimension,enpara,sphhar,l_opti,l_kpts)
     207          48 :              CALL timestop("postprocessInput") 
     208             : 
     209          48 :              IF (mpi%irank.EQ.0) THEN
     210          24 :                 filename = ''
     211          24 :                 numSpecies = SIZE(speciesRepAtomType)
     212             :                 CALL w_inpXML(&
     213             :                               atoms,obsolete,vacuum,input,stars,sliceplot,forcetheo,banddos,&
     214             :                               cell,sym,xcpot,noco,oneD,hybrid,kpts,kpts%nkpt3,kpts%l_gamma,&
     215             :                               noel,namex,relcor,a1,a2,a3,dtild,input%comment,&
     216             :                               xmlElectronStates,xmlPrintCoreStates,xmlCoreOccs,&
     217             :                               atomTypeSpecies,speciesRepAtomType,.TRUE.,filename,&
     218          24 :                              .TRUE.,numSpecies,enpara)
     219             : 
     220          24 :                 DEALLOCATE(atomTypeSpecies,speciesRepAtomType)
     221          24 :                 DEALLOCATE(xmlElectronStates,xmlPrintCoreStates,xmlCoreOccs)
     222             :              END IF
     223             : 
     224          48 :              DEALLOCATE(noel)
     225             : 
     226             : #ifdef CPP_MPI
     227             :              CALL initParallelProcesses(atoms,vacuum,input,stars,sliceplot,banddos,&
     228             :                   DIMENSION,cell,sym,xcpot,noco,oneD,hybrid,&
     229          48 :                   kpts,enpara,sphhar,mpi,obsolete)
     230             : 
     231             : #endif
     232             : 
     233             :           ELSE ! else branch of "IF (input%l_inpXML) THEN"
     234             :              CALL fleur_init_old(mpi,&
     235             :                   input,DIMENSION,atoms,sphhar,cell,stars,sym,noco,vacuum,forcetheo,&
     236             :                   sliceplot,banddos,obsolete,enpara,xcpot,kpts,hybrid,&
     237          28 :                   oneD,coreSpecInput,l_opti)
     238             :           END IF ! end of else branch of "IF (input%l_inpXML) THEN"
     239             :           !
     240             :   
     241          76 :           IF (.NOT.mpi%irank==0) CALL enpara%init(atoms,input%jspins,.FALSE.)
     242             :                    !-odim
     243          76 :           oneD%odd%nq2 = oneD%odd%n2d
     244          76 :           oneD%odd%kimax2 = oneD%odd%nq2 - 1
     245          76 :           oneD%odd%nat = atoms%nat
     246             : 
     247          76 :           oneD%odi%d1 = oneD%odd%d1 ; oneD%odi%mb = oneD%odd%mb ; oneD%odi%M = oneD%odd%M
     248          76 :           oneD%odi%k3 = oneD%odd%k3 ; oneD%odi%chi = oneD%odd%chi ; oneD%odi%rot = oneD%odd%rot
     249          76 :           oneD%odi%invs = oneD%odd%invs ; oneD%odi%zrfs = oneD%odd%zrfs
     250          76 :           oneD%odi%n2d = oneD%odd%n2d ; oneD%odi%nq2 = oneD%odd%nq2 ; oneD%odi%nn2d = oneD%odd%nn2d
     251          76 :           oneD%odi%kimax2 = oneD%odd%kimax2 ; oneD%odi%m_cyl = oneD%odd%m_cyl
     252          76 :           oneD%odi%ig => oneD%ig1 ; oneD%odi%kv => oneD%kv1 ; oneD%odi%nst2 => oneD%nstr1
     253             : 
     254          76 :           oneD%ods%nop = oneD%odd%nop ; oneD%ods%nat = oneD%odd%nat
     255          76 :           oneD%ods%mrot => oneD%mrot1 ; oneD%ods%tau => oneD%tau1 ; oneD%ods%ngopr => oneD%ngopr1
     256          76 :           oneD%ods%invtab => oneD%invtab1 ; oneD%ods%multab => oneD%multab1
     257             : 
     258          76 :           oneD%odl%nn2d = oneD%odd%nn2d
     259          76 :           oneD%odl%igf => oneD%igfft1 ; oneD%odl%pgf => oneD%pgfft1
     260             : 
     261          76 :           oneD%odg%nn2d = oneD%odd%nn2d
     262          76 :           oneD%odg%pgfx => oneD%pgft1x ; oneD%odg%pgfy => oneD%pgft1y
     263          76 :           oneD%odg%pgfxx => oneD%pgft1xx ; oneD%odg%pgfyy => oneD%pgft1yy ; oneD%odg%pgfxy => oneD%pgft1xy
     264             :           !+odim
     265             :           !
     266             : 
     267             : #ifdef CPP_MPI
     268          76 :           CALL MPI_BCAST(l_opti,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
     269          76 :           CALL MPI_BCAST(noco%l_noco,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
     270          76 :           CALL MPI_BCAST(noco%l_soc,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
     271          76 :           CALL MPI_BCAST(input%strho ,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
     272          76 :           CALL MPI_BCAST(input%jspins,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
     273          76 :           CALL MPI_BCAST(atoms%n_u,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
     274          76 :           CALL MPI_BCAST(atoms%lmaxd,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
     275          76 :           call MPI_BCAST( input%preconditioning_param, 1, MPI_DOUBLE_PRECISION, 0, mpi%mpi_comm, ierr )
     276             : #endif
     277          76 :           CALL ylmnorm_init(max(atoms%lmaxd, 2*hybrid%lexp))
     278             :           !
     279             :           !--> determine more dimensions
     280             :           !
     281          76 :           DIMENSION%nbasfcn = DIMENSION%nvd + atoms%nat*atoms%nlod*(2*atoms%llod+1)
     282          76 :           DIMENSION%lmd     = atoms%lmaxd* (atoms%lmaxd+2)
     283          76 :           DIMENSION%lmplmd  = (DIMENSION%lmd* (DIMENSION%lmd+3))/2
     284             : 
     285          76 :           ALLOCATE (stars%igq_fft(0:stars%kq1_fft*stars%kq2_fft*stars%kq3_fft-1))
     286          76 :           ALLOCATE (stars%igq2_fft(0:stars%kq1_fft*stars%kq2_fft-1))
     287             : #ifdef CPP_MPI
     288             :           CALL mpi_bc_all(mpi,stars,sphhar,atoms,obsolete,sym,kpts,DIMENSION,input,field,&
     289          76 :                           banddos,sliceplot,vacuum,cell,enpara,noco,oneD,hybrid)
     290             : #endif
     291             : 
     292             :           ! Set up pointer for backtransformation from g-vector in positive 
     293             :           ! domain of carge density fftibox into stars
     294          76 :           CALL prp_qfft_map(stars,sym,input,stars%igq2_fft,stars%igq_fft)
     295             : 
     296          76 :           atoms%nlotot = 0
     297         250 :           DO n = 1, atoms%ntype
     298         300 :              DO l = 1,atoms%nlo(n)
     299         224 :                 atoms%nlotot = atoms%nlotot + atoms%neq(n) * ( 2*atoms%llo(l,n) + 1 )
     300             :              ENDDO
     301             :           ENDDO
     302             : 
     303             :           !-t3e
     304             :           !-odim
     305          76 :           oneD%odd%nq2 = oneD%odd%n2d
     306          76 :           oneD%odd%kimax2 = oneD%odd%nq2 - 1
     307          76 :           oneD%odd%nat = atoms%nat
     308             : 
     309          76 :           oneD%odi%d1 = oneD%odd%d1 ; oneD%odi%mb = oneD%odd%mb ; oneD%odi%M = oneD%odd%M
     310          76 :           oneD%odi%k3 = oneD%odd%k3 ; oneD%odi%chi = oneD%odd%chi ; oneD%odi%rot = oneD%odd%rot
     311          76 :           oneD%odi%invs = oneD%odd%invs ; oneD%odi%zrfs = oneD%odd%zrfs
     312          76 :           oneD%odi%n2d = oneD%odd%n2d ; oneD%odi%nq2 = oneD%odd%nq2 ; oneD%odi%nn2d = oneD%odd%nn2d
     313          76 :           oneD%odi%kimax2 = oneD%odd%kimax2 ; oneD%odi%m_cyl = oneD%odd%m_cyl
     314          76 :           oneD%odi%ig => oneD%ig1 ; oneD%odi%kv => oneD%kv1 ; oneD%odi%nst2 => oneD%nstr1
     315             : 
     316          76 :           oneD%ods%nop = oneD%odd%nop ; oneD%ods%nat = oneD%odd%nat
     317          76 :           oneD%ods%mrot => oneD%mrot1 ; oneD%ods%tau => oneD%tau1 ; oneD%ods%ngopr => oneD%ngopr1
     318          76 :           oneD%ods%invtab => oneD%invtab1 ; oneD%ods%multab => oneD%multab1
     319             : 
     320          76 :           oneD%odl%nn2d = oneD%odd%nn2d
     321          76 :           oneD%odl%igf => oneD%igfft1 ; oneD%odl%pgf => oneD%pgfft1
     322             : 
     323          76 :           oneD%odg%nn2d = oneD%odd%nn2d
     324          76 :           oneD%odg%pgfx => oneD%pgft1x ; oneD%odg%pgfy => oneD%pgft1y
     325          76 :           oneD%odg%pgfxx => oneD%pgft1xx ; oneD%odg%pgfyy => oneD%pgft1yy ; oneD%odg%pgfxy => oneD%pgft1xy
     326             :           !+odim
     327          76 :           IF (noco%l_noco) DIMENSION%nbasfcn = 2*DIMENSION%nbasfcn
     328             :           
     329          76 :           IF( sym%invs .OR. noco%l_soc ) THEN
     330          64 :              sym%nsym = sym%nop
     331             :           ELSE
     332             :              ! combine time reversal symmetry with the spatial symmetry opera
     333             :              ! thus the symmetry operations are doubled
     334          12 :              sym%nsym = 2*sym%nop
     335             :           END IF
     336             : 
     337          76 :           CALL checkInputParams(mpi,input,dimension,atoms,noco,xcpot,oneD)
     338             : 
     339             :           ! Initializations for Wannier functions (start)
     340          76 :           IF (mpi%irank.EQ.0) THEN
     341             : #ifdef CPP_WANN
     342             :              INQUIRE(FILE='plotbscomf',EXIST=wann%l_bs_comf)
     343             :              WRITE(*,*)'l_bs_comf=',wann%l_bs_comf
     344             :              WRITE(*,*) 'Logical variables for wannier functions to be read in!!'
     345             : #endif
     346          38 :              wann%l_gwf = wann%l_ms.OR.wann%l_sgwf.OR.wann%l_socgwf
     347             : 
     348          38 :              if(wann%l_gwf) then
     349           0 :                 WRITE(*,*)'running HDWF-extension of FLEUR code'
     350           0 :                 WRITE(*,*)'with l_sgwf =',wann%l_sgwf,' and l_socgwf =',wann%l_socgwf
     351             : 
     352           0 :                 IF(wann%l_socgwf.AND. .NOT.noco%l_soc) THEN
     353           0 :                   CALL juDFT_error("set l_soc=T if l_socgwf=T",calledby="fleur_init")
     354             :                 END IF
     355             : 
     356           0 :                 IF((wann%l_ms.or.wann%l_sgwf).AND..NOT.(noco%l_noco.AND.noco%l_ss)) THEN
     357           0 :                    CALL juDFT_error("set l_noco=l_ss=T for l_sgwf.or.l_ms",calledby="fleur_init")
     358             :                 END IF
     359             : 
     360           0 :                 IF((wann%l_ms.or.wann%l_sgwf).and.wann%l_socgwf) THEN
     361           0 :                    CALL juDFT_error("(l_ms.or.l_sgwf).and.l_socgwf",calledby="fleur_init")
     362             :                 END IF
     363             : 
     364           0 :                 INQUIRE(FILE=wann%param_file,EXIST=l_exist)
     365           0 :                 IF(.NOT.l_exist) THEN
     366           0 :                    CALL juDFT_error("where is param_file"//trim(wann%param_file)//"?",calledby="fleur_init")
     367             :                 END IF
     368           0 :                 OPEN (113,file=wann%param_file,status='old')
     369           0 :                 READ (113,*) wann%nparampts,wann%scale_param
     370           0 :                 CLOSE(113)
     371             :              ELSE
     372          38 :                 wann%nparampts=1
     373          38 :                 wann%scale_param=1.0
     374             :              END IF
     375             :           END IF
     376             : 
     377             : #ifdef CPP_MPI
     378          76 :           CALL MPI_BCAST(wann%l_bs_comf,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
     379          76 :           CALL MPI_BCAST(wann%l_gwf,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
     380          76 :           CALL MPI_BCAST(wann%nparampts,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
     381          76 :           CALL MPI_BCAST(wann%scale_param,1,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
     382             : 
     383          76 :           CALL MPI_BCAST(wann%l_sgwf,1,MPI_LOGICAL,0,MPI_COMM_WORLD,ierr)
     384          76 :           CALL MPI_BCAST(wann%l_socgwf,1,MPI_LOGICAL,0,MPI_COMM_WORLD,ierr)
     385          76 :           CALL MPI_BCAST(wann%l_ms,1,MPI_LOGICAL,0,MPI_COMM_WORLD,ierr)
     386             : #endif
     387             : 
     388          76 :           ALLOCATE (wann%param_vec(3,wann%nparampts))
     389          76 :           ALLOCATE (wann%param_alpha(atoms%ntype,wann%nparampts))
     390             : 
     391          76 :           IF(mpi%irank.EQ.0) THEN
     392          38 :              IF(wann%l_gwf) THEN
     393           0 :                 OPEN(113,file=wann%param_file,status='old')
     394           0 :                 READ(113,*)!header
     395           0 :                 write(6,*) 'parameter points for HDWFs generation:'
     396           0 :                 IF(wann%l_sgwf.or.wann%l_ms) THEN
     397           0 :                    WRITE(6,*)'      q1       ','      q2       ','      q3'
     398           0 :                 ELSE IF(wann%l_socgwf) THEN
     399           0 :                    WRITE(6,*)'      --       ','     phi       ','    theta'
     400             :                 END IF
     401             : 
     402           0 :                 DO pc = 1, wann%nparampts
     403           0 :                    READ(113,'(3(f14.10,1x))') wann%param_vec(1,pc), wann%param_vec(2,pc), wann%param_vec(3,pc)
     404           0 :                    wann%param_vec(:,pc) = wann%param_vec(:,pc) / wann%scale_param
     405           0 :                    WRITE(6,'(3(f14.10,1x))') wann%param_vec(1,pc), wann%param_vec(2,pc), wann%param_vec(3,pc)
     406           0 :                    IF(wann%l_sgwf.or.wann%l_ms) THEN
     407           0 :                       iAtom = 1
     408           0 :                       DO iType = 1, atoms%ntype
     409             :                          phi_add = tpi_const*(wann%param_vec(1,pc)*atoms%taual(1,iAtom) +&
     410             :                                               wann%param_vec(2,pc)*atoms%taual(2,iAtom) +&
     411           0 :                                               wann%param_vec(3,pc)*atoms%taual(3,iAtom))
     412           0 :                          wann%param_alpha(iType,pc) = noco%alph(iType) + phi_add
     413           0 :                          iAtom = iAtom + atoms%neq(iType)
     414             :                       END DO  
     415             :                    END IF
     416             :                 END DO
     417             : 
     418           0 :                 IF(ANY(wann%param_vec(1,:).NE.wann%param_vec(1,1))) wann%l_dim(1)=.true.
     419           0 :                 IF(ANY(wann%param_vec(2,:).NE.wann%param_vec(2,1))) wann%l_dim(2)=.true.
     420           0 :                 IF(ANY(wann%param_vec(3,:).NE.wann%param_vec(3,1))) wann%l_dim(3)=.true.
     421             : 
     422           0 :                 CLOSE(113)
     423             : 
     424           0 :                 IF(wann%l_dim(1).and.wann%l_socgwf) THEN
     425           0 :                    CALL juDFT_error("do not specify 1st component if l_socgwf",calledby="fleur_init")
     426             :                 END IF
     427             :              END IF!(wann%l_gwf)
     428             :           END IF!(mpi%irank.EQ.0)
     429             : 
     430             : #ifdef CPP_MPI
     431          76 :           CALL MPI_BCAST(wann%param_vec,3*wann%nparampts,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ierr)
     432          76 :           CALL MPI_BCAST(wann%param_alpha,atoms%ntype*wann%nparampts,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ierr)
     433          76 :           CALL MPI_BCAST(wann%l_dim,3,MPI_LOGICAL,0,MPI_COMM_WORLD,ierr)
     434             : #endif
     435             : 
     436             :           ! Initializations for Wannier functions (end)
     437             : 
     438          76 :           IF (xcpot%is_hybrid().OR.input%l_rdmft) THEN
     439             : 
     440             : !             IF( ANY( atoms%l_geo  ) )&
     441             : !                  &     CALL juDFT_error("Forces not implemented for HF/PBE0/HSE ",&
     442             : !                  &                    calledby ="fleur")
     443             : 
     444             :              !calculate whole Brilloun zone
     445             :              !CALL gen_bz(kpts,sym)
     446           0 :              CALL gen_map(atoms,sym,oneD,hybrid)
     447             : 
     448             :              ! calculate d_wgn
     449           0 :              ALLOCATE (hybrid%d_wgn2(-atoms%lmaxd:atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,0:atoms%lmaxd,sym%nsym))
     450           0 :              CALL d_wigner(sym%nop,sym%mrot,cell%bmat,atoms%lmaxd,hybrid%d_wgn2(:,:,1:,:sym%nop))
     451           0 :              hybrid%d_wgn2(:,:,0,:) = 1
     452             : 
     453           0 :              DO isym = sym%nop+1,sym%nsym
     454           0 :                 iisym = isym - sym%nop
     455           0 :                 DO l = 0,atoms%lmaxd
     456           0 :                    DO m2 = -l,l
     457           0 :                       DO m1 = -l,-1
     458           0 :                          cdum                  = hybrid%d_wgn2( m1,m2,l,iisym)
     459           0 :                          hybrid%d_wgn2( m1,m2,l,isym) = hybrid%d_wgn2(-m1,m2,l,iisym)*(-1)**m1
     460           0 :                          hybrid%d_wgn2(-m1,m2,l,isym) = cdum                  *(-1)**m1
     461             :                       END DO
     462           0 :                       hybrid%d_wgn2(0,m2,l,isym) = hybrid%d_wgn2(0,m2,l,iisym)
     463             :                    END DO
     464             :                 END DO
     465             :              END DO
     466             :           ELSE
     467          90 :              IF ( banddos%dos .AND. banddos%ndir == -3 ) THEN
     468           0 :                 WRITE(*,*) 'Recalculating k point grid to cover the full BZ.'
     469           0 :                 CALL gen_bz(kpts,sym)
     470           0 :                 kpts%nkpt = kpts%nkptf
     471           0 :                 DEALLOCATE(kpts%bk,kpts%wtkpt)
     472           0 :                 ALLOCATE(kpts%bk(3,kpts%nkptf),kpts%wtkpt(kpts%nkptf))
     473           0 :                 kpts%bk(:,:) = kpts%bkf(:,:)
     474           0 :                 IF (kpts%nkpt3(1)*kpts%nkpt3(2)*kpts%nkpt3(3).NE.kpts%nkptf) THEN
     475           0 :                    IF(kpts%l_gamma) THEN
     476           0 :                       kpts%wtkpt = 1.0 / (kpts%nkptf-1)
     477           0 :                       DO i = 1, kpts%nkptf
     478           0 :                          IF(ALL(kpts%bk(:,i).EQ.0.0)) THEN
     479           0 :                             kpts%wtkpt(i) = 0.0
     480             :                          END IF
     481             :                       END DO
     482             :                    ELSE
     483           0 :                       CALL juDFT_error("nkptf does not match product of nkpt3(i).",calledby="fleur_init")
     484             :                    END IF
     485             :                 ELSE
     486           0 :                    kpts%wtkpt = 1.0 / kpts%nkptf
     487             :                 END IF
     488             :              END IF
     489          76 :              ALLOCATE(hybrid%map(0,0),hybrid%tvec(0,0,0),hybrid%d_wgn2(0,0,0,0))
     490          76 :              hybrid%l_calhf = .FALSE.
     491             :           END IF
     492             : 
     493          76 :           IF(input%l_rdmft) THEN
     494           0 :              hybrid%l_calhf = .FALSE.
     495             :           END IF
     496             :  
     497          76 :           IF (mpi%irank.EQ.0) THEN
     498             :              CALL writeOutParameters(mpi,input,sym,stars,atoms,vacuum,obsolete,kpts,&
     499             :                                      oneD,hybrid,cell,banddos,sliceplot,xcpot,&
     500          38 :                                      noco,dimension,enpara,sphhar)
     501          38 :              CALL fleur_info(kpts)
     502          38 :              CALL deleteDensities()
     503             :           END IF
     504             : 
     505             :           !Finalize the MPI setup
     506          76 :           CALL setupMPI(kpts%nkpt,DIMENSION%neigd,mpi)
     507             : 
     508             :           !Collect some usage info
     509          76 :           CALL add_usage_data("A-Types",atoms%ntype)
     510          76 :           CALL add_usage_data("Atoms",atoms%nat)
     511          76 :           CALL add_usage_data("Real",sym%invs.AND..NOT.noco%l_noco)
     512          76 :           CALL add_usage_data("Spins",input%jspins)
     513          76 :           CALL add_usage_data("Noco",noco%l_noco)
     514          76 :           CALL add_usage_data("SOC",noco%l_soc)
     515          76 :           CALL add_usage_data("SpinSpiral",noco%l_ss)
     516          76 :           CALL add_usage_data("PlaneWaves",DIMENSION%nvd)
     517          76 :           CALL add_usage_data("LOs",atoms%nlotot)
     518          76 :           CALL add_usage_data("nkpt", kpts%nkpt)
     519             : 
     520             : #ifdef CPP_GPU
     521             :          CALL add_usage_data("gpu_per_node",1)
     522             : #else
     523          76 :          CALL add_usage_data("gpu_per_node",0)
     524             : #endif
     525             :           
     526          76 :           CALL results%init(dimension,input,atoms,kpts,noco)
     527             : 
     528          76 :           IF (mpi%irank.EQ.0) THEN
     529          38 :              IF(input%gw.NE.0) CALL mixing_history_reset(mpi)
     530          38 :              CALL setStartingDensity(noco%l_noco)
     531             :           END IF
     532             : 
     533             :           !new check mode will only run the init-part of FLEUR
     534          76 :           IF (judft_was_argument("-check")) CALL judft_end("Check-mode done",mpi%irank)
     535             : 
     536          76 :         END SUBROUTINE fleur_init
     537             :       END MODULE m_fleur_init

Generated by: LCOV version 1.13