Revision 5 src/Calc_mixed_frag.f90

Calc_mixed_frag.f90 (revision 5)
14 14

  
15 15
  IMPLICIT NONE
16 16

  
17
  CHARACTER(5) :: AtName
18
  integer(KINT) ::  na,atome(na),ind_zmat(Na,5)
17
! Parameters of the subroutine
18
! na: number of atoms in the system
19
  integer(KINT) ::  na
20
! atome: Mass number of the atoms of the system
21
  integer(KINT) ::  atome(na)
22
! ind_zmat: for "zmat" atoms contains the indices of reference atoms
23
  integer(KINT) ::  ind_zmat(Na,5)
19 24
  INTEGER(KINT) ::  idx_zmat(NA)
20 25
  real(KREAL) ::  x(Na),y(Na),z(Na),fact
21 26
  real(KREAL) ::  val_zmat(Na,3)
22 27
  real(KREAL) ::  r_cov(0:Max_Z)
23 28

  
29
  CHARACTER(5) :: AtName
30

  
24 31
  !     Frozen contains the indices of frozen atoms
25 32
  INTEGER(KINT) Frozen(*),Cart(*),NFroz,NCart
26 33
  LOGICAL, ALLOCATABLE :: FCart(:) ! Na
......
30 37
  INTEGER(KINT), ALLOCATABLE :: Fragment(:),NbAtFrag(:) !na
31 38
  INTEGER(KINT), ALLOCATABLE :: FragAt(:,:) !na,na
32 39
  INTEGER(KINT), ALLOCATABLE :: FrozFrag(:,:) !na,3
33
  !  INTEGER(KINT), ALLOCATABLE :: IdxFragAt(:) !na
34 40
  INTEGER(KINT), ALLOCATABLE :: FrozBlock(:,:) !(na,0:na)
35 41
  REAL(KREAL), ALLOCATABLE :: DistFroz(:) !na
36 42

  
......
47 53
  real(KREAL) ::  vx4,vy4,vz4,norm4
48 54
  real(KREAL) ::  vx5,vy5,vz5,norm5
49 55
  real(KREAL) ::  val, val_d, d
50
  Logical Debug
56
  Logical Debug,DebugGaussian
51 57
  LOGICAL, ALLOCATABLE :: DejaFait(:),FCaf(:) !(na)
52 58
  Logical, ALLOCATABLE ::  FrozAt(:)    !T if this atom is frozen
53 59

  
......
92 98

  
93 99
  Pi=dacos(-1.d0)
94 100
  debug=valid("calc_mixed_frag")
101
  debugGaussian=valid("zmat_gaussian")
102

  
95 103
  if (debug) Call Header("Entering Calc_mixed_frag")
96 104
  if (na.le.2) THEN
97 105
     WRITE(*,*) "I do not work for less than 2 atoms :-p"
......
987 995
  if (debug) WRITE(*,*) "Deallocate FCart,AtCart,FCaf"
988 996
  DEALLOCATE(FCart,AtCart,FCaf)
989 997

  
998
  if (debugGaussian) THEN
999
     WRITE(*,*) 'DBG Cre_Zmat_Frag: Gaussian Zmat - START'
1000
     Call WriteMixed_Gaussian(na,atome,NCart,ind_zmat,val_zmat)
1001
     WRITE(*,*) 'DBG Cre_Zmat_Frag: Gaussian Zmat - END'
1002
  END IF
1003

  
1004

  
990 1005
  if (debug) Call Header("Exiting Calc_mixed_frag")
991 1006

  
992 1007
END SUBROUTINE Calc_mixed_frag
993 1008

  
1009

  
1010
SUBROUTINE WriteMixed_Gaussian(na,atome,NCart,ind_zmat,val_zmat)
1011

  
1012
! This subroutine comes for zmat_g92
1013

  
1014
  Use Path_module, only : max_Z, NMaxL, Nom,MaxFroz, Pi
1015
  Use Io_module
1016

  
1017
  IMPLICIT NONE
1018
! Parameters of the subroutine
1019
! na: number of atoms in the system
1020
  integer(KINT), INTENT(IN) ::  na
1021
! atome: Mass number of the atoms of the system
1022
  integer(KINT), INTENT(IN) ::  atome(na)
1023
! nCart: number of atoms described in cartesian
1024
  integer(KINT), INTENT(IN) ::  NCart
