Commit aca1fd1f authored by Matthias Redies's avatar Matthias Redies

Merge branch 'MetaGGA' into 'develop'

Meta gga

See merge request fleur/fleur!27
parents efbb4037 596be481
......@@ -4,7 +4,7 @@ MODULE m_cdntot
! vacuum, and mt regions c.l.fu
! ********************************************************
CONTAINS
SUBROUTINE cdntot_integrate(stars,atoms,sym,vacuum,input,cell,oneD, integrand, &
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
......@@ -72,7 +72,7 @@ CONTAINS
q(jsp) = q(jsp) + qis(jsp)
qtot = qtot + q(jsp)
END DO ! loop over spins
END SUBROUTINE cdntot_integrate
END SUBROUTINE integrate_cdn
SUBROUTINE cdntot(stars,atoms,sym,vacuum,input,cell,oneD,&
den,l_printData,qtot,qistot)
......@@ -108,11 +108,9 @@ CONTAINS
REAL qmt(atoms%ntype,input%jspins),qvac(2,input%jspins)
INTEGER, ALLOCATABLE :: lengths(:,:)
CHARACTER(LEN=20) :: attributes(6), names(6)
CALL timestart("cdntot")
call cdntot_integrate(stars,atoms,sym,vacuum,input,cell,oneD, den, &
call integrate_cdn(stars,atoms,sym,vacuum,input,cell,oneD, den, &
q, qis, qmt, qvac, qtot, qistot)
IF (input%film) THEN
......
......@@ -9,7 +9,7 @@ MODULE m_cdncore
CONTAINS
SUBROUTINE cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,&
stars,cell,sphhar,atoms,vTot,outDen,moments,results)
stars,cell,sphhar,atoms,vTot,outDen,moments,results, EnergyDen)
USE m_constants
USE m_judft
......@@ -28,21 +28,22 @@ SUBROUTINE cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,&
IMPLICIT NONE
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_dimension), INTENT(IN) :: dimension
TYPE(t_oneD), INTENT(IN) :: oneD
TYPE(t_input), INTENT(IN) :: input
TYPE(t_vacuum), INTENT(IN) :: vacuum
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_stars), INTENT(IN) :: stars
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_sphhar), INTENT(IN) :: sphhar
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_potden), INTENT(IN) :: vTot
TYPE(t_potden), INTENT(INOUT) :: outDen
TYPE(t_moments), INTENT(INOUT) :: moments
TYPE(t_results), INTENT(INOUT) :: results
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_dimension), INTENT(IN) :: dimension
TYPE(t_oneD), INTENT(IN) :: oneD
TYPE(t_input), INTENT(IN) :: input
TYPE(t_vacuum), INTENT(IN) :: vacuum
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_stars), INTENT(IN) :: stars
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_sphhar), INTENT(IN) :: sphhar
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_potden), INTENT(IN) :: vTot
TYPE(t_potden), INTENT(INOUT) :: outDen
TYPE(t_moments), INTENT(INOUT) :: moments
TYPE(t_results), INTENT(INOUT) :: results
TYPE(t_potden), INTENT(INOUT), OPTIONAL :: EnergyDen
INTEGER :: jspin, n, iType
REAL :: seig, rhoint, momint
......@@ -53,8 +54,9 @@ SUBROUTINE cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,&
REAL :: tec(atoms%ntype,input%jspins)
REAL :: rhTemp(dimension%msh,atoms%ntype,input%jspins)
results%seigc = 0.0
IF (mpi%irank.EQ.0) THEN
IF (mpi%irank==0) THEN
DO jspin = 1,input%jspins
DO n = 1,atoms%ntype
moments%svdn(n,jspin) = outDen%mt(1,0,n,jspin) / (sfp_const*atoms%rmsh(1,n)*atoms%rmsh(1,n))
......@@ -62,10 +64,10 @@ SUBROUTINE cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,&
END DO
END IF
IF (input%kcrel.EQ.0) THEN
IF (input%kcrel==0) THEN
! Generate input file ecore for subsequent GW calculation
! 11.2.2004 Arno Schindlmayr
IF ((input%gw.eq.1 .or. input%gw.eq.3).AND.(mpi%irank.EQ.0)) THEN
IF ((input%gw==1 .or. input%gw==3).AND.(mpi%irank==0)) THEN
OPEN (15,file='ecore',status='unknown', action='write',form='unformatted')
END IF
......@@ -73,7 +75,7 @@ SUBROUTINE cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,&
tec = 0.0
qint = 0.0
IF (input%frcor) THEN
IF (mpi%irank.EQ.0) THEN
IF (mpi%irank==0) THEN
CALL readCoreDensity(input,atoms,dimension,rh,tec,qint)
END IF
#ifdef CPP_MPI
......@@ -83,51 +85,60 @@ SUBROUTINE cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,&
END IF
!add in core density
IF (mpi%irank.EQ.0) THEN
IF (input%kcrel.EQ.0) THEN
IF (mpi%irank==0) THEN
IF (input%kcrel==0) THEN
DO jspin = 1,input%jspins
CALL cored(input,jspin,atoms,outDen%mt,dimension,sphhar,vTot%mt(:,0,:,jspin), qint,rh,tec,seig)
IF(PRESENT(EnergyDen)) THEN
CALL cored(input,jspin,atoms,outDen%mt,dimension,sphhar,vTot%mt(:,0,:,jspin), qint,rh ,tec,seig, EnergyDen%mt)
ELSE
CALL cored(input,jspin,atoms,outDen%mt,dimension,sphhar,vTot%mt(:,0,:,jspin), qint,rh ,tec,seig)
ENDIF
rhTemp(:,:,jspin) = rh(:,:,jspin)
results%seigc = results%seigc + seig
END DO
ELSE
IF(PRESENT(EnergyDen)) call juDFT_error("Energyden not implemented for relativistic core calculations")
CALL coredr(input,atoms,seig, outDen%mt,dimension,sphhar,vTot%mt(:,0,:,:),qint,rh)
results%seigc = results%seigc + seig
END IF
END IF
DO jspin = 1,input%jspins
IF (mpi%irank.EQ.0) THEN
IF (mpi%irank==0) THEN
DO n = 1,atoms%ntype
moments%stdn(n,jspin) = outDen%mt(1,0,n,jspin) / (sfp_const*atoms%rmsh(1,n)*atoms%rmsh(1,n))
END DO
END IF
IF ((noco%l_noco).AND.(mpi%irank.EQ.0)) THEN
IF (jspin.EQ.2) THEN
IF ((noco%l_noco).AND.(mpi%irank==0)) THEN
IF (jspin==2) THEN
IF(PRESENT(EnergyDen)) call juDFT_error("Energyden not implemented for noco")
!pk non-collinear (start)
!add the coretail-charge to the constant interstitial
!charge (star 0), taking into account the direction of
!magnetisation of this atom
DO iType = 1,atoms%ntype
rhoint = (qint(iType,1) + qint(iType,2)) /cell%volint/input%jspins/2.0
momint = (qint(iType,1) - qint(iType,2)) /cell%volint/input%jspins/2.0
rhoint = (qint(iType,1) + qint(iType,2)) /(cell%volint * input%jspins * 2.0)
momint = (qint(iType,1) - qint(iType,2)) /(cell%volint * input%jspins * 2.0)
!rho_11
outDen%pw(1,1) = outDen%pw(1,1) + rhoint + momint*cos(noco%beta(iType))
!rho_22
outDen%pw(1,2) = outDen%pw(1,2) + rhoint - momint*cos(noco%beta(iType))
!real part rho_21
outDen%pw(1,3) = outDen%pw(1,3) + cmplx(0.5*momint *cos(noco%alph(iType))*sin(noco%beta(iType)),0.0)
outDen%pw(1,3) = outDen%pw(1,3) + cmplx( 0.5*momint *cos(noco%alph(iType))*sin(noco%beta(iType)),&
!imaginary part rho_21
outDen%pw(1,3) = outDen%pw(1,3) + cmplx(0.0,-0.5*momint *sin(noco%alph(iType))*sin(noco%beta(iType)))
-0.5*momint *sin(noco%alph(iType))*sin(noco%beta(iType)))
END DO
!pk non-collinear (end)
END IF
ELSE
IF (input%ctail) THEN
IF(PRESENT(EnergyDen)) call juDFT_error("Energyden not implemented for ctail")
!+gu hope this works as well
CALL cdnovlp(mpi,sphhar,stars,atoms,sym,dimension,vacuum,&
cell,input,oneD,l_st,jspin,rh(:,:,jspin),&
outDen%pw,outDen%vacxy,outDen%mt,outDen%vacz)
ELSE IF (mpi%irank.EQ.0) THEN
ELSE IF (mpi%irank==0) THEN
DO iType = 1,atoms%ntype
outDen%pw(1,jspin) = outDen%pw(1,jspin) + qint(iType,jspin) / (input%jspins * cell%volint)
END DO
......@@ -135,11 +146,11 @@ SUBROUTINE cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,&
END IF
END DO
IF (input%kcrel.EQ.0) THEN
IF (mpi%irank.EQ.0) THEN
IF (input%kcrel==0) THEN
IF (mpi%irank==0) THEN
CALL writeCoreDensity(input,atoms,dimension,rhTemp,tec,qint)
END IF
IF ((input%gw.eq.1 .or. input%gw.eq.3).AND.(mpi%irank.EQ.0)) CLOSE(15)
IF ((input%gw==1 .or. input%gw==3).AND.(mpi%irank==0)) CLOSE(15)
END IF
END SUBROUTINE cdncore
......
......@@ -18,7 +18,7 @@ if (${CMAKE_Fortran_COMPILER_ID} MATCHES "Intel")
endif()
set(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE} -xHost -O2 -g")
if (${CMAKE_Fortran_COMPILER_VERSION} VERSION_LESS "19.0.0.0")
set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -C -traceback -O0 -g -ftrapuv -check uninit -check pointers -DCPP_DEBUG")
set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -C -traceback -O0 -g -ftrapuv -check uninit -check pointers -DCPP_DEBUG -warn=all")
else()
set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -CB -traceback -O0 -g -ftrapuv -check uninit -check pointers -DCPP_DEBUG")
endif()
......@@ -50,7 +50,7 @@ elseif(${CMAKE_Fortran_COMPILER_ID} MATCHES "GNU")
if (${CMAKE_Fortran_COMPILER_VERSION} VERSION_LESS "6.1.0")
message(FATAL_ERROR "Only modern versions of gfortran >6.3 will be able to compile FLEUR\nYou need to specify a different compiler.\nSee the docs at www.flapw.de.\n")
endif()
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -ffree-line-length-none -fopenmp ")
set(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE} -O2")
set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -fdump-core -Wall -Wextra -Warray-temporaries -fbacktrace -fcheck=all -finit-real=nan -O0 -g -DCPP_DEBUG")
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -ffree-line-length-none -fopenmp -fdefault-real-8 -Wno-missing-include-dirs")
set(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE} -O2 -g")
set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -fdump-core -Wall -Wextra -Wno-array-temporaries -fbacktrace -fcheck=all -finit-real=nan -O0 -g -DCPP_DEBUG")
endif()
MODULE m_cored
CONTAINS
SUBROUTINE cored(&
& input,jspin,atoms,&
& rho,DIMENSION,&
& sphhar,&
& vr,&
& qint,rhc,tec,seig)
SUBROUTINE cored(input, jspin, atoms, rho, DIMENSION, sphhar, vr, qint, rhc, tec, seig, EnergyDen)
! *******************************************************
! ***** set up the core densities for compounds. *****
! ***** d.d.koelling *****
......@@ -29,26 +23,29 @@ CONTAINS
REAL, INTENT (OUT) :: seig
! ..
! .. Array Arguments ..
REAL, INTENT(IN) :: vr(atoms%jmtd,atoms%ntype)
REAL, INTENT(INOUT) :: rho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins)
REAL, INTENT(INOUT) :: rhc(DIMENSION%msh,atoms%ntype,input%jspins)
REAL, INTENT(INOUT) :: qint(atoms%ntype,input%jspins)
REAL, INTENT(INOUT) :: tec(atoms%ntype,input%jspins)
REAL, INTENT(IN) :: vr(atoms%jmtd,atoms%ntype)
REAL, INTENT(INOUT) :: rho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins)
REAL, INTENT(INOUT) :: rhc(DIMENSION%msh,atoms%ntype,input%jspins)
REAL, INTENT(INOUT) :: qint(atoms%ntype,input%jspins)
REAL, INTENT(INOUT) :: tec(atoms%ntype,input%jspins)
REAL, INTENT(INOUT), OPTIONAL :: EnergyDen(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins)
! ..
! .. Local Scalars ..
REAL e,fj,fl,fn,q,rad,rhos,rhs,sea,sume,t2
REAL d,dxx,rn,rnot,z,t1,rr,r,lambd,c,bmu,weight
REAL eig,fj,fl,fn,q,rad,rhos,rhs,sea,sume,t2
REAL d,dxx,rn,rnot,z,t1,rr,r,lambd,c,bmu,weight, aux_weight
INTEGER i,j,jatom,korb,n,ncmsh,nm,nm1,nst ,l,ierr
! ..
! .. Local Arrays ..
REAL rhcs(DIMENSION%msh),rhoc(DIMENSION%msh),rhoss(DIMENSION%msh),vrd(DIMENSION%msh),f(0:3)
REAL rhcs_aux(DIMENSION%msh), rhoss_aux(DIMENSION%msh) !> quantities for energy density calculations
REAL occ(DIMENSION%nstd),a(DIMENSION%msh),b(DIMENSION%msh),ain(DIMENSION%msh),ahelp(DIMENSION%msh)
REAL occ_h(DIMENSION%nstd,2)
INTEGER kappa(DIMENSION%nstd),nprnc(DIMENSION%nstd)
CHARACTER(LEN=20) :: attributes(6)
REAL stateEnergies(29)
! ..
c = c_light(1.0)
seig = 0.
!
......@@ -97,7 +94,8 @@ CONTAINS
rn = rnot* (d** (ncmsh-1))
WRITE (6,FMT=8000) z,rnot,dxx,atoms%jri(jatom)
DO j = 1,atoms%jri(jatom)
rhoss(j) = 0.
rhoss(j) = 0.0
if(present(EnergyDen)) rhoss_aux(j) = 0.0
vrd(j) = vr(j,jatom)
ENDDO
!
......@@ -114,6 +112,7 @@ CONTAINS
IF ( atoms%jri(jatom) < ncmsh) THEN
DO i = atoms%jri(jatom) + 1,ncmsh
rhoss(i) = 0.
if(present(EnergyDen)) rhoss_aux(i) = 0.0
IF (input%l_core_confpot) THEN
rr = d*rr
vrd(i) = rr*( t2 + rr*t1 )
......@@ -135,22 +134,36 @@ CONTAINS
IF (occ(korb) /= 0.0) THEN
fn = nprnc(korb)
fj = iabs(kappa(korb)) - .5e0
weight = 2*fj + 1.e0
IF (bmu > 99.) weight = occ(korb)
fl = fj + (.5e0)*isign(1,kappa(korb))
e = -2* (z/ (fn+fl))**2
CALL differ(fn,fl,fj,c,z,dxx,rnot,rn,d,ncmsh,vrd, e, a,b,ierr)
stateEnergies(korb) = e
WRITE (6,FMT=8010) fn,fl,fj,e,weight
eig = -2* (z/ (fn+fl))**2
CALL differ(fn,fl,fj,c,z,dxx,rnot,rn,d,ncmsh,vrd, eig, a,b,ierr)
stateEnergies(korb) = eig
WRITE (6,FMT=8010) fn,fl,fj,eig,weight
IF (ierr/=0) CALL juDFT_error("error in core-level routine" ,calledby ="cored")
IF (input%gw==1 .OR. input%gw==3) WRITE (15) NINT(fl),weight,e,&
IF (input%gw==1 .OR. input%gw==3) WRITE (15) NINT(fl),weight,eig,&
a(1:atoms%jri(jatom)),b(1:atoms%jri(jatom))
sume = sume + weight*e/input%jspins
sume = sume + weight*eig/input%jspins
DO j = 1,ncmsh
rhcs(j) = weight* (a(j)**2+b(j)**2)
rhcs(j) = weight* (a(j)**2+b(j)**2)
rhoss(j) = rhoss(j) + rhcs(j)
ENDDO
IF(present(EnergyDen)) THEN
!rhoss_aux = rhoss
DO j = 1,ncmsh
! for energy density we want to multiply the weights
! with the eigenenergies
rhoss_aux(j) = rhoss_aux(j) + (rhcs(j) * eig)
ENDDO
ENDIF
ENDIF
ENDDO
......@@ -162,6 +175,13 @@ CONTAINS
rho(j,0,jatom,jspin) = rho(j,0,jatom,jspin) + rhoc(j)/sfp_const
ENDDO
IF(present(EnergyDen)) then
DO j = 1,nm
EnergyDen(j,0,jatom,jspin) = EnergyDen(j,0,jatom,jspin) &
+ rhoss_aux(j) /(input%jspins * sfp_const)
ENDDO
ENDIF
rhc(1:ncmsh,jatom,jspin) = rhoss(1:ncmsh) / input%jspins
rhc(ncmsh+1:DIMENSION%msh,jatom,jspin) = 0.0
......
Subproject commit 3cb2231abf1d47fbd8b3e21c8478e9f26a73ce5f
Subproject commit ca6f7114b9fffe0964ca9e8d24e09ef15b300316
......@@ -83,6 +83,7 @@ MODULE m_constants
REAL, INTENT (IN) :: fac
c_light = 137.0359895e0 * fac
!c_light = 1e6*fac
END FUNCTION c_light
END MODULE m_constants
......@@ -175,7 +175,7 @@ SUBROUTINE initParallelProcesses(atoms,vacuum,input,stars,sliceplot,banddos,&
ALLOCATE(hybrid%select1(4,atoms%ntype),hybrid%lcutm1(atoms%ntype))
ALLOCATE(hybrid%lcutwf(atoms%ntype))
IF (xcpot%is_gga()) THEN
IF (xcpot%needs_grad()) THEN
ALLOCATE (stars%ft2_gfx(0:stars%kimax2),stars%ft2_gfy(0:stars%kimax2))
ALLOCATE (oneD%pgft1x(0:oneD%odd%nn2d-1),oneD%pgft1xx(0:oneD%odd%nn2d-1),&
oneD%pgft1xy(0:oneD%odd%nn2d-1),&
......
......@@ -38,7 +38,7 @@
oneD%igfft1(0:oneD%odd%nn2d-1,1:2) = 0
oneD%pgfft1(0:oneD%odd%nn2d-1) = 0.
IF (xcpot%is_gga()) THEN
IF (xcpot%needs_grad()) THEN
! ALLOCATE ( odg%pgfx(0:odg%nn2d-1),
! & odg%pgfy(0:odg%nn2d-1),
! & odg%pgfxx(0:odg%nn2d-1),
......@@ -125,7 +125,7 @@
oneD%pgfft1(i-1) = 1.
ENDDO
IF (xcpot%is_gga()) THEN
IF (xcpot%needs_grad()) THEN
DO i = 1,oneD%odd%nq2
kfx_1 = oneD%kv1(1,i)
kfy_1 = oneD%kv1(2,i)
......
......@@ -164,7 +164,7 @@ CONTAINS
cell,sliceplot,noco,&
stars,oneD,hybrid,kpts,a1,a2,a3,namex,relcor)
!
IF (xcpot%is_gga()) THEN
IF (xcpot%needs_grad()) THEN
ALLOCATE (stars%ft2_gfx(0:stars%kimax2),stars%ft2_gfy(0:stars%kimax2))
ALLOCATE (oneD%pgft1x(0:oneD%odd%nn2d-1),oneD%pgft1xx(0:oneD%odd%nn2d-1),&
oneD%pgft1xy(0:oneD%odd%nn2d-1),&
......
......@@ -257,7 +257,7 @@
!!$ !+guta
!!$ IF ((xcpot%icorr.EQ.-1).OR.(xcpot%icorr.GE.6)) THEN
IF (xcpot%is_gga()) THEN
IF (xcpot%needs_grad()) THEN
obsolete%ndvgrd = MAX(obsolete%ndvgrd,3)
......@@ -347,7 +347,7 @@
!
! check muffin tin radii
!
l_gga= xcpot%is_gga()
l_gga= xcpot%needs_grad()
l_test = .TRUE. ! only checking, dont use new parameters
CALL chkmt(atoms,input,vacuum,cell,oneD,l_test,l_gga,noel, kmax1,dtild,dvac1,lmax1,jri1,rmt1,dx1)
......
......@@ -486,7 +486,7 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,obsolete,kpts
ENDIF
! Missing xc functionals initializations
IF (xcpot%is_gga()) THEN
IF (xcpot%needs_grad()) THEN
ALLOCATE (stars%ft2_gfx(0:stars%kimax2),stars%ft2_gfy(0:stars%kimax2))
ALLOCATE (oneD%pgft1x(0:oneD%odd%nn2d-1),oneD%pgft1xx(0:oneD%odd%nn2d-1),&
oneD%pgft1xy(0:oneD%odd%nn2d-1),&
......
......@@ -82,7 +82,7 @@
! arltv(i) : length of reciprical lattice vector along
! direction (i)
!
IF (.NOT.xcpot%is_gga()) xcpot%gmaxxc=stars%gmax
IF (.NOT.xcpot%needs_grad()) xcpot%gmaxxc=stars%gmax
WRITE (6,'('' gmaxxc should be: 2*kmax <= gmaxxc <= gmax '')')
IF ( abs( xcpot%gmaxxc - stars%gmax ) .le. 10.0**(-6) ) THEN
WRITE (6,'('' concerning memory, you may want to choose'',&
......
......@@ -66,7 +66,7 @@ CONTAINS
!
!WRITE (*,*) ' stars are always ordered '
l_xcExtended = xcpot%is_gga()
l_xcExtended = xcpot%needs_grad()
!---> read in information if exists
CALL readStars(stars,l_xcExtended,.TRUE.,l_error)
IF(.NOT.l_error) THEN
......@@ -331,7 +331,7 @@ CONTAINS
stars%igfft2(kidx2,2) = kfft
stars%pgfft2(kidx2) = phas(n)
!+guta
IF (xcpot%is_gga()) THEN
IF (xcpot%needs_grad()) THEN
!! pgft2x: exp(i*(gfx,gfy,gfz)*tau)*gfx.
!! y y.
!! pgft2xx: exp(i*(gfx,gfy,gfz)*tau)*gfx*gfx.
......@@ -556,7 +556,7 @@ CONTAINS
!
WRITE (*,*) ' stars are always ordered '
l_xcExtended = xcpot%is_gga()
l_xcExtended = xcpot%needs_grad()
!---> read in information if exists
CALL readStars(stars,l_xcExtended,.FALSE.,l_error)
IF(.NOT.l_error) THEN
......@@ -782,7 +782,7 @@ CONTAINS
judft_error("BUG 1 in strgen")
stars%ng2 = 2 ; stars%kv2 = 0 ; stars%ig2 = 0 ; stars%kimax2= 0 ; stars%igfft2 = 0
stars%sk2 = 0.0 ; stars%pgfft2 = 0.0 ; stars%nstr2 = 0
IF (xcpot%is_gga()) THEN
IF (xcpot%needs_grad()) THEN
stars%ft2_gfx = 0.0 ; stars%ft2_gfy = 0.0
ENDIF
......
This diff is collapsed.
......@@ -317,12 +317,16 @@
</xsd:restriction>
</xsd:simpleType>
<xsd:complexType name="XCLibXCIDType">
<xsd:attribute name="exchange" type="xsd:integer" use="required"/>
<xsd:attribute name="correlation" type="xsd:integer" use="required"/>
<xsd:attribute name="exchange" type="xsd:integer" use="required"/>
<xsd:attribute name="correlation" type="xsd:integer" use="required"/>
<xsd:attribute name="etot_exchange" type="xsd:integer" use="optional"/>
<xsd:attribute name="etot_correlation" type="xsd:integer" use="optional"/>
</xsd:complexType>
<xsd:complexType name="XCLibXCNameType">
<xsd:attribute name="exchange" type="xsd:string" use="required"/>
<xsd:attribute name="correlation" type="xsd:string" use="required"/>
<xsd:attribute name="exchange" type="xsd:string" use="required"/>
<xsd:attribute name="correlation" type="xsd:string" use="required"/>
<xsd:attribute name="etot_exchange" type="xsd:string" use="optional"/>
<xsd:attribute name="etot_correlation" type="xsd:string" use="optional"/>
</xsd:complexType>
<xsd:complexType name="XCParamsType">
<xsd:attribute name="igrd" type="xsd:integer" use="required"/>
......
This diff is collapsed.
module endian_swap
implicit none
PRIVATE
PUBLIC :: Big_Endian
PUBLIC :: Swap_Endian
INTERFACE Swap_Endian
module procedure SWAP_I1
module procedure SWAP_I2
module procedure SWAP_I4
module procedure SWAP_I8
module procedure SWAP_F4
module procedure SWAP_F8
module procedure SWAP_F16
module procedure SWAP_C4
module procedure SWAP_C8
END INTERFACE Swap_Endian
CONTAINS
FUNCTION Big_Endian()
LOGICAL :: Big_Endian
Big_Endian = ichar(transfer(1,'a')) == 0
END FUNCTION Big_Endian
function SWAP_I4(input) result(output)
implicit none
integer(4), parameter :: b_sz = 4
integer(b_sz), intent(in) :: input
integer(b_sz) :: output
integer(1) :: byte_arr(b_sz), byte_arr_tmp(b_sz)
integer(1) :: i
byte_arr_tmp = transfer(input, byte_arr_tmp)
do i = 1,b_sz
byte_arr(i) = byte_arr_tmp(1 + b_sz - i)
enddo
output = transfer(byte_arr, output)
end function SWAP_I4
function SWAP_I2(input) result(output)
implicit none
integer(4), parameter :: b_sz = 2
integer(b_sz), intent(in) :: input
integer(b_sz) :: output
integer(1) :: byte_arr(b_sz), byte_arr_tmp(b_sz)
integer(1) :: i
byte_arr_tmp = transfer(input, byte_arr_tmp)
do i = 1,b_sz
byte_arr(i) = byte_arr_tmp(1 + b_sz - i)
enddo
output = transfer(byte_arr, output)
end function SWAP_I2
function SWAP_I1(input) result(output)
implicit none
integer(4), parameter :: b_sz = 1
integer(b_sz), intent(in) :: input
integer(b_sz) :: output
integer(1) :: byte_arr(b_sz), byte_arr_tmp(b_sz)
integer(1) :: i
byte_arr_tmp = transfer(input, byte_arr_tmp)
do i = 1,b_sz
byte_arr(i) = byte_arr_tmp(1 + b_sz - i)
enddo
output = transfer(byte_arr, output)
end function SWAP_I1
function SWAP_I8(input) result(output)
implicit none
integer(4), parameter :: b_sz = 8
integer(b_sz), intent(in) :: input
integer(b_sz) :: output
integer(1) :: byte_arr(b_sz), byte_arr_tmp(b_sz)
integer(1) :: i
byte_arr_tmp = transfer(input, byte_arr_tmp)
do i = 1,b_sz
byte_arr(i) = byte_arr_tmp(1 + b_sz - i)
enddo
output = transfer(byte_arr, output)
end function SWAP_I8
function SWAP_F4(input) result(output)
implicit none
integer(4), parameter :: b_sz = 4
real(b_sz), intent(in) :: input
real(b_sz) :: output
integer(1) :: byte_arr(b_sz), byte_arr_tmp(b_sz)
integer(1) :: i
byte_arr_tmp = transfer(input, byte_arr_tmp)
do i = 1,b_sz
byte_arr(i) = byte_arr_tmp(1 + b_sz - i)
enddo
output = transfer(byte_arr, output)
end function SWAP_F4
function SWAP_F8(input) result(output)
implicit none
integer(4), parameter :: b_sz = 8
real(b_sz), intent(in) :: input
real(b_sz) :: output
integer(1) :: byte_arr(b_sz), byte_arr_tmp(b_sz)
integer(1) :: i
byte_arr_tmp = transfer(input, byte_arr_tmp)
do i = 1,b_sz
byte_arr(i) = byte_arr_tmp(1 + b_sz - i)
enddo
output = transfer(byte_arr, output)
end function SWAP_F8
function SWAP_F16(input) result(output)
implicit none
integer(4), parameter :: b_sz = 16
real(b_sz), intent(in) :: input
real(b_sz) :: output
integer(1) :: byte_arr(b_sz), byte_arr_tmp(b_sz)
integer(1) :: i
byte_arr_tmp = transfer(input, byte_arr_tmp)
do i = 1,b_sz
byte_arr(i) = byte_arr_tmp(1 + b_sz - i)
enddo
output = transfer(byte_arr, output)
end function SWAP_F16
function SWAP_C8(input) result(output)
implicit none