More cleanup in cdn/cdnval.F90

cdn/cdnval.F90

@@ -73,7 +73,7 @@ CONTAINS
     USE m_Ekwritesl   ! and write to file.
     USE m_abcrot2
     USE m_doswrite
-    USE m_cdnread, ONLY : cdn_read0, cdn_read
+    USE m_eig66_io, ONLY : read_eig
     USE m_corespec, only : l_cs    ! calculation of core spectra (EELS)
     USE m_corespec_io, only : corespec_init
     USE m_corespec_eval, only : corespec_gaunt,corespec_rme,corespec_dos,corespec_ddscs
@@ -112,23 +112,20 @@ CONTAINS
 
 #ifdef CPP_MPI
     INCLUDE 'mpif.h'
-    LOGICAL :: mpi_flag, mpi_status
 #endif
+
     !     .. Local Scalars ..
-    INTEGER :: llpd,ikpt,jsp_start,jsp_end,ispin,jsp
-    INTEGER :: i,ie,iv,ivac,j,k,l,n,ilo,isp,nbands,noccbd
+    INTEGER :: ikpt,jsp_start,jsp_end,ispin,jsp
+    INTEGER :: i,ie,ivac,j,k,l,n,ilo,nbands,noccbd
     INTEGER :: skip_t,skip_tt
     INTEGER :: nStart,nEnd,nbasfcn
     LOGICAL :: l_fmpl,l_evp,l_orbcomprot,l_real, l_write
-    !     ...Local Arrays ..
-    INTEGER :: noccbd_in(kpts%nkpt)
-    INTEGER :: nStart_in(kpts%nkpt)
-    INTEGER :: nEnd_in(kpts%nkpt)
-    REAL    :: eig(dimension%neigd)
 
+    !     ...Local Arrays ..
     INTEGER, ALLOCATABLE :: gvac1d(:),gvac2d(:)
     INTEGER, ALLOCATABLE :: jsym(:),ksym(:)
     REAL,    ALLOCATABLE :: we(:)
+    REAL,    ALLOCATABLE :: eig(:)
     REAL,    ALLOCATABLE :: f(:,:,:,:),g(:,:,:,:),flo(:,:,:,:) ! radial functions
 
     TYPE (t_lapw)             :: lapw
@@ -145,7 +142,6 @@ CONTAINS
 
     l_real = sym%invs.AND.(.NOT.noco%l_soc).AND.(.NOT.noco%l_noco)
 
