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