diff --git a/cdn_mt/CMakeLists.txt b/cdn_mt/CMakeLists.txt index 8f738c84bcdfca7aa3441a712dbc52419d7d5816..3f5abdf9f7b144a8bdc75ea3bdac0a8dff1b0253 100644 --- a/cdn_mt/CMakeLists.txt +++ b/cdn_mt/CMakeLists.txt @@ -9,6 +9,7 @@ cdn_mt/abcof.F90 cdn_mt/abcof3.F90 cdn_mt/abcrot2.f90 cdn_mt/cdnmt.f90 +cdn_mt/orbMagMoms.f90 cdn_mt/orb_comp2.f90 cdn_mt/radfun.f90 cdn_mt/rhomt.f90 diff --git a/cdn_mt/orbMagMoms.f90 b/cdn_mt/orbMagMoms.f90 new file mode 100644 index 0000000000000000000000000000000000000000..c5b50a2cec4bbb474f4b0506296c3c4faf3c3001 --- /dev/null +++ b/cdn_mt/orbMagMoms.f90 @@ -0,0 +1,66 @@ +MODULE m_orbMagMoms + +CONTAINS + +SUBROUTINE orbMagMoms(dimension,atoms,noco,clmom) + + USE m_types + USE m_xmlOutput + + IMPLICIT NONE + + TYPE(t_dimension), INTENT(IN) :: dimension + TYPE(t_atoms), INTENT(IN) :: atoms + TYPE(t_noco), INTENT(IN) :: noco + + REAL, INTENT(INOUT) :: clmom(3,atoms%ntype,dimension%jspd) + + INTEGER :: iType, j + REAL :: thetai, phii, slmom, slxmom, slymom + CHARACTER(LEN=20) :: attributes(4) + + thetai = noco%theta + phii = noco%phi + WRITE (6,FMT=9020) + WRITE (16,FMT=9020) + CALL openXMLElement('orbitalMagneticMomentsInMTSpheres',(/'units'/),(/'muBohr'/)) + DO iType = 1, atoms%ntype + IF (noco%l_noco) THEN + thetai = noco%beta(iType) + phii = noco%alph(iType) + END IF + + ! magn. moment(-) + slxmom = clmom(1,iType,1)+clmom(1,iType,2) + slymom = clmom(2,iType,1)+clmom(2,iType,2) + slmom = clmom(3,iType,1)+clmom(3,iType,2) + + ! rotation: orbital moment || spin moment (extended to incude phi - hopefully) + slmom = cos(thetai)*slmom + sin(thetai)*(cos(phii)*slxmom + sin(phii)*slymom) + clmom(3,iType,1) = cos(thetai)*clmom(3,iType,1) + & + sin(thetai)*(cos(phii)*clmom(1,iType,1) + & + sin(phii)*clmom(2,iType,1)) + clmom(3,iType,2) = cos(thetai)*clmom(3,iType,2) + & + sin(thetai)*(cos(phii)*clmom(1,iType,2) + & + sin(phii)*clmom(2,iType,2)) + + WRITE (6,FMT=8030) iType,slmom,(clmom(3,iType,j),j=1,2) + WRITE (16,FMT=8030) iType,slmom,(clmom(3,iType,j),j=1,2) + attributes = '' + WRITE(attributes(1),'(i0)') iType + WRITE(attributes(2),'(f15.10)') slmom + WRITE(attributes(3),'(f15.10)') clmom(3,iType,1) + WRITE(attributes(4),'(f15.10)') clmom(3,iType,2) + CALL writeXMLElementFormPoly('orbMagMoment',(/'atomType ','moment ','spinUpCharge ',& + 'spinDownCharge'/),& + attributes,reshape((/8,6,12,14,6,15,15,15/),(/4,2/))) + END DO + CALL closeXMLElement('orbitalMagneticMomentsInMTSpheres') + + 9020 FORMAT (/,/,10x,'orb. magnetic moments in the spheres:',/,10x,& + 'type',t22,'moment',t33,'spin-up',t43,'spin-down') + 8030 FORMAT (2x,'--> mm',i8,2x,3f12.5) + +END SUBROUTINE orbMagMoms + +END MODULE m_orbMagMoms diff --git a/main/cdngen.F90 b/main/cdngen.F90 index d407c651bfd7a9147db5ab976182b5798edbce64..772ec0c1983eb170585b70b00b7fe99b5593a1cd 100644 --- a/main/cdngen.F90 +++ b/main/cdngen.F90 @@ -35,6 +35,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,& USE m_m_perp USE m_types USE m_xmlOutput + USE m_orbMagMoms #ifdef CPP_MPI USE m_mpi_bc_potden USE m_mpi_bc_coreden @@ -74,7 +75,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,& !Local Scalars REAL fix,qtot,scor,seig,smom,stot,sval,dummy - REAL slmom,slxmom,slymom,sum,thetai,phii,fermiEnergyTemp + REAL sum,fermiEnergyTemp INTEGER iter,ivac,j,jspin,jspmax,k,n,nt,ieig,ikpt INTEGER ityp,ilayer,urec,itype,iatom LOGICAL l_relax_any,exst,n_exist,l_qfix, l_enpara @@ -394,49 +395,11 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,& CLOSE (24) END IF - IF (noco%l_soc) THEN - thetai = noco%theta - phii = noco%phi - WRITE (6,FMT=9020) - WRITE (16,FMT=9020) - CALL openXMLElement('orbitalMagneticMomentsInMTSpheres',(/'units'/),(/'muBohr'/)) - DO n = 1, atoms%ntype - IF (noco%l_noco) THEN - thetai = noco%beta(n) - phii = noco%alph(n) - END IF - - ! magn. moment(-) - slxmom = clmom(1,n,1)+clmom(1,n,2) - slymom = clmom(2,n,1)+clmom(2,n,2) - slmom = clmom(3,n,1)+clmom(3,n,2) - - ! rotation: orbital moment || spin moment (extended to incude phi - hopefully) - slmom = cos(thetai)*slmom + sin(thetai)* (cos(phii)*slxmom + sin(phii)*slymom) - clmom(3,n,1) = cos(thetai)*clmom(3,n,1) + & - sin(thetai)*(cos(phii)*clmom(1,n,1) + sin(phii)*clmom(2,n,1)) - clmom(3,n,2) = cos(thetai)*clmom(3,n,2) + & - sin(thetai)*(cos(phii)*clmom(1,n,2) + sin(phii)*clmom(2,n,2)) - - WRITE (6,FMT=8030) n,slmom,(clmom(3,n,j),j=1,2) - WRITE (16,FMT=8030) n,slmom,(clmom(3,n,j),j=1,2) - attributes = '' - WRITE(attributes(1),'(i0)') n - WRITE(attributes(2),'(f15.10)') slmom - WRITE(attributes(3),'(f15.10)') clmom(3,n,1) - WRITE(attributes(4),'(f15.10)') clmom(3,n,2) - CALL writeXMLElementFormPoly('orbMagMoment',(/'atomType ','moment ','spinUpCharge ',& - 'spinDownCharge'/),& - attributes,reshape((/8,6,12,14,6,15,15,15/),(/4,2/))) - END DO - CALL closeXMLElement('orbitalMagneticMomentsInMTSpheres') - END IF + IF (noco%l_soc) CALL orbMagMoms(dimension,atoms,noco,clmom) END IF !block 2 unnecessary for slicing: end END IF ! .NOT.sliceplot%slice - 9020 FORMAT (/,/,10x,'orb. magnetic moments in the spheres:',/,10x,& - 'type',t22,'moment',t33,'spin-up',t43,'spin-down') 8000 FORMAT (/,/,10x,'spin density at the nucleus:',/,10x,'type',t25,& 'input%total',t42,'valence',t65,'core',t90,& 'majority valence and input%total density',/)