diff --git a/fleurinput/types_hybinp.f90 b/fleurinput/types_hybinp.f90 index 6179b99e168bc37b2cca6bacb0e69a8807f29ad5..f81931f49d7cb6ae09222bb6f4fae81e5f2b36cb 100644 --- a/fleurinput/types_hybinp.f90 +++ b/fleurinput/types_hybinp.f90 @@ -18,9 +18,6 @@ MODULE m_types_hybinp INTEGER :: ewaldlambda = -1 INTEGER :: lexp = -1 INTEGER :: bands1 = -1 !Only read in - INTEGER :: nbasp = -1 - INTEGER :: maxbasm1 = -1 - INTEGER :: max_indx_p_1 = -1 !new INTEGER, ALLOCATABLE :: select1(:, :) INTEGER, ALLOCATABLE :: lcutm1(:) INTEGER, ALLOCATABLE :: lcutwf(:) @@ -56,9 +53,6 @@ CONTAINS CALL mpi_bc(this%ewaldlambda, rank, mpi_comm) CALL mpi_bc(this%lexp, rank, mpi_comm) CALL mpi_bc(this%bands1, rank, mpi_comm) - CALL mpi_bc(this%nbasp, rank, mpi_comm) - CALL mpi_bc(this%maxbasm1, rank, mpi_comm) - CALL mpi_bc(this%max_indx_p_1, rank, mpi_comm) CALL mpi_bc(this%select1, rank, mpi_comm) CALL mpi_bc(this%lcutm1, rank, mpi_comm) CALL mpi_bc(this%lcutwf, rank, mpi_comm) diff --git a/hybrid/coulombmatrix.F90 b/hybrid/coulombmatrix.F90 index 92c419f9653097adad503b4e4b2ec5529f927ff0..eca09705610b6342b823e66b4286a1c127487de5 100644 --- a/hybrid/coulombmatrix.F90 +++ b/hybrid/coulombmatrix.F90 @@ -35,13 +35,13 @@ MODULE m_coulombmatrix CONTAINS - SUBROUTINE coulombmatrix(mpi, atoms, kpts, cell, sym, mpdata, hybinp, xcpot) + SUBROUTINE coulombmatrix(mpi, atoms, kpts, cell, sym, mpdata, hybinp, hybdat, xcpot) USE m_types_hybdat USE m_types USE m_juDFT USE m_constants, ONLY: pi_const USE m_olap, ONLY: olap_pw - use m_types_hybdat, only: gptnorm + use m_types_hybdat USE m_trafo, ONLY: symmetrize, bramat_trafo USE m_intgrf, ONLY: intgrf, intgrf_init use m_util, only: primitivef @@ -56,6 +56,7 @@ CONTAINS TYPE(t_mpi), INTENT(IN) :: mpi TYPE(t_mpdata), intent(in) :: mpdata TYPE(t_hybinp), INTENT(IN) :: hybinp + TYPE(t_hybdat), INTENT(IN) :: hybdat TYPE(t_sym), INTENT(IN) :: sym TYPE(t_cell), INTENT(IN) :: cell TYPE(t_kpts), INTENT(IN) :: kpts @@ -156,7 +157,7 @@ CONTAINS CALL intgrf_init(atoms%ntype, atoms%jmtd, atoms%jri, atoms%dx, atoms%rmsh, gridf) - nbasm1 = hybinp%nbasp + mpdata%n_g(:) + nbasm1 = hybdat%nbasp + mpdata%n_g(:) ! Calculate the structure constant CALL structureconstant(structconst, cell, hybinp, atoms, kpts, mpi) @@ -170,7 +171,7 @@ CONTAINS call timestart("coulomb allocation") IF (ALLOCATED(coulomb)) deallocate(coulomb) - allocate(coulomb(hybinp%maxbasm1*(hybinp%maxbasm1 + 1)/2, kpts%nkpt), stat=ok) + allocate(coulomb(hybdat%maxbasm1*(hybdat%maxbasm1 + 1)/2, kpts%nkpt), stat=ok) IF (ok /= 0) call judft_error('coulombmatrix: failure allocation coulomb matrix') coulomb = 0 call timestop("coulomb allocation") @@ -465,7 +466,7 @@ CONTAINS ! (1b) r,r' in different MT - allocate(coulmat(hybinp%nbasp, hybinp%nbasp), stat=ok) + allocate(coulmat(hybdat%nbasp, hybdat%nbasp), stat=ok) IF (ok /= 0) call judft_error('coulombmatrix: failure allocation coulmat') coulmat = 0 @@ -525,12 +526,12 @@ CONTAINS IF (sym%invs) THEN !symmetrize makes the Coulomb matrix real symmetric - CALL symmetrize(coulmat, hybinp%nbasp, hybinp%nbasp, 3, .FALSE., & + CALL symmetrize(coulmat, hybdat%nbasp, hybdat%nbasp, 3, .FALSE., & atoms, hybinp%lcutm1, maxval(hybinp%lcutm1), & mpdata%num_radbasfn, sym) ENDIF - coulomb(:hybinp%nbasp*(hybinp%nbasp + 1)/2, ikpt) = packmat(coulmat) + coulomb(:hybdat%nbasp*(hybdat%nbasp + 1)/2, ikpt) = packmat(coulmat) END IF call timestop("MT-MT part") @@ -559,7 +560,7 @@ CONTAINS ! (2b) r,r' in same MT ! (2c) r,r' in different MT - allocate(coulmat(hybinp%nbasp, maxval(mpdata%n_g)), stat=ok) + allocate(coulmat(hybdat%nbasp, maxval(mpdata%n_g)), stat=ok) IF (ok /= 0) call judft_error('coulombmatrix: failure allocation coulmat') coulmat = 0 @@ -571,7 +572,7 @@ CONTAINS DO igpt0 = igptmin(ikpt), igptmax(ikpt) !1,ngptm1(ikpt) igpt = pgptm1(igpt0, ikpt) igptp = mpdata%gptm_ptr(igpt, ikpt) - ix = hybinp%nbasp + igpt + ix = hybdat%nbasp + igpt q = MATMUL(kpts%bk(:, ikpt) + mpdata%g(:, igptp), cell%bmat) qnorm = norm2(q) iqnrm = pqnrm(igpt, ikpt) @@ -657,13 +658,13 @@ CONTAINS iy = iy + 1 IF (ikpt == 1 .AND. igpt == 1) THEN - IF (l == 0) coulmat(iy, ix - hybinp%nbasp) = & + IF (l == 0) coulmat(iy, ix - hybdat%nbasp) = & -cdum*moment2(n, itype)/6/svol ! (2a) - coulmat(iy, ix - hybinp%nbasp) = coulmat(iy, ix - hybinp%nbasp) & + coulmat(iy, ix - hybdat%nbasp) = coulmat(iy, ix - hybdat%nbasp) & + (-cdum/(2*l + 1)*integral(n, l, itype, iqnrm) & ! (2b)& + csum*moment(n, l, itype))/svol ! (2c) ELSE - coulmat(iy, ix - hybinp%nbasp) = & + coulmat(iy, ix - hybdat%nbasp) = & (cdum*olap(n, l, itype, iqnrm)/qnorm**2 & ! (2a)& - cdum/(2*l + 1)*integral(n, l, itype, iqnrm) & ! (2b)& + csum*moment(n, l, itype))/svol ! (2c) @@ -680,15 +681,15 @@ CONTAINS END DO IF (sym%invs) THEN - CALL symmetrize(coulmat, hybinp%nbasp, mpdata%n_g(ikpt), 1, .FALSE., & + CALL symmetrize(coulmat, hybdat%nbasp, mpdata%n_g(ikpt), 1, .FALSE., & atoms, hybinp%lcutm1, maxval(hybinp%lcutm1), mpdata%num_radbasfn, sym) ENDIF - M = hybinp%nbasp*(hybinp%nbasp + 1)/2 + M = hybdat%nbasp*(hybdat%nbasp + 1)/2 DO i = 1, mpdata%n_g(ikpt) - DO j = 1, hybinp%nbasp + i + DO j = 1, hybdat%nbasp + i M = M + 1 - IF (j <= hybinp%nbasp) coulomb(M, ikpt) = coulmat(j, i) + IF (j <= hybdat%nbasp) coulomb(M, ikpt) = coulmat(j, i) END DO END DO END DO @@ -749,8 +750,8 @@ CONTAINS DO igpt0 = igptmin(ikpt), igptmax(ikpt) igpt2 = pgptm1(igpt0, ikpt) igptp2 = mpdata%gptm_ptr(igpt2, ikpt) - ix = hybinp%nbasp + igpt2 - iy = hybinp%nbasp + ix = hybdat%nbasp + igpt2 + iy = hybdat%nbasp q2 = MATMUL(kpts%bk(:, ikpt) + mpdata%g(:, igptp2), cell%bmat) rdum2 = SUM(q2**2) IF (abs(rdum2) > 1e-12) rdum2 = 4*pi_const/rdum2 @@ -820,7 +821,7 @@ CONTAINS DO igpt0 = igptmin(ikpt), igptmax(ikpt)!1,ngptm1(ikpt) igpt2 = pgptm1(igpt0, ikpt) - ix = hybinp%nbasp + igpt2 + ix = hybdat%nbasp + igpt2 igptp2 = mpdata%gptm_ptr(igpt2, ikpt) iqnrm2 = pqnrm(igpt2, ikpt) ic2 = 0 @@ -858,7 +859,7 @@ CONTAINS call timestop("itype loops") call timestart("igpt1") - iy = hybinp%nbasp + iy = hybdat%nbasp DO igpt1 = 1, igpt2 iy = iy + 1 igptp1 = mpdata%gptm_ptr(igpt1, ikpt) @@ -894,12 +895,12 @@ CONTAINS rdum = (4*pi_const)**(1.5)/cell%vol**2*gmat(1, 1) DO igpt0 = 1, ngptm1(1) igpt2 = pgptm1(igpt0, 1); IF (igpt2 == 1) CYCLE - ix = hybinp%nbasp + igpt2 + ix = hybdat%nbasp + igpt2 iqnrm2 = pqnrm(igpt2, 1) igptp2 = mpdata%gptm_ptr(igpt2, 1) q2 = MATMUL(mpdata%g(:, igptp2), cell%bmat) qnorm2 = norm2(q2) - iy = hybinp%nbasp + 1 + iy = hybdat%nbasp + 1 DO igpt1 = 2, igpt2 iy = iy + 1 idum = ix*(ix - 1)/2 + iy @@ -937,10 +938,10 @@ CONTAINS END DO END DO ! (2) igpt1 = 1 , igpt2 > 1 (first G vector vanishes, second finite) - iy = hybinp%nbasp + 1 + iy = hybdat%nbasp + 1 DO igpt0 = 1, ngptm1(1) igpt2 = pgptm1(igpt0, 1); IF (igpt2 == 1) CYCLE - ix = hybinp%nbasp + igpt2 + ix = hybdat%nbasp + igpt2 iqnrm2 = pqnrm(igpt2, 1) igptp2 = mpdata%gptm_ptr(igpt2, 1) qnorm2 = qnrm(iqnrm2) @@ -963,8 +964,8 @@ CONTAINS END DO END DO ! (2) igpt1 = 1 , igpt2 = 1 (vanishing G vectors) - iy = hybinp%nbasp + 1 - ix = hybinp%nbasp + 1 + iy = hybdat%nbasp + 1 + ix = hybdat%nbasp + 1 idum = ix*(ix - 1)/2 + iy DO itype1 = 1, atoms%ntype DO ineq1 = 1, atoms%neq(itype1) @@ -1009,12 +1010,12 @@ CONTAINS call timestart("q loop") DO igpt0 = igptmin(ikpt), igptmax(ikpt)!1,ngptm1(ikpt) igpt2 = pgptm1(igpt0, ikpt) - ix = hybinp%nbasp + igpt2 + ix = hybdat%nbasp + igpt2 igptp2 = mpdata%gptm_ptr(igpt2, ikpt) iqnrm2 = pqnrm(igpt2, ikpt) q2 = MATMUL(kpts%bk(:, ikpt) + mpdata%g(:, igptp2), cell%bmat) y2 = CONJG(carr2(:, igpt2)) - iy = hybinp%nbasp + iy = hybdat%nbasp DO igpt1 = 1, igpt2 iy = iy + 1 igptp1 = mpdata%gptm_ptr(igpt1, ikpt) @@ -1072,7 +1073,7 @@ CONTAINS ! All elements are needed so send all data to all processes treating the ! respective k-points - allocate(carr2(hybinp%maxbasm1, 2), iarr(maxval(mpdata%n_g))) + allocate(carr2(hybdat%maxbasm1, 2), iarr(maxval(mpdata%n_g))) allocate(nsym_gpt(mpdata%num_gpts(), kpts%nkpt), & sym_gpt(MAXVAL(nsym1), mpdata%num_gpts(), kpts%nkpt)) nsym_gpt = 0; sym_gpt = 0 @@ -1084,11 +1085,11 @@ CONTAINS lsym = ((igptmin(ikpt) <= igpt0) .AND. & (igptmax(ikpt) >= igpt0)) igpt2 = pgptm1(igpt0, ikpt) - j = (hybinp%nbasp + igpt2 - 1)*(hybinp%nbasp + igpt2)/2 - i = hybinp%nbasp + igpt2 + j = (hybdat%nbasp + igpt2 - 1)*(hybdat%nbasp + igpt2)/2 + i = hybdat%nbasp + igpt2 carr2(1:i, 2) = coulomb(j + 1:j + i, ikpt) j = j + i - DO i = hybinp%nbasp + igpt2 + 1, nbasm1(ikpt) + DO i = hybdat%nbasp + igpt2 + 1, nbasm1(ikpt) j = j + i - 1 IF (sym%invs) THEN carr2(i, 2) = coulomb(j, ikpt) @@ -1108,7 +1109,7 @@ CONTAINS sym, rrot(:, :, isym), invrrot(:, :, isym), mpdata, hybinp, & kpts, maxval(hybinp%lcutm1), atoms, hybinp%lcutm1, & mpdata%num_radbasfn, maxval(mpdata%num_radbasfn), dwgn(:, :, :, isym), & - hybinp%nbasp, nbasm1) + hybdat%nbasp, nbasm1) IF (iarr(igpt1) == 0) THEN CALL bramat_trafo( & carr2(:, 1), igpt1, & @@ -1116,9 +1117,9 @@ CONTAINS sym, rrot(:, :, isym), invrrot(:, :, isym), mpdata, hybinp, & kpts, maxval(hybinp%lcutm1), atoms, hybinp%lcutm1, & mpdata%num_radbasfn, maxval(mpdata%num_radbasfn), & - dwgn(:, :, :, isym), hybinp%nbasp, nbasm1) - l = (hybinp%nbasp + igpt1 - 1)*(hybinp%nbasp + igpt1)/2 - coulomb(l + 1:l + hybinp%nbasp + igpt1, ikpt) = carr2(:hybinp%nbasp + igpt1, 1) + dwgn(:, :, :, isym), hybdat%nbasp, nbasm1) + l = (hybdat%nbasp + igpt1 - 1)*(hybdat%nbasp + igpt1)/2 + coulomb(l + 1:l + hybdat%nbasp + igpt1, ikpt) = carr2(:hybdat%nbasp + igpt1, 1) iarr(igpt1) = 1 IF (lsym) THEN ic = ic + 1 @@ -1147,7 +1148,8 @@ CONTAINS ! the normal Coulomb matrix ! ELSE - IF (ikptmin == 1) CALL subtract_sphaverage(sym, cell, atoms, mpdata, hybinp, nbasm1, gridf, coulomb) + IF (ikptmin == 1) CALL subtract_sphaverage(sym, cell, atoms, mpdata, & + hybinp, hybdat, nbasm1, gridf, coulomb) END IF ! transform Coulomb matrix to the biorthogonal set @@ -1208,14 +1210,14 @@ CONTAINS call timestart("multiply inverse rhs") if (olapm%l_real) THEN !multiply with inverse olap from right hand side - coulhlp%data_r(:, hybinp%nbasp + 1:) = MATMUL(coulhlp%data_r(:, hybinp%nbasp + 1:), olapm%data_r) + coulhlp%data_r(:, hybdat%nbasp + 1:) = MATMUL(coulhlp%data_r(:, hybdat%nbasp + 1:), olapm%data_r) !multiply with inverse olap from left side - coulhlp%data_r(hybinp%nbasp + 1:, :) = MATMUL(olapm%data_r, coulhlp%data_r(hybinp%nbasp + 1:, :)) + coulhlp%data_r(hybdat%nbasp + 1:, :) = MATMUL(olapm%data_r, coulhlp%data_r(hybdat%nbasp + 1:, :)) else !multiply with inverse olap from right hand side - coulhlp%data_c(:, hybinp%nbasp + 1:) = MATMUL(coulhlp%data_c(:, hybinp%nbasp + 1:), olapm%data_c) + coulhlp%data_c(:, hybdat%nbasp + 1:) = MATMUL(coulhlp%data_c(:, hybdat%nbasp + 1:), olapm%data_c) !multiply with inverse olap from left side - coulhlp%data_c(hybinp%nbasp + 1:, :) = MATMUL(olapm%data_c, coulhlp%data_c(hybinp%nbasp + 1:, :)) + coulhlp%data_c(hybdat%nbasp + 1:, :) = MATMUL(olapm%data_c, coulhlp%data_c(hybdat%nbasp + 1:, :)) end if coulomb(:(nbasm1(ikpt)*(nbasm1(ikpt) + 1))/2, ikpt) = coulhlp%to_packed() call timestop("multiply inverse rhs") @@ -1343,9 +1345,9 @@ CONTAINS iatom = iatom + 1 DO n = 1, mpdata%num_radbasfn(0, itype) - 1 if (coulhlp%l_real) THEN - coulomb_mt2_r(n, 0, maxval(hybinp%lcutm1) + 1, iatom, ikpt0) = coulhlp%data_r(ic + n, hybinp%nbasp + 1) + coulomb_mt2_r(n, 0, maxval(hybinp%lcutm1) + 1, iatom, ikpt0) = coulhlp%data_r(ic + n, hybdat%nbasp + 1) else - coulomb_mt2_c(n, 0, maxval(hybinp%lcutm1) + 1, iatom, ikpt0) = coulhlp%data_c(ic + n, hybinp%nbasp + 1) + coulomb_mt2_c(n, 0, maxval(hybinp%lcutm1) + 1, iatom, ikpt0) = coulhlp%data_c(ic + n, hybdat%nbasp + 1) endif END DO ic = ic + SUM([((2*l + 1)*mpdata%num_radbasfn(l, itype), l=0, hybinp%lcutm1(itype))]) @@ -1465,10 +1467,10 @@ CONTAINS DO igpt = 1, mpdata%n_g(ikpt) indx2 = indx2 + 1 IF (sym%invs) THEN - coulomb_mtir_r(indx1, indx2, ikpt1) = coulhlp%data_r(indx3, hybinp%nbasp + igpt) + coulomb_mtir_r(indx1, indx2, ikpt1) = coulhlp%data_r(indx3, hybdat%nbasp + igpt) coulomb_mtir_r(indx2, indx1, ikpt1) = coulomb_mtir_r(indx1, indx2, ikpt1) ELSE - coulomb_mtir_c(indx1, indx2, ikpt1) = coulhlp%data_c(indx3, hybinp%nbasp + igpt) + coulomb_mtir_c(indx1, indx2, ikpt1) = coulhlp%data_c(indx3, hybdat%nbasp + igpt) coulomb_mtir_c(indx2, indx1, ikpt1) = CONJG(coulomb_mtir_c(indx1, indx2, ikpt1)) ENDIF @@ -1487,12 +1489,12 @@ CONTAINS ! if (sym%invs) THEN coulomb_mtir_r(ic + 1:ic + mpdata%n_g(ikpt), ic + 1:ic + mpdata%n_g(ikpt), ikpt1) & - = coulhlp%data_r(hybinp%nbasp + 1:nbasm1(ikpt), hybinp%nbasp + 1:nbasm1(ikpt)) + = coulhlp%data_r(hybdat%nbasp + 1:nbasm1(ikpt), hybdat%nbasp + 1:nbasm1(ikpt)) ic2 = indx1 + mpdata%n_g(ikpt) coulombp_mtir_r(:ic2*(ic2 + 1)/2, ikpt0) = packmat(coulomb_mtir_r(:ic2, :ic2, ikpt1)) else coulomb_mtir_c(ic + 1:ic + mpdata%n_g(ikpt), ic + 1:ic + mpdata%n_g(ikpt), ikpt1) & - = coulhlp%data_c(hybinp%nbasp + 1:nbasm1(ikpt), hybinp%nbasp + 1:nbasm1(ikpt)) + = coulhlp%data_c(hybdat%nbasp + 1:nbasm1(ikpt), hybdat%nbasp + 1:nbasm1(ikpt)) ic2 = indx1 + mpdata%n_g(ikpt) coulombp_mtir_c(:ic2*(ic2 + 1)/2, ikpt0) = packmat(coulomb_mtir_c(:ic2, :ic2, ikpt1)) end if @@ -1538,7 +1540,7 @@ CONTAINS ! Calculate body of Coulomb matrix at Gamma point: v_IJ = SUM(G) c^*_IG c_JG 4*pi/G**2 . ! For this we must subtract from coulomb(:,1) the spherical average of a term that comes ! from the fact that MT functions have k-dependent Fourier coefficients (see script). - SUBROUTINE subtract_sphaverage(sym, cell, atoms, mpdata, hybinp, nbasm1, gridf, coulomb) + SUBROUTINE subtract_sphaverage(sym, cell, atoms, mpdata, hybinp, hybdat, nbasm1, gridf, coulomb) USE m_types USE m_constants @@ -1554,6 +1556,7 @@ CONTAINS TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_mpdata), intent(in) :: mpdata TYPE(t_hybinp), INTENT(IN) :: hybinp + TYPE(t_hybdat), INTENT(IN) :: hybdat INTEGER, INTENT(IN) :: nbasm1(:) REAL, INTENT(IN) :: gridf(:,:) @@ -1607,9 +1610,9 @@ CONTAINS END DO END DO IF (olap%l_real) THEN - coeff(hybinp%nbasp + 1:n) = olap%data_r(1, 1:n - hybinp%nbasp) + coeff(hybdat%nbasp + 1:n) = olap%data_r(1, 1:n - hybdat%nbasp) else - coeff(hybinp%nbasp + 1:n) = olap%data_c(1, 1:n - hybinp%nbasp) + coeff(hybdat%nbasp + 1:n) = olap%data_c(1, 1:n - hybdat%nbasp) END IF IF (sym%invs) THEN CALL symmetrize(coeff, 1, nbasm1(1), 2, .FALSE., & @@ -1639,8 +1642,8 @@ CONTAINS + CONJG(claplace(i))*coeff(j))/2) END DO END DO - coeff(hybinp%nbasp + 1) = 1.0 - coeff(hybinp%nbasp + 2:) = 0.0 + coeff(hybdat%nbasp + 1) = 1.0 + coeff(hybdat%nbasp + 2:) = 0.0 IF (sym%invs) THEN CALL desymmetrize(coeff, 1, nbasm1(1), 2, & @@ -1652,7 +1655,7 @@ CONTAINS ENDIF ! Explicit normalization here in order to prevent failure of the diagonalization in diagonalize_coulomb ! due to inaccuracies in the overlap matrix (which can make it singular). - !constfunc = coeff / SQRT ( ( SUM(ABS(coeff(:hybinp%nbasp))**2) + dot_product ( coeff(hybinp%nbasp+1:), MATMUL(olap,coeff(hybinp%nbasp+1:)) ) ) ) + !constfunc = coeff / SQRT ( ( SUM(ABS(coeff(:hybdat%nbasp))**2) + dot_product ( coeff(hybdat%nbasp+1:), MATMUL(olap,coeff(hybdat%nbasp+1:)) ) ) ) END SUBROUTINE subtract_sphaverage diff --git a/hybrid/exchange_val_hf.F90 b/hybrid/exchange_val_hf.F90 index d8f931c18eeb5ebaa924c3f6350852b859ca454e..6e10a2bddf52a7f57030213ebb813e9c449974fb 100644 --- a/hybrid/exchange_val_hf.F90 +++ b/hybrid/exchange_val_hf.F90 @@ -129,8 +129,8 @@ CONTAINS COMPLEX :: hessian(3, 3) COMPLEX :: proj_ibsc(3, mnobd, hybdat%nbands(nk)) COMPLEX :: olap_ibsc(3, 3, mnobd, mnobd) - REAL :: carr1_v_r(hybinp%maxbasm1) - COMPLEX :: carr1_v_c(hybinp%maxbasm1) + REAL :: carr1_v_r(hybdat%maxbasm1) + COMPLEX :: carr1_v_c(hybdat%maxbasm1) COMPLEX, ALLOCATABLE :: phase_vv(:, :) REAL, ALLOCATABLE :: cprod_vv_r(:, :, :), carr3_vv_r(:, :, :) COMPLEX, ALLOCATABLE :: cprod_vv_c(:, :, :), carr3_vv_c(:, :, :) @@ -161,7 +161,7 @@ CONTAINS ! the contribution of the Gamma-point is treated separately (see below) ! determine package size loop over the occupied bands - rdum = hybinp%maxbasm1*hybdat%nbands(nk)*4/1048576. + rdum = hybdat%maxbasm1*hybdat%nbands(nk)*4/1048576. psize = 1 DO iband = mnobd, 1, -1 ! ensure that the packages have equal size @@ -184,17 +184,17 @@ CONTAINS IF (ok /= 0) call judft_error('exchange_val_hf: error allocation phase') if (mat_ex%l_real) THEN - allocate(cprod_vv_c(hybinp%maxbasm1, 0, 0), carr3_vv_c(hybinp%maxbasm1, 0, 0)) - allocate(cprod_vv_r(hybinp%maxbasm1, psize, hybdat%nbands(nk)), stat=ok) + allocate(cprod_vv_c(hybdat%maxbasm1, 0, 0), carr3_vv_c(hybdat%maxbasm1, 0, 0)) + allocate(cprod_vv_r(hybdat%maxbasm1, psize, hybdat%nbands(nk)), stat=ok) IF (ok /= 0) call judft_error('exchange_val_hf: error allocation cprod') - allocate(carr3_vv_r(hybinp%maxbasm1, psize, hybdat%nbands(nk)), stat=ok) + allocate(carr3_vv_r(hybdat%maxbasm1, psize, hybdat%nbands(nk)), stat=ok) IF (ok /= 0) call judft_error('exchange_val_hf: error allocation carr3') cprod_vv_r = 0; carr3_vv_r = 0 ELSE - allocate(cprod_vv_r(hybinp%maxbasm1, 0, 0), carr3_vv_r(hybinp%maxbasm1, 0, 0)) - allocate(cprod_vv_c(hybinp%maxbasm1, psize, hybdat%nbands(nk)), stat=ok) + allocate(cprod_vv_r(hybdat%maxbasm1, 0, 0), carr3_vv_r(hybdat%maxbasm1, 0, 0)) + allocate(cprod_vv_c(hybdat%maxbasm1, psize, hybdat%nbands(nk)), stat=ok) IF (ok /= 0) call judft_error('exchange_val_hf: error allocation cprod') - allocate(carr3_vv_c(hybinp%maxbasm1, psize, hybdat%nbands(nk)), stat=ok) + allocate(carr3_vv_c(hybdat%maxbasm1, psize, hybdat%nbands(nk)), stat=ok) IF (ok /= 0) call judft_error('exchange_val_hf: error allocation carr3') cprod_vv_c = 0; carr3_vv_c = 0 END IF @@ -205,7 +205,7 @@ CONTAINS ikpt0 = pointer_EIBZ(ikpt) - n = hybinp%nbasp + mpdata%n_g(ikpt0) + n = hybdat%nbasp + mpdata%n_g(ikpt0) IF (hybinp%nbasm(ikpt0) /= n) call judft_error('error hybinp%nbasm') nn = n*(n + 1)/2 @@ -227,11 +227,11 @@ CONTAINS IF (mat_ex%l_real) THEN CALL wavefproducts_inv5(1, hybdat%nbands(nk), ibando, ibando + psize - 1, input, jsp, atoms, & - lapw, kpts, nk, ikpt0, hybdat, mpdata, hybinp, cell, hybinp%nbasp, sym, & + lapw, kpts, nk, ikpt0, hybdat, mpdata, hybinp, cell, hybdat%nbasp, sym, & noco, nkqpt, cprod_vv_r) ELSE CALL wavefproducts_noinv5(1, hybdat%nbands(nk), ibando, ibando + psize - 1, nk, ikpt0, input, jsp, &!jsp,& - cell, atoms, mpdata, hybinp, hybdat, kpts, lapw, sym, hybinp%nbasp, noco, nkqpt, cprod_vv_c) + cell, atoms, mpdata, hybinp, hybdat, kpts, lapw, sym, hybdat%nbasp, noco, nkqpt, cprod_vv_c) END IF ! The sparse matrix technique is not feasible for the HSE @@ -259,7 +259,7 @@ CONTAINS CALL bra_trafo2(mat_ex%l_real, carr3_vv_r(:hybinp%nbasm(ikpt0), :, :), cprod_vv_r(:hybinp%nbasm(ikpt0), :, :), & carr3_vv_c(:hybinp%nbasm(ikpt0), :, :), cprod_vv_c(:hybinp%nbasm(ikpt0), :, :), & hybinp%nbasm(ikpt0), psize, hybdat%nbands(nk), kpts%bkp(ikpt0), ikpt0, kpts%bksym(ikpt0), sym, & - mpdata, hybinp, kpts, atoms, phase_vv) + mpdata, hybinp, hybdat, kpts, atoms, phase_vv) IF (mat_ex%l_real) THEN cprod_vv_r(:hybinp%nbasm(ikpt0), :, :) = carr3_vv_r(:hybinp%nbasm(ikpt0), :, :) ELSE @@ -280,11 +280,11 @@ CONTAINS call timestart("sparse matrix products") IF (mat_ex%l_real) THEN carr1_v_r(:n) = 0 - CALL spmvec_invs(atoms, mpdata, hybinp, ikpt0, coulomb_mt1, coulomb_mt2_r, coulomb_mt3_r, & + CALL spmvec_invs(atoms, mpdata, hybinp, hybdat, ikpt0, coulomb_mt1, coulomb_mt2_r, coulomb_mt3_r, & coulomb_mtir_r, cprod_vv_r(:n, iband, n1), carr1_v_r(:n)) ELSE carr1_v_c(:n) = 0 - CALL spmvec_noinvs(atoms, mpdata, hybinp, ikpt0, coulomb_mt1, coulomb_mt2_c, coulomb_mt3_c, & + CALL spmvec_noinvs(atoms, mpdata, hybinp, hybdat, ikpt0, coulomb_mt1, coulomb_mt2_c, coulomb_mt3_c, & coulomb_mtir_c, cprod_vv_c(:n, iband, n1), carr1_v_c(:n)) END IF call timestop("sparse matrix products") diff --git a/hybrid/hf_setup.F90 b/hybrid/hf_setup.F90 index 1f0ba812573bf67bc84f2748ff127bced1b66383..27acb66545cddd2cfc2a93a587a14c6160e66b1a 100644 --- a/hybrid/hf_setup.F90 +++ b/hybrid/hf_setup.F90 @@ -216,10 +216,10 @@ CONTAINS allocate(basprod(atoms%jmtd), stat=ok) IF (ok /= 0) call judft_error('eigen_hf: failure allocation basprod') IF(ALLOCATED(hybdat%prodm)) DEALLOCATE(hybdat%prodm) - allocate(hybdat%prodm(maxval(mpdata%num_radbasfn), hybinp%max_indx_p_1, 0:maxval(hybinp%lcutm1), atoms%ntype), stat=ok) + allocate(hybdat%prodm(maxval(mpdata%num_radbasfn), hybdat%max_indx_p_1, 0:maxval(hybinp%lcutm1), atoms%ntype), stat=ok) IF (ok /= 0) call judft_error('eigen_hf: failure allocation hybdat%prodm') - call mpdata%init(hybinp, atoms) + call mpdata%init(hybinp, hybdat, atoms) basprod = 0; hybdat%prodm = 0; mpdata%l1 = 0; mpdata%l2 = 0 mpdata%n1 = 0; mpdata%n2 = 0 diff --git a/hybrid/mixedbasis.F90 b/hybrid/mixedbasis.F90 index 10f77c7a2eb05a0c81e64444f2ef2aa3c5df8d78..d919b5d061cbe1677dc6ec9a727c5ced3c605f22 100644 --- a/hybrid/mixedbasis.F90 +++ b/hybrid/mixedbasis.F90 @@ -56,7 +56,7 @@ CONTAINS TYPE(t_mpi), INTENT(IN) :: mpi TYPE(t_mpdata), intent(inout) :: mpdata TYPE(t_hybinp), INTENT(IN) :: hybinp - TYPE(t_hybdat), INTENT(IN) :: hybdat + TYPE(t_hybdat), INTENT(INOUT) :: hybdat TYPE(t_enpara), INTENT(IN) :: enpara TYPE(t_input), INTENT(IN) :: input TYPE(t_cell), INTENT(IN) :: cell @@ -136,7 +136,7 @@ CONTAINS ! determine maximal indices of (radial) mixed-basis functions (->num_radbasfn) ! (will be reduced later-on due to overlap) - hybinp%max_indx_p_1 = 0 + hybdat%max_indx_p_1 = 0 DO itype = 1, atoms%ntype seleco = .FALSE. selecu = .FALSE. @@ -184,7 +184,7 @@ CONTAINS IF (n_radbasfn == 0 .AND. mpi%irank == 0) & WRITE (6, '(A)') 'mixedbasis: Warning! No basis-function product of '//lchar(l)// & '-angular momentum defined.' - hybinp%max_indx_p_1 = MAX(hybinp%max_indx_p_1, M) + hybdat%max_indx_p_1 = MAX(hybdat%max_indx_p_1, M) mpdata%num_radbasfn(l, itype) = n_radbasfn*input%jspins END DO END DO @@ -369,16 +369,16 @@ CONTAINS call mpdata%check_radbasfn(atoms, hybinp) !count basis functions - hybinp%nbasp = 0 + hybdat%nbasp = 0 DO itype = 1, atoms%ntype DO i = 1, atoms%neq(itype) DO l = 0, hybinp%lcutm1(itype) - hybinp%nbasp = hybinp%nbasp + (2*l+1) * mpdata%num_radbasfn(l, itype) + hybdat%nbasp = hybdat%nbasp + (2*l+1) * mpdata%num_radbasfn(l, itype) END DO END DO END DO - hybinp%maxbasm1 = hybinp%nbasp + maxval(mpdata%n_g) - hybinp%nbasm = hybinp%nbasp + mpdata%n_g + hybdat%maxbasm1 = hybdat%nbasp + maxval(mpdata%n_g) + hybinp%nbasm = hybdat%nbasp + mpdata%n_g hybdat%maxlmindx = 0 do itype = 1,atoms%ntype diff --git a/hybrid/spmvec.F90 b/hybrid/spmvec.F90 index 5b8fe1aaee9b97b0bb1dd7a2379df7c1647fc114..b63e26b3f6e089566a70fd41113af2035b357e4c 100644 --- a/hybrid/spmvec.F90 +++ b/hybrid/spmvec.F90 @@ -4,7 +4,7 @@ CONTAINS !Note this module contains a real/complex version of spmvec SUBROUTINE spmvec_invs(& - atoms, mpdata, hybinp,& + atoms, mpdata, hybinp, hybdat,& ikpt, & coulomb_mt1, coulomb_mt2, coulomb_mt3,& coulomb_mtir, vecin,& @@ -16,6 +16,7 @@ CONTAINS USE m_juDFT IMPLICIT NONE TYPE(t_hybinp), INTENT(IN) :: hybinp + TYPE(t_hybdat), INTENT(IN) :: hybdat TYPE(t_mpdata), intent(in) :: mpdata TYPE(t_atoms), INTENT(IN) :: atoms @@ -114,7 +115,7 @@ CONTAINS indx3 = indx3 + atoms%neq(itype1)*ishift1 END DO - IF (indx3 /= hybinp%nbasp) call judft_error('spmvec: error counting index indx3') + IF (indx3 /= hybdat%nbasp) call judft_error('spmvec: error counting index indx3') vecout(indx1:indx2) = vecout(indx1:indx2) + coulomb_mt2(:mpdata%num_radbasfn(l, itype) - 1, 0, maxval(hybinp%lcutm1) + 1, iatom)*vecinhlp(indx3 + 1) @@ -159,7 +160,7 @@ CONTAINS iatom = iatom + 1 indx1 = indx0 + 1 indx2 = indx1 + mpdata%num_radbasfn(0, itype) - 2 - vecout(hybinp%nbasp + 1) = vecout(hybinp%nbasp + 1) + dot_product(coulomb_mt2(:mpdata%num_radbasfn(0, itype) - 1, 0, maxval(hybinp%lcutm1) + 1, iatom), vecinhlp(indx1:indx2)) + vecout(hybdat%nbasp + 1) = vecout(hybdat%nbasp + 1) + dot_product(coulomb_mt2(:mpdata%num_radbasfn(0, itype) - 1, 0, maxval(hybinp%lcutm1) + 1, iatom), vecinhlp(indx1:indx2)) indx0 = indx0 + ishift END DO @@ -192,7 +193,7 @@ CONTAINS indx0 = indx0 + ishift END DO END DO - IF (indx0 /= hybinp%nbasp) call judft_error('spmvec: error index counting (indx0)') + IF (indx0 /= hybdat%nbasp) call judft_error('spmvec: error index counting (indx0)') END IF CALL reorder(hybinp%nbasm(ikpt), atoms, hybinp%lcutm1, maxval(hybinp%lcutm1), & @@ -201,7 +202,7 @@ CONTAINS END SUBROUTINE spmvec_invs SUBROUTINE spmvec_noinvs(& - atoms, mpdata, hybinp,& + atoms, mpdata, hybinp, hybdat,& ikpt, & coulomb_mt1, coulomb_mt2, coulomb_mt3,& coulomb_mtir, vecin,& @@ -214,6 +215,7 @@ CONTAINS IMPLICIT NONE TYPE(t_mpdata), INTENT(IN) :: mpdata TYPE(t_hybinp), INTENT(IN) :: hybinp + TYPE(t_hybdat), INTENT(IN) :: hybdat TYPE(t_atoms), INTENT(IN) :: atoms ! - scalars - @@ -314,7 +316,7 @@ CONTAINS indx3 = indx3 + atoms%neq(itype1)*ishift1 END DO - IF (indx3 /= hybinp%nbasp) call judft_error('spmvec: error counting index indx3') + IF (indx3 /= hybdat%nbasp) call judft_error('spmvec: error counting index indx3') vecout(indx1:indx2) = vecout(indx1:indx2) + coulomb_mt2(:mpdata%num_radbasfn(l, itype) - 1, 0, maxval(hybinp%lcutm1) + 1, iatom)*vecinhlp(indx3 + 1) @@ -359,7 +361,7 @@ CONTAINS iatom = iatom + 1 indx1 = indx0 + 1 indx2 = indx1 + mpdata%num_radbasfn(0, itype) - 2 - vecout(hybinp%nbasp + 1) = vecout(hybinp%nbasp + 1) + dot_product(coulomb_mt2(:mpdata%num_radbasfn(0, itype) - 1, 0, maxval(hybinp%lcutm1) + 1, iatom), vecinhlp(indx1:indx2)) + vecout(hybdat%nbasp + 1) = vecout(hybdat%nbasp + 1) + dot_product(coulomb_mt2(:mpdata%num_radbasfn(0, itype) - 1, 0, maxval(hybinp%lcutm1) + 1, iatom), vecinhlp(indx1:indx2)) indx0 = indx0 + ishift END DO @@ -392,7 +394,7 @@ CONTAINS indx0 = indx0 + ishift END DO END DO - IF (indx0 /= hybinp%nbasp) call judft_error('spmvec: error index counting (indx0)') + IF (indx0 /= hybdat%nbasp) call judft_error('spmvec: error index counting (indx0)') END IF CALL reorder(hybinp%nbasm(ikpt), atoms, hybinp%lcutm1, maxval(hybinp%lcutm1), mpdata%num_radbasfn,& diff --git a/hybrid/trafo.F90 b/hybrid/trafo.F90 index 327e6b785cc8596c4f9c67232e01e7bb7ab7dbb6..de42ea4231ef8423f64eb57f39798903c90a0cee 100644 --- a/hybrid/trafo.F90 +++ b/hybrid/trafo.F90 @@ -535,7 +535,7 @@ CONTAINS SUBROUTINE bra_trafo2( & l_real, vecout_r, vecin_r, vecout_c, vecin_c, & dim, nobd, nbands, ikpt0, ikpt1, iop, sym, & - mpdata, hybinp, kpts, atoms, & + mpdata, hybinp, hybdat, kpts, atoms, & phase) ! ikpt0 :: parent of ikpt1 @@ -548,6 +548,7 @@ CONTAINS IMPLICIT NONE type(t_mpdata), intent(in) :: mpdata TYPE(t_hybinp), INTENT(IN) :: hybinp + TYPE(t_hybdat), INTENT(IN) :: hybdat TYPE(t_sym), INTENT(IN) :: sym TYPE(t_kpts), INTENT(IN) :: kpts TYPE(t_atoms), INTENT(IN) :: atoms @@ -598,7 +599,7 @@ CONTAINS vecin1 = vecin_r DO i = 1, nbands DO j = 1, nobd - CALL desymmetrize(vecin1(:hybinp%nbasp, j, i), hybinp%nbasp, 1, 1, & + CALL desymmetrize(vecin1(:hybdat%nbasp, j, i), hybdat%nbasp, 1, 1, & atoms, hybinp%lcutm1, maxval(hybinp%lcutm1), mpdata%num_radbasfn, sym) END DO END DO @@ -727,7 +728,7 @@ CONTAINS END IF cdum = exp(img*tpi_const*dot_product(kpts%bkf(:, ikpt1) + g1, trans(:))) - vecout1(hybinp%nbasp + igptm, :, :) = cdum*vecin1(hybinp%nbasp + igptm2, :, :) + vecout1(hybdat%nbasp + igptm, :, :) = cdum*vecin1(hybdat%nbasp + igptm2, :, :) END DO deallocate(vecin1) diff --git a/hybrid/wavefproducts.F90 b/hybrid/wavefproducts.F90 index d29755b3c9adef314fa973b9c1fb65690796172a..ad750f642b2bcdb61d03d47e1c4f7cbd13b01d19 100644 --- a/hybrid/wavefproducts.F90 +++ b/hybrid/wavefproducts.F90 @@ -42,7 +42,7 @@ CONTAINS ! - arrays - - COMPLEX, INTENT(OUT) :: cprod(hybinp%maxbasm1, mnobd, bandf - bandi + 1) + COMPLEX, INTENT(OUT) :: cprod(hybdat%maxbasm1, mnobd, bandf - bandi + 1) ! - local scalars - INTEGER :: ic, l, n, l1, l2, n1, n2, lm_0, lm1_0, lm2_0, lm, lm1, lm2, m1, m2, i, j, ll @@ -307,7 +307,7 @@ CONTAINS ! - arrays - INTEGER, INTENT(IN) :: parent(kpts%nkptf) - REAL, INTENT(OUT) :: cprod(hybinp%maxbasm1, mnobd, bandf - bandi + 1) + REAL, INTENT(OUT) :: cprod(hybdat%maxbasm1, mnobd, bandf - bandi + 1) ! - local scalars - INTEGER :: i, ikpt, ic, iband, iband1, igpt, igptp, ibando, iatom, iiatom, itype, ieq, ishift, ioffset, iatom1, iatom2 @@ -1237,7 +1237,7 @@ CONTAINS ! - arrays - INTEGER, INTENT(IN) :: parent(kpts%nkptf) - REAL, INTENT(OUT) :: cprod(hybinp%maxbasm1, bandoi:bandof, bandf - bandi + 1) + REAL, INTENT(OUT) :: cprod(hybdat%maxbasm1, bandoi:bandof, bandf - bandi + 1) ! - local scalars - INTEGER :: i, ikpt, ic, iband, iband1, igpt, igptp, ig, ig2, ig1 @@ -2257,7 +2257,7 @@ CONTAINS ! - arrays - - COMPLEX, INTENT(OUT) :: cprod(hybinp%maxbasm1, bandoi:bandof, bandf - bandi + 1) + COMPLEX, INTENT(OUT) :: cprod(hybdat%maxbasm1, bandoi:bandof, bandf - bandi + 1) ! - local scalars - INTEGER :: ic, l, n, l1, l2, n1, n2, lm_0, lm1_0, lm2_0, lm, lm1, lm2, m1, m2, i, j, ll diff --git a/hybrid/wavefproducts_inv.f90 b/hybrid/wavefproducts_inv.f90 index 66d7ebcd18f09e876f517212a224a445b957f467..b54fca8de3bb8a13f4726f443892e0c0f655ece8 100644 --- a/hybrid/wavefproducts_inv.f90 +++ b/hybrid/wavefproducts_inv.f90 @@ -38,7 +38,7 @@ CONTAINS INTEGER, INTENT(OUT) :: nkqpt ! - arrays - - REAL, INTENT(OUT) :: cprod(hybinp%maxbasm1, bandoi:bandof, bandf - bandi + 1) + REAL, INTENT(OUT) :: cprod(hybdat%maxbasm1, bandoi:bandof, bandf - bandi + 1) ! - local scalars - INTEGER :: g_t(3) @@ -92,7 +92,7 @@ CONTAINS INTEGER, INTENT(IN) :: nkqpt ! - arrays - - REAL, INTENT(OUT) :: cprod(hybinp%maxbasm1, bandoi:bandof, bandf - bandi + 1) + REAL, INTENT(OUT) :: cprod(hybdat%maxbasm1, bandoi:bandof, bandf - bandi + 1) ! - local scalars - INTEGER :: ic, ig, ig2, ig1, ok, igptm, iigptm @@ -208,7 +208,7 @@ CONTAINS INTEGER, INTENT(IN) :: nkqpt ! - arrays - - REAL, INTENT(INOUT) :: cprod(hybinp%maxbasm1, bandoi:bandof, bandf - bandi + 1) + REAL, INTENT(INOUT) :: cprod(hybdat%maxbasm1, bandoi:bandof, bandf - bandi + 1) ! - local scalars - INTEGER :: i, iband diff --git a/hybrid/wavefproducts_noinv.f90 b/hybrid/wavefproducts_noinv.f90 index d4dd2c84792ecdb1cc9b778b866b81dea273ad19..cf22b0229611c609762a373a724be3cee06a0e74 100644 --- a/hybrid/wavefproducts_noinv.f90 +++ b/hybrid/wavefproducts_noinv.f90 @@ -29,7 +29,7 @@ CONTAINS ! - arrays - - COMPLEX, INTENT(OUT) :: cprod(hybinp%maxbasm1, bandoi:bandof, bandf - bandi + 1) + COMPLEX, INTENT(OUT) :: cprod(hybdat%maxbasm1, bandoi:bandof, bandf - bandi + 1) INTEGER :: g_t(3) REAL :: kqpt(3), kqpthlp(3) @@ -86,7 +86,7 @@ CONTAINS ! - arrays - - COMPLEX, INTENT(OUT) :: cprod(hybinp%maxbasm1, bandoi:bandof, bandf - bandi + 1) + COMPLEX, INTENT(OUT) :: cprod(hybdat%maxbasm1, bandoi:bandof, bandf - bandi + 1) ! - local scalars - INTEGER :: ic, n1, n2 @@ -220,7 +220,7 @@ CONTAINS ! - arrays - - COMPLEX, INTENT(INOUT) :: cprod(hybinp%maxbasm1, bandoi:bandof, bandf - bandi + 1) + COMPLEX, INTENT(INOUT) :: cprod(hybdat%maxbasm1, bandoi:bandof, bandf - bandi + 1) ! - local scalars - INTEGER :: ic, l, n, l1, l2, n1, n2, lm_0, lm1_0, lm2_0 diff --git a/io/io_hybinp.F90 b/io/io_hybinp.F90 index 6259bb7443e3d1bcda0b1e3f9bb7bc57c67d75a2..95a1a4b398486d1e5c001c0c76b561c4c83a5c01 100644 --- a/io/io_hybinp.F90 +++ b/io/io_hybinp.F90 @@ -63,7 +63,7 @@ contains & recl=input%neig*hybdat%maxlmindx*atoms%nat*16) #ifdef CPP_NOSPMVEC - irecl_coulomb = hybinp%maxbasm1 * (hybinp%maxbasm1+1) * 8 / 2 + irecl_coulomb = hybdat%maxbasm1 * (hybdat%maxbasm1+1) * 8 / 2 if (.not.l_real) irecl_coulomb =irecl_coulomb *2 OPEN(unit=778,file='coulomb',form='unformatted',access='direct', recl=irecl_coulomb) id_coulomb=778 diff --git a/types/types_hybdat.f90 b/types/types_hybdat.f90 index b9688f5e6469aabf7d883abaac8ec5ebebf384c9..8f7199b574da87520ae3a5ed37c0e1fca50977b5 100644 --- a/types/types_hybdat.f90 +++ b/types/types_hybdat.f90 @@ -25,6 +25,9 @@ MODULE m_types_hybdat INTEGER, ALLOCATABLE :: nobd(:, :) INTEGER :: maxlmindx = -1 COMPLEX, ALLOCATABLE :: stepfunc(:,:,:) + INTEGER :: nbasp = -1 + INTEGER :: max_indx_p_1 = -1 + INTEGER :: maxbasm1 = -1 contains procedure :: set_stepfunction => set_stepfunction END TYPE t_hybdat diff --git a/types/types_mpdata.f90 b/types/types_mpdata.f90 index 784fe3baa0b8b0b656b1eadfc757340cd313ddb1..7fea50709271ae356762f4c940743849fa9ecdf5 100644 --- a/types/types_mpdata.f90 +++ b/types/types_mpdata.f90 @@ -497,19 +497,21 @@ contains end do end subroutine mpdata_normalize - subroutine mpdata_init(mpdata, hybinp, atoms) + subroutine mpdata_init(mpdata, hybinp, hybdat, atoms) use m_types_setup use m_types_hybinp + use m_types_hybdat use m_judft implicit none class(t_mpdata) :: mpdata type(t_hybinp), intent(in) :: hybinp + type(t_hybdat), intent(in) :: hybdat type(t_atoms), intent(in) :: atoms integer :: ok if(.not. allocated(mpdata%l1)) then - allocate(mpdata%l1(hybinp%max_indx_p_1, 0:maxval(hybinp%lcutm1), atoms%ntype), stat=ok) + allocate(mpdata%l1(hybdat%max_indx_p_1, 0:maxval(hybinp%lcutm1), atoms%ntype), stat=ok) if (ok /= 0) call judft_error('mpdata_init: failure allocation mpdata%l1') allocate(mpdata%l2, mold=mpdata%l1, stat=ok)