-    llpd=(atoms%lmaxd*(atoms%lmaxd+3))/2
     !---> l_fmpl is meant as a switch to to a plot of the full magnet.
     !---> density without the atomic sphere approximation for the magnet.
     !---> density. It is not completely implemented (lo's missing).
@@ -223,18 +219,18 @@ CONTAINS
     skip_tt = dot_product(enpara%skiplo(:atoms%ntype,jspin),atoms%neq(:atoms%ntype))
     IF (noco%l_soc.OR.noco%l_noco)  skip_tt = 2 * skip_tt
     ALLOCATE (we(MAXVAL(cdnvalKLoop%noccbd(:))))
+    ALLOCATE (eig(MAXVAL(cdnvalKLoop%noccbd(:))))
     jsp = MERGE(1,jspin,noco%l_noco)
 
     DO ikpt = cdnvalKLoop%ikptStart, cdnvalKLoop%nkptExtended, cdnvalKLoop%ikptIncrement
+
        IF (ikpt.GT.kpts%nkpt) THEN
 #ifdef CPP_MPI
-          ! Synchronizes the RMA operations
-          CALL MPI_BARRIER(mpi%mpi_comm,ie)
+          CALL MPI_BARRIER(mpi%mpi_comm,ie) ! Synchronizes the RMA operations
 #endif
           EXIT
        END IF
 
-       ! -> Gu test: distribute ev's among the processors...
        CALL lapw%init(input,noco, kpts,atoms,sym,ikpt,cell,.false., mpi)
        skip_t = skip_tt
        noccbd = cdnvalKLoop%noccbd(ikpt)
@@ -242,12 +238,8 @@ CONTAINS
        nEnd = cdnvalKLoop%nEnd(ikpt)
 
        we=0.0
-       IF(noccbd.GT.0) THEN
-          we(1:noccbd) = results%w_iks(nStart:nEnd,ikpt,jsp)
-       END IF
-       IF ((sliceplot%slice).AND.(input%pallst)) THEN
-          we(:) = kpts%wtkpt(ikpt)
-       END IF
+       IF(noccbd.GT.0) we(1:noccbd) = results%w_iks(nStart:nEnd,ikpt,jsp)
+       IF ((sliceplot%slice).AND.(input%pallst)) we(:) = kpts%wtkpt(ikpt)
 
        IF (cdnvalKLoop%l_evp) THEN
           IF (nStart > skip_tt) skip_t = 0
@@ -257,20 +249,16 @@ CONTAINS
 
        nbasfcn = MERGE(lapw%nv(1)+lapw%nv(2)+2*atoms%nlotot,lapw%nv(1)+atoms%nlotot,noco%l_noco)
        CALL zMat%init(l_real,nbasfcn,noccbd)
-       CALL cdn_read(eig_id,dimension%nvd,dimension%jspd,mpi%irank,mpi%isize,&
-                     ikpt,jspin,zmat%nbasfcn,noco%l_ss,noco%l_noco,&
-                     noccbd,nStart,nEnd,nbands,eig,zMat)
+       CALL read_eig(eig_id,ikpt,jsp,n_start=nStart,n_end=nEnd,neig=nbands,zmat=zMat)
 #ifdef CPP_MPI
-       ! Synchronizes the RMA operations
-       CALL MPI_BARRIER(mpi%mpi_comm,ie)
+       CALL MPI_BARRIER(mpi%mpi_comm,ie) ! Synchronizes the RMA operations
 #endif
 
        eig(1:noccbd) = results%eig(nStart:nEnd,ikpt,jsp)
 
        IF (vacuum%nstm.EQ.3.AND.input%film) THEN
-          CALL nstm3(sym,atoms,vacuum,stars,ikpt,lapw%nv(jspin),input,jspin,kpts,&
-                     cell,kpts%wtkpt(ikpt),lapw%k1(:,jspin),lapw%k2(:,jspin),&
-                     enpara%evac0(1,jspin),vTot%vacz(:,:,jspin),gvac1d,gvac2d)
+          CALL nstm3(sym,atoms,vacuum,stars,lapw,ikpt,input,jspin,kpts,&
+                     cell,enpara%evac0(1,jspin),vTot%vacz(:,:,jspin),gvac1d,gvac2d)
        END IF
 
        IF (noccbd.EQ.0) GO TO 199
@@ -386,14 +374,8 @@ CONTAINS
           !--->    and write the information to the files dosinp and vacdos
           !--->    for dos and bandstructure plots
 
-          !--dw    parallel writing of vacdos,dosinp....
-          !        write data to direct access file first, write to formated file later by PE 0 only!
           !--dw    since z is no longer an argument of cdninf sympsi has to be called here!
-
-          IF (banddos%ndir.GT.0) THEN
-             CALL sympsi(lapw%bkpt,lapw%nv(jspin),lapw%k1(:,jspin),lapw%k2(:,jspin),&
-                         lapw%k3(:,jspin),sym,dimension,nbands,cell,eig,noco, ksym,jsym,zMat)
-          END IF
+          IF (banddos%ndir.GT.0) CALL sympsi(lapw,jspin,sym,dimension,nbands,cell,eig,noco,ksym,jsym,zMat)
 
           CALL write_dos(eig_id,ikpt,jspin,regCharges,slab,orbcomp,ksym,jsym,mcd%mcd)
 
@@ -404,7 +386,7 @@ CONTAINS
 #ifdef CPP_MPI
     CALL timestart("cdnval: mpi_col_den")
     DO ispin = jsp_start,jsp_end
-       CALL mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,input,noco,l_fmpl,ispin,llpd,regCharges,&
+       CALL mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,input,noco,l_fmpl,ispin,regCharges,&
                         results,denCoeffs,orb,denCoeffsOffdiag,den,den%mmpMat(:,:,:,jspin))
     END DO
     CALL timestop("cdnval: mpi_col_den")
