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             : MODULE m_make_stars
       8             :    USE m_juDFT
       9             : 
      10             :    IMPLICIT NONE
      11             : 
      12             :    PRIVATE
      13             :    PUBLIC :: make_stars
      14             : CONTAINS
      15         160 :    SUBROUTINE make_stars(stars,sym,atoms,vacuum,sphhar,input,cell,noco,fmpi,qvec,iDtype,iDir)
      16             :       USE m_stepf
      17             :       USE m_types_sym
      18             :       USE m_types_atoms
      19             :       USE m_types_vacuum
      20             :       USE m_types_sphhar
      21             :       USE m_types_input
      22             :       USE m_types_cell
      23             :       USE m_types_mpi
      24             :       USE m_types_noco
      25             :       USE m_mpi_bc_tool
      26             :       USE m_types_stars
      27             :       USE m_step_function
      28             :       USE m_mpi_bc_tool
      29             : 
      30             :       CLASS(t_stars),INTENT(INOUT) :: stars
      31             :       TYPE(t_sym),INTENT(in)::sym
      32             :       TYPE(t_atoms),INTENT(in)::atoms
      33             :       TYPE(t_vacuum),INTENT(in)::vacuum
      34             :       TYPE(t_sphhar),INTENT(in)::sphhar
      35             :       TYPE(t_input),INTENT(in)::input
      36             :       TYPE(t_cell),INTENT(in)::cell
      37             :       TYPE(t_noco),INTENT(in)::noco
      38             :       TYPE(t_mpi),INTENT(in)::fmpi
      39             : 
      40             :       REAL, OPTIONAL, INTENT(IN) :: qvec(3)
      41             :       INTEGER, OPTIONAL, INTENT(IN) :: iDtype, iDir
      42             : 
      43             :       INTEGER :: ierr
      44             : 
      45        1280 :       TYPE(t_fftgrid) :: fftgrid
      46             : 
      47             :       ! Dimensioning of stars
      48         160 :       IF (fmpi%irank==0) THEN
      49          80 :          CALL timestart("star-setup")
      50          80 :          stars%gmax=input%gmax
      51          80 :          IF (ABS(input%gmaxz).GE.1e-8) stars%gmaxz=input%gmaxz
      52          80 :          IF (PRESENT(qvec)) THEN
      53           0 :             CALL stars%dim(sym,cell,input%film,qvec)
      54           0 :             CALL stars%init(cell,sym,input%film,input%rkmax,qvec)
      55             :          ELSE
      56          80 :             CALL stars%dim(sym,cell,input%film)
      57          80 :             CALL stars%init(cell,sym,input%film,input%rkmax)
      58             :          END IF
      59          80 :          CALL timestop("star-setup")
      60             :       END IF
      61             : 
      62             :       !The following broadcasts are needed for the step function generation and the allocations above it.
      63         160 :       call mpi_bc(stars%mx1,0,fmpi%mpi_comm)
      64         160 :       call mpi_bc(stars%mx2,0,fmpi%mpi_comm)
      65         160 :       call mpi_bc(stars%mx3,0,fmpi%mpi_comm)
      66         160 :       call mpi_bc(stars%ng3,0,fmpi%mpi_comm)
      67             : 
      68         160 :       CALL timestart("stepf")
      69         160 :       IF (PRESENT(qvec)) THEN
      70           0 :          IF (fmpi%irank == 0) THEN
      71           0 :             ALLOCATE (stars%ufft(0:27*stars%mx1*stars%mx2*stars%mx3-1))
      72           0 :             ALLOCATE (stars%ufft1(0:27*stars%mx1*stars%mx2*stars%mx3-1),stars%ustep(stars%ng3))
      73           0 :             CALL stepf_analytical(sym, stars, atoms, input, cell, fmpi, fftgrid, qvec, iDtype, iDir, 1)
      74           0 :             CALL stepf_stars(stars,fftgrid,qvec)
      75             :          END IF
      76             :       ELSE
      77         480 :          ALLOCATE (stars%ufft(0:27*stars%mx1*stars%mx2*stars%mx3-1))
      78         480 :          ALLOCATE (stars%ustep(stars%ng3))
      79         160 :          CALL stepf(sym,stars,atoms,input,cell,vacuum,fmpi)
      80             :       END IF
      81             : 
      82             :       ! New routines for the stepfunction.
      83             :       !IF (fmpi%irank == 0) THEN
      84             :       !   CALL stepf_analytical(sym, stars, atoms, input, cell, fmpi, fftgrid)
      85             :       !   CALL stepf_stars(stars,fftgrid)
      86             :       !END IF
      87         160 :       CALL timestop("stepf")
      88             : 
      89         160 :       CALL stars%mpi_bc(fmpi%mpi_comm)
      90             : 
      91         160 :    END SUBROUTINE make_stars
      92             : END MODULE m_make_stars