convn.f90 2.59 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82
      MODULE m_convn
      use m_juDFT
      CONTAINS
      SUBROUTINE convn(&
     &                 dimension,atoms,stars)
!
!     ***********************************************************
!     determines the optimum values for the convergence parameter
!     for each atom type using the criterion discussed in
!     m. weinert, j. math. phys. 22, 2433 (1981).  each sphere
!     and l component may have different values.  (psqpw changed
!     to allow this option).
!          m. weinert july 1982
!     ***********************************************************
      USE m_types
      IMPLICIT NONE
!     ..
      TYPE(t_dimension),INTENT(IN) :: dimension
      TYPE(t_atoms),INTENT(INOUT)  :: atoms
      TYPE(t_stars),INTENT(IN)     :: stars
!     .. Local Scalars ..
      REAL sck,z0
      INTEGER i,l,n,n1,nc
!     ..
!     .. Local Arrays ..
      REAL z(17)
!     ..
!     .. Intrinsic Functions ..
      INTRINSIC min0
!     ..
!     .. Data statements ..
      DATA z/6.9e0,8.1e0,9.3e0,10.5e0,11.6e0,12.7e0,13.9e0,15.0e0,&
     &     16.1e0,17.2e0,18.3e0,19.4e0,20.5e0,21.6e0,22.7e0,23.7e0,&
     &     24.8e0/,z0/5.7e0/
!     ..
!--->    read in values of ncv (if ncv(1).le.0, calculate best values)
!      read(5,1000) (ncv(n),n=1,ntype)
!      if(ncv(1).le.0) go to 2
!      n1=ncv(1)
!      do 1 n=2,ntype
!    1 if(ncv(n).le.0) ncv(n)=n1
!      go to 5
!--->    calculate values
!    2 continue
!
      DO 20 n = 1,atoms%ntype
         sck = stars%gmax*atoms%rmt(n)
         IF (sck.LT.z0) GO TO 60
         DO 10 i = 1,17
            IF (sck.GT.z(i)) GO TO 10
            atoms%ncv(n) = i
            GO TO 20
   10    CONTINUE
         n1 = 0.9e0* (sck-z(17))
         atoms%ncv(n) = 18 + n1
   20 CONTINUE
!--->    output and make sure ncv(n).le.ncvd
   30 CONTINUE
      WRITE (6,FMT=8010)
      DO 40 n = 1,atoms%ntype
         nc = atoms%ncv(n)
         l = nc - 1
         WRITE (6,FMT=8020) n,nc,l
   40 CONTINUE
      l = dimension%ncvd - 1
      WRITE (6,FMT=8030) dimension%ncvd,l
      DO 50 n = 1,atoms%ntype
         atoms%ncv(n) = min0(atoms%ncv(n),dimension%ncvd)
   50 CONTINUE
      RETURN
   60 WRITE (6,FMT=8040) n,sck
       CALL juDFT_error("ncv",calledby="convn")
 8000 FORMAT (10i5)
 8010 FORMAT (/,/,10x,'convergence parameters for the pseudocharge',&
     &       ' density expansion',/,10x,'atom',5x,'parameter',5x,&
     &       'max. l to include',/)
 8020 FORMAT (10x,i3,9x,i3,13x,i3)
 8030 FORMAT (10x,'max values allowed: ncvd=',i3,', l=',i3,/)
 8040 FORMAT (/,/,10x,'atom type',i3,' has rkmax=',f6.4,/,10x,&
     &       '$$$ stop ncv error')
      END SUBROUTINE convn
      END MODULE m_convn