1025
! ind_zmat: for "zmat" atoms contains the indices of reference atoms
1026
  integer(KINT), INTENT(IN) ::  ind_zmat(Na,5)
1027
! val_zmat: for "zmat" atoms contains the values from reference atoms
1028
  real(KREAL), INTENT(IN)   :: val_zmat(Na,3)
1029

  
1030
  character(6) :: at1, at2, at3, at4, d, a, dh
1031
  Character(6) :: x,y,z
1032
  character(SCHARS), ALLOCATABLE :: tab(:) ! 3*na
1033
  character(LCHARS) :: ligne
1034
  
1035
  INTEGER(KINT) :: i,n1,n2,n3,n4, NZmat,ITab
1036

  
1037
  ALLOCATE(tab(3*na))
1038

  
1039
! We first write the Cartesian atoms
1040

  
1041
  DO I=1,NCart
1042
! Name of the atom
1043
        n1=ind_zmat(i,1)
1044
        write(at1,11) nom(atome(n1)),n1
1045
        Call ecris_sb(at1,at1)
1046
! x
1047
        write(x,11) 'x',i
1048
        Call ecris_sb(x,x)
1049
        write(tab(3*i-2),'(A,1X,F12.8)') trim(x),val_zmat(i,1)
1050
! y
1051
        write(y,11) 'y',i
1052
        Call ecris_sb(y,y)
1053
        write(tab(3*i-1),'(A,1X,F12.8)') trim(y),val_zmat(i,2)
1054
! z
1055
        write(z,11) 'z',i
1056
        Call ecris_sb(z,z)
1057
        write(tab(3*i),'(A,1X,F12.8)') trim(z),val_zmat(i,3)
1058
! write the line
1059
           write(ligne,'(1X,A,1X,A,1X,A,1X,A)') Trim(at1),x,y,z
1060
        END DO
1061

  
1062
  NZmat=na-NCart
1063
  ITab=3*NCart+1
1064

  
1065
  DO i=NCart+1,NZmat
1066
     IF (i .GE. 1)  THEN
1067
        n1=ind_zmat(i,1)
1068
        write(at1,11) nom(atome(n1)),n1
1069
11      format(a2,i3)
1070
        Call ecris_sb(at1,at1)
1071
        write(ligne,4) at1
1072
     END IF
1073
     IF (i .GE. 2)  THEN
1074
        n2=ind_zmat(i,2)
1075
        write(at2,11) nom(atome(n2)),n2
1076
        Call ecris_sb(At2,at2)
1077
        write(d,11) 'R',i-1
1078
        Call ecris_sb(D,d)
1079
        write(ligne,4) at1,at2,d
1080
        write(tab(ITab),12) d,val_zmat(i,1)
1081
        ITab=ITab+1
1082
12      format(a8,f8.4)
1083
     END IF
1084
     IF (i .GE. 3)  THEN
1085
        n3=ind_zmat(i,3)
1086
        write(at3,11) nom(atome(n3)),n3
1087
        Call ecris_sb(At3,at3)
1088
        write(a,11) 'A',na+i-3
1089
        Call ecris_sb(A,A)
1090
        write(ligne,4) at1,at2,d,at3,a
1091
        write(tab(ITab),13) a,val_zmat(i,2)
1092
        ITab=ITab+1
1093
13      format(a8,f8.3)
1094
     END IF
1095
     IF (i .GE. 4)  THEN
1096
        n4=ind_zmat(i,4)
1097
        write(at4,11) nom(atome(n4)),n4
1098
        Call ecris_sb(At4,at4)
1099
        write(dh,11) 'DH',na+na+i-6
1100
        Call ecris_sb(dh,dh)
1101
        write(ligne,4) at1,at2,d,at3,a,at4,dh
1102
4       format(7a6)
1103
        write(tab(ITab),13) dh,val_zmat(i,3)
1104
        ITab=ITab+1
1105
     END IF
1106
     write(IOOUT,*) TRIM(ligne)
1107
     END DO
1108
     
1109
     write(IOOUT,*)
1110
     DO i=1,ITab
1111
        write(IOOUT,*) TRIM(tab(i))
1112
     END DO
1113
     write(IOOUT,*)
1114

  
1115
     DEALLOCATE(Tab)
1116

  
1117
   END SUBROUTINE WriteMixed_Gaussian

Also available in: Unified diff