Commit 7588283e authored by Daniel Wortmann's avatar Daniel Wortmann

Cleanup of forces part, new input, etc...

parent 3a758e0e
set(fleur_F77 ${fleur_F77} set(fleur_F77 ${fleur_F77}
force/relax.F #force/relax.F
) )
set(fleur_F90 ${fleur_F90} set(fleur_F90 ${fleur_F90}
force/bfgs0.f90 #force/bfgs0.f90
force/bfgs.f90 #force/bfgs.f90
force/force_b8.f90 force/force_b8.f90
force/force_0.f90 #force/force_0.f90
force/force_a12.f90 force/force_a12.f90
force/force_a21.F90 force/force_a21.F90
force/force_a21_U.f90 force/force_a21_U.f90
...@@ -17,7 +17,7 @@ force/force_a8.F90 ...@@ -17,7 +17,7 @@ force/force_a8.F90
force/force_b8.f90 force/force_b8.f90
force/force_sf.F90 force/force_sf.F90
force/force_w.F90 force/force_w.F90
force/geo.f90 #force/geo.f90
force/stern.f90 force/stern.f90
force/relaxation.F90 force/relaxation.F90
) )
MODULE m_forcew !--------------------------------------------------------------------------------
! ************************************************************ ! Copyright (c) 2019 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! Printing force components ! 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.
CONTAINS !--------------------------------------------------------------------------------
SUBROUTINE force_w(mpi,input,atoms,sym,results,cell,oneD,vacuum) MODULE m_forcew
USE m_geo ! ************************************************************
USE m_relax ! Printing force components
USE m_types ! ************************************************************
USE m_xmlOutput CONTAINS
use m_relaxation SUBROUTINE force_w(mpi,input,atoms,sym,results,cell,oneD,vacuum)
IMPLICIT NONE USE m_types
TYPE(t_mpi),INTENT(IN) :: mpi USE m_xmlOutput
TYPE(t_results),INTENT(IN) :: results USE m_relaxation
TYPE(t_oneD),INTENT(IN) :: oneD IMPLICIT NONE
TYPE(t_input),INTENT(IN) :: input TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_sym),INTENT(IN) :: sym TYPE(t_results),INTENT(INOUT):: results
TYPE(t_cell),INTENT(IN) :: cell TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_input),INTENT(IN) :: input
TYPE(t_vacuum),INTENT(IN) :: vacuum TYPE(t_sym),INTENT(IN) :: sym
! .. TYPE(t_cell),INTENT(IN) :: cell
! .. Local Scalars .. TYPE(t_atoms),INTENT(IN) :: atoms
REAL,PARAMETER:: zero=0.0 TYPE(t_vacuum),INTENT(IN) :: vacuum
REAL sum ! ..
INTEGER i,jsp,n,nat1,ierr ! .. Local Scalars ..
REAL eps_force REAL,PARAMETER:: zero=0.0
LOGICAL :: l_new,l_relax REAL sum
! .. INTEGER i,jsp,n,nat1,ierr
! .. Local Arrays .. REAL eps_force
REAL forcetot(3,atoms%ntype) LOGICAL :: l_new,l_relax
CHARACTER(LEN=20) :: attributes(7) ! ..
! ! .. Local Arrays ..
! write spin-dependent forces REAL forcetot(3,atoms%ntype)
! CHARACTER(LEN=20) :: attributes(7)
IF (mpi%irank==0) THEN !
nat1 = 1 ! write spin-dependent forces
DO n = 1,atoms%ntype !
IF (atoms%l_geo(n)) THEN IF (mpi%irank==0) THEN
IF (input%jspins.EQ.2) THEN nat1 = 1
DO jsp = 1,input%jspins DO n = 1,atoms%ntype
WRITE (6,FMT=8000) jsp,n, (atoms%pos(i,nat1),i=1,3),& IF (atoms%l_geo(n)) THEN
& (results%force(i,n,jsp),i=1,3) IF (input%jspins.EQ.2) THEN
END DO DO jsp = 1,input%jspins
END IF WRITE (6,FMT=8000) jsp,n, (atoms%pos(i,nat1),i=1,3),&
8000 FORMAT ('SPIN-',i1,1x,'FORCE FOR ATOM TYPE=',i3,2x,'X=',f7.3,& & (results%force(i,n,jsp),i=1,3)
& 3x,'Y=',f7.3,3x,'Z=',f7.3,5x,' FX_SP =',f9.6,' FY_SP =',& END DO
& f9.6,' FZ_SP =',f9.6) END IF
ENDIF 8000 FORMAT ('SPIN-',i1,1x,'FORCE FOR ATOM TYPE=',i3,2x,'X=',f7.3,&
nat1 = nat1 + atoms%neq(n) & 3x,'Y=',f7.3,3x,'Z=',f7.3,5x,' FX_SP =',f9.6,' FY_SP =',&
END DO & f9.6,' FZ_SP =',f9.6)
! ENDIF
! write total forces nat1 = nat1 + atoms%neq(n)
! END DO
WRITE (6,8005) !
8005 FORMAT (/,' ***** TOTAL FORCES ON ATOMS ***** ',/) ! write total forces
IF (input%l_f) CALL openXMLElement('totalForcesOnRepresentativeAtoms',(/'units'/),(/'Htr/bohr'/)) !
nat1 = 1 WRITE (6,8005)
DO n = 1,atoms%ntype 8005 FORMAT (/,' ***** TOTAL FORCES ON ATOMS ***** ',/)
IF (atoms%l_geo(n)) THEN IF (input%l_f) CALL openXMLElement('totalForcesOnRepresentativeAtoms',(/'units'/),(/'Htr/bohr'/))
DO i = 1,3 nat1 = 1
forcetot(i,n) = zero DO n = 1,atoms%ntype
END DO IF (atoms%l_geo(n)) THEN
DO jsp = 1,input%jspins DO i = 1,3
DO i = 1,3 forcetot(i,n) = zero
forcetot(i,n) = forcetot(i,n) + results%force(i,n,jsp) END DO
END DO DO jsp = 1,input%jspins
END DO 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),& WRITE (6,FMT=8010) n, (atoms%pos(i,nat1),i=1,3),&
& (forcetot(i,n),i=1,3) & (forcetot(i,n),i=1,3)
8010 FORMAT (' TOTAL FORCE FOR ATOM TYPE=',i3,2x,'X=',f7.3,3x,'Y=',& 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,& & f7.3,3x,'Z=',f7.3,/,22x,' FX_TOT=',f9.6,&
& ' FY_TOT=',f9.6,' FZ_TOT=',f9.6) & ' FY_TOT=',f9.6,' FZ_TOT=',f9.6)
WRITE(attributes(1),'(i0)') n WRITE(attributes(1),'(i0)') n
WRITE(attributes(2),'(f12.6)') atoms%pos(1,nat1) WRITE(attributes(2),'(f12.6)') atoms%pos(1,nat1)
WRITE(attributes(3),'(f12.6)') atoms%pos(2,nat1) WRITE(attributes(3),'(f12.6)') atoms%pos(2,nat1)
WRITE(attributes(4),'(f12.6)') atoms%pos(3,nat1) WRITE(attributes(4),'(f12.6)') atoms%pos(3,nat1)
WRITE(attributes(5),'(f12.8)') forcetot(1,n) WRITE(attributes(5),'(f12.8)') forcetot(1,n)
WRITE(attributes(6),'(f12.8)') forcetot(2,n) WRITE(attributes(6),'(f12.8)') forcetot(2,n)
WRITE(attributes(7),'(f12.8)') forcetot(3,n) WRITE(attributes(7),'(f12.8)') forcetot(3,n)
IF (input%l_f) THEN IF (input%l_f) THEN
CALL writeXMLElementFormPoly('forceTotal',(/'atomType','x ','y ','z ',& CALL writeXMLElementFormPoly('forceTotal',(/'atomType','x ','y ','z ',&
'F_x ','F_y ','F_z '/),attributes,& 'F_x ','F_y ','F_z '/),attributes,&
reshape((/8,1,1,1,3,3,3,6,12,12,12,12,12,12/),(/7,2/))) RESHAPE((/8,1,1,1,3,3,3,6,12,12,12,12,12,12/),(/7,2/)))
END IF END IF
END IF END IF
nat1 = nat1 + atoms%neq(n) nat1 = nat1 + atoms%neq(n)
END DO END DO
IF (input%l_f) CALL closeXMLElement('totalForcesOnRepresentativeAtoms') IF (input%l_f) CALL closeXMLElement('totalForcesOnRepresentativeAtoms')
sum=0.0
DO n = 1,atoms%ntype !Check convergence of force by comparing force with old_force
IF (atoms%l_geo(n)) THEN sum=MAXVAL(ABS(forcetot - results%force_old))
DO i = 1,3 results%force_old(:,:)=forcetot !Store for next iteration
sum = max(sum,(forcetot(i,n) - results%force_old(i,n))**2) results%force=0.0
ENDDO l_relax=sum<input%force_converged
ENDIF IF (.NOT.l_relax) THEN
ENDDO WRITE (6,8020) input%force_converged,sum
sum=sqrt(sum) 8020 FORMAT ('No new postions, force convergence required=',f8.5,'max force distance=',f8.5)
!-roa END IF
eps_force=0.00001 ENDIF
open(88,file='eps_force',form='formatted',status='old',err=188)
read(88,'(f20.8)') eps_force
close (88)
188 continue
!-roa
WRITE (6,8020) eps_force,sum
8020 FORMAT ('eps_force=',f8.5,'max=',f8.5)
ENDIF
l_relax=sum<eps_force
#ifdef CPP_MPI #ifdef CPP_MPI
CALL MPI_BCAST(l_relax,1,MPI_LOGICAL,0,ierr) CALL MPI_BCAST(l_relax,1,MPI_LOGICAL,0,ierr)
#endif #endif
IF (l_relax.and.input%l_f) CALL relaxation(mpi,input,atoms,cell,sym,forcetot,results%tote) IF (l_relax.AND.input%l_f) CALL relaxation(mpi,input,atoms,cell,sym,forcetot,results%tote)
END SUBROUTINE force_w END SUBROUTINE force_w
END MODULE m_forcew END MODULE m_forcew
!--------------------------------------------------------------------------------
! Copyright (c) 2016 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_relaxation MODULE m_relaxation
USE m_judft USE m_judft
IMPLICIT NONE IMPLICIT NONE
PRIVATE PRIVATE
integer:: input_force_relax=3 PUBLIC relaxation !This is the interface. Below there are internal subroutines for bfgs, simple mixing, CG ...
public relaxation
CONTAINS CONTAINS
SUBROUTINE relaxation(mpi,input,atoms,cell,sym,force_new,energies_new) SUBROUTINE relaxation(mpi,input,atoms,cell,sym,force_new,energies_new)
!This routine uses the current force,energies and atomic positions to
!generate a displacement in a relaxation step.
!The history is taken into account by read_relax from m_relaxio
!After generating new positions the code stops
USE m_types USE m_types
use m_relaxio USE m_relaxio
use m_broyd_io USE m_broyd_io
#ifdef CPP_MPI
INCLUDE 'mpif.h'
#endif
TYPE(t_mpi),INTENT(IN) :: mpi TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_input),INTENT(IN) :: input TYPE(t_input),INTENT(IN) :: input
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_sym),INTENT(IN) :: sym TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell TYPE(t_cell),INTENT(IN) :: cell
REAL,INTENT(in) :: force_new(:,:),energies_new REAL,INTENT(in) :: force_new(:,:),energies_new !data for this iteration
REAL,ALLOCATABLE :: pos(:,:,:),force(:,:,:),energies(:) REAL,ALLOCATABLE :: pos(:,:,:),force(:,:,:),energies(:)
REAL,ALLOCATABLE :: displace(:,:),old_displace(:,:) REAL,ALLOCATABLE :: displace(:,:),old_displace(:,:)
REAL :: alpha INTEGER :: n,ierr
INTEGER :: n LOGICAL :: l_conv
IF (mpi%irank==0) THEN IF (mpi%irank==0) THEN
ALLOCATE(pos(3,atoms%ntype,1)); ALLOCATE(pos(3,atoms%ntype,1));
DO n=1,atoms%ntype DO n=1,atoms%ntype
...@@ -31,39 +42,51 @@ CONTAINS ...@@ -31,39 +42,51 @@ CONTAINS
ALLOCATE(force(3,atoms%ntype,1)); force(:,:,1)=force_new ALLOCATE(force(3,atoms%ntype,1)); force(:,:,1)=force_new
ALLOCATE(energies(1));energies(1)=energies_new ALLOCATE(energies(1));energies(1)=energies_new
ALLOCATE(displace(3,atoms%ntype),old_displace(3,atoms%ntype)) ALLOCATE(displace(3,atoms%ntype),old_displace(3,atoms%ntype))
! add history ! add history
CALL read_relax(pos,force,energies) CALL read_relax(pos,force,energies)
!determine new positions !determine new positions
IF (SIZE(energies)==1.OR.input_force_relax==0) THEN IF (SIZE(energies)==1.OR.input%forcemix==0) THEN
!no history present simple step !no history present simple step
! choose a reasonable first guess for scaling ! choose a reasonable first guess for scaling
! this choice is based on a Debye temperature of 330K; ! this choice is based on a Debye temperature of 330K;
! modify as needed ! modify as needed
alpha = (250.0/(MAXVAL(atoms%zatom)*input%xa))*((330./input%thetad)**2) !alpha = (250.0/(MAXVAL(atoms%zatom)*input%xa))*((330./input%thetad)**2)
CALL simple_step(alpha,force,displace) CALL simple_step(input%forcealpha,force,displace)
ELSEIF (input_force_relax==1) THEN ELSEIF (input%forcemix==1) THEN
CALL simple_cg(pos,force,displace) CALL simple_cg(pos,force,displace)
ELSE ELSE
CALL simple_bfgs(pos,force,displace) CALL simple_bfgs(pos,force,displace)
ENDIF
!Check for convergence of forces/displacements
l_conv=.TRUE.
DO n=1,atoms%ntype
IF (DOT_PRODUCT(force(:,n,SIZE(force,3)),force(:,n,SIZE(force,3)))>input%epsforce**2) l_conv=.FALSE.
IF (DOT_PRODUCT(displace(:,n),displace(:,n))>input%epsforce**2) l_conv=.FALSE.
ENDDO
!New displacements relative to positions in inp.xml
CALL read_displacements(atoms,old_displace)
displace=displace+old_displace
!Write file
CALL write_relax(pos,force,energies,displace)
ENDIF ENDIF
#ifdef CPP_MPI
CALL read_displacements(atoms,old_displace) CALL MPI_BCAST(l_conv,1,MPI_LOGICAL,0,ierr)
DO n=1,atoms%ntype #endif
PRINT *,"OD:",old_displace(:,n) IF (l_conv) THEN
PRINT *,"ND:",displace(:,n) CALL judft_end("Structual relaxation: Done",0)
END DO ELSE
CALL resetBroydenHistory()
displace=displace+old_displace CALL judft_end("Structual relaxation: new displacements generated",0)
END IF
!Write file
CALL write_relax(pos,force,energies,displace)
ENDIF
CALL resetBroydenHistory()
CALL judft_end("Structual relaxation done",0)
END SUBROUTINE relaxation END SUBROUTINE relaxation
SUBROUTINE simple_step(alpha,force,displace) SUBROUTINE simple_step(alpha,force,displace)
...@@ -72,27 +95,27 @@ CONTAINS ...@@ -72,27 +95,27 @@ CONTAINS
REAL,INTENT(in) :: alpha REAL,INTENT(in) :: alpha
REAL,INTENT(in) :: force(:,:,:) REAL,INTENT(in) :: force(:,:,:)
REAL,INTENT(OUT) :: displace(:,:) REAL,INTENT(OUT) :: displace(:,:)
displace = alpha*force(:,:,SIZE(force,3)) displace = alpha*force(:,:,SIZE(force,3))
END SUBROUTINE simple_step END SUBROUTINE simple_step
SUBROUTINE simple_bfgs(pos,force,shift) SUBROUTINE simple_bfgs(pos,force,shift)
!----------------------------------------------- !-----------------------------------------------
! Simple BFGS method to calculate shift out of old positions and forces ! Simple BFGS method to calculate shift out of old positions and forces
!----------------------------------------------- !-----------------------------------------------
IMPLICIT NONE IMPLICIT NONE
REAL,INTENT(in) :: pos(:,:,:),force(:,:,:) REAL,INTENT(in) :: pos(:,:,:),force(:,:,:)
real,INTENT(OUT) :: shift(:,:) REAL,INTENT(OUT) :: shift(:,:)
INTEGER :: n,i,j,hist_length,n_force INTEGER :: n,i,j,hist_length,n_force
REAL,ALLOCATABLE:: h(:,:) REAL,ALLOCATABLE:: h(:,:)
REAL,ALLOCATABLE:: p(:),y(:),v(:) REAL,ALLOCATABLE:: p(:),y(:),v(:)
REAL :: py,yy,gamma REAL :: py,yy,gamma
n_force=3*size(pos,2) n_force=3*SIZE(pos,2)
allocate(h(n_force,n_force)) ALLOCATE(h(n_force,n_force))
allocate(p(n_force),y(n_force),v(n_force)) ALLOCATE(p(n_force),y(n_force),v(n_force))
!calculate approx. Hessian !calculate approx. Hessian
!initialize H !initialize H
...@@ -101,15 +124,15 @@ CONTAINS ...@@ -101,15 +124,15 @@ CONTAINS
h(n,n) = 1.0 h(n,n) = 1.0
ENDDO ENDDO
!loop over all iterations (including current) !loop over all iterations (including current)
hist_length=size(pos,3) hist_length=SIZE(pos,3)
DO n = 2,hist_length DO n = 2,hist_length
! differences ! differences
p(:) = RESHAPE(pos(:,:,n)-pos(:,:,n-1),(/SIZE(p)/)) p(:) = RESHAPE(pos(:,:,n)-pos(:,:,n-1),(/SIZE(p)/))
y(:) = RESHAPE(force(:,:,n)-force(:,:,n-1),(/SIZE(p)/)) y(:) = RESHAPE(force(:,:,n)-force(:,:,n-1),(/SIZE(p)/))
! get necessary inner products and H|y> ! get necessary inner products and H|y>
py = dot_PRODUCT(p,y) py = DOT_PRODUCT(p,y)
v = MATMUL(y,h) v = MATMUL(y,h)
yy = dot_PRODUCT(y,v) yy = DOT_PRODUCT(y,v)
!check that update will leave h positive definite; !check that update will leave h positive definite;
IF (py <= 0.0) THEN IF (py <= 0.0) THEN
WRITE (6,*) ' bfgs: <p|y> < 0' WRITE (6,*) ' bfgs: <p|y> < 0'
...@@ -135,20 +158,20 @@ CONTAINS ...@@ -135,20 +158,20 @@ CONTAINS
ENDIF ENDIF
ENDDO ENDDO
y(:) = RESHAPE(force(:,:,hist_length),(/SIZE(p)/)) y(:) = RESHAPE(force(:,:,hist_length),(/SIZE(p)/))
shift = reshape(MATMUL(y,h),shape(shift)) shift = RESHAPE(MATMUL(y,h),SHAPE(shift))
END SUBROUTINE simple_bfgs END SUBROUTINE simple_bfgs
SUBROUTINE simple_cg(pos,force,shift) SUBROUTINE simple_cg(pos,force,shift)
!----------------------------------------------- !-----------------------------------------------
IMPLICIT NONE IMPLICIT NONE
REAL,intent(in) :: pos(:,:,:),force(:,:,:) REAL,INTENT(in) :: pos(:,:,:),force(:,:,:)
real,INTENT(OUT) :: shift(:,:) REAL,INTENT(OUT) :: shift(:,:)
REAL :: f1(3,SIZE(pos,2)),f2(3,SIZE(pos,2)) REAL :: f1(3,SIZE(pos,2)),f2(3,SIZE(pos,2))
INTEGER :: n_old INTEGER :: n_old
n_old = SIZE(pos,3)-1 n_old = SIZE(pos,3)-1
f1 = (force(:,:,n_old+1)-force(:,:,n_old))/(pos(:,:,n_old+1)-pos(:,:,n_old)) f1 = (force(:,:,n_old+1)-force(:,:,n_old))/(pos(:,:,n_old+1)-pos(:,:,n_old))
f2 = force(:,:,n_old+1)-f1*pos(:,:,n_old+1) f2 = force(:,:,n_old+1)-f1*pos(:,:,n_old+1)
shift = -1.*f2/f1-force(:,:,n_old+1) shift = -1.*f2/f1-force(:,:,n_old+1)
......
...@@ -155,7 +155,7 @@ ...@@ -155,7 +155,7 @@
banddos%ndir = 0 ; vacuum%layers = 0 ; atoms%nflip(:) = 1 ; vacuum%izlay(:,:) = 0 banddos%ndir = 0 ; vacuum%layers = 0 ; atoms%nflip(:) = 1 ; vacuum%izlay(:,:) = 0
banddos%e_mcd_lo = -10.0 ; banddos%e_mcd_up = 0.0 banddos%e_mcd_lo = -10.0 ; banddos%e_mcd_up = 0.0
atoms%lda_u%l = -1 ; atoms%relax(1:2,:) = 1 ; atoms%relax(:,:) = 1 atoms%lda_u%l = -1 ; atoms%relax(1:2,:) = 1 ; atoms%relax(:,:) = 1
input%epsdisp = 0.00001 ; input%epsforce = 0.00001 ; input%xa = 2.0 ; input%thetad = 330.0 input%epsdisp = 0.00001 ; input%epsforce = 0.00001 ; input%forcealpha = 1.0
sliceplot%e1s = 0.0 ; sliceplot%e2s = 0.0 ; banddos%e1_dos = 0.5 ; banddos%e2_dos = -0.5 ; input%tkb = 0.001 sliceplot%e1s = 0.0 ; sliceplot%e2s = 0.0 ; banddos%e1_dos = 0.5 ; banddos%e2_dos = -0.5 ; input%tkb = 0.001
banddos%sig_dos = 0.015 ; vacuum%tworkf = 0.0 ; input%scaleCell = 1.0 ; scpos = 1.0 banddos%sig_dos = 0.015 ; vacuum%tworkf = 0.0 ; input%scaleCell = 1.0 ; scpos = 1.0
input%scaleA1 = 1.0 ; input%scaleA2 = 1.0 ; input%scaleC = 1.0 input%scaleA1 = 1.0 ; input%scaleA2 = 1.0 ; input%scaleC = 1.0
......
...@@ -666,11 +666,11 @@ input%preconditioning_param = evaluateFirstOnly(xmlGetAttributeValue('/fleurInpu ...@@ -666,11 +666,11 @@ input%preconditioning_param = evaluateFirstOnly(xmlGetAttributeValue('/fleurInpu
IF (numberNodes.EQ.1) THEN IF (numberNodes.EQ.1) THEN
input%l_f = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@l_f')) input%l_f = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@l_f'))
input%xa = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@xa')) input%forcealpha = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@forcealpha'))
input%thetad = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@thetad'))
input%epsdisp = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@epsdisp')) input%epsdisp = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@epsdisp'))
input%epsforce = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@epsforce')) input%epsforce = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@epsforce'))
input%forcemix = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@forcemix'))
input%force_converged = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@force_converged'))
numberNodes = xmlGetNumberOfNodes(TRIM(ADJUSTL(xPathA))//'/@qfix') numberNodes = xmlGetNumberOfNodes(TRIM(ADJUSTL(xPathA))//'/@qfix')
IF (numberNodes.EQ.1) THEN IF (numberNodes.EQ.1) THEN
input%qfix = 1 input%qfix = 1
......
...@@ -5,6 +5,9 @@ ...@@ -5,6 +5,9 @@
!-------------------------------------------------------------------------------- !--------------------------------------------------------------------------------
MODULE m_relaxio MODULE m_relaxio
!This module handles IO to the relax.xml file
!The writing is done directly to relax.xml
!The reading uses the libxml interface to inp.xml. Hence the relax.xml has to be included here.
USE m_judft USE m_judft
IMPLICIT NONE IMPLICIT NONE
PRIVATE PRIVATE
...@@ -19,7 +22,7 @@ CONTAINS ...@@ -19,7 +22,7 @@ CONTAINS
INTEGER :: no_steps,n,ntype,step INTEGER :: no_steps,n,ntype,step
No_steps=SIZE(positions,3) No_steps=SIZE(positions,3)
ntype=SIZE(positions,2) ntype=SIZE(positions,2)
IF (ntype.NE.SIZE(forces,2).OR.ntype.ne.SIZE(displace,2).OR.& IF (ntype.NE.SIZE(forces,2).OR.ntype.NE.SIZE(displace,2).OR.&
no_steps.NE.SIZE(forces,3).OR.no_steps.NE.SIZE(energies))THEN no_steps.NE.SIZE(forces,3).OR.no_steps.NE.SIZE(energies))THEN
CALL judft_error("BUG in relax_io") CALL judft_error("BUG in relax_io")
ENDIF ENDIF
...@@ -32,7 +35,7 @@ CONTAINS ...@@ -32,7 +35,7 @@ CONTAINS
' <displace>',displace(:,n),'</displace>' ' <displace>',displace(:,n),'</displace>'
END DO END DO
WRITE(765,"(a)") ' </displacements>' WRITE(765,"(a)") ' </displacements>'
!Write all known old positions,forces and energies !Write all known old positions,forces and energies
WRITE(765,*) " <relaxation-history>" WRITE(765,*) " <relaxation-history>"
DO step=1,no_steps DO step=1,no_steps
...@@ -47,14 +50,14 @@ CONTAINS ...@@ -47,14 +50,14 @@ CONTAINS
WRITE(765,*) "</relaxation>" WRITE(765,*) "</relaxation>"
CLOSE(765) CLOSE(765)
END SUBROUTINE write_relax END SUBROUTINE write_relax
SUBROUTINE read_relax(positions,forces,energies) SUBROUTINE read_relax(positions,forces,energies)
USE m_xmlIntWrapFort USE m_xmlIntWrapFort
USE m_calculator USE m_calculator
REAL,INTENT(INOUT),ALLOCATABLE:: positions(:,:,:) REAL,INTENT(INOUT),ALLOCATABLE:: positions(:,:,:)
REAL,INTENT(INOUT),ALLOCATABLE:: forces(:,:,:) REAL,INTENT(INOUT),ALLOCATABLE:: forces(:,:,:)
REAL,INTENT(INOUT),ALLOCATABLE:: energies(:)