cfnorm.f 2.89 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 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100
      SUBROUTINE cfnorm(mrad,is,it,nsol,nmatch,jtop,var,gc,fc,rc,rc2,
     +                  dx,gck,fck)
c...........................................................cfnorm
c wavefunctions normalization
c
      IMPLICIT NONE
c
C     .. Scalar Arguments ..
      INTEGER, INTENT (IN) :: mrad
      REAL dx
      INTEGER is,it,jtop,nmatch,nsol
C     ..
C     .. Array Arguments ..
      REAL fc(2,2,mrad),fck(2,2,mrad),gc(2,2,mrad),gck(2,2,mrad),
     +     rc(mrad),rc2(mrad),var(4)
C     ..
C     .. Local Scalars ..
      REAL xnorm
      INTEGER i,j,k,n
C     ..
C     .. Local Arrays ..
      REAL rint(mrad)
C     ..
C     .. External Functions ..
      REAL rsimp
      EXTERNAL rsimp
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC sqrt
C     ..
      DO n = 1,mrad
         DO k = 1,nsol
            gck(k,is,n) = 0.0
            fck(k,is,n) = 0.0
         END DO
      END DO
C                         ---------------------------------
C--->                     NORMALIZE WAVEFUNCTIONS ACCORDING
C                               TO MATCHING CONDITIONS
C                         ---------------------------------
C                                    INWARD - SOLUTION
      DO 30 n = nmatch,jtop
         DO 20 j = 1,nsol
            DO 10 i = 1,nsol
               gc(i,j,n) = gc(i,j,n)*var(2)
               fc(i,j,n) = fc(i,j,n)*var(2)
   10       CONTINUE
   20    CONTINUE
   30 CONTINUE
c
      IF (nsol.EQ.2) THEN
C                                   OUTWARD - SOLUTION
         DO 50 n = 1, (nmatch-1)
            DO 40 i = 1,nsol
               gc(i,it,n) = gc(i,it,n)*var(3)
               fc(i,it,n) = fc(i,it,n)*var(3)
   40       CONTINUE
   50    CONTINUE
C                                    INWARD - SOLUTION
         DO 70 n = nmatch,jtop
            DO 60 i = 1,nsol
               gc(i,it,n) = gc(i,it,n)*var(4)
               fc(i,it,n) = fc(i,it,n)*var(4)
   60       CONTINUE
   70    CONTINUE
      END IF
C                                    SUM FOR EACH KAPPA
      DO n = 1,jtop
         DO k = 1,nsol
            gck(k,is,n) = 0.00
            fck(k,is,n) = 0.00
         END DO
      END DO
      DO n = 1,jtop
         DO k = 1,nsol
            DO j = 1,nsol
               gck(k,is,n) = gck(k,is,n) + gc(k,j,n)
               fck(k,is,n) = fck(k,is,n) + fc(k,j,n)
            END DO
         END DO
      END DO
C                       -----------------------------------
C                       CALCULATE  NORM  AND NORMALIZE TO 1
C                       -----------------------------------
      DO n = 1,jtop
         rint(n) = 0.00
         DO k = 1,nsol
            rint(n) = rint(n) + rc2(n)* (gck(k,is,n)**2+fck(k,is,n)**2)
         END DO
      END DO
      xnorm = rsimp(mrad,rint,rc,jtop,dx)
      xnorm = 1.00/sqrt(xnorm)
      DO n = 1,jtop
         DO k = 1,nsol
            gck(k,is,n) = gck(k,is,n)*xnorm
            fck(k,is,n) = fck(k,is,n)*xnorm
         END DO
      END DO
      RETURN
      END