setup.f90 7.26 KB
Newer Older
1 2 3
      MODULE m_setup
      USE m_juDFT
      CONTAINS
Daniel Wortmann's avatar
Daniel Wortmann committed
4
        SUBROUTINE setup(mpi,atoms,kpts,DIMENSION,sphhar,&
5
                  obsolete,sym,stars,oneD, input,noco,vacuum,cell,xcpot, sliceplot,enpara,l_opti)
6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41
          !
          !----------------------------------------
          ! this routine is called by: fleur.F
          !
          ! setup --+
          !         +-- spg2set
          !         +-- local_sym -+- ptsym
          !         |              +- lhcal -+- gaussp
          !         |                        +- gtest
          !         |                        +- ylm4
          !         +-- strgn1 -+- boxdim
          !         |           +- sort
          !         |           +- dset
          !         |           +- spgrot
          !         |           +- unor2or
          !         +-- mapatom -+- dotset
          !         |            +- dotirl
          !         +-- inpeig -- gkptwgt
          !         +-- gaunt2 -- grule
          !         +-- prp_qfft -+- boxdim
          !         |             +- ifft235
          !         +-- prp_xcfft -+- boxdim
          !         |              +- ifft235
          !         +-- stepf
          !         +-- convn
          !         +-- efield
          !----------------------------------------

          !
          USE m_types
          USE m_localsym
          USE m_rwsymfile
          USE m_spg2set
          USE m_dwigner
          USE m_strgn
          USE m_stepf
42
          USE m_cdn_io
43 44 45 46 47 48 49
          USE m_mapatom
          USE m_writegw
          USE m_convn
          USE m_prpqfft
          USE m_prpxcfft
          USE m_inpeig
          USE m_efield
50
          USE m_ylm
51 52 53 54 55 56 57 58
          !-odim
          USE m_od_mapatom
          USE m_od_chisym
          USE m_od_strgn1
          !+odim
          IMPLICIT NONE
          !     ..
          !     .. Scalars Arguments ..
Daniel Wortmann's avatar
Daniel Wortmann committed
59
          TYPE(t_mpi),INTENT(IN)         :: mpi
60 61 62 63 64 65 66 67 68 69 70 71
          TYPE(t_atoms),INTENT(INOUT)    :: atoms
          TYPE(t_kpts),INTENT(INOUT)     :: kpts
          TYPE(t_dimension),INTENT(INOUT):: DIMENSION
          TYPE(t_sphhar),INTENT(INOUT)   :: sphhar
          TYPE(t_obsolete),INTENT(INOUT) :: obsolete
          TYPE(t_sym),INTENT(INOUT)      :: sym
          TYPE(t_stars),INTENT(INOUT)    :: stars
          TYPE(t_oneD),INTENT(INOUT)     :: oneD
          TYPE(t_input),INTENT(INOUT)    :: input
          TYPE(t_noco),INTENT(INOUT)     :: noco
          TYPE(t_vacuum),INTENT(INOUT)   :: vacuum
          TYPE(t_cell),INTENT(INOUT)     :: cell
72
          CLASS(t_xcpot),INTENT(INOUT)   :: xcpot
73 74 75 76 77 78 79 80 81
          TYPE(t_sliceplot),INTENT(INOUT):: sliceplot
          TYPE(t_enpara),INTENT(INOUT)   :: enpara
          LOGICAL, INTENT (IN) :: l_opti  
          !     ..
          !     .. Local Scalars ..
          REAL       :: rkmaxx
          INTEGER    :: ntp1,ii,i,j,n1,n2,na,np1,n
          INTEGER, ALLOCATABLE :: lmx1(:), nq1(:), nlhtp1(:)
          !
Daniel Wortmann's avatar
Daniel Wortmann committed
82
        IF ( mpi%irank == 0 ) THEN
83
          IF (sym%namgrp.EQ.'any ') THEN
84
             CALL rw_symfile('R',94,'sym.out',sym%nop,cell%bmat, sym%mrot,sym%tau,sym%nop,sym%nop2,sym%symor)
85
          ELSE
86
             CALL spg2set(sym%nop,sym%zrfs,sym%invs,sym%namgrp,cell%latnam, sym%mrot,sym%tau,sym%nop2,sym%symor)
87 88 89
          ENDIF
          IF (input%film.AND..NOT.sym%symor) CALL juDFT_warn("Films&Symor",hint&
               &     ="Films should be symmorphic",calledby ='setup')
90
          CALL ylmnorm_init(atoms%lmaxd)
91 92
          IF (.NOT.oneD%odd%d1) THEN
             CALL local_sym(&
93
                  atoms%lmaxd,atoms%lmax,sym%nop,sym%mrot,sym%tau,&
94
                  atoms%nat,atoms%ntype,atoms%neq,cell%amat,cell%bmat,atoms%taual,&
95 96
                  sphhar%nlhd,sphhar%memd,sphhar%ntypsd,.FALSE.,&
                  atoms%nlhtyp,atoms%ntypsy,sphhar%nlh,sphhar%llh,sphhar%nmem,sphhar%mlh,sphhar%clnu)
97 98 99 100 101 102
             sym%nsymt = sphhar%ntypsd

             oneD%mrot1(:,:,:) = sym%mrot(:,:,:)
             oneD%tau1(:,:) = sym%tau(:,:)
          ELSEIF (oneD%odd%d1) THEN
             CALL od_chisym(oneD%odd,oneD%mrot1,oneD%tau1,sym%zrfs,sym%invs,sym%invs2,cell%amat)
103
             ntp1 = atoms%nat
104 105 106 107 108 109 110 111 112 113
             ALLOCATE (nq1(ntp1),lmx1(ntp1),nlhtp1(ntp1))
             ii = 1
             DO i = 1,atoms%ntype
                DO j = 1,atoms%neq(i)
                   nq1(ii) = 1
                   lmx1(ii) = atoms%lmax(i)
                   ii = ii + 1
                END DO
             END DO
             CALL local_sym(&
114
                  atoms%lmaxd,lmx1,sym%nop,sym%mrot,sym%tau,&
115
                  atoms%nat,ntp1,nq1,cell%amat,cell%bmat,atoms%taual,&
116 117
                  sphhar%nlhd,sphhar%memd,sphhar%ntypsd,.FALSE.,&
                  nlhtp1,atoms%ntypsy,sphhar%nlh,sphhar%llh,sphhar%nmem,sphhar%mlh,sphhar%clnu)
118 119 120 121 122 123 124 125 126 127 128

             sym%nsymt = sphhar%ntypsd
             ii = 1
             DO i = 1,atoms%ntype
                atoms%nlhtyp(i) = nlhtp1(ii)
                ii = ii + atoms%neq(i)
             END DO
             DEALLOCATE (lmx1,nlhtp1)
          END IF
          !+odim
          IF (atoms%n_u.GT.0) THEN
129
             CALL d_wigner(sym%nop,sym%mrot,cell%bmat,3, sym%d_wgn)
130 131 132 133
          ENDIF
          !
          !+odim
          IF (.NOT.oneD%odd%d1) THEN
134
             CALL mapatom(sym,atoms, cell,input, noco)
135
             oneD%ngopr1(1:atoms%nat) = atoms%ngopr(1:atoms%nat)
136 137 138 139
             !        DEALLOCATE ( nq1 )
          ELSE
             !-odim
             CALL juDFT_error("The oneD version is broken here. Compare call to mapatom with old version")
140 141
             CALL mapatom(sym,atoms, cell,input, noco)
             CALL od_mapatom(oneD,atoms,sym,cell)
142 143
          END IF

144 145
          ! Store structure data

146
          CALL storeStructureIfNew(input, atoms, cell, vacuum, oneD, sym)
147

148 149
          !+odim
          IF (input%film.OR.(sym%namgrp.NE.'any ')) THEN
150
             CALL strgn1(stars,sym,atoms, vacuum,sphhar, input,cell,xcpot)
151 152
             !-odim
             IF (oneD%odd%d1) THEN
153
                CALL od_strgn1(xcpot,cell,sym,oneD)
154 155 156
             END IF
             !+odim
          ELSE
157
             CALL strgn2(stars,sym,atoms, vacuum,sphhar, input,cell,xcpot)
158 159
          ENDIF
          !
160
          !IF (.NOT.l_opti) THEN
161
             CALL inpeig(atoms,cell,input,oneD%odd%d1,kpts,enpara)
162
          !ENDIF
163 164 165
          !
          !-----> prepare dimensions for charge density fft-box in pwden.f
          !
166
          CALL  prp_qfft(stars, cell,noco, input)
167 168

          IF (input%gw.GE.1) CALL write_gw(&
169
               atoms%ntype,sym%nop,1,input%jspins,atoms%nat,&
170 171 172
               atoms%ncst,atoms%neq,atoms%lmax,sym%mrot,cell%amat,cell%bmat,input%rkmax,&
               atoms%taual,atoms%zatom,cell%vol,1.0,DIMENSION%neigd,atoms%lmaxd,&
               atoms%nlod,atoms%llod,atoms%nlo,atoms%llo,noco%l_soc)
173 174 175 176 177
          !
          !-----> prepare dimensions for xc fft-box in visxc(g).f
          !
          
         
178
          CALL  prp_xcfft(stars,input, cell, xcpot)
179
          !
Daniel Wortmann's avatar
Daniel Wortmann committed
180
        ENDIF ! (mpi%irank == 0)
181
          CALL stepf(sym,stars,atoms,oneD, input,cell, vacuum,mpi)
182
          IF (.NOT.sliceplot%iplot) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
183 184
             IF ( mpi%irank == 0 ) THEN
                CALL convn(DIMENSION,atoms,stars)
185

Daniel Wortmann's avatar
Daniel Wortmann committed
186
                !--->    set up electric field parameters (if needed) 
187
                ! CALL e_field(atoms, DIMENSION, stars, sym, vacuum, cell, input,field)
Daniel Wortmann's avatar
Daniel Wortmann committed
188
             ENDIF
189 190 191 192
          ENDIF

        END SUBROUTINE setup
      END MODULE m_setup