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

          Line data    Source code
       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2017 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_postprocessInput
       8             : 
       9             : CONTAINS
      10             : 
      11          96 : SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,obsolete,kpts,&
      12             :      oneD,hybrid,cell,banddos,sliceplot,xcpot,forcetheo,&
      13             :      noco,DIMENSION,enpara,sphhar,l_opti,l_kpts)
      14             : 
      15             :   USE m_juDFT
      16             :   USE m_types
      17             :   USE m_constants
      18             :   USE m_lapwdim
      19             :   USE m_ylm
      20             :   USE m_convndim
      21             :   USE m_chkmt
      22             :   USE m_localsym
      23             :   USE m_strgndim
      24             :   USE m_od_chisym
      25             :   USE m_dwigner
      26             :   USE m_mapatom
      27             :   USE m_cdn_io
      28             :   USE m_strgn
      29             :   USE m_od_strgn1
      30             :   USE m_prpqfft
      31             :   USE m_prpxcfft
      32             :   USE m_stepf
      33             :   USE m_convn
      34             :   USE m_efield
      35             :   USE m_od_mapatom
      36             :   USE m_od_kptsgen
      37             :   USE m_gen_bz
      38             :   USE m_nocoInputCheck
      39             :   USE m_kpoints   
      40             :   USE m_types_forcetheo_extended
      41             :   USE m_relaxio
      42             : 
      43             :   IMPLICIT NONE
      44             : 
      45             :   TYPE(t_mpi)      ,INTENT   (IN) :: mpi
      46             :   CLASS(t_forcetheo),INTENT(IN)   :: forcetheo
      47             :   TYPE(t_input),    INTENT(INOUT) :: input
      48             :   TYPE(t_sym),      INTENT(INOUT) :: sym
      49             :   TYPE(t_stars),    INTENT(INOUT) :: stars 
      50             :   TYPE(t_atoms),    INTENT(INOUT) :: atoms
      51             :   TYPE(t_vacuum),   INTENT(INOUT) :: vacuum
      52             :   TYPE(t_obsolete), INTENT(INOUT) :: obsolete
      53             :   TYPE(t_kpts),     INTENT(INOUT) :: kpts
      54             :   TYPE(t_oneD),     INTENT(INOUT) :: oneD
      55             :   TYPE(t_hybrid),   INTENT(INOUT) :: hybrid
      56             :   TYPE(t_cell),     INTENT(INOUT) :: cell
      57             :   TYPE(t_banddos),  INTENT(INOUT) :: banddos
      58             :   TYPE(t_sliceplot),INTENT(INOUT) :: sliceplot
      59             :   CLASS(t_xcpot),   INTENT(INOUT) :: xcpot
      60             :   TYPE(t_noco),     INTENT(INOUT) :: noco
      61             :   TYPE(t_dimension),INTENT(INOUT) :: dimension
      62             :   TYPE(t_enpara)   ,INTENT(INOUT) :: enpara
      63             :   TYPE(t_sphhar)   ,INTENT  (OUT) :: sphhar
      64             :   TYPE(t_field),    INTENT(INOUT) :: field
      65             :   LOGICAL,          INTENT  (OUT) :: l_opti
      66             :   LOGICAL,          INTENT   (IN) :: l_kpts
      67             : 
      68             :   INTEGER              :: i, j, n, na, iType, l, ilo
      69             :   INTEGER              :: minNeigd, jrc, ii
      70             :   INTEGER              :: ios, ntst, ierr
      71             :   REAL                 :: rmtmax, zp, radius, dr
      72             :   LOGICAL              :: l_vca, l_test
      73             :  
      74          48 :   INTEGER, ALLOCATABLE :: lmx1(:), nq1(:), nlhtp1(:)
      75             :   REAL,    ALLOCATABLE :: rmt1(:)
      76             : 
      77             : #ifdef CPP_MPI
      78             :   INCLUDE 'mpif.h'
      79             : #endif
      80             : 
      81             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      82             : !!! Start of input postprocessing (calculate missing parameters)
      83             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      84             : 
      85          48 :   IF (mpi%irank.EQ.0) THEN
      86             : 
      87             :   ! Check the LO stuff and call setlomap (from inped):
      88             : 
      89          24 :      ALLOCATE(atoms%lo1l(0:atoms%llod,atoms%ntype))
      90          24 :      ALLOCATE(atoms%nlol(0:atoms%llod,atoms%ntype))
      91             : 
      92          24 :      IF (ANY(atoms%lapw_l(:).NE.-1)) input%l_useapw = .TRUE.
      93          79 :      DO iType = 1, atoms%ntype
      94          79 :         IF (atoms%nlo(iType).GE.1) THEN
      95          12 :            IF (input%secvar) THEN
      96           0 :               CALL juDFT_error("LO + sevcar not implemented",calledby ="postprocessInput")
      97             :            END IF
      98          12 :            IF (atoms%nlo(iType).GT.atoms%nlod) THEN
      99           0 :               WRITE (6,*) 'nlo(n) =',atoms%nlo(iType),' > nlod =',atoms%nlod
     100           0 :               CALL juDFT_error("nlo(n)>nlod",calledby ="postprocessInput")
     101             :            END IF
     102          30 :            DO j=1,atoms%nlo(iType)
     103          18 :               IF (.NOT.input%l_useapw) THEN
     104          18 :                  IF (atoms%llo(j,iType).LT.0) THEN ! CALL juDFT_error("llo<0 ; compile with DCPP_APW!",calledby="inped")
     105           0 :                     WRITE(6,'(A)') 'Info: l_useapw not set.'
     106           0 :                     WRITE(6,'(A,I2,A,I2,A)') '      LO #', j, ' at atom type', iType, ' is an e-derivative.'
     107             :                  END IF
     108             :               ENDIF
     109          30 :               IF ( (atoms%llo(j,iType).GT.atoms%llod).OR.(mod(-atoms%llod,10)-1).GT.atoms%llod ) THEN
     110           0 :                  WRITE (6,*) 'llo(j,n) =',atoms%llo(j,iType),' > llod =',atoms%llod
     111           0 :                  CALL juDFT_error("llo(j,n)>llod",calledby ="postprocessInput")
     112             :               END IF
     113             :            END DO
     114             : 
     115             :            ! Replace call to setlomap with the following 3 loops (preliminary).
     116             :            ! atoms%nlol and atoms%lo1l arrays are strange. This should be solved differently.
     117          40 :            DO l = 0,atoms%llod
     118          28 :               atoms%nlol(l,iType) = 0
     119          40 :               atoms%lo1l(l,iType) = 0
     120             :            END DO
     121             : 
     122          36 :            DO ilo = 1,atoms%nlod
     123          36 :               atoms%l_dulo(ilo,iType) = .FALSE.
     124             :            END DO
     125             : 
     126          30 :            DO ilo = 1,atoms%nlo(iType)
     127          18 :               if (input%l_useapW) THEN
     128           0 :                  IF (atoms%ulo_der(ilo,iType).EQ.1) THEN
     129           0 :                     atoms%l_dulo(ilo,iType) = .TRUE.
     130             :                  END IF
     131             :               endif
     132          18 :               WRITE(6,'(A,I2,A,I2)') 'I use',atoms%ulo_der(ilo,iType),'. derivative of l =',atoms%llo(ilo,iType)
     133          18 :               IF (atoms%llo(ilo,iType)>atoms%llod) CALL juDFT_error(" l > llod!!!",calledby="postprocessInput")
     134          18 :               l = atoms%llo(ilo,iType)
     135          18 :               IF (ilo.EQ.1) THEN
     136          12 :                  atoms%lo1l(l,iType) = ilo
     137             :               ELSE
     138           6 :                  IF (l.NE.atoms%llo(ilo-1,iType)) THEN
     139           6 :                     atoms%lo1l(l,iType) = ilo
     140             :                  END IF
     141             :               END IF
     142          30 :               atoms%nlol(l,iType) = atoms%nlol(l,iType) + 1
     143             :            END DO
     144          12 :            WRITE (6,*) 'atoms%lapw_l(n) = ',atoms%lapw_l(iType)
     145             :         END IF
     146             : 
     147             :      END DO
     148             : 
     149             :      ! Check lda+u stuff (from inped)
     150             : 
     151          36 :      DO i = 1, atoms%n_u
     152          12 :         n = atoms%lda_u(i)%atomType
     153          36 :         IF (atoms%nlo(n).GE.1) THEN
     154           0 :            DO j = 1, atoms%nlo(n)
     155           0 :               IF ((ABS(atoms%llo(j,n)).EQ.atoms%lda_u(i)%l) .AND. (.NOT.atoms%l_dulo(j,n)) ) &
     156           0 :                  WRITE (*,*) 'LO and LDA+U for same l not implemented'
     157             :            END DO
     158             :         END IF
     159             :      END DO
     160             : 
     161          24 :      IF (atoms%n_u.GT.0) THEN
     162           3 :         IF (input%secvar) CALL juDFT_error("LDA+U and sevcar not implemented",calledby ="postprocessInput")
     163           3 :         IF (noco%l_mperp) CALL juDFT_error("LDA+U and l_mperp not implemented",calledby ="postprocessInput")
     164             :      END IF
     165             : 
     166             :      ! Check DOS related stuff (from inped)
     167             : 
     168          24 :      IF ((banddos%ndir.LT.0).AND..NOT.banddos%dos) THEN
     169             :         CALL juDFT_error('STOP banddos: the inbuild dos-program  <0'//&
     170           0 :              ' can only be used if dos = true',calledby ="postprocessInput")
     171             :      END IF
     172             : 
     173          24 :      IF ((banddos%ndir.LT.0).AND.banddos%dos) THEN
     174           3 :         IF (banddos%e1_dos-banddos%e2_dos.LT.1e-3) THEN
     175             :            CALL juDFT_error("STOP banddos: no valid energy window for "//&
     176           0 :                 "internal dos-program",calledby ="postprocessInput")
     177             :         END IF
     178           3 :         IF (banddos%sig_dos.LT.0) THEN
     179             :            CALL juDFT_error("STOP DOS: no valid broadening (sig_dos) for "//&
     180           0 :                 "internal dos-PROGRAM",calledby ="postprocessInput")
     181             :         END IF
     182             :      END IF
     183             : 
     184          24 :      IF (banddos%vacdos) THEN
     185           0 :         IF (.NOT.banddos%dos) THEN
     186           0 :            CALL juDFT_error("STOP DOS: only set vacdos = .true. if dos = .true.",calledby ="postprocessInput")
     187             :         END IF
     188           0 :         IF (.NOT.vacuum%starcoeff.AND.(vacuum%nstars.NE.1))THEN
     189           0 :            CALL juDFT_error("STOP banddos: if stars = f set vacuum=1",calledby ="postprocessInput")
     190             :         END IF
     191           0 :         IF (vacuum%layers.LT.1) THEN
     192           0 :            CALL juDFT_error("STOP DOS: specify layers if vacdos = true",calledby ="postprocessInput")
     193             :         END IF
     194           0 :         DO i=1,vacuum%layers
     195           0 :            IF (vacuum%izlay(i,1).LT.1) THEN
     196           0 :               CALL juDFT_error("STOP DOS: all layers must be at z>0",calledby ="postprocessInput")
     197             :            END IF
     198             :         END DO
     199             :      END IF
     200             : 
     201             :      ! Check noco stuff and calculate missing noco parameters
     202             : 
     203          24 :      IF (noco%l_noco) THEN
     204           5 :         CALL nocoInputCheck(atoms,input,vacuum,noco)
     205             : 
     206           5 :         IF (noco%l_ss) THEN
     207             : 
     208             :            !--->    the angle beta is relative to the spiral in a spin-spiral
     209             :            !--->    calculation, i.e. if beta = 0 for all atoms in the unit cell
     210             :            !--->    that means that the moments are "in line" with the spin-spiral
     211             :            !--->    (beta = qss * taual). note: this means that only atoms within
     212             :            !--->    a plane perpendicular to qss can be equivalent!
     213             : 
     214           1 :            na = 1
     215           2 :            DO iType = 1,atoms%ntype
     216           1 :               noco%alph(iType) = noco%alphInit(iType) + tpi_const*dot_product(noco%qss,atoms%taual(:,na))
     217           2 :               na = na + atoms%neq(iType)
     218             :            END DO
     219             :         END IF
     220             :      ELSE
     221          19 :         IF (noco%l_ss) THEN
     222           0 :            CALL judft_warn("l_noco=F and l_ss=T is meaningless. Setting l_ss to F.")
     223           0 :            noco%l_ss = .FALSE.
     224             :         END IF
     225          19 :         IF (noco%l_mperp) THEN
     226           0 :            CALL judft_warn("l_noco=F and l_mperp=T is meaningless. Setting l_mperp to F.")
     227           0 :            noco%l_mperp = .FALSE.
     228             :         END IF
     229             :      END IF
     230             : 
     231             :      ! Calculate missing kpts parameters
     232          24 :      CALL kpoints(oneD,sym,cell,input,noco,banddos,kpts,l_kpts)
     233             :     
     234             :      ! Generate missing general parameters
     235             :      
     236          24 :      minNeigd = MAX(5,NINT(0.75*input%zelec) + 1)
     237          24 :      IF (noco%l_soc.and.(.not.noco%l_noco)) minNeigd = 2 * minNeigd
     238          24 :      IF (noco%l_soc.and.noco%l_ss) minNeigd=(3*minNeigd)/2
     239          24 :      IF ((dimension%neigd.NE.-1).AND.(dimension%neigd.LT.minNeigd)) THEN
     240          22 :         IF (dimension%neigd>0) THEN
     241           0 :            WRITE(*,*) 'numbands is too small. Setting parameter to default value.'
     242           0 :            WRITE(*,*) 'changed numbands (dimension%neigd) to ',minNeigd
     243             :         ENDIF
     244          22 :         dimension%neigd = minNeigd
     245             :      END IF
     246             : 
     247             :    
     248             :      !cell%aamat=matmul(transpose(cell%amat),cell%amat)
     249          24 :      cell%bbmat=matmul(cell%bmat,transpose(cell%bmat))
     250             : 
     251          24 :      CALL lapw_dim(kpts,cell,input,noco,oneD,forcetheo,DIMENSION)
     252             : 
     253          24 :      CALL lapw_fft_dim(cell,input,noco,stars)
     254             : 
     255          24 :      atoms%nlotot = 0
     256          79 :      DO n = 1, atoms%ntype
     257          97 :         DO l = 1,atoms%nlo(n)
     258          73 :            atoms%nlotot = atoms%nlotot + atoms%neq(n) * ( 2*atoms%llo(l,n) + 1 )
     259             :         END DO
     260             :      END DO
     261             : 
     262          24 :      IF(dimension%neigd.EQ.-1) THEN
     263           0 :         dimension%neigd = dimension%nvd + atoms%nlotot
     264             :      END IF
     265             : 
     266          24 :      obsolete%lepr = 0
     267             : 
     268          24 :      IF (noco%l_noco) dimension%neigd = 2*dimension%neigd
     269             : 
     270             :      ! Generate missing parameters for atoms and calculate volume of the different regions
     271             : 
     272          24 :      cell%volint = cell%vol
     273          24 :      atoms%jmtd = maxval(atoms%jri(:))
     274          24 :      CALL ylmnorm_init(atoms%lmaxd)
     275          24 :      dimension%nspd=(atoms%lmaxd+1+mod(atoms%lmaxd+1,2))*(2*atoms%lmaxd+1)
     276          24 :      rmtmax = maxval(atoms%rmt(:))
     277          24 :      rmtmax = rmtmax*stars%gmax
     278          24 :      CALL convn_dim(rmtmax,dimension%ncvd)
     279          24 :      dimension%msh = 0
     280          24 :      ALLOCATE(atoms%rmsh(atoms%jmtd,atoms%ntype))
     281          24 :      ALLOCATE(atoms%volmts(atoms%ntype))
     282          24 :      na = 0
     283          79 :      DO iType = 1, atoms%ntype
     284          55 :         l_vca = .FALSE.
     285          55 :         INQUIRE (file="vca.in", exist=l_vca)
     286          55 :         IF (l_vca) THEN
     287           0 :            WRITE(*,*) 'Note: Implementation for virtual crystal approximation should be changed in postprocessInput!'
     288           0 :            WRITE(*,*) 'I am not sure whether the implementation actually makes any sense. It is from inped.'
     289           0 :            WRITE(*,*) 'We have to get rid of the file vca.in!'
     290           0 :            OPEN (17,file='vca.in',form='formatted')
     291           0 :            DO i= 1, iType
     292           0 :               READ (17,*,IOSTAT=ios) ntst,zp
     293           0 :               IF (ios /= 0) EXIT
     294           0 :               IF (ntst == iType) THEN
     295           0 :                  atoms%zatom(iType) = atoms%zatom(iType) + zp
     296             :               END IF
     297             :            END DO
     298           0 :            CLOSE (17)
     299             :         END IF
     300             : 
     301             :         ! Calculate mesh for valence states
     302          55 :         radius = atoms%rmt(iType)*exp(atoms%dx(iType)*(1-atoms%jri(iType)))
     303          55 :         dr = exp(atoms%dx(iType))
     304       35938 :         DO i = 1, atoms%jri(iType)
     305       35883 :            atoms%rmsh(i,iType) = radius
     306       35938 :            radius = radius*dr
     307             :         END DO
     308             :         ! Calculate mesh dimension for core states
     309          55 :         radius = atoms%rmt(iType)
     310          55 :         jrc = atoms%jri(iType)
     311       13993 :         DO WHILE (radius < atoms%rmt(iType) + 20.0)
     312        6969 :            jrc = jrc + 1
     313        7024 :            radius = radius*dr
     314             :         END DO
     315          55 :         dimension%msh = max(dimension%msh,jrc)
     316             : 
     317          55 :         atoms%volmts(iType) = (fpi_const/3.0)*atoms%rmt(iType)**3
     318          79 :         cell%volint = cell%volint - atoms%volmts(iType)*atoms%neq(iType)
     319             :      END DO
     320             : 
     321             : 
     322             : 
     323             : 
     324             :      ! Dimensioning of lattice harmonics
     325             : 
     326          24 :      ALLOCATE(atoms%nlhtyp(atoms%ntype),atoms%ntypsy(atoms%nat))
     327          24 :      ALLOCATE(sphhar%clnu(1,1,1),sphhar%nlh(1),sphhar%llh(1,1),sphhar%nmem(1,1),sphhar%mlh(1,1,1))
     328          24 :      sphhar%ntypsd = 0
     329          24 :      IF (.NOT.oneD%odd%d1) THEN
     330             :         CALL local_sym(atoms%lmaxd,atoms%lmax,sym%nop,sym%mrot,sym%tau,&
     331             :              atoms%nat,atoms%ntype,atoms%neq,cell%amat,cell%bmat,&
     332             :              atoms%taual,sphhar%nlhd,sphhar%memd,sphhar%ntypsd,.true.,&
     333             :              atoms%nlhtyp,atoms%ntypsy,sphhar%nlh,sphhar%llh,&
     334          24 :              sphhar%nmem,sphhar%mlh,sphhar%clnu)
     335             :      ELSE IF (oneD%odd%d1) THEN
     336           0 :         WRITE(*,*) 'Note: I would be surprised if lattice harmonics generation works'
     337           0 :         WRITE(*,*) 'Dimensioning of local arrays seems to be inconsistent with routine local_sym'
     338           0 :         ALLOCATE (nq1(atoms%nat),lmx1(atoms%nat),nlhtp1(atoms%nat))
     339             :         ii = 1
     340           0 :         nq1=1
     341           0 :         DO i = 1,atoms%ntype
     342           0 :            DO j = 1,atoms%neq(i)
     343           0 :               lmx1(ii) = atoms%lmax(i)
     344           0 :               ii = ii + 1
     345             :            END DO
     346             :         END DO
     347             :         CALL local_sym(atoms%lmaxd,lmx1,sym%nop,sym%mrot,sym%tau,&
     348             :                        atoms%nat,atoms%nat,nq1,cell%amat,cell%bmat,atoms%taual,&
     349             :                        sphhar%nlhd,sphhar%memd,sphhar%ntypsd,.true.,nlhtp1,&
     350             :                        atoms%ntypsy,sphhar%nlh,sphhar%llh,sphhar%nmem,&
     351           0 :                        sphhar%mlh,sphhar%clnu)        
     352           0 :         ii = 1
     353           0 :         DO i = 1,atoms%ntype
     354           0 :            atoms%nlhtyp(i) = nlhtp1(ii)
     355           0 :            ii = ii + atoms%neq(i)
     356             :         END DO
     357           0 :         DEALLOCATE (nq1,lmx1,nlhtp1)
     358             :      END IF
     359          24 :      DEALLOCATE(sphhar%clnu,sphhar%nlh,sphhar%llh,sphhar%nmem,sphhar%mlh)
     360             : 
     361          24 :      ALLOCATE(sphhar%clnu(sphhar%memd,0:sphhar%nlhd,sphhar%ntypsd))
     362          24 :      ALLOCATE(sphhar%llh(0:sphhar%nlhd,sphhar%ntypsd))
     363          24 :      ALLOCATE(sphhar%mlh(sphhar%memd,0:sphhar%nlhd,sphhar%ntypsd))
     364          24 :      ALLOCATE(sphhar%nlh(sphhar%ntypsd),sphhar%nmem(0:sphhar%nlhd,sphhar%ntypsd))
     365             : 
     366             :      ! Dimensioning of stars
     367             : 
     368          24 :      IF (input%film.OR.(sym%namgrp.ne.'any ')) THEN
     369             :         CALL strgn1_dim(stars%gmax,cell%bmat,sym%invs,sym%zrfs,sym%mrot,&
     370             :                         sym%tau,sym%nop,sym%nop2,stars%mx1,stars%mx2,stars%mx3,&
     371          10 :                         stars%ng3,stars%ng2,oneD%odd)
     372             : 
     373             :      ELSE
     374             :         CALL strgn2_dim(stars%gmax,cell%bmat,sym%invs,sym%zrfs,sym%mrot,&
     375             :                         sym%tau,sym%nop,stars%mx1,stars%mx2,stars%mx3,&
     376          14 :                         stars%ng3,stars%ng2)
     377          14 :         oneD%odd%n2d = stars%ng2
     378          14 :         oneD%odd%nq2 = stars%ng2
     379          14 :         oneD%odd%nop = sym%nop
     380             :      END IF
     381             : 
     382          24 :      stars%kimax2= (2*stars%mx1+1)* (2*stars%mx2+1)-1
     383          24 :      stars%kimax = (2*stars%mx1+1)* (2*stars%mx2+1)* (2*stars%mx3+1)-1
     384          24 :      IF (oneD%odd%d1) THEN
     385           0 :         oneD%odd%k3 = stars%mx3
     386           0 :         oneD%odd%nn2d = (2*(oneD%odd%k3)+1)*(2*(oneD%odd%M)+1)
     387             :      ELSE
     388          24 :         oneD%odd%k3 = 0
     389          24 :         oneD%odd%M = 0
     390          24 :         oneD%odd%nn2d = 1
     391          24 :         oneD%odd%mb = 0
     392             :      END IF
     393          24 :      ALLOCATE (stars%ig(-stars%mx1:stars%mx1,-stars%mx2:stars%mx2,-stars%mx3:stars%mx3))
     394          24 :      ALLOCATE (stars%ig2(stars%ng3))
     395          24 :      ALLOCATE (stars%kv2(2,stars%ng2),stars%kv3(3,stars%ng3))
     396          24 :      ALLOCATE (stars%nstr2(stars%ng2),stars%nstr(stars%ng3))
     397          24 :      ALLOCATE (stars%sk2(stars%ng2),stars%sk3(stars%ng3),stars%phi2(stars%ng2))
     398          24 :      ALLOCATE (stars%igfft(0:stars%kimax,2),stars%igfft2(0:stars%kimax2,2))
     399          24 :      ALLOCATE (stars%rgphs(-stars%mx1:stars%mx1,-stars%mx2:stars%mx2,-stars%mx3:stars%mx3))
     400          24 :      ALLOCATE (stars%pgfft(0:stars%kimax),stars%pgfft2(0:stars%kimax2))
     401          24 :      ALLOCATE (stars%ufft(0:27*stars%mx1*stars%mx2*stars%mx3-1),stars%ustep(stars%ng3))
     402             : 
     403        1274 :      stars%sk2(:) = 0.0
     404        1274 :      stars%phi2(:) = 0.0
     405             : 
     406             :      ! Initialize xc fft box
     407             : 
     408          24 :      CALL prp_xcfft_box(xcpot%gmaxxc,cell%bmat,stars%kxc1_fft,stars%kxc2_fft,stars%kxc3_fft)
     409             : 
     410             :      ! Initialize missing 1D code arrays
     411             : 
     412          24 :      ALLOCATE (oneD%ig1(-oneD%odd%k3:oneD%odd%k3,-oneD%odd%M:oneD%odd%M))
     413          24 :      ALLOCATE (oneD%kv1(2,oneD%odd%n2d),oneD%nstr1(oneD%odd%n2d))
     414          24 :      ALLOCATE (oneD%ngopr1(atoms%nat),oneD%mrot1(3,3,oneD%odd%nop),oneD%tau1(3,oneD%odd%nop))
     415          24 :      ALLOCATE (oneD%invtab1(oneD%odd%nop),oneD%multab1(oneD%odd%nop,oneD%odd%nop))
     416          24 :      ALLOCATE (oneD%igfft1(0:oneD%odd%nn2d-1,2),oneD%pgfft1(0:oneD%odd%nn2d-1))
     417             : 
     418             :      ! Initialize missing hybrid functionals arrays
     419             : 
     420          24 :      ALLOCATE (hybrid%nindx(0:atoms%lmaxd,atoms%ntype))
     421             :    
     422             :      ! Generate lattice harmonics
     423             : 
     424          24 :      IF (.NOT.oneD%odd%d1) THEN
     425             :         CALL local_sym(atoms%lmaxd,atoms%lmax,sym%nop,sym%mrot,sym%tau,&
     426             :                        atoms%nat,atoms%ntype,atoms%neq,cell%amat,cell%bmat,atoms%taual,&
     427             :                        sphhar%nlhd,sphhar%memd,sphhar%ntypsd,.FALSE.,&
     428          24 :                        atoms%nlhtyp,atoms%ntypsy,sphhar%nlh,sphhar%llh,sphhar%nmem,sphhar%mlh,sphhar%clnu)
     429          24 :         sym%nsymt = sphhar%ntypsd
     430          24 :         oneD%mrot1(:,:,:) = sym%mrot(:,:,:)
     431          24 :         oneD%tau1(:,:) = sym%tau(:,:)
     432             :      ELSE IF (oneD%odd%d1) THEN
     433           0 :         WRITE(*,*) 'Note: I would be surprised if lattice harmonics generation works'
     434           0 :         WRITE(*,*) 'Dimensioning of local arrays seems to be inconsistent with routine local_sym'
     435           0 :         CALL od_chisym(oneD%odd,oneD%mrot1,oneD%tau1,sym%zrfs,sym%invs,sym%invs2,cell%amat)
     436           0 :         ALLOCATE (nq1(atoms%nat),lmx1(atoms%nat),nlhtp1(atoms%nat))
     437           0 :         ii = 1
     438           0 :         DO i = 1,atoms%ntype
     439           0 :            DO j = 1,atoms%neq(i)
     440           0 :               nq1(ii) = 1
     441           0 :               lmx1(ii) = atoms%lmax(i)
     442           0 :               ii = ii + 1
     443             :            END DO
     444             :         END DO
     445             :         CALL local_sym(atoms%lmaxd,lmx1,sym%nop,sym%mrot,sym%tau,&
     446             :                        atoms%nat,atoms%nat,nq1,cell%amat,cell%bmat,atoms%taual,&
     447             :                        sphhar%nlhd,sphhar%memd,sphhar%ntypsd,.FALSE.,&
     448           0 :                        nlhtp1,atoms%ntypsy,sphhar%nlh,sphhar%llh,sphhar%nmem,sphhar%mlh,sphhar%clnu)
     449           0 :         sym%nsymt = sphhar%ntypsd
     450           0 :         ii = 1
     451           0 :         DO i = 1,atoms%ntype
     452           0 :            atoms%nlhtyp(i) = nlhtp1(ii)
     453           0 :            ii = ii + atoms%neq(i)
     454             :         END DO
     455           0 :         DEALLOCATE (lmx1,nlhtp1)
     456             :      END IF
     457             : 
     458             :      ! Calculate additional symmetry information
     459             : 
     460          24 :      IF (atoms%n_u.GT.0) THEN
     461           3 :         CALL d_wigner(sym%nop,sym%mrot,cell%bmat,3,sym%d_wgn)
     462             :      END IF
     463             : 
     464          24 :      IF (.NOT.oneD%odd%d1) THEN
     465          24 :         CALL mapatom(sym,atoms,cell,input,noco)
     466          24 :         oneD%ngopr1(1:atoms%nat) = atoms%ngopr(1:atoms%nat)
     467             :         !     DEALLOCATE ( nq1 )
     468             :      ELSE
     469           0 :         CALL juDFT_error("The oneD version is broken here. Compare call to mapatom with old version")
     470           0 :         CALL mapatom(sym,atoms,cell,input,noco)
     471           0 :         CALL od_mapatom(oneD,atoms,sym,cell)
     472             :      END IF
     473             :     ! Check muffin tin radii
     474             : 
     475          24 :      l_test = .TRUE. ! only checking, dont use new parameters
     476          24 :      CALL chkmt(atoms,input,vacuum,cell,oneD,l_test)
     477             : 
     478             :      !adjust positions by displacements
     479          24 :      CALL apply_displacements(cell,input,vacuum,oneD,sym,noco,atoms)
     480             : 
     481             :      !Calculate kpoint in the full BZ
     482          24 :      IF (kpts%l_gamma.and. banddos%ndir .eq. 0.and.kpts%specificationType==2) THEN
     483           0 :         CALL gen_bz(kpts,sym)
     484             :      ELSE
     485          24 :         kpts%nkptf=0
     486             :      ENDIF
     487             : 
     488             :      ! Missing xc functionals initializations
     489          24 :      IF (xcpot%needs_grad()) THEN
     490          20 :         ALLOCATE (stars%ft2_gfx(0:stars%kimax2),stars%ft2_gfy(0:stars%kimax2))
     491             :         ALLOCATE (oneD%pgft1x(0:oneD%odd%nn2d-1),oneD%pgft1xx(0:oneD%odd%nn2d-1),&
     492             :                   oneD%pgft1xy(0:oneD%odd%nn2d-1),&
     493          20 :                   oneD%pgft1y(0:oneD%odd%nn2d-1),oneD%pgft1yy(0:oneD%odd%nn2d-1))
     494             :      ELSE
     495           4 :         ALLOCATE (stars%ft2_gfx(0:1),stars%ft2_gfy(0:1))
     496             :         ALLOCATE (oneD%pgft1x(0:1),oneD%pgft1xx(0:1),oneD%pgft1xy(0:1),&
     497           4 :                   oneD%pgft1y(0:1),oneD%pgft1yy(0:1))
     498             :      END IF
     499          24 :      oneD%odd%nq2 = oneD%odd%n2d
     500          24 :      oneD%odi%nq2 = oneD%odd%nq2
     501             : 
     502             :      ! Store structure data
     503             : 
     504          24 :      CALL storeStructureIfNew(input,stars, atoms, cell, vacuum, oneD, sym, mpi,sphhar,noco)
     505             : 
     506             :      ! Generate stars
     507             : 
     508          24 :      CALL timestart("strgn") 
     509          24 :      IF (input%film.OR.(sym%namgrp.NE.'any ')) THEN
     510          10 :         CALL strgn1(stars,sym,atoms,vacuum,sphhar,input,cell,xcpot)
     511          10 :         IF (oneD%odd%d1) THEN
     512           0 :            CALL od_strgn1(xcpot,cell,sym,oneD)
     513             :         END IF
     514             :      ELSE
     515          14 :         CALL strgn2(stars,sym,atoms,vacuum,sphhar,input,cell,xcpot)
     516             :      END IF
     517          24 :      CALL timestop("strgn") 
     518             : 
     519             :      ! Other small stuff
     520             : 
     521          24 :      input%strho = .FALSE.
     522             : 
     523          24 :      INQUIRE(file="cdn1",exist=l_opti)
     524          24 :      if (noco%l_noco) INQUIRE(file="rhomat_inp",exist=l_opti)
     525          24 :      l_opti=.not.l_opti
     526             :      IF ((sliceplot%iplot).OR.(input%strho).OR.(input%swsp).OR.&
     527          24 :          (input%lflip).OR.(input%l_bmt)) l_opti = .TRUE.
     528             : 
     529             :      IF (.NOT.l_opti) THEN
     530             :         !      The following call to inpeig should not be required.
     531             :         !      CALL inpeig(atoms,cell,input,oneD%odd%d1,kpts,enpara)
     532             :      END IF
     533          24 :      kpts%wtkpt=kpts%wtkpt/sum(kpts%wtkpt) !Normalize k-point weight
     534          24 :      CALL prp_qfft(stars,cell,noco,input)
     535             : 
     536             : 
     537          24 :      CALL prp_xcfft(stars,input,cell,xcpot)
     538             :  
     539             :   END IF !(mpi%irank.EQ.0)
     540             : #ifdef CPP_MPI
     541          48 :   CALL MPI_BCAST(sliceplot%iplot,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
     542          48 :   CALL MPI_BCAST(input%qfix,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
     543          48 :   CALL MPI_BCAST(noco%l_noco,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
     544             : #endif
     545             : 
     546          48 :   CALL timestart("stepf") 
     547          48 :   CALL stepf(sym,stars,atoms,oneD,input,cell,vacuum,mpi)
     548          48 :   CALL timestop("stepf") 
     549          48 :   IF (.NOT.sliceplot%iplot) THEN   
     550          44 :      IF (mpi%irank.EQ.0) THEN
     551          22 :         CALL convn(DIMENSION,atoms,stars)
     552          22 :         CALL e_field(atoms,DIMENSION,stars,sym,vacuum,cell,input,field%efield)
     553             :      END IF !(mpi%irank.EQ.0)
     554             :   END IF
     555             : 
     556             :   !At some point this should be enabled for noco as well
     557             : #ifdef CPP_MPI
     558          48 :   CALL MPI_BCAST(atoms%nat,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
     559             : #endif
     560          48 :   IF (.not.noco%l_noco) & 
     561          38 :   CALL transform_by_moving_atoms(mpi,stars,atoms,vacuum, cell, sym, sphhar,input,oned,noco)
     562             : 
     563             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     564             : !!! End of input postprocessing (calculate missing parameters)
     565             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     566             : 
     567          48 : END SUBROUTINE postprocessInput
     568             : 
     569             : END MODULE m_postprocessInput

Generated by: LCOV version 1.13