Statistiques
| Révision :

root / src / CalcBMat_int.f90 @ 2

Historique | Voir | Annoter | Télécharger (2,76 ko)

1 2 pfleura2
subroutine CalcBmat_int(natoms, xyzatm, indzmat, dzdc)
2 1 pfleura2
3 1 pfleura2
  use Io_module
4 2 pfleura2
  use Path_module, only : MW,Pi, atome
5 1 pfleura2
6 1 pfleura2
  IMPLICIT NONE
7 1 pfleura2
8 1 pfleura2
9 2 pfleura2
  integer(KINT), INTENT(IN) :: natoms, indzmat(natoms,5)
10 2 pfleura2
  real(KREAL), INTENT(IN)   :: xyzatm(3,natoms)
11 2 pfleura2
  real(KREAL), INTENT(OUT)   :: dzdc(3*natoms,3*natoms)
12 1 pfleura2
13 1 pfleura2
14 1 pfleura2
!!!!!!!!!!!!!!!!!!!!!
15 1 pfleura2
!
16 1 pfleura2
! This routine computes the derivatives of the internal coordinates
17 1 pfleura2
! with respect to the cartesian coordinates.
18 1 pfleura2
! This is what is called the B matrix in Baker coordinates :
19 1 pfleura2
! B(i,j)=dz_i/dx_j
20 1 pfleura2
!
21 1 pfleura2
! it uses the same routines as Calc_baker
22 1 pfleura2
!
23 1 pfleura2
!!!!!!!!!!!!!!!!!!!!!!
24 1 pfleura2
!
25 1 pfleura2
! Input:
26 1 pfleura2
! natoms: number of atoms
27 1 pfleura2
! xyzatm(3,natoms): cartesian geometry
28 1 pfleura2
! indzmat(natoms,5): index of the Z-matrix definition
29 1 pfleura2
! atmass(natoms): mass of the atoms
30 1 pfleura2
! atome(natoms): ??
31 1 pfleura2
!
32 1 pfleura2
! Output:
33 1 pfleura2
! dzdc(3*natoms,3*natoms): B matrix
34 1 pfleura2
!
35 1 pfleura2
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
36 1 pfleura2
37 1 pfleura2
38 1 pfleura2
  INTERFACE
39 1 pfleura2
     function valid(string) result (isValid)
40 1 pfleura2
       CHARACTER(*), intent(in) :: string
41 1 pfleura2
       logical                  :: isValid
42 1 pfleura2
     END function VALID
43 1 pfleura2
  END INTERFACE
44 1 pfleura2
45 1 pfleura2
  LOGICAL :: debug
46 1 pfleura2
  INTEGER(KINT) :: i,j,k,iat
47 1 pfleura2
  INTEGER(KINT) :: iat1, iat2, iat3, iat4
48 1 pfleura2
49 1 pfleura2
50 1 pfleura2
  ! ======================================================================
51 1 pfleura2
52 1 pfleura2
53 1 pfleura2
  debug=valid('CalcBmat_int').OR.valid('CalcBMat')
54 1 pfleura2
  if (debug) Call Header('Entering CalcBmat_int')
55 1 pfleura2
56 1 pfleura2
  if (debug) THEN
57 1 pfleura2
     WRITE(*,*) 'DBG CALCBMAT_INT Xyzatm '
58 1 pfleura2
     DO iat=1,natoms
59 1 pfleura2
        write(*,'(1X,I5,3(1X,F15.6))') atome(iat), xyzatm(1:3,iat)
60 1 pfleura2
     END DO
61 1 pfleura2
     WRITE(*,*) 'DBG CALCBMAT_INT IndZmat'
62 1 pfleura2
     DO iat=1,natoms
63 1 pfleura2
        write(*,'(6(1X,I5))') iat, indzmat(iat,1:4)
64 1 pfleura2
     END DO
65 1 pfleura2
  END IF
66 1 pfleura2
67 1 pfleura2
  dzdc=0.d0
68 1 pfleura2
  if (natoms.ge.2) THEN
69 1 pfleura2
     iat1=indzmat(2,1)
70 1 pfleura2
     iat2=indzmat(2,2)
71 1 pfleura2
     Call CONSTRAINTS_BONDLENGTH_DER(Natoms,iat1,iAT2, xyzatm, dzdc(1,4))
72 1 pfleura2
   END IF
73 1 pfleura2
  if (natoms.ge.3) THEN
74 1 pfleura2
     iat1=indzmat(3,1)
75 1 pfleura2
     iat2=indzmat(3,2)
76 1 pfleura2
     iat3=indzmat(3,3)
77 1 pfleura2
     Call CONSTRAINTS_BONDLENGTH_DER(Natoms,iat1,iAT2, xyzatm, dzdc(1,7))
78 1 pfleura2
     CALL CONSTRAINTS_BONDANGLE_DER(Natoms,iAt1,iAT2,iAt3, xyzatm, dzdc(1,8))
79 1 pfleura2
  END IF
80 1 pfleura2
  k=10
81 1 pfleura2
  DO I=4, Natoms
82 1 pfleura2
     iat1=indzmat(i,1)
83 1 pfleura2
     iat2=indzmat(i,2)
84 1 pfleura2
     iat3=indzmat(i,3)
85 1 pfleura2
     iat4=indzmat(i,4)
86 1 pfleura2
     Call CONSTRAINTS_BONDLENGTH_DER(Natoms,iat1,iAT2, xyzatm, dzdc(1,k))
87 1 pfleura2
     k=k+1
88 1 pfleura2
     CALL CONSTRAINTS_BONDANGLE_DER(Natoms,iAt1,iAT2,iAt3, xyzatm, dzdc(1,k))
89 1 pfleura2
     k=k+1
90 1 pfleura2
     CALL CONSTRAINTS_TORSION_DER2(Natoms,iat1,iat2,iat3,iat4, xyzatm, dzdc(1,k))
91 1 pfleura2
     k=k+1
92 1 pfleura2
  END DO
93 1 pfleura2
94 1 pfleura2
95 1 pfleura2
  if (debug) THEN
96 1 pfleura2
     WRITE(*,*) 'DBG CALCBMAT_INT dzdc '
97 1 pfleura2
     k=min(3*natoms,12)
98 1 pfleura2
     DO iat=1,natoms
99 1 pfleura2
        DO j=1,3
100 1 pfleura2
           write(*,'(1X,I5,12(1X,F12.6))') 3*iat-3+j, dzdc(1:k,3*iat-3+j)
101 1 pfleura2
        END DO
102 1 pfleura2
     END DO
103 1 pfleura2
  END IF
104 1 pfleura2
105 1 pfleura2
  if (debug) Call Header('CalcBmat_int Over')
106 1 pfleura2
  ! ======================================================================
107 1 pfleura2
108 1 pfleura2
end subroutine CalcBmat_int