@@ -412,8 +394,7 @@ CONTAINS
 
     IF (mpi%irank==0) THEN
        CALL cdnmt(dimension%jspd,atoms,sphhar,noco,l_fmpl,jsp_start,jsp_end,&
-                  enpara%el0,enpara%ello0,vTot%mt(:,0,:,:),denCoeffs,&
-                  usdus,orb,denCoeffsOffdiag,moments,den%mt)
+                  enpara,vTot%mt(:,0,:,:),denCoeffs,usdus,orb,denCoeffsOffdiag,moments,den%mt)
 
        IF(l_cs) CALL corespec_ddscs(jspin,input%jspins)
 
@@ -459,7 +440,7 @@ CONTAINS
 
     END IF ! end of (mpi%irank==0)
 #ifdef CPP_MPI
-    CALL MPI_BARRIER(mpi%mpi_comm,ie)
+    CALL MPI_BARRIER(mpi%mpi_comm,ie) ! Synchronizes the RMA operations
 #endif
 
     IF ((jsp_end.EQ.input%jspins)) THEN

cdn_mt/cdnmt.f90

@@ -10,8 +10,8 @@ MODULE m_cdnmt
   !     Philipp Kurz 2000-02-03
   !***********************************************************************
 CONTAINS
-  SUBROUTINE cdnmt(jspd,atoms,sphhar,noco,l_fmpl,jsp_start,jsp_end, epar,&
-                   ello,vr,denCoeffs,usdus,orb,denCoeffsOffdiag,moments,rho)
+  SUBROUTINE cdnmt(jspd,atoms,sphhar,noco,l_fmpl,jsp_start,jsp_end,enpara,&
+                   vr,denCoeffs,usdus,orb,denCoeffsOffdiag,moments,rho)
     use m_constants,only: sfp_const
     USE m_rhosphnlo
     USE m_radfun
@@ -23,6 +23,7 @@ CONTAINS
     TYPE(t_noco),    INTENT(IN)    :: noco
     TYPE(t_sphhar),  INTENT(IN)    :: sphhar
     TYPE(t_atoms),   INTENT(IN)    :: atoms
+    TYPE(t_enpara),  INTENT(IN)    :: enpara
     TYPE(t_moments), INTENT(INOUT) :: moments
 
     !     .. Scalar Arguments ..
@@ -30,9 +31,7 @@ CONTAINS
     LOGICAL, INTENT (IN) :: l_fmpl
     !     ..
     !     .. Array Arguments ..
-    REAL, INTENT    (IN) :: epar(0:atoms%lmaxd,atoms%ntype,jspd)
     REAL, INTENT    (IN) :: vr(atoms%jmtd,atoms%ntype,jspd)
-    REAL, INTENT    (IN) :: ello(atoms%nlod,atoms%ntype,jspd)
     REAL, INTENT (INOUT) :: rho(:,0:,:,:)!(toms%jmtd,0:sphhar%nlhd,atoms%ntype,jspd)
     TYPE (t_orb),              INTENT(IN) :: orb
     TYPE (t_denCoeffs),        INTENT(IN) :: denCoeffs
@@ -66,7 +65,7 @@ CONTAINS
     !$OMP PARALLEL DEFAULT(none) &
 
     !$OMP SHARED(usdus,rho,moments,rho21,qmtl) &
-    !$OMP SHARED(atoms,jsp_start,jsp_end,epar,vr,denCoeffs,sphhar,ello)&
+    !$OMP SHARED(atoms,jsp_start,jsp_end,enpara,vr,denCoeffs,sphhar)&
     !$OMP SHARED(orb,noco,l_fmpl,denCoeffsOffdiag,jspd)&
     !$OMP PRIVATE(itype,na,ispin,l,f,g,nodeu,noded,wronk,i,j,s,qmtllo,qmtt,nd,lh,lp,llp,cs)
     IF (noco%l_mperp) THEN
@@ -87,7 +86,7 @@ CONTAINS
        !--->    spherical component
        DO ispin = jsp_start,jsp_end
           DO l = 0,atoms%lmax(itype)
