Commit 0dcdef6c authored by Alexander Neukirchen's avatar Alexander Neukirchen

Removed references to m_cotra that no longer exists.

parent 21cbdb54
......@@ -64,7 +64,6 @@
! ---> Interstitial part
DO j = 1,np
IF (.NOT.oneD%odi%d1) THEN
!CALL cotra1(p(:,j),rcc,cell%bmat)
rcc=MATMUL(cell%bmat,p(:,j))/tpi_const
CALL starf3(&
& sym%nop,stars%ng3,sym%symor,stars%kv3,sym%mrot,sym%tau,p(:,j),sym%invtab,&
......@@ -72,7 +71,6 @@
ENDIF
!
IF (oneD%odi%d1) THEN
!CALL cotra1(p(:,j),rcc,cell%bmat)
rcc=MATMUL(cell%bmat,p(:,j))/tpi_const
CALL starf3(&
& sym%nop,stars%ng3,sym%symor,stars%kv3,sym%mrot,sym%tau,rcc,sym%invtab,&
......@@ -111,12 +109,10 @@
!+odim
END IF
IF (oneD%odi%d1) THEN
!CALL cotra1(p(:,j),rcc,cell%bmat)
rcc=MATMUL(cell%bmat,p(:,j))/tpi_const
WRITE (6,FMT=8020) rcc,(p(i,j),i=1,3),v1(j),v2(j)
ELSE
!CALL cotra0(p(1,j),rcc,cell%amat)
rcc=MATMUL(cell%amat,p(:,j))
WRITE (6,FMT=8020) (p(i,j),i=1,3),rcc,v1(j),v2(j)
ENDIF
......@@ -127,7 +123,6 @@
ENDIF
! ----> interstitial part
DO j = 1,np
!CALL cotra1(p(1,j),rcc,cell%bmat)
rcc=MATMUL(cell%bmat,p(:,j))/tpi_const
CALL starf3(&
......@@ -159,7 +154,6 @@
ENDDO
! new
IF (nopa.NE.1) THEN
!CALL cotra1(x,rcc,cell%bmat) ! switch to internal units
rcc=MATMUL(cell%bmat,x)/tpi_const
DO i = 1,3 ! rotate into representative
......@@ -172,7 +166,6 @@
END IF
ENDDO
ENDDO
!CALL cotra0(ri,x,cell%amat) !switch back to cartesian units
x=MATMUL(cell%amat,ri)
END IF
......@@ -192,7 +185,6 @@
ENDDO
v2(j) = help * ir2
IF (j.LE.8) THEN
!CALL cotra1(p(1,j),rcc,cell%bmat)
rcc=MATMUL(cell%bmat,p(:,j))/tpi_const
WRITE (6,FMT=8020) rcc, (p(i,j),i=1,3),v1(j),v2(j)
......
......@@ -57,9 +57,7 @@
! ----> rotate n1 and n2 by symmetry element and form the cross-product
! of the rotated vectors (nn1,nn2) --> ssqa
!
! CALL cotra0(n1,nn1,rrot)
nn1=matmul(rrot,n1)
! CALL cotra0(n2,nn2,rrot)
nn2=matmul(rrot,n2)
CALL cross(nn1,nn2,
......
......@@ -49,7 +49,6 @@
! ----> rotate qss by symmetry element and form the dot-product
! with unrotated vector (q1 . qss)
!
! CALL cotra3(qss,q1,rrot)
q1=matmul(qss,rrot)
!
! ----> if qss is unchanged, accept this symmetry element
......
......@@ -40,7 +40,6 @@
ALLOCATE ( rsyp(3,nosyp),del(nosyp),d(nosyp),nk(nosyp) )
DO i = 1,nosyp
syp1(:) = syp(:,i)
!CALL cotra3(syp1,rsyp1,bmat)
rsyp1=matmul(syp1,bmat)
rsyp(:,i) = rsyp1(:)
ENDDO
......
......@@ -736,7 +736,6 @@
pt_rel(1) = REAL(i-1)/nx
DO j = 1, ny+1
pt_rel(2) = REAL(j-1)/ny
!CALL cotra0 (pt_rel, pt_abs, amat)
pt_abs=matmul(amat,pt_rel)
IF (E%dirichlet) THEN
WRITE (748, '(4f12.5,2g16.5)')&
......@@ -881,7 +880,6 @@
& * nstr2(k)/(3*k1d*3*k2d)
END IF
END DO ! k
!CALL cotra0 (pt_rel, pt_abs, amat)
pt_abs=matmul(amat,pt_rel)
WRITE (754,'(4f14.7,3g16.7,2i6)')&
& pt_abs(1:2),pt_rel(1:2),&
......
......@@ -333,7 +333,6 @@
!
! Transform intern coordinates to cartesian:
!
!CALL cotra0(atoms%taual(1,na),atoms%pos(1,na),cell%amat)
atoms%pos(:,na)=MATMUL(cell%amat,atoms%taual(:,na))
ENDDO ! l.o. equivalent atoms (n1)
ENDDO ! loop over atom-types (n)
......
......@@ -327,11 +327,9 @@
IF (abs(mat(1,1)).GT.0.0000001) THEN ! transform hex->trig
CALL recip(a1,a2,a3,rdummy)
DO n = 1, abs(natin)
! CALL cotra0(atompos(1,n),x,mat)
x = matmul(mat,atompos(:,n))
write(*,'(3f10.5)') x(1:3)
write(*,'(3f10.5)') rdummy
! CALL cotra1(x,atompos(1,n),rdummy)
atompos(:,n) = matmul(rdummy,x)
write(*,'(3f10.5)') atompos(1:3,n)
ENDDO
......
......@@ -89,7 +89,6 @@
na = 0
DO nn = 1, ntype
DO n = 1, neq(nn)
!CALL cotra0(pos(:,natmap(na+n)),posc,amat)
posc=matmul(amat,pos(:,natmap(na+n)))
! DO i = 1, 2
! IF (posc(i).LT.0) posc(i) = posc(i) + amat(i,i)
......
......@@ -561,7 +561,7 @@ c
+ ,calledby ="brzone")
WRITE (6,7200) ((cpoint(i,ip),i=1,3),ip=1,ncorn)
WRITE (ibfile,7200) ((cpoint(i,ip),i=1,3),ip=1,ncorn)
7200 FORMAT(//,' corner points in carthesian units ',
7200 FORMAT(//,' corner points in cartesian units ',
$ 99(/,3f10.5))
CLOSE (ibfile)
......
......@@ -13,9 +13,7 @@ CONTAINS
! this routine is called by: fleur.F90
!
! optional --+-- plot -+- loddop
! | +- outcdn -+- cotra0
! | +- cotra1
! | +- starf2 -- spgrot
! | +- outcdn -+- starf2 -- spgrot
! | +- starf3
! | +- ylm3
! +-- stden -+- atom2 -+- setcor
......@@ -40,10 +38,8 @@ CONTAINS
! | +- points -- qranf
! | +- sphpts -- qranf
! | +- checkdop -+- starf3
! | +- cotra0
! | +- starf2 -- spgrot
! | +- fitchk
! | +- cotra1
! | +- ylm3
! +-- cdnsp -+- readDensity
! | +- writeDensity
......
......@@ -16,7 +16,7 @@ CONTAINS
USE m_ylm
!--------------------------------------------------------------------------
! Calculates the charge density at given point p(i=1,3).
! Calculates the charge density at a given point p(i=1,3).
!--------------------------------------------------------------------------
IMPLICIT NONE
......@@ -56,7 +56,6 @@ CONTAINS
IF (iflag.NE.1) THEN
IF (iflag.NE.0) THEN
! Interstitial part:
!CALL cotra1(p(1),rcc,cell%bmat)
rcc=matmul(cell%bmat,p)/tpi_const
CALL starf3(sym%nop, stars%ng3, sym%symor, stars%kv3, sym%mrot, &
sym%tau, rcc, sym%invtab, sf3)
......@@ -107,7 +106,6 @@ CONTAINS
END IF
p(3) = abs(p(3))
END IF
!CALL cotra1(p,rcc,cell%bmat)
rcc=matmul(cell%bmat,p)/tpi_const
CALL starf2(sym%nop2, stars%ng2, stars%kv3, sym%mrot, sym%symor, &
sym%tau,rcc,sym%invtab,sf2)
......@@ -152,7 +150,6 @@ CONTAINS
sx = sqrt(sx)
IF (nopa.NE.1) THEN
! Switch to internal units.
!CALL cotra1(x,rcc,cell%bmat)
rcc=matmul(cell%bmat,x)/tpi_const
! Rotate into representative.
DO i = 1,3
......@@ -166,7 +163,6 @@ CONTAINS
END DO
END DO
! Switch back to cartesian units.
!CALL cotra0(p,x,cell%amat)
x=matmul(cell%amat,p)
END IF
DO j = atoms%jri(n),2,-1
......
......@@ -231,7 +231,6 @@ c ----> construct a and b coefficients
ENDDO
ENDDO
fkp=MATMUL(fkr,bmat)
! CALL cotra3(fkr,fkp,bmat)
c ----> generate spherical harmonics
CALL ylm4(
> lmax(n),fkp,
......
......@@ -207,12 +207,10 @@ c***************************************c
! yl1(lm) for b1 and yl2(lm) for b2
yl1 = cmplx(0.,0.)
bkrot=MATMUL(bpt,bmat)
! call cotra3(bpt,bkrot,bmat)
call ylm4(lwn,bkrot,yl1)
yl2 = cmplx(0.,0.)
bkrot=MATMUL(bpt2,bmat)
! call cotra3(bpt2,bkrot,bmat)
call ylm4(lwn,bkrot,yl2)
call cpu_time(t0)
t33 = t33 + t0-t1
......
......@@ -219,12 +219,10 @@ c***************************************c
! yl1(lm) for b1 and yl2(lm) for b2
yl1 = cmplx(0.,0.)
bkrot=MATMUL(bpt,bmat)
! call cotra3(bpt,bkrot,bmat)
call ylm4(lwn,bkrot,yl1)
yl2 = cmplx(0.,0.)
bkrot=MATMUL(bpt2,bmat)
! call cotra3(bpt2,bkrot,bmat)
call ylm4(lwn,bkrot,yl2)
call cpu_time(t0)
......
......@@ -234,12 +234,10 @@ c endif
! yl1(lm) for b1 and yl2(lm) for b2
yl1 = cmplx(0.,0.)
bkrot=MATMUL(bpt,bmat)
! call cotra3(bpt,bkrot,bmat)
call ylm4(lwn,bkrot,yl1)
yl2 = cmplx(0.,0.)
bkrot=MATMUL(bpt2,bmat)
! call cotra3(bpt2,bkrot,bmat)
if(ANY(bkrot.ne.0.0)) stop 'dmi but bkrot.ne.0'
call ylm4(lwn,bkrot,yl2)
!if(indexx.eq.1 .and. irank.eq.0) write(*,*)'yl2',yl2(1)
......
......@@ -34,7 +34,6 @@ c***********************************************************************
use m_ylm
use m_intgr, only : intgr3
use m_gaunt, only: gaunt1
use m_cotra
implicit none
......
......@@ -190,7 +190,6 @@ c ++++++++++++++++++++++++++++++++++++++++++++++++
! transform wfs to global frame
DO iintsp=1,2
pt = matmul(bmat,rcc2)/tpi_const
! CALL cotra1(pt(1),rcc2,bmat)
arg = -pi*real(2*iintsp-3)*( qss(1,iqpt)*rcc2(1)
> +qss(2,iqpt)*rcc2(2)
> +qss(3,iqpt)*rcc2(3))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment