Many bugfixes and missing initalizations

cdn/cdnovlp.F90

@@ -113,7 +113,7 @@
           COMPLEX,INTENT (INOUT) :: rhtxy(vacuum%nmzxyd,oneD%odi%n2d-1,2,input%jspins)
           REAL,   INTENT (INOUT) :: rho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins)
           REAL,   INTENT (INOUT) :: rht(vacuum%nmzd,2,input%jspins)
-          REAL,   INTENT (INOUT) :: rh(DIMENSION%msh,atoms%ntype)
+          REAL,   INTENT (INOUT) :: rh(atoms%msh,atoms%ntype)
           !     ..
           !     .. Local Scalars ..
           COMPLEX czero,carg,VALUE,slope,c_ph
@@ -127,7 +127,7 @@
           !     .. Local Arrays ..
           COMPLEX, ALLOCATABLE :: qpwc(:)
           REAL    acoff(atoms%ntype),alpha(atoms%ntype),rho_out(2)
-          REAL    rat(DIMENSION%msh,atoms%ntype)
+          REAL    rat(atoms%msh,atoms%ntype)
           INTEGER mshc(atoms%ntype)
           REAL    fJ(-oneD%odi%M:oneD%odi%M),dfJ(-oneD%odi%M:oneD%odi%M)
           !     ..
@@ -174,7 +174,7 @@
           !      (2) cut_off core tails from noise 
           !
 #ifdef CPP_MPI
-          CALL MPI_BCAST(rh,DIMENSION%msh*atoms%ntype,CPP_MPI_REAL,0,mpi%mpi_comm,ierr)
+          CALL MPI_BCAST(rh,atoms%msh*atoms%ntype,CPP_MPI_REAL,0,mpi%mpi_comm,ierr)
 #endif
           nloop: DO  n = 1 , atoms%ntype
               IF ((atoms%econf(n)%num_core_states.GT.0).OR.l_st) THEN
@@ -182,13 +182,13 @@
                       rat(j,n) = atoms%rmsh(j,n)
                    ENDDO
                    dxx = EXP(atoms%dx(n))
-                   DO j = atoms%jri(n) + 1 , DIMENSION%msh
+                   DO j = atoms%jri(n) + 1 , atoms%msh
                       rat(j,n) = rat(j-1,n)*dxx
                    ENDDO
-                   DO j = atoms%jri(n) - 1 , DIMENSION%msh
+                   DO j = atoms%jri(n) - 1 , atoms%msh
                       rh(j,n) = rh(j,n)/ (fpi_const*rat(j,n)*rat(j,n))
                    ENDDO
-                   DO j = DIMENSION%msh , atoms%jri(n) , -1
+                   DO j = atoms%msh , atoms%jri(n) , -1
                       IF ( rh(j,n) .GT. tol_14 ) THEN
                          mshc(n) = j
                          CYCLE nloop
@@ -493,11 +493,11 @@
       type(t_atoms)    ,intent(in) :: atoms
       integer          ,intent(in) :: mshc(atoms%ntype)
       real             ,intent(in) :: alpha(atoms%ntype), tol_14
-      real             ,intent(in) :: rh(DIMENSION%msh,atoms%ntype)
+      real             ,intent(in) :: rh(atoms%msh,atoms%ntype)
       real             ,intent(in) :: acoff(atoms%ntype)
       type(t_stars)    ,intent(in) :: stars
       integer          ,intent(in) :: method2
-      real             ,intent(in) :: rat(DIMENSION%msh,atoms%ntype)
+      real             ,intent(in) :: rat(atoms%msh,atoms%ntype)
       type(t_cell)     ,intent(in) :: cell
       type(t_oneD)     ,intent(in) :: oneD
       type(t_sym)      ,intent(in) :: sym
@@ -539,7 +539,7 @@
               
               ! (1) Form factor for each atom type
              
