Statistiques
| Révision :

root / src / Write_path.f90 @ 1

Historique | Voir | Annoter | Télécharger (4,9 ko)

1 1 equemene
SUBROUTINE Write_path(Iopt)
2 1 equemene
3 1 equemene
  Use Path_module
4 1 equemene
  Use Io_module
5 1 equemene
6 1 equemene
  IMPLICIT NONE
7 1 equemene
8 1 equemene
  INTEGER(KINT), INTENT(IN) :: Iopt
9 1 equemene
10 1 equemene
  INTEGER(KINT) :: IGeom, Idx, Iat, I,J
11 1 equemene
  REAL(KREAL), ALLOCATABLE :: GeomTmpC(:), GeomTmp(:),GeomTmpC2(:,:)
12 1 equemene
  CHARACTER(SCHARS) :: Line
13 1 equemene
  CHARACTER(LCHARS) ::Title
14 1 equemene
  LOGICAL :: Debug
15 1 equemene
16 1 equemene
  INTERFACE
17 1 equemene
     function valid(string) result (isValid)
18 1 equemene
       CHARACTER(*), intent(in) :: string
19 1 equemene
       logical                  :: isValid
20 1 equemene
     END function VALID
21 1 equemene
  END INTERFACE
22 1 equemene
23 1 equemene
  debug=valid('write_path').OR.valid('writepath')
24 1 equemene
  if (debug) Call Header("Entering Write_PATH")
25 1 equemene
26 1 equemene
27 1 equemene
  ALLOCATE(GeomTmpC(3*Nat), GeomTmp(NCoord),GeomTmpC2(Nat,3))
28 1 equemene
29 1 equemene
  IF (IOpt.GE.0) THEN
30 1 equemene
     WRITE(Line,'(I5)') Iopt
31 1 equemene
  ELSE
32 1 equemene
     Line="Ini"
33 1 equemene
     Energies=0.
34 1 equemene
  END IF
