Removed lots of preprocessor dependencies, fixed BUG in last commit

cdn/pwden.F90

@@ -371,7 +371,7 @@ CONTAINS
           isn = 1
 #if ( defined(CPP_INVERSION) && !defined(CPP_SOC) )
      CALL rfft(isn,stars%kq1_fft,stars%kq2_fft,stars%kq3_fft+1,stars%kq1_fft,stars%kq2_fft,stars%kq3_fft,&
-          nw1,nw2,nw3,wsave,psir(ifftq3d), psir(-ifftq2))
+     nw1,nw2,nw3,wsave,psir(ifftq3d), psir(-ifftq2))
 
      ! GM forces part
           IF (input%l_f) THEN
@@ -566,8 +566,8 @@ CONTAINS
 
        isn = -1
 #if ( defined(CPP_INVERSION) && !defined(CPP_SOC) )
-       CALL rfft(isn,stars%kq1_fft,stars%kq2_fft,stars%kq3_fft+1,stars%kq1_fft,stars%kq2_fft,stars%kq3_fft,&
-            stars%kq1_fft,stars%kq2_fft,stars%kq3_fft,wsave,psir(ifftq3d), rhon(-ifftq2))
+     CALL rfft(isn,stars%kq1_fft,stars%kq2_fft,stars%kq3_fft+1,stars%kq1_fft,stars%kq2_fft,stars%kq3_fft,&
+     stars%kq1_fft,stars%kq2_fft,stars%kq3_fft,wsave,psir(ifftq3d), rhon(-ifftq2))
        IF (input%l_f) CALL rfft(isn,stars%kq1_fft,stars%kq2_fft,stars%kq3_fft+1,stars%kq1_fft,stars%kq2_fft,stars%kq3_fft,&
             stars%kq1_fft,stars%kq2_fft,stars%kq3_fft,wsave,kpsir(ifftq3d), ekin(-ifftq2))
 #else
@@ -620,18 +620,19 @@ CONTAINS
     DO istr = 1 , stars%ng3_fft
        cwk(istr) = scale * cwk(istr) / REAL( stars%nstr(istr) )
     ENDDO
-#ifdef CPP_APW
-    IF (input%l_f) THEN
-       DO istr = 1 , stars%ng3_fft
-          ecwk(istr) = scale * ecwk(istr) / REAL( stars%nstr(istr) )
-       ENDDO
-       CALL forces_b8(&
-            atoms,ecwk,stars,&
-            sym,cell,&
-            jspin,&
-            forces,f_b8)
+    IF (input%l_useapw) THEN
+
+       IF (input%l_f) THEN
+          DO istr = 1 , stars%ng3_fft
+             ecwk(istr) = scale * ecwk(istr) / REAL( stars%nstr(istr) )
+          ENDDO
+          CALL force_b8(&
+               atoms,ecwk,stars,&
+               sym,cell,&
+               jspin,&
+               forces,f_b8)
+       ENDIF
     ENDIF
-#endif
     !
     !---> check charge neutralilty
     !

cdn_mt/#abccoflo.f90#

