setup.f90 7.07 KB
Newer Older
1 2 3
      MODULE m_setup
      USE m_juDFT
      CONTAINS
4 5
        SUBROUTINE setup(atoms,kpts,DIMENSION,sphhar,&
                  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 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80
          USE m_mapatom
          USE m_writegw
          USE m_convn
          USE m_prpqfft
          USE m_prpxcfft
          USE m_inpeig
          USE m_efield
          !-odim
          USE m_od_mapatom
          USE m_od_chisym
          USE m_od_strgn1
          !+odim
          IMPLICIT NONE
          !     ..
          !     .. Scalars Arguments ..
          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
          TYPE(t_xcpot),INTENT(INOUT)    :: xcpot
          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(:)
          !
          IF (sym%namgrp.EQ.'any ') THEN
81
             CALL rw_symfile('R',94,'sym.out',sym%nop,cell%bmat, sym%mrot,sym%tau,sym%nop,sym%nop2,sym%symor)
82
          ELSE
83
             CALL spg2set(sym%nop,sym%zrfs,sym%invs,sym%namgrp,cell%latnam, sym%mrot,sym%tau,sym%nop2,sym%symor)
84 85 86 87 88
          ENDIF
          IF (input%film.AND..NOT.sym%symor) CALL juDFT_warn("Films&Symor",hint&
               &     ="Films should be symmorphic",calledby ='setup')
          IF (.NOT.oneD%odd%d1) THEN
             CALL local_sym(&
89
                  atoms%lmaxd,atoms%lmax,sym%nop,sym%mrot,sym%tau,&
Daniel Wortmann's avatar
Daniel Wortmann committed
90
                  atoms%nat,atoms%ntype,atoms%neq,cell%amat,cell%bmat,atoms%taual,&
91 92
                  sphhar%nlhd,sphhar%memd,sphhar%ntypsd,.FALSE.,&
                  atoms%nlhtyp,atoms%ntypsy,sphhar%nlh,sphhar%llh,sphhar%nmem,sphhar%mlh,sphhar%clnu)
93 94 95 96 97 98
             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)
Daniel Wortmann's avatar
Daniel Wortmann committed
99
             ntp1 = atoms%nat
100 101 102 103 104 105 106 107 108 109
             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(&
110
                  atoms%lmaxd,lmx1,sym%nop,sym%mrot,sym%tau,&
Daniel Wortmann's avatar
Daniel Wortmann committed
111
                  atoms%nat,ntp1,nq1,cell%amat,cell%bmat,atoms%taual,&
112 113
                  sphhar%nlhd,sphhar%memd,sphhar%ntypsd,.FALSE.,&
                  nlhtp1,atoms%ntypsy,sphhar%nlh,sphhar%llh,sphhar%nmem,sphhar%mlh,sphhar%clnu)
114 115 116 117 118 119 120 121 122 123 124

             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
125
             CALL d_wigner(sym%nop,sym%mrot,cell%bmat,3, sym%d_wgn)
126 127 128 129
          ENDIF
          !
          !+odim
          IF (.NOT.oneD%odd%d1) THEN
130
             CALL mapatom(sym,atoms, cell,input, noco)
Daniel Wortmann's avatar
Daniel Wortmann committed
131
             oneD%ngopr1(1:atoms%nat) = atoms%ngopr(1:atoms%nat)
132 133 134 135
             !        DEALLOCATE ( nq1 )
          ELSE
             !-odim
             CALL juDFT_error("The oneD version is broken here. Compare call to mapatom with old version")
136 137
             CALL mapatom(sym,atoms, cell,input, noco)
             CALL od_mapatom(oneD,atoms,sym,cell)
138 139
          END IF

140 141
          ! Store structure data

142
          CALL storeStructureIfNew(input, atoms, cell, vacuum, oneD, sym)
143

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

          IF (input%gw.GE.1) CALL write_gw(&
Daniel Wortmann's avatar
Daniel Wortmann committed
165
               atoms%ntype,sym%nop,1,input%jspins,atoms%nat,&
166 167 168
               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)
169 170 171 172 173
          !
          !-----> prepare dimensions for xc fft-box in visxc(g).f
          !
          
         
174
          CALL  prp_xcfft(stars,input, cell, xcpot)
175 176 177
          !
          IF (.NOT.sliceplot%iplot) THEN
             !
178
             CALL stepf(sym,stars,atoms,oneD, input,cell, vacuum)
179
             !
180
             CALL convn(DIMENSION,atoms,stars)
181 182 183
             !
             !--->    set up electric field parameters (if needed) 
             !
184
             CALL efield(atoms, DIMENSION, stars, sym, vacuum, cell, input)
185 186 187 188 189

          ENDIF

        END SUBROUTINE setup
      END MODULE m_setup