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 |