...
 
Commits (1167)

Too many changes to show.

To preserve performance only 311 of 311+ files are displayed.

docs/mkdocs/site
init/compileinfo.h init/compileinfo.h
io/xml/inputSchema.h io/xml/inputSchema.h
Testing/*
*~ *~
\#* \#*
build build
build.* build.*
*.o *.o
*.mod
*.x *.x
*.swp *.swp
tags tags
.DS_Store
.vscode
stages: stages:
- build - build
- test - test
- coverage - html
- deploy - deploy
- build-pgi
- test-pgi
- build-intel
- test-intel
build-gfortran-hdf5: build-gfortran-hdf5:
image: iffregistry.fz-juelich.de/fleur/fleur:latest image: iffregistry.fz-juelich.de/fleur/fleur:latest
stage: build stage: build
cache: artifacts:
paths: paths:
- build - build
expire_in: 1h
script: script:
- cd /builds/fleur/fleur; ./configure.sh GITLAB; cd build; make - cd /builds/fleur/fleur; ./configure.sh GITLAB; cd build; make -j 4
# only: # only:
# - schedules # - schedules
# - triggers # - triggers
...@@ -25,9 +22,6 @@ build-gfortran-hdf5: ...@@ -25,9 +22,6 @@ build-gfortran-hdf5:
test-gfortran-hdf5: test-gfortran-hdf5:
image: iffregistry.fz-juelich.de/fleur/fleur:latest image: iffregistry.fz-juelich.de/fleur/fleur:latest
stage: test stage: test
cache:
paths:
- build
script: script:
- ulimit -s unlimited ;export juDFT_MPI="mpirun -n 2 --allow-run-as-root ";export OMP_NUM_THREADS=4;cd /builds/fleur/fleur/build;ctest - ulimit -s unlimited ;export juDFT_MPI="mpirun -n 2 --allow-run-as-root ";export OMP_NUM_THREADS=4;cd /builds/fleur/fleur/build;ctest
artifacts: artifacts:
...@@ -39,68 +33,103 @@ test-gfortran-hdf5: ...@@ -39,68 +33,103 @@ test-gfortran-hdf5:
# - schedules # - schedules
# - triggers # - triggers
# - web # - web
pages: pages:
image: iffregistry.fz-juelich.de/fleur/fleur:latest image: iffregistry.fz-juelich.de/fleur/fleur:latest
stage: deploy stage: deploy
cache: script:
paths: - echo "HTML should be ready from cache..."
- build - mv /builds/fleur/fleur/docs/Docu_main.html /builds/fleur/fleur/public/index.html
- public environment:
name: HTML-Pages
url: https://fleur.iffgit.fz-juelich.de/fleur
artifacts:
paths:
- public
only:
- web
doxygen:
image: iffregistry.fz-juelich.de/fleur/fleur:latest
stage: html
script: script:
- cd /builds/fleur/fleur/build ; make doc - cd /builds/fleur/fleur/build ; make doc
- mv docs/html/ ../public/ - mkdir ../public
- mv /builds/fleur/fleur/docs/Docu_main.html ../public/index.html - mv docs/html/ ../public/doxygen
environment:
name: Doxygen
url: https://fleur.iffgit.fz-juelich.de/fleur
artifacts: artifacts:
paths: paths:
- public - public
- build/fleur - build/fleur
- build/fleur_MPI - build/fleur_MPI
- build/inpgen - build/inpgen
only:
- web
build-pgi:
image: iffregistry.fz-juelich.de/fleur/fleur:pgi
stage: build
artifacts:
paths:
- build.pgi
expire_in: 1h
script:
- cd /builds/fleur/fleur; ./configure.sh -l pgi ; cd build.pgi; make
allow_failure: true
only: only:
- schedules - schedules
- triggers - triggers
- web - web
#build-pgi:
# image: iffregistry.fz-juelich.de/fleur/fleur:pgi
# stage: build-pgi
# cache:
# paths:
# - build.debug
# script:
# - cd /builds/fleur/fleur; ./configure.sh -d AUTO ; cd build.debug; make
# only:
# - schedules
# - triggers
# - web
#test-pgi: test-pgi:
# image: iffregistry.fz-juelich.de/fleur/fleur:pgi image: iffregistry.fz-juelich.de/fleur/fleur:pgi
# stage: test-pgi stage: test
# cache: dependencies:
# paths: - build-pgi
# - build.debug script:
# script: - cd /builds/fleur/fleur/build.pgi;ctest
# - cd /builds/fleur/fleur/build.debug;ctest allow_failure: true
# only: only:
# - schedules - schedules
# - web - web
# - triggers - triggers
build-intel-static:
image: iffregistry.fz-juelich.de/fleur/fleur:intel-static
stage: build
artifacts:
paths:
- build.intel-static
expire_in: 1h
script:
- set +e && source compilervars.sh intel64 && set -e ; ulimit -s unlimited
- cd /builds/fleur/fleur; ./configure.sh -l intel-static INTEL_DOCKER_STATIC ; cd build.intel-static; make -j 4
artifacts:
when: on_success
paths:
- build.intel-static/fleur
- build.intel-static/fleur_MPI
- build.intel-static/inpgen
allow_failure: true
only:
- schedules
- triggers
- web
build-intel: build-intel:
image: iffregistry.fz-juelich.de/docker-images/centos7-intel-compilers/extended image: iffregistry.fz-juelich.de/fleur/fleur:intel-static
stage: build-intel stage: build
cache: artifacts:
paths: paths:
- build.intel - build.intel.debug
expire_in: 1h
script: script:
- set +e && source compilervars.sh intel64 && set -e ; ulimit -s unlimited - set +e && source compilervars.sh intel64 && set -e ; ulimit -s unlimited
- cd /builds/fleur/fleur; FC=mpiifort FLEUR_LIBRARIES="-lmkl_scalapack_lp64;-lmkl_blacs_intelmpi_lp64" ./configure.sh -t -l intel INTEL_MPI ; cd build.intel; make - cd /builds/fleur/fleur; CC=gcc FC=mpiifort FLEUR_LIBRARIES="-lmkl_scalapack_lp64;-lmkl_blacs_intelmpi_lp64" ./configure.sh -t -d -l intel INTEL_MPI ; cd build.intel.debug; make -j 4
allow_failure: true
only: only:
- schedules - schedules
- triggers - triggers
...@@ -108,19 +137,19 @@ build-intel: ...@@ -108,19 +137,19 @@ build-intel:
test-intel: test-intel:
image: iffregistry.fz-juelich.de/docker-images/centos7-intel-compilers/extended image: iffregistry.fz-juelich.de/fleur/fleur:intel-static
stage: test-intel stage: test
cache: dependencies:
paths: - build-intel
- build.intel
script: script:
- set +e && source compilervars.sh intel64 && set -e; ulimit -s unlimited - set +e && source compilervars.sh intel64 && set -e; ulimit -s unlimited
- cd /builds/fleur/fleur/build.intel;ctest - cd /builds/fleur/fleur/build.intel.debug;ctest
allow_failure: true
artifacts: artifacts:
when: on_failure when: on_failure
paths: paths:
- build/Testing/failed - build.intel.debug/Testing/failed
- build/Testing/test.oldlogs - build.intel.debug/Testing/test.oldlogs
only: only:
- schedules - schedules
- web - web
...@@ -128,18 +157,16 @@ test-intel: ...@@ -128,18 +157,16 @@ test-intel:
gfortran-coverage: gfortran-coverage:
image: iffregistry.fz-juelich.de/fleur/fleur:latest image: iffregistry.fz-juelich.de/fleur/fleur:latest
stage: coverage stage: html
cache:
paths:
- build
script: script:
- cd /builds/fleur/fleur; ./configure.sh -l coverage -flags --coverage GITLAB; cd build.coverage; make - cd /builds/fleur/fleur; ./configure.sh -l coverage -flags --coverage GITLAB; cd build.coverage; make -j 4
- lcov --capture --initial -d CMakeFiles -o baseline.info - lcov --capture --initial -d CMakeFiles -o baseline.info
- ulimit -s unlimited ;export juDFT_MPI="mpirun -n 2 --allow-run-as-root ";ctest - ulimit -s unlimited ;export juDFT_MPI="mpirun -n 2 --allow-run-as-root ";ctest
- lcov --capture -d CMakeFiles -o after.info - lcov --capture -d CMakeFiles -o after.info
- lcov --add-tracefile baseline.info --add-tracefile after.info -o combined.info - lcov --add-tracefile baseline.info --add-tracefile after.info -o combined.info
- genhtml combined.info --output-directory html_out - genhtml combined.info --output-directory html_out
- mkdir ../public;mv html_out ../public/coverage_html - mkdir ../public;mv html_out ../public/coverage_html
allow_failure: true
artifacts: artifacts:
paths: paths:
- public - public
...@@ -148,4 +175,4 @@ gfortran-coverage: ...@@ -148,4 +175,4 @@ gfortran-coverage:
url: https://fleur.iffgit.fz-juelich.de/fleur/coverage_html url: https://fleur.iffgit.fz-juelich.de/fleur/coverage_html
only: only:
- web - web
- schedules
\ No newline at end of file
# Summary
<!-- Summarize the bug encountered concisely. -->
## Input and output file:
<!--Please provide at least the inp.xml and the out files produced. -->
## Compute environment
<!-- Please shortly describe the machine&compiler you use. -->
## This is BUG because:
<!-- Please indicate the correct behaviour you expect. -->
## The problem only occurs if:
<!-- Please indicate if you checked if the bug only occurs if, e.g. you run on a specific machine,
in MPI mode, with several OpenMP task, you use LOs or SOC or ... -->
## Console output and other logs
<!-- Paste any relevant logs - please use code blocks (```) to format console output,
logs, and code as it's very hard to read otherwise. -->
## Ideas for fixes
<!-- If you can, give hints that that might help fixing the problem. -->
<!-- Please choose an appropriate label like: ~Bug ~"Critial Bug" . -->
/label ~Bug
# Summary
<!-- Summarize the problem encountered concisely. -->
## Machine
<!-- Please describe the machine you use. -->
## Compiler
<!-- Please describe the compiler you use. -->
## Libraries
<!-- Please describe any specific libraries you use. -->
## Version you try to compile
<!-- Best is to use 'git describe' on the source code and paste the output here. -->
## Command line
<!-- Please give the command line of the configure script you use and of any corresponding environment variables you set -->
## Console output and other logs
<!-- Paste any relevant logs - please use code blocks (```) to format console output,
logs, and code as it's very hard to read otherwise. -->
## Further comments
\label ~"Compilation related"
\ No newline at end of file
# Summary
<!-- Summarize the feature concisely. -->
## Why is this feature needed?
<!-- Please describe the usecase. -->
## Implementation ideas
<!-- If yoy have ideas how the feature should be realized share them. -->
\label ~"Feature Request"
\ No newline at end of file
[submodule "external/hdf5-git"]
path = external/hdf5-git
url = https://bitbucket.hdfgroup.org/scm/hdffv/hdf5.git
[submodule "external/libxc-git"]
path = external/libxc-git
url = https://gitlab.com/libxc/libxc.git
[submodule "docs/katacoda-tutorials"]
path = docs/katacoda-tutorials
url = gitlab@iffgit.fz-juelich.de:fleur/katacoda-tutorials.git
[submodule "external/wannier90"]
path = external/wannier90
url = https://github.com/wannier-developers/wannier90.git
...@@ -10,12 +10,17 @@ set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${tmp}") ...@@ -10,12 +10,17 @@ set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${tmp}")
include("cmake/CompilerConfig.txt") include("cmake/CompilerConfig.txt")
include("cmake/ReportConfig.txt")
include("cmake/Generate_Schema.cmake") include("cmake/Generate_Schema.cmake")
include("cmake/Files_and_Targets.txt") include("cmake/Files_and_Targets.txt")
include("cmake/filespecific.cmake") include("cmake/filespecific.cmake")
include("cmake/ReportConfig.txt")
#install(TARGETS fleur inpgen DESTINATION bin) #install(TARGETS fleur inpgen DESTINATION bin)
install(PROGRAMS ${CMAKE_BINARY_DIR}/fleur install(PROGRAMS ${CMAKE_BINARY_DIR}/fleur
CONFIGURATIONS Debug CONFIGURATIONS Debug
......
...@@ -4,6 +4,124 @@ MODULE m_cdntot ...@@ -4,6 +4,124 @@ MODULE m_cdntot
! vacuum, and mt regions c.l.fu ! vacuum, and mt regions c.l.fu
! ******************************************************** ! ********************************************************
CONTAINS CONTAINS
SUBROUTINE integrate_cdn(stars,atoms,sym,vacuum,input,cell,oneD, integrand, &
q, qis, qmt, qvac, qtot, qistot)
USE m_intgr, ONLY : intgr3
USE m_constants
USE m_qsf
USE m_pwint
USE m_types
USE m_juDFT
USE m_convol
IMPLICIT NONE
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_input),INTENT(IN) :: input
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_potden),INTENT(IN) :: integrand
REAL, INTENT(out) :: q(input%jspins), qis(input%jspins), qmt(atoms%ntype,input%jspins),&
qvac(2,input%jspins), qtot, qistot
INTEGER :: jsp, j, ivac, nz, n
REAL :: q2(vacuum%nmz), w, rht1(vacuum%nmzd,2,input%jspins)
COMPLEX :: x(stars%ng3)
qtot = 0.0
qistot = 0.0
DO jsp = 1,input%jspins
q(jsp) = 0.0
! -----mt charge
CALL timestart("MT")
DO n = 1,atoms%ntype
CALL intgr3(integrand%mt(:,0,n,jsp),atoms%rmsh(:,n),atoms%dx(n),atoms%jri(n),w)
qmt(n, jsp) = w*sfp_const
q(jsp) = q(jsp) + atoms%neq(n)*qmt(n,jsp)
ENDDO
CALL timestop("MT")
! -----vacuum region
IF (input%film) THEN
DO ivac = 1,vacuum%nvac
DO nz = 1,vacuum%nmz
IF (oneD%odi%d1) THEN
rht1(nz,ivac,jsp) = (cell%z1+(nz-1)*vacuum%delz)*&
integrand%vacz(nz,ivac,jsp)
ELSE
rht1(nz,ivac,jsp) = integrand%vacz(nz,ivac,jsp)
END IF
END DO
CALL qsf(vacuum%delz,rht1(1,ivac,jsp),q2,vacuum%nmz,0)
qvac(ivac,jsp) = q2(1)*cell%area
IF (.NOT.oneD%odi%d1) THEN
q(jsp) = q(jsp) + qvac(ivac,jsp)*2./real(vacuum%nvac)
ELSE
q(jsp) = q(jsp) + cell%area*q2(1)
END IF
ENDDO
END IF
! -----is region
qis(jsp) = 0.
CALL pwint_all(stars,atoms,sym,oneD,cell,1,stars%ng3,x)
DO j = 1,stars%ng3
qis(jsp) = qis(jsp) + integrand%pw(j,jsp)*x(j)*stars%nstr(j)
ENDDO
qistot = qistot + qis(jsp)
q(jsp) = q(jsp) + qis(jsp)
qtot = qtot + q(jsp)
END DO ! loop over spins
END SUBROUTINE integrate_cdn
SUBROUTINE integrate_realspace(xcpot, atoms, sym, sphhar, input, &
stars, cell, oneD, vacuum, noco, mt, is, hint)
use m_types
use m_mt_tofrom_grid
use m_pw_tofrom_grid
use m_constants
implicit none
CLASS(t_xcpot), INTENT(inout) :: xcpot
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_sym), INTENT(in) :: sym
TYPE(t_sphhar), INTENT(IN) :: sphhar
TYPE(t_input), INTENT(IN) :: input
TYPE(t_stars), INTENT(IN) :: stars
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_oneD), INTENT(in) :: oneD
TYPE(t_vacuum), INTENT(in) :: vacuum
TYPE(t_noco), INTENT(in) :: noco
real, intent(inout) :: mt(:,:,:), is(:,:)
character(len=*), intent(in), optional :: hint
integer :: n_atm, i
TYPE(t_potden) :: tmp_potden
REAL :: q(input%jspins), qis(input%jspins), &
qmt(atoms%ntype,input%jspins), qvac(2,input%jspins),&
qtot, qistot
call tmp_potden%init(stars, atoms, sphhar, vacuum, noco, input%jspins, POTDEN_TYPE_DEN)
call init_mt_grid(input%jspins, atoms, sphhar, xcpot%needs_grad(), sym)
do n_atm =1,atoms%ntype
call mt_from_grid(atoms, sphhar, n_atm, input%jspins, mt(:,:,n_atm), &
tmp_potden%mt(:,0:,n_atm,:))
do i=1,atoms%jri(n_atm)
tmp_potden%mt(i,:,n_atm,:) = tmp_potden%mt(i,:,n_atm,:) * atoms%rmsh(i,n_atm)**2
enddo
enddo
call finish_mt_grid()
call init_pw_grid(xcpot%needs_grad(), stars, sym, cell)
call pw_from_grid(xcpot%needs_grad(), stars, .False., is, tmp_potden%pw)
call finish_pw_grid()
call integrate_cdn(stars,atoms,sym,vacuum,input,cell,oneD, tmp_potden, &
q, qis, qmt, qvac, qtot, qistot)
call print_cdn_inte(q, qis, qmt, qvac, qtot, qistot, hint)
END SUBROUTINE integrate_realspace
SUBROUTINE cdntot(stars,atoms,sym,vacuum,input,cell,oneD,& SUBROUTINE cdntot(stars,atoms,sym,vacuum,input,cell,oneD,&
den,l_printData,qtot,qistot) den,l_printData,qtot,qistot)
...@@ -31,84 +149,37 @@ CONTAINS ...@@ -31,84 +149,37 @@ CONTAINS
! .. Local Scalars .. ! .. Local Scalars ..
COMPLEX x(stars%ng3) COMPLEX x(stars%ng3)
REAL q,qis,w,mtCharge REAL q(input%jspins),qis(input%jspins),w,mtCharge
INTEGER i,ivac,j,jspin,n,nz INTEGER i,ivac,j,jsp,n,nz
! .. ! ..
! .. Local Arrays .. ! .. Local Arrays ..
REAL qmt(atoms%ntype),qvac(2),q2(vacuum%nmz),rht1(vacuum%nmzd,2,input%jspins) REAL qmt(atoms%ntype,input%jspins),qvac(2,input%jspins)
INTEGER, ALLOCATABLE :: lengths(:,:) INTEGER, ALLOCATABLE :: lengths(:,:)
CHARACTER(LEN=20) :: attributes(6), names(6) CHARACTER(LEN=20) :: attributes(6), names(6)
! ..
! .. Intrinsic Functions .. CALL timestart("cdntot")
INTRINSIC real call integrate_cdn(stars,atoms,sym,vacuum,input,cell,oneD, den, &
! .. q, qis, qmt, qvac, qtot, qistot)
!
IF (input%film) THEN IF (input%film) THEN
ALLOCATE(lengths(4+vacuum%nvac,2)) ALLOCATE(lengths(4+vacuum%nvac,2))
ELSE ELSE
ALLOCATE(lengths(4,2)) ALLOCATE(lengths(4,2))
END IF END IF
CALL timestart("cdntot")
qtot = 0.e0 DO jsp = 1,input%jspins
qistot = 0.e0 WRITE (6,FMT=8000) jsp,q(jsp),qis(jsp), (qmt(n,jsp),n=1,atoms%ntype)
DO jspin = 1,input%jspins IF (input%film) WRITE (6,FMT=8010) (i,qvac(i,jsp),i=1,vacuum%nvac)
q = 0.e0 mtCharge = SUM(qmt(1:atoms%ntype,jsp) * atoms%neq(1:atoms%ntype))
! -----mt charge names(1) = 'spin' ; WRITE(attributes(1),'(i0)') jsp ; lengths(1,1)=4 ; lengths(1,2)=1
CALL timestart("MT") names(2) = 'total' ; WRITE(attributes(2),'(f14.7)') q(jsp) ; lengths(2,1)=5 ; lengths(2,2)=14
DO n = 1,atoms%ntype names(3) = 'interstitial' ; WRITE(attributes(3),'(f14.7)') qis(jsp) ; lengths(3,1)=12 ; lengths(3,2)=14
CALL intgr3(den%mt(:,0,n,jspin),atoms%rmsh(:,n),atoms%dx(n),atoms%jri(n),w)
qmt(n) = w*sfp_const
q = q + atoms%neq(n)*qmt(n)
ENDDO
CALL timestop("MT")
! -----vacuum region
IF (input%film) THEN
DO ivac = 1,vacuum%nvac
DO nz = 1,vacuum%nmz
IF (oneD%odi%d1) THEN
rht1(nz,ivac,jspin) = (cell%z1+(nz-1)*vacuum%delz)*&
den%vacz(nz,ivac,jspin)
ELSE
rht1(nz,ivac,jspin) = den%vacz(nz,ivac,jspin)
END IF
END DO
CALL qsf(vacuum%delz,rht1(1,ivac,jspin),q2,vacuum%nmz,0)
qvac(ivac) = q2(1)*cell%area
IF (.NOT.oneD%odi%d1) THEN
q = q + qvac(ivac)*2./real(vacuum%nvac)
ELSE
q = q + cell%area*q2(1)
END IF
ENDDO
END IF
! -----is region
IF (.FALSE.) THEN !Change this for old way of determination of int-charge
CALL convol(stars,x,den%pw(:,jspin),stars%ufft)
qis = x(1)*cell%omtil
ELSE
qis = 0.
CALL pwint_all(stars,atoms,sym,oneD,cell,x)
DO j = 1,stars%ng3
qis = qis + den%pw(j,jspin)*x(j)*stars%nstr(j)
ENDDO
endif
qistot = qistot + qis
q = q + qis
WRITE (6,FMT=8000) jspin,q,qis, (qmt(n),n=1,atoms%ntype)
IF (input%film) WRITE (6,FMT=8010) (i,qvac(i),i=1,vacuum%nvac)
WRITE (16,FMT=8000) jspin,q,qis, (qmt(n),n=1,atoms%ntype)
IF (input%film) WRITE (16,FMT=8010) (i,qvac(i),i=1,vacuum%nvac)
mtCharge = SUM(qmt(1:atoms%ntype) * atoms%neq(1:atoms%ntype))
names(1) = 'spin' ; WRITE(attributes(1),'(i0)') jspin ; lengths(1,1)=4 ; lengths(1,2)=1
names(2) = 'total' ; WRITE(attributes(2),'(f14.7)') q ; lengths(2,1)=5 ; lengths(2,2)=14
names(3) = 'interstitial' ; WRITE(attributes(3),'(f14.7)') qis ; lengths(3,1)=12 ; lengths(3,2)=14
names(4) = 'mtSpheres' ; WRITE(attributes(4),'(f14.7)') mtCharge ; lengths(4,1)=9 ; lengths(4,2)=14 names(4) = 'mtSpheres' ; WRITE(attributes(4),'(f14.7)') mtCharge ; lengths(4,1)=9 ; lengths(4,2)=14
IF(l_printData) THEN IF(l_printData) THEN
IF(input%film) THEN IF(input%film) THEN
DO i = 1, vacuum%nvac DO i = 1, vacuum%nvac
WRITE(names(4+i),'(a6,i0)') 'vacuum', i WRITE(names(4+i),'(a6,i0)') 'vacuum', i
WRITE(attributes(4+i),'(f14.7)') qvac(i) WRITE(attributes(4+i),'(f14.7)') qvac(i,jsp)
lengths(4+i,1)=7 lengths(4+i,1)=7
lengths(4+i,2)=14 lengths(4+i,2)=14
END DO END DO
...@@ -118,11 +189,8 @@ CONTAINS ...@@ -118,11 +189,8 @@ CONTAINS
CALL writeXMLElementFormPoly('spinDependentCharge',names(1:4),attributes(1:4),lengths) CALL writeXMLElementFormPoly('spinDependentCharge',names(1:4),attributes(1:4),lengths)
END IF END IF
END IF END IF
qtot = qtot + q
END DO ! loop over spins END DO ! loop over spins
DEALLOCATE (lengths)
WRITE (6,FMT=8020) qtot WRITE (6,FMT=8020) qtot
WRITE (16,FMT=8020) qtot
IF(l_printData) THEN IF(l_printData) THEN
CALL writeXMLElementFormPoly('totalCharge',(/'value'/),(/qtot/),reshape((/5,20/),(/1,2/))) CALL writeXMLElementFormPoly('totalCharge',(/'value'/),(/qtot/),reshape((/5,20/),(/1,2/)))
END IF END IF
...@@ -134,4 +202,29 @@ CONTAINS ...@@ -134,4 +202,29 @@ CONTAINS
CALL timestop("cdntot") CALL timestop("cdntot")
END SUBROUTINE cdntot END SUBROUTINE cdntot
SUBROUTINE print_cdn_inte(q, qis, qmt, qvac, qtot, qistot, hint)
use ieee_arithmetic
implicit none
REAL, INTENT(in) :: q(:), qis(:), qmt(:,:), qvac(:,:), qtot, qistot
character(len=*), intent(in), optional :: hint
integer :: n_mt
if(present(hint)) write (*,*) "DEN of ", hint
write (*,*) "q = ", q
write (*,*) "qis = ", qis
write (*,*) "qmt"
do n_mt = 1,size(qmt, dim=1)
write (*,*) "mt = ", n_mt, qmt(n_mt,:)
enddo
if(.not. any(ieee_is_nan(qvac))) then
write (*, *) "qvac", qvac
endif
write (*, *) "qtot", qtot
write (*, *) "qis_tot", qistot
write (*, *) "-------------------------"
END SUBROUTINE print_cdn_inte
END MODULE m_cdntot END MODULE m_cdntot
...@@ -88,14 +88,14 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st ...@@ -88,14 +88,14 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
#endif #endif
! Local Scalars ! Local Scalars
INTEGER :: ikpt,jsp_start,jsp_end,ispin,jsp INTEGER :: ikpt,ikpt_i,jsp_start,jsp_end,ispin,jsp
INTEGER :: iErr,nbands,noccbd,iType INTEGER :: iErr,nbands,noccbd,iType
INTEGER :: skip_t,skip_tt,nStart,nEnd,nbasfcn INTEGER :: skip_t,skip_tt,nbasfcn
LOGICAL :: l_orbcomprot, l_real, l_dosNdir, l_corespec LOGICAL :: l_orbcomprot, l_real, l_dosNdir, l_corespec
! Local Arrays ! Local Arrays
REAL, ALLOCATABLE :: we(:) REAL,ALLOCATABLE :: we(:),eig(:)
REAL, ALLOCATABLE :: eig(:) INTEGER,ALLOCATABLE :: ev_list(:)
REAL, ALLOCATABLE :: f(:,:,:,:),g(:,:,:,:),flo(:,:,:,:) ! radial functions REAL, ALLOCATABLE :: f(:,:,:,:),g(:,:,:,:),flo(:,:,:,:) ! radial functions
TYPE (t_lapw) :: lapw TYPE (t_lapw) :: lapw
...@@ -134,7 +134,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st ...@@ -134,7 +134,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
CALL denCoeffs%init(atoms,sphhar,jsp_start,jsp_end) CALL denCoeffs%init(atoms,sphhar,jsp_start,jsp_end)
! The last entry in denCoeffsOffdiag%init is l_fmpl. It is meant as a switch to a plot of the full magnet. ! The last entry in denCoeffsOffdiag%init is l_fmpl. It is meant as a switch to a plot of the full magnet.
! density without the atomic sphere approximation for the magnet. density. It is not completely implemented (lo's missing). ! density without the atomic sphere approximation for the magnet. density. It is not completely implemented (lo's missing).
CALL denCoeffsOffdiag%init(atoms,noco,sphhar,.FALSE.) CALL denCoeffsOffdiag%init(atoms,noco,sphhar,noco%l_mtnocopot)
CALL force%init1(input,atoms) CALL force%init1(input,atoms)
CALL orb%init(atoms,noco,jsp_start,jsp_end) CALL orb%init(atoms,noco,jsp_start,jsp_end)
...@@ -154,7 +154,6 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st ...@@ -154,7 +154,6 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
IF (mpi%irank==0) THEN IF (mpi%irank==0) THEN
WRITE (6,FMT=8000) jspin WRITE (6,FMT=8000) jspin
WRITE (16,FMT=8000) jspin
CALL openXMLElementPoly('mtCharges',(/'spin'/),(/jspin/)) CALL openXMLElementPoly('mtCharges',(/'spin'/),(/jspin/))
END IF END IF
8000 FORMAT (/,/,10x,'valence density: spin=',i2) 8000 FORMAT (/,/,10x,'valence density: spin=',i2)
...@@ -172,36 +171,28 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st ...@@ -172,36 +171,28 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
skip_tt = dot_product(enpara%skiplo(:atoms%ntype,jspin),atoms%neq(:atoms%ntype)) skip_tt = dot_product(enpara%skiplo(:atoms%ntype,jspin),atoms%neq(:atoms%ntype))
IF (noco%l_soc.OR.noco%l_noco) skip_tt = 2 * skip_tt IF (noco%l_soc.OR.noco%l_noco) skip_tt = 2 * skip_tt
ALLOCATE (we(MAXVAL(cdnvalJob%noccbd(:))))
ALLOCATE (eig(MAXVAL(cdnvalJob%noccbd(:))))
jsp = MERGE(1,jspin,noco%l_noco)
DO ikpt = cdnvalJob%ikptStart, cdnvalJob%nkptExtended, cdnvalJob%ikptIncrement jsp = MERGE(1,jspin,noco%l_noco)
IF (ikpt.GT.kpts%nkpt) THEN DO ikpt_i = 1,size(cdnvalJob%k_list)
#ifdef CPP_MPI ikpt=cdnvalJob%k_list(ikpt_i)
CALL MPI_BARRIER(mpi%mpi_comm,iErr) ! Synchronizes the RMA operations
#endif
EXIT
END IF
CALL lapw%init(input,noco, kpts,atoms,sym,ikpt,cell,.false., mpi) CALL lapw%init(input,noco, kpts,atoms,sym,ikpt,cell,.false., mpi)
skip_t = skip_tt skip_t = skip_tt
noccbd = cdnvalJob%noccbd(ikpt) ev_list=cdnvaljob%compact_ev_list(ikpt_i,banddos%dos)
nStart = cdnvalJob%nStart(ikpt) noccbd = SIZE(ev_list)
nEnd = cdnvalJob%nEnd(ikpt) we = cdnvalJob%weights(ev_list,ikpt)
we(1:noccbd) = cdnvalJob%weights(1:noccbd,ikpt) eig = results%eig(ev_list,ikpt,jsp)
eig(1:noccbd) = results%eig(nStart:nEnd,ikpt,jsp)
IF (cdnvalJob%l_evp) THEN IF (cdnvalJob%l_evp) THEN
IF (nStart > skip_tt) skip_t = 0 IF (minval(ev_list) > skip_tt) skip_t = 0
IF (nEnd <= skip_tt) skip_t = noccbd IF (maxval(ev_list) <= skip_tt) skip_t = noccbd
IF ((nStart <= skip_tt).AND.(nEnd > skip_tt)) skip_t = mod(skip_tt,noccbd) IF ((minval(ev_list) <= skip_tt).AND.(maxval(ev_list) > skip_tt)) skip_t = mod(skip_tt,noccbd)
END IF END IF
nbasfcn = MERGE(lapw%nv(1)+lapw%nv(2)+2*atoms%nlotot,lapw%nv(1)+atoms%nlotot,noco%l_noco) nbasfcn = MERGE(lapw%nv(1)+lapw%nv(2)+2*atoms%nlotot,lapw%nv(1)+atoms%nlotot,noco%l_noco)
CALL zMat%init(l_real,nbasfcn,noccbd) CALL zMat%init(l_real,nbasfcn,noccbd)
CALL read_eig(eig_id,ikpt,jsp,n_start=nStart,n_end=nEnd,neig=nbands,zmat=zMat) CALL read_eig(eig_id,ikpt,jsp,list=ev_list,neig=nbands,zmat=zMat)
#ifdef CPP_MPI #ifdef CPP_MPI
CALL MPI_BARRIER(mpi%mpi_comm,iErr) ! Synchronizes the RMA operations CALL MPI_BARRIER(mpi%mpi_comm,iErr) ! Synchronizes the RMA operations
#endif #endif
...@@ -214,13 +205,13 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st ...@@ -214,13 +205,13 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
IF (.NOT.((jspin.EQ.2).AND.noco%l_noco)) THEN IF (.NOT.((jspin.EQ.2).AND.noco%l_noco)) THEN
! valence density in the interstitial region ! valence density in the interstitial region
CALL pwden(stars,kpts,banddos,oneD,input,mpi,noco,cell,atoms,sym,ikpt,& CALL pwden(stars,kpts,banddos,oneD,input,mpi,noco,cell,atoms,sym,ikpt,&
jspin,lapw,noccbd,we,eig,den,results,force%f_b8,zMat,dos) jspin,lapw,noccbd,ev_list,we,eig,den,results,force%f_b8,zMat,dos)
! charge of each valence state in this k-point of the SBZ in the layer interstitial region of the film ! charge of each valence state in this k-point of the SBZ in the layer interstitial region of the film
IF (l_dosNdir.AND.PRESENT(slab)) CALL q_int_sl(jspin,ikpt,stars,atoms,sym,cell,noccbd,lapw,slab,oneD,zMat) IF (l_dosNdir.AND.PRESENT(slab)) CALL q_int_sl(jspin,ikpt,stars,atoms,sym,cell,noccbd,ev_list,lapw,slab,oneD,zMat)
! valence density in the vacuum region ! valence density in the vacuum region
IF (input%film) THEN IF (input%film) THEN
CALL vacden(vacuum,dimension,stars,oneD, kpts,input,sym,cell,atoms,noco,banddos,& CALL vacden(vacuum,dimension,stars,oneD, kpts,input,sym,cell,atoms,noco,banddos,&
gVacMap,we,ikpt,jspin,vTot%vacz(:,:,jspin),noccbd,lapw,enpara%evac,eig,den,zMat,dos) gVacMap,we,ikpt,jspin,vTot%vacz(:,:,jspin),noccbd,ev_list,lapw,enpara%evac,eig,den,zMat,dos)
END IF END IF
END IF END IF
IF (input%film) CALL regCharges%sumBandsVac(vacuum,dos,noccbd,ikpt,jsp_start,jsp_end,eig,we) IF (input%film) CALL regCharges%sumBandsVac(vacuum,dos,noccbd,ikpt,jsp_start,jsp_end,eig,we)
...@@ -236,21 +227,20 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st ...@@ -236,21 +227,20 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
! perform Brillouin zone integration and summation over the ! perform Brillouin zone integration and summation over the
! bands in order to determine the energy parameters for each atom and angular momentum ! bands in order to determine the energy parameters for each atom and angular momentum
CALL eparas(ispin,atoms,noccbd,mpi,ikpt,noccbd,we,eig,& CALL eparas(ispin,atoms,noccbd,ev_list,mpi,ikpt,noccbd,we,eig,&
skip_t,cdnvalJob%l_evp,eigVecCoeffs,usdus,regCharges,dos,banddos%l_mcd,mcd) skip_t,cdnvalJob%l_evp,eigVecCoeffs,usdus,regCharges,dos,banddos%l_mcd,mcd)
IF (noco%l_mperp.AND.(ispin==jsp_end)) CALL qal_21(dimension,atoms,input,noccbd,noco,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos) IF (noco%l_mperp.AND.(ispin==jsp_end)) CALL qal_21(dimension,atoms,input,noccbd,ev_list,noco,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos)
! layer charge of each valence state in this k-point of the SBZ from the mt-sphere region of the film ! layer charge of each valence state in this k-point of the SBZ from the mt-sphere region of the film
IF (l_dosNdir) THEN IF (l_dosNdir) THEN
IF (PRESENT(slab)) CALL q_mt_sl(ispin,atoms,noccbd,ikpt,noccbd,skip_t,noccbd,eigVecCoeffs,usdus,slab) IF (PRESENT(slab)) CALL q_mt_sl(ispin,atoms,noccbd,ev_list,ikpt,noccbd,skip_t,noccbd,eigVecCoeffs,usdus,slab)
INQUIRE (file='orbcomprot',exist=l_orbcomprot)
IF (l_orbcomprot) CALL abcrot2(atoms,noccbd,eigVecCoeffs,ispin) ! rotate ab-coeffs
IF (PRESENT(orbcomp)) CALL orb_comp(ispin,ikpt,noccbd,atoms,noccbd,usdus,eigVecCoeffs,orbcomp)
END IF
IF (banddos%l_orb.AND.ANY((/banddos%alpha,banddos%beta,banddos%gamma/).NE.0.0)) THEN
CALL abcrot2(atoms,banddos,noccbd,eigVecCoeffs,ispin) ! rotate ab-coeffs
IF (PRESENT(orbcomp)) CALL orb_comp(ispin,ikpt,noccbd,ev_list,atoms,noccbd,usdus,eigVecCoeffs,orbcomp)
END IF
ENDIF
CALL calcDenCoeffs(atoms,sphhar,sym,we,noccbd,eigVecCoeffs,ispin,denCoeffs) CALL calcDenCoeffs(atoms,sphhar,sym,we,noccbd,eigVecCoeffs,ispin,denCoeffs)
IF (noco%l_soc) CALL orbmom(atoms,noccbd,we,ispin,eigVecCoeffs,orb) IF (noco%l_soc) CALL orbmom(atoms,noccbd,we,ispin,eigVecCoeffs,orb)
...@@ -274,9 +264,9 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st ...@@ -274,9 +264,9 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
END DO END DO
#endif #endif
IF (mpi%irank==0) THEN CALL cdnmt(mpi,input%jspins,atoms,sphhar,noco,jsp_start,jsp_end,&
CALL cdnmt(input%jspins,atoms,sphhar,noco,jsp_start,jsp_end,&
enpara,vTot%mt(:,0,:,:),denCoeffs,usdus,orb,denCoeffsOffdiag,moments,den%mt) enpara,vTot%mt(:,0,:,:),denCoeffs,usdus,orb,denCoeffsOffdiag,moments,den%mt)
IF (mpi%irank==0) THEN
IF (l_coreSpec) CALL corespec_ddscs(jspin,input%jspins) IF (l_coreSpec) CALL corespec_ddscs(jspin,input%jspins)
DO ispin = jsp_start,jsp_end DO ispin = jsp_start,jsp_end
IF (input%cdinf) THEN IF (input%cdinf) THEN
......
...@@ -23,7 +23,7 @@ MODULE m_eparas ...@@ -23,7 +23,7 @@ MODULE m_eparas
!*********************************************************************** !***********************************************************************
! !
CONTAINS CONTAINS
SUBROUTINE eparas(jsp,atoms,noccbd, mpi,ikpt,ne,we,eig,skip_t,l_evp,eigVecCoeffs,& SUBROUTINE eparas(jsp,atoms,noccbd,ev_list,mpi,ikpt,ne,we,eig,skip_t,l_evp,eigVecCoeffs,&
usdus,regCharges,dos,l_mcd,mcd) usdus,regCharges,dos,l_mcd,mcd)
USE m_types USE m_types
IMPLICIT NONE IMPLICIT NONE
...@@ -39,6 +39,7 @@ CONTAINS ...@@ -39,6 +39,7 @@ CONTAINS
INTEGER, INTENT (IN) :: noccbd,jsp INTEGER, INTENT (IN) :: noccbd,jsp
INTEGER, INTENT (IN) :: ne,ikpt ,skip_t INTEGER, INTENT (IN) :: ne,ikpt ,skip_t
LOGICAL, INTENT (IN) :: l_mcd,l_evp LOGICAL, INTENT (IN) :: l_mcd,l_evp
INTEGER, INTENT (IN) :: ev_list(noccbd)
! .. ! ..
! .. Array Arguments .. ! .. Array Arguments ..
REAL, INTENT (IN) :: eig(:)!(dimension%neigd), REAL, INTENT (IN) :: eig(:)!(dimension%neigd),
...@@ -98,7 +99,7 @@ CONTAINS ...@@ -98,7 +99,7 @@ CONTAINS
DO icore = 1, mcd%ncore(n) DO icore = 1, mcd%ncore(n)
DO ipol = 1, 3 DO ipol = 1, 3
index = 3*(n-1) + ipol index = 3*(n-1) + ipol
mcd%mcd(index,icore,i,ikpt,jsp)=mcd%mcd(index,icore,i,ikpt,jsp) + fac*(& mcd%mcd(index,icore,ev_list(i),ikpt,jsp)=mcd%mcd(index,icore,ev_list(i),ikpt,jsp) + fac*(&
suma * CONJG(mcd%m_mcd(icore,lm+1,index,1))*mcd%m_mcd(icore,lm+1,index,1) +& suma * CONJG(mcd%m_mcd(icore,lm+1,index,1))*mcd%m_mcd(icore,lm+1,index,1) +&
sumb * CONJG(mcd%m_mcd(icore,lm+1,index,2))*mcd%m_mcd(icore,lm+1,index,2) +& sumb * CONJG(mcd%m_mcd(icore,lm+1,index,2))*mcd%m_mcd(icore,lm+1,index,2) +&
sumab* CONJG(mcd%m_mcd(icore,lm+1,index,2))*mcd%m_mcd(icore,lm+1,index,1) +& sumab* CONJG(mcd%m_mcd(icore,lm+1,index,2))*mcd%m_mcd(icore,lm+1,index,1) +&
...@@ -107,7 +108,7 @@ CONTAINS ...@@ -107,7 +108,7 @@ CONTAINS
ENDDO ENDDO
ENDIF ! end MCD ENDIF ! end MCD
ENDDO ENDDO
dos%qal(l,n,i,ikpt,jsp) = (suma+sumb*usdus%ddn(l,n,jsp))/atoms%neq(n) dos%qal(l,n,ev_list(i),ikpt,jsp) = (suma+sumb*usdus%ddn(l,n,jsp))/atoms%neq(n)
ENDDO ENDDO
nt1 = nt1 + atoms%neq(n) nt1 = nt1 + atoms%neq(n)
ENDDO ENDDO
...@@ -120,8 +121,8 @@ CONTAINS ...@@ -120,8 +121,8 @@ CONTAINS
DO l = 0,3 DO l = 0,3
DO n = 1,atoms%ntype DO n = 1,atoms%ntype
DO i = (skip_t+1),noccbd DO i = (skip_t+1),noccbd
regCharges%ener(l,n,jsp) = regCharges%ener(l,n,jsp) + dos%qal(l,n,i,ikpt,jsp)*we(i)*eig(i) regCharges%ener(l,n,jsp) = regCharges%ener(l,n,jsp) + dos%qal(l,n,ev_list(i),ikpt,jsp)*we(i)*eig(i)
regCharges%sqal(l,n,jsp) = regCharges%sqal(l,n,jsp) + dos%qal(l,n,i,ikpt,jsp)*we(i) regCharges%sqal(l,n,jsp) = regCharges%sqal(l,n,jsp) + dos%qal(l,n,ev_list(i),ikpt,jsp)*we(i)
ENDDO ENDDO
ENDDO ENDDO
ENDDO ENDDO
...@@ -174,7 +175,7 @@ CONTAINS ...@@ -174,7 +175,7 @@ CONTAINS
! llo > 3 used for unoccupied states only ! llo > 3 used for unoccupied states only
IF( l .GT. 3 ) CYCLE IF( l .GT. 3 ) CYCLE
DO i = 1,ne DO i = 1,ne
dos%qal(l,ntyp,i,ikpt,jsp)= dos%qal(l,ntyp,i,ikpt,jsp) + ( 1.0/atoms%neq(ntyp) )* (& dos%qal(l,ntyp,ev_list(i),ikpt,jsp)= dos%qal(l,ntyp,ev_list(i),ikpt,jsp) + ( 1.0/atoms%neq(ntyp) )* (&
qaclo(i,lo,ntyp)*usdus%uulon(lo,ntyp,jsp)+qbclo(i,lo,ntyp)*usdus%dulon(lo,ntyp,jsp) ) qaclo(i,lo,ntyp)*usdus%uulon(lo,ntyp,jsp)+qbclo(i,lo,ntyp)*usdus%dulon(lo,ntyp,jsp) )
END DO END DO
DO lop = 1,atoms%nlo(ntyp) DO lop = 1,atoms%nlo(ntyp)
...@@ -182,7 +183,7 @@ CONTAINS ...@@ -182,7 +183,7 @@ CONTAINS
DO i = 1,ne DO i = 1,ne
regCharges%enerlo(lo,ntyp,jsp) = regCharges%enerlo(lo,ntyp,jsp) +qlo(i,lop,lo,ntyp)*we(i)*eig(i) regCharges%enerlo(lo,ntyp,jsp) = regCharges%enerlo(lo,ntyp,jsp) +qlo(i,lop,lo,ntyp)*we(i)*eig(i)
regCharges%sqlo(lo,ntyp,jsp) = regCharges%sqlo(lo,ntyp,jsp) + qlo(i,lop,lo,ntyp)*we(i) regCharges%sqlo(lo,ntyp,jsp) = regCharges%sqlo(lo,ntyp,jsp) + qlo(i,lop,lo,ntyp)*we(i)
dos%qal(l,ntyp,i,ikpt,jsp)= dos%qal(l,ntyp,i,ikpt,jsp) + ( 1.0/atoms%neq(ntyp) ) *& dos%qal(l,ntyp,ev_list(i),ikpt,jsp)= dos%qal(l,ntyp,ev_list(i),ikpt,jsp) + ( 1.0/atoms%neq(ntyp) ) *&
qlo(i,lop,lo,ntyp)*usdus%uloulopn(lop,lo,ntyp,jsp) qlo(i,lop,lo,ntyp)*usdus%uloulopn(lop,lo,ntyp,jsp)
ENDDO ENDDO
ENDIF ENDIF
......
...@@ -34,7 +34,7 @@ SUBROUTINE genNewNocoInp(input,atoms,noco,noco_new) ...@@ -34,7 +34,7 @@ SUBROUTINE genNewNocoInp(input,atoms,noco,noco_new)
alphdiff = 2.0*pi_const*(noco%qss(1)*atoms%taual(1,iAtom) + & alphdiff = 2.0*pi_const*(noco%qss(1)*atoms%taual(1,iAtom) + &
noco%qss(2)*atoms%taual(2,iAtom) + & noco%qss(2)*atoms%taual(2,iAtom) + &
noco%qss(3)*atoms%taual(3,iAtom) ) noco%qss(3)*atoms%taual(3,iAtom) )
noco_new%alph(iType) = noco%alph(iType) - alphdiff noco_new%alph(iType) = noco_new%alph(iType) - alphdiff
DO WHILE (noco_new%alph(iType) > +pi_const) DO WHILE (noco_new%alph(iType) > +pi_const)
noco_new%alph(iType)= noco_new%alph(iType) - 2.0*pi_const noco_new%alph(iType)= noco_new%alph(iType) - 2.0*pi_const
END DO END DO
...@@ -42,12 +42,12 @@ SUBROUTINE genNewNocoInp(input,atoms,noco,noco_new) ...@@ -42,12 +42,12 @@ SUBROUTINE genNewNocoInp(input,atoms,noco,noco_new)
noco_new%alph(iType)= noco_new%alph(iType) + 2.0*pi_const noco_new%alph(iType)= noco_new%alph(iType) + 2.0*pi_const
END DO END DO
ELSE ELSE
noco_new%alph(iType) = noco%alph(iType) noco_new%alph(iType) = noco_new%alph(iType)
END IF END IF
iatom= iatom + atoms%neq(iType) iatom= iatom + atoms%neq(iType)
END DO END DO
OPEN (24,file='nocoinp',form='formatted', status='old') OPEN (24,file='nocoinp',form='formatted', status='unknown')
REWIND (24) REWIND (24)
CALL rw_noco_write(atoms,noco_new, input) CALL rw_noco_write(atoms,noco_new, input)
CLOSE (24) CLOSE (24)
......
...@@ -57,11 +57,9 @@ CONTAINS ...@@ -57,11 +57,9 @@ CONTAINS
my = 2*AIMAG(qa21(itype)) my = 2*AIMAG(qa21(itype))
mz = chmom(itype,1) - chmom(itype,2) mz = chmom(itype,1) - chmom(itype,2)
WRITE (6,8025) mx,my WRITE (6,8025) mx,my
WRITE (16,8025) mx,my
!---> determine the polar angles of the moment vector in the local frame !---> determine the polar angles of the moment vector in the local frame
CALL pol_angle(mx,my,mz,betah,alphh) CALL pol_angle(mx,my,mz,betah,alphh)
WRITE (6,8026) betah,alphh WRITE (6,8026) betah,alphh
WRITE (16,8026) betah,alphh
8025 FORMAT(2x,'--> local frame: ','mx=',f9.5,' my=',f9.5) 8025 FORMAT(2x,'--> local frame: ','mx=',f9.5,' my=',f9.5)
8026 FORMAT(2x,'-->',10x,' delta beta=',f9.5,& 8026 FORMAT(2x,'-->',10x,' delta beta=',f9.5,&
& ' delta alpha=',f9.5) & ' delta alpha=',f9.5)
...@@ -79,9 +77,7 @@ CONTAINS ...@@ -79,9 +77,7 @@ CONTAINS
mz = rho11 - rho22 mz = rho11 - rho22
CALL pol_angle(mx,my,mz,betah,alphh) CALL pol_angle(mx,my,mz,betah,alphh)
WRITE (6,8027) noco%beta(itype),noco%alph(itype)-alphdiff WRITE (6,8027) noco%beta(itype),noco%alph(itype)-alphdiff
WRITE (16,8027) noco%beta(itype),noco%alph(itype)-alphdiff
WRITE (6,8028) betah,alphh-alphdiff WRITE (6,8028) betah,alphh-alphdiff
WRITE (16,8028) betah,alphh-alphdiff
8027 FORMAT(2x,'-->',10x,' input noco%beta=',f9.5, ' input noco%alpha=',f9.5) 8027 FORMAT(2x,'-->',10x,' input noco%beta=',f9.5, ' input noco%alpha=',f9.5)
8028 FORMAT(2x,'-->',10x,'output noco%beta=',f9.5, ' output noco%alpha=',f9.5) 8028 FORMAT(2x,'-->',10x,'output noco%beta=',f9.5, ' output noco%alpha=',f9.5)
...@@ -96,7 +92,6 @@ CONTAINS ...@@ -96,7 +92,6 @@ CONTAINS
my_mix = 2*AIMAG(rho21) my_mix = 2*AIMAG(rho21)
mz_mix = rho11 - rho22 mz_mix = rho11 - rho22
WRITE (6,8031) mx_mix,my_mix WRITE (6,8031) mx_mix,my_mix
WRITE (16,8031) mx_mix,my_mix
8031 FORMAT(2x,'--> global frame: ','mixed mx=',f9.5,' mixed my=',f9.5) 8031 FORMAT(2x,'--> global frame: ','mixed mx=',f9.5,' mixed my=',f9.5)
! if magnetic moment (in local frame!) is negative, direction of quantization ! if magnetic moment (in local frame!) is negative, direction of quantization
! has to be antiparallel! ! has to be antiparallel!
...@@ -109,7 +104,6 @@ CONTAINS ...@@ -109,7 +104,6 @@ CONTAINS
! calculate angles alpha and beta in global frame ! calculate angles alpha and beta in global frame
CALL pol_angle(mx_mix,my_mix,mz_mix,betah,alphh) CALL pol_angle(mx_mix,my_mix,mz_mix,betah,alphh)
WRITE (6,8029) betah,alphh-alphdiff WRITE (6,8029) betah,alphh-alphdiff
WRITE (16,8029) betah,alphh-alphdiff
8029 FORMAT(2x,'-->',10x,' new noco%beta =',f9.5, ' new noco%alpha =',f9.5) 8029 FORMAT(2x,'-->',10x,' new noco%beta =',f9.5, ' new noco%alpha =',f9.5)
noco%alph(itype) = alphh noco%alph(itype) = alphh
noco%beta(itype) = betah noco%beta(itype) = betah
...@@ -129,9 +123,7 @@ CONTAINS ...@@ -129,9 +123,7 @@ CONTAINS
b_con_outy = scale*my b_con_outy = scale*my
!---> mix input and output constraint fields !---> mix input and output constraint fields
WRITE (6,8100) noco%b_con(1,itype),noco%b_con(2,itype) WRITE (6,8100) noco%b_con(1,itype),noco%b_con(2,itype)
WRITE (16,8100) noco%b_con(1,itype),noco%b_con(2,itype)
WRITE (6,8200) b_con_outx,b_con_outy WRITE (6,8200) b_con_outx,b_con_outy
WRITE (16,8200) b_con_outx,b_con_outy
noco%b_con(1,itype) = noco%b_con(1,itype) + noco%mix_b*b_con_outx noco%b_con(1,itype) = noco%b_con(1,itype) + noco%mix_b*b_con_outx
noco%b_con(2,itype) = noco%b_con(2,itype) + noco%mix_b*b_con_outy noco%b_con(2,itype) = noco%b_con(2,itype) + noco%mix_b*b_con_outy
ENDIF ENDIF
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
MODULE m_pwden MODULE m_pwden
CONTAINS