35 1 equemene
  OPEN(IOTMP,File=Trim(PathName) // '.' // AdjustL(TRIM(Line)))
36 1 equemene
  IF ((COORD.EQ.'ZMAT').OR.(COORD.EQ.'MIXED').OR.(COORD.EQ.'BAKER')) &
37 1 equemene
       OPEN(IOCART,File=TRIM(PathName) // '_cart.' //  AdjustL(TRIM(Line)))
38 1 equemene
39 1 equemene
  DO IGeom=1,NGeomF
40 1 equemene
     WRITE(Title,"('Geometry ',I3,'/',I3,' for iteration ',I3,' E=',F13.6)") Igeom,NgeomF,Iopt,Energies(IGeom)
41 1 equemene
     SELECT CASE(Coord)
42 1 equemene
     CASE ('CART','HYBRID')
43 1 equemene
        ! XyzGeomF is 3,Nat... but Printgeom expects Nat,3...
44 1 equemene
        ! this should really be rewritten !!!!
45 1 equemene
        GeomTmp=Reshape(reshape(XyzGeomF(IGeom,:,:),(/Nat,3/),ORDER=(/2,1/)),(/3*Nat/))
46 1 equemene
     CASE ('ZMAT','MIXED','BAKER')
47 1 equemene
        GeomTmp=IntCoordF(IGeom,:)
48 1 equemene
     CASE DEFAULT
49 1 equemene
        WRITE(*,*) "Coord=",TRIM(Coord)," not recognized in Write_path. L34.STOP"
50 1 equemene
        STOP
51 1 equemene
     END SELECT
52 1 equemene
53 1 equemene
     ! Nothing for the baker case.
54 1 equemene
     Call PrintGeom(Title,Nat,NCoord,GeomTmp,Coord,IoTmp,Atome,Order,OrderInv,IndZmat)
55 1 equemene
56 1 equemene
     IF (COORD.EQ.'ZMAT') THEN
57 1 equemene
        ! Writing the Cartesian coordinates
58 1 equemene
        WRITE(IOCART,'(1X,I5)') Nat
59 1 equemene
        WRITE(IOCART,'(1X,A)') Title
60 1 equemene
        ! we have to generate the cartesian coordinates from the internal coordinates
61 1 equemene
        Call Int2Cart(nat,indzmat,GeomTmp,GeomTmpC)
62 1 equemene
        GeomTmpC2=reshape(GeomTmpC,(/Nat,3/))
63 1 equemene
        DO I=1,Nat
64 1 equemene
           IF (renum) THEN
65 1 equemene
              Iat=Order(I)
66 1 equemene
              !             WRITE(IOCART,'(1X,A10,3(1X,F15.8))') Trim(AtName(I)),GeomTmpC(3*Iat-2:3*Iat)
67 1 equemene
              WRITE(IOCART,'(1X,A10,3(1X,F15.8))') Trim(AtName(I)),GeomTmpC2(Iat,1:3)
68 1 equemene
           ELSE
69 1 equemene
              Iat=OrderInv(I)
70 1 equemene
              !            WRITE(IOCART,'(1X,A10,3(1X,F15.8),A)') Trim(AtName(Iat)),GeomTmpC(3*I-2:3*I)
71 1 equemene
              WRITE(IOCART,'(1X,A10,3(1X,F15.8),A)') Trim(AtName(Iat)),GeomTmpC2(I,1:3)
72 1 equemene
           END IF
73 1 equemene
        END DO
74 1 equemene
     END IF ! matches IF (COORD.EQ.'ZMAT') THEN
75 1 equemene
76 1 equemene
     IF (COORD.EQ.'BAKER') THEN
77 1 equemene
        ! Writing the Cartesian coordinates
78 1 equemene
        WRITE(IOCART,'(1X,I5)') Nat
79 1 equemene
        WRITE(IOCART,'(1X,A)') Title
80 1 equemene
        ! we have to generate the cartesian coordinates from the internal coordinates
81 1 equemene
        ! we can also print the cartesiann coordinates directly from XyzGeomF??
82 1 equemene
        !Call ConvertBakerInternal_cart(InCoordF(IGeom-1,:),InCoordF(IGeom,:))
83 1 equemene
        ! XyzGeomF(NGeomF,3,Nat), GeomTmpC(3*Nat),GeomTmpC2(Nat,3)
84 1 equemene
        !GeomTmpC2=reshape(GeomTmpC,(/Nat,3/)). XyzGeomF is already updated in
85 1 equemene
        ! EgradPath.f90
86 1 equemene
        DO I =1, 3
87 1 equemene
           GeomTmpC2(:,I)=XyzGeomF(IGeom,I,:)
88 1 equemene
        END DO
89 1 equemene
        DO I=1,Nat
90 1 equemene
           IF (renum) THEN
91 1 equemene
              Iat=Order(I)
92 1 equemene
              !             WRITE(IOCART,'(1X,A10,3(1X,F15.8))') Trim(AtName(I)),GeomTmpC(3*Iat-2:3*Iat)
93 1 equemene
              !Print *, GeomTmpC2(Iat,1:3)
94 1 equemene
              WRITE(IOCART,'(1X,A10,3(1X,F15.8))') Trim(AtName(I)),GeomTmpC2(Iat,1:3)
95 1 equemene
           ELSE
96 1 equemene
              Iat=OrderInv(I)
97 1 equemene
              !            WRITE(IOCART,'(1X,A10,3(1X,F15.8),A)') Trim(AtName(Iat)),GeomTmpC(3*I-2:3*I)
98 1 equemene
              WRITE(IOCART,'(1X,A10,3(1X,F15.8),A)') Trim(AtName(Iat)),GeomTmpC2(I,1:3)
99 1 equemene
           END IF
100 1 equemene
        END DO
101 1 equemene
     END IF ! matches IF (COORD.EQ.'BAKER') THEN
102 1 equemene
103 1 equemene
     IF (COORD.EQ.'MIXED') THEN
104 1 equemene
        ! Writing the Cartesian coordinates
105 1 equemene
        WRITE(IOCART,'(1X,I5)') Nat
106 1 equemene
        WRITE(IOCART,'(1X,A)') Title
107 1 equemene
        ! we have to generate the cartesian coordinates from the internal coordinates
108 1 equemene
        Call Mixed2Cart(nat,indzmat,geomtmp,GeomTmpC)
109 1 equemene
        GeomTmpC2=reshape(GeomTmpC,(/Nat,3/))
110 1 equemene
        DO I=1,Nat
111 1 equemene
           IF (renum) THEN
112 1 equemene
              Iat=Order(I)
113 1 equemene
              !             WRITE(IOCART,'(1X,A10,3(1X,F15.8))') Trim(AtName(I)),GeomTmpC(3*Iat-2:3*Iat)
114 1 equemene
              WRITE(IOCART,'(1X,A10,3(1X,F15.8))') Trim(AtName(I)),GeomTmpC2(Iat,1:3)
115 1 equemene
           ELSE
116 1 equemene
              Iat=OrderInv(I)
117 1 equemene
              !             WRITE(IOCART,'(1X,A10,3(1X,F15.8),A)') Trim(AtName(Iat)),GeomTmpC(3*I-2:3*I)
118 1 equemene
              WRITE(IOCART,'(1X,A10,3(1X,F15.8),A)') Trim(AtName(Iat)),GeomTmpC2(I,1:3)
119 1 equemene
           END IF
120 1 equemene
        END DO
121 1 equemene
     END IF ! matches IF (COORD.EQ.'MIXED') THEN
122 1 equemene
  END DO ! matches DO IGeom=1,NGeomF
123 1 equemene
  CLOSE(IOTMP)
124 1 equemene
  IF ((COORD.EQ.'ZMAT').OR.(COORD.EQ.'MIXED').OR.(COORD.EQ.'BAKER')) CLOSE(IOCART)
125 1 equemene
  DEALLOCATE(GeomTmpC,GeomTmp)
126 1 equemene
127 1 equemene
  if (debug) Call Header('Exiting Write_PATH')
128 1 equemene
END SUBROUTINE Write_path