Commit 619f39c3 authored by jiff1302's avatar jiff1302

Merge branch 'develop' of fleur-git:fleur into develop

parents 8ae64a64 4ec5cc28
......@@ -15,7 +15,8 @@
USE m_qsf
USE m_pwint
USE m_types
use m_juDFT
USE m_juDFT
USE m_xmlOutput
IMPLICIT NONE
! ..
! .. Scalar Arguments ..
......@@ -43,15 +44,22 @@
! ..
! .. Local Arrays ..
REAL qmt(atoms%ntypd),qvac(2),q2(vacuum%nmz),rht1(vacuum%nmzd,2,input%jspins)
INTEGER, ALLOCATABLE :: lengths(:,:)
CHARACTER(LEN=20) :: attributes(6), names(6)
! ..
! .. Intrinsic Functions ..
INTRINSIC real
! ..
!
IF (input%film) THEN
ALLOCATE(lengths(4+vacuum%nvac,2))
ELSE
ALLOCATE(lengths(4,2))
END IF
CALL timestart("cdntot")
qtot = 0.e0
qistot = 0.e0
DO 40 jspin = 1,input%jspins
DO jspin = 1,input%jspins
q = 0.e0
! -----mt charge
CALL timestart("MT")
......@@ -105,10 +113,28 @@
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)
names(1) = 'spin' ; WRITE(attributes(1),'(i0)') jspin ; lengths(1,1)=4 ; lengths(1,2)=1
names(2) = 'total' ; WRITE(attributes(2),'(f17.10)') q ; lengths(2,1)=5 ; lengths(2,2)=17
names(3) = 'interstitial' ; WRITE(attributes(3),'(f17.10)') qis ; lengths(3,1)=12 ; lengths(3,2)=17
names(4) = 'mtSpheres' ; WRITE(attributes(4),'(f17.10)') SUM(qmt(1:atoms%ntype)) ; lengths(4,1)=9 ; lengths(4,2)=17
IF(input%film) THEN
DO i = 1, vacuum%nvac
WRITE(names(4+i),'(a6,i0)') 'vacuum', i
WRITE(attributes(4+i),'(f17.10)') qvac(i)
lengths(4+i,1)=7
lengths(4+i,2)=17
END DO
CALL writeXMLElementFormPoly('spinDependentCharge',names(1:4+vacuum%nvac),&
attributes(1:4+vacuum%nvac),lengths)
ELSE
CALL writeXMLElementFormPoly('spinDependentCharge',names(1:4),attributes(1:4),lengths)
END IF
qtot = qtot + q
40 CONTINUE
END DO ! loop over spins
DEALLOCATE (lengths)
WRITE (6,FMT=8020) qtot
WRITE (16,FMT=8020) qtot
CALL writeXMLElementFormPoly('totalCharge',(/'value'/),(/qtot/),reshape((/5,20/),(/1,2/)))
8000 FORMAT (/,10x,'total charge for spin',i3,'=',f12.6,/,10x,&
& 'interst. charge = ',f12.6,/,&
& (10x,'mt charge= ',4f12.6,/))
......
......@@ -329,7 +329,7 @@ CONTAINS
IF (mpi%irank==0) THEN
WRITE (6,FMT=8000) jspin
WRITE (16,FMT=8000) jspin
CALL openXMLElementPoly('valenceDensity',(/'spin'/),(/jspin/))
CALL openXMLElementPoly('mtCharges',(/'spin'/),(/jspin/))
END IF
8000 FORMAT (/,/,10x,'valence density: spin=',i2)
......@@ -782,7 +782,7 @@ CONTAINS
we,ispin,noccbd,usdus,acof(:,0:,:,ispin),&
bcof(:,0:,:,ispin),e1cof,e2cof, acoflo,bcoflo, results,f_a12)
#endif
CALL force_a21(atoms,dimension,noccbd,sym,atoms%nlod*(atoms%nlod+1)/2,&
CALL force_a21(atoms,dimension,noccbd,sym,&
oneD,cell,we,ispin,epar(0:,:,ispin),noccbd,eig,usdus,acof(:,0:,:,ispin),&
bcof(:,0:,:,ispin),ccof(-atoms%llod:,:,:,:,ispin), aveccof,bveccof,cveccof,&
results,f_a21,f_b4)
......@@ -964,7 +964,7 @@ CONTAINS
END IF
!-for
END DO ! end of loop ispin = jsp_start,jsp_end
CALL closeXMLElement('valenceDensity')
CALL closeXMLElement('mtCharges')
END IF ! end of (mpi%irank==0)
!+t3e
!Note: no deallocation anymore, we rely on Fortran08 :-)
......
......@@ -98,7 +98,6 @@ CONTAINS
& t33,'d',t42,'f',t51,'total')
CALL timestart("cdnmt")
CALL openXMLElementNoAttributes('mtCharges')
na = 1
DO itype = 1,atoms%ntype
!---> spherical component
......@@ -251,7 +250,6 @@ CONTAINS
na = na + atoms%neq(itype)
ENDDO ! end of loop over atom types
CALL closeXMLElement('mtCharges')
CALL timestop("cdnmt")
!---> for testing: to plot the offdiag. part of the density matrix it
!---> is written to the file rhomt21. This file can read in pldngen.
......
......@@ -49,7 +49,7 @@ init/tetcon.f init/kvecon.f
set(inpgen_F90 io/xsf_io.f90
global/types.F90 global/enpara.f90 global/chkmt.f90 inpgen/inpgen.f90 inpgen/set_inp.f90 io/rw_inp.f90 juDFT/juDFT.F90
juDFT/stop.F90 juDFT/time.F90 juDFT/init.F90 io/w_inpXML.f90 init/julia.f90 io/xmlOutput.f90)
juDFT/stop.F90 juDFT/time.F90 juDFT/init.F90 io/w_inpXML.f90 init/julia.f90 io/xmlOutput.F90)
set(fleur_SRC ${fleur_F90} ${fleur_F77})
......
......@@ -122,10 +122,10 @@ CONTAINS
! The only reason having them is that the Scalapack counterpart
! PDPOTRF very often fails on higher processor numbers for unknown reasons!
#ifdef CPP_ELPA_NEW
CALL CPP_cholesky (m,bsca,SIZE(bsca,1),nb, mpi_comm_rows,mpi_comm_cols,ok)
CALL CPP_CHOLESKY (m,bsca,SIZE(bsca,1),nb, mpi_comm_rows,mpi_comm_cols,ok)
CALL CPP_invert_trm(m, bsca, SIZE(bsca,1), nb, mpi_comm_rows, mpi_comm_cols,ok)
#else
CALL CPP_cholesky(m,bsca,SIZE(bsca,1),nb, mpi_comm_rows,mpi_comm_cols)
CALL CPP_CHOLESKY (m,bsca,SIZE(bsca,1),nb, mpi_comm_rows,mpi_comm_cols)
CALL CPP_invert_trm(m, bsca, SIZE(bsca,1), nb, mpi_comm_rows, mpi_comm_cols)
#endif
......
MODULE m_forcea21
CONTAINS
SUBROUTINE force_a21(&
atoms,dimension,nobd,sym, loplod,oneD,cell,&
atoms,dimension,nobd,sym,oneD,cell,&
we,jsp,epar,ne,eig,usdus,&
acof,bcof,ccof,aveccof,bveccof,cveccof, results,f_a21,f_b4)
......@@ -38,8 +38,7 @@ CONTAINS
TYPE(t_usdus),INTENT(IN) :: usdus
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: nobd
INTEGER, INTENT (IN) :: loplod
INTEGER, INTENT (IN) :: nobd
INTEGER, INTENT (IN) :: ne,jsp
! ..
! .. Array Arguments ..
......@@ -56,7 +55,7 @@ CONTAINS
! .. Local Scalars ..
INTEGER, PARAMETER :: lmaxb=3
COMPLEX dtd,dtu,utd,utu
INTEGER lo
INTEGER lo, mlotot, mlolotot, mlot_d, mlolot_d
INTEGER i,ie,im,in,l1,l2,ll1,ll2,lm1,lm2,m1,m2,n,natom
INTEGER natrun,is,isinv,j,irinv,it
REAL ,PARAMETER:: zero=0.0
......@@ -73,11 +72,18 @@ CONTAINS
! ..
! ..
!dimension%lmplmd = (dimension%lmd* (dimension%lmd+3))/2
mlotot = 0 ; mlolotot = 0
DO n = 1, atoms%ntype
mlotot = mlotot + atoms%nlo(n)
mlolotot = mlolotot + atoms%nlo(n)*(atoms%nlo(n)+1)/2
ENDDO
mlot_d = max(mlotot,1)
mlolot_d = max(mlolotot,1)
ALLOCATE ( tlmplm%tdd(0:dimension%lmplmd,atoms%ntype,1),tlmplm%tuu(0:dimension%lmplmd,atoms%ntype,1),&
tlmplm%tdu(0:dimension%lmplmd,atoms%ntype,1),tlmplm%tud(0:dimension%lmplmd,atoms%ntype,1),&
tlmplm%tuulo(0:dimension%lmd,-atoms%llod:atoms%llod,atoms%nlod,1),&
tlmplm%tdulo(0:dimension%lmd,-atoms%llod:atoms%llod,atoms%nlod,1),&
tlmplm%tuloulo(-atoms%llod:atoms%llod,-atoms%llod:atoms%llod,loplod,1),&
tlmplm%tuulo(0:dimension%lmd,-atoms%llod:atoms%llod,mlot_d,1),&
tlmplm%tdulo(0:dimension%lmd,-atoms%llod:atoms%llod,mlot_d,1),&
tlmplm%tuloulo(-atoms%llod:atoms%llod,-atoms%llod:atoms%llod,mlolot_d,1),&
v_mmp(-lmaxb:lmaxb,-lmaxb:lmaxb),&
a21(3,atoms%natd),b4(3,atoms%natd),tlmplm%ind(0:dimension%lmd,0:dimension%lmd,atoms%ntype,1) )
!
......@@ -179,11 +185,13 @@ CONTAINS
!
!---> add the local orbital and U contribution to a21
!
CALL force_a21_lo(nobd,atoms, loplod,jsp,n,we,eig,ne,&
acof,bcof,ccof,aveccof,bveccof,cveccof, tlmplm,usdus, a21)
CALL force_a21_lo(nobd,atoms,jsp,n,we,eig,ne,&
acof,bcof,ccof,aveccof,bveccof,&
cveccof, tlmplm,usdus, a21)
CALL force_a21_U(nobd,atoms,lmaxb,n,jsp,we,ne, usdus,v_mmp,&
acof,bcof,ccof,aveccof,bveccof,cveccof, a21)
CALL force_a21_U(nobd,atoms,lmaxb,n,jsp,we,ne,&
usdus,v_mmp,acof,bcof,ccof,&
aveccof,bveccof,cveccof, a21)
#ifdef CPP_APW
! -> B4 force
......
MODULE m_forcea21lo
CONTAINS
SUBROUTINE force_a21_lo(nobd,atoms, loplod,isp,itype,we,eig,ne,&
acof,bcof,ccof,aveccof,bveccof,cveccof, tlmplm,usdus, a21)
SUBROUTINE force_a21_lo(nobd,atoms,isp,itype,we,eig,ne,&
acof,bcof,ccof,aveccof,bveccof,&
cveccof,tlmplm,usdus, a21)
!
!***********************************************************************
! This subroutine calculates the local orbital contribution to A21,
......@@ -18,7 +19,7 @@ CONTAINS
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: nobd
INTEGER, INTENT (IN) :: loplod,itype,ne,isp
INTEGER, INTENT (IN) :: itype,ne,isp
! ..
! .. Array Arguments ..
REAL, INTENT (IN) :: we(nobd),eig(:)!(dimension%neigd)
......
......@@ -8,6 +8,7 @@
USE m_geo
USE m_relax
USE m_types
USE m_xmlOutput
IMPLICIT NONE
TYPE(t_results),INTENT(IN) :: results
......@@ -26,6 +27,7 @@
! ..
! .. Local Arrays ..
REAL forcetot(3,atoms%ntypd)
CHARACTER(LEN=20) :: attributes(7)
!
! write spin-dependent forces
!
......@@ -52,30 +54,43 @@
WRITE (6,8005)
WRITE (16,8005)
8005 FORMAT (/,' ***** TOTAL FORCES ON ATOMS ***** ',/)
IF (input%l_f) CALL openXMLElement('totalForcesOnRepresentativeAtoms',(/'units'/),(/'Htr/bohr'/))
nat1 = 1
DO n = 1,atoms%ntype
IF (atoms%l_geo(n)) THEN
!
DO i = 1,3
forcetot(i,n) = zero
END DO
DO jsp = 1,input%jspins
DO i = 1,3
forcetot(i,n) = forcetot(i,n) + results%force(i,n,jsp)
forcetot(i,n) = zero
END DO
END DO
!
WRITE (6,FMT=8010) n, (atoms%pos(i,nat1),i=1,3),&
& (forcetot(i,n),i=1,3)
WRITE (16,FMT=8010) n, (atoms%pos(i,nat1),i=1,3),&
& (forcetot(i,n),i=1,3)
8010 FORMAT (' TOTAL FORCE FOR ATOM TYPE=',i3,2x,'X=',f7.3,3x,'Y=',&
& f7.3,3x,'Z=',f7.3,/,22x,' FX_TOT=',f9.6,&
& ' FY_TOT=',f9.6,' FZ_TOT=',f9.6)
!
ENDIF
DO jsp = 1,input%jspins
DO i = 1,3
forcetot(i,n) = forcetot(i,n) + results%force(i,n,jsp)
END DO
END DO
WRITE (6,FMT=8010) n, (atoms%pos(i,nat1),i=1,3),&
& (forcetot(i,n),i=1,3)
WRITE (16,FMT=8010) n, (atoms%pos(i,nat1),i=1,3),&
& (forcetot(i,n),i=1,3)
8010 FORMAT (' TOTAL FORCE FOR ATOM TYPE=',i3,2x,'X=',f7.3,3x,'Y=',&
& f7.3,3x,'Z=',f7.3,/,22x,' FX_TOT=',f9.6,&
& ' FY_TOT=',f9.6,' FZ_TOT=',f9.6)
WRITE(attributes(1),'(i0)') n
WRITE(attributes(2),'(f12.6)') atoms%pos(1,nat1)
WRITE(attributes(3),'(f12.6)') atoms%pos(2,nat1)
WRITE(attributes(4),'(f12.6)') atoms%pos(3,nat1)
WRITE(attributes(5),'(f12.8)') forcetot(1,n)
WRITE(attributes(6),'(f12.8)') forcetot(2,n)
WRITE(attributes(7),'(f12.8)') forcetot(3,n)
IF (input%l_f) THEN
CALL writeXMLElementFormPoly('forceTotal',(/'atomType','x ','y ','z ',&
'F_x ','F_y ','F_z '/),attributes,&
reshape((/8,1,1,1,3,3,3,6,12,12,12,12,12,12/),(/7,2/)))
END IF
END IF
nat1 = nat1 + atoms%neq(n)
END DO
IF (input%l_f) CALL closeXMLElement('totalForcesOnRepresentativeAtoms')
sum=0.0
DO n = 1,atoms%ntype
......
......@@ -20,5 +20,5 @@ io/wrtdop.f90
io/w_inpXML.f90
io/xsf_io.f90
io/xmlIntWrapFort.f90
io/xmlOutput.f90
io/xmlOutput.F90
)
......@@ -40,6 +40,10 @@ MODULE m_xmlOutput
IMPLICIT NONE
#ifdef CPP_MPI
include "mpif.h"
INTEGER::err,isize
#endif
CHARACTER(LEN=8) :: date
CHARACTER(LEN=10) :: time
CHARACTER(LEN=10) :: zone
......@@ -58,6 +62,10 @@ MODULE m_xmlOutput
WRITE (xmlOutputUnit,'(a)') '<?xml version="1.0" encoding="UTF-8" standalone="no"?>'
WRITE (xmlOutputUnit,'(a)') '<fleurOutput fleurOutputVersion="0.27">'
CALL writeXMLElement('programVersion',(/'version'/),(/version_const/))
#ifdef CPP_MPI
CALL MPI_COMM_SIZE(MPI_COMM_WORLD,isize,err)
CALL writeXMLElementPoly('parallelizationParameters',(/'mpiPEs'/),(/isize/))
#endif
CALL writeXMLElement('startDateAndTime',(/'date','time','zone'/),(/dateString,timeString,zone/))
END SUBROUTINE startXMLOutput
......
......@@ -6,6 +6,7 @@
! called with suitable names for timers
! Daniel Wortmann, Fri Sep 6 11:53:08 2002
!*****************************************************************
USE m_xmlOutput
IMPLICIT NONE
! List of different timers
PRIVATE
......@@ -29,7 +30,7 @@
CHARACTER(LEN=256),SAVE :: lastfile=""
INTEGER ,SAVE :: lastline=0
PUBLIC timestart,timestop,writetimes,writelocation
PUBLIC timestart,timestop,writetimes,writelocation,writeTimesXML
PUBLIC juDFT_time_lastlocation !should not be used
CONTAINS
......@@ -301,6 +302,79 @@
END SUBROUTINE writetimes
! writes all times to out.xml file
SUBROUTINE writeTimesXML()
IMPLICIT NONE
INTEGER :: fn,irank=0
LOGICAL :: l_out
TYPE(t_timer), POINTER :: timer
#ifdef CPP_MPI
include "mpif.h"
INTEGER::err,isize
CALL MPI_COMM_RANK(MPI_COMM_WORLD,irank,err)
#endif
IF (irank.NE.0) RETURN
IF (.NOT.associated(globaltimer)) RETURN !write nothing if no timing recorded
timer => globaltimer
DO WHILE (TRIM(ADJUSTL(timer%name)).NE.'Iteration')
IF(timer%n_subtimers.EQ.0) RETURN
timer => timer%subtimer(1)%p
END DO
CALL openXMLElement('timing',(/'units'/),(/'sec'/))
CALL privWriteTimesXML(timer,1)
CALL closeXMLElement('timing')
END SUBROUTINE writeTimesXML
RECURSIVE SUBROUTINE privWriteTimesXML(timer,level)
IMPLICIT NONE
TYPE(t_timer),INTENT(IN) :: timer
INTEGER,INTENT(IN) :: level
INTEGER :: n, timerNameLength
REAL :: time
CHARACTER(LEN=30) :: timername
CHARACTER(LEN=40) :: attributes(2)
IF (timer%starttime>0) THEN
time=timer%time+cputime()-timer%starttime
ELSE
time=timer%time
END IF
timername=TRIM(ADJUSTL(timer%name))
timerNameLength = LEN(TRIM(ADJUSTL(timername)))
DO n = 1, timerNameLength
IF (timername(n:n).EQ.' ') THEN
timername(n:n) = '_'
END IF
IF (timername(n:n).EQ.'&') THEN
timername(n:n) = '+'
END IF
END DO
WRITE(attributes(1),'(a)') TRIM(ADJUSTL(timername))
WRITE(attributes(2),'(f12.3)') time
IF(timer%n_subtimers.EQ.0) THEN
CALL writeXMLElementForm('timer',(/'name ','value'/),attributes,&
reshape((/14+20-3*level,5,40,12/),(/2,2/)))
ELSE
CALL openXMLElementForm('compositeTimer',(/'name ','value'/),attributes,&
reshape((/5+20-3*level,5,40,12/),(/2,2/)))
DO n = 1, timer%n_subtimers
CALL privWriteTimesXML(timer%subtimer(n)%p,level+1)
END DO
CALL closeXMLElement('compositeTimer')
END IF
END SUBROUTINE privWriteTimesXML
!>
!<-- private function timestring
......
......@@ -158,20 +158,20 @@
! called once and both spin directions are calculated in a single
! go.
!
IF (mpi%irank.EQ.0) CALL openXMLElementNoAttributes('valenceDensity')
jspmax = input%jspins
IF (noco%l_mperp) jspmax = 1
DO jspin = 1,jspmax
CALL timestart("cdngen: cdnval")
CALL cdnval(eig_id,&
mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atoms,enpara,stars, vacuum,dimension,&
sphhar, sym,obsolete, igq_fft, vr,vz(:,:,jspin), oneD,&
n_mmp(-3:,-3:,:,jspin),results, qpw,rhtxy,rho,rht,cdom,cdomvz,cdomvxy,qa21, chmom,clmom)
CALL timestop("cdngen: cdnval")
DO jspin = 1,jspmax
CALL timestart("cdngen: cdnval")
CALL cdnval(eig_id,&
mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atoms,enpara,stars, vacuum,dimension,&
sphhar, sym,obsolete, igq_fft, vr,vz(:,:,jspin), oneD,&
n_mmp(-3:,-3:,:,jspin),results, qpw,rhtxy,rho,rht,cdom,cdomvz,cdomvxy,qa21, chmom,clmom)
CALL timestop("cdngen: cdnval")
!-fo
enddo
END DO
!-lda+U
IF ( (atoms%n_u.GT.0).and. (mpi%irank.EQ.0)) CALL u_mix(atoms,input%jspins,n_mmp)
DEALLOCATE ( n_mmp )
......@@ -179,9 +179,10 @@
!+t3e
IF (mpi%irank.EQ.0) THEN
!-t3e
IF (l_enpara) CLOSE (40)
IF (l_enpara) CLOSE (40)
CALL cdntot(stars,atoms,sym, vacuum,input,cell,oneD, qpw,rho,rht, qtot,dummy)
CALL cdntot(stars,atoms,sym, vacuum,input,cell,oneD, qpw,rho,rht, qtot,dummy)
CALL closeXMLElement('valenceDensity')
!
!---> changes
!
......@@ -313,7 +314,9 @@ enddo
IF (mpi%irank.EQ.0) THEN
! block 2 unnecessary for slicing: begin
IF (.NOT.sliceplot%slice) THEN
CALL openXMLElement('allElectronCharges',(/'comment'/),(/'inQFix'/))
CALL qfix(stars,atoms,sym,vacuum, sphhar,input,cell,oneD, qpw,rhtxy,rho,rht, fix)
CALL closeXMLElement('allElectronCharges')
!---> pk non-collinear
IF (noco%l_noco) THEN
!---> fix also the off-diagonal part of the density matrix
......
......@@ -119,6 +119,7 @@
USE m_potdis
USE m_mix
USE m_xmlOutput
USE m_juDFT_time
! USE m_jcoff
! USE m_jcoff2
! USE m_ssomat
......@@ -858,6 +859,7 @@
ELSE
l_cont = ( it < input%itmax )
END IF
CALL writeTimesXML()
IF (mpi%irank.EQ.0) CALL closeXMLElement('iteration')
80 CONTINUE
IF (mpi%irank.EQ.0) CALL closeXMLElement('scfLoop')
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment