Commit 745d1a18 authored by Gregor Michalicek's avatar Gregor Michalicek

Added scale parameters to lattice parameter input in inp.xml

...as suggested by Bernd + Stefan

...also in this commit: Some minor cleanup
parent 50799d23
......@@ -214,7 +214,7 @@ CONTAINS
CALL rw_inp('r',atoms_temp,obsolete_temp,vacuum_temp,input_temp,stars_temp,sliceplot_temp,&
banddos_temp,cell_temp,sym_temp,xcpot_temp,noco_temp,Jij_temp,oneD_temp,hybrid_temp,&
kpts_temp,noel_temp,namex_temp,relcor_temp,a1_temp,a2_temp,a3_temp,scale_temp,dtild_temp,&
kpts_temp,noel_temp,namex_temp,relcor_temp,a1_temp,a2_temp,a3_temp,dtild_temp,&
input_temp%comment)
input_temp%l_f = input%l_f
input_temp%tkb = input%tkb
......@@ -224,7 +224,7 @@ CONTAINS
vacuum_temp = vacuum
CALL rw_inp('W',atoms_new,obsolete_temp,vacuum_temp,input_temp,stars_temp,sliceplot_temp,&
banddos_temp,cell_temp,sym_temp,xcpot_temp,noco_temp,Jij_temp,oneD_temp,hybrid_temp,&
kpts_temp,noel_temp,namex_temp,relcor_temp,a1_temp,a2_temp,a3_temp,scale_temp,a3_temp(3),&
kpts_temp,noel_temp,namex_temp,relcor_temp,a1_temp,a2_temp,a3_temp,a3_temp(3),&
input_temp%comment)
ELSE
......@@ -236,7 +236,7 @@ CONTAINS
CALL r_inpXML(atoms_temp,obsolete_temp,vacuum_temp,input_temp,stars_temp,sliceplot_temp,&
banddos_temp,dimension_temp,cell_temp,sym_temp,xcpot_temp,noco_temp,Jij_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,scale_temp,dtild_temp,xmlElectronStates,&
namex_temp,relcor_temp,a1_temp,a2_temp,a3_temp,dtild_temp,xmlElectronStates,&
xmlPrintCoreStates,xmlCoreOccs,atomTypeSpecies,speciesRepAtomType,l_kpts_temp)
numSpecies = SIZE(speciesRepAtomType)
filename = 'inp_new.xml'
......@@ -247,7 +247,7 @@ CONTAINS
CALL w_inpXML(atoms_new,obsolete_temp,vacuum_temp,input_temp,stars_temp,sliceplot_temp,&
banddos_temp,cell_temp,sym_temp,xcpot_temp,noco_temp,jij_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,&
scale_temp,dtild_temp,input_temp%comment,xmlElectronStates,xmlPrintCoreStates,xmlCoreOccs,&
dtild_temp,input_temp%comment,xmlElectronStates,xmlPrintCoreStates,xmlCoreOccs,&
atomTypeSpecies,speciesRepAtomType,.FALSE.,filename,.TRUE.,numSpecies,enpara_temp)
DEALLOCATE(atomTypeSpecies,speciesRepAtomType)
DEALLOCATE(xmlElectronStates,xmlPrintCoreStates,xmlCoreOccs)
......
......@@ -556,7 +556,6 @@ MODULE m_types
REAL :: tkb
LOGICAL :: gauss
LOGICAL :: l_bmt
!INTEGER:: scale
INTEGER:: jspins
INTEGER:: kcrel
LOGICAL:: frcor
......@@ -574,6 +573,10 @@ MODULE m_types
LOGICAL:: sso_opt(2)
LOGICAL:: total
LOGICAL:: l_inpXML
REAL :: scaleCell
REAL :: scaleA1
REAL :: scaleA2
REAL :: scaleC
REAL :: ellow
REAL :: elup
REAL :: rkmax
......
......@@ -57,7 +57,7 @@
!-------------------------------------------------------------------
! .. Local Scalars ..
REAL :: thetad,xa,epsdisp,epsforce ,rmtmax,arltv1,arltv2,arltv3
REAL :: s,r,d ,idsprs,scale
REAL :: s,r,d ,idsprs
INTEGER :: ok,ilo,n,nstate,i,j,na,n1,n2,jrc,nopd,symfh
INTEGER :: nmopq(3)
......@@ -116,7 +116,7 @@
CALL rw_inp('r',&
& atoms,obsolete,vacuum,input,stars,sliceplot,banddos,&
& cell,sym,xcpot,noco,jij,oneD,hybrid,kpts,&
& noel,namex,relcor,a1,a2,a3,scale)
& noel,namex,relcor,a1,a2,a3)
!---> pk non-collinear
!---> read the angle and spin-spiral information from nocoinp
......@@ -191,9 +191,9 @@
!
! ---> now, set the lattice harmonics, determine nlhd
!
cell%amat(:,1) = a1(:)*scale
cell%amat(:,2) = a2(:)*scale
cell%amat(:,3) = a3(:)*scale
cell%amat(:,1) = a1(:)*input%scaleCell
cell%amat(:,2) = a2(:)*input%scaleCell
cell%amat(:,3) = a3(:)*input%scaleCell
CALL inv3(cell%amat,cell%bmat,cell%omtil)
IF (input%film) cell%omtil = cell%omtil/cell%amat(3,3)*vacuum%dvac
!-odim
......@@ -259,17 +259,14 @@
CALL soc_sym(sym%nop,sym%mrot,noco%theta,noco%phi,cell%amat,error)
IF ( ANY(error(:)) ) THEN
WRITE(*,fmt='(1x)')
WRITE(*,fmt='(A)')&
& 'Symmetry incompatible with SOC spin-quantization axis ,'
WRITE(*,fmt='(A)')&
& 'do not perform self-consistent calculations !'
WRITE(*,fmt='(A)') 'Symmetry incompatible with SOC spin-quantization axis ,'
WRITE(*,fmt='(A)') 'do not perform self-consistent calculations !'
WRITE(*,fmt='(1x)')
IF ( input%eonly .or. (noco%l_soc.and.noco%l_ss) .or. input%gw.ne.0 ) THEN ! .or. .
CONTINUE
ELSE
IF (input%itmax>1) THEN
CALL juDFT_error("symmetry & SOC",calledby&
& ="dimen7")
CALL juDFT_error("symmetry & SOC",calledby ="dimen7")
ENDIF
ENDIF
ENDIF
......@@ -281,8 +278,7 @@
IF (noco%l_ss) THEN ! test symmetry for spin-spiral
ALLOCATE ( error(sym%nop) )
CALL ss_sym(sym%nop,sym%mrot,noco%qss,error)
IF ( ANY(error(:)) ) CALL juDFT_error("symmetry & SSDW",&
& calledby="dimen7")
IF ( ANY(error(:)) ) CALL juDFT_error("symmetry & SSDW", calledby="dimen7")
DEALLOCATE ( error )
ENDIF
!--- J<
......@@ -306,10 +302,8 @@
ENDIF
IF ( xcpot%gmaxxc .le. 10.0**(-6) ) THEN
WRITE (6,'(" xcpot%gmaxxc=0 : xcpot%gmaxxc=stars%gmax choosen as default",&
& " value")')
WRITE (6,'(" concerning memory, you may want to choose",&
& " a smaller value for stars%gmax")')
WRITE (6,'(" xcpot%gmaxxc=0 : xcpot%gmaxxc=stars%gmax choosen as default value")')
WRITE (6,'(" concerning memory, you may want to choose a smaller value for stars%gmax")')
xcpot%gmaxxc=stars%gmax
END IF
......@@ -324,17 +318,13 @@
n2=sym%nop2
sym%nop=1
sym%nop2=1
CALL julia(&
& sym,cell,input,noco,banddos,&
& kpts,.false.,.FALSE.)
CALL julia(sym,cell,input,noco,banddos,kpts,.false.,.FALSE.)
sym%nop=n1
sym%nop2=n2
ELSE IF(l_gamma .and. banddos%ndir .eq. 0) THEN
call judft_error("gamma swtich not supported in old inp file anymore",calledby="dimen7")
ELSE
CALL julia(&
& sym,cell,input,noco,banddos,&
& kpts,.false.,.FALSE.)
CALL julia(sym,cell,input,noco,banddos,kpts,.false.,.FALSE.)
ENDIF
ELSE
CALL od_kptsgen (kpts%nkpt)
......@@ -343,17 +333,15 @@
IF(input%gw.eq.2) THEN
INQUIRE(file='QGpsi',exist=l_kpts) ! Use QGpsi if it exists ot
IF(l_kpts) THEN
WRITE(6,*)&
& 'QGpsi exists and will be used to generate kpts-file'
OPEN (15,file='QGpsi',form='unformatted',status='old',&
& action='read')
WRITE(6,*) 'QGpsi exists and will be used to generate kpts-file'
OPEN (15,file='QGpsi',form='unformatted',status='old',action='read')
OPEN (41,file='kpts',form='formatted',status='unknown')
REWIND(41)
READ (15) kpts%nkpt
WRITE (41,'(i5,f20.10)') kpts%nkpt,1.0
DO n = 1, kpts%nkpt
READ (15) q
WRITE (41,'(4f10.5)') MATMUL(TRANSPOSE(cell%amat),q)/scale,1.0
WRITE (41,'(4f10.5)') MATMUL(TRANSPOSE(cell%amat),q)/input%scaleCell,1.0
READ (15)
ENDDO
CLOSE (15)
......@@ -372,17 +360,14 @@
l_tmp=(/noco%l_ss,noco%l_soc/)
noco%l_ss=.false.
noco%l_soc=.false.
CALL julia(&
& sym,cell,input,noco,banddos,&
& kpts,.true.,.FALSE.)
CALL julia(sym,cell,input,noco,banddos,kpts,.true.,.FALSE.)
noco%l_ss=l_tmp(1); noco%l_soc=l_tmp(2)
ENDIF
!
! now proceed as usual
!
CALL inpeig_dim(input,obsolete,cell,noco,oneD,jij,&
& kpts,dimension,stars)
CALL inpeig_dim(input,obsolete,cell,noco,oneD,jij,kpts,dimension,stars)
vacuum%layerd = max(vacuum%layerd,1)
dimension%nstd = max(dimension%nstd,30)
atoms%ntype = atoms%ntype
......@@ -390,18 +375,15 @@
atoms%nlod = max(atoms%nlod,2) ! for chkmt
dimension%jspd=input%jspins
CALL parawrite(&
& sym,stars,atoms,sphhar,dimension,vacuum,obsolete,&
& kpts,oneD)
CALL parawrite(sym,stars,atoms,sphhar,dimension,vacuum,obsolete,kpts,oneD)
!
DEALLOCATE( sym%mrot,sym%tau,&
& atoms%lmax,atoms%ntypsy,atoms%neq,atoms%nlhtyp,atoms%rmt,atoms%zatom,atoms%jri,atoms%dx,atoms%nlo,atoms%llo,atoms%nflip,atoms%bmu,noel,&
& vacuum%izlay,atoms%ncst,atoms%lnonsph,atoms%taual,atoms%pos,atoms%nz,atoms%relax,&
& atoms%l_geo,noco%soc_opt,noco%alph,noco%beta,atoms%lda_u,noco%l_relax,jij%l_magn,jij%M,noco%b_con,sphhar%clnu,sphhar%nlh,&
& sphhar%llh,sphhar%nmem,sphhar%mlh,jij%magtype,jij%nmagtype,hybrid%select1,hybrid%lcutm1,&
& hybrid%lcutwf)
!
RETURN
END SUBROUTINE dimen7
END MODULE m_dimen7
......@@ -194,14 +194,10 @@ CONTAINS
IF (l_kpts) WRITE (6,*) ' No fl7para-file found, '
WRITE (6,*) ' invoking dimen7... '
!call first_glance to generate k-points
CALL first_glance(&
& n1,n2,n3,n5,n6,input%itmax,&
& l_kpts,l_qpts,ldum,n7,n8,n9,n10)
CALL dimen7(&
& input,sym,stars,atoms,sphhar,&
& dimension,vacuum,obsolete,kpts,&
& oneD,hybrid,Jij,cell)
CALL first_glance(n1,n2,n3,n5,n6,input%itmax,l_kpts,l_qpts,ldum,n7,n8,n9,n10)
CALL dimen7(input,sym,stars,atoms,sphhar,dimension,vacuum,obsolete,kpts,&
oneD,hybrid,Jij,cell)
ENDIF
! in case of a parallel calculation we have to broadcast
#ifdef CPP_MPI
......
......@@ -26,11 +26,9 @@
! *******************************************************
!
CONTAINS
SUBROUTINE inped( &
& atoms,obsolete,vacuum,&
& input,banddos,xcpot,sym,&
& cell,sliceplot,noco,&
& stars,oneD,jij,hybrid,kpts,scale,a1,a2,a3,namex,relcor)
SUBROUTINE inped(atoms,obsolete,vacuum,input,banddos,xcpot,sym,&
cell,sliceplot,noco,&
stars,oneD,jij,hybrid,kpts,a1,a2,a3,namex,relcor)
USE m_rwinp
USE m_chkmt
USE m_inpnoco
......@@ -56,7 +54,6 @@
TYPE(t_jij), INTENT(INOUT) :: jij
TYPE(t_hybrid), INTENT(INOUT) :: hybrid
TYPE(t_kpts), INTENT(INOUT) :: kpts
REAL, INTENT(OUT) :: scale
REAL, INTENT(OUT) :: a1(3)
REAL, INTENT(OUT) :: a2(3)
REAL, INTENT(OUT) :: a3(3)
......@@ -88,7 +85,7 @@
na = 0
CALL rw_inp('r',atoms,obsolete,vacuum,input,stars,sliceplot,banddos,&
cell,sym,xcpot,noco,jij,oneD,hybrid,kpts, noel,namex,relcor,a1,a2,a3,scale)
cell,sym,xcpot,noco,jij,oneD,hybrid,kpts, noel,namex,relcor,a1,a2,a3)
input%l_core_confpot=.TRUE. !this is the former CPP_CORE switch!
input%l_useapw=.FALSE. !this is the former CPP_APW switch!
......@@ -139,9 +136,9 @@
CALL juDFT_error("latnam",calledby ="inped")
ENDIF
dtild=a3(3)
IF (scale.EQ.0.) scale = 1.
vacuum%dvac = scale*vacuum%dvac
dtild = scale*dtild
IF (input%scaleCell.EQ.0.0) input%scaleCell = 1.0
vacuum%dvac = input%scaleCell*vacuum%dvac
dtild = input%scaleCell*dtild
!+odim
IF (.NOT.oneD%odd%d1) THEN
IF ((dtild-vacuum%dvac.LT.0.0).AND.input%film) THEN
......@@ -164,11 +161,11 @@
IF (vacuum%nmz>vacuum%nmzd) CALL juDFT_error("nmzd",calledby ="inped")
vacuum%nmzxy = vacuum%nmzxyd
IF (vacuum%nmzxy>vacuum%nmzxyd) CALL juDFT_error("nmzxyd",calledby ="inped")
a1(:) = scale*a1(:)
a2(:) = scale*a2(:)
a3(:) = scale*a3(:)
WRITE (6,FMT=8050) scale
WRITE (16,FMT=8050) scale
a1(:) = input%scaleCell*a1(:)
a2(:) = input%scaleCell*a2(:)
a3(:) = input%scaleCell*a3(:)
WRITE (6,FMT=8050) input%scaleCell
WRITE (16,FMT=8050) input%scaleCell
8050 FORMAT (' unit cell scaled by ',f10.6)
WRITE (6,FMT=8060) cell%z1
WRITE (16,FMT=8060) cell%z1
......@@ -349,7 +346,7 @@
!
!---> for films, the z-coordinates are given in absolute values:
!
IF (input%film) atoms%taual(3,na) = scale*atoms%taual(3,na)/a3(3)
IF (input%film) atoms%taual(3,na) = input%scaleCell*atoms%taual(3,na)/a3(3)
!
! Transform intern coordinates to cartesian:
!
......
......@@ -98,14 +98,14 @@ SUBROUTINE postprocessInput(mpi,input,sym,stars,atoms,vacuum,obsolete,kpts,&
DO iType = 1, atoms%ntype
IF (atoms%nlo(iType).GE.1) THEN
IF (input%secvar) THEN
CALL juDFT_error("LO + sevcar not implemented",calledby ="r_inpXML")
CALL juDFT_error("LO + sevcar not implemented",calledby ="postprocessInput")
END IF
IF (input%isec1<input%itmax) THEN
CALL juDFT_error("LO + Wu not implemented",calledby ="r_inpXML")
CALL juDFT_error("LO + Wu not implemented",calledby ="postprocessInput")
END IF
IF (atoms%nlo(iType).GT.atoms%nlod) THEN
WRITE (6,*) 'nlo(n) =',atoms%nlo(iType),' > nlod =',atoms%nlod
CALL juDFT_error("nlo(n)>nlod",calledby ="r_inpXML")
CALL juDFT_error("nlo(n)>nlod",calledby ="postprocessInput")
END IF
DO j=1,atoms%nlo(iType)
IF (.NOT.input%l_useapw) THEN
......@@ -116,7 +116,7 @@ SUBROUTINE postprocessInput(mpi,input,sym,stars,atoms,vacuum,obsolete,kpts,&
ENDIF
IF ( (atoms%llo(j,iType).GT.atoms%llod).OR.(mod(-atoms%llod,10)-1).GT.atoms%llod ) THEN
WRITE (6,*) 'llo(j,n) =',atoms%llo(j,iType),' > llod =',atoms%llod
CALL juDFT_error("llo(j,n)>llod",calledby ="r_inpXML")
CALL juDFT_error("llo(j,n)>llod",calledby ="postprocessInput")
END IF
END DO
......@@ -138,7 +138,7 @@ SUBROUTINE postprocessInput(mpi,input,sym,stars,atoms,vacuum,obsolete,kpts,&
END IF
endif
WRITE(6,'(A,I2,A,I2)') 'I use',atoms%ulo_der(ilo,iType),'. derivative of l =',atoms%llo(ilo,iType)
IF (atoms%llo(ilo,iType)>atoms%llod) CALL juDFT_error(" l > llod!!!",calledby="r_inpXML")
IF (atoms%llo(ilo,iType)>atoms%llod) CALL juDFT_error(" l > llod!!!",calledby="postprocessInput")
l = atoms%llo(ilo,iType)
IF (ilo.EQ.1) THEN
atoms%lo1l(l,iType) = ilo
......@@ -171,42 +171,42 @@ SUBROUTINE postprocessInput(mpi,input,sym,stars,atoms,vacuum,obsolete,kpts,&
END DO
IF (atoms%n_u.GT.0) THEN
IF (input%secvar) CALL juDFT_error("LDA+U and sevcar not implemented",calledby ="r_inpXML")
IF (input%isec1<input%itmax) CALL juDFT_error("LDA+U and Wu not implemented",calledby ="r_inpXML")
IF (noco%l_mperp) CALL juDFT_error("LDA+U and l_mperp not implemented",calledby ="r_inpXML")
IF (input%secvar) CALL juDFT_error("LDA+U and sevcar not implemented",calledby ="postprocessInput")
IF (input%isec1<input%itmax) CALL juDFT_error("LDA+U and Wu not implemented",calledby ="postprocessInput")
IF (noco%l_mperp) CALL juDFT_error("LDA+U and l_mperp not implemented",calledby ="postprocessInput")
END IF
! Check DOS related stuff (from inped)
IF ((banddos%ndir.LT.0).AND..NOT.banddos%dos) THEN
CALL juDFT_error('STOP banddos: the inbuild dos-program <0'//&
' can only be used if dos = true',calledby ="r_inpXML")
' can only be used if dos = true',calledby ="postprocessInput")
END IF
IF ((banddos%ndir.LT.0).AND.banddos%dos) THEN
IF (banddos%e1_dos-banddos%e2_dos.LT.1e-3) THEN
CALL juDFT_error("STOP banddos: no valid energy window for "//&
"internal dos-program",calledby ="r_inpXML")
"internal dos-program",calledby ="postprocessInput")
END IF
IF (banddos%sig_dos.LT.0) THEN
CALL juDFT_error("STOP DOS: no valid broadening (sig_dos) for "//&
"internal dos-PROGRAM",calledby ="r_inpXML")
"internal dos-PROGRAM",calledby ="postprocessInput")
END IF
END IF
IF (banddos%vacdos) THEN
IF (.NOT.banddos%dos) THEN
CALL juDFT_error("STOP DOS: only set vacdos = .true. if dos = .true.",calledby ="r_inpXML")
CALL juDFT_error("STOP DOS: only set vacdos = .true. if dos = .true.",calledby ="postprocessInput")
END IF
IF (.NOT.vacuum%starcoeff.AND.(vacuum%nstars.NE.1))THEN
CALL juDFT_error("STOP banddos: if stars = f set vacuum=1",calledby ="r_inpXML")
CALL juDFT_error("STOP banddos: if stars = f set vacuum=1",calledby ="postprocessInput")
END IF
IF (vacuum%layers.LT.1) THEN
CALL juDFT_error("STOP DOS: specify layers if vacdos = true",calledby ="r_inpXML")
CALL juDFT_error("STOP DOS: specify layers if vacdos = true",calledby ="postprocessInput")
END IF
DO i=1,vacuum%layers
IF (vacuum%izlay(i,1).LT.1) THEN
CALL juDFT_error("STOP DOS: all layers must be at z>0",calledby ="r_inpXML")
CALL juDFT_error("STOP DOS: all layers must be at z>0",calledby ="postprocessInput")
END IF
END DO
END IF
......@@ -275,7 +275,7 @@ SUBROUTINE postprocessInput(mpi,input,sym,stars,atoms,vacuum,obsolete,kpts,&
END DO
!IF (input%film .OR.oneD%odd%d1) THEN
! WRITE(*,*) 'There might be additional work required for the k points here!'
! WRITE(*,*) '...in r_inpXML. See inpeig_dim for comparison!'
! WRITE(*,*) '...in postprocessInput. See inpeig_dim for comparison!'
!END IF
CALL apws_dim(bk(:),cell,input,noco,oneD,nv,nv2,kq1,kq2,kq3)
stars%kq1_fft = max(kq1,stars%kq1_fft)
......@@ -309,7 +309,7 @@ SUBROUTINE postprocessInput(mpi,input,sym,stars,atoms,vacuum,obsolete,kpts,&
l_vca = .FALSE.
INQUIRE (file="vca.in", exist=l_vca)
IF (l_vca) THEN
WRITE(*,*) 'Note: Implementation for virtual crystal approximation should be changed in r_inpXML!'
WRITE(*,*) 'Note: Implementation for virtual crystal approximation should be changed in postprocessInput!'
WRITE(*,*) 'I am not sure whether the implementation actually makes any sense. It is from inped.'
WRITE(*,*) 'We have to get rid of the file vca.in!'
OPEN (17,file='vca.in',form='formatted')
......
......@@ -66,7 +66,7 @@
INTEGER nu,iofile
INTEGER iggachk
INTEGER n ,iostat, errorStatus
REAL scale,scpos ,zc
REAL scpos ,zc
TYPE(t_banddos)::banddos
TYPE(t_obsolete)::obsolete
......@@ -160,7 +160,8 @@
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
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 ; scale = 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
zc = 0.0 ; vacuum%locx(:) = 0.0 ; vacuum%locy(:) = 0.0
kpts%numSpecialPoints = 0
input%ldauLinMix = .FALSE. ; input%ldauMixParam = 0.05 ; input%ldauSpinf = 1.0
......@@ -459,7 +460,7 @@
CALL w_inpXML(&
& atoms,obsolete,vacuum,input,stars,sliceplot,banddos,&
& cell,sym,xcpot,noco,jij,oneD,hybrid,kpts,div,l_gamma,&
& noel,namex,relcor,a1Temp,a2Temp,a3Temp,scale,dtild,input%comment,&
& noel,namex,relcor,a1Temp,a2Temp,a3Temp,dtild,input%comment,&
& xmlElectronStates,xmlPrintCoreStates,xmlCoreOccs,&
& atomTypeSpecies,speciesRepAtomType,.FALSE.,filename,&
& l_explicit,numSpecies,enpara)
......@@ -497,7 +498,7 @@
CALL rw_inp(&
& ch_rw,atoms,obsolete,vacuum,input,stars,sliceplot,banddos,&
& cell,sym,xcpot,noco,jij,oneD,hybrid,kpts,&
& noel,namex,relcor,a1,a2,a3,scale,dtild,input%comment)
& noel,namex,relcor,a1,a2,a3,dtild,input%comment)
iofile = 6
......@@ -534,7 +535,7 @@
CALL rw_inp(&
& ch_rw,atoms,obsolete,vacuum,input,stars,sliceplot,banddos,&
& cell,sym,xcpot,noco,jij,oneD,hybrid,kpts,&
& noel,namex,relcor,a1,a2,a3,scale,dtild,input%comment)
& noel,namex,relcor,a1,a2,a3,dtild,input%comment)
IF ( ALL(div /= 0) ) nkpt3 = div
WRITE (iofile,FMT=9999) product(nkpt3),nkpt3,l_gamma
......
......@@ -16,7 +16,7 @@ CONTAINS
SUBROUTINE r_inpXML(&
atoms,obsolete,vacuum,input,stars,sliceplot,banddos,dimension,&
cell,sym,xcpot,noco,jij,oneD,hybrid,kpts,enpara,coreSpecInput,wann,&
noel,namex,relcor,a1,a2,a3,scale,dtild,xmlElectronStates,&
noel,namex,relcor,a1,a2,a3,dtild,xmlElectronStates,&
xmlPrintCoreStates,xmlCoreOccs,atomTypeSpecies,speciesRepAtomType,&
l_kpts)
......@@ -67,7 +67,7 @@ SUBROUTINE r_inpXML(&
CHARACTER(len=4), INTENT(OUT) :: namex
CHARACTER(len=12), INTENT(OUT) :: relcor
REAL, INTENT(OUT) :: a1(3),a2(3),a3(3)
REAL, INTENT(OUT) :: scale, dtild
REAL, INTENT(OUT) :: dtild
CHARACTER(len=8) :: name(10)
......@@ -739,7 +739,7 @@ SUBROUTINE r_inpXML(&
IF (numberNodes.EQ.1) THEN
latticeScale = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@scale'))
scale = latticeScale
input%scaleCell = latticeScale
valueString = TRIM(ADJUSTL(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@latnam')))
READ(valueString,*) cell%latnam
......@@ -774,14 +774,20 @@ SUBROUTINE r_inpXML(&
numberNodes = xmlGetNumberOfNodes(TRIM(ADJUSTL(xPathA))//'/a1')
IF (numberNodes.EQ.1) THEN
latticeDef = 1
input%scaleA1 = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/a1/@scale'))
a1(1) = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/a1'))
a1(1) = a1(1) * input%scaleA1
numberNodes = xmlGetNumberOfNodes(TRIM(ADJUSTL(xPathA))//'/a2')
IF (numberNodes.EQ.1) THEN
latticeDef = 2
input%scaleA2 = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/a2/@scale'))
a2(2) = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/a2'))
a2(2) = a2(2) * input%scaleA2
END IF
IF(.NOT.input%film) THEN
input%scaleC = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/c/@scale'))
a3(3) = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/c'))
a3(3) = a3(3) * input%scaleC
END IF
END IF
......@@ -795,7 +801,9 @@ SUBROUTINE r_inpXML(&
a2(1) = evaluateFirst(valueString)
a2(2) = evaluateFirst(valueString)
IF(.NOT.input%film) THEN
input%scaleC = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/c/@scale'))
a3(3) = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/c'))
a3(3) = a3(3) * input%scaleC
END IF
END IF
......
......@@ -10,7 +10,7 @@
SUBROUTINE rw_inp(&
& ch_rw,atoms,obsolete,vacuum,input,stars,sliceplot,banddos,&
& cell,sym,xcpot,noco,jij,oneD,hybrid,kpts,&
& noel,namex,relcor,a1,a2,a3,scale,dtild_opt,name_opt)
& noel,namex,relcor,a1,a2,a3,dtild_opt,name_opt)
!*********************************************************************
!* This subroutine reads or writes an inp - file on unit iofile *
......@@ -41,7 +41,7 @@
TYPE(t_xcpot),INTENT(INOUT) :: xcpot
TYPE(t_noco),INTENT(INOUT) :: noco
REAL,INTENT(INOUT) :: a1(3),a2(3),a3(3),scale
REAL,INTENT(INOUT) :: a1(3),a2(3),a3(3)
CHARACTER(len=3),INTENT(OUT) :: noel(atoms%ntype)
CHARACTER(len=4),INTENT(OUT) :: namex
CHARACTER(len=12),INTENT(OUT):: relcor
......@@ -248,6 +248,10 @@
a2(2) = -a1(2)
END IF
input%scaleA1 = 1.0
input%scaleA2 = 1.0
input%scaleC = 1.0
IF (sym%namgrp.EQ.'any ') THEN
INQUIRE (file='sym.out',exist=l_sym)
IF (.not.l_sym)&
......@@ -257,28 +261,27 @@
ENDIF
IF (cell%latnam.EQ.'any') THEN
! CALL juDFT_error("please specify lattice type (squ,p-r,c-r,hex,hx3,obl)",calledby="rw_inp")
READ (UNIT=5,FMT=*,iostat=ierr) a3(1),a3(2),a3(3),&
& vacuum%dvac,scale
READ (UNIT=5,FMT=*,iostat=ierr) a3(1),a3(2),a3(3),vacuum%dvac,input%scaleCell
IF (ierr /= 0) THEN
BACKSPACE(5)
READ (UNIT = 5,FMT ="(a)",END = 99,ERR = 99) line
a3(1) = evaluatefirst(line)
a3(2) = evaluatefirst(line)
a3(3) = evaluatefirst(line)
vacuum%dvac = evaluatefirst(line)
scale = evaluatefirst(line)
a3(1) = evaluatefirst(line)
a3(2) = evaluatefirst(line)
a3(3) = evaluatefirst(line)
vacuum%dvac = evaluatefirst(line)
input%scaleCell = evaluatefirst(line)
ENDIF
WRITE (6,9031) a3(1),a3(2),a3(3),vacuum%dvac,scale
WRITE (6,9031) a3(1),a3(2),a3(3),vacuum%dvac,input%scaleCell
ELSE
READ (UNIT = 5,FMT =*,iostat= ierr) vacuum%dvac,dtild,scale
READ (UNIT = 5,FMT =*,iostat= ierr) vacuum%dvac,dtild,input%scaleCell
IF (ierr /= 0) THEN
BACKSPACE(5)
READ (UNIT = 5,FMT ="(a)",END = 99,ERR = 99) line
vacuum%dvac = evaluatefirst(line)
dtild = evaluatefirst(line)
scale = evaluatefirst(line)
vacuum%dvac = evaluatefirst(line)
dtild = evaluatefirst(line)
input%scaleCell = evaluatefirst(line)
ENDIF
WRITE (6,9030) vacuum%dvac,dtild,scale
WRITE (6,9030) vacuum%dvac,dtild,input%scaleCell
a3(3) = dtild
ENDIF
!
......@@ -783,11 +786,11 @@
ENDIF
!
IF (cell%latnam.EQ.'any') THEN
WRITE (5,9031) a3(1),a3(2),a3(3),vacuum%dvac,scale
WRITE (5,9031) a3(1),a3(2),a3(3),vacuum%dvac,input%scaleCell
dtild = a3(3)
ELSE
WRITE (5,9030) vacuum%dvac,dtild,scale
a3(3) = scale * dtild
WRITE (5,9030) vacuum%dvac,dtild,input%scaleCell
a3(3) = input%scaleCell * dtild
ENDIF
9030 FORMAT (3f15.8)
9031 FORMAT (5f15.8)
......@@ -883,7 +886,7 @@
atoms%taual(i,na) = atoms%taual(i,na)*scpos
ENDDO
IF (.NOT.input%film) atoms%taual(3,na) = atoms%taual(3,na)*scpos
IF (input%film) atoms%taual(3,na) = a3(3)*atoms%taual(3,na)/scale
IF (input%film) atoms%taual(3,na) = a3(3)*atoms%taual(3,na)/input%scaleCell
!+odim in 1D case all the coordinates are given in cartesian YM
IF (oneD%odd%d1) THEN
atoms%taual(1,na) = atoms%taual(1,na)*a1(1)
......
......@@ -19,7 +19,7 @@ CONTAINS
SUBROUTINE w_inpXML(&
& atoms,obsolete,vacuum,input,stars,sliceplot,banddos,&
& cell,sym,xcpot,noco,jij,oneD,hybrid,kpts,div,l_gamma,&
& noel,namex,relcor,a1,a2,a3,scale,dtild_opt,name_opt,&
& noel,namex,relcor,a1,a2,a3,dtild_opt,name_opt,&
& xmlElectronStates,xmlPrintCoreStates,xmlCoreOccs,&
& atomTypeSpecies,speciesRepAtomType,l_outFile,filename,&
& l_explicitIn,numSpecies,enpara)
......@@ -54,7 +54,7 @@ SUBROUTINE w_inpXML(&
INTEGER, INTENT (IN) :: atomTypeSpecies(atoms%ntype)
INTEGER, INTENT (IN) :: speciesRepAtomType(numSpecies)
LOGICAL, INTENT (IN) :: l_gamma, l_outFile, l_explicitIn
REAL, INTENT (IN) :: a1(3),a2(3),a3(3),scale
REAL, INTENT (IN) :: a1(3),a2(3),a3(3)
REAL, INTENT (IN) :: xmlCoreOccs(2,29,atoms%ntype)
INTEGER, INTENT (IN) :: xmlElectronStates(29,atoms%ntype)
LOGICAL, INTENT (IN) :: xmlPrintCoreStates(29,atoms%ntype)
......@@ -329,7 +329,7 @@ SUBROUTINE w_inpXML(&
! <xsd:attribute name="dTilda" type="xsd:double" use="required"/>
! <filmLattice ...>
241 FORMAT(' <filmLattice scale="',f0.8,'" latnam="',a,'" dVac="',f0.8,'" dTilda="',f0.8,'">')
WRITE(fileNum,241) scale, TRIM(ADJUSTL(cell%latnam)), vacuum%dvac, dtild
WRITE(fileNum,241) input%scaleCell, TRIM(ADJUSTL(cell%latnam)), vacuum%dvac, dtild
IF (cell%latnam.EQ.'any') THEN
WRITE (fileNum,'(a)') ' <bravaisMatrix>'
255 FORMAT(' <row-1>',f0.10,' ',f0.10,' ',f0.10,'</row-1>')
......@@ -343,12 +343,12 @@ SUBROUTINE w_inpXML(&
IF ((cell%latnam.EQ.'squ').OR.(cell%latnam.EQ.'hex').OR.&
& (cell%latnam.EQ.'c-b').OR.(cell%latnam.EQ.'hx3').OR.&
& (cell%latnam.EQ.'c-r').OR.(cell%latnam.EQ.'p-r')) THEN
256 FORMAT(' <a1>',f0.10,'</a1>')
WRITE (fileNum,256) a1Temp(1)
256 FORMAT(' <a1 scale="',f0.10,'">',f0.10,'</a1>')
WRITE (fileNum,256) input%scaleA1, a1Temp(1) / input%scaleA1
END IF
IF ((cell%latnam.EQ.'c-r').OR.(cell%latnam.EQ.'p-r')) THEN
266 FORMAT(' <a2>',f0.10,'</a2>')
WRITE (fileNum,266) a2Temp(2)
266 FORMAT(' <a2 scale="',f0.10,'">',f0.10,'</a2>')
WRITE (fileNum,266) input%scaleA2, a2Temp(2) / input%scaleA2
END IF
IF (cell%latnam.EQ.'obl') THEN
......@@ -368,11 +368,11 @@ SUBROUTINE w_inpXML(&
ELSE
242 FORMAT(' <bulkLattice scale="',f0.10,'" latnam="',a,'">')
WRITE (fileNum,242) scale, TRIM(ADJUSTL(cell%latnam))
WRITE (fileNum,242) input%scaleCell, TRIM(ADJUSTL(cell%latnam))
IF (cell%latnam.EQ.'any') THEN
! <bravaisMatrix scale="1.0000000">
! <bravaisMatrix>
WRITE (fileNum,'(a)') ' <bravaisMatrix>'
! <row-1>0.00000 5.13000 5.13000</row-1>
......@@ -391,16 +391,16 @@ SUBROUTINE w_inpXML(&
IF ((cell%latnam.EQ.'squ').OR.(cell%latnam.EQ.'hex').OR.&
& (cell%latnam.EQ.'c-b').OR.(cell%latnam.EQ.'hx3').OR.&
& (cell%latnam.EQ.'c-r').OR.(cell%latnam.EQ.'p-r')) THEN
252 FORMAT(' <a1>',f0.10,'</a1>')
WRITE (fileNum,252) a1Temp(1)
252 FORMAT(' <a1 scale="',f0.10,'">',f0.10,'</a1>')
WRITE (fileNum,252) input%scaleA1, a1Temp(1) / input%scaleA1
IF ((cell%latnam.EQ.'c-r').OR.(cell%latnam.EQ.'p-r')) THEN
262 FORMAT(' <a2>',f0.10,'</a2>')
WRITE (fileNum,262) a2Temp(2)
262 FORMAT(' <a2 scale="',f0.10,'">',f0.10,'</a2>')
WRITE (fileNum,262) input%scaleA2, a2Temp(2) / input%scaleA2
</