-MODULE m_abccoflo
-  USE m_juDFT
-  !*********************************************************************
-  ! Calculates the (upper case) A, B and C coefficients for the local
-  ! orbitals.
-  ! Philipp Kurz 99/04
-  !*********************************************************************
-CONTAINS
-  SUBROUTINE abccoflo(atoms, con1,rph,cph,ylm,ntyp,na,k,nv,&
-       l_lo1,alo1,blo1,clo1, nkvec, enough,alo,blo,clo,kvec)
-    !
-    !*************** ABBREVIATIONS ***************************************
-    ! kvec    : stores the number of the G-vectors, that have been used to
-    !           construct the local orbitals
-    ! nkvec   : stores the number of G-vectors that have been found and
-    !           accepted during the construction of the local orbitals.
-    ! enough  : enough is set to .true. when enough G-vectors have been
-    !           accepted.
-    ! linindq : if the norm of that part of a local orbital (contructed 
-    !           with a trial G-vector) that is orthogonal to the previous
-    !           ones is larger than linindq, then this G-vector is 
-    !           accepted.
-    !*********************************************************************
-    !
-    USE m_constants
-    USE m_types
-    IMPLICIT NONE
-
-    TYPE(t_atoms),INTENT(IN)   :: atoms
-    !     .. 
-    !     .. Scalar Arguments ..
-    REAL,    INTENT (IN) :: con1,cph ,rph
-    INTEGER, INTENT (IN) :: k,na,ntyp,nv
-    LOGICAL, INTENT (IN) :: l_lo1
-    LOGICAL, INTENT (OUT):: enough
-    !     ..
-    !     .. Array Arguments ..
-    INTEGER, INTENT (IN)::  kvec(2* (2*atoms%llod+1),atoms%nlod) )
-    REAL,    INTENT (IN) :: alo1(atoms%nlod),blo1(atoms%nlod),clo1(atoms%nlod)
-    COMPLEX, INTENT (IN) :: ylm( (atoms%lmaxd+1)**2 )
-    COMPLEX, INTENT (OUT):: alo(-atoms%llod:atoms%llod,2* (2*atoms%llod+1),atoms%nlod)  
-    COMPLEX, INTENT (OUT):: blo(-atoms%llod:atoms%llod,2* (2*atoms%llod+1),atoms%nlod)  
-    COMPLEX, INTENT (OUT):: clo(-atoms%llod:atoms%llod,2* (2*atoms%llod+1),atoms%nlod)  
-    INTEGER,INTENT (INOUT):: nkvec(atoms%nlod)
-    !     ..
-    !     .. Local Scalars ..
-    COMPLEX term1
-    REAL,PARAMETER:: linindq=1.e-4
-    INTEGER l,lo ,mind,ll1,lm
-    LOGICAL linind
-    !     ..
-    !
-    !---> the whole program is in hartree units, therefore 1/wronskian is
-    !---> (rmt**2)/2. the factor i**l, which usually appears in the a, b
-    !---> and c coefficients, is included in the t-matrices. thus, it does
-    !---> not show up in the formula above.
-    !
-    !-abccoflo1
-    IF ( l_lo1) THEN
-       DO lo = 1,atoms%nlo(ntyp)
-          IF ( (nkvec(lo).EQ.0).AND.(atoms%llo(lo,ntyp).EQ.0) ) THEN
-             enough = .FALSE.
-             nkvec(lo) = 1
-             m = 0
-             clo(m,nkvec(lo),lo) = con1* ((atoms%rmt**2)/2) / SQRT(fpi_const)
-             alo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*alo1(lo)
-             blo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*blo1(lo)
-             clo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*clo1(lo)
-             IF (kvec(nkvec(lo),lo)/=k)  CALL juDFT_error("abccoflo:1"&
-                  &           ,calledby ="abccoflo")
-
-          ENDIF
-       ENDDO
-    ELSE
-       enough = .TRUE.
-       term1 = con1* ((atoms%rmt**2)/2)*CMPLX(rph,cph)
-       DO lo = 1,atoms%nlo(ntyp)
-          IF (atoms%invsat(na).EQ.0) THEN
-             IF ((nkvec(lo)).LT. (2*atoms%llo(lo,ntyp)+1)) THEN
-                enough = .FALSE.
-                nkvec(lo) = nkvec(lo) + 1
-                l = atoms%llo(lo,ntyp)
-                ll1 = l*(l+1) + 1
-                DO m = -l,l
-                   lm = ll1 + m
-                   clo(m,nkvec(lo),lo) = term1*ylm(lm)
-                END DO
-                IF ( kvec(nkvec(lo),lo) == k ) THEN
-                   DO m = -l,l
-                      alo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*alo1(lo)
-                      blo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*blo1(lo)
-                      clo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*clo1(lo)
-                   END DO
-                   !                  WRITE(6,9000) nkvec(lo),k,lo,na,
-                   !     +                          (clo(m,nkvec(lo),lo),m=-l,l)
-                   ! 9000             format(2i4,2i2,7(' (',e9.3,',',e9.3,')'))
-                ELSE
-                   nkvec(lo) = nkvec(lo) - 1
-                ENDIF
-             ENDIF
-          ELSE
-             IF ((atoms%invsat(na).EQ.1) .OR. (atoms%invsat(na).EQ.2)) THEN
-                !           only invsat=1 is needed invsat=2 for testing
-                IF ((nkvec(lo)).LT. (2* (2*atoms%llo(lo,ntyp)+1))) THEN
-                   enough = .FALSE.
-                   nkvec(lo) = nkvec(lo) + 1
-                   l = atoms%llo(lo,ntyp)
-                   ll1 = l*(l+1) + 1
-                   DO m = -l,l
-                      lm = ll1 + m
-                      clo(m,nkvec(lo),lo) = term1*ylm(lm)
-                   END DO
-                   IF ( kvec(nkvec(lo),lo) == k ) THEN
-                      DO m = -l,l
-                         !                            if(l.eq.1) then
-                         !               WRITE(*,*)'k=',k,' clotmp=',clo(m,nkvec(lo),lo)
-                         !               WRITE(*,*)'clo1=',clo1(lo),' term1=',term1
-                         !                            endif
-                         alo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*alo1(lo)
-                         blo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*blo1(lo)
-                         clo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*clo1(lo)
-                         !                        kvec(nkvec(lo),lo) = k
-                      END DO
-                   ELSE
-                      nkvec(lo) = nkvec(lo) - 1
-                   END IF
-                END IF
-             END IF
-          END IF
-       END DO
-       IF ((k.EQ.nv) .AND. (.NOT.enough)) THEN
-          WRITE (6,FMT=*)&
-               &     'abccoflo did not find enough linearly independent'
-          WRITE (6,FMT=*)&
-               &     'clo coefficient-vectors. the linear independence'
-          WRITE (6,FMT=*) 'quality, linindq, is set to: ',linindq,'.'
-          WRITE (6,FMT=*) 'this value might be to large.'
-          CALL juDFT_error&
-               &        ("abccoflo: did not find enough lin. ind. clo-vectors"&
-               &        ,calledby ="abccoflo")
-       END IF
-    ENDIF  ! abccoflo1
-
-  END SUBROUTINE abccoflo
-END MODULE m_abccoflo

