Statistiques
| Révision :

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