root / src / TestCart.f90 @ 2
Historique | Voir | Annoter | Télécharger (2,22 ko)
1 | 1 | equemene | SUBROUTINE TestCart(SetCart) |
---|---|---|---|
2 | 1 | equemene | |
3 | 1 | equemene | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
4 | 1 | equemene | ! |
5 | 1 | equemene | ! This subroutines looks at the displacements for atoms between |
6 | 1 | equemene | ! images. If the total displacement is less than the atomic radius |
7 | 1 | equemene | ! then it might be a good idea to treat this atom as CART. |
8 | 1 | equemene | ! |
9 | 1 | equemene | ! Input: |
10 | 1 | equemene | ! SetCart : if True then Cart list is set by TestCart |
11 | 1 | equemene | ! (Normal use : call TestCart with AutoCart as the argument) |
12 | 1 | equemene | ! |
13 | 1 | equemene | ! Output: |
14 | 1 | equemene | ! None |
15 | 1 | equemene | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
16 | 1 | equemene | |
17 | 1 | equemene | Use Path_module |
18 | 1 | equemene | Use Io_module |
19 | 1 | equemene | |
20 | 1 | equemene | IMPLICIT NONE |
21 | 1 | equemene | |
22 | 1 | equemene | |
23 | 1 | equemene | LOGICAL, INTENT(IN) :: SetCart |
24 | 1 | equemene | |
25 | 1 | equemene | INTEGER(KINT) :: IGeom, I,J,K,Iat |
26 | 1 | equemene | CHARACTER(SCHARS) :: Line,Line2 |
27 | 1 | equemene | |
28 | 1 | equemene | REAL(KREAL) :: d |
29 | 1 | equemene | LOGICAL, ALLOCATABLE :: TobeCart(:) ! Nat |
30 | 1 | equemene | LOGICAL :: Debug |
31 | 1 | equemene | |
32 | 1 | equemene | INTERFACE |
33 | 1 | equemene | function valid(string) result (isValid) |
34 | 1 | equemene | CHARACTER(*), intent(in) :: string |
35 | 1 | equemene | logical :: isValid |
36 | 1 | equemene | END function VALID |
37 | 1 | equemene | END INTERFACE |
38 | 1 | equemene | |
39 | 1 | equemene | debug=valid('testcart') |
40 | 1 | equemene | if (debug) WRITE(*,*) "========================= Entering TestCart ===========" |
41 | 1 | equemene | |
42 | 1 | equemene | ALLOCATE(TobeCart(Nat)) |
43 | 1 | equemene | |
44 | 1 | equemene | ToBeCart=.TRUE. |
45 | 1 | equemene | |
46 | 1 | equemene | ! We put first geometry as the reference |
47 | 1 | equemene | DO I=1,NGeomI |
48 | 1 | equemene | DO J=I+1,NGeomI |
49 | 1 | equemene | DO K=1,Nat |
50 | 1 | equemene | IF (ToBeCart(K)) THEN |
51 | 1 | equemene | Iat=Atome(K) |
52 | 1 | equemene | d=100.*sqrt((XyzGeomI(J,1,K)-XyzGeomI(I,1,K))**2+ & |
53 | 1 | equemene | (XyzGeomI(J,2,K)-XyzGeomI(I,2,K))**2+ & |
54 | 1 | equemene | (XyzGeomI(J,3,K)-XyzGeomI(I,3,K))**2) |
55 | 1 | equemene | if (debug) WRITe(*,'(4(1X,I5),10(1X,F12.8))') k,i,j,iat,d,r_cov(iat),r_cov(iat)*fact,d/r_cov(iat) |
56 | 1 | equemene | if ((d/r_cov(iat)).GE.0.5d0) ToBeCart(K)=.FALSE. |
57 | 1 | equemene | END IF |
58 | 1 | equemene | END DO |
59 | 1 | equemene | END DO |
60 | 1 | equemene | END DO |
61 | 1 | equemene | |
62 | 1 | equemene | If (Debug) THEN |
63 | 1 | equemene | WRITE(*,*) "Atoms that might be described in CART" |
64 | 1 | equemene | DO K=1,Nat |
65 | 1 | equemene | IF (ToBeCart(K)) WRITE(*,'(I5)',ADVANCE="NO") K |
66 | 1 | equemene | END DO |
67 | 1 | equemene | END IF |
68 | 1 | equemene | |
69 | 1 | equemene | IF (SetCart) THEN |
70 | 1 | equemene | WRITE(*,*) "AutoCART=T: Atoms that will be described in CART" |
71 | 1 | equemene | K=1 |
72 | 1 | equemene | DO I=1,Nat |
73 | 1 | equemene | If(ToBeCart(I)) THEN |
74 | 1 | equemene | Cart(K)=I |
75 | 1 | equemene | K=K+1 |
76 | 1 | equemene | WRITE(*,'(I5)',ADVANCE="NO") I |
77 | 1 | equemene | END IF |
78 | 1 | equemene | END DO |
79 | 1 | equemene | Cart(K)=0 |
80 | 1 | equemene | Ncart=K-1 |
81 | 1 | equemene | END IF |
82 | 1 | equemene | |
83 | 1 | equemene | deallocate(tobecart) |
84 | 1 | equemene | |
85 | 1 | equemene | if (debug) WRITE(*,*) "========================= Exiting TestCart ===========" |
86 | 1 | equemene | END SUBROUTINE TestCart |
87 | 1 | equemene | |
88 | 1 | equemene | |
89 | 1 | equemene | |
90 | 1 | equemene | |
91 | 1 | equemene |