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