-              CALL FormFactor_forAtomType(DIMENSION,method2,n_out_p,&
+              CALL FormFactor_forAtomType(atoms%msh,method2,n_out_p,&
                                  atoms%rmt(n),atoms%jri(n),atoms%dx(n),mshc(n),rat(:,n), &
                                  rh(:,n),alpha(n),stars,cell,acoff(n),qf)
 
@@ -668,7 +668,7 @@
       end subroutine StructureConst_forAtom
 
 !----------------------------------------------------------------------
-      subroutine FormFactor_forAtomType(DIMENSION,method2,n_out_p,&
+      subroutine FormFactor_forAtomType(msh,method2,n_out_p,&
                        rmt,jri,dx,mshc,rat,&
                        rh,alpha,stars,cell,acoff,qf)
 
@@ -677,14 +677,14 @@
       USE m_rcerf
       USE m_intgr, ONLY : intgr3,intgz0
 
-      type(t_dimension),intent(in) :: DIMENSION
-      integer          ,intent(in) :: method2, n_out_p
+      
+      integer          ,intent(in) :: msh,method2, n_out_p
       real             ,intent(in) :: rmt
       integer          ,intent(in) :: jri
       real             ,intent(in) :: dx
       integer          ,intent(in) :: mshc
-      real             ,intent(in) :: rat(DIMENSION%msh)
-      real             ,intent(in) :: rh(DIMENSION%msh)
+      real             ,intent(in) :: rat(msh)
+      real             ,intent(in) :: rh(msh)
       real             ,intent(in) :: alpha
       type(t_stars)    ,intent(in) :: stars
       type(t_cell)     ,intent(in) :: cell
@@ -698,7 +698,7 @@
       logical tail
 
 !     ..Local arrays
-      real rhohelp(DIMENSION%msh)
+      real rhohelp(msh)
 
       zero = 0.0
       DO k = 1,stars%ng3

cdn/cdnval.F90

@@ -165,7 +165,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
       IF (noco%l_mperp) CALL denCoeffsOffdiag%addRadFunScalarProducts(atoms,f,g,flo,iType)
       IF (banddos%l_mcd) CALL mcd_init(atoms,input,dimension,vTot%mt(:,0,:,:),g,f,mcd,iType,jspin)
       IF (l_coreSpec) CALL corespec_rme(atoms,input,iType,dimension%nstd,input%jspins,jspin,results%ef,&
-                                        dimension%msh,vTot%mt(:,0,:,:),f,g)
+                                        atoms%msh,vTot%mt(:,0,:,:),f,g)
    END DO
    DEALLOCATE (f,g,flo)
 

cdn_mt/cdncore.F90

@@ -49,10 +49,10 @@ SUBROUTINE cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,&
    REAL                             :: seig, rhoint, momint
    LOGICAL, PARAMETER               :: l_st=.FALSE.
 
-   REAL                             :: rh(dimension%msh,atoms%ntype,input%jspins)
+   REAL                             :: rh(atoms%msh,atoms%ntype,input%jspins)
    REAL                             :: qint(atoms%ntype,input%jspins)
    REAL                             :: tec(atoms%ntype,input%jspins)
-   REAL                             :: rhTemp(dimension%msh,atoms%ntype,input%jspins)
+   REAL                             :: rhTemp(atoms%msh,atoms%ntype,input%jspins)
 
 
    results%seigc = 0.0

core/ccdnup.f90

@@ -23,7 +23,7 @@ CONTAINS
     REAL,    INTENT (IN) :: sume
     !     ..
     !     .. Array Arguments ..
-    REAL,    INTENT (IN) :: rhochr(:),rhospn(:)!(dimension%msh)
+    REAL,    INTENT (IN) :: rhochr(:),rhospn(:)!(atoms%msh)
     REAL,    INTENT (IN) :: vrs(:,:,:)!(atoms%jmtd,atoms%ntype,input%jspins)
     REAL,    INTENT (OUT) :: tecs(:,:)!(atoms%ntype,input%jspins)
     REAL,    INTENT (OUT) :: qints(:,:)!(atoms%ntype,input%jspins)

core/cored.F90

@@ -25,7 +25,7 @@ CONTAINS
       !     .. Array Arguments ..
       REAL, INTENT(IN)              :: vr(atoms%jmtd,atoms%ntype)
       REAL, INTENT(INOUT)           :: rho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins)
-      REAL, INTENT(INOUT)           :: rhc(DIMENSION%msh,atoms%ntype,input%jspins)
+      REAL, INTENT(INOUT)           :: rhc(atoms%msh,atoms%ntype,input%jspins)
       REAL, INTENT(INOUT)           :: qint(atoms%ntype,input%jspins)
       REAL, INTENT(INOUT)           :: tec(atoms%ntype,input%jspins)
       REAL, INTENT(INOUT), OPTIONAL :: EnergyDen(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins)
@@ -37,9 +37,9 @@ CONTAINS
       !     ..
       !     .. Local Arrays ..
 
-      REAL rhcs(DIMENSION%msh),rhoc(DIMENSION%msh),rhoss(DIMENSION%msh),vrd(DIMENSION%msh),f(0:3)
-      REAL rhcs_aux(DIMENSION%msh), rhoss_aux(DIMENSION%msh) !> quantities for energy density calculations
-      REAL occ(maxval(atoms%econf%num_states)),a(DIMENSION%msh),b(DIMENSION%msh),ain(DIMENSION%msh),ahelp(DIMENSION%msh)
+      REAL rhcs(atoms%msh),rhoc(atoms%msh),rhoss(atoms%msh),vrd(atoms%msh),f(0:3)
+      REAL rhcs_aux(atoms%msh), rhoss_aux(atoms%msh) !> quantities for energy density calculations
+      REAL occ(maxval(atoms%econf%num_states)),a(atoms%msh),b(atoms%msh),ain(atoms%msh),ahelp(atoms%msh)
       REAL occ_h(maxval(atoms%econf%num_states),2)
       INTEGER kappa(maxval(atoms%econf%num_states)),nprnc(maxval(atoms%econf%num_states))
       CHARACTER(LEN=20) :: attributes(6)
@@ -53,7 +53,7 @@ CONTAINS
          DO  n = 1,atoms%ntype
             rnot = atoms%rmsh(1,n) ; dxx = atoms%dx(n)
             ncmsh = NINT( LOG( (atoms%rmt(n)+10.0)/rnot ) / dxx + 1 )
-            ncmsh = MIN( ncmsh, DIMENSION%msh )
+            ncmsh = MIN( ncmsh, atoms%msh )
             !     --->    update spherical charge density
             DO  i = 1,atoms%jri(n)
                rhoc(i) = rhc(i,n,jspin)
@@ -93,7 +93,7 @@ CONTAINS
          rnot = atoms%rmsh(1,jatom)
          d = EXP(atoms%dx(jatom))
          ncmsh = NINT( LOG( (atoms%rmt(jatom)+10.0)/rnot ) / dxx + 1 )
-         ncmsh = MIN( ncmsh, DIMENSION%msh )
+         ncmsh = MIN( ncmsh, atoms%msh )
          rn = rnot* (d** (ncmsh-1))
          WRITE (6,FMT=8000) z,rnot,dxx,atoms%jri(jatom)
          DO  j = 1,atoms%jri(jatom)
@@ -186,7 +186,7 @@ CONTAINS
          ENDIF
 
          rhc(1:ncmsh,jatom,jspin)   = rhoss(1:ncmsh) / input%jspins
-         rhc(ncmsh+1:DIMENSION%msh,jatom,jspin) = 0.0
+         rhc(ncmsh+1:atoms%msh,jatom,jspin) = 0.0
 
          seig = seig + atoms%neq(jatom)*sume
          DO  i = 1,nm

core/coredr.F90

@@ -23,7 +23,7 @@ CONTAINS
     !     .. Array Arguments ..
     REAL   , INTENT (IN) :: vrs(atoms%jmtd,atoms%ntype,input%jspins)
     REAL,    INTENT (INOUT) :: rho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins)