-             CALL radfun(l,itype,ispin,epar(l,itype,ispin),vr(1,itype,ispin),atoms,&
+             CALL radfun(l,itype,ispin,enpara%el0(l,itype,ispin),vr(1,itype,ispin),atoms,&
                   f(1,1,l,ispin),g(1,1,l,ispin),usdus, nodeu,noded,wronk)
              DO j = 1,atoms%jri(itype)
                 s = denCoeffs%uu(l,itype,ispin)*( f(j,1,l,ispin)*f(j,1,l,ispin)+f(j,2,l,ispin)*f(j,2,l,ispin) )&
@@ -106,7 +105,7 @@ CONTAINS
 
           CALL rhosphnlo(itype,atoms,sphhar,&
                usdus%uloulopn(1,1,itype,ispin),usdus%dulon(1,itype,ispin),&
-               usdus%uulon(1,itype,ispin),ello(1,itype,ispin),&
+               usdus%uulon(1,itype,ispin),enpara%ello0(1,itype,ispin),&
                vr(1,itype,ispin),denCoeffs%aclo(1,itype,ispin),denCoeffs%bclo(1,itype,ispin),&
                denCoeffs%cclo(1,1,itype,ispin),denCoeffs%acnmt(0,1,1,itype,ispin),&
                denCoeffs%bcnmt(0,1,1,itype,ispin),denCoeffs%ccnmt(1,1,1,itype,ispin),&

dos/nstm3.f90

@@ -9,13 +9,9 @@ MODULE m_nstm3
   !
   !***********************************************************************
 CONTAINS
-  SUBROUTINE nstm3(&
-       &                 sym,atoms,vacuum,stars,ikpt,nv,&
-       &                 input,jspin,kpts,&
-       &                 cell,wk,k1,k2,&
-       &                 evac,vz,&
-       &                 gvac1d,gvac2d)
-    !
+  SUBROUTINE nstm3(sym,atoms,vacuum,stars,lapw,ikpt,input,jspin,kpts,&
+                   cell,evac,vz,gvac1d,gvac2d)
+
     USE m_sort
     USE m_types
     IMPLICIT NONE
@@ -24,17 +20,16 @@ CONTAINS
     TYPE(t_vacuum),INTENT(IN)   :: vacuum
     TYPE(t_sym),INTENT(IN)      :: sym
     TYPE(t_stars),INTENT(IN)    :: stars
+    TYPE(t_lapw),INTENT(IN)     :: lapw
     TYPE(t_cell),INTENT(IN)     :: cell
     TYPE(t_kpts),INTENT(IN)     :: kpts
     TYPE(t_atoms),INTENT(IN)    :: atoms
     !     ..
     !     .. Scalar Arguments ..
-    INTEGER, INTENT (IN) :: ikpt,nv      
+    INTEGER, INTENT (IN) :: ikpt   
     INTEGER, INTENT (IN) :: jspin      
-    REAL,    INTENT (IN) :: wk 
     !     ..
     !     .. Array  Arguments ..
-    INTEGER, INTENT (IN) :: k1(:),k2(:)
     REAL,    INTENT (IN) :: evac(2)
     REAL,    INTENT (IN) :: vz(:,:)!(vacuum%nmzd,2)
     INTEGER, INTENT (OUT) :: gvac1d(:),gvac2d(:) !(dimension%nv2d)
@@ -50,17 +45,17 @@ CONTAINS
     !
     IF (ikpt.EQ.1) THEN
        n2 = 0
-       k_loop: DO  k = 1,nv
+       k_loop: DO  k = 1,lapw%nv(jspin)
           DO j = 1,n2
-             IF (k1(k).EQ.gvac1(j).AND.k2(k).EQ.gvac2(j)) THEN
+             IF (lapw%k1(k,jspin).EQ.gvac1(j).AND.lapw%k2(k,jspin).EQ.gvac2(j)) THEN
                 CYCLE k_loop
              END IF
           ENDDO
           n2 = n2 + 1
-          gvac1(n2) = k1(k)
-          gvac2(n2) = k2(k)
+          gvac1(n2) = lapw%k1(k,jspin)
+          gvac2(n2) = lapw%k2(k,jspin)
           DO i=1,2
-             gvac(i)=k1(k)*cell%bmat(1,i)+k2(k)*cell%bmat(2,i)
+             gvac(i)=lapw%k1(k,jspin)*cell%bmat(1,i)+lapw%k2(k,jspin)*cell%bmat(2,i)
           END DO
           gvacl(n2) = SQRT(REAL(gvac(1)**2+gvac(2)**2))
        ENDDO k_loop
@@ -120,7 +115,7 @@ CONTAINS
     !  only write here if not on T3E
 
 
-    WRITE (87,'(i3,1x,f12.6)') ikpt,wk
+    WRITE (87,'(i3,1x,f12.6)') ikpt,kpts%wtkpt(ikpt)
 
   END SUBROUTINE nstm3
 END MODULE m_nstm3

dos/sympsi.F90

@@ -18,13 +18,14 @@ MODULE m_sympsi
   ! Jussi Enkovaara, Juelich 2004
 
 CONTAINS
-  SUBROUTINE sympsi(bkpt,nv,kx,ky,kz,sym,DIMENSION,ne,cell,eig,noco, ksym,jsym,zMat)
+  SUBROUTINE sympsi(lapw,jspin,sym,DIMENSION,ne,cell,eig,noco, ksym,jsym,zMat)
 
     USE m_grp_k
     USE m_inv3
     USE m_types
     IMPLICIT NONE
 
+    TYPE(t_lapw),INTENT(IN)        :: lapw
     TYPE(t_dimension),INTENT(IN)   :: DIMENSION
     TYPE(t_noco),INTENT(IN)        :: noco
     TYPE(t_sym),INTENT(IN)         :: sym
@@ -32,11 +33,10 @@ CONTAINS
     TYPE(t_zMat),INTENT(IN)        :: zMat
     !
     !     .. Scalar Arguments ..
-    INTEGER, INTENT (IN) :: nv,ne
+    INTEGER, INTENT (IN) :: ne,jspin
     !     ..
     !     .. Array Arguments ..
-    INTEGER, INTENT (IN) :: kx(:),ky(:),kz(:)!(nvd) 
-    REAL,    INTENT (IN) :: bkpt(3),eig(DIMENSION%neigd)
+    REAL,    INTENT (IN) :: eig(DIMENSION%neigd)
 
     INTEGER, INTENT (OUT):: jsym(DIMENSION%neigd),ksym(DIMENSION%neigd)
     !     ..
@@ -72,9 +72,9 @@ CONTAINS
 
     IF (soc) THEN
        ALLOCATE(su(2,2,2*sym%nop))
-       CALL grp_k(sym,mrot_k,cell,bkpt,nclass,nirr,c_table, grpname,irrname,su)
+       CALL grp_k(sym,mrot_k,cell,lapw%bkpt,nclass,nirr,c_table, grpname,irrname,su)
     ELSE
-       CALL grp_k(sym,mrot_k,cell,bkpt,nclass,nirr,c_table, grpname,irrname)
+       CALL grp_k(sym,mrot_k,cell,lapw%bkpt,nclass,nirr,c_table, grpname,irrname)
     ENDIF
     ALLOCATE(csum(ne,ne,nclass))
     ALLOCATE(chars(ne,nclass))
@@ -97,25 +97,25 @@ CONTAINS
     gmap=0
     DO c=1,nclass
        CALL inv3(mrot_k(:,:,c),mtmpinv,d)
-       kloop: DO k=1,nv
-          kv(1)=kx(k)
-          kv(2)=ky(k)
-          kv(3)=kz(k)
-          kv=kv+bkpt
+       kloop: DO k=1,lapw%nv(jspin)
+          kv(1)=lapw%k1(k,jspin)
+          kv(2)=lapw%k2(k,jspin)
+          kv(3)=lapw%k3(k,jspin)
+          kv=kv+lapw%bkpt
           kvtest=MATMUL(kv,mtmpinv)
           !         kvtest=MATMUL(kv,mrot_k(:,:,c))
-          DO i = 1,nv
-             kv(1)=kx(i)
-             kv(2)=ky(i)
-             kv(3)=kz(i)
-             kv=kv+bkpt
+          DO i = 1,lapw%nv(jspin)
+             kv(1)=lapw%k1(i,jspin)
+             kv(2)=lapw%k2(i,jspin)
+             kv(3)=lapw%k3(i,jspin)
+             kv=kv+lapw%bkpt
              IF (ABS(kvtest(1)-kv(1)).LT.small.AND.&
                   ABS(kvtest(2)-kv(2)).LT.small.AND. ABS(kvtest(3)-kv(3)).LT.small) THEN
                 gmap(k,c)=i
                 CYCLE kloop
              ENDIF
           ENDDO
-          WRITE(6,*) 'Problem in symcheck, cannot find rotated kv for', k,kx(k),ky(k),kz(k)
+          WRITE(6,*) 'Problem in symcheck, cannot find rotated kv for', k,lapw%k1(k,jspin),lapw%k2(k,jspin),lapw%k3(k,jspin)
           RETURN
        ENDDO kloop
     ENDDO
@@ -124,16 +124,16 @@ CONTAINS
     DO i=1,ne
        norm(i)=0.0
        IF (soc) THEN
-          DO k=1,nv*2
+          DO k=1,lapw%nv(jspin)*2
              norm(i)=norm(i)+ABS(zMat%z_c(k,i))**2
           ENDDO
        ELSE
           IF (zmat%l_real) THEN
-             DO k=1,nv
+             DO k=1,lapw%nv(jspin)
                 norm(i)=norm(i)+ABS(zMat%z_r(k,i))**2
              ENDDO
           ELSE
-             DO k=1,nv
+             DO k=1,lapw%nv(jspin)
                 norm(i)=norm(i)+ABS(zMat%z_c(k,i))**2
              ENDDO
           ENDIF
@@ -161,21 +161,21 @@ CONTAINS
           DO n1=1,ndeg
              DO n2=1,ndeg
                 IF (zmat%l_real) THEN
-                   DO k=1,nv
+                   DO k=1,lapw%nv(jspin)
                       csum(n1,n2,c)=csum(n1,n2,c)+zMat%z_r(k,deg(n1))*&
                            zMat%z_r(gmap(k,c),deg(n2))/(norm(deg(n1))*norm(deg(n2)))
                    END DO
                 ELSE
                    IF (soc) THEN  
-                      DO k=1,nv
+                      DO k=1,lapw%nv(jspin)
 
                          csum(n1,n2,c)=csum(n1,n2,c)+(CONJG(zMat%z_c(k,deg(n1)))*&
-                              (su(1,1,c)*zMat%z_c(gmap(k,c),deg(n2))+ su(1,2,c)*zMat%z_c(gmap(k,c)+nv,deg(n2)))+&
-                              CONJG(zMat%z_c(k+nv,deg(n1)))* (su(2,1,c)*zMat%z_c(gmap(k,c),deg(n2))+&
-                              su(2,2,c)*zMat%z_c(gmap(k,c)+nv,deg(n2))))/ (norm(deg(n1))*norm(deg(n2)))
+                              (su(1,1,c)*zMat%z_c(gmap(k,c),deg(n2))+ su(1,2,c)*zMat%z_c(gmap(k,c)+lapw%nv(jspin),deg(n2)))+&
+                              CONJG(zMat%z_c(k+lapw%nv(jspin),deg(n1)))* (su(2,1,c)*zMat%z_c(gmap(k,c),deg(n2))+&
+                              su(2,2,c)*zMat%z_c(gmap(k,c)+lapw%nv(jspin),deg(n2))))/ (norm(deg(n1))*norm(deg(n2)))
                       END DO
                    ELSE
-                      DO k=1,nv
+                      DO k=1,lapw%nv(jspin)
                          csum(n1,n2,c)=csum(n1,n2,c)+CONJG(zMat%z_c(k,deg(n1)))*&
                               zMat%z_c(gmap(k,c),deg(n2))/(norm(deg(n1))*norm(deg(n2)))
                       END DO
@@ -217,7 +217,7 @@ CONTAINS
     !>
 
     IF (.NOT.char_written) THEN
-       WRITE(444,124) bkpt
+       WRITE(444,124) lapw%bkpt
        WRITE(444,*) 'Group is ' ,grpname
        DO c=1,nirr
           IF (zmat%l_real)THEN

mpi/mpi_col_den.F90

@@ -10,7 +10,7 @@ MODULE m_mpi_col_den
   !
 CONTAINS
   SUBROUTINE mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,&
-       input, noco,l_fmpl,jspin,llp