root / src / AnalyzeGeom.f90 @ 7
Historique  Voir  Annoter  Télécharger (2,64 ko)
1 
SUBROUTINE AnalyzeGeom(GeomCart,Values) 

2 
! This routines read a list of geometrical variables to monitor 
3 
! This is inspired from Xyz2Path (that was inspired by Xyz2scan ...) 
4  
5  
6 
use VarTypes 
7 
use Path_module 
8 
use Io_module 
9  
10 
IMPLICIT NONE 
11  
12  
13 
INTERFACE 
14 
function valid(string) result (isValid) 
15 
CHARACTER(*), intent(in) :: string 
16 
logical :: isValid 
17 
END function VALID 
18  
19 
SUBROUTINE die(routine, msg, file, line, unit) 
20  
21 
Use VarTypes 
22 
Use io_module 
23  
24 
implicit none 
25  
26 
character(len=*), intent(in) :: routine, msg 
27 
character(len=*), intent(in), optional :: file 
28 
integer(KINT), intent(in), optional :: line, unit 
29  
30 
END SUBROUTINE die 
31  
32  
33 
SUBROUTINE Calc_Xprim(nat,x,y,z,Coordinate,NPrim,XPrimitive,XPrimRef) 
34  
35 
Use VarTypes 
36 
Use Io_module 
37 
Use Path_module, only : pi 
38  
39 
IMPLICIT NONE 
40  
41 
Type (ListCoord), POINTER :: Coordinate 
42 
INTEGER(KINT), INTENT(IN) :: Nat,NPrim 
43 
REAL(KREAL), INTENT(IN) :: x(Nat), y(Nat), z(Nat) 
44 
REAL(KREAL), INTENT(IN), OPTIONAL :: XPrimRef(NPrim) 
45 
REAL(KREAL), INTENT(OUT) :: XPrimitive(NPrim) 
46  
47 
END SUBROUTINE CALC_XPRIM 
48  
49 
END INTERFACE 
50  
51 
! Input 
52 
REAL(KREAL),INTENT(IN) :: GeomCart(Nat,3) 
53 
REAL(KREAL), INTENT(OUT) :: Values(NbVar) 
54  
55 
LOGICAL :: Debug 
56 
INTEGER(KINT) :: I,J,K,NatT 
57 
REAL(KREAL), ALLOCATABLE :: GeoCartLoc(:,:) ! (Nat+NbCom,3) 
58 
REAL(KREAL), ALLOCATABLE :: x(:),y(:),z(:) ! Nat+NbCom 
59 
REAL(KREAL) :: COG(3),Weight 
60  
61  
62  
63 
Debug=Valid('AnaGeom') 
64  
65 
If (Debug) Call Header("Entering AnalyzeGeom") 
66  
67 
if (debug) THEN 
68 
WRITE(*,*) "AnalyzeGeom  GeomCart" 
69 
DO K=1,Nat 
70 
WRITE(*,'(1X,I5,3(1X,F15.8))') K,GeomCart(K,1:3) 
71 
END DO 
72 
END IF 
73  
74 
NAtt=Nat+NbCom 
75 
ALLOCATE(GeoCartLoc(Natt,3),x(Natt),y(Natt),z(Natt)) 
76 
GeoCartLoc(1:Nat,:)=GeomCart(:,:) 
77 
CurBary => Bary 
78  
79 
DO I=1, NbCom 
80 
COG=0. 
81 
Weight=0. 
82 
DO j=1,CurBary%ListAtoms(0) 
83 
DO k=1,3 
84 
COG(k)=COG(k)+GeomCart(CurBary%ListAtoms(j),k)*CurBary%Weights(j) 
85 
END DO 
86 
Weight=Weight+CurBary%Weights(j) 
87 
END DO 
88 
COG=COG/Weight 
89 
DO k=1,3 
90 
GeoCartLoc(Nat+i,k)=COG(k) 
91 
END DO 
92 
END DO 
93 

94 
Values=0. 
95  
96 
if (debug) THEN 
97 
WRITE(*,*) "AnalyzeGeom before Calc_Xprim  GeomCartLoc" 
98 
DO K=1,Nat+NbCom 
99 
WRITE(*,*) K,GeoCartLoc(K,1:3) 
100 
END DO 
101 
END IF 
102  
103 
x = GeoCartLoc(:,1) 
104 
y = GeoCartLoc(:,2) 
105 
z = GeoCartLoc(:,3) 
106  
107 
Call Calc_XPrim(Natt,x,y,z,GeomList,NbVar,Values) 
108  
109 
DeALLOCATE(GeoCartLoc,x,y,z) 
110  
111 
if (debug) THEN 
112 
WRITE(*,*) 'AnalyzeGeom: NbVar,Values',NbVar,Values 
113 
END IF 
114  
115 
If (Debug) Call Header("Exiting AnalizeGeom") 
116  
117 
END SUBROUTINE AnalyzeGeom 