Commit a0f14ff2 authored by Gregor Michalicek's avatar Gregor Michalicek

Experimental: write struct_force.xsf after each force calculation step

...only slightly tested.
parent 6645cae4
...@@ -42,6 +42,7 @@ CONTAINS ...@@ -42,6 +42,7 @@ CONTAINS
USE m_rinpXML USE m_rinpXML
USE m_winpXML USE m_winpXML
USE m_init_wannier_defaults USE m_init_wannier_defaults
USE m_xsf_io
IMPLICIT NONE IMPLICIT NONE
TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_cell),INTENT(IN) :: cell TYPE(t_cell),INTENT(IN) :: cell
...@@ -101,6 +102,7 @@ CONTAINS ...@@ -101,6 +102,7 @@ CONTAINS
CHARACTER(LEN=20) :: filename CHARACTER(LEN=20) :: filename
REAL :: a1_temp(3),a2_temp(3),a3_temp(3) REAL :: a1_temp(3),a2_temp(3),a3_temp(3)
REAL :: scale_temp, dtild_temp REAL :: scale_temp, dtild_temp
REAL :: forceAllAtoms(3,atoms%nat)
CLASS(t_forcetheo),ALLOCATABLE:: forcetheo CLASS(t_forcetheo),ALLOCATABLE:: forcetheo
input=input_in input=input_in
atoms_new=atoms atoms_new=atoms
...@@ -135,9 +137,33 @@ CONTAINS ...@@ -135,9 +137,33 @@ CONTAINS
ENDDO ENDDO
istep = 1 istep = 1
CALL bfgs(atoms%ntype,istep,istep0,forcetot,& CALL bfgs(atoms%ntype,istep,istep0,forcetot,zat,input%xa,input%thetad,input%epsdisp,&
& zat,input%xa,input%thetad,input%epsdisp,input%epsforce,tote,& input%epsforce,tote,xold,y,h,tau0,lconv)
& xold,y,h,tau0, lconv)
!write out struct_force.xsf file
forceAllAtoms = 0.0
na = 0
DO itype=1,atoms%ntype
forcetot(:,itype)=MATMUL(cell%bmat,forcetot(:,itype))/tpi_const ! to inner coordinates
DO ieq = 1,atoms%neq(itype)
na = na + 1
jop = sym%invtab(atoms%ngopr(na))
IF (oneD%odi%d1) jop = oneD%ods%ngopr(na)
DO i = 1,3
DO j = 1,3
IF (.NOT.oneD%odi%d1) THEN
forceAllAtoms(i,na) = forceAllAtoms(i,na) + sym%mrot(i,j,jop) * forcetot(j,itype)
ELSE
forceAllAtoms(i,na) = forceAllAtoms(i,na) + oneD%ods%mrot(i,j,jop) * forcetot(j,itype)
END IF
END DO
END DO
forceAllAtoms(:,na) = MATMUL(cell%amat,forceAllAtoms(:,na)) ! to external coordinates
END DO
END DO
OPEN (55,file="struct_force.xsf",status='replace')
CALL xsf_WRITE_atoms(55,atoms,input%film,.false.,cell%amat,forceAllAtoms)
CLOSE (55)
IF (lconv) THEN IF (lconv) THEN
WRITE (6,'(a)') "Des woars!" WRITE (6,'(a)') "Des woars!"
......
...@@ -15,7 +15,7 @@ MODULE m_xsf_io ...@@ -15,7 +15,7 @@ MODULE m_xsf_io
CONTAINS CONTAINS
!<-- S:S: xsf_WRITE_atoms(fileno,film,amat,neq(:ntype),zatom(:ntype),pos) !<-- S:S: xsf_WRITE_atoms(fileno,film,amat,neq(:ntype),zatom(:ntype),pos)
SUBROUTINE xsf_WRITE_atoms(fileno,atoms,film,od,amat) SUBROUTINE xsf_WRITE_atoms(fileno,atoms,film,od,amat,forceAllAtoms)
!----------------------------------------------- !-----------------------------------------------
! Writes the crystal dimensions&atomic positions ! Writes the crystal dimensions&atomic positions
! (last modified: 2004-00-00) D. Wortmann ! (last modified: 2004-00-00) D. Wortmann
...@@ -27,6 +27,7 @@ CONTAINS ...@@ -27,6 +27,7 @@ CONTAINS
LOGICAL,INTENT(IN) :: film LOGICAL,INTENT(IN) :: film
LOGICAL,INTENT(IN) :: od LOGICAL,INTENT(IN) :: od
REAL,INTENT(IN) :: amat(3,3) REAL,INTENT(IN) :: amat(3,3)
REAL, OPTIONAL, INTENT(IN) :: forceAllAtoms(3,atoms%nat)
!> !>
!<-- Locals !<-- Locals
INTEGER :: n,nn,na INTEGER :: n,nn,na
...@@ -52,8 +53,11 @@ CONTAINS ...@@ -52,8 +53,11 @@ CONTAINS
na = 1 na = 1
DO n = 1,SIZE(atoms%neq) DO n = 1,SIZE(atoms%neq)
DO nn = 1,atoms%neq(n) DO nn = 1,atoms%neq(n)
WRITE(fileno,'(i4,2x,3(f0.7,1x))') NINT(atoms%zatom(n)),& IF (PRESENT(forceAllAtoms)) THEN
& atoms%pos(:,na)*a0 WRITE(fileno,'(i4,2x,6(f0.7,1x))') NINT(atoms%zatom(n)),atoms%pos(:,na)*a0,forceAllAtoms(:,na)/a0
ELSE
WRITE(fileno,'(i4,2x,3(f0.7,1x))') NINT(atoms%zatom(n)),atoms%pos(:,na)*a0
END IF
na=na+1 na=na+1
ENDDO ENDDO
ENDDO ENDDO
......
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