Commit 9d9906c2 authored by Daniel Wortmann's avatar Daniel Wortmann

Removed jij data-type, added first implementation of further force-theorem...

Removed jij data-type, added first implementation of further force-theorem modes, these lack tests&support in xml-shema
parent 6ddaa944
......@@ -8,7 +8,7 @@ MODULE m_genNewNocoInp
CONTAINS
SUBROUTINE genNewNocoInp(input,atoms,jij,noco,noco_new)
SUBROUTINE genNewNocoInp(input,atoms,noco,noco_new)
USE m_juDFT
USE m_types
......@@ -19,7 +19,6 @@ SUBROUTINE genNewNocoInp(input,atoms,jij,noco,noco_new)
TYPE(t_input),INTENT(IN) :: input
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_jij),INTENT(IN) :: jij
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_noco),INTENT(INOUT) :: noco_new
......@@ -50,7 +49,7 @@ SUBROUTINE genNewNocoInp(input,atoms,jij,noco,noco_new)
OPEN (24,file='nocoinp',form='formatted', status='old')
REWIND (24)
CALL rw_noco_write(atoms,jij,noco_new, input)
CALL rw_noco_write(atoms,noco_new, input)
CLOSE (24)
END SUBROUTINE genNewNocoInp
......
......@@ -19,7 +19,7 @@ CONTAINS
!> The matrices generated and diagonalized here are of type m_mat as defined in m_types_mat.
!>@author D. Wortmann
SUBROUTINE eigen(mpi,stars,sphhar,atoms,obsolete,xcpot,&
sym,kpts,DIMENSION, vacuum, input, cell, enpara_in,enpara,banddos, noco,jij, oneD,hybrid,&
sym,kpts,DIMENSION, vacuum, input, cell, enpara_in,enpara,banddos, noco, oneD,hybrid,&
it,eig_id,results,inden,v,vx)
USE m_constants, ONLY : pi_const,sfp_const
USE m_types
......@@ -55,7 +55,6 @@ CONTAINS
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_banddos),INTENT(IN) :: banddos
TYPE(t_jij),INTENT(IN) :: jij
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_cell),INTENT(IN) :: cell
......@@ -154,7 +153,7 @@ CONTAINS
CALL lapw%init(input,noco, kpts,atoms,sym,nk,cell,l_zref, mpi)
call timestart("Setup of H&S matrices")
CALL eigen_hssetup(jsp,mpi,DIMENSION,hybrid,enpara,input,vacuum,noco,jij,sym,&
CALL eigen_hssetup(jsp,mpi,DIMENSION,hybrid,enpara,input,vacuum,noco,sym,&
stars,cell,sphhar,atoms,ud,td,v,lapw,l_real,smat,hmat)
CALL timestop("Setup of H&S matrices")
......@@ -191,13 +190,8 @@ CONTAINS
#else
ne_found=ne_all
#endif
!jij%eig_l = 0.0 ! need not be used, if hdf-file is present
IF (.NOT.l_real) THEN
IF (.NOT.jij%l_J) THEN
zMat%data_c(:lapw%nmat,:ne_found) = CONJG(zMat%data_c(:lapw%nmat,:ne_found))
ELSE
zMat%data_c(:lapw%nmat,:ne_found) = CMPLX(0.0,0.0)
ENDIF
ENDIF
CALL write_eig(eig_id, nk,jsp,ne_found,ne_all,&
eig(:ne_found),n_start=mpi%n_size,n_end=mpi%n_rank,zmat=zMat)
......
......@@ -15,7 +15,7 @@ CONTAINS
!! 4. The vacuum part is added (in hsvac())
!! 5. The matrices are copied to the final matrix, in the noco-case the full matrix is constructed from the 4-parts.
SUBROUTINE eigen_hssetup(isp,mpi,DIMENSION,hybrid,enpara,input,vacuum,noco,jij,sym,&
SUBROUTINE eigen_hssetup(isp,mpi,DIMENSION,hybrid,enpara,input,vacuum,noco,sym,&
stars,cell,sphhar,atoms,ud,td,v,lapw,l_real,smat_final,hmat_final)
USE m_hs_int
USE m_hsvac
......@@ -33,7 +33,6 @@ CONTAINS
TYPE(t_input),INTENT(IN) :: input
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_jij),INTENT(IN) :: jij
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_cell),INTENT(IN) :: cell
......@@ -82,7 +81,7 @@ CONTAINS
IF (input%film) THEN
CALL timestart("Vacuum part")
CALL hsvac(vacuum,stars,DIMENSION, atoms,mpi,isp,input,v,enpara%evac0,cell,&
lapw,sym, noco,jij,hmat,smat)
lapw,sym, noco,hmat,smat)
CALL timestop("Vacuum part")
ENDIF
!Now copy the data into final matrix
......
......@@ -12,7 +12,7 @@ CONTAINS
!-----------------------------------------------------------
SUBROUTINE hsvac(&
vacuum,stars,DIMENSION, atoms,mpi,jsp,input,v,evac,cell,&
lapw,sym, noco,jij,hmat,smat)
lapw,sym, noco,hmat,smat)
USE m_vacfun
......@@ -22,7 +22,6 @@ CONTAINS
TYPE(t_input),INTENT(IN) :: input
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_jij),INTENT(IN) :: jij
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_cell),INTENT(IN) :: cell
......@@ -57,13 +56,10 @@ CONTAINS
REAL ddnv(DIMENSION%nv2d,DIMENSION%jspd),dudz(DIMENSION%nv2d,DIMENSION%jspd)
REAL duz(DIMENSION%nv2d,DIMENSION%jspd), udz(DIMENSION%nv2d,DIMENSION%jspd)
REAL uz(DIMENSION%nv2d,DIMENSION%jspd)
! l_J auxiliary potential array
COMPLEX, ALLOCATABLE :: vxy1(:,:,:)
! ..
d2 = SQRT(cell%omtil/cell%area)
IF (jij%l_J) ALLOCATE (vxy1(vacuum%nmzxyd,stars%ng2-1,2))
!---> set up mapping function from 3d-->2d lapws
......
......@@ -9,7 +9,7 @@ MODULE m_od_hsvac
CONTAINS
SUBROUTINE od_hsvac(&
vacuum,stars,DIMENSION, oneD,atoms, jsp,input,vxy,vz,evac,cell,&
bkpt,lapw, MM,vM,m_cyl,n2d_1, n_size,n_rank,sym,noco,jij,nv2,l_real,hamOvlp)
bkpt,lapw, MM,vM,m_cyl,n2d_1, n_size,n_rank,sym,noco,nv2,l_real,hamOvlp)
! subroutine for calculating the hamiltonian and overlap matrices in
! the vacuum in the case of 1-dimensional calculations
......@@ -25,7 +25,6 @@ CONTAINS
TYPE(t_input),INTENT(IN) :: input
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_jij),INTENT(IN) :: jij
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_cell),INTENT(IN) :: cell
......@@ -70,14 +69,11 @@ CONTAINS
REAL, ALLOCATABLE :: ddnv(:,:,:),dudz(:,:,:)
REAL, ALLOCATABLE :: duz(:,:,:)
REAL, ALLOCATABLE :: udz(:,:,:),uz(:,:,:)
! l_J auxiliary potential array
COMPLEX, ALLOCATABLE :: vxy1(:,:,:)
! ..
ic = CMPLX(0.,1.)
d2 = SQRT(cell%omtil/cell%area)
IF (jij%l_J) ALLOCATE (vxy1(vacuum%nmzxyd,n2d_1-1,2))
ALLOCATE (&
ai(-vM:vM,DIMENSION%nv2d,DIMENSION%nvd),bi(-vM:vM,DIMENSION%nv2d,DIMENSION%nvd),&
nvp(DIMENSION%nv2d,DIMENSION%jspd),ind(stars%ng2,DIMENSION%nv2d,DIMENSION%jspd),&
......@@ -133,35 +129,13 @@ CONTAINS
!---> load the non-warping part of the potential
READ (25)((vz(imz,ivac,ipot),imz=1,vacuum%nmzd),ipot=1,4)
npot = 3
!---> for J-coeff. we average the up-up and down-down parts
!---> and off-diagonal elements of the potential matrix to zero
IF (jij%l_J) THEN
vz(:,ivac,1) = (vz(:,ivac,1) + vz(:,ivac,2))/2.
vz(:,ivac,2) = vz(:,ivac,1)
vz(:,ivac,3) = 0.0
vz(:,ivac,4) = 0.0
END IF
ENDIF
DO ipot = 1,npot
IF (noco%l_noco) THEN
IF (.NOT.jij%l_J) THEN
READ (25)((vxy(imz,k,ivac), imz=1,vacuum%nmzxy),k=1,n2d_1-1)
END IF
READ (25)((vxy(imz,k,ivac), imz=1,vacuum%nmzxy),k=1,n2d_1-1)
!---> l_J we want to average the diagonal elements of the pot. matrix
IF (jij%l_J .AND. ipot.EQ.1) THEN
READ (25)((vxy(imz,k,ivac), imz=1,vacuum%nmzxy),k=1,n2d_1-1)
READ (25)((vxy1(imz,k,ivac), imz=1,vacuum%nmzxy),k=1,n2d_1-1)
vxy(:,:,ivac) = (vxy(:,:,ivac)+vxy1(:,:,ivac))/2.
END IF
IF (jij%l_J .AND. ipot.EQ.3) THEN
READ (25)((vxy(imz,k,ivac), imz=1,vacuum%nmzxy),k=1,n2d_1-1)
END IF
IF (jij%l_J .AND. ipot.EQ.3) vxy(:,:,ivac)=CMPLX(0.,0.)
ENDIF ! loco
! get the wavefunctions and set up the tuuv, etc matrices
......@@ -354,8 +328,6 @@ CONTAINS
ENDDO !ipot
IF (jij%l_J) DEALLOCATE (vxy1)
DEALLOCATE (ai,bi,nvp,ind,kvac3,map1, tddv,tduv,tudv,tuuv,a,b,bess,dbss,bess1, ddnv,dudz,duz,udz,uz )
RETURN
......
......@@ -11,4 +11,5 @@ eigen_soc/sointg.f90
eigen_soc/sorad.f90
eigen_soc/spnorb.f90
eigen_soc/vso.f90
eigen_soc/ssomat.F90
)
......@@ -13,9 +13,6 @@ MODULE m_spnorb
!*********************************************************************
CONTAINS
SUBROUTINE spnorb(atoms,noco,input,mpi, enpara, vr, usdus, rsoc,l_angles)
USE m_anglso
USE m_sgml
USE m_sorad
USE m_types
IMPLICIT NONE
......@@ -37,12 +34,7 @@ CONTAINS
INTEGER is1,is2,jspin1,jspin2,l,l1,l2,m1,m2,n
LOGICAL, SAVE :: first_k = .TRUE.
! ..
! .. Local Arrays ..
INTEGER ispjsp(2)
! ..
! ..
DATA ispjsp/1,-1/
!Allocate space for SOC matrix elements; set to zero at the same time
ALLOCATE(rsoc%rsopp (atoms%ntype,atoms%lmaxd,2,2));rsoc%rsopp =0.0
ALLOCATE(rsoc%rsoppd (atoms%ntype,atoms%lmaxd,2,2));rsoc%rsoppd=0.0
......@@ -97,10 +89,34 @@ CONTAINS
9000 FORMAT (5x,' p ',5x,' d ', 5x, ' f ')
!
IF (.NOT.l_angles) RETURN
!Calculate angular matrix elements if requested
IF (l_angles) &
CALL spnorb_angles(atoms,mpi,noco%theta,noco%phi,rsoc%soangl)
END SUBROUTINE spnorb
IF ((ABS(noco%theta).LT.0.00001).AND.(ABS(noco%phi).LT.0.00001)) THEN
SUBROUTINE spnorb_angles(atoms,mpi,theta,phi,soangl)
USE m_anglso
USE m_sgml
USE m_sorad
USE m_types
IMPLICIT NONE
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_mpi),INTENT(IN) :: mpi
REAL,INTENT(IN) :: theta,phi
COMPLEX,INTENT(INOUT) :: soangl(:,-atoms%lmaxd:,:,:,-atoms%lmaxd:,:)
! ..
! ..
! .. Local Scalars ..
INTEGER is1,is2,jspin1,jspin2,l,l1,l2,m1,m2,n
! ..
! .. Local Arrays ..
INTEGER ispjsp(2)
! ..
! ..
DATA ispjsp/1,-1/
IF ((ABS(theta).LT.0.00001).AND.(ABS(phi).LT.0.00001)) THEN
!
! TEST for real function sgml(l1,m1,is1,l2,m2,is2)
!
......@@ -112,7 +128,7 @@ CONTAINS
is2=ispjsp(jspin2)
DO m1 = -l1,l1,1
DO m2 = -l2,l2,1
rsoc%soangl(l1,m1,jspin1,l2,m2,jspin2) =&
soangl(l1,m1,jspin1,l2,m2,jspin2) =&
CMPLX(sgml(l1,m1,is1,l2,m2,is2),0.0)
ENDDO
ENDDO
......@@ -134,8 +150,8 @@ CONTAINS
!
DO m1 = -l1,l1,1
DO m2 = -l2,l2,1
rsoc%soangl(l1,m1,jspin1,l2,m2,jspin2) =&
anglso(noco%theta,noco%phi,l1,m1,is1,l2,m2,is2)
soangl(l1,m1,jspin1,l2,m2,jspin2) =&
anglso(theta,phi,l1,m1,is1,l2,m2,is2)
ENDDO
ENDDO
!
......@@ -152,7 +168,7 @@ CONTAINS
DO jspin2 = 1,2
WRITE (6,FMT=*) 'd-states:is1=',jspin1,',is2=',jspin2
WRITE (6,FMT='(7x,7i8)') (m1,m1=-3,3,1)
WRITE (6,FMT=8003) (m2, (rsoc%soangl(3,m1,jspin1,3,m2,jspin2),&
WRITE (6,FMT=8003) (m2, (soangl(3,m1,jspin1,3,m2,jspin2),&
m1=-3,3,1),m2=-3,3,1)
ENDDO
ENDDO
......@@ -160,5 +176,5 @@ CONTAINS
8002 FORMAT (' so - angular matrix elements')
8003 FORMAT (i8,14f8.4)
END SUBROUTINE spnorb
END SUBROUTINE spnorb_angles
END MODULE m_spnorb
This diff is collapsed.
......@@ -7,7 +7,7 @@
MODULE m_ferhis
CONTAINS
SUBROUTINE ferhis(input,kpts,mpi,results, index,idxeig,idxkpt,idxjsp,n,&
nstef,ws,spindg,weight, e,ne,we, noco,jij,cell)
nstef,ws,spindg,weight, e,ne,we, noco,cell)
!***********************************************************************
!
! This subroutine determines the fermi energy and the sum of the
......@@ -60,7 +60,6 @@ CONTAINS
TYPE(t_input),INTENT(IN) :: input
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_noco),INTENT(IN),OPTIONAL :: noco
TYPE(t_jij),INTENT(IN),OPTIONAL :: jij
TYPE(t_cell),INTENT(IN),OPTIONAL :: cell
! ..
! .. Scalar Arguments ..
......@@ -295,20 +294,6 @@ CONTAINS
WRITE (6,FMT=8040) results%seigv
END IF
!--- J constants
IF (PRESENT(jij)) THEN
IF (jij%l_J) THEN
IF (jij%l_disp) THEN
qc=MATMUL(noco%qss,cell%bmat)
WRITE (114,FMT=1001) noco%qss(1),noco%qss(2),noco%qss(3),SQRT(dot_product(qc,qc)),results%seigv
ELSE
WRITE (114,FMT=1002) noco%qss(1),noco%qss(2),noco%qss(3),results%seigv
ENDIF
ENDIF
1001 FORMAT (4(f14.10,1x),f20.10)
1002 FORMAT (3(f14.10,1x),f20.10)
ENDIF
!--- J constants
!
! 7.12.95 r.pentcheva seigscv = seigsc + seigv will be
......
......@@ -8,7 +8,7 @@ MODULE m_fermie
!----------------------------------------------------------------------
CONTAINS
SUBROUTINE fermie(eig_id, mpi,kpts,obsolete,&
input, noco,e_min,jij,cell,results)
input, noco,e_min,cell,results)
!---------------------------------------------------f--------------------
!
......@@ -44,7 +44,6 @@ CONTAINS
TYPE(t_obsolete),INTENT(IN) :: obsolete
TYPE(t_input),INTENT(IN) :: input
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_jij),INTENT(IN) :: jij
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_kpts),INTENT(IN) :: kpts
! ..
......@@ -102,18 +101,6 @@ CONTAINS
! initiliaze e
e = 0
!
IF (jij%l_J) THEN
#if defined(CPP_MPI)&&defined(CPP_NEVER)
CALL mpi_col_eigJ(mpi%mpi_comm,mpi%irank,mpi%isize,kpts%nkpt,SIZE(results%w_iks,1),kpts%nkpt,&
& jij%nkpt_l,jij%eig_l,&
& kpts%bk,kpts%wtkpt,ne(1,1),eig)
IF (mpi%irank.NE.0) THEN
DEALLOCATE( idxeig,idxjsp,idxkpt,index,e,eig,we )
RETURN
ENDIF
#endif
ENDIF
IF ( mpi%irank == 0 ) WRITE (6,FMT=8000)
......@@ -223,7 +210,7 @@ CONTAINS
IF (noco%l_noco) nspins = 1
tkb_1 = input%tkb
CALL ferhis(input,kpts,mpi,results,index,idxeig,idxkpt,idxjsp, n,&
nstef,ws,spindg,weight,e,ne,we, noco,jij,cell)
nstef,ws,spindg,weight,e,ne,we, noco,cell)
END IF
! 7.12.95 r.pentcheva seigscv must be calculated outside if (gauss)
results%seigscv = results%seigsc + results%seigv
......
......@@ -12,7 +12,7 @@ CONTAINS
! *********************************************************************
! * calculates the NEW atomic positions after the results%force calculation *
! * SUBROUTINE is based on a BFGS method implemented by jij%M. Weinert *
! * SUBROUTINE is based on a BFGS method implemented by M. Weinert *
! * [cf. PRB 52 (9) p. 6313 (1995)] *
! * *
! * as a first step we READ in the file 'inp' WITH some additional *
......@@ -82,7 +82,6 @@ CONTAINS
TYPE(t_enpara) :: enpara_temp
TYPE(t_xcpot) :: xcpot_temp
TYPE(t_results) :: results_temp
TYPE(t_jij) :: jij_temp
TYPE(t_kpts) :: kpts_temp
TYPE(t_hybrid) :: hybrid_temp
TYPE(t_oneD) :: oneD_temp
......@@ -182,7 +181,7 @@ CONTAINS
ALLOCATE(xmlCoreOccs(1,1,1))
CALL initWannierDefaults(wann_temp)
CALL r_inpXML(atoms_temp,obsolete_temp,vacuum_temp,input_temp,stars_temp,sliceplot_temp,&
banddos_temp,dimension_temp,forcetheo,cell_temp,sym_temp,xcpot_temp,noco_temp,Jij_temp,&
banddos_temp,dimension_temp,forcetheo,cell_temp,sym_temp,xcpot_temp,noco_temp,&
oneD_temp,hybrid_temp,kpts_temp,enpara_temp,coreSpecInput_temp,wann_temp,noel_temp,&
namex_temp,relcor_temp,a1_temp,a2_temp,a3_temp,dtild_temp,xmlElectronStates,&
xmlPrintCoreStates,xmlCoreOccs,atomTypeSpecies,speciesRepAtomType,l_kpts_temp)
......@@ -194,7 +193,7 @@ CONTAINS
div(:) = MIN(kpts_temp%nkpt3(:),1)
stars_temp%gmax = stars_temp%gmaxInit
CALL w_inpXML(atoms_new,obsolete_temp,vacuum_temp,input_temp,stars_temp,sliceplot_temp,forcetheo,&
banddos_temp,cell_temp,sym_temp,xcpot_temp,noco_temp,jij_temp,oneD_temp,hybrid_temp,&
banddos_temp,cell_temp,sym_temp,xcpot_temp,noco_temp,oneD_temp,hybrid_temp,&
kpts_temp,kpts_temp%nkpt3,kpts_temp%l_gamma,noel_temp,namex_temp,relcor_temp,a1_temp,a2_temp,a3_temp,&
dtild_temp,input_temp%comment,xmlElectronStates,xmlPrintCoreStates,xmlCoreOccs,&
atomTypeSpecies,speciesRepAtomType,.FALSE.,filename,.TRUE.,numSpecies,enpara_temp)
......
......@@ -3,8 +3,9 @@ set(fleur_F77 ${fleur_F77}
set(fleur_F90 ${fleur_F90}
forcetheorem/types_forcetheo_extended.F90
forcetheorem/mae.F90
forcetheorem/dmi.F90
forcetheorem/jij.F90
forcetheorem/ssdisp.F90
)
set(inpgen_F90 ${inpgen_F90}
forcetheorem/types_forcetheo_extended.F90
forcetheorem/mae.F90
)
!--------------------------------------------------------------------------------
! 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_types_dmi
USE m_judft
USE m_types_forcetheo
TYPE,EXTENDS(t_forcetheo) :: t_forcetheo_dmi
INTEGER :: q_done
REAL,ALLOCATABLE:: qvec(:,:)
REAL,ALLOCATABLE:: theta(:)
REAL,ALLOCATABLE:: phi(:)
REAL,ALLOCATABLE:: evsum(:,:)
CONTAINS
PROCEDURE :: start =>dmi_start
PROCEDURE :: next_job=>dmi_next_job
PROCEDURE :: eval =>dmi_eval
PROCEDURE :: postprocess => dmi_postprocess
PROCEDURE :: init => dmi_init !not overloaded
PROCEDURE :: dist => dmi_dist !not overloaded
END TYPE t_forcetheo_dmi
CONTAINS
SUBROUTINE dmi_init(this,q,theta_s,phi_s)
USE m_calculator
USE m_constants
IMPLICIT NONE
CLASS(t_forcetheo_dmi),INTENT(INOUT):: this
REAL,INTENT(in) :: q(:,:)
CHARACTER(len=*),INTENT(INOUT) :: theta_s,phi_s
CALL evaluateList(this%theta,theta_s)
CALL evaluateList(this%phi,phi_s)
IF (SIZE(this%phi).NE.SIZE(this%theta)) CALL &
judft_error("Lists for theta/phi must have the same length in DMI force theorem calculations")
! use same definition of rotation angles as in noco-routines
this%theta=-this%theta
this%phi=this%phi+pi_const
ALLOCATE(this%qvec(3,SIZE(q,2)))
this%qvec=q
ALLOCATE(this%evsum(0:SIZE(this%phi),SIZE(q,2)))
this%evsum=0
END SUBROUTINE dmi_init
SUBROUTINE dmi_start(this)
IMPLICIT NONE
CLASS(t_forcetheo_dmi),INTENT(INOUT):: this
this%q_done=0
CALL this%t_forcetheo%start() !call routine of basis type
END SUBROUTINE dmi_start
LOGICAL FUNCTION dmi_next_job(this,lastiter,noco)
USE m_types_setup
USE m_xmlOutput
IMPLICIT NONE
CLASS(t_forcetheo_dmi),INTENT(INOUT):: this
LOGICAL,INTENT(IN) :: lastiter
!Stuff that might be modified...
TYPE(t_noco),INTENT(INOUT) :: noco
IF (.NOT.lastiter) THEN
dmi_next_job=this%t_forcetheo%next_job(lastiter,noco)
RETURN
ENDIF
!OK, now we start the DMI-loop
this%q_done=this%q_done+1
dmi_next_job=(this%q_done<=SIZE(this%qvec,2)) !still q-vectors to do
IF (.NOT.dmi_next_job) RETURN
!Now modify the noco-file
noco%qss=this%qvec(:,this%q_done)
IF (this%q_done.NE.1) CALL closeXMLElement('Forcetheorem_Loop_DMI')
CALL openXMLElementPoly('Forcetheorem_Loop_DMI',(/'Q-vec:'/),(/this%q_done/))
END FUNCTION dmi_next_job
SUBROUTINE dmi_postprocess(this)
USE m_xmlOutput
IMPLICIT NONE
CLASS(t_forcetheo_dmi),INTENT(INOUT):: this
!Locals
INTEGER:: n,q
CHARACTER(LEN=12):: attributes(4)
!Now output the results
call closeXMLElement('Forcetheorem_Loop_DMI')
CALL openXMLElementPoly('Forcetheorem_DMI',(/'qPoints','Angles '/),(/SIZE(this%evsum,2),SIZE(this%evsum,2)/))
DO q=1,SIZE(this%evsum,2)
WRITE(attributes(1),'(i5)') q
WRITE(attributes(2),'(f12.7)') this%evsum(0,q)
CALL writeXMLElementForm('Entry',(/'q ','ev-sum'/),attributes(1:2),&
RESHAPE((/1,6,5,12/),(/2,2/)))
DO n=1,SIZE(this%evsum,1)-1
WRITE(attributes(2),'(f12.7)') this%theta(n)
WRITE(attributes(3),'(f12.7)') this%phi(n)
WRITE(attributes(4),'(f12.7)') this%evsum(n,q)
CALL writeXMLElementForm('Entry',(/'q ','theta ','phi ','ev-sum'/),attributes,&
RESHAPE((/1,5,3,6,5,12,12,12/),(/4,2/)))
END DO
ENDDO
CALL closeXMLElement('Forcetheorem_DMI')
END SUBROUTINE dmi_postprocess
SUBROUTINE dmi_dist(this,mpi)
USE m_types_mpi
IMPLICIT NONE
CLASS(t_forcetheo_dmi),INTENT(INOUT):: this
TYPE(t_mpi),INTENT(in):: mpi
INTEGER:: i,q,ierr
#ifdef CPP_MPI
INCLUDE 'mpif.h'
IF (mpi%irank==0) i=SIZE(this%theta)
call MPI_BCAST(i,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
IF (mpi%irank==0) q=SIZE(this%qvec,2)
CALL MPI_BCAST(q,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
IF (mpi%irank.NE.0) ALLOCATE(this%qvec(3,q),this%phi(i),this%theta(i),this%evsum(0:i,q));this%evsum=0.0
CALL MPI_BCAST(this%phi,i,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(this%theta,i,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(this%qvec,3*q,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
#endif
END SUBROUTINE dmi_dist
FUNCTION dmi_eval(this,eig_id,DIMENSION,atoms,kpts,sym,&
cell,noco, input,mpi, oneD,enpara,v,results)RESULT(skip)
USE m_types
USE m_ssomat
IMPLICIT NONE
CLASS(t_forcetheo_dmi),INTENT(INOUT):: this
LOGICAL :: skip
!Stuff that might be used...
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_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_enpara),INTENT(IN) :: enpara
TYPE(t_potden),INTENT(IN) :: v
TYPE(t_results),INTENT(IN) :: results
INTEGER,INTENT(IN) :: eig_id
this%evsum(0,this%q_done)=results%seigv
CALL ssomat(this%evsum(1:,this%q_done),this%theta,this%phi,eig_id,DIMENSION,atoms,kpts,sym,&
cell,noco, input,mpi, oneD,enpara,v,results)
skip=.TRUE.
END FUNCTION dmi_eval
END MODULE m_types_dmi
This diff is collapsed.
......@@ -61,6 +61,7 @@ CONTAINS
!OK, now we start the MAE-loop
this%directions_done=this%directions_done+1
mae_next_job=(this%directions_done<=SIZE(this%phi)) !still angles to do
IF (.NOT.mae_next_job) RETURN
noco%theta=this%theta(this%directions_done)
noco%phi=this%phi(this%directions_done)
......@@ -68,14 +69,27 @@ CONTAINS
CALL openXMLElementPoly('Forcetheorem_Loop_MAE',(/'No'/),(/this%directions_done/))
END FUNCTION mae_next_job
FUNCTION mae_eval(this,results)RESULT(skip)
USE m_types_misc
FUNCTION mae_eval(this,eig_id,DIMENSION,atoms,kpts,sym,&
cell,noco, input,mpi, oneD,enpara,v,results)RESULT(skip)
USE m_types
IMPLICIT NONE
CLASS(t_forcetheo_mae),INTENT(INOUT):: this
LOGICAL :: skip
!Stuff that might be used...
TYPE(t_results),INTENT(IN) :: 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_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_enpara),INTENT(IN) :: enpara
TYPE(t_potden),INTENT(IN) :: v
TYPE(t_results),INTENT(IN) :: results
INTEGER,INTENT(IN) :: eig_id
this%evsum(this%directions_done)=results%seigv
skip=.TRUE.
END FUNCTION mae_eval
......
!--------------------------------------------------------------------------------
! 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_types_ssdisp
USE m_judft
USE m_types_forcetheo
TYPE,EXTENDS(t_forcetheo) :: t_forcetheo_ssdisp
INTEGER :: q_done
REAL,ALLOCATABLE:: qvec(:,:)
REAL,ALLOCATABLE:: evsum(:)
CONTAINS
PROCEDURE :: start =>ssdisp_start
PROCEDURE :: next_job=>ssdisp_next_job
PROCEDURE :: eval =>ssdisp_eval
PROCEDURE :: postprocess => ssdisp_postprocess
PROCEDURE :: init => ssdisp_init !not overloaded
PROCEDURE :: dist => ssdisp_dist !not overloaded
END TYPE t_forcetheo_ssdisp
CONTAINS
SUBROUTINE ssdisp_init(this,q)
USE m_calculator
USE m_constants
IMPLICIT NONE
CLASS(t_forcetheo_ssdisp),INTENT(INOUT):: this
REAL,INTENT(in) :: q(:,:)
ALLOCATE(this%qvec(3,SIZE(q,2)))
this%qvec=q
ALLOCATE(this%evsum(SIZE(q,2)))
this%evsum=0
END SUBROUTINE ssdisp_init
SUBROUTINE ssdisp_start(this)
IMPLICIT NONE
CLASS(t_forcetheo_ssdisp),INTENT(INOUT):: this
this%q_done=0
CALL this%t_forcetheo%start() !call routine of basis type
END SUBROUTINE ssdisp_start
LOGICAL FUNCTION ssdisp_next_job(this,lastiter,noco)
USE m_types_setup
USE m_xmlOutput