Commit a7ce652d authored by Gustav Bihlmayer's avatar Gustav Bihlmayer

Corrected the treatment of centered monoclinic lattices in lattice2.f.

To transform the atom positions in atom_sym.f into the centered basis,
a variable (i_c) is passed through to indicate the type of centering.
parent 2b763377
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
> dispfh,outfh,errfh,dispfn,natmax, > dispfh,outfh,errfh,dispfn,natmax,
X natin,atomid,atompos, X natin,atomid,atompos,
X ngen,mmrot,ttr, X ngen,mmrot,ttr,
> cartesian,symor,as,bs,nop48, > cartesian,i_c,symor,as,bs,nop48,
< ntype,nat,nops,mrot,tau, < ntype,nat,nops,mrot,tau,
< neq,ntyrep,zatom,natype,natrep,natmap,pos) < neq,ntyrep,zatom,natype,natrep,natmap,pos)
...@@ -53,6 +53,7 @@ ...@@ -53,6 +53,7 @@
LOGICAL, INTENT (IN) :: symor ! whether to reduce to symmorphic subgroup LOGICAL, INTENT (IN) :: symor ! whether to reduce to symmorphic subgroup
INTEGER, INTENT (INOUT) :: natin ! formerly 'ntype0' INTEGER, INTENT (INOUT) :: natin ! formerly 'ntype0'
INTEGER, INTENT (IN) :: ngen ! Number of generators INTEGER, INTENT (IN) :: ngen ! Number of generators
INTEGER, INTENT (IN) :: i_c ! centering of lattice
INTEGER, INTENT (IN) :: nop48, natmax ! dimensioning INTEGER, INTENT (IN) :: nop48, natmax ! dimensioning
INTEGER, INTENT (INOUT) :: mmrot(3,3,nop48) INTEGER, INTENT (INOUT) :: mmrot(3,3,nop48)
REAL, INTENT (INOUT) :: ttr(3,nop48) REAL, INTENT (INOUT) :: ttr(3,nop48)
...@@ -76,7 +77,7 @@ ...@@ -76,7 +77,7 @@
REAL tr(3),tt(3),disp(3,natmax) REAL tr(3),tt(3),disp(3,natmax)
INTEGER mp(3,3),mtmp(3,3) INTEGER mp(3,3),mtmp(3,3)
REAL ttau(3),orth(3,3) REAL ttau(3),orth(3,3),tc(3,3),td(3,3)
INTEGER mmrot2(3,3,ngen) INTEGER mmrot2(3,3,ngen)
REAL ttr2(3,ngen) REAL ttr2(3,ngen)
...@@ -84,20 +85,49 @@ ...@@ -84,20 +85,49 @@
LOGICAL l_exist,lclose,l_inipos LOGICAL l_exist,lclose,l_inipos
INTEGER n,na,ng,ncyl,nc,no,nop0,nn,nt,i,j,mops INTEGER n,na,ng,ncyl,nc,no,nop0,nn,nt,i,j,mops
INTEGER ios,istep0 INTEGER ios,istep0
REAL eps7
CHARACTER(len=30) :: filen CHARACTER(len=30) :: filen
REAL, ALLOCATABLE :: inipos(:,:) REAL, ALLOCATABLE :: inipos(:,:)
eps7= 1.0e-7 ; istep0 = 0 REAL, PARAMETER :: eps = 1.0e-7, isqrt3 = 1.0/sqrt(3.0),
& thrd = 1.0/3.0, mtthrd = -2.0/3.0
REAL :: lmat(3,3,8)
DATA lmat / 1.0, 0.0, 0.0, ! 1: primitive : P
& 0.0, 1.0, 0.0,
& 0.0, 0.0, 1.0,
+ -1.0, 1.0, 1.0, ! 2: Inverse (F)
& 1.0, -1.0, 1.0,
& 1.0, 1.0, -1.0,
+ 0.0, 1.0, 1.0, ! 3: Inverse (I)
& 1.0, 0.0, 1.0,
& 1.0, 1.0, 0.0,
+ 1.0, 1.0, 0.0, ! 4: Inverse (hP)
& -isqrt3, isqrt3, 0.0,
& 0.0, 0.0, 1.0,
+ 0.0, isqrt3, -isqrt3, ! 5: Inverse (hR)
& mtthrd, thrd, thrd,
& thrd, thrd, thrd,
+ 1.0, 1.0, 0.0, ! 6: Inverse ( S (C) )
& -1.0, 1.0, 0.0,
& 0.0, 0.0, 1.0,
+ 1.0, 0.0, 1.0, ! 7: Inverse (B)
& 0.0, 1.0, 0.0,
& -1.0, 0.0, 1.0,
+ 1.0, 0.0, 0.0, ! 8: Inverse (A)
& 0.0, 1.0, -1.0,
& 0.0, 1.0, 1.0/
istep0 = 0
! !
!---> take atomic positions and shift to (-1/2,1/2] in lattice coords. !---> take atomic positions and shift to (-1/2,1/2] in lattice coords.
! !
natin = abs(natin) natin = abs(natin)
DO n=1,natin DO n=1,natin
IF (cartesian) THEN ! convert to lattice coords. if necessary IF (cartesian) THEN ! convert to lattice coords. if necessary
atompos(:,n) = matmul( bs, atompos(:,n) ) ! atompos(:,n) = matmul( bs, atompos(:,n) )
atompos(:,n) = matmul( lmat(:,:,i_c), atompos(:,n) )
ENDIF ENDIF
atompos(:,n) = atompos(:,n) - anint( atompos(:,n) - eps7 ) atompos(:,n) = atompos(:,n) - anint( atompos(:,n) - eps )
ENDDO ENDDO
!---> store the positions (in lattice coord.s) given in the input file !---> store the positions (in lattice coord.s) given in the input file
...@@ -124,7 +154,7 @@ ...@@ -124,7 +154,7 @@
tr = matmul( bs, tr ) tr = matmul( bs, tr )
ENDIF ENDIF
atompos(:,n) = atompos(:,n) + tr(:) atompos(:,n) = atompos(:,n) + tr(:)
atompos(:,n) = atompos(:,n) - anint( atompos(:,n)- eps7 ) atompos(:,n) = atompos(:,n) - anint( atompos(:,n)- eps )
ENDDO ENDDO
CLOSE (dispfh) CLOSE (dispfh)
IF ( ios==0 ) THEN IF ( ios==0 ) THEN
...@@ -142,10 +172,16 @@ ...@@ -142,10 +172,16 @@
!---> save generators !---> save generators
IF (cartesian) THEN ! convert to lattice coords. if necessary IF (cartesian) THEN ! convert to lattice coords. if necessary
DO ng = 2, ngen+1 DO ng = 2, ngen+1
mmrot2(:,:,1) = matmul( bs, mmrot(:,:,ng) ) ! mmrot2(:,:,1) = matmul( bs, mmrot(:,:,ng) )
mmrot(:,:,ng) = matmul( mmrot2(:,:,1), as ) ! mmrot(:,:,ng) = matmul( mmrot2(:,:,1), as )
ttr2(:,1) = matmul( bs, ttr(:,ng) ) tc = mmrot(:,:,ng)
td = matmul( bs, tc )
tc = matmul( td, as )
mmrot(:,:,ng) = NINT(tc)
write(*,*) i_c, ttr(:,ng)
ttr2(:,1) = matmul( lmat(:,:,i_c), ttr(:,ng) )
ttr(:,ng) = ttr2(:,1) ttr(:,ng) = ttr2(:,1)
write(*,*) mmrot(:,:,ng),ttr(:,ng)
ENDDO ENDDO
ENDIF ENDIF
mmrot2(:,:,1:ngen) = mmrot(:,:,2:ngen+1) mmrot2(:,:,1:ngen) = mmrot(:,:,2:ngen+1)
...@@ -214,7 +250,7 @@ ...@@ -214,7 +250,7 @@
ENDIF ENDIF
!---> rewrite all the non-primitive translations so in (-1/2,1/2] !---> rewrite all the non-primitive translations so in (-1/2,1/2]
ttr(:,1:nops) = ttr(:,1:nops) - anint( ttr(:,1:nops)- eps7 ) ttr(:,1:nops) = ttr(:,1:nops) - anint( ttr(:,1:nops)- eps )
!---> allocate arrays for space group information (mod_spgsym) !---> allocate arrays for space group information (mod_spgsym)
! if( nopd < nops )then ! if( nopd < nops )then
...@@ -226,6 +262,7 @@ ...@@ -226,6 +262,7 @@
mrot(:,:,n) = mmrot(:,:,n) mrot(:,:,n) = mmrot(:,:,n)
tau(:,n) = ttr(:,n) tau(:,n) = ttr(:,n)
index_op(n) = n index_op(n) = n
write(*,*) n,mrot(:,:,n),tau(:,n)
ENDDO ENDDO
!---> check that the group is closed, etc. !---> check that the group is closed, etc.
...@@ -245,7 +282,7 @@ ...@@ -245,7 +282,7 @@
!---> reduce symmetry to the largest symmorphic subgroup !---> reduce symmetry to the largest symmorphic subgroup
j = 1 j = 1
DO i = 1, nops DO i = 1, nops
IF ( all ( abs( tau(:,i) ) < eps7 ) ) THEN IF ( all ( abs( tau(:,i) ) < eps ) ) THEN
IF ( j<i ) then IF ( j<i ) then
mrot(:,:,j) = mrot(:,:,i) mrot(:,:,j) = mrot(:,:,i)
ENDIF ENDIF
...@@ -276,10 +313,10 @@ ...@@ -276,10 +313,10 @@
DO n = 1, nat DO n = 1, nat
tt = ( atompos(:,nt) - tpos(:,n) ) tt = ( atompos(:,nt) - tpos(:,n) )
& - anint( atompos(:,nt) - tpos(:,n) ) & - anint( atompos(:,nt) - tpos(:,n) )
IF ( all( abs(tt) < eps7 ) ) THEN IF ( all( abs(tt) < eps ) ) THEN
icount(n) = icount(n) + 1 icount(n) = icount(n) + 1
imap(nt) = n imap(nt) = n
IF ( abs( atomid(nt)-atomid(ity(n)) ) < eps7 ) IF ( abs( atomid(nt)-atomid(ity(n)) ) < eps )
& CYCLE repres_atoms & CYCLE repres_atoms
CALL juDFT_error("ERROR! mismatch between atoms." CALL juDFT_error("ERROR! mismatch between atoms."
+ ,calledby ="atom_sym") + ,calledby ="atom_sym")
...@@ -297,14 +334,14 @@ ...@@ -297,14 +334,14 @@
!---> loop over operations !---> loop over operations
opts: DO no = 2, nops opts: DO no = 2, nops
tr = matmul( mrot(:,:,no) , atompos(:,nt) ) + tau(:,no) tr = matmul( mrot(:,:,no) , atompos(:,nt) ) + tau(:,no)
tr = tr - anint( tr - eps7 ) tr = tr - anint( tr - eps )
!---> check whether this is a new atom !---> check whether this is a new atom
DO n = 1, nneq(ntype) DO n = 1, nneq(ntype)
tt = ( tr-tpos(:,nat+n) ) - anint( tr-tpos(:,nat+n) ) tt = ( tr-tpos(:,nat+n) ) - anint( tr-tpos(:,nat+n) )
IF ( all( abs(tt) < eps7 ) ) THEN IF ( all( abs(tt) < eps ) ) THEN
nn = ity(nat+n) nn = ity(nat+n)
IF ( abs( atomid(nt)-atomid(nn) ) < eps7 ) CYCLE opts IF ( abs( atomid(nt)-atomid(nn) ) < eps ) CYCLE opts
WRITE (6,'(" Mismatch between atoms and", WRITE (6,'(" Mismatch between atoms and",
& " symmetry input")') & " symmetry input")')
CALL juDFT_error("atom_sym: mismatch rotated",calledby CALL juDFT_error("atom_sym: mismatch rotated",calledby
......
...@@ -8,7 +8,7 @@ ...@@ -8,7 +8,7 @@
> dbgfh,errfh,outfh,dispfh,dispfn, > dbgfh,errfh,outfh,dispfh,dispfn,
> cal_symm,cartesian,symor,oldfleur, > cal_symm,cartesian,symor,oldfleur,
> natin,natmax,nop48, > natin,natmax,nop48,
> atomid,atompos,a1,a2,a3,aa,scale,noangles, > atomid,atompos,a1,a2,a3,aa,scale,noangles,i_c,
< invs,zrfs,invs2,nop,nop2, < invs,zrfs,invs2,nop,nop2,
< ngen,mmrot,ttr,ntype,nat,nops, < ngen,mmrot,ttr,ntype,nat,nops,
< neq,ntyrep,zatom,natype,natrep,natmap, < neq,ntyrep,zatom,natype,natrep,natmap,
...@@ -26,7 +26,7 @@ ...@@ -26,7 +26,7 @@
!===> Arguments !===> Arguments
LOGICAL, INTENT(IN) :: cal_symm,cartesian,oldfleur,noangles LOGICAL, INTENT(IN) :: cal_symm,cartesian,oldfleur,noangles
INTEGER, INTENT(IN) :: ngen,natmax,nop48 INTEGER, INTENT(IN) :: ngen,natmax,nop48,i_c
INTEGER, INTENT(IN) :: dbgfh,errfh,outfh,dispfh ! file handles, mainly 6 INTEGER, INTENT(IN) :: dbgfh,errfh,outfh,dispfh ! file handles, mainly 6
REAL, INTENT(IN) :: aa REAL, INTENT(IN) :: aa
LOGICAL, INTENT(INOUT) :: symor ! on input: if true, reduce symmetry if oldfleur LOGICAL, INTENT(INOUT) :: symor ! on input: if true, reduce symmetry if oldfleur
...@@ -154,7 +154,7 @@ ...@@ -154,7 +154,7 @@
> dispfh,outfh,errfh,dispfn,natmax, > dispfh,outfh,errfh,dispfn,natmax,
X natin,atomid,atompos, X natin,atomid,atompos,
X ngen,mmrot,ttr, X ngen,mmrot,ttr,
> cartesian,symor,as,bs,nop48, > cartesian,i_c,symor,as,bs,nop48,
< ntype,nat,nops,mrot,tau, < ntype,nat,nops,mrot,tau,
< neq,ntyrep,zatom,natype,natrep,natmap,pos) < neq,ntyrep,zatom,natype,natrep,natmap,pos)
......
...@@ -20,7 +20,7 @@ PROGRAM inpgen ...@@ -20,7 +20,7 @@ PROGRAM inpgen
IMPLICIT NONE IMPLICIT NONE
INTEGER natmax,nop48,nline,natin,ngen,i,j INTEGER natmax,nop48,nline,natin,ngen,i,j
INTEGER nops,no3,no2,na,numSpecies INTEGER nops,no3,no2,na,numSpecies,i_c
INTEGER infh,errfh,bfh,warnfh,symfh,dbgfh,outfh,dispfh INTEGER infh,errfh,bfh,warnfh,symfh,dbgfh,outfh,dispfh
LOGICAL cal_symm,checkinp,newSpecies,noangles LOGICAL cal_symm,checkinp,newSpecies,noangles
LOGICAL cartesian,oldfleur,l_hyb ,inistop LOGICAL cartesian,oldfleur,l_hyb ,inistop
...@@ -60,7 +60,7 @@ PROGRAM inpgen ...@@ -60,7 +60,7 @@ PROGRAM inpgen
dispfn='disp' dispfn='disp'
nline = 0 nline = 0
input%l_inpXML = .FALSE. input%l_inpXML = .FALSE.
ALLOCATE ( mmrot(3,3,nop48), ttr(3,nop48) ) ALLOCATE ( mmrot(3,3,nop48), ttr(3,nop48) )
ALLOCATE ( atompos(3,natmax),atomid(natmax) ) ALLOCATE ( atompos(3,natmax),atomid(natmax) )
...@@ -73,7 +73,7 @@ PROGRAM inpgen ...@@ -73,7 +73,7 @@ PROGRAM inpgen
& natmax,nop48,& & natmax,nop48,&
& nline,xl_buffer,buffer,& & nline,xl_buffer,buffer,&
& title,input%film,cal_symm,checkinp,sym%symor,& & title,input%film,cal_symm,checkinp,sym%symor,&
& cartesian,oldfleur,a1,a2,a3,vacuum%dvac,aa,scale,noangles,& & cartesian,oldfleur,a1,a2,a3,vacuum%dvac,aa,scale,noangles,i_c,&
& factor,natin,atomid,atompos,ngen,mmrot,ttr,& & factor,natin,atomid,atompos,ngen,mmrot,ttr,&
& l_hyb,noco%l_soc,noco%l_ss,noco%theta,noco%phi,noco%qss,inistop)!keep & l_hyb,noco%l_soc,noco%l_ss,noco%theta,noco%phi,noco%qss,inistop)!keep
...@@ -113,7 +113,7 @@ PROGRAM inpgen ...@@ -113,7 +113,7 @@ PROGRAM inpgen
& dbgfh,errfh,outfh,dispfh,dispfn,& & dbgfh,errfh,outfh,dispfh,dispfn,&
& cal_symm,cartesian,sym%symor,input%film,& & cal_symm,cartesian,sym%symor,input%film,&
& natin,natmax,nop48,& & natin,natmax,nop48,&
& atomid,atompos,a1,a2,a3,aa,scale,noangles,& & atomid,atompos,a1,a2,a3,aa,scale,noangles,i_c,&
& sym%invs,sym%zrfs,sym%invs2,sym%nop,sym%nop2,& & sym%invs,sym%zrfs,sym%invs2,sym%nop,sym%nop2,&
& ngen,mmrot,ttr,atoms%ntype,atoms%nat,nops,& & ngen,mmrot,ttr,atoms%ntype,atoms%nat,nops,&
& atoms%neq,ntyrep,atoms%zatom,natype,natrep,natmap,& & atoms%neq,ntyrep,atoms%zatom,natype,natrep,natmap,&
......
...@@ -8,7 +8,7 @@ ...@@ -8,7 +8,7 @@
CONTAINS CONTAINS
SUBROUTINE lattice2( SUBROUTINE lattice2(
> buffer,xl_buffer,errfh,bfh,nline, > buffer,xl_buffer,errfh,bfh,nline,
< a1,a2,a3,aa,scale,noangles,ios ) < a1,a2,a3,aa,scale,noangles,i_c,ios )
USE m_constants USE m_constants
IMPLICIT NONE IMPLICIT NONE
...@@ -20,7 +20,7 @@ ...@@ -20,7 +20,7 @@
REAL, INTENT (OUT) :: a1(3),a2(3),a3(3) REAL, INTENT (OUT) :: a1(3),a2(3),a3(3)
REAL, INTENT (OUT) :: aa REAL, INTENT (OUT) :: aa
REAL, INTENT (OUT) :: scale(3) REAL, INTENT (OUT) :: scale(3)
INTEGER, INTENT (OUT) :: ios INTEGER, INTENT (OUT) :: i_c,ios
LOGICAL, INTENT (OUT) :: noangles LOGICAL, INTENT (OUT) :: noangles
!==> Local Variables !==> Local Variables
...@@ -63,8 +63,8 @@ ...@@ -63,8 +63,8 @@
& 0.0, 1.0, 0.0, & 0.0, 1.0, 0.0,
& 0.5, 0.0, 0.5, & 0.5, 0.0, 0.5,
+ 1.0, 0.0, 0.0, ! 8: base-centered: A + 1.0, 0.0, 0.0, ! 8: base-centered: A
& 0.0, 0.5, -0.5, & 0.0, 0.5, 0.5,
& 0.0, 0.5, 0.5/ & 0.0, -0.5, 0.5/
!===> 12: monoclinic-P (mP) !===> 12: monoclinic-P (mP)
!===> 13: monoclinic-P (mS) (mA) (mB) (mC) !===> 13: monoclinic-P (mS) (mA) (mB) (mC)
...@@ -76,7 +76,8 @@ ...@@ -76,7 +76,8 @@
latsys = ' ' ; a0 = 0.0 latsys = ' ' ; a0 = 0.0
a = 0.0 ; b = 0.0 ; c = 0.0 a = 0.0 ; b = 0.0 ; c = 0.0
alpha = 0.0 ; beta = 0.0 ; gamma = 0.0 alpha = 0.0 ; beta = 0.0 ; gamma = 0.0
scale = 0.0
READ (bfh,lattice,err=911,end=911,iostat=ios) READ (bfh,lattice,err=911,end=911,iostat=ios)
IF ( abs(a0) < eps ) a0 = 1.0 IF ( abs(a0) < eps ) a0 = 1.0
...@@ -105,10 +106,10 @@ ...@@ -105,10 +106,10 @@
& latsys =='simple-cubic' ) THEN & latsys =='simple-cubic' ) THEN
noangles=.true. noangles=.true.
i = 1 i_c = 1
a1 = lmat(:,1,i) a1 = lmat(:,1,i_c)
a2 = lmat(:,2,i) a2 = lmat(:,2,i_c)
a3 = lmat(:,3,i) a3 = lmat(:,3,i_c)
IF ( a.NE.b .OR. a.NE.c ) err = 11 IF ( a.NE.b .OR. a.NE.c ) err = 11
IF ( ar.NE.br .OR. ar.NE.cr .OR. ar.NE.(pi_const/2.0) ) err = 12 IF ( ar.NE.br .OR. ar.NE.cr .OR. ar.NE.(pi_const/2.0) ) err = 12
...@@ -119,10 +120,10 @@ ...@@ -119,10 +120,10 @@
& latsys =='face-centered-cubic' ) THEN & latsys =='face-centered-cubic' ) THEN
noangles=.true. noangles=.true.
i = 2 i_c = 2
a1 = lmat(:,1,i) a1 = lmat(:,1,i_c)
a2 = lmat(:,2,i) a2 = lmat(:,2,i_c)
a3 = lmat(:,3,i) a3 = lmat(:,3,i_c)
IF ( a.NE.b .OR. a.NE.c ) err = 21 IF ( a.NE.b .OR. a.NE.c ) err = 21
...@@ -132,10 +133,10 @@ ...@@ -132,10 +133,10 @@
& latsys =='body-centered-cubic' ) THEN & latsys =='body-centered-cubic' ) THEN
noangles=.true. noangles=.true.
i = 3 i_c = 3
a1 = lmat(:,1,i) a1 = lmat(:,1,i_c)
a2 = lmat(:,2,i) a2 = lmat(:,2,i_c)
a3 = lmat(:,3,i) a3 = lmat(:,3,i_c)
IF ( a.NE.b .OR. a.NE.c ) err = 31 IF ( a.NE.b .OR. a.NE.c ) err = 31
...@@ -145,10 +146,10 @@ ...@@ -145,10 +146,10 @@
& .OR.latsys =='hexagonal' ) THEN & .OR.latsys =='hexagonal' ) THEN
noangles=.true. noangles=.true.
i = 4 i_c = 4
a1 = lmat(:,1,i) a1 = lmat(:,1,i_c)
a2 = lmat(:,2,i) a2 = lmat(:,2,i_c)
a3 = lmat(:,3,i) a3 = lmat(:,3,i_c)
IF ( a.NE.b ) err = 41 IF ( a.NE.b ) err = 41
...@@ -157,10 +158,11 @@ ...@@ -157,10 +158,11 @@
ELSEIF ( latsys =='hdp' ) THEN ELSEIF ( latsys =='hdp' ) THEN
noangles=.true. noangles=.true.
i = 4 i_c = 4
a1 = lmat((/2,1,3/),1,i) a1 = lmat((/2,1,3/),1,i_c)
a2 = -lmat((/2,1,3/),2,i) a2 = -lmat((/2,1,3/),2,i_c)
a3 = lmat(:,3,i) a3 = lmat(:,3,i_c)
i_c = 9
IF ( a.NE.b ) err = 41 IF ( a.NE.b ) err = 41
...@@ -171,10 +173,10 @@ ...@@ -171,10 +173,10 @@
& latsys =='rho'.OR.latsys =='trigonal' ) THEN & latsys =='rho'.OR.latsys =='trigonal' ) THEN
noangles=.false. noangles=.false.
i = 5 i_c = 5
a1 = lmat(:,1,i) a1 = lmat(:,1,i_c)
a2 = lmat(:,2,i) a2 = lmat(:,2,i_c)
a3 = lmat(:,3,i) a3 = lmat(:,3,i_c)
IF ( a.NE.b ) err = 51 IF ( a.NE.b ) err = 51
IF ( alpha.EQ.0.0 .OR. IF ( alpha.EQ.0.0 .OR.
...@@ -196,6 +198,7 @@ ...@@ -196,6 +198,7 @@
& latsys =='trigonal2' ) THEN & latsys =='trigonal2' ) THEN
noangles=.false. noangles=.false.
i_c = 5
IF ( a.NE.b .OR. a.NE.c ) err = 53 IF ( a.NE.b .OR. a.NE.c ) err = 53
IF ( alpha.NE.beta .OR. alpha.NE.gamma ) err = 54 IF ( alpha.NE.beta .OR. alpha.NE.gamma ) err = 54
...@@ -223,10 +226,10 @@ ...@@ -223,10 +226,10 @@
& .OR.latsys =='simple-tetragonal' ) THEN & .OR.latsys =='simple-tetragonal' ) THEN
noangles=.true. noangles=.true.
i = 1 i_c = 1
a1 = lmat(:,1,i) a1 = lmat(:,1,i_c)
a2 = lmat(:,2,i) a2 = lmat(:,2,i_c)
a3 = lmat(:,3,i) a3 = lmat(:,3,i_c)
IF ( a.NE.b ) err = 61 IF ( a.NE.b ) err = 61
IF ( ar.NE.br .OR. ar.NE.cr .OR. ar.NE.(pi_const/2.0) ) err= 62 IF ( ar.NE.br .OR. ar.NE.cr .OR. ar.NE.(pi_const/2.0) ) err= 62
...@@ -237,10 +240,10 @@ ...@@ -237,10 +240,10 @@
& .OR.latsys =='body-centered-tetragonal' ) THEN & .OR.latsys =='body-centered-tetragonal' ) THEN
noangles=.true. noangles=.true.
i = 3 i_c = 3
a1 = lmat(:,1,i) a1 = lmat(:,1,i_c)
a2 = lmat(:,2,i) a2 = lmat(:,2,i_c)
a3 = lmat(:,3,i) a3 = lmat(:,3,i_c)
IF ( a.NE.b ) err = 61 IF ( a.NE.b ) err = 61
...@@ -250,10 +253,10 @@ ...@@ -250,10 +253,10 @@
& latsys =='simple-orthorhombic' ) THEN & latsys =='simple-orthorhombic' ) THEN
noangles=.true. noangles=.true.
i = 1 i_c = 1
a1 = lmat(:,1,i) a1 = lmat(:,1,i_c)
a2 = lmat(:,2,i) a2 = lmat(:,2,i_c)
a3 = lmat(:,3,i) a3 = lmat(:,3,i_c)
!===> 9: orthorhombic-F (oF) !===> 9: orthorhombic-F (oF)
...@@ -262,10 +265,10 @@ ...@@ -262,10 +265,10 @@
& latsys =='face-centered-orthorhombic' ) THEN & latsys =='face-centered-orthorhombic' ) THEN
noangles=.true. noangles=.true.
i = 2 i_c = 2
a1 = lmat(:,1,i) a1 = lmat(:,1,i_c)
a2 = lmat(:,2,i) a2 = lmat(:,2,i_c)
a3 = lmat(:,3,i) a3 = lmat(:,3,i_c)
!===> 10: orthorhombic-I (oI) !===> 10: orthorhombic-I (oI)
...@@ -274,10 +277,10 @@ ...@@ -274,10 +277,10 @@
& latsys =='body-centered-orthorhombic' ) THEN & latsys =='body-centered-orthorhombic' ) THEN
noangles=.true. noangles=.true.
i = 3 i_c = 3
a1 = lmat(:,1,i) a1 = lmat(:,1,i_c)
a2 = lmat(:,2,i) a2 = lmat(:,2,i_c)
a3 = lmat(:,3,i) a3 = lmat(:,3,i_c)
!===> 11: orthorhombic-S (oS) (oC) !===> 11: orthorhombic-S (oS) (oC)
...@@ -286,10 +289,10 @@ ...@@ -286,10 +289,10 @@
& latsys =='base-centered-orthorhombic' ) THEN & latsys =='base-centered-orthorhombic' ) THEN
noangles=.true. noangles=.true.
i = 6 i_c = 6
a1 = lmat(:,1,i) a1 = lmat(:,1,i_c)
a2 = lmat(:,2,i) a2 = lmat(:,2,i_c)
a3 = lmat(:,3,i) a3 = lmat(:,3,i_c)
!===> 11a: orthorhombic-A (oA) !===> 11a: orthorhombic-A (oA)
...@@ -298,10 +301,10 @@ ...@@ -298,10 +301,10 @@
& latsys =='base-centered-orthorhombic2' ) THEN & latsys =='base-centered-orthorhombic2' ) THEN
noangles=.true. noangles=.true.
i = 8 i_c = 8
a1 = lmat(:,1,i) a1 = lmat(:,1,i_c)
a2 = lmat(:,2,i) a2 = lmat(:,2,i_c)
a3 = lmat(:,3,i) a3 = lmat(:,3,i_c)
!===> 11b: orthorhombic-B (oB) !===> 11b: orthorhombic-B (oB)
...@@ -310,10 +313,10 @@ ...@@ -310,10 +313,10 @@
& latsys =='base-centered-orthorhombic3' ) THEN & latsys =='base-centered-orthorhombic3' ) THEN
noangles=.true. noangles=.true.
i = 7 i_c = 7
a1 = lmat(:,1,i) a1 = lmat(:,1,i_c)
a2 = lmat(:,2,i) a2 = lmat(:,2,i_c)
a3 = lmat(:,3,i) a3 = lmat(:,3,i_c)
!===> 12: monoclinic-P (mP) !===> 12: monoclinic-P (mP)
ELSEIF ( latsys =='monoclinic-P'.OR.latsys =='mP'.OR ELSEIF ( latsys =='monoclinic-P'.OR.latsys =='mP'.OR
...@@ -321,6 +324,8 @@ ...@@ -321,6 +324,8 @@
& latsys =='simple-monoclinic' ) THEN & latsys =='simple-monoclinic' ) THEN
noangles=.false. noangles=.false.
i_c = 1
IF ( (abs(alpha-90.0)<eps).AND.(abs(beta-90.0)<eps) ) THEN IF ( (abs(alpha-90.0)<eps).AND.(abs(beta-90.0)<eps) ) THEN
IF ( ABS(gamma - 90.0) <eps ) CALL juDFT_error IF ( ABS(gamma - 90.0) <eps ) CALL juDFT_error
+ ("no monoclinic angle!",calledby ="lattice2") + ("no monoclinic angle!",calledby ="lattice2")
...@@ -359,12 +364,16 @@ ...@@ -359,12 +364,16 @@
+ ,calledby ="lattice2") + ,calledby ="lattice2")
ENDIF ENDIF
CALL brvmat ( alpha, beta, gamma, am ) CALL brvmat ( alpha, beta, gamma, am )
i = 8 am(:,1) = a * am(:,1)
am = matmul ( am, lmat(:,:,i) ) am(:,2) = b * am(:,2)
am(:,3) = c * am(:,3)
i_c = 8
am = matmul ( am, lmat(:,:,i_c) )
a1 = am(:,1) a1 = am(:,1)
a2 = am(:,2) a2 = am(:,2)
a3 = am(:,3) a3 = am(:,3)
CALL angles( am ) CALL angles( am )
scale = 1.0
!===> 13b monoclinic-B (mB) !===> 13b monoclinic-B (mB)
ELSEIF ( latsys =='monoclinic-B'.OR.latsys =='mB'.OR