diff --git a/cdn_mt/CMakeLists.txt b/cdn_mt/CMakeLists.txt index 3f5abdf9f7b144a8bdc75ea3bdac0a8dff1b0253..c55174370fa0aa18cfff0925f9986da10c5233b2 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/magMoms.f90 cdn_mt/orbMagMoms.f90 cdn_mt/orb_comp2.f90 cdn_mt/radfun.f90 diff --git a/cdn_mt/magMoms.f90 b/cdn_mt/magMoms.f90 new file mode 100644 index 0000000000000000000000000000000000000000..4bc51de55470f5d1d71b1e74166d5d96b9ec9361 --- /dev/null +++ b/cdn_mt/magMoms.f90 @@ -0,0 +1,53 @@ +!-------------------------------------------------------------------------------- +! Copyright (c) 2018 Peter Grünberg Institut, Forschungszentrum Jülich, Germany +! This file is part of FLEUR and available as free software under the conditions +! of the MIT license as expressed in the LICENSE file in more detail. +!-------------------------------------------------------------------------------- + +MODULE m_magMoms + +CONTAINS + +SUBROUTINE magMoms(dimension,input,atoms,chmom) + + USE m_types + USE m_xmlOutput + + IMPLICIT NONE + + TYPE(t_dimension), INTENT(IN) :: dimension + TYPE(t_input), INTENT(IN) :: input + TYPE(t_atoms), INTENT(IN) :: atoms + + REAL, INTENT(INOUT) :: chmom(atoms%ntype,dimension%jspd) + + INTEGER :: iType, j + REAL :: smom + CHARACTER(LEN=20) :: attributes(4) + + WRITE (6,FMT=8020) + WRITE (16,FMT=8020) + + CALL openXMLElement('magneticMomentsInMTSpheres',(/'units'/),(/'muBohr'/)) + DO iType = 1, atoms%ntype + smom = chmom(iType,1) - chmom(iType,input%jspins) + WRITE (6,FMT=8030) iType,smom, (chmom(iType,j),j=1,input%jspins) + WRITE (16,FMT=8030) iType,smom, (chmom(iType,j),j=1,input%jspins) + attributes = '' + WRITE(attributes(1),'(i0)') iType + WRITE(attributes(2),'(f15.10)') smom + WRITE(attributes(3),'(f15.10)') chmom(iType,1) + WRITE(attributes(4),'(f15.10)') chmom(iType,2) + CALL writeXMLElementFormPoly('magneticMoment',(/'atomType ','moment ','spinUpCharge ',& + 'spinDownCharge'/),& + attributes,reshape((/8,6,12,14,6,15,15,15/),(/4,2/))) + END DO + CALL closeXMLElement('magneticMomentsInMTSpheres') + + 8020 FORMAT (/,/,2x,'--> magnetic moments in the spheres:',/,2x,& + 'mm --> type',t22,'moment',t33,'spin-up',t43,'spin-down') + 8030 FORMAT (2x,'--> mm',i8,2x,3f12.5) + +END SUBROUTINE magMoms + +END MODULE m_magMoms diff --git a/cdn_mt/orbMagMoms.f90 b/cdn_mt/orbMagMoms.f90 index c5b50a2cec4bbb474f4b0506296c3c4faf3c3001..edeb5f01ae967b347d2ed4a7a5cd9c222c78c1b9 100644 --- a/cdn_mt/orbMagMoms.f90 +++ b/cdn_mt/orbMagMoms.f90 @@ -1,3 +1,9 @@ +!-------------------------------------------------------------------------------- +! Copyright (c) 2018 Peter Grünberg Institut, Forschungszentrum Jülich, Germany +! This file is part of FLEUR and available as free software under the conditions +! of the MIT license as expressed in the LICENSE file in more detail. +!-------------------------------------------------------------------------------- + MODULE m_orbMagMoms CONTAINS diff --git a/main/cdngen.F90 b/main/cdngen.F90 index 772ec0c1983eb170585b70b00b7fe99b5593a1cd..b01bee21f34ec0d622da5fec8ef06b9170f71310 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_magMoms USE m_orbMagMoms #ifdef CPP_MPI USE m_mpi_bc_potden @@ -74,7 +75,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,& TYPE(t_noco) :: noco_new !Local Scalars - REAL fix,qtot,scor,seig,smom,stot,sval,dummy + REAL fix,qtot,scor,seig,stot,sval,dummy REAL sum,fermiEnergyTemp INTEGER iter,ivac,j,jspin,jspmax,k,n,nt,ieig,ikpt INTEGER ityp,ilayer,urec,itype,iatom @@ -88,7 +89,6 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,& REAL chmom(atoms%ntype,dimension%jspd),clmom(3,atoms%ntype,dimension%jspd) INTEGER,ALLOCATABLE :: igq_fft(:) REAL ,ALLOCATABLE :: qvac(:,:,:,:),qvlay(:,:,:,:,:) - CHARACTER(LEN=20) :: attributes(4) !pk non-collinear (start) REAL rhoint,momint,alphdiff(atoms%ntype) @@ -325,6 +325,10 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,& WRITE (6,FMT=8010) n,stot,sval,scor,svdn(n,1),stdn(n,1) WRITE (16,FMT=8010) n,stot,sval,scor,svdn(n,1),stdn(n,1) END DO + + CALL magMoms(dimension,input,atoms,chmom) + + noco_new = noco IF (noco%l_mperp) THEN ! angles in nocoinp file are (alph-alphdiff) iatom = 1 @@ -336,33 +340,13 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,& ELSE alphdiff(n)= 0. END IF - iatom= iatom + atoms%neq(n) - END DO - END IF - WRITE (6,FMT=8020) - WRITE (16,FMT=8020) - noco_new = noco - CALL openXMLElement('magneticMomentsInMTSpheres',(/'units'/),(/'muBohr'/)) - DO n = 1, atoms%ntype - smom = chmom(n,1) - chmom(n,input%jspins) - WRITE (6,FMT=8030) n,smom, (chmom(n,j),j=1,input%jspins) - WRITE (16,FMT=8030) n,smom, (chmom(n,j),j=1,input%jspins) - attributes = '' - WRITE(attributes(1),'(i0)') n - WRITE(attributes(2),'(f15.10)') smom - WRITE(attributes(3),'(f15.10)') chmom(n,1) - WRITE(attributes(4),'(f15.10)') chmom(n,2) - CALL writeXMLElementFormPoly('magneticMoment',(/'atomType ','moment ','spinUpCharge ',& - 'spinDownCharge'/),& - attributes,reshape((/8,6,12,14,6,15,15,15/),(/4,2/))) - IF (noco%l_mperp) THEN !calculate the perpendicular part of the local moment !and relax the angle of the local moment or calculate !the constraint B-field. CALL m_perp(atoms,n,noco_new,vTot%mt(:,0,:,:),chmom,qa21,alphdiff) - END IF - END DO - CALL closeXMLElement('magneticMomentsInMTSpheres') + iatom= iatom + atoms%neq(n) + END DO + END IF !save the new nocoinp file if the dierctions of the local !moments are relaxed or a constraint B-field is calculated. @@ -404,9 +388,6 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,& 'input%total',t42,'valence',t65,'core',t90,& 'majority valence and input%total density',/) 8010 FORMAT (i13,2x,3e20.8,5x,2e20.8) - 8020 FORMAT (/,/,2x,'--> magnetic moments in the spheres:',/,2x,& - 'mm --> type',t22,'moment',t33,'spin-up',t43,'spin-down') - 8030 FORMAT (2x,'--> mm',i8,2x,3f12.5) IF (sliceplot%slice) THEN OPEN (20,file='cdn_slice',form='unformatted',status='unknown')