-    REAL,    INTENT (OUT) :: rhc(DIMENSION%msh,atoms%ntype,input%jspins),qints(atoms%ntype,input%jspins)
+    REAL,    INTENT (OUT) :: rhc(atoms%msh,atoms%ntype,input%jspins),qints(atoms%ntype,input%jspins)
     !     ..
     !     .. Local Scalars ..
     REAL dxx,rnot,sume,t2,t2b,z,t1,rr,d,v1,v2
@@ -31,9 +31,9 @@ CONTAINS
     LOGICAL exetab
     !     ..
     !     .. Local Arrays ..
-    REAL br(atoms%jmtd,atoms%ntype),brd(DIMENSION%msh),etab(100,atoms%ntype),&
-         rhcs(atoms%jmtd,atoms%ntype,input%jspins),rhochr(DIMENSION%msh),rhospn(DIMENSION%msh),&
-         tecs(atoms%ntype,input%jspins),vr(atoms%jmtd,atoms%ntype),vrd(DIMENSION%msh)
+    REAL br(atoms%jmtd,atoms%ntype),brd(atoms%msh),etab(100,atoms%ntype),&
+         rhcs(atoms%jmtd,atoms%ntype,input%jspins),rhochr(atoms%msh),rhospn(atoms%msh),&
+         tecs(atoms%ntype,input%jspins),vr(atoms%jmtd,atoms%ntype),vrd(atoms%msh)
     INTEGER nkmust(atoms%ntype),ntab(100,atoms%ntype),ltab(100,atoms%ntype)
 
     !     ..
@@ -76,7 +76,7 @@ CONTAINS
        CALL etabinit(atoms,DIMENSION,input, vr, etab,ntab,ltab,nkmust)
     END IF
     !
-    ncmsh = DIMENSION%msh
+    ncmsh = atoms%msh
     seig = 0.
     ! ---> set up densities
     DO jatom = 1,atoms%ntype
@@ -125,7 +125,7 @@ CONTAINS
        z = atoms%zatom(jatom)
        dxx = atoms%dx(jatom)
 
