diff --git a/init/old_inp/fleur_init_old.F90 b/init/old_inp/fleur_init_old.F90
index fe64022a97582ee9d34403a0e7d6db2822e20639..2c7f0a2bd4fd7625535ce562488d3a353d9fe95f 100644
--- a/init/old_inp/fleur_init_old.F90
+++ b/init/old_inp/fleur_init_old.F90
@@ -184,7 +184,7 @@ CONTAINS
INQUIRE(file="cdn1",exist=l_opti)
IF (noco%l_noco) INQUIRE(file="rhomat_inp",exist=l_opti)
l_opti=.NOT.l_opti
- IF ((sliceplot%iplot).OR.(input%strho).OR.(input%swsp).OR.&
+ IF ((sliceplot%iplot.NE.0).OR.(input%strho).OR.(input%swsp).OR.&
& (input%lflip).OR.(input%l_bmt)) l_opti = .TRUE.
!
diff --git a/init/old_inp/setup.f90 b/init/old_inp/setup.f90
index c83f9eabc54746bcc575fd901eca79f42883018d..e0421d34cfb703444e283b90a591ad0b716231f4 100644
--- a/init/old_inp/setup.f90
+++ b/init/old_inp/setup.f90
@@ -173,7 +173,7 @@
!
ENDIF ! (mpi%irank == 0)
CALL stepf(sym,stars,atoms,oneD, input,cell, vacuum,mpi)
- IF (.NOT.sliceplot%iplot) THEN
+ IF (sliceplot%iplot.EQ.0) THEN
IF ( mpi%irank == 0 ) THEN
CALL convn(DIMENSION,atoms,stars)
diff --git a/init/postprocessInput.F90 b/init/postprocessInput.F90
index 2f89d5f0bdeca4a7d70fd63ef02b51f17e4fc6ab..ed5ddf0edc259cd5ae6aae697ff32f277f9a981c 100644
--- a/init/postprocessInput.F90
+++ b/init/postprocessInput.F90
@@ -523,7 +523,7 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,obsolete,kpts
INQUIRE(file="cdn1",exist=l_opti)
if (noco%l_noco) INQUIRE(file="rhomat_inp",exist=l_opti)
l_opti=.not.l_opti
- IF ((sliceplot%iplot).OR.(input%strho).OR.(input%swsp).OR.&
+ IF ((sliceplot%iplot.NE.0).OR.(input%strho).OR.(input%swsp).OR.&
(input%lflip).OR.(input%l_bmt)) l_opti = .TRUE.
IF (.NOT.l_opti) THEN
@@ -546,7 +546,7 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,obsolete,kpts
CALL timestart("stepf")
CALL stepf(sym,stars,atoms,oneD,input,cell,vacuum,mpi)
CALL timestop("stepf")
- IF (.NOT.sliceplot%iplot) THEN
+ IF (sliceplot%iplot.EQ.0) THEN
IF (mpi%irank.EQ.0) THEN
CALL convn(DIMENSION,atoms,stars)
CALL e_field(atoms,DIMENSION,stars,sym,vacuum,cell,input,field%efield)
diff --git a/inpgen/set_inp.f90 b/inpgen/set_inp.f90
index 20623d7841b13ad1bdef59dacacf75c9ff1e9494..a84a4bb9c46d50d3a961fb2c37edec0ee710c77c 100644
--- a/inpgen/set_inp.f90
+++ b/inpgen/set_inp.f90
@@ -140,7 +140,7 @@
input%gauss= .false. ; input%tria = .false.
sliceplot%slice= .false. ; input%swsp = .false.
input%lflip= .false. ; banddos%vacdos= .false. ; input%integ = .false.
- sliceplot%iplot= .false. ; input%score = .false. ; sliceplot%plpot = .false.
+ sliceplot%iplot= 0 ; input%score = .false. ; sliceplot%plpot = .false.
input%pallst = .false. ; obsolete%lwb = .false. ; vacuum%starcoeff = .false.
input%strho = .false. ; input%l_f = .false. ; atoms%l_geo(:) = .true.
noco%l_noco = noco%l_ss ; input%jspins = 1
diff --git a/io/r_inpXML.F90 b/io/r_inpXML.F90
index c0bf7e8135108f17ab6a28ad78587091cc711f55..5d51ab0a2a3ce96bedb6f16974729941b717d966 100644
--- a/io/r_inpXML.F90
+++ b/io/r_inpXML.F90
@@ -1924,7 +1924,7 @@ CONTAINS
input%vchk = .FALSE.
input%cdinf = .FALSE.
- sliceplot%iplot = .FALSE.
+ sliceplot%iplot = 0
input%score = .FALSE.
sliceplot%plpot = .FALSE.
@@ -1962,7 +1962,7 @@ CONTAINS
numberNodes = xmlGetNumberOfNodes(xPathA)
IF (numberNodes.EQ.1) THEN
- sliceplot%iplot = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@iplot'))
+ sliceplot%iplot = evaluateFirstIntOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@iplot'))
input%score = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@score'))
sliceplot%plpot = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@plplot'))
END IF
diff --git a/io/rw_inp.f90 b/io/rw_inp.f90
index bbf7a3e3134a0025ac3169e2229249c0397d9a02..a9e8a9894679a4eb681e694d2b09152f8af46ebc 100644
--- a/io/rw_inp.f90
+++ b/io/rw_inp.f90
@@ -619,15 +619,17 @@
END IF
!
band = .false.
- READ (UNIT=5,FMT=8050,END=992,ERR=992) sliceplot%iplot,input%score,sliceplot%plpot,band
- WRITE (6,9240) sliceplot%iplot,input%score,sliceplot%plpot,band
+ READ (UNIT=5,FMT=8050,END=992,ERR=992) ldum,input%score,sliceplot%plpot,band
+ WRITE (6,9240) ldum,input%score,sliceplot%plpot,band
+ sliceplot%iplot=MERGE(1,0,ldum)
IF (band) THEN
banddos%dos=.true. ; banddos%ndir = -4
ENDIF
GOTO 993
992 BACKSPACE(5)
- READ (UNIT=5,FMT=8050,END=99,ERR=99) sliceplot%iplot,input%score,sliceplot%plpot
- WRITE (6,9240) sliceplot%iplot,input%score,sliceplot%plpot,band
+ READ (UNIT=5,FMT=8050,END=99,ERR=99) ldum,input%score,sliceplot%plpot
+ WRITE (6,9240) ldum,input%score,sliceplot%plpot,band
+ sliceplot%iplot=MERGE(1,0,ldum)
!
993 READ (UNIT=5,FMT='(i3,2f10.6,6x,i3,8x,l1)',END=99,ERR=99)&
& sliceplot%kk,sliceplot%e1s,sliceplot%e2s,sliceplot%nnne,input%pallst
@@ -930,7 +932,7 @@
WRITE (5,*)
END IF
band = .false.
- WRITE (5,9240) sliceplot%iplot,input%score,sliceplot%plpot,band
+ WRITE (5,9240) ldum,input%score,sliceplot%plpot,band
9240 FORMAT ('iplot=',l1,',score=',l1,',plpot=',l1,',band=',l1)
WRITE (5,9250) sliceplot%kk,sliceplot%e1s,sliceplot%e2s,sliceplot%nnne,input%pallst
9250 FORMAT (i3,2f10.6,',nnne=',i3,',pallst=',l1)
diff --git a/io/w_inpXML.f90 b/io/w_inpXML.f90
index a53e7d69235d74d62e66d929b2e8588bd15be3fd..e81ef79c8a2837a282fffb48ee245b443c142dc4 100644
--- a/io/w_inpXML.f90
+++ b/io/w_inpXML.f90
@@ -679,8 +679,8 @@ SUBROUTINE w_inpXML(&
395 FORMAT(' ')
WRITE (fileNum,395) banddos%unfoldband, banddos%s_cell_x, banddos%s_cell_y, banddos%s_cell_z
-!
- 400 FORMAT(' ')
+!
+ 400 FORMAT(' ')
WRITE (fileNum,400) sliceplot%iplot,input%score,sliceplot%plpot
!
diff --git a/io/xml/FleurInputSchema.xsd b/io/xml/FleurInputSchema.xsd
index 36c25effecf00fef5db21f18a20b495213df141d..b05dccc43c9589f251b6c19877fad6209ac6f5ca 100644
--- a/io/xml/FleurInputSchema.xsd
+++ b/io/xml/FleurInputSchema.xsd
@@ -580,7 +580,7 @@
-
+
diff --git a/io/xml/FleurOutputSchema.xsd b/io/xml/FleurOutputSchema.xsd
index d9f299a5bf4507ef98e935fcfaf79d0ded243784..435e4c967881fa8f65351a639f08d9f266f41b95 100755
--- a/io/xml/FleurOutputSchema.xsd
+++ b/io/xml/FleurOutputSchema.xsd
@@ -820,7 +820,7 @@
-
+
diff --git a/main/fleur_init.F90 b/main/fleur_init.F90
index e91158695dc8b9160663c4a2b22d2cd7cadafca2..ab0e286cc3267afe6b24621714215fbacec46725 100644
--- a/main/fleur_init.F90
+++ b/main/fleur_init.F90
@@ -156,7 +156,7 @@
kpts%ntet = 1
kpts%numSpecialPoints = 1
- sliceplot%iplot=.FALSE.
+ sliceplot%iplot=0
sliceplot%kk = 0
sliceplot%e1s = 0.0
sliceplot%e2s = 0.0
diff --git a/main/optional.F90 b/main/optional.F90
index 9b5a70f0a62bc3814eabbec824bbe39d28143ea9..5f28ef554f1afd630ad1ee8589a27761eb017e49 100644
--- a/main/optional.F90
+++ b/main/optional.F90
@@ -94,7 +94,7 @@ CONTAINS
! ..
it = 1
- IF (sliceplot%iplot .AND. (mpi%irank==0) ) THEN
+ IF ((sliceplot%iplot.NE.0 ).AND. (mpi%irank==0) ) THEN
IF (noco%l_noco) THEN
CALL pldngen(mpi,sym,stars,atoms,sphhar,vacuum,&
cell,input,noco,oneD,sliceplot)
@@ -104,9 +104,9 @@ CONTAINS
IF (mpi%irank == 0) THEN
IF (sliceplot%plpot) input%score = .FALSE.
- IF (sliceplot%iplot) THEN
+ IF (sliceplot%iplot.NE.0) THEN
CALL timestart("Plotting")
- IF (input%strho) CALL juDFT_error("strho = T and iplot=T",calledby = "optional")
+ IF (input%strho) CALL juDFT_error("strho = T and iplot=/=0",calledby = "optional")
CALL plotdop(oneD,dimension,stars,vacuum,sphhar,atoms,&
input,sym,cell,sliceplot,noco)
CALL timestop("Plotting")
@@ -116,7 +116,7 @@ CONTAINS
! --->generate starting charge density
!
strho=input%strho
- IF (.NOT.(strho.OR.sliceplot%iplot)) THEN
+ IF (.NOT.(strho.OR.(sliceplot%iplot.NE.0))) THEN
archiveType = CDN_ARCHIVE_TYPE_CDN1_const
IF (noco%l_noco) THEN
archiveType = CDN_ARCHIVE_TYPE_NOCO_const
@@ -168,7 +168,7 @@ CONTAINS
ENDIF ! mpi%irank == 0
- IF (sliceplot%iplot) CALL juDFT_end("density plot o.k.",mpi%irank)
+ IF (sliceplot%iplot.NE.0) CALL juDFT_end("density plot o.k.",mpi%irank)
IF (input%strho) CALL juDFT_end("starting density generated",mpi%irank)
IF (input%swsp) CALL juDFT_end("spin polarised density generated",mpi%irank)
IF (input%lflip) CALL juDFT_end("magnetic moments flipped",mpi%irank)
diff --git a/mpi/mpi_bc_all.F90 b/mpi/mpi_bc_all.F90
index 61642b6d1fa4a03cb9309f27ab14142dd0ab3670..2a5e10db0dc6a1ec1a40600f114e96be4436f055 100644
--- a/mpi/mpi_bc_all.F90
+++ b/mpi/mpi_bc_all.F90
@@ -38,9 +38,9 @@ CONTAINS
INTEGER n
REAL rdum
! .. Local Arrays ..
- INTEGER i(42),ierr(3)
+ INTEGER i(43),ierr(3)
REAL r(34)
- LOGICAL l(46)
+ LOGICAL l(45)
! ..
! .. External Subroutines..
#ifdef CPP_MPI
@@ -57,7 +57,7 @@ CONTAINS
i(27)=vacuum%nstars ; i(28)=vacuum%nstm ; i(29)=oneD%odd%nq2 ; i(30)=oneD%odd%nop
i(31)=input%gw ; i(32)=input%gw_neigd ; i(33)=hybrid%ewaldlambda ; i(34)=hybrid%lexp
i(35)=hybrid%bands1 ; i(36)=input%maxiter ; i(37)=input%imix ; i(38)=banddos%orbCompAtom
- i(39)=input%kcrel;i(40)=banddos%s_cell_x;i(41)=banddos%s_cell_y;i(42)=banddos%s_cell_z
+ i(39)=input%kcrel;i(40)=banddos%s_cell_x;i(41)=banddos%s_cell_y;i(42)=banddos%s_cell_z; i(43)=sliceplot%iplot
r(1)=cell%omtil ; r(2)=cell%area ; r(3)=vacuum%delz ; r(4)=cell%z1 ; r(5)=input%alpha
r(6)=sliceplot%e1s ; r(7)=sliceplot%e2s ; r(8)=noco%theta; r(9)=noco%phi; r(10)=vacuum%tworkf
@@ -71,7 +71,7 @@ CONTAINS
l(1)=input%eonly ; l(2)=input%l_useapw ; l(3)=input%secvar ; l(4)=sym%zrfs ; l(5)=input%film
l(6)=sym%invs ; l(7)=sym%invs2 ; l(8)=input%l_bmt ; l(9)=input%l_f ; l(10)=input%cdinf
- l(11)=banddos%dos ; l(12) = hybrid%l_hybrid ; l(13)=banddos%vacdos ; l(14)=input%integ ; l(15)=sliceplot%iplot
+ l(11)=banddos%dos ; l(12) = hybrid%l_hybrid ; l(13)=banddos%vacdos ; l(14)=input%integ; l(15)=noco%l_spav
l(16)=input%strho ; l(17)=input%swsp ; l(18)=input%lflip
l(21)=input%pallst ; l(22)=sliceplot%slice ; l(23)=noco%l_soc ; l(24)=vacuum%starcoeff
l(25)=noco%l_noco ; l(26)=noco%l_ss; l(27)=noco%l_mperp; l(28)=noco%l_constr
@@ -80,7 +80,7 @@ CONTAINS
l(38)=field%efield%l_segmented
l(39)=sym%symor ; l(40)=input%frcor ; l(41)=input%tria ; l(42)=field%efield%dirichlet
l(43)=field%efield%l_dirichlet_coeff ; l(44)=input%l_coreSpec ; l(45)=input%ldauLinMix
- l(46)=noco%l_spav
+
ENDIF
!
CALL MPI_BCAST(i,SIZE(i),MPI_INTEGER,0,mpi%mpi_comm,ierr)
@@ -91,7 +91,7 @@ CONTAINS
sliceplot%nnne=i(17) ; banddos%ndir=i(18) ; stars%mx1=i(19) ; stars%mx2=i(20) ; stars%mx3=i(21)
input%jspins=i(12) ; vacuum%nvac=i(13) ; input%itmax=i(14) ; sliceplot%kk=i(15) ; vacuum%layers=i(16)
stars%ng2=i(7) ; stars%ng3=i(8) ; vacuum%nmz=i(9) ; vacuum%nmzxy=i(10) ; obsolete%lepr=i(11)
- atoms%ntype=i(3) ; banddos%orbCompAtom=i(38);banddos%s_cell_x=i(40);banddos%s_cell_y=i(41);banddos%s_cell_z=i(42)
+ atoms%ntype=i(3) ; banddos%orbCompAtom=i(38);banddos%s_cell_x=i(40);banddos%s_cell_y=i(41);banddos%s_cell_z=i(42) ;sliceplot%iplot=i(43)
input%coretail_lmax=i(2) ; input%kcrel=i(39)
stars%kimax=i(25);stars%kimax2=i(26)
!
@@ -114,14 +114,14 @@ CONTAINS
input%pallst=l(21) ; sliceplot%slice=l(22) ; noco%l_soc=l(23) ; vacuum%starcoeff=l(24)
input%strho=l(16) ; input%swsp=l(17) ; input%lflip=l(18)
banddos%dos=l(11) ; hybrid%l_hybrid=l(12) ; banddos%vacdos=l(13) ; banddos%l_orb=l(33) ; banddos%l_mcd=l(34)
- input%integ=l(14) ; sliceplot%iplot=l(15)
+ input%integ=l(14)
sym%invs=l(6) ; sym%invs2=l(7) ; input%l_bmt=l(8) ; input%l_f=l(9) ; input%cdinf=l(10)
input%eonly=l(1) ; input%secvar=l(3) ; sym%zrfs=l(4) ; input%film=l(5)
field%efield%l_segmented = l(38) ; sym%symor=l(39); field%efield%dirichlet = l(40)
field%efield%l_dirichlet_coeff = l(41) ; input%l_coreSpec=l(44) ; input%ldauLinMix=l(45)
banddos%unfoldband=l(35)
noco%l_mtNocoPot=l(36)
- noco%l_spav=l(46)
+ noco%l_spav=l(15)
!
! -> Broadcast the arrays:
IF (field%efield%l_segmented) THEN
diff --git a/optional/plot.f90 b/optional/plot.f90
new file mode 100644
index 0000000000000000000000000000000000000000..63208673a54627295b141c0b1696f17c3b189577
--- /dev/null
+++ b/optional/plot.f90
@@ -0,0 +1,499 @@
+!--------------------------------------------------------------------------------
+! Copyright (c) 2019 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_plot
+ USE m_types
+ USE m_juDFT
+ USE m_constants
+ USE m_cdn_io
+ USE m_loddop
+ USE m_wrtdop
+ USE m_qfix
+ USE m_fft2d
+ USE m_fft3d
+ USE m_types
+ USE m_rotdenmat
+
+ PRIVATE
+ !------------------------------------------------
+ ! A general purpose plotting routine for FLEUR.
+ !
+ ! Based on older plotting routines in pldngen.f90
+ ! and plotdop.f90 called by optional.F90 and now
+ ! called within a scf-loop instead of as a post
+ ! process functionality.
+ !
+ ! A. Neukirchen & R. Hilgers, September 2019
+ !------------------------------------------------
+ INTEGER, PARAMETER :: PLOT_INPDEN_const=2 !ind_plot= 1
+ INTEGER, PARAMETER :: PLOT_OUTDEN_Y_CORE_const=4 !ind_plot= 2
+ INTEGER, PARAMETER :: PLOT_INPDEN_N_CORE_const=8 !ind_plot= 4
+ INTEGER, PARAMETER :: PLOT_POT_TOT_const=128 !ind_plot= 7
+ INTEGER, PARAMETER :: PLOT_POT_EXT_const=256 !ind_plot= 8
+ INTEGER, PARAMETER :: PLOT_POT_COU_const=512 !ind_plot= 9
+ INTEGER, PARAMETER :: PLOT_POT_VXC_const=1024 !ind_plot=10
+
+ PUBLIC :: checkplotinp, makeplots, procplot, vectorsplit, matrixsplit, scalarplot, vectorplot, matrixplot
+
+CONTAINS
+
+ SUBROUTINE checkplotinp()
+ ! Checks for existing plot input. If an ancient plotin file is used, an
+ ! error is called. If no usable plot_inp exists, a new one is generated.
+
+ oldform = .false.
+ INQUIRE(file = "plotin", exist = oldform)
+ IF (oldform) THEN
+ CALL juDFT_error("Use of plotin file no longer supported",calledby = "plotdop")
+ END IF
+
+ INQUIRE(file = "plot_inp", exist = newform)
+ IF (.NOT.newform) THEN
+ OPEN(20,file ="plot_inp")
+ WRITE(20,'(i2,a5,l1)') 2,",xsf=",.true.
+ WRITE(20,*) "&PLOT twodim=t,cartesian=t"
+ WRITE(20,*) " vec1(1)=10.0 vec2(2)=10.0"
+ WRITE(20,*) " filename='plot1' /"
+ WRITE(20,*) "&PLOT twodim=f,cartesian=f"
+ WRITE(20,*) " vec1(1)=1.0 vec1(2)=0.0 vec1(3)=0.0 "
+ WRITE(20,*) " vec2(1)=0.0 vec2(2)=1.0 vec2(3)=0.0 "
+ WRITE(20,*) " vec3(1)=0.0 vec3(2)=0.0 vec3(3)=1.0 "
+ WRITE(20,*) " grid(1)=30 grid(2)=30 grid(3)=30 "
+ WRITE(20,*) " zero(1)=0.0 zero(2)=0.0 zero(3)=0.5 "
+ WRITE(20,*) " filename ='plot2' /"
+ CLOSE(20)
+ END IF
+
+ END SUBROUTINE checkplotinp
+
+!--------------------------------------------------------------------------------------------
+
+ SUBROUTINE vectorsplit(stars,vacuum,atoms,sphhar,input,noco,denmat,cden,mden)
+ ! Takes a 2D potential/density vector and rearanges it into two plottable
+ ! seperate ones (e.g. [rho_up, rho_down] ---> n, m).
+
+ IMPLICIT NONE
+
+ TYPE(t_stars), INTENT(IN) :: stars
+ TYPE(t_vacuum), INTENT(IN) :: vacuum
+ TYPE(t_atoms), INTENT(IN) :: atoms
+ TYPE(t_sphhar), INTENT(IN) :: sphhar
+ TYPE(t_input), INTENT(IN) :: input
+ TYPE(t_noco), INTENT(IN) :: noco
+ TYPE(t_potden), INTENT(INOUT) :: denmat
+ TYPE(t_potden), INTENT(OUT) :: cden, mden
+
+ CALL cden%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_DEN)
+ CALL mden%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_DEN)
+
+ CALL SpinsToChargeAndMagnetisation(denmat)
+
+ cden%mt(:,0:,1:,1) = denmat%mt(:,0:,1:,1)
+ cden%pw(1:,1) = denmat%pw(1:,1)
+ cden%vacz(1:,1:,1) = denmat%vacz(1:,1:,1)
+ cden%vacxy(1:,1:,1:,1) = denmat%vacxy(1:,1:,1:,1)
+
+ mden%mt(:,0:,1:,1) = denmat%mt(:,0:,1:,2)
+ mden%pw(1:,1) = denmat%pw(1:,2)
+ mden%vacz(1:,1:,1) = denmat%vacz(1:,1:,2)
+ mden%vacxy(1:,1:,1:,1) = denmat%vacxy(1:,1:,1:,2)
+
+ CALL ChargeAndMagnetisationToSpins(denmat)
+
+ END SUBROUTINE vectorsplit
+
+!--------------------------------------------------------------------------------------------
+
+ SUBROUTINE matrixsplit(mpi,sym,stars,atoms,sphhar,vacuum,cell,input,noco,oneD,sliceplot,factor,denmat,cden,mxden,myden,mzden)
+ ! Takes a 2x2 potential/density matrix and rearanges it into four plottable
+ ! seperate ones (e.g. rho_mat ---> n, mx, my, mz).
+ !
+ ! This is basically 1:1 the old pldngen.f90 routine, courtesy of Philipp Kurz.
+
+ IMPLICIT NONE
+
+ TYPE(t_mpi), INTENT(IN) :: mpi
+ TYPE(t_sym), INTENT(IN) :: sym
+ TYPE(t_stars), INTENT(IN) :: stars
+ TYPE(t_vacuum), INTENT(IN) :: vacuum
+ TYPE(t_atoms), INTENT(IN) :: atoms
+ TYPE(t_sphhar), INTENT(IN) :: sphhar
+ TYPE(t_input), INTENT(IN) :: input
+ TYPE(t_cell), INTENT(IN) :: cell
+ TYPE(t_oneD), INTENT(IN) :: oneD
+ TYPE(t_noco), INTENT(IN) :: noco
+ TYPE(t_sliceplot), INTENT(IN) :: sliceplot
+ REAL, INTENT(IN) :: factor
+ TYPE(t_potden), INTENT(INOUT) :: denmat
+ TYPE(t_potden), INTENT(OUT) :: cden, mxden, myden, mzden
+
+ ! Local type instances
+ TYPE(t_input) :: inp
+ TYPE(t_potden) :: den
+
+ ! Local scalars
+ INTEGER iden,ivac,ifft2,ifft3
+ INTEGER imz,ityp,iri,ilh,imesh,iter
+ REAL cdnup,cdndown,chden,mgden,theta,phi,zero,rho_11,rziw,fermiEnergyTemp
+ REAL rho_22,rho_21r,rho_21i,rhotot,mx,my,mz,fix,vz_r,vz_i
+ COMPLEX czero
+
+ ! Local arrays
+ !---> off-diagonal part of the density matrix
+ COMPLEX, ALLOCATABLE :: cdom(:),cdomvz(:,:),cdomvxy(:,:,:)
+ COMPLEX, ALLOCATABLE :: qpw(:,:),rhtxy(:,:,:,:)
+ REAL, ALLOCATABLE :: rht(:,:,:),rho(:,:,:,:)
+ REAL, ALLOCATABLE :: rvacxy(:,:,:,:),ris(:,:),fftwork(:)
+
+ !---> for testing: output of offdiag. output density matrix. to plot the
+ !---> offdiag. part of the output density matrix, that part has to be
+ !---> written the file rhomt21 in cdnmt.
+ LOGICAL :: l_qfix
+ REAL :: cdn11, cdn22
+ COMPLEX :: cdn21
+ !---> end of test part
+
+ iter = 0 ! This is not clean!
+
+ zero = 0.0 ; czero = CMPLX(0.0,0.0)
+ ifft3 = 27*stars%mx1*stars%mx2*stars%mx3
+ ifft2 = 9*stars%mx1*stars%mx2
+
+ ALLOCATE (qpw(stars%ng3,4),rhtxy(vacuum%nmzxyd,stars%ng2-1,2,4),&
+ cdom(stars%ng3),cdomvz(vacuum%nmzd,2),cdomvxy(vacuum%nmzxyd,stars%ng2-1,2),&
+ ris(0:27*stars%mx1*stars%mx2*stars%mx3-1,4),fftwork(0:27*stars%mx1*stars%mx2*stars%mx3-1),&
+ rvacxy(0:9*stars%mx1*stars%mx2-1,vacuum%nmzxyd,2,4),&
+ rho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,4),rht(vacuum%nmzd,2,4) )
+
+ !---> initialize arrays for the density matrix
+ rho(:,:,:,:) = zero ; qpw(:,:) = czero ; cdom(:) = czero
+ IF (input%film) THEN
+ cdomvz(:,:) = czero ; rhtxy(:,:,:,:) = czero
+ cdomvxy(:,:,:) = czero ; rht(:,:,:) = zero
+ END IF
+
+ ! Save the density matrix to a work density
+ CALL den%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_DEN)
+ den=denmat
+
+ rho(:,0:,1:,:input%jspins) = factor*den%mt(:,0:,1:,:input%jspins)
+ qpw(1:,:input%jspins) = factor*den%pw(1:,:input%jspins)
+ rht(1:,1:,:input%jspins) = factor*den%vacz(1:,1:,:input%jspins)
+ rhtxy(1:,1:,1:,:input%jspins) = factor*den%vacxy(1:,1:,1:,:input%jspins)
+ IF(noco%l_noco) THEN
+ cdom = factor*den%pw(:,3)
+ cdomvz(:,:) = CMPLX(factor*den%vacz(:,:,3),factor*den%vacz(:,:,4))
+ cdomvxy = factor*den%vacxy(:,:,:,3)
+ END IF
+
+ IF (.NOT. sliceplot%slice) THEN
+ CALL den%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_DEN)
+ den%iter = iter
+ den%mt(:,0:,1:,:input%jspins) = rho(:,0:,1:,:input%jspins)
+ den%pw(1:,:input%jspins) = qpw(1:,:input%jspins)
+ den%vacz(1:,1:,:input%jspins) = rht(1:,1:,:input%jspins)
+ den%vacxy(1:,1:,1:,:input%jspins) = rhtxy(1:,1:,1:,:input%jspins)
+ IF(noco%l_noco) THEN
+ den%pw(:,3) = cdom
+ den%vacz(:,:,3) = REAL(cdomvz(:,:))
+ den%vacz(:,:,4) = AIMAG(cdomvz(:,:))
+ den%vacxy(:,:,:,3) = cdomvxy
+ END IF
+ CALL qfix(mpi,stars,atoms,sym,vacuum,sphhar,input,cell,oneD,den,noco%l_noco,.FALSE.,.true.,fix)
+ rho(:,0:,1:,:input%jspins) = den%mt(:,0:,1:,:input%jspins)
+ qpw(1:,:input%jspins) = den%pw(1:,:input%jspins)
+ rht(1:,1:,:input%jspins) = den%vacz(1:,1:,:input%jspins)
+ rhtxy(1:,1:,1:,:input%jspins) = den%vacxy(1:,1:,1:,:input%jspins)
+ IF(noco%l_noco) THEN
+ cdom = den%pw(:,3)
+ cdomvz(:,:) = CMPLX(den%vacz(:,:,3),den%vacz(:,:,4))
+ cdomvxy = den%vacxy(:,:,:,3)
+ END IF
+ END IF
+
+ !---> calculate the charge and magnetization density in the muffin tins
+ DO ityp = 1,atoms%ntype
+ DO ilh = 0,sphhar%nlh(atoms%ntypsy(ityp))
+ DO iri = 1,atoms%jri(ityp)
+ IF (SIZE(den%mt,4).LE.2) THEN
+ cdnup = rho(iri,ilh,ityp,1)
+ cdndown = rho(iri,ilh,ityp,2)
+ theta = noco%beta(ityp)
+ phi = noco%alph(ityp)
+ chden = cdnup + cdndown
+ mgden = cdnup - cdndown
+ rho(iri,ilh,ityp,1) = chden
+ rho(iri,ilh,ityp,2) = mgden*COS(phi)*SIN(theta)
+ rho(iri,ilh,ityp,3) = mgden*SIN(phi)*SIN(theta)
+ rho(iri,ilh,ityp,4) = mgden*COS(theta)
+ ELSE
+ !---> for testing: output of offdiag. output density matrix
+ cdn11 = rho(iri,ilh,ityp,1)
+ cdn22 = rho(iri,ilh,ityp,2)
+ cdn21 = CMPLX(den%mt(iri,ilh,ityp,3),den%mt(iri,ilh,ityp,4))
+ CALL rot_den_mat(noco%alph(ityp),noco%beta(ityp),cdn11,cdn22,cdn21)
+ rho(iri,ilh,ityp,1) = cdn11 + cdn22
+ rho(iri,ilh,ityp,2) = 2.0*REAL(cdn21)
+ ! Note: The minus sign in the following line is temporary to adjust for differences in the offdiagonal
+ ! part of the density between this fleur version and ancient (v0.26) fleur.
+ rho(iri,ilh,ityp,3) = -2.0*AIMAG(cdn21)
+ rho(iri,ilh,ityp,4) = cdn11 - cdn22
+ !---> end of test part
+ END IF
+ END DO
+ END DO
+ END DO
+
+
+ !---> fouriertransform the diagonal part of the density matrix
+ !---> in the interstitial, qpw, to real space (ris)
+ DO iden = 1,2
+ CALL fft3d(ris(0,iden),fftwork,qpw(1,iden),stars,1)
+ END DO
+ !---> fouriertransform the off-diagonal part of the density matrix
+ CALL fft3d(ris(0,3),ris(0,4),cdom(1),stars,+1)
+
+ !---> calculate the charge and magnetization density on the
+ !---> real space mesh
+ DO imesh = 0,ifft3-1
+ rho_11 = ris(imesh,1)
+ rho_22 = ris(imesh,2)
+ rho_21r = ris(imesh,3)
+ rho_21i = ris(imesh,4)
+ rhotot = rho_11 + rho_22
+ mx = 2*rho_21r
+ my = -2*rho_21i
+ mz = (rho_11-rho_22)
+
+ ris(imesh,1) = rhotot
+ ris(imesh,2) = mx
+ ris(imesh,3) = my
+ ris(imesh,4) = mz
+ END DO
+
+ !---> Fouriertransform the density matrix back to reciprocal space
+ DO iden = 1,4
+ fftwork=zero
+ CALL fft3d(ris(0,iden),fftwork,qpw(1,iden),stars,-1)
+ END DO
+
+ !---> fouriertransform the diagonal part of the density matrix
+ !---> in the vacuum, rz & rxy, to real space (rvacxy)
+ IF (input%film) THEN
+ DO iden = 1,2
+ DO ivac = 1,vacuum%nvac
+ DO imz = 1,vacuum%nmzxyd
+ rziw = 0.0
+ CALL fft2d(stars,rvacxy(0,imz,ivac,iden),fftwork,rht(imz,ivac,iden),&
+ rziw,rhtxy(imz,1,ivac,iden),vacuum%nmzxyd,1)
+ END DO
+ END DO
+ END DO
+ !---> fouriertransform the off-diagonal part of the density matrix
+ DO ivac = 1,vacuum%nvac
+ DO imz = 1,vacuum%nmzxyd
+ rziw = 0.0
+ vz_r = REAL(cdomvz(imz,ivac))
+ vz_i = AIMAG(cdomvz(imz,ivac))
+ CALL fft2d(stars,rvacxy(0,imz,ivac,3),rvacxy(0,imz,ivac,4),&
+ vz_r,vz_i,cdomvxy(imz,1,ivac),vacuum%nmzxyd,1)
+ END DO
+ END DO
+
+ !---> calculate the four components of the matrix potential on
+ !---> real space mesh
+ DO ivac = 1,vacuum%nvac
+ DO imz = 1,vacuum%nmzxyd
+ DO imesh = 0,ifft2-1
+ rho_11 = rvacxy(imesh,imz,ivac,1)
+ rho_22 = rvacxy(imesh,imz,ivac,2)
+ rho_21r = rvacxy(imesh,imz,ivac,3)
+ rho_21i = rvacxy(imesh,imz,ivac,4)
+ rhotot = rho_11 + rho_22
+ mx = 2*rho_21r
+ my = -2*rho_21i
+ mz = (rho_11-rho_22)
+
+ rvacxy(imesh,imz,ivac,1) = rhotot
+ rvacxy(imesh,imz,ivac,2) = mx
+ rvacxy(imesh,imz,ivac,3) = my
+ rvacxy(imesh,imz,ivac,4) = mz
+ END DO
+ END DO
+ DO imz = vacuum%nmzxyd+1,vacuum%nmzd
+ rho_11 = rht(imz,ivac,1)
+ rho_22 = rht(imz,ivac,2)
+ rho_21r = REAL(cdomvz(imz,ivac))
+ rho_21i = AIMAG(cdomvz(imz,ivac))
+ rhotot = rho_11 + rho_22
+ mx = 2*rho_21r
+ my = -2*rho_21i
+ mz = (rho_11-rho_22)
+
+ rht(imz,ivac,1) = rhotot
+ rht(imz,ivac,2) = mx
+ rht(imz,ivac,3) = my
+ rht(imz,ivac,4) = mz
+ END DO
+ END DO
+ !---> Fouriertransform the matrix potential back to reciprocal space
+ DO iden = 1,4
+ DO ivac = 1,vacuum%nvac
+ DO imz = 1,vacuum%nmzxyd
+ fftwork=zero
+ CALL fft2d(stars,rvacxy(0,imz,ivac,iden),fftwork,rht(imz,ivac,iden),&
+ rziw,rhtxy(imz,1,ivac,iden),vacuum%nmzxyd,-1)
+ END DO
+ END DO
+ END DO
+ END IF
+
+ cden=den
+
+ !---> save mx to file mdnx
+ den%mt(:,0:,1:,1) = rho(:,0:,1:,2)
+ den%pw(1:,1) = qpw(1:,2)
+ den%vacz(1:,1:,1) = rht(1:,1:,2)
+ den%vacxy(1:,1:,1:,1) = rhtxy(1:,1:,1:,2)
+
+ mxden=den
+
+ !---> save my to file mdny
+ den%mt(:,0:,1:,1) = rho(:,0:,1:,3)
+ den%pw(1:,1) = qpw(1:,3)
+ den%vacz(1:,1:,1) = rht(1:,1:,3)
+ den%vacxy(1:,1:,1:,1) = rhtxy(1:,1:,1:,3)
+
+ myden=den
+
+ !---> save mz to file mdnz
+ den%mt(:,0:,1:,1) = rho(:,0:,1:,4)
+ den%pw(1:,1) = qpw(1:,4)
+ den%vacz(1:,1:,1) = rht(1:,1:,4)
+ den%vacxy(1:,1:,1:,1) = rhtxy(1:,1:,1:,4)
+
+ mzden=den
+
+ DEALLOCATE (qpw,rhtxy,cdom,cdomvz,cdomvxy,ris,fftwork,rvacxy,rho,rht)
+
+ END SUBROUTINE matrixsplit
+
+!--------------------------------------------------------------------------------------------
+
+ SUBROUTINE scalarplot(iplot,den,filename)
+ !Takes a 1-component t_potden density, i.e. a scalar field in MT-sphere/star
+ !representation and makes it into a plottable .xsf file according to a scheme
+ !given in plot_inp.
+
+ END SUBROUTINE scalarplot
+
+!--------------------------------------------------------------------------------------------
+
+ SUBROUTINE vectorplot(stars,vacuum,atoms,sphhar,input,noco,denmat,filenames)
+ !Takes a spin-polarized t_potden density, i.e. a 2D vector in MT-sphere/star
+ !representation and makes it into a plottable .xsf file according to a scheme
+ !given in plot_inp.
+
+ IMPLICIT NONE
+
+ TYPE(t_stars), INTENT(IN) :: stars
+ TYPE(t_vacuum), INTENT(IN) :: vacuum
+ TYPE(t_atoms), INTENT(IN) :: atoms
+ TYPE(t_sphhar), INTENT(IN) :: sphhar
+ TYPE(t_input), INTENT(IN) :: input
+ TYPE(t_noco), INTENT(IN) :: noco
+ TYPE(t_potden), INTENT(INOUT) :: denmat
+
+ TYPE(t_potden) :: cden, mden
+
+ CALL vectorsplit(stars,vacuum,atoms,sphhar,input,noco,denmat,cden,mden)
+ CALL scalarplot(...,cden,filenames(1))
+ CALL scalarplot(...,mden,filenames(2))
+
+ END SUBROUTINE vectorplot
+
+!--------------------------------------------------------------------------------------------
+
+ SUBROUTINE matrixplot(mpi,sym,stars,atoms,sphhar,vacuum,cell,input,noco,oneD,sliceplot,factor,denmat,filenames)
+ !Takes a 2x2 t_potden density, i.e. a sum of Pauli matrices in MT-sphere/star
+ !representation and makes it into 4 plottable .xsf files according to a scheme
+ !given in plot_inp.
+
+ IMPLICIT NONE
+
+ TYPE(t_mpi), INTENT(IN) :: mpi
+ TYPE(t_sym), INTENT(IN) :: sym
+ TYPE(t_stars), INTENT(IN) :: stars
+ TYPE(t_vacuum), INTENT(IN) :: vacuum
+ TYPE(t_atoms), INTENT(IN) :: atoms
+ TYPE(t_sphhar), INTENT(IN) :: sphhar
+ TYPE(t_input), INTENT(IN) :: input
+ TYPE(t_cell), INTENT(IN) :: cell
+ TYPE(t_oneD), INTENT(IN) :: oneD
+ TYPE(t_noco), INTENT(IN) :: noco
+ TYPE(t_sliceplot), INTENT(IN) :: sliceplot
+ REAL, INTENT(IN) :: factor
+ TYPE(t_potden), INTENT(INOUT) :: denmat
+
+ TYPE(t_potden), :: cden, mxden, myden, mzden
+
+ CALL matrixsplit(mpi,sym,stars,atoms,sphhar,vacuum,cell,input,noco,oneD,sliceplot,factor,denmat,cden,mxden,myden,mzden)
+ CALL scalarplot(...,cden,filenames(1))
+ CALL scalarplot(...,mxden,filenames(2))
+ CALL scalarplot(...,myden,filenames(3))
+ CALL scalarplot(...,mzden,filenames(4))
+
+ END SUBROUTINE matrixplot
+
+!--------------------------------------------------------------------------------------------
+
+ SUBROUTINE procplot(jspins,noco,iplot,ind_plot,den)
+ INTEGER, INTENT(IN) :: jplot
+ CHARACTER (len=15), ALLOCATABLE :: outFilenames(:)
+ INTEGER :: i
+
+ ! Plotting the density matrix as n or n,m or n,mx,my,mz
+ IF jplot==2 THEN
+ IF jspins==2 THEN
+ IF noco%l_noco THEN
+ ALLOCATE(outFilenames(4))
+ outFilenames(1)='cden'
+ outFilenames(2)='mdnx'
+ outFilenames(3)='mdny'
+ outFilenames(4)='mdnz'
+ call matrixplot(...)
+ ELSE
+ ALLOCATE(outFilenames(2))
+ outFilenames(1)='cden'
+ outFilenames(2)='mden'
+ call vectorplot(...)
+ END IF
+ ELSE
+ ALLOCATE(outFilenames(1))
+ outFilenames(1)='cden'
+ call scalarplot(...)
+ END IF
+ END IF
+ END SUBROUTINE procplot
+
+!--------------------------------------------------------------------------------------------
+
+ SUBROUTINE makeplots(jspins,noco,iplot,ind_plot,den)
+ INTEGER, INTENT(IN) :: iplot
+ INTEGER, INTENT(IN) :: ind_plot !Index of the plot according to the constants set above
+ INTEGER :: jplot
+ LOGICAL :: allowplot
+
+ allowplot=BTEST(iplot,ind_plot).OR.(MODULO(iplot,2).NE.1)
+ IF (allowplot) THEN
+ jplot=2**ind_plot
+ CALL checkplotinp()
+ CALL procplot(jspins,noco,jplot,den)
+ END IF
+ END SUBROUTINE makeplots
+
+!--------------------------------------------------------------------------------------------
+
+END MODULE m_plot
diff --git a/tests/tests/Bi2Te3XML/files/inp.xml b/tests/tests/Bi2Te3XML/files/inp.xml
index 2aafa6a6012de8541363864a0a704263157978e5..d3094eabd1575c8a7a200e158a574011375eee43 100644
--- a/tests/tests/Bi2Te3XML/files/inp.xml
+++ b/tests/tests/Bi2Te3XML/files/inp.xml
@@ -107,7 +107,7 @@
-
+
diff --git a/tests/tests/CoMCDXML/files/inp.xml b/tests/tests/CoMCDXML/files/inp.xml
index c25610939ad7c247aa3c8377e8a2a7f2c20e7cbb..cf4f62bdd1dc4b91b8a3b844bef642c16187bcf2 100644
--- a/tests/tests/CoMCDXML/files/inp.xml
+++ b/tests/tests/CoMCDXML/files/inp.xml
@@ -55,7 +55,7 @@
-
+
diff --git a/tests/tests/CoMCDXML/files/inp2.xml b/tests/tests/CoMCDXML/files/inp2.xml
index 07990032716459a5edc21778be51be552bb5d034..fed57da1493ddd5c5f47267fa48667cdc969068c 100644
--- a/tests/tests/CoMCDXML/files/inp2.xml
+++ b/tests/tests/CoMCDXML/files/inp2.xml
@@ -55,7 +55,7 @@
-
+
diff --git a/tests/tests/CuBandXML/files/inp.xml b/tests/tests/CuBandXML/files/inp.xml
index da30467ed1b7f4ecd5df45d966d97410553c64bb..2b8ccf2458ed14c78dabdda30034704b7ce226c9 100644
--- a/tests/tests/CuBandXML/files/inp.xml
+++ b/tests/tests/CuBandXML/files/inp.xml
@@ -47,7 +47,7 @@
-
+
diff --git a/tests/tests/CuBulkLibXC/files/inp.xml b/tests/tests/CuBulkLibXC/files/inp.xml
index 57b7aeaead9c349e48a6bbf62f87cb6a5bee21fc..00926a07b4f502eef5566936f2ef0a1226a004ee 100644
--- a/tests/tests/CuBulkLibXC/files/inp.xml
+++ b/tests/tests/CuBulkLibXC/files/inp.xml
@@ -46,7 +46,7 @@
-
+
diff --git a/tests/tests/CuBulkXML/files/inp.xml b/tests/tests/CuBulkXML/files/inp.xml
index bb4d8ac5308db277a361456f76b0d845ec2a639e..16e6ac3c425ab904055b9b295b7b4e86f6083297 100644
--- a/tests/tests/CuBulkXML/files/inp.xml
+++ b/tests/tests/CuBulkXML/files/inp.xml
@@ -44,7 +44,7 @@
-
+
diff --git a/tests/tests/CuDOSXML/files/inp.xml b/tests/tests/CuDOSXML/files/inp.xml
index 79406b6e0f9dd6a72692e7d0f3fd0c230cb54908..030fc5ad8e08fa6c17454233eaeafc7959995b51 100644
--- a/tests/tests/CuDOSXML/files/inp.xml
+++ b/tests/tests/CuDOSXML/files/inp.xml
@@ -44,7 +44,7 @@
-
+
diff --git a/tests/tests/CwannXML/files/inp.xml b/tests/tests/CwannXML/files/inp.xml
index 1f8b4376fb11a4c0c400d58535d8b6cbf6374e50..9e9761ce4beec1b22e3a206c107bc9a7b44539c5 100644
--- a/tests/tests/CwannXML/files/inp.xml
+++ b/tests/tests/CwannXML/files/inp.xml
@@ -290,7 +290,7 @@
-
+
diff --git a/tests/tests/CwannXML/files/wann_inp-1.xml b/tests/tests/CwannXML/files/wann_inp-1.xml
index 3e5981758990fce45bee1599a4ded36d32cb4455..b1b88a9794a045126a40cc6379232c74348deac8 100644
--- a/tests/tests/CwannXML/files/wann_inp-1.xml
+++ b/tests/tests/CwannXML/files/wann_inp-1.xml
@@ -290,7 +290,7 @@
-
+
diff --git a/tests/tests/CwannXML/files/wann_inp-2.xml b/tests/tests/CwannXML/files/wann_inp-2.xml
index 5cdd1a08215cc49dc0b2fd3773faa876423d9018..35a310709ddd8f201873aac9472f682a5b8df0a8 100644
--- a/tests/tests/CwannXML/files/wann_inp-2.xml
+++ b/tests/tests/CwannXML/files/wann_inp-2.xml
@@ -290,7 +290,7 @@
-
+
diff --git a/tests/tests/Diamond_SCAN/files/inp.xml b/tests/tests/Diamond_SCAN/files/inp.xml
index 2d7eab824dd079383c7ce029f8a28b101c14e11c..7cca88b3e1c0c71f50b1d92df0aee59a048d4343 100644
--- a/tests/tests/Diamond_SCAN/files/inp.xml
+++ b/tests/tests/Diamond_SCAN/files/inp.xml
@@ -48,7 +48,7 @@
-
+
diff --git a/tests/tests/Fe_1lXML/files/inp.xml b/tests/tests/Fe_1lXML/files/inp.xml
index 6fdb380b55cc9a0fff7cdc8861f6a2093a3e2713..a2903858d4c4d74c405a61daba302490f45f96cd 100644
--- a/tests/tests/Fe_1lXML/files/inp.xml
+++ b/tests/tests/Fe_1lXML/files/inp.xml
@@ -40,7 +40,7 @@
-
+
diff --git a/tests/tests/Fe_1l_SOCXML/files/inp.xml b/tests/tests/Fe_1l_SOCXML/files/inp.xml
index 4534d21c35b68fa239e2de814c4d15665af81c59..81fabe6a676febebdb14eae776fbc9d4737fdbe2 100644
--- a/tests/tests/Fe_1l_SOCXML/files/inp.xml
+++ b/tests/tests/Fe_1l_SOCXML/files/inp.xml
@@ -40,7 +40,7 @@
-
+
diff --git a/tests/tests/Fe_Kerker/files/inp.xml b/tests/tests/Fe_Kerker/files/inp.xml
index 86cc9b6a6735a5231fcf9b92de0e9f4a4eb5c9f8..1ee84321a35170bbf9aab263d91209c1ad687594 100644
--- a/tests/tests/Fe_Kerker/files/inp.xml
+++ b/tests/tests/Fe_Kerker/files/inp.xml
@@ -63,7 +63,7 @@
-
+
diff --git a/tests/tests/Fe_bctXML/files/inp.xml b/tests/tests/Fe_bctXML/files/inp.xml
index bdd8a4fa61eacef24d64d3fb30d1be4d030b8b51..fa1af8c7d69ff458fdd242f4d2fc9633432d8c50 100644
--- a/tests/tests/Fe_bctXML/files/inp.xml
+++ b/tests/tests/Fe_bctXML/files/inp.xml
@@ -49,7 +49,7 @@
-
+
diff --git a/tests/tests/Fe_bct_LOXML/files/inp.xml b/tests/tests/Fe_bct_LOXML/files/inp.xml
index 52165e3a16e6fbb524bd0f233f1a36dd38205b1b..5e64bb293658c86f7bacf7ea26d274d4d829a8ad 100644
--- a/tests/tests/Fe_bct_LOXML/files/inp.xml
+++ b/tests/tests/Fe_bct_LOXML/files/inp.xml
@@ -50,7 +50,7 @@
-
+
diff --git a/tests/tests/Fe_bct_LibXC/files/inp.xml b/tests/tests/Fe_bct_LibXC/files/inp.xml
index 82470181210656e89f9f8ae1b718f07759e7cd30..c349c92742eede0bd705ec4febc86778ec28220e 100644
--- a/tests/tests/Fe_bct_LibXC/files/inp.xml
+++ b/tests/tests/Fe_bct_LibXC/files/inp.xml
@@ -51,7 +51,7 @@
-
+
diff --git a/tests/tests/Fe_bct_SOCXML/files/inp.xml b/tests/tests/Fe_bct_SOCXML/files/inp.xml
index efea0225e1b3f89d9f5da7b535061cc326db8823..b5a01597c96b8f3e1ee1e648dfef7a36163d641c 100644
--- a/tests/tests/Fe_bct_SOCXML/files/inp.xml
+++ b/tests/tests/Fe_bct_SOCXML/files/inp.xml
@@ -49,7 +49,7 @@
-
+
diff --git a/tests/tests/Fe_fccXML/files/inp.xml b/tests/tests/Fe_fccXML/files/inp.xml
index 2212be7661a114db7c751909342cf08e5e0c1abc..924f128c0203a4425ca088538e28a0d88aeaa347 100644
--- a/tests/tests/Fe_fccXML/files/inp.xml
+++ b/tests/tests/Fe_fccXML/files/inp.xml
@@ -49,7 +49,7 @@
-
+
diff --git a/tests/tests/GaAsMultiUForceXML/files/inp-2.xml b/tests/tests/GaAsMultiUForceXML/files/inp-2.xml
index 7b0cb21d2bfbb4e077c65c5a981b2df549dcb1dc..fa85006a13472f7d13c4fe43ed06d8442bf068b2 100644
--- a/tests/tests/GaAsMultiUForceXML/files/inp-2.xml
+++ b/tests/tests/GaAsMultiUForceXML/files/inp-2.xml
@@ -56,7 +56,7 @@
-
+
diff --git a/tests/tests/GaAsMultiUForceXML/files/inp-3.xml b/tests/tests/GaAsMultiUForceXML/files/inp-3.xml
index aa49c88f1612ab20ad4c1a70fff77251db727dc5..adcc815c2ccdcddf098748b14bb708b83d8b0e96 100644
--- a/tests/tests/GaAsMultiUForceXML/files/inp-3.xml
+++ b/tests/tests/GaAsMultiUForceXML/files/inp-3.xml
@@ -57,7 +57,7 @@
-
+
diff --git a/tests/tests/GaAsMultiUForceXML/files/inp.xml b/tests/tests/GaAsMultiUForceXML/files/inp.xml
index ff4dfa1892fcb01cce02934c6cd3182ef7f0bb27..9fbae0243c562049aa01e23c1dde509c0d461a95 100644
--- a/tests/tests/GaAsMultiUForceXML/files/inp.xml
+++ b/tests/tests/GaAsMultiUForceXML/files/inp.xml
@@ -56,7 +56,7 @@
-
+
diff --git a/tests/tests/NiO_ldauXML/files/inp.xml b/tests/tests/NiO_ldauXML/files/inp.xml
index 43821fdd7854f637dc127e94691063fb700bf0a9..60a26015c9752ceb9884c9a549ec47b79174e58b 100644
--- a/tests/tests/NiO_ldauXML/files/inp.xml
+++ b/tests/tests/NiO_ldauXML/files/inp.xml
@@ -66,7 +66,7 @@
-
+
diff --git a/tests/tests/PTO-SOCXML/files/inp.xml b/tests/tests/PTO-SOCXML/files/inp.xml
index 08cbcf73ec9882083c6ec9b2e1624e6a2250e7db..d2d475f19a2674c0b45b3f5962b114664df564b9 100644
--- a/tests/tests/PTO-SOCXML/files/inp.xml
+++ b/tests/tests/PTO-SOCXML/files/inp.xml
@@ -65,7 +65,7 @@
-
+
diff --git a/tests/tests/PTOXML/files/inp.xml b/tests/tests/PTOXML/files/inp.xml
index 676bab1c74fcfa4f5e32821ab8eb1f3c26b49eb7..1b203adb0e36b2fc2852f5155b8b5225e76145fa 100644
--- a/tests/tests/PTOXML/files/inp.xml
+++ b/tests/tests/PTOXML/files/inp.xml
@@ -65,7 +65,7 @@
-
+
diff --git a/tests/tests/SiFilmPlotXML/files/inp-2.xml b/tests/tests/SiFilmPlotXML/files/inp-2.xml
index e661b7b4755bb4c0cbec50edf10f8c880d477e3f..ffeb821bb2261d425434f4e2992b33faeed9a6cd 100644
--- a/tests/tests/SiFilmPlotXML/files/inp-2.xml
+++ b/tests/tests/SiFilmPlotXML/files/inp-2.xml
@@ -51,7 +51,7 @@
-
+
diff --git a/tests/tests/SiFilmPlotXML/files/inp.xml b/tests/tests/SiFilmPlotXML/files/inp.xml
index 3b50dac045d4590dd1470f817676c566a96fb48b..ed9e1c135165b01455eb9938672520398a6543e9 100644
--- a/tests/tests/SiFilmPlotXML/files/inp.xml
+++ b/tests/tests/SiFilmPlotXML/files/inp.xml
@@ -51,7 +51,7 @@
-
+
diff --git a/tests/tests/SiFilmSlicePlotXML/files/inp-2.xml b/tests/tests/SiFilmSlicePlotXML/files/inp-2.xml
index 832ca7ffb24fe06fd7fc06602e0c623cb0116a62..5696e711a33cc547975d727590e0df10089d95a8 100644
--- a/tests/tests/SiFilmSlicePlotXML/files/inp-2.xml
+++ b/tests/tests/SiFilmSlicePlotXML/files/inp-2.xml
@@ -51,7 +51,7 @@
-
+
diff --git a/tests/tests/SiFilmSlicePlotXML/files/inp-3.xml b/tests/tests/SiFilmSlicePlotXML/files/inp-3.xml
index 54c2835c473f096a9bc88be4bca64fd6ecf1c77a..b7cc4df52529cf190bae813ee617a97eb9acdf16 100644
--- a/tests/tests/SiFilmSlicePlotXML/files/inp-3.xml
+++ b/tests/tests/SiFilmSlicePlotXML/files/inp-3.xml
@@ -51,7 +51,7 @@
-
+
diff --git a/tests/tests/SiFilmSlicePlotXML/files/inp.xml b/tests/tests/SiFilmSlicePlotXML/files/inp.xml
index 54c2835c473f096a9bc88be4bca64fd6ecf1c77a..b7cc4df52529cf190bae813ee617a97eb9acdf16 100644
--- a/tests/tests/SiFilmSlicePlotXML/files/inp.xml
+++ b/tests/tests/SiFilmSlicePlotXML/files/inp.xml
@@ -51,7 +51,7 @@
-
+
diff --git a/tests/tests/SiHybridGamma/files/inp.xml b/tests/tests/SiHybridGamma/files/inp.xml
index f6a4a8de5eeab5e70a58fb52b3e34dfa855074bb..cd6dfa61fee2a91854d752e520f391c4488bc8b8 100644
--- a/tests/tests/SiHybridGamma/files/inp.xml
+++ b/tests/tests/SiHybridGamma/files/inp.xml
@@ -49,7 +49,7 @@
-
+
diff --git a/tests/tests/SiLOXML/files/inp.xml b/tests/tests/SiLOXML/files/inp.xml
index 40495124aeaee7d8bef7992ac178c45e8d28a26c..091c15602c51da154e963f83e530bc1ffce2121c 100644
--- a/tests/tests/SiLOXML/files/inp.xml
+++ b/tests/tests/SiLOXML/files/inp.xml
@@ -47,7 +47,7 @@
-
+
diff --git a/tests/tests/Si_film/files/inp_force b/tests/tests/Si_film/files/inp_force
index 20cefbf37974e239032fe9602ad6dcafbd42ef25..f4d9f0bd664a38a2bd7f32a335b5369b08a9858d 100644
--- a/tests/tests/Si_film/files/inp_force
+++ b/tests/tests/Si_film/files/inp_force
@@ -42,7 +42,7 @@ swsp=F 0.00 0.00 0.00
lflip=F 1 1 1
vacdos=f,layers= 0,integ=F,star=f,nstars= 0 0.00 0.00 0.00 0.00,nstm=0,tworkf= 0.000000
-iplot=f,score=F,plpot=F,band=F
+iplot=F,score=F,plpot=F,band=F
0 0.000000 0.000000,nnne= 0,pallst=F
xa= 2.00000,thetad= 330.00000,epsdisp= 0.00001,epsforce= 0.00001
relax 111 111 111
diff --git a/tests/tests/TiO2eelsXML/files/inp-2.xml b/tests/tests/TiO2eelsXML/files/inp-2.xml
index 5ed9a89340733ae4eeb698f7c9cce52b11fede21..c569ead8a0a224cf6ed9bf1ce60af125a213ab0c 100644
--- a/tests/tests/TiO2eelsXML/files/inp-2.xml
+++ b/tests/tests/TiO2eelsXML/files/inp-2.xml
@@ -144,7 +144,7 @@
-
+
diff --git a/tests/tests/TiO2eelsXML/files/inp.xml b/tests/tests/TiO2eelsXML/files/inp.xml
index e4fc8ebea645475b60690645cf027dda01822b01..37a0f3731f18a74b760b7d24d70df443bfd4d347 100644
--- a/tests/tests/TiO2eelsXML/files/inp.xml
+++ b/tests/tests/TiO2eelsXML/files/inp.xml
@@ -144,7 +144,7 @@
-
+
diff --git a/types/types_setup.F90 b/types/types_setup.F90
index 45a92581535f2944ec10b7ee93c6b3b42867fb4e..39b717a5487e00a614e901e03e70d0ae90e8a01c 100644
--- a/types/types_setup.F90
+++ b/types/types_setup.F90
@@ -423,7 +423,7 @@ MODULE m_types_setup
END TYPE t_input
TYPE t_sliceplot
- LOGICAL :: iplot
+ INTEGER :: iplot
LOGICAL :: slice
LOGICAL :: plpot
INTEGER :: kk