Line data    Source code

       1             :       MODULE m_cnodes
       2             :       use m_juDFT
       3             : c...........................................................cnodes
       4             : c number of nodes
       5             : c
       6             :       CONTAINS
       7          36 :       SUBROUTINE cnodes(mrad,iflag,is,ec,l,xmj,nqn,vv,bb,rc,dx,
       8          36 :      +                  nmatch,nzero,gc,fc,pow,qow,piw,qiw,node)
       9             : c
      10             :       USE m_coredir
      11             :       IMPLICIT NONE
      12             : C     ..
      13             : C     .. Scalar Arguments ..
      14             :       INTEGER, INTENT (IN) :: mrad
      15             :       REAL dx,ec,xmj
      16             :       INTEGER iflag,is,l,nmatch,node,nqn,nzero
      17             : C     ..
      18             : C     .. Array Arguments ..
      19             :       REAL bb(mrad),fc(2,2,mrad),gc(2,2,mrad),piw(2,2),pow(2,2),
      20             :      +     qiw(2,2),qow(2,2),rc(mrad),vv(mrad)
      21             : C     ..
      22             : C     .. Local Scalars ..
      23             :       INTEGER n
      24             : C     ..
      25             : c                    - outward solution -
      26             :       CALL coredir(mrad,ec,l,xmj,1,vv,bb,rc,dx,nmatch,nzero,
      27          36 :      +             gc,fc,pow,qow,piw,qiw)
      28             : 
      29          36 :       node = 0
      30       17748 :       DO 10 n = 2,nmatch
      31       17712 :          IF (gc(is,is,n)*gc(is,is,n-1).LT.0.0) node = node + 1
      32          36 :    10 CONTINUE
      33          36 :       IF (node.EQ. (nqn-l-1)) THEN
      34          36 :          IF ((gc(is,is,nmatch)/gc(is,is,nmatch-1).LE.0.0) .OR.
      35             :      +       (gc(is,is,nmatch)/gc(is,is,nmatch-1).GE.1.0)) THEN
      36           0 :             ec = 0.9*ec
      37           0 :             iflag = 1
      38             : !            write(*,*) '=',nmatch,is,node,ec
      39             : !            DO l = 1,nzero
      40             : !             write(*,*) l,gc(is,is,l)
      41             : !            ENDDO
      42             : !            stop
      43           0 :             IF (ec > -0.00000001) CALL juDFT_error("cnodes:1",calledby
      44           0 :      +           ="cnodes")
      45             :             GO TO 20
      46             :          END IF
      47             :       ELSE
      48           0 :          IF (node.GT. (nqn-l-1)) THEN
      49           0 :             ec = 1.2*ec
      50           0 :             write(*,*) '>',node,ec
      51             :          ELSE
      52           0 :             ec = 0.8*ec
      53           0 :             write(*,*) '<',node,ec
      54             :          END IF
      55           0 :          iflag = 1
      56           0 :          GO TO 20
      57             :       END IF
      58             : c                    - inward solution -
      59             :       CALL coredir(mrad,ec,l,xmj,2,vv,bb,rc,dx,nmatch,nzero,
      60          36 :      +             gc,fc,pow,qow,piw,qiw)
      61             :    20 CONTINUE
      62             : 
      63          36 :       END SUBROUTINE cnodes
      64             :       END MODULE m_cnodes