-       CALL spratm(DIMENSION%msh,vrd,brd,z,rnot,dxx,ncmsh,&
+       CALL spratm(atoms%msh,vrd,brd,z,rnot,dxx,ncmsh,&
             etab(1,jatom),ntab(1,jatom),ltab(1,jatom), sume,rhochr,rhospn)
 
        seig = seig + atoms%neq(jatom)*sume
@@ -144,12 +144,12 @@ CONTAINS
           END DO
        END IF
        IF (input%jspins.EQ.2) THEN
-          DO j = 1,DIMENSION%msh
+          DO j = 1,atoms%msh
              rhc(j,jatom,input%jspins) = (rhochr(j)+rhospn(j))*0.5
              rhc(j,jatom,1) = (rhochr(j)-rhospn(j))*0.5
           ENDDO
        ELSE
-          DO j = 1,DIMENSION%msh
+          DO j = 1,atoms%msh
              rhc(j,jatom,1) = rhochr(j)
           END DO
        END IF

core/etabinit.F90

@@ -39,14 +39,14 @@ CONTAINS
     !     ..
     !     .. Local Arrays ..
     INTEGER kappa(maxval(atoms%econf%num_states)),nprnc(maxval(atoms%econf%num_states))
-    REAL eig(maxval(atoms%econf%num_states)),occ(maxval(atoms%econf%num_states),1),vrd(DIMENSION%msh),a(DIMENSION%msh),b(DIMENSION%msh)
+    REAL eig(maxval(atoms%econf%num_states)),occ(maxval(atoms%econf%num_states),1),vrd(atoms%msh),a(atoms%msh),b(atoms%msh)
     !     ..
     !
     c = c_light(1.0)
     !
     WRITE (6,FMT=8020)
     !
-    ncmsh = DIMENSION%msh
+    ncmsh = atoms%msh
     !     ---> set up densities
     DO  jatom = 1,atoms%ntype
        z = atoms%zatom(jatom)
@@ -68,10 +68,10 @@ CONTAINS
           rr = atoms%rmt(jatom)
           d = EXP(atoms%dx(jatom))
        ELSE
-          t2 = vrd(atoms%jri(jatom))/ (atoms%jri(jatom)-DIMENSION%msh)
+          t2 = vrd(atoms%jri(jatom))/ (atoms%jri(jatom)-atoms%msh)
        ENDIF
-       IF (atoms%jri(jatom).LT.DIMENSION%msh) THEN
-          DO i = atoms%jri(jatom) + 1,DIMENSION%msh
+       IF (atoms%jri(jatom).LT.atoms%msh) THEN
+          DO i = atoms%jri(jatom) + 1,atoms%msh
              if (input%l_core_confpot) THEN
                 rr = d*rr
                 vrd(i) = rr*( t2 + rr*t1 )
@@ -89,7 +89,7 @@ CONTAINS
           weight = 2*fj + 1.e0
           fl = fj + (.5e0)*isign(1,kappa(korb))
           e = -2* (z/ (fn+fl))**2
-          CALL differ(fn,fl,fj,c,z,dxx,rnot,rn,d,DIMENSION%msh,vrd,&
+          CALL differ(fn,fl,fj,c,z,dxx,rnot,rn,d,atoms%msh,vrd,&
                e, a,b,ierr)
           IF (ierr/=0)  CALL juDFT_error("error in core-levels",calledby="etabinit")
           WRITE (6,FMT=8010) fn,fl,fj,e,weight

fleurinput/types_atoms.F90

@@ -35,6 +35,7 @@ MODULE m_types_atoms
       INTEGER ::n_u
       ! dimensions
       INTEGER :: jmtd
+      INTEGER :: msh=0 !core state mesh was in dimension
       !No of element
       INTEGER, ALLOCATABLE ::nz(:)
       !atoms per type
@@ -97,6 +98,7 @@ MODULE m_types_atoms
       INTEGER, ALLOCATABLE :: relax(:, :) !<(3,ntype)
       INTEGER, ALLOCATABLE :: nflip(:) !<flip magnetisation of this atom
    CONTAINS
+      PROCEDURE :: init=>init_atoms
       PROCEDURE :: nsp => calc_nsp_atom
       PROCEDURE :: same_species
       PROCEDURE :: read_xml => read_xml_atoms
@@ -118,14 +120,15 @@ MODULE m_types_atoms
         rank=0
      end if
 
-     call mpi_bc(this% ntype,rank,mpi_comm)
-     call mpi_bc(this% nat,rank,mpi_comm)
+     call mpi_bc(this%ntype,rank,mpi_comm)
+     call mpi_bc(this%nat,rank,mpi_comm)
      call mpi_bc(this%nlod,rank,mpi_comm)
      call mpi_bc(this%llod,rank,mpi_comm)
      call mpi_bc(this%nlotot,rank,mpi_comm)
-     call mpi_bc(this% lmaxd,rank,mpi_comm)
+     call mpi_bc(this%lmaxd,rank,mpi_comm)
      call mpi_bc(this%n_u,rank,mpi_comm)
-     call mpi_bc(this% jmtd,rank,mpi_comm)
+     call mpi_bc(this%jmtd,rank,mpi_comm)
+     call mpi_bc(this%msh,rank,mpi_comm)
      call mpi_bc(this%nz,rank,mpi_comm)
      call mpi_bc(this%neq,rank,mpi_comm)
      call mpi_bc(this%jri,rank,mpi_comm)
@@ -222,7 +225,7 @@ MODULE m_types_atoms
     ALLOCATE(this%lda_u(4*this%ntype))
     ALLOCATE(this%bmu(this%ntype))
     ALLOCATE(this%relax(3,this%ntype))
-    ALLOCATE(this%neq(this%ntype))
+    ALLOCATE(this%neq(this%ntype));this%neq=0
     ALLOCATE(this%taual(3,this%nat))
     ALLOCATE(this%label(this%nat))
     ALLOCATE(this%pos(3,this%nat))
@@ -231,8 +234,10 @@ MODULE m_types_atoms
     ALLOCATE(this%ncv(this%ntype)) ! For what is this?
     ALLOCATE(this%lapw_l(this%ntype)) ! Where do I put this?
     ALLOCATE(this%llo(MAXVAL(xml%get_nlo()),this%ntype))
+    ALLOCATE(this%speciesname(this%ntype))
     this%lapw_l(:) = -1
     this%n_u = 0
+    na=0
     DO n = 1, this%ntype
        !in Species:
        !@name,element,atomicNumber,coreStates
@@ -241,6 +246,7 @@ MODULE m_types_atoms
        !optional: energyParameters,prodBasis,special,force,electronConfig,nocoParams,ldaU(up to 4),lo(as many as needed)
        xpathg=xml%groupPath(n)
        xpaths=xml%speciesPath(n)
+       this%speciesname(n)=trim(adjustl(xml%getAttributeValue(TRIM(ADJUSTL(xPathg))//'/@species')))
        this%nz(n)=evaluateFirstIntOnly(xml%getAttributeValue(TRIM(ADJUSTL(xPaths))//'/@atomicNumber'))
        IF (this%nz(n).EQ.0) THEN
           WRITE(*,*) 'Note: Replacing atomic number 0 by 1.0e-10 on atom type ', n
@@ -332,7 +338,51 @@ MODULE m_types_atoms
              END DO
           END IF
        END IF
-     
+       ! Read in atom positions
+       numberNodes = xml%getNumberOfNodes(TRIM(ADJUSTL(xPathg))//'/relPos')
+       DO i = 1, numberNodes
+          this%neq(n)=this%neq(n)+1
+          na = na + 1
+          WRITE(xPath,*) TRIM(ADJUSTL(xPathg)),'/relPos[',i,']'
+          IF(xml%getNumberOfNodes(TRIM(ADJUSTL(xPath))//'/@label').NE.0) THEN
+             this%label(na) = xml%getAttributeValue(TRIM(ADJUSTL(xPath))//'/@label')
+          ELSE
+             WRITE(this%label(na),'(i0)') na
+            END IF
+            valueString = xml%getAttributeValue(TRIM(ADJUSTL(xPath)))
+            this%taual(1,na) = evaluatefirst(valueString)
+            this%taual(2,na) = evaluatefirst(valueString)
+            this%taual(3,na) = evaluatefirst(valueString)
+            this%pos(:,na)=this%taual(:,na) !Use as flag that no rescaling is needed in init
+         END DO
+
+         numberNodes = xml%getNumberOfNodes(TRIM(ADJUSTL(xPathg))//'/absPos')
+         DO i = 1, numberNodes
+            na = na + 1
+            STOP 'absPos not yet implemented!'
+         END DO
+
+         numberNodes = xml%getNumberOfNodes(TRIM(ADJUSTL(xPathg))//'/filmPos')
+         DO i = 1, numberNodes
+            this%neq(n)=this%neq(n)+1
+            na = na + 1
+            WRITE(xPath,*) TRIM(ADJUSTL(xPathg)),'/filmPos[',i,']'
+            IF(xml%getNumberOfNodes(TRIM(ADJUSTL(xPath))//'/@label').NE.0) THEN
+               this%label(na) = xml%getAttributeValue(TRIM(ADJUSTL(xPath))//'/@label')
+            ELSE
+               WRITE(this%label(na),'(i0)') na
+            END IF
+            valueString = xml%getAttributeValue(TRIM(ADJUSTL(xPath)))
+            this%taual(1,na) = evaluatefirst(valueString)
+            this%taual(2,na) = evaluatefirst(valueString)
+            this%taual(3,na) = evaluatefirst(valueString)
+            this%pos(1:2,na)=this%taual(1:2,na) !Use as flag that no rescaling is needed in init
+            this%pos(3,na)=this%taual(3,na)+1
+            END DO
+
+
+
+ 
     END DO
 
     this%nlotot = 0
@@ -346,7 +396,7 @@ MODULE m_types_atoms
     
     ALLOCATE(this%lo1l(0:this%llod,this%ntype))
     ALLOCATE(this%nlol(0:this%llod,this%ntype))