diff --git a/dos/evaldos.f90 b/dos/evaldos.f90 index 65afaec3ce3f7a527b32fb9ea8debcdb012710d4..b2f79dcdb59f14dd68a7595c885f8ffedc88eb31 100644 --- a/dos/evaldos.f90 +++ b/dos/evaldos.f90 @@ -47,8 +47,8 @@ TYPE(t_atoms),INTENT(IN) :: atoms REAL, INTENT(IN) :: efermiarg, bandgap - LOGICAL, INTENT(IN) :: l_mcd - + LOGICAL, INTENT(IN) :: l_mcd + ! locals INTEGER, PARAMETER :: lmax= 4, ned = 1301 INTEGER i,s,v,index,jspin,k,l,l1,l2,ln,n,nl,ntb,ntria,ntetra @@ -73,7 +73,7 @@ qdim = lmax*atoms%ntype+3 l_orbcomp = banddos%l_orb IF (banddos%ndir.EQ.-3) THEN - qdim = 2*slab%nsld + qdim = 2*slab%nsld n_orb = 0 IF (banddos%l_orb) THEN n_orb = banddos%orbCompAtom @@ -84,7 +84,7 @@ ALLOCATE( qal(qdim,dimension%neigd,kpts%nkpt),& & qval(vacuum%nstars*vacuum%layers*vacuum%nvac,dimension%neigd,kpts%nkpt),& & qlay(dimension%neigd,vacuum%layerd,2)) - IF (l_mcd) THEN + IF (l_mcd) THEN ALLOCATE(mcd_local(3*atoms%ntype*ncored,dimension%neigd,kpts%nkpt) ) ELSE ALLOCATE(mcd_local(0,0,0)) @@ -95,11 +95,11 @@ emin =min(banddos%e1_dos*hartree_to_ev_const,banddos%e2_dos*hartree_to_ev_const) emax =max(banddos%e1_dos*hartree_to_ev_const,banddos%e2_dos*hartree_to_ev_const) efermi = efermiarg*hartree_to_ev_const - + WRITE (6,'(a)') 'DOS-Output is generated!' IF ( NINT((emax - emin)/sigma) > ned ) THEN - WRITE(6,*) 'sig_dos too small for DOS smoothing:' + WRITE(6,*) 'sig_dos too small for DOS smoothing:' WRITE(6,*) 'Reduce energy window or enlarge banddos%sig_dos!' WRITE(6,*) 'For now: setting sigma to zero !' sigma = 0.0 @@ -117,10 +117,10 @@ DO i=1,ned e(i) = emin + (i-1)*de ENDDO - + IF ( l_mcd ) THEN ! create an energy grid for mcd-spectra - e_lo = 9.9*10.0**9 - e_up = -9.9*10.0**9 + e_lo = 9.9*10.0**9 + e_up = -9.9*10.0**9 DO jspin = 1,input%jspins DO n = 1,atoms%ntype DO icore = 1 , mcd%ncore(n) @@ -129,7 +129,7 @@ ENDDO ENDDO ENDDO - e_lo = e_lo*hartree_to_ev_const - efermi - emax + e_lo = e_lo*hartree_to_ev_const - efermi - emax e_up = e_up*hartree_to_ev_const - efermi de = (e_up-e_lo)/(ned-1) DO i=1,ned @@ -207,7 +207,7 @@ qal(lmax*atoms%ntype+1,i,k) = qal(lmax*atoms%ntype+1,i,k) - qmt ENDDO qal(lmax*atoms%ntype+1,i,k) = qal(lmax*atoms%ntype+1,i,k)& - -qal(lmax*atoms%ntype+2,i,k)*(3-vacuum%nvac) -qal(lmax*atoms%ntype+3,i,k)*(vacuum%nvac-1) + -qal(lmax*atoms%ntype+2,i,k)*(3-vacuum%nvac) -qal(lmax*atoms%ntype+3,i,k)*(vacuum%nvac-1) ENDDO ENDIF ! @@ -237,27 +237,17 @@ write(*,*) as,sym%nop2,l_tria ! l_tria=.true. ELSE - IF (input%l_inpXML) THEN - IF (input%tria) THEN - ntetra = kpts%ntet - DO i = 1, ntetra - itetra(1:4,i) = kpts%ntetra(1:4,i) - voltet(i) = kpts%voltet(i) / ntetra - END DO - l_tria = input%tria - GOTO 67 - ELSE - GOTO 66 - END IF + IF (input%tria) THEN + ntetra = kpts%ntet + DO i = 1, ntetra + itetra(1:4,i) = kpts%ntetra(1:4,i) + voltet(i) = kpts%voltet(i) / ntetra + END DO + l_tria = input%tria + GOTO 67 + ELSE + GOTO 66 END IF - OPEN (41,file='kpts',FORM='formatted',STATUS='old') - DO i = 1, kpts%nkpt+1 - READ (41,*,END=66,ERR=66) - ENDDO - READ (41,'(i5)',END=66,ERR=66) ntetra - READ (41,'(4(4i6,4x))') ((itetra(i,k),i=1,4),k=1,ntetra) - READ (41,'(4f20.13)') (voltet(k),k=1,ntetra) - CLOSE(41) voltet(1:ntetra) = voltet(1:ntetra) / ntetra l_tria=.true. GOTO 67 @@ -265,7 +255,7 @@ CALL triang(kpts%bk,kpts%nkpt,itria,ntria,atr,as,l_tria) l_tria=.true. ! YM: tetrahedrons is not the way in 1D - IF (oneD%odi%d1) as = 0.0 + IF (oneD%odi%d1) as = 0.0 IF (sym%invs) THEN IF (abs(sym%nop2*as-1.0).GT.0.000001) l_tria=.false. ELSE @@ -328,9 +318,9 @@ CALL smooth(e,g(1,ln),sigma,ned) ENDDO ENDIF - + !*** sum up for all atoms - + IF (banddos%ndir.NE.-3) THEN DO l = 1 , atoms%ntype l1 = lmax*(l-1) + 1 @@ -350,7 +340,7 @@ ENDDO ENDDO ENDIF - + !**** write out DOS OPEN (18,FILE='DOS'//spin12(jspin)) @@ -409,14 +399,14 @@ ENDDO ENDDO ENDDO - CLOSE (18) + CLOSE (18) ENDIF DEALLOCATE (g) -! +! !------------------------------------------------------------------------------ ! now calculate the VACOS !------------------------------------------------------------------------------ - + IF ( banddos%vacdos .and. input%film ) THEN ALLOCATE(g(ned,vacuum%nstars*vacuum%layers*vacuum%nvac)) ! CALL ptdos( @@ -425,16 +415,16 @@ ! < g) CALL ptdos(emin,emax,input%jspins,ned,vacuum%nstars*vacuum%nvac*vacuum%layers,ntb,ntria& ,as,atr,2*kpts%nkpt,itria,kpts%nkpt,ev(1:ntb,1:kpts%nkpt), qval(:,1:ntb,1:kpts%nkpt),e,g) - + !---- > smoothening IF ( sigma.GT.0.0 ) THEN DO ln = 1 , vacuum%nstars*vacuum%nvac*vacuum%layers CALL smooth(e,g(1,ln),sigma,ned) ENDDO ENDIF - + ! write VACDOS - + OPEN (18,FILE='VACDOS'//spin12(jspin)) ! WRITE (18,'(i2,25(2x,i3))') Layers , (Zlay(l),l=1,Layers) DO i = 1 , ned @@ -464,11 +454,11 @@ END IF OPEN (18,FILE='bands'//spin12(jspin)) - ntb = minval(results%neig(:,jspin)) + ntb = minval(results%neig(:,jspin)) kx(1) = 0.0 vkr(:,1)=matmul(kpts%bk(:,1),cell%bmat) DO k = 2, kpts%nkpt - + vkr(:,k)=matmul(kpts%bk(:,k),cell%bmat) dk = (vkr(1,k)-vkr(1,k-1))**2 + (vkr(2,k)-vkr(2,k-1) )**2 + & (vkr(3,k)-vkr(3,k-1))**2 @@ -483,7 +473,7 @@ ENDIF ENDDO -! +! !------------------------------------------------------------------------------ ! for MCD calculations ... !------------------------------------------------------------------------------ @@ -512,4 +502,4 @@ 99001 FORMAT (f10.5,110(1x,e10.3)) END SUBROUTINE evaldos - END MODULE m_evaldos + END MODULE m_evaldos diff --git a/fermi/fermie.F90 b/fermi/fermie.F90 index fa9a5c209abf4a075002d1aed1bbefcc5b845cec..49842870eefedfab491ba59bcd44bd731d601901 100644 --- a/fermi/fermie.F90 +++ b/fermi/fermie.F90 @@ -80,11 +80,11 @@ CONTAINS !*********************************************************************** ! ABBREVIATIONS ! - ! eig : array of eigenvalues + ! eig : array of eigenvalues ! wtkpt : list of the weights of each k-point (from inp-file) - ! e : linear list of the eigenvalues + ! e : linear list of the eigenvalues ! we : list of weights of the eigenvalues in e - ! zelec : number of electrons + ! zelec : number of electrons ! spindg : spindegeneracy (2 in nonmagnetic calculations) ! seigv : weighted sum of the occupied valence eigenvalues ! seigsc : weighted sum of the semi-core eigenvalues @@ -125,7 +125,7 @@ CONTAINS IF (mpi%irank == 0) THEN CALL read_eig(eig_id,k,jsp,neig=ne(k,jsp),eig=eig(:,k,jsp)) WRITE (6,'(a2,3f10.5,f12.6)') 'at',kpts%bk(:,k),kpts%wtkpt(k) - WRITE (6,'(i5,a14)') ne(k,jsp),' eigenvalues :' + WRITE (6,'(i5,a14)') ne(k,jsp),' eigenvalues :' WRITE (6,'(8f12.6)') (eig(i,k,jsp),i=1,ne(k,jsp)) IF(.NOT.judft_was_argument("-minimalOutput")) THEN attributes = '' @@ -144,7 +144,7 @@ CONTAINS ENDDO !finished reading of eigenvalues IF (mpi%irank == 0) CALL closeXMLElement('eigenvalues') - IF (mpi%irank == 0) THEN + IF (mpi%irank == 0) THEN IF (ABS(input%fixed_moment)<1E-6) THEN !this is a standard calculation @@ -167,7 +167,7 @@ CONTAINS !Generate a list of energies DO k = 1,kpts%nkpt ! - !---> STORE EIGENVALUES AND WEIGHTS IN A LINEAR LIST. AND MEMORIZE + !---> STORE EIGENVALUES AND WEIGHTS IN A LINEAR LIST. AND MEMORIZE !---> CONECTION TO THE ORIGINAL ARRAYS ! DO j = 1,ne(k,jsp) @@ -208,7 +208,7 @@ CONTAINS IF ( mpi%irank == 0 ) THEN WRITE (6,FMT=8010) n,ws,weight END IF - CALL juDFT_error("Not enough eavefunctions",calledby="fermie") + CALL juDFT_error("Not enough weavefunctions",calledby="fermie") 8010 FORMAT (/,10x,'error: not enough wavefunctions.',i10,2d20.10) END IF ws = ws + we(INDEX(l)) diff --git a/fermi/fertri.f b/fermi/fertri.f index 196ce33b1ca080b8c3b01d29271c9b051f5f90cc..d364943639ea60c6b553f62de18065df818ac04e 100644 --- a/fermi/fertri.f +++ b/fermi/fertri.f @@ -86,38 +86,14 @@ c c---> write results of triang IF (.not.film) THEN - IF(input%l_inpXML) THEN - ntetra = kpts%ntet - DO j = 1, ntetra - itetra(1:4,j) = kpts%ntetra(1:4,j) - voltet(j) = kpts%voltet(j) / ntetra - END DO - ELSE - IF ( irank == 0 ) THEN - WRITE (6,*) 'reading tetrahedrons from file kpts' - END IF - OPEN (41,file='kpts',FORM='formatted',STATUS='old') - DO i = 1, nkpt+1 - READ (41,*) - ENDDO - READ (41,'(i5)',ERR=66,END=66) ntetra - IF (ntetra>6*nkpt) CALL juDFT_error("ntetra > 6 nkpt" - + ,calledby ="fertri") - READ (41,'(4(4i6,4x))') ((itetra(i,j),i=1,4),j=1,ntetra) - READ (41,'(4f20.13)') (voltet(j),j=1,ntetra) - voltet(1:ntetra) = voltet(1:ntetra) / ntetra - GOTO 67 - 66 CONTINUE ! no tetrahedron-information of file - CALL make_tetra( - > nkpt,bk,ntria,itria,atr, - < ntetra,itetra,voltet)!keep - - 67 CONTINUE ! tetrahedron-information read or created - CLOSE(41) - END IF - lb = MINVAL(eig(:,:,:)) - 0.01 - ub = ef + 0.2 - CALL tetra_ef( + ntetra = kpts%ntet + DO j = 1, ntetra + itetra(1:4,j) = kpts%ntetra(1:4,j) + voltet(j) = kpts%voltet(j) / ntetra + END DO + lb = MINVAL(eig(:,:,:)) - 0.01 + ub = ef + 0.2 + CALL tetra_ef( > jspins,nkpt, > lb,ub,eig,zc,sfac, > ntetra,itetra,voltet, diff --git a/fleurinput/types_atoms.F90 b/fleurinput/types_atoms.F90 index 3997575e7ed1afbf6134688248c88263c2a80df7..bcd0a8479a470396f1ac55c4e9f4410af9e14512 100644 --- a/fleurinput/types_atoms.F90 +++ b/fleurinput/types_atoms.F90 @@ -278,9 +278,10 @@ MODULE m_types_atoms !force type xpath='' IF(xml%getNumberOfNodes(TRIM(ADJUSTL(xPaths))//'/force')==1) xpath=xpaths + IF(xml%getNumberOfNodes(TRIM(ADJUSTL(xPathg))//'/force')==1) xpath=xpathg IF (xpath.NE.'') THEN - this%l_geo(n) = evaluateFirstBoolOnly(xml%getAttributeValue(TRIM(ADJUSTL(xPathg))//'/force/@calculate')) - valueString = xml%getAttributeValue(TRIM(ADJUSTL(xPathg))//'force/@relaxXYZ') + this%l_geo(n) = evaluateFirstBoolOnly(xml%getAttributeValue(TRIM(ADJUSTL(xPath))//'/force/@calculate')) + valueString = xml%getAttributeValue(TRIM(ADJUSTL(xPath))//'/force/@relaxXYZ') READ(valueString,'(3l1)') relaxX, relaxY, relaxZ IF (relaxX) this%relax(1,n) = 1 IF (relaxY) this%relax(2,n) = 1 diff --git a/fleurinput/types_econfig.F90 b/fleurinput/types_econfig.F90 index 650021b09908a91c61c427a76237913dde7842f9..5c2aec3ef8514abed57752cf579555c14aca1b08 100644 --- a/fleurinput/types_econfig.F90 +++ b/fleurinput/types_econfig.F90 @@ -9,7 +9,7 @@ MODULE m_types_econfig PRIVATE !This is used by t_atoms and does not extend t_fleurinput_base by itself TYPE:: t_econfig - CHARACTER(len=100) :: coreconfig + CHARACTER(len=200) :: coreconfig CHARACTER(len=100) :: valenceconfig INTEGER :: num_core_states INTEGER :: num_states @@ -29,7 +29,7 @@ MODULE m_types_econfig END TYPE t_econfig PUBLIC :: t_econfig CONTAINS - + SUBROUTINE get_core(econf,nst,nprnc,kappa,occupation,l_valence) CLASS(t_econfig),INTENT(IN) :: econf INTEGER ,INTENT(out) :: nst @@ -46,9 +46,9 @@ CONTAINS occupation(:nst,:)=econf%occupation(:nst,:) if (size(occupation,2)==1) occupation=occupation*2 END SUBROUTINE get_core - - - + + + FUNCTION get_state_string(econf,i)RESULT(str) CLASS(t_econfig),INTENT(IN):: econf INTEGER,INTENT(in) :: i @@ -74,17 +74,17 @@ CONTAINS CASE default call judft_error("Invalid reqest for string with kappa") END SELECT - - + + WRITE(str,"(a1,i1,a)") "(",econf%nprnc(i),s END FUNCTION get_state_string - - + + SUBROUTINE broadcast(econf,mpi_comm) USE m_mpi_bc_tool CLASS(t_econfig),INTENT(INOUT):: econf INTEGER,INTENT(in) :: mpi_comm -#ifdef CPP_MPI +#ifdef CPP_MPI INCLUDE 'mpif.h' INTEGER :: ierr,irank @@ -97,7 +97,7 @@ CONTAINS CALL mpi_bc(econf%valence_electrons,0,mpi_comm) #endif END SUBROUTINE broadcast - + SUBROUTINE init_num(econf,nc,nz) USE m_constants @@ -114,8 +114,8 @@ CONTAINS CALL econf%init(core,nz) END SUBROUTINE init_num - - + + SUBROUTINE init_simple(econf,str) CLASS(t_econfig),INTENT(OUT):: econf CHARACTER(len=*),INTENT(IN) :: str @@ -123,10 +123,10 @@ CONTAINS CHARACTER(len=200)::core,valence INTEGER :: n REAL,allocatable :: core_occ(:),valence_occ(:) - + n=INDEX(str,"|") IF (n==0) CALL judft_error(("Invalid econfig:"//TRIM(str))) - + IF (INDEX(str,"|")==1) THEN ! No core core="" @@ -157,15 +157,15 @@ CONTAINS INTEGER :: np(40),kap(40) - + econf%coreconfig=core econf%valenceconfig=valence - + CALL expand_noble_gas(core) !extend noble gas config IF (VERIFY(core,"(1234567spdf/) ")>0) call judft_error(("Invalid econfig:"//TRIM(core))) IF (VERIFY(valence,"(1234567spdf/) ")>0) CALL judft_error(("Invalid econfig:"//TRIM(valence))) - + econf%num_core_states=0 DO WHILE (len_TRIM(core)>1) CALL extract_next(core,np(econf%num_core_states+1),kap(econf%num_core_states+1)) @@ -180,7 +180,7 @@ CONTAINS econf%nprnc=np(:econf%num_states) econf%kappa=kap(:econf%num_states) ALLOCATE(econf%occupation(econf%num_states,2)) - + CALL econf%set_occupation("(1s1/2)",-1.,-1.) END SUBROUTINE init_all @@ -195,34 +195,34 @@ CONTAINS CHARACTER(len=7)::str IF (nz>54) CALL judft_warn("Specifying no explicit valence config for systems with f-states might lead to broken configs") - + econf%coreconfig=core - + CALL expand_noble_gas(core) !extend noble gas config IF (VERIFY(core,"(1234567spdf/) ")>0) call judft_error(("Invalid econfig:"//TRIM(core))) - + econf%num_core_states=0 DO WHILE (len_TRIM(core)>1) CALL extract_next(core,np(econf%num_core_states+1),kap(econf%num_core_states+1)) econf%num_core_states=econf%num_core_states+1 ENDDO econf%num_states=econf%num_core_states - !valence charge - charge=nz-SUM(ABS(kap(:econf%num_core_states)))*2 - DO WHILE(charge>0) !Add valence + !valence charge + charge=nz-SUM(ABS(kap(:econf%num_core_states))**2)*2 + DO WHILE(charge>0) !Add valence str=coreStateList_const(econf%num_states+1) PRINT*,econf%num_states,str,charge CALL extract_next(str,np(econf%num_states+1),kap(econf%num_states+1)) econf%num_states=econf%num_states+1 - charge=charge-ABS(kap(econf%num_states)) + charge=charge-ABS(kap(econf%num_states)**2)*2 ENDDO ALLOCATE(econf%nprnc(econf%num_states),econf%kappa(econf%num_states)) econf%nprnc=np(:econf%num_states) econf%kappa=kap(:econf%num_states) ALLOCATE(econf%occupation(econf%num_states,2)) - + CALL econf%set_occupation("(1s1/2)",-1.,-1.) !last level might be partially occupied IF (charge<0) THEN @@ -241,9 +241,9 @@ CONTAINS REAL :: up,down up=u down=d - + str=ADJUSTL(state) - + IF (up==-1. .AND. down==-1) THEN !Set all defaults econf%occupation=0.0 @@ -264,12 +264,12 @@ CONTAINS up=-1;down=-1 END IF END IF - END DO + END DO END IF econf%core_electrons=SUM(econf%occupation(:econf%num_core_states,:)) econf%valence_electrons=SUM(econf%occupation(econf%num_core_states+1:econf%num_states,:)) END SUBROUTINE set_occupation - + SUBROUTINE set_initial_moment(econf,bmu) CLASS(t_econfig),INTENT(INOUT):: econf @@ -301,7 +301,7 @@ CONTAINS - + SUBROUTINE extract_next(str,n,kappa) CHARACTER(len=*),INTENT(INOUT) :: str INTEGER,INTENT(out) :: n,kappa @@ -345,29 +345,29 @@ CONTAINS CASE ("Ne","ne","NE") str="(1s1/2) (2s1/2) (2p1/2) "//str CASE ("Ar","ar","AR") - str="(1s1/2) (2s1/2) (2p1/2) (3s1/2) (3p1/2) (3p3/2) "//str + str="(1s1/2) (2s1/2) (2p1/2) (2p3/2) (3s1/2) (3p1/2) (3p3/2) "//str CASE ("Kr","kr","KR") - str="(1s1/2) (2s1/2) (2p1/2) (3s1/2) (3p1/2) (3p3/2) (4s1/2) (3d3/2) (3d5/2) (4p1/2) (4p3/2)"//str + str="(1s1/2) (2s1/2) (2p1/2) (2p3/2) (3s1/2) (3p1/2) (3p3/2) (4s1/2) (3d3/2) (3d5/2) (4p1/2) (4p3/2)"//str CASE ("Xe","xe","XE") - str="(1s1/2) (2s1/2) (2p1/2) (3s1/2) (3p1/2) (3p3/2) (4s1/2) (3d3/2) (3d5/2) (4p1/2) (4p3/2) (5s1/2) (4d3/2) (4d5/2) (5p1/2) (5p3/2) "//str + str="(1s1/2) (2s1/2) (2p1/2) (2p3/2) (3s1/2) (3p1/2) (3p3/2) (4s1/2) (3d3/2) (3d5/2) (4p1/2) (4p3/2) (5s1/2) (4d3/2) (4d5/2) (5p1/2) (5p3/2) "//str CASE ("Rn","rn","RN") - str="(1s1/2) (2s1/2) (2p1/2) (3s1/2) (3p1/2) (3p3/2) (4s1/2) (3d3/2) (3d5/2) (4p1/2) (4p3/2) (5s1/2) (4d3/2) (4d5/2) (5p1/2) (5p3/2) (6s1/2) (4f5/2) (4f7/2) (5d3/2) (5d5/2) (6p1/2) (6p3/2) "//str + str="(1s1/2) (2s1/2) (2p1/2) (2p3/2) (3s1/2) (3p1/2) (3p3/2) (4s1/2) (3d3/2) (3d5/2) (4p1/2) (4p3/2) (5s1/2) (4d3/2) (4d5/2) (5p1/2) (5p3/2) (6s1/2) (4f5/2) (4f7/2) (5d3/2) (5d5/2) (6p1/2) (6p3/2) "//str CASE default call judft_error(("Invalid econfig:"//TRIM(str))) END SELECT END SUBROUTINE expand_noble_gas - - + + SUBROUTINE convert_to_extended(simple,extended,occupations) CHARACTER(len=*),INTENT(IN) :: simple CHARACTER(len=*),INTENT(OUT) :: extended REAL,ALLOCATABLE,INTENT(OUT) :: occupations(:) - + CHARACTER(len=200)::conf - REAL :: occupation(100) !this is the tmp local variable (no 's') + REAL :: occupation(200) !this is the tmp local variable (no 's') INTEGER:: n,nn,occ CHARACTER:: n_ch,ch extended="" diff --git a/fleurinput/types_enparaXML.f90 b/fleurinput/types_enparaXML.f90 index 1839dac7c4e2da1161a6561b442a5c16ccad6ea7..78ac90e44f5c3f1e01cb966195a3e1db638f5eb6 100644 --- a/fleurinput/types_enparaXML.f90 +++ b/fleurinput/types_enparaXML.f90 @@ -131,7 +131,7 @@ CONTAINS enpara%qn_el(:,ntype,:)=ABS(enpara%qn_el(:,ntype,:)) END SUBROUTINE set_quantum_numbers - SUBROUTINE init(this,ntype,nlod,jspins,l_defaults,nz) + SUBROUTINE Init(This,Ntype,Nlod,Jspins,L_defaults,Nz) USE m_constants CLASS(t_enparaXML),INTENT(inout):: this INTEGER,INTENT(IN) :: jspins,nlod,ntype @@ -141,6 +141,9 @@ CONTAINS INTEGER :: n,i,jsp,l this%evac0=-1E99 + if (allocated(this%qn_el)) deallocate(this%qn_el) + if (allocated(this%qn_ello)) deallocate(this%qn_ello) + ALLOCATE(this%qn_el(0:3,ntype,jspins)) ALLOCATE(this%qn_ello(nlod,ntype,jspins)) diff --git a/fleurinput/types_input.f90 b/fleurinput/types_input.f90 index 76e97e2983bfa8dcc1e4e577f4fc078945cc8c93..7b223419f2f8875e18ba5f2c031491aef0378e34 100644 --- a/fleurinput/types_input.f90 +++ b/fleurinput/types_input.f90 @@ -57,7 +57,7 @@ MODULE m_types_input LOGICAL:: l_wann=.FALSE. LOGICAL:: secvar=.FALSE. LOGICAL:: evonly=.FALSE. - LOGICAL:: l_inpXML=.TRUE. +! LOGICAL:: l_inpXML=.TRUE. REAL :: ellow=-1.8 REAL :: elup=1.0 REAL :: fixed_moment = 0.0 @@ -135,7 +135,7 @@ CONTAINS call mpi_bc(this%l_wann,rank,mpi_comm) call mpi_bc(this%secvar,rank,mpi_comm) call mpi_bc(this%evonly,rank,mpi_comm) - call mpi_bc(this%l_inpXML,rank,mpi_comm) +! call mpi_bc(this%l_inpXML,rank,mpi_comm) call mpi_bc(this%ellow,rank,mpi_comm) call mpi_bc(this%elup,rank,mpi_comm) call mpi_bc(this%fixed_moment ,rank,mpi_comm) diff --git a/fleurinput/types_noco.f90 b/fleurinput/types_noco.f90 index 64a91cc6a3009c2d656c6168dd1c12a5a5a3925f..caf2a31a910ad9c3f475e621e1675998cd7cfb42 100644 --- a/fleurinput/types_noco.f90 +++ b/fleurinput/types_noco.f90 @@ -5,7 +5,7 @@ !-------------------------------------------------------------------------------- MODULE m_types_noco - USE m_judft + USE m_judft USE m_types_fleurinput_base IMPLICIT NONE PRIVATE @@ -21,7 +21,7 @@ MODULE m_types_noco LOGICAL:: l_spav= .FALSE. REAL :: theta=0.0 REAL :: phi=0.0 - + LOGICAL, ALLOCATABLE :: l_relax(:) REAL, ALLOCATABLE :: alphInit(:) REAL, ALLOCATABLE :: alph(:) @@ -49,7 +49,7 @@ MODULE m_types_noco ELSE rank=0 END IF - + CALL mpi_bc(this%l_ss,rank,mpi_comm) CALL mpi_bc(this%l_soc,rank,mpi_comm) CALL mpi_bc(this%l_noco ,rank,mpi_comm) @@ -61,27 +61,27 @@ MODULE m_types_noco CALL mpi_bc(this%l_spav,rank,mpi_comm) CALL mpi_bc(this%theta,rank,mpi_comm) CALL mpi_bc(this%phi,rank,mpi_comm) - + CALL mpi_bc(this%l_relax,rank,mpi_comm) CALL mpi_bc(this%alphInit,rank,mpi_comm) CALL mpi_bc(this%alph,rank,mpi_comm) CALL mpi_bc(this%beta,rank,mpi_comm) CALL mpi_bc(this%b_con,rank,mpi_comm) CALL mpi_bc(this%socscale,rank,mpi_comm) - - + + END SUBROUTINE mpi_bc_noco SUBROUTINE read_xml_noco(this,xml) USE m_types_xml CLASS(t_noco),INTENT(inout):: this TYPE(t_xml),INTENT(IN) :: xml - + INTEGER:: numberNodes,ntype,itype CHARACTER(len=100)::xpathA,xpathB,valueString this%l_noco = evaluateFirstBoolOnly(xml%GetAttributeValue('/fleurInput/calculationSetup/magnetism/@l_noco')) - + ! Read in optional SOC parameters if present xPathA = '/fleurInput/calculationSetup/soc' numberNodes = xml%GetNumberOfNodes(xPathA) @@ -115,8 +115,9 @@ MODULE m_types_noco ALLOCATE(this%socscale(ntype)) DO itype=1,ntype + this%socscale(Itype)=1.0 IF (xml%GetNumberOfNodes(TRIM(ADJUSTL(xml%speciesPath(itype)))//'/special/@socscale')>0) & - this%socscale(iType)=evaluateFirstOnly(xml%GetAttributeValue(TRIM(ADJUSTL(xml%speciesPath(itype)))//'/special/@socscale')) + this%socscale(Itype)=evaluateFirstOnly(xml%GetAttributeValue(TRIM(ADJUSTL(xml%speciesPath(itype)))//'/special/@socscale')) !Read in atom group specific noco parameters xPathB = TRIM(ADJUSTL(xml%groupPath(itype)))//'/nocoParams' numberNodes = xml%GetNumberOfNodes(TRIM(ADJUSTL(xPathB))) @@ -139,7 +140,7 @@ MODULE m_types_noco integer :: na,itype - + ! Check noco stuff and calculate missing noco parameters IF (noco%l_noco) THEN IF (noco%l_ss) THEN @@ -162,9 +163,9 @@ MODULE m_types_noco END IF - + end subroutine init_noco - - + + END MODULE m_types_noco diff --git a/init/inpeig.f90 b/init/inpeig.f90 index 4db4ba78e8fb82dbf7acf4692e65c080e66c0d67..a03716914e4fe41841490ec1655dec77641e5c7f 100644 --- a/init/inpeig.f90 +++ b/init/inpeig.f90 @@ -22,7 +22,7 @@ USE m_types_kpts USE m_types_enpara USE m_juDFT - + IMPLICIT NONE ! .. TYPE(t_atoms),INTENT(IN) :: atoms @@ -31,7 +31,7 @@ LOGICAL,INTENT(IN) :: l_is_oneD TYPE(t_kpts),INTENT(INOUT) :: kpts TYPE(t_enpara),OPTIONAL,INTENT(INOUT) :: enpara - + CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: kptsFilename CHARACTER(len=*),INTENT(IN) :: latnam @@ -43,17 +43,17 @@ CHARACTER(LEN=255) :: fname ! .. ! - + !---> input energy parameters for each atom. !---> the energy parameters for l.ge.3 have the same value !---> read from file 40='enpara' shz Jan.96 ! IF(PRESENT(enpara)) THEN - IF (.NOT.input%l_inpXML) THEN - !read enpara file if present! + !IF (.NOT.input%l_inpXML) THEN + !read enpara file if present! CALL enpara%init_enpara(atoms,input%jspins,input%film) - END IF + !END IF END IF ! !---> read k-points from file 41='kpts' @@ -66,7 +66,7 @@ END IF INQUIRE(file=TRIM(ADJUSTL(fname)),exist=l_k) - if (.not.l_k) return + if (.not.l_k) return OPEN (41,file=TRIM(ADJUSTL(fname)),form='formatted',status='old') ! @@ -84,7 +84,7 @@ 911 CONTINUE xyu = .false. 912 CONTINUE - + IF (kpts%nkpt.GT.kpts%nkpt) THEN CALL juDFT_error('nkptd too small',calledby='inpeig') ENDIF @@ -146,9 +146,9 @@ & ="The sum of weights in the kpts file is zero") END IF END IF - IF (l_is_oneD) kpts%bk(1:2,:) = 0.0 + IF (l_is_oneD) kpts%bk(1:2,:) = 0.0 kpts%wtkpt(:) = kpts%wtkpt(:)/wt - + WRITE (6,FMT=8120) kpts%nkpt DO nk = 1,kpts%nkpt WRITE (6,FMT=8040) kpts%bk(:,nk),kpts%wtkpt(nk) diff --git a/inpgen2/old_inp/rw_inp.f90 b/inpgen2/old_inp/rw_inp.f90 index 686b6b562453d68cafc388f873fed425aa80968c..88490ab35bc209bd0468610411da1d53c6dd4a8a 100644 --- a/inpgen2/old_inp/rw_inp.f90 +++ b/inpgen2/old_inp/rw_inp.f90 @@ -311,11 +311,10 @@ READ (UNIT=5,FMT=7182,END=77,ERR=77) ch_test IF (ch_test.EQ.'igr') THEN ! GGA input BACKSPACE (5) - call judft_error("Old input files with explicit GGA parameters no longer supported") -! READ (UNIT=5,FMT=7121,END=99,ERR=99)& -! & idum,obsolete%lwb,obsolete%ndvgrd,idsprs,obsolete%chng -! IF (idsprs.ne.0)& -! & CALL juDFT_warn("idsprs no longer supported in rw_inp") + READ (UNIT=5,FMT=7121,END=99,ERR=99)& + & idum,ldum,idum,idsprs + IF (idsprs.ne.0)& + & CALL juDFT_warn("idsprs no longer supported in rw_inp") ! WRITE (6,9121) idum,obsolete%lwb,obsolete%ndvgrd,idsprs,obsolete%chng 7121 FORMAT (5x,i1,5x,l1,8x,i1,8x,i1,6x,d10.3) diff --git a/inpgen2/read_old_inp.f90 b/inpgen2/read_old_inp.f90 index bbbece633a1b868a09b4b2a205e952733829aec2..0756f9b4e8d047160b8e96284892358642fc4d48 100644 --- a/inpgen2/read_old_inp.f90 +++ b/inpgen2/read_old_inp.f90 @@ -41,12 +41,13 @@ CONTAINS TYPE(t_forcetheo):: forcetheo TYPE(t_kpts) ,INTENT(OUT):: kpts - + !local only TYPE(t_dimension) ::dimension TYPE(t_sphhar) ::sphhar TYPE(t_atompar) :: ap INTEGER :: n,grid(3) + LOGICAL :: l_enparaok CALL fleur_init_old(& input,DIMENSION,atoms,sphhar,cell,stars,sym,noco,vacuum,& @@ -54,15 +55,35 @@ CONTAINS oneD,grid) !kpt grid not used... CALL sym%init(cell,input%film) - ALLOCATE(enpara%qn_el(0:3,atoms%ntype,2),enpara%qn_ello(size(enpara%ello0),atoms%ntype,2)) - enpara%qn_el=0.0 - enpara%qn_ello=0.0 - - ALLOCATE(atoms%label(atoms%nat)); atoms%label="" + + !Generate speciesnames ALLOCATE(atoms%speciesname(atoms%ntype)) DO n=1,atoms%ntype - WRITE(atoms%speciesname(n),"(a,a,i0)") ADJUSTL(TRIM(namat_const(atoms%nz(n)))),"-",n - END DO + write(atoms%speciesname(n),"(a,a,i0)") namat_const(atoms%nz(n)),"-",n + ENDDO + IF (.not.allocated(atoms%label)) THEN + allocate(atoms%label(atoms%nat)) + atoms%label="" + ENDIF + !convert enpara + l_enparaok=.false. + If (all(abs(enpara%el0)<1E10))THEN + IF (All(Abs(Enpara%El0-Nint(Enpara%El0))<1e-9)) Then + Enpara%Qn_el=Nint(Enpara%El0) + l_enparaok=.true. + if (atoms%nlotot>0) THEN + IF (all(abs(enpara%ello0-Nint(Enpara%ello0))<1e-9)) THEN + enpara%qn_ello=Nint(enpara%ello0) + ELSE + l_enparaok=.false. + ENDIF + ENDIF + ENDIF + ENDIF + IF (.NOT.l_enparaok) THEN + CALL enpara%init(atoms%ntype,atoms%nlod,input%jspins,.true.,atoms%nz) + call judft_warn("Enpara not found or not set to integer values. Using defaults") + ENDIF DO n=1,atoms%ntype ap=find_atompar(atoms%nz(n),atoms%rmt(n)) @@ -70,6 +91,6 @@ CONTAINS call atoms%econf(n)%init(ap%econfig) END DO - + END SUBROUTINE read_old_inp END MODULE m_read_old_inp diff --git a/main/fleur_init.F90 b/main/fleur_init.F90 index 6aa39e6a7e7180813fc3da0e42aa7dd71d5a864f..99c610249d45c8f4f51ad2de837e247dfed9900a 100644 --- a/main/fleur_init.F90 +++ b/main/fleur_init.F90 @@ -99,8 +99,8 @@ CONTAINS mpi%irank=0 ; mpi%isize=1; mpi%mpi_comm=1 #endif !determine if we use an xml-input file - INQUIRE (file='inp.xml',exist=input%l_inpXML) - IF (.NOT.input%l_inpXML) THEN + INQUIRE (file='inp.xml',exist=l_found) + IF (.NOT.l_found) THEN CALL judft_error("No input file found",calledby='fleur_init',hint="To use FLEUR, you have to provide an 'inp.xml' file in the working directory") END IF diff --git a/optional/stden.f90 b/optional/stden.f90 index 2895de2a01d534701e0179160354f6badfcee5cc..49291f5ecde2c6116dc7aba32d3b285ba7622568 100644 --- a/optional/stden.f90 +++ b/optional/stden.f90 @@ -57,8 +57,8 @@ SUBROUTINE stden(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,& REAL :: vacpar(2) INTEGER lnum(29,atoms%ntype),nst(atoms%ntype) INTEGER jrc(atoms%ntype) - LOGICAL l_found(0:3),llo_found(atoms%nlod),l_enpara,l_st - REAL :: occ(MAXVAL(atoms%econf%num_states),2) + LOGICAL l_found(0:3),llo_found(atoms%nlod),l_st + REAL,ALLOCATABLE :: occ(:,:) ! Data statements DATA del/1.e-6/ PARAMETER (l_st=.true.) @@ -219,12 +219,8 @@ SUBROUTINE stden(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,& END DO ! ispin = 1, input%jspins END IF ! input%vchk - l_enpara = .FALSE. - INQUIRE (file='enpara',exist=l_enpara) - l_enpara = l_enpara.OR.input%l_inpXML - ! set up parameters for enpara-file - IF ((juDFT_was_argument("-genEnpara")).AND..NOT.l_enpara) THEN + IF ((juDFT_was_argument("-genEnpara"))) THEN CALL enpara%init_enpara(atoms,input%jspins,input%film) enpara%lchange = .TRUE. diff --git a/wannier/wann_get_kpts.f b/wannier/wann_get_kpts.f index 8d1c278e04ff36894c67dfcaa4578042d533cbec..fb570d57d517c0330572a12ce1d41a4db324215f 100644 --- a/wannier/wann_get_kpts.f +++ b/wannier/wann_get_kpts.f @@ -13,7 +13,7 @@ < nkpts,kpoints) c******************************************************** c Read in the k-points from kpts/w90kpts file. -c +c c Frank Freimuth c******************************************************** implicit none @@ -47,42 +47,15 @@ c******************************************************** endif close(987) else - IF(.NOT.input%l_inpXML) THEN - inquire(file='kpts',exist=l_file) - IF(.NOT.l_file) CALL juDFT_error("where is kpts?",calledby - + ="wann_get_kpts") - open(987,file='kpts',status='old',form='formatted') - read(987,*)nkpts,scale - write(6,*)"wann_get_kpts: nkpts=",nkpts - if(l_readkpts)then - IF(SIZE(kpoints,1)/=3) - + CALL juDFT_error("wann_get_kpts: 1", - + calledby ="wann_get_kpts") - IF(SIZE(kpoints,2)/=nkpts) - + CALL juDFT_error("wann_get_kpts:2", - + calledby ="wann_get_kpts") - do iter=1,nkpts - read(987,*)kpoints(:,iter) - enddo - endif - close(987) - ELSE - nkpts = kpts%nkpt + nkpts = kpts%nkpt write(6,*)"wann_get_kpts: nkpts=",nkpts if(l_readkpts)then do iter=1,nkpts kpoints(:,iter) = kpts%bk(:,iter) enddo endif - END IF endif - if(l_readkpts.AND..NOT.input%l_inpXML)then - kpoints=kpoints/scale - if(film.and..not.l_onedimens)then - kpoints(3,:)=0.0 - endif - endif IF (l_readkpts) THEN do iter=1,nkpts write(6,*)kpoints(:,iter) diff --git a/wannier/wann_mmnk_symm.f b/wannier/wann_mmnk_symm.f index 766ab853833c5fc8b9325a06720ef40a8c6a0f26..365e34ecd206e7a546cc2f62c02a9c68b6a15d29 100644 --- a/wannier/wann_mmnk_symm.f +++ b/wannier/wann_mmnk_symm.f @@ -15,7 +15,7 @@ c Find out minimal set of k-point-pairs that have to be c calculated; map symmetry-related k-point-pairs to this c minimal set. c Frank Freimuth -c****************************************************************** +c****************************************************************** subroutine wann_mmnk_symm(input,kpts, > fullnkpts,nntot,bpt,gb,l_bzsym, > irreduc,mapkoper,l_p0,film,nop, @@ -83,8 +83,8 @@ c-----Test for nonsymmorphic space groups endif do 10 ikpt = 1,fullnkpts ! loop by k-points starts - l_nosymm1=.false. - kptibz=ikpt + l_nosymm1=.false. + kptibz=ikpt if(l_bzsym) then kptibz=irreduc(ikpt) oper=mapkoper(ikpt) @@ -94,13 +94,13 @@ c-----Test for nonsymmorphic space groups else sign=1 endif - if( - & any( abs(tau(:,oper)).gt.1.e-6 ) + if( + & any( abs(tau(:,oper)).gt.1.e-6 ) & )l_nosymm1=.true. endif do 15 ikpt_b = 1,nntot - l_nosymm2=.false. + l_nosymm2=.false. if(index(ikpt,ikpt_b).eq.1)cycle kptibz_b=bpt(ikpt_b,ikpt) if(l_bzsym) then @@ -112,8 +112,8 @@ c-----Test for nonsymmorphic space groups else sign_b=1 endif - if( - & any( abs(tau(:,oper_b)).gt.1.e-6 ) + if( + & any( abs(tau(:,oper_b)).gt.1.e-6 ) & )l_nosymm2=.true. endif @@ -135,7 +135,7 @@ c*************************************************************** maptopair(3,ikpt,ikpt_b)=1 c print*,"conjugation" num_conj=num_conj+1 - goto 15 + goto 15 endif enddo !ikpt_k c**************************************************************** @@ -164,7 +164,7 @@ c if(all(gb(:,ikpt_b,ikpt).eq.0))then ngis_b=-1 else ngis_b=1 - endif + endif do ky=1,nntot if(bpt(ky,repkpt).eq.repkpt_bb)then repkpt_b=ky @@ -179,7 +179,7 @@ c if(all(gb(:,ikpt_b,ikpt).eq.0))then if( any( abs(brot).gt.1e-6 ) )cycle endif if(sign*ngis*multtab(invtab(oper),repo).eq. - & sign_b*ngis_b*multtab(invtab(oper_b),repo_b))then + & sign_b*ngis_b*multtab(invtab(oper_b),repo_b))then maptopair(1,ikpt,ikpt_b)=repkpt maptopair(2,ikpt,ikpt_b)=repkpt_b maptopair(3,ikpt,ikpt_b)=2+(1-ngis*sign)/2 @@ -187,14 +187,14 @@ c if(all(gb(:,ikpt_b,ikpt).eq.0))then num_rot=num_rot+1 goto 15 endif - endif - endif - enddo - endif - enddo - endif - enddo -c endif !gb=0 + endif + endif + enddo + endif + enddo + endif + enddo +c endif !gb=0 endif 33 continue @@ -202,9 +202,9 @@ c endif !gb=0 index(ikpt,ikpt_b)=1 num_pair=num_pair+1 pair_to_do(ikpt,ikpt_b)=num_pair - + 15 continue !loop over nearest neighbor k-points -10 continue ! end of cycle by the k-points +10 continue ! end of cycle by the k-points if(l_p0)then write(6,*)"pairs to calculate: ",num_pair @@ -220,7 +220,7 @@ c endif !gb=0 c***************************************************************** c determine difference vectors that occur on the k-mesh -c***************************************************************** +c***************************************************************** if (l_bzsym) then l_file=.false. IF(.NOT.l_q)THEN @@ -234,56 +234,47 @@ c***************************************************************** IF(.NOT.l_file) CALL juDFT_error + ("w90qpts not found, needed if bzsym",calledby + ="wann_mmnk_symm") - open(412,file='w90qpts',form='formatted') + open(412,file='w90qpts',form='formatted') ENDIF read(412,*)fullnkpts_tmp,scale do k=1,fullnkpts read(412,*)kpoints(:,k) - enddo + enddo kpoints=kpoints/scale close(412) - else + else IF(.not.l_q)THEN - IF(.NOT.input%l_inpXML) THEN - open(412,file='kpts',form='formatted') - read(412,*)fullnkpts_tmp,scale - do k=1,fullnkpts - read(412,*)kpoints(:,k) - enddo - kpoints(:,:)=kpoints/scale - ELSE fullnkpts_tmp = kpts%nkpt do k=1,fullnkpts kpoints(:,k) = kpts%bk(:,k) - enddo - END IF + enddo ELSE open(412,file=param_file,form='formatted') read(412,*)fullnkpts_tmp,scale do k=1,fullnkpts read(412,*)kpoints(:,k) - enddo + enddo kpoints(:,:)=kpoints/scale ENDIF if (film.and..not.l_onedimens) kpoints(3,:)=0.0 close(412) endif - + if(l_p0)then IF(.not.l_q) THEN print*,"vectors combining nearest neighbor k-points:" ELSE print*,"vectors combining nearest neighbor q-points:" ENDIF - endif + endif ky=1 do k=1,fullnkpts do kx=1,nntot kdiffvec=kpoints(:,bpt(kx,k))+gb(:,kx,k)-kpoints(:,k) do ikpt=1,ky-1 if(all(abs(kdiff(:,ikpt)-kdiffvec).le.0.0001))goto 200 - enddo + enddo IF(ky>nntot) CALL juDFT_error("problem in wann_mmnk_symm" + ,calledby ="wann_mmnk_symm") kdiff(:,ky)=kdiffvec(:) @@ -295,7 +286,7 @@ c***************************************************************** 200 continue enddo - enddo + enddo end subroutine SUBROUTINE close_pt( > nops,mrot, diff --git a/wannier/wann_read_inp.f90 b/wannier/wann_read_inp.f90 index eebc4647c55b6978ab87635611f5235be4559b20..b6b86d500f61aa9826acc8ef9025f4afcbdf54b1 100644 --- a/wannier/wann_read_inp.f90 +++ b/wannier/wann_read_inp.f90 @@ -34,7 +34,7 @@ subroutine wann_read_inp(input,l_p0,wann) wann%l_orbcomp=.false. wann%l_orbcomprs=.false. wann%l_perturbrs=.false. - wann%l_denmat=.false. + wann%l_denmat=.false. wann%l_perturb=.false. wann%l_nedrho=.false. wann%l_anglmomrs=.false. @@ -133,7 +133,7 @@ subroutine wann_read_inp(input,l_p0,wann) !-----read the input file 'wann_inp' l_file=.false. inquire(file='wann_inp',exist=l_file) - IF ((.not.l_file).AND.(.NOT.input%l_inpXML)) THEN + IF ((.not.l_file)) THEN CALL juDFT_error ("wann_inp not found", calledby="wann_read_inp") END IF IF (l_file) THEN @@ -142,7 +142,7 @@ subroutine wann_read_inp(input,l_p0,wann) wann%l_byindex=.false. open(916,file='wann_inp',form='formatted') i=0 - do + do i=i+1 read(916,'(a)',iostat=ios)task if(ios.ne.0)exit @@ -245,7 +245,7 @@ subroutine wann_read_inp(input,l_p0,wann) elseif(trim(task).eq.'hsomtxvec_to_lmpzsoc')then wann%l_hsomtxvec_to_lmpzsoc=.true. elseif(trim(task).eq.'hsomtxvec_unf_to_lmpzsoc')then - wann%l_hsomtxvec_unf_to_lmpzsoc=.true. + wann%l_hsomtxvec_unf_to_lmpzsoc=.true. elseif(trim(task).eq.'hsomtx_unf_to_hsoc_unf')then wann%l_hsomtx_unf_to_hsoc_unf=.true. elseif(trim(task).eq.'hsomtx_to_hsoc_unf')then @@ -254,19 +254,19 @@ subroutine wann_read_inp(input,l_p0,wann) wann%l_hsomtx_to_hsoc=.true. elseif(trim(task).eq.'hsomtx_unf_to_hsoc')then wann%l_hsomtx_unf_to_hsoc=.true. - + elseif(trim(task).eq.'perpmagatlres')then wann%l_perpmagatlres=.true. backspace(916) read(916,*,iostat=ios)task,wann%perpmagl if (ios /= 0) & CALL juDFT_error ("error reading perpmagl", & - calledby="wann_read_inp") - + calledby="wann_read_inp") + elseif(trim(task).eq.'socmat')then wann%l_socmat=.true. elseif(trim(task).eq.'socmatvec')then - wann%l_socmatvec=.true. + wann%l_socmatvec=.true. elseif(trim(task).eq.'socmatrs')then wann%l_socmatrs=.true. elseif(trim(task).eq.'soctomom')then @@ -426,7 +426,7 @@ subroutine wann_read_inp(input,l_p0,wann) if(l_p0.and.ios.lt.0)write(6,*)"end of wann_inp reached" close(916) - ELSE IF (input%l_inpXML) THEN + ELSE DO i = 1, SIZE(wann%jobList) task = TRIM(ADJUSTL(wann%jobList(i))) @@ -529,7 +529,7 @@ subroutine wann_read_inp(input,l_p0,wann) elseif(trim(task).eq.'hsomtxvec_to_lmpzsoc')then wann%l_hsomtxvec_to_lmpzsoc=.true. elseif(trim(task).eq.'hsomtxvec_unf_to_lmpzsoc')then - wann%l_hsomtxvec_unf_to_lmpzsoc=.true. + wann%l_hsomtxvec_unf_to_lmpzsoc=.true. elseif(trim(task).eq.'hsomtx_unf_to_hsoc_unf')then wann%l_hsomtx_unf_to_hsoc_unf=.true. elseif(trim(task).eq.'hsomtx_to_hsoc_unf')then @@ -538,15 +538,15 @@ subroutine wann_read_inp(input,l_p0,wann) wann%l_hsomtx_to_hsoc=.true. elseif(trim(task).eq.'hsomtx_unf_to_hsoc')then wann%l_hsomtx_unf_to_hsoc=.true. - + elseif(trim(task).eq.'perpmagatlres')then wann%l_perpmagatlres=.true. backspace(916) read(916,*,iostat=ios)task,wann%perpmagl if (ios /= 0) & CALL juDFT_error ("error reading perpmagl", & - calledby="wann_read_inp") - + calledby="wann_read_inp") + elseif(trim(task).eq.'socmat')then wann%l_socmat=.true. elseif(trim(task).eq.'socmatvec')then @@ -724,7 +724,7 @@ subroutine wann_read_inp(input,l_p0,wann) do n=1,wann%atomlist_num wann%atomlist(n)=n enddo - endif + endif end subroutine wann_read_inp