cdn_mt/abcof.F90

 MODULE m_abcof
 CONTAINS
-  SUBROUTINE abcof(atoms,nobd,sym, cell, bkpt,lapw,ne,z,usdus,&
+  SUBROUTINE abcof(input,atoms,nobd,sym, cell, bkpt,lapw,ne,z,usdus,&
        noco,jspin,kveclo,oneD, acof,bcof,ccof)
     !     ************************************************************
     !     subroutine constructs the a,b coefficients of the linearized
@@ -16,7 +16,8 @@ CONTAINS
     USE m_ylm
     USE m_types
     IMPLICIT NONE
-    TYPE(t_usdus),INTENT(IN)   :: usdus
+    TYPE(t_input),INTENT(IN)  :: input
+    TYPE(t_usdus),INTENT(IN)  :: usdus
     TYPE(t_lapw),INTENT(IN)   :: lapw
     TYPE(t_oneD),INTENT(IN)   :: oneD
     TYPE(t_noco),INTENT(IN)   :: noco
@@ -79,9 +80,7 @@ CONTAINS
           DO lo = 1,atoms%nlo(n)
              IF (atoms%l_dulo(lo,n)) apw(l,n) = .true.
           ENDDO
-#ifdef CPP_APW
-          IF (atoms%lapw_l(n).GE.l) apw(l,n) = .false.
-#endif
+          IF ((input%l_useapw).AND.(atoms%lapw_l(n).GE.l)) apw(l,n) = .false.
        ENDDO
        DO lo = 1,atoms%nlo(n)
           IF (atoms%l_dulo(lo,n)) apw(atoms%llo(lo,n),n) = .true.

cdn_mt/abcof3.F90

 MODULE m_abcof3
 CONTAINS
-  SUBROUTINE abcof3(atoms,sym,jspin, cell, bkpt,lapw,&
+  SUBROUTINE abcof3(input,atoms,sym,jspin, cell, bkpt,lapw,&
        usdus, kveclo,oneD,a,b,bascof_lo)
     !     ************************************************************
     !     subroutine constructs the a,b coefficients of the linearized
@@ -16,6 +16,7 @@ CONTAINS
     USE m_ylm
     USE m_types
     IMPLICIT NONE
+    TYPE(t_input),INTENT(IN)   :: input
     TYPE(t_usdus),INTENT(IN)   :: usdus
     TYPE(t_lapw),INTENT(IN)   :: lapw
     TYPE(t_oneD),INTENT(IN)   :: oneD
@@ -61,9 +62,8 @@ CONTAINS
           DO lo = 1,atoms%nlo(n)
              IF (atoms%l_dulo(lo,n)) apw(l,n) = .true.
           ENDDO
-#ifdef CPP_APW
-          IF (atoms%lapw_l(n).GE.l) apw(l,n) = .false.
-#endif
+          IF ((input%l_useapw).AND.(atoms%lapw_l(n).GE.l)) apw(l,n) = .false.
+
        ENDDO
        DO lo = 1,atoms%nlo(n)
           IF (atoms%l_dulo(lo,n)) apw(atoms%llo(lo,n),n) = .true.

cmake/Architectures.txt

@@ -17,6 +17,8 @@ elseif ($ENV{FC} MATCHES "gfortran.*")
    set (configfile "cmake/cmake.gfortran.config")
 elseif ($ENV{FC} MATCHES "ifort.*")
    set (configfile "cmake/cmake.ifort.config")
+elseif (CMAKE_SYSTEM_NAME MATCHES "Darwin")
+   set (configfile "cmake/cmake.darwin.config")
 elseif (${sitename} MATCHES "iff.*")
    set (configfile "cmake/cmake.iff.config")
 elseif (${sitename} MATCHES "jrl.*")
@@ -28,8 +30,6 @@ elseif (${sitename} MATCHES "jrl.*")
    endif()
 elseif (${sitename} MATCHES "juquee.*")
    set (configfile "cmake/cmake.juqueen.config")
-elseif (CMAKE_SYSTEM_NAME MATCHES "Darwin")
-   set (configfile "cmake/cmake.darwin.config")
 endif ()
 
 if (${configfile} MATCHES "NOTFOUND")

diagonalization/chani.F90

@@ -302,17 +302,11 @@ CONTAINS
        WRITE (*,*) 'ERROR: chani.F: Allocating rwork failed'
        CALL juDFT_error('Failed to allocated "rwork"', calledby ='chani')
     ENDIF
-#ifdef CPP_T90
-    CALL CPP_LAPACK_pzhegvx(1,'V','I','U',m,asca,1,1,desca,bsca,1,1, desca,&
-         0.0,1.0,1,m,abstol,num1,num2,eig2,orfac,eigvec,1,1,&
-         desceigv,work2,-1,rwork,-1,iwork,-1,ifail,iclustr,&
-         gap,ierr)
-#else
+
     CALL CPP_LAPACK_pzhegvx(1,'V','I','U',m,asca,1,1,desca,bsca,1,1, desca,&
          0.0,1.0,1,num,abstol,num1,num2,eig2,orfac,eigvec,1,1,&
          desceigv,work2,-1,rwork,-1,iwork,-1,ifail,iclustr,&
          gap,ierr)
-#endif
     IF (ABS(work2(1)).GT.lwork2) THEN
        lwork2=work2(1)
        DEALLOCATE (work2)

diagonalization/eigen_diag.F90

@@ -56,7 +56,7 @@ CONTAINS
 #ifdef CPP_SCALAPACK
     USE m_chani
 #endif
-#ifdef CPP_elemental
+#ifdef CPP_ELEMENTAL
     USE m_elemental
 #endif
     IMPLICIT NONE

diagonalization/geneigbrobl.F90

@@ -24,17 +24,6 @@ CONTAINS
 
     REAL,    INTENT(OUT) :: eig(:)
     INTEGER, INTENT(OUT) :: ne
-#ifdef CPP_F90
-
-#ifdef CPP_INVERSION
-    REAL,  INTENT (INOUT) :: a(:),b(:)
-    REAL,  INTENT (INOUT) :: z(:,:)
-#else
-    COMPLEX, INTENT (INOUT)::a(:),b(:)
-    COMPLEX, INTENT (INOUT) :: z(:,:)
-#endif
-
-#else
 
 #ifdef CPP_INVERSION
     REAL, ALLOCATABLE, INTENT (INOUT) :: a(:),b(:)
@@ -44,7 +33,6 @@ CONTAINS
     COMPLEX, ALLOCATABLE, INTENT (INOUT) :: z(:,:)
 #endif
 
-#endif
 
     ! ... Local Variables ..
 
@@ -82,9 +70,7 @@ CONTAINS
        ENDDO
     ENDDO
     !save some storage by deallocation of unused array
-#ifndef CPP_F90
     DEALLOCATE (a)
-#endif
     !metric
     ALLOCATE ( largeb(nsize,nsize), stat=err )
     IF (err/=0)  CALL juDFT_error("error allocating largeb",calledby ="geneigprobl")
@@ -97,9 +83,7 @@ CONTAINS
        ENDDO
     ENDDO
     !save some storage by deallocation of unused array
-#ifndef CPP_F90
     DEALLOCATE (b)
-#endif
 
 
 
@@ -120,7 +104,6 @@ CONTAINS
     IF (err/=0)  CALL juDFT_error(" error allocating work",calledby ="geneigprobl")
     ALLOCATE ( isuppz(2*nsize), stat=err )
     IF (err /= 0)  CALL juDFT_error("error allocating isuppz",calledby ="geneigprobl")
-#ifndef CPP_F90
     IF (allocated(z)) THEN
        IF (.not.(size(z,1)==nbasfcn.and.size(z,2)==neigd)) deallocate(z)
     ENDIF
@@ -131,10 +114,8 @@ CONTAINS
           CALL juDFT_error("error allocating z",calledby ="geneigprobl")
        ENDIF
     ENDIF
-#endif
     sizez= size(z,1) 
     iu   = min(nsize,neigd)
-#ifndef CPP_F90
     IF (l_J) THEN
        CALL CPP_LAPACK_ssyevr('N','I','U',nsize,largea, nsize,lb,ub,1,iu,toler,ne,eigTemp,z,&
             sizez,isuppz,work,lwork,iwork,liwork,info)
@@ -142,10 +123,6 @@ CONTAINS
        CALL CPP_LAPACK_ssyevr('V','I','U',nsize,largea,nsize,lb,ub,1,iu,toler,ne,eigTemp,z,&
             sizez,isuppz,work,lwork,iwork,liwork,info)
     ENDIF
-#else
-    eig = 0.0
-    eigTemp = 0.0
-#endif
     IF (info /= 0)  CALL juDFT_error("error in ssyevr",calledby ="geneigprobl")
     DEALLOCATE (isuppz,work,iwork)
 
@@ -174,7 +151,6 @@ CONTAINS
     lrwork = 84*nsize
     ALLOCATE (work(lrwork), stat=err )
     IF (err/=0)  CALL juDFT_error(" error allocating work",calledby ="geneigprobl")
-#ifndef CPP_F90
     IF (allocated(z)) THEN
        IF (.not.(size(z,1)==nbasfcn.and.size(z,2)==neigd)) deallocate(z)
     ENDIF
@@ -185,27 +161,15 @@ CONTAINS
           CALL juDFT_error("error allocating z",calledby ="geneigprobl")
        ENDIF
     ENDIF
-#endif
     sizez= size(z,1) 
     iu   = min(nsize,neigd)
-#ifndef CPP_F90
     IF (l_J) THEN
        CALL CPP_LAPACK_cheevr('N','I','U',nsize,largea, nsize,lb,ub,1,iu,toler,ne,eigTemp,z,&
             sizez,isuppz,cwork,lwork,work,lrwork,iwork,liwork,info)
     ELSE
-#if (1==1)
        CALL CPP_LAPACK_cheevr('V','I','U',nsize,largea, nsize,lb,ub,1,iu,toler,ne,eigTemp,z,&
             sizez,isuppz,cwork,lwork,work,lrwork,iwork,liwork,info)
-#else
-
-       CALL CPP_LAPACK_cheevx('V','I','U',nsize,largea, nsize,lb,ub,1,iu,toler,ne,eigTemp,z,&
-            sizez,cwork,lwork,work,iwork,isuppz,info)
-#endif
     ENDIF
-#else
-    eig = 0.0
-    eigTemp = 0.0
-#endif
     IF (info /= 0)  CALL juDFT_error("error in cheevr",calledby ="geneigprobl")
     DEALLOCATE ( isuppz )
     deallocate ( work   )

diagonalization/zsymsecloc.F90

@@ -50,17 +50,6 @@ CONTAINS
     !     .. Array Arguments ..
     INTEGER, INTENT (IN)  :: matind(dimension%nbasfcn,2)
     REAL,    INTENT (OUT) :: eig(dimension%neigd)
-#ifdef CPP_F90
-
-#ifdef CPP_INVERSION
-    REAL,  INTENT (INOUT) :: a(:),b(:)
-    REAL,  INTENT (INOUT) :: z(:,:)
-#else
-    COMPLEX, INTENT (INOUT)::a(:),b(:)
-    COMPLEX, INTENT (INOUT) :: z(:,:)
-#endif
-
-#else
 
 #ifdef CPP_INVERSION
     REAL, ALLOCATABLE, INTENT (INOUT) :: a(:),b(:)
@@ -70,7 +59,6 @@ CONTAINS
     COMPLEX, ALLOCATABLE, INTENT (INOUT) :: z(:,:)
 #endif
 
-#endif
 
 #ifdef CPP_INVERSION
     real locrec(atoms%nlotot,atoms%nlotot)
@@ -105,9 +93,7 @@ CONTAINS
 
 
     !      print*,"in zsymsecloc"
-#ifndef CPP_F90
     deallocate(z)
-#endif
 
     !******************************************
     ! l_zref=.false. => simply call eigensolver
@@ -115,10 +101,8 @@ CONTAINS
     if(.not.sym%l_zref)then
        call geneigprobl(dimension%nbasfcn, nsize,dimension%neigd,jij%l_j,a,b, z,eig,ne)
 
-#ifndef CPP_F90
        allocate(a(dimension%nbasfcn*(dimension%nbasfcn+1)/2))
        allocate(b(dimension%nbasfcn*(dimension%nbasfcn+1)/2))
-#endif
        return
        !******************************************
        ! l_zref=.true. => blockdiagonalize
@@ -461,9 +445,7 @@ CONTAINS
        !  z1 holds eigenvectors of even block.
        !  z2 holds eigenvectors of odd block.
        !********************************************************************
-#ifndef CPP_F90
        allocate(z(dimension%nbasfcn,dimension%neigd))
-#endif
        allocate(evensort(ne))
        etemp1(ne1+1)=99.9e9
        etemp2(ne2+1)=99.9e9
@@ -529,10 +511,8 @@ CONTAINS
           endif !evensort
        enddo !ii
 
-#ifndef CPP_F90
        allocate(a(dimension%nbasfcn*(dimension%nbasfcn+1)/2))
        allocate(b(dimension%nbasfcn*(dimension%nbasfcn+1)/2))
-#endif
     endif !sym%l_zref
 
     deallocate ( z1,z2,etemp1,etemp2,evensort )

eigen/eigen.F90

@@ -453,7 +453,7 @@ CONTAINS
           !--->         set up interstitial hamiltonian and overlap matrices
           !
           call timestart("Interstitial Hamiltonian&Overlap")
-          CALL hsint(noco,jij,stars, vpw(:,jsp),lapw,jsp, n_size,n_rank,kpts%bk(:,nk),cell,atoms, a,b)
+          CALL hsint(input,noco,jij,stars, vpw(:,jsp),lapw,jsp, n_size,n_rank,kpts%bk(:,nk),cell,atoms, a,b)
 
           call timestop("Interstitial Hamiltonian&Overlap")
           !

eigen/hsint.F90

@@ -6,7 +6,7 @@
 
 MODULE m_hsint
 CONTAINS
-  SUBROUTINE hsint(noco,jij,stars, vpw,lapw,jspin,&
+  SUBROUTINE hsint(input,noco,jij,stars, vpw,lapw,jspin,&
        n_size,n_rank,bkpt,cell,atoms,aa,bb)
     !*********************************************************************
     !     initializes and sets up the hamiltonian and overlap matrices