Commit 7575ecc8 by Matthias Redies

replace all dotprod with fortran standart

parent 902059a1
 ... ... @@ -1637,7 +1637,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(:hybrid%nbasp))**2) + dotprod ( coeff(hybrid%nbasp+1:), MATMUL(olap,coeff(hybrid%nbasp+1:)) ) ) ) !constfunc = coeff / SQRT ( ( SUM(ABS(coeff(:hybrid%nbasp))**2) + dot_product ( coeff(hybrid%nbasp+1:), MATMUL(olap,coeff(hybrid%nbasp+1:)) ) ) ) END SUBROUTINE subtract_sphaverage ... ...
 ... ... @@ -290,13 +290,13 @@ CONTAINS DO n2 = 1, nsest(n1)!n1 nn2 = indx_sest(n2, n1) exch_vv(nn2, n1) = exch_vv(nn2, n1) + cdum*phase_vv(iband, nn2)* & dotprod(carr1_v_r(:n), cprod_vv_r(:n, iband, nn2)) dot_product(carr1_v_r(:n), cprod_vv_r(:n, iband, nn2)) END DO !n2 ELSE DO n2 = 1, nsest(n1)!n1 nn2 = indx_sest(n2, n1) exch_vv(nn2, n1) = exch_vv(nn2, n1) + cdum*phase_vv(iband, nn2)* & dotprod(carr1_v_c(:n), cprod_vv_c(:n, iband, nn2)) dot_product(carr1_v_c(:n), cprod_vv_c(:n, iband, nn2)) END DO !n2 END IF END DO ... ...
 ... ... @@ -1933,13 +1933,13 @@ CONTAINS if (l_real) THEN cprod_fourier_trafo_r(igpt, iobd0, iband1) = & ! muffin tin contribution dotprod(fourier_trafo(:nbasp, igpt), cprod_r(:nbasp, iobd0, iband1)) & dot_product(fourier_trafo(:nbasp, igpt), cprod_r(:nbasp, iobd0, iband1)) & ! interstitial contribution (interstitial is kronecker_G,G') + cprod_r(nbasp + igpt, iobd0, iband1) else cprod_fourier_trafo_c(igpt, iobd0, iband1) = & ! muffin tin contribution dotprod(cprod_c(:nbasp, iobd0, iband1), fourier_trafo(:nbasp, igpt)) & dot_product(cprod_c(:nbasp, iobd0, iband1), fourier_trafo(:nbasp, igpt)) & ! interstitial contribution (interstitial is kronecker_G,G') + CONJG(cprod_c(nbasp + igpt, iobd0, iband1)) endif ... ...
 ... ... @@ -966,9 +966,9 @@ MODULE m_kp_perturbation END DO ! multiply with right vector DO iband2 = bandi2, bandf2 momentum(iband2, iband1, 1) = momentum(iband2, iband1, 1) + dotprod(cvec1(:nn), cmt2(:nn, iband2)) momentum(iband2, iband1, 2) = momentum(iband2, iband1, 2) + dotprod(cvec2(:nn), cmt2(:nn, iband2)) momentum(iband2, iband1, 3) = momentum(iband2, iband1, 3) + dotprod(cvec3(:nn), cmt2(:nn, iband2)) momentum(iband2, iband1, 1) = momentum(iband2, iband1, 1) + dot_product(cvec1(:nn), cmt2(:nn, iband2)) momentum(iband2, iband1, 2) = momentum(iband2, iband1, 2) + dot_product(cvec2(:nn), cmt2(:nn, iband2)) momentum(iband2, iband1, 3) = momentum(iband2, iband1, 3) + dot_product(cvec3(:nn), cmt2(:nn, iband2)) END DO ! iband2 END DO ! iband1 ... ... @@ -1002,9 +1002,9 @@ MODULE m_kp_perturbation vec2_r = matvec(olap_r, z%data_r(:lapw%nv(jsp), iband2)*qg(:, 2)) vec3_r = matvec(olap_r, z%data_r(:lapw%nv(jsp), iband2)*qg(:, 3)) DO iband1 = bandi1, bandf1 momentum(iband2, iband1, 1) = momentum(iband2, iband1, 1) + dotprod(z%data_r(:lapw%nv(jsp), iband1), vec1_r) momentum(iband2, iband1, 2) = momentum(iband2, iband1, 2) + dotprod(z%data_r(:lapw%nv(jsp), iband1), vec2_r) momentum(iband2, iband1, 3) = momentum(iband2, iband1, 3) + dotprod(z%data_r(:lapw%nv(jsp), iband1), vec3_r) momentum(iband2, iband1, 1) = momentum(iband2, iband1, 1) + dot_product(z%data_r(:lapw%nv(jsp), iband1), vec1_r) momentum(iband2, iband1, 2) = momentum(iband2, iband1, 2) + dot_product(z%data_r(:lapw%nv(jsp), iband1), vec2_r) momentum(iband2, iband1, 3) = momentum(iband2, iband1, 3) + dot_product(z%data_r(:lapw%nv(jsp), iband1), vec3_r) END DO END DO else ... ... @@ -1013,9 +1013,9 @@ MODULE m_kp_perturbation vec2_c = matvec(olap_c, z%data_c(:lapw%nv(jsp), iband2)*qg(:, 2)) vec3_c = matvec(olap_c, z%data_c(:lapw%nv(jsp), iband2)*qg(:, 3)) DO iband1 = bandi1, bandf1 momentum(iband2, iband1, 1) = momentum(iband2, iband1, 1) + dotprod(z%data_c(:lapw%nv(jsp), iband1), vec1_c) momentum(iband2, iband1, 2) = momentum(iband2, iband1, 2) + dotprod(z%data_c(:lapw%nv(jsp), iband1), vec2_c) momentum(iband2, iband1, 3) = momentum(iband2, iband1, 3) + dotprod(z%data_c(:lapw%nv(jsp), iband1), vec3_c) momentum(iband2, iband1, 1) = momentum(iband2, iband1, 1) + dot_product(z%data_c(:lapw%nv(jsp), iband1), vec1_c) momentum(iband2, iband1, 2) = momentum(iband2, iband1, 2) + dot_product(z%data_c(:lapw%nv(jsp), iband1), vec2_c) momentum(iband2, iband1, 3) = momentum(iband2, iband1, 3) + dot_product(z%data_c(:lapw%nv(jsp), iband1), vec3_c) END DO END DO end if ... ...
 ... ... @@ -245,8 +245,8 @@ CONTAINS ! CALL dgemv('N',ngpt1,ngpt2,1.0,olappw,ngpt1,real(cpw2),1,0.0,rarr1,1) ! CALL dgemv('N',ngpt1,ngpt2,1.0,olappw,ngpt1,aimag(cpw2),1,0.0,rarr2,1) ! ! rdum1 = dotprod(cpw1,rarr1) ! rdum2 = dotprod(cpw1,rarr2) ! rdum1 = dot_product(cpw1,rarr1) ! rdum2 = dot_product(cpw1,rarr2) ! cdum = cmplx( rdum1, rdum2 ) ! wfolap = wfolap + cdum ... ... @@ -299,8 +299,8 @@ CONTAINS ! CALL dgemv('N',ngpt1,ngpt2,1.0,olappw,ngpt1,real(cpw2),1,0.0,rarr1,1) ! CALL dgemv('N',ngpt1,ngpt2,1.0,olappw,ngpt1,aimag(cpw2),1,0.0,rarr2,1) ! ! rdum1 = dotprod(cpw1,rarr1) ! rdum2 = dotprod(cpw1,rarr2) ! rdum1 = dot_product(cpw1,rarr1) ! rdum2 = dot_product(cpw1,rarr2) ! cdum = cmplx( rdum1, rdum2 ) ! wfolap = wfolap + cdum ... ...
 ... ... @@ -148,7 +148,7 @@ MODULE m_spmvec indx2 = indx2 + 1 indx3 = indx3 + n - 1 vecout(indx1) = vecout(indx1) + dotprod(coulomb_mt2(:n - 1, m, l, iatom), vecinhlp(indx2:indx3)) vecout(indx1) = vecout(indx1) + dot_product(coulomb_mt2(:n - 1, m, l, iatom), vecinhlp(indx2:indx3)) indx2 = indx3 END DO ... ... @@ -165,7 +165,7 @@ MODULE m_spmvec iatom = iatom + 1 indx1 = indx0 + 1 indx2 = indx1 + hybrid%nindxm1(0, itype) - 2 vecout(hybrid%nbasp + 1) = vecout(hybrid%nbasp + 1) + dotprod(coulomb_mt2(:hybrid%nindxm1(0, itype) - 1, 0, hybrid%maxlcutm1 + 1, iatom), vecinhlp(indx1:indx2)) vecout(hybrid%nbasp + 1) = vecout(hybrid%nbasp + 1) + dot_product(coulomb_mt2(:hybrid%nindxm1(0, itype) - 1, 0, hybrid%maxlcutm1 + 1, iatom), vecinhlp(indx1:indx2)) indx0 = indx0 + ishift END DO ... ... @@ -190,7 +190,7 @@ MODULE m_spmvec indx3 = indx2 + (ieq1 - 1)*ishift1 + 1 indx4 = indx3 + hybrid%nindxm1(0, itype1) - 2 vecout(indx1) = vecout(indx1) + dotprod(coulomb_mt3(:hybrid%nindxm1(0, itype1) - 1, iatom, iatom1), vecinhlp(indx3:indx4)) vecout(indx1) = vecout(indx1) + dot_product(coulomb_mt3(:hybrid%nindxm1(0, itype1) - 1, iatom, iatom1), vecinhlp(indx3:indx4)) END DO indx2 = indx2 + atoms%neq(itype1)*ishift1 ... ... @@ -356,7 +356,7 @@ MODULE m_spmvec indx2 = indx2 + 1 indx3 = indx3 + n - 1 vecout(indx1) = vecout(indx1) + dotprod(coulomb_mt2(:n - 1, m, l, iatom), vecinhlp(indx2:indx3)) vecout(indx1) = vecout(indx1) + dot_product(coulomb_mt2(:n - 1, m, l, iatom), vecinhlp(indx2:indx3)) indx2 = indx3 END DO ... ... @@ -373,7 +373,7 @@ MODULE m_spmvec iatom = iatom + 1 indx1 = indx0 + 1 indx2 = indx1 + hybrid%nindxm1(0, itype) - 2 vecout(hybrid%nbasp + 1) = vecout(hybrid%nbasp + 1) + dotprod(coulomb_mt2(:hybrid%nindxm1(0, itype) - 1, 0, hybrid%maxlcutm1 + 1, iatom), vecinhlp(indx1:indx2)) vecout(hybrid%nbasp + 1) = vecout(hybrid%nbasp + 1) + dot_product(coulomb_mt2(:hybrid%nindxm1(0, itype) - 1, 0, hybrid%maxlcutm1 + 1, iatom), vecinhlp(indx1:indx2)) indx0 = indx0 + ishift END DO ... ... @@ -398,7 +398,7 @@ MODULE m_spmvec indx3 = indx2 + (ieq1 - 1)*ishift1 + 1 indx4 = indx3 + hybrid%nindxm1(0, itype1) - 2 vecout(indx1) = vecout(indx1) + dotprod(coulomb_mt3(:hybrid%nindxm1(0, itype1) - 1, iatom, iatom1), vecinhlp(indx3:indx4)) vecout(indx1) = vecout(indx1) + dot_product(coulomb_mt3(:hybrid%nindxm1(0, itype1) - 1, iatom, iatom1), vecinhlp(indx3:indx4)) END DO indx2 = indx2 + atoms%neq(itype1)*ishift1 ... ...
 ... ... @@ -253,7 +253,7 @@ CONTAINS DO i = 1, j ic = ic + 1 vxc(ic) = vxc(ic) + carr1(i, j) ! vxc(ic) = vxc(ic) + conjg(dotprod ( bascof(i,:nnbas,iatom),carr(:nnbas) )) ! vxc(ic) = vxc(ic) + conjg(dot_product ( bascof(i,:nnbas,iatom),carr(:nnbas) )) END DO END DO END DO ... ...
 ... ... @@ -91,7 +91,7 @@ CONTAINS iatom1 = hybrid%map(iatom, iop) tau1 = hybrid%tvec(:, iatom, iop) cdum = exp(tpiimg*dotprod(rkpt, tau1)) cdum = exp(tpiimg*dot_product(rkpt, tau1)) lm0 = 0 DO l = 0, atoms%lmax(itype) ... ... @@ -136,7 +136,7 @@ CONTAINS IF (igpt1 == 0) THEN STOP 'wavetrafo_symm: rotated G vector not found' END IF cdum = exp(tpiimg*dotprod(rkpt + lapw%gvec(:, igpt, jsp), trans(:))) cdum = exp(tpiimg*dot_product(rkpt + lapw%gvec(:, igpt, jsp), trans(:))) if (l_real) THEN z_out(igpt, 1:ndb) = cdum*z_r(igpt1, bandi:bandi + ndb - 1) else ... ... @@ -238,7 +238,7 @@ CONTAINS iatom1 = hybrid%map(iatom, iop) tau1 = hybrid%tvec(:, iatom, iop) cdum = exp(tpiimg*dotprod(rkpt, tau1)) cdum = exp(tpiimg*dot_product(rkpt, tau1)) lm0 = 0 DO l = 0, atoms%lmax(itype) ... ... @@ -282,7 +282,7 @@ CONTAINS END IF END DO IF (igpt1 == 0) CYCLE cdum = exp(tpiimg*dotprod(rkpt + (/lapw_rkpt%k1(igpt, jsp), lapw_rkpt%k2(igpt, jsp), lapw_rkpt%k3(igpt, jsp)/), trans)) cdum = exp(tpiimg*dot_product(rkpt + (/lapw_rkpt%k1(igpt, jsp), lapw_rkpt%k2(igpt, jsp), lapw_rkpt%k3(igpt, jsp)/), trans)) if (l_real) THEN zhlp(igpt, :nbands) = cdum*z_r(igpt1, :nbands) else ... ...
 ... ... @@ -389,7 +389,7 @@ CONTAINS lm1 = lm + (iatom1 - 1 - iiatom)*ioffset lm2 = lm + (iatom2 - 1 - iiatom)*ioffset + ishift rdum = tpi_const*dotprod(kpts%bkf(:, iq), atoms%taual(:, iatom1)) rdum = tpi_const*dot_product(kpts%bkf(:, iq), atoms%taual(:, iatom1)) rfac1 = sin(rdum)/sr2 rfac2 = cos(rdum)/sr2 DO iband = bandi, bandf ... ...
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!