Statistics
| Revision:

root / src / CalcDist_cart.f90 @ 7

History | View | Annotate | Download (12.3 kB)

1 1 pfleura2
SUBROUTINE CalcDist_cart(iopt,s,dist,x0,y0,z0,xgeom,Coef)
2 1 pfleura2
3 1 pfleura2
! This subroutine computes the curvilinear distance of the images on the path
4 1 pfleura2
! It is adapted from Extrapol_cart
5 1 pfleura2
6 1 pfleura2
  use Path_module
7 1 pfleura2
  use Io_module
8 1 pfleura2
9 1 pfleura2
10 1 pfleura2
  IMPLICIT NONE
11 1 pfleura2
12 1 pfleura2
13 1 pfleura2
  REAL(KREAL), INTENT(OUT) :: s
14 1 pfleura2
  ! X0(Nat),Y0(Nat),Z0(Nat): reference geometry.
15 1 pfleura2
  REAL(KREAL), INTENT(IN) :: dist,X0(Nat),Y0(Nat),Z0(Nat)
16 1 pfleura2
  REAL(KREAL), INTENT(IN) :: Xgeom(NGeomI),Coef(NGeomI,NCoord)
17 1 pfleura2
! Iopt: Number of the cycles for the optimization
18 1 pfleura2
  INTEGER(KINT), INTENT(IN) :: Iopt
19 1 pfleura2
  INTEGER(KINT) :: IdxGeom, I, J, K, Idx,Iat, IGeom
20 1 pfleura2
! NSpline is the number of points along the interpolating path
21 1 pfleura2
  INTEGER(KINT) :: NSpline
22 1 pfleura2
! FileSpline: Filename to save the interpolating path coordinates
23 1 pfleura2
  CHARACTER(LCHARS) :: FileSpline,TmpChar
24 1 pfleura2
  REAL(KREAL) :: Rmsd,MRot(3,3), ds, u, v
25 1 pfleura2
  REAL(KREAL) :: a_val, d
26 1 pfleura2
27 1 pfleura2
  REAL(KREAL), ALLOCATABLE :: XyzTmp(:,:), XyzTmp2(:,:) ! (Nat,3)
28 1 pfleura2
  REAL(KREAL), ALLOCATABLE :: DerXyz(:,:) ! Nat,3
29 1 pfleura2
30 1 pfleura2
31 1 pfleura2
  LOGICAL ::  debug, print, printspline
32 1 pfleura2
  LOGICAL, EXTERNAL :: valid
33 1 pfleura2
34 1 pfleura2
  !We will calculate the length of the path, in MW coordinates...
35 1 pfleura2
  ! this is done is a stupid way: we interpolate the zmatrix values,
36 1 pfleura2
  ! convert them into cartesian, weight the cartesian
37 1 pfleura2
  ! and calculate the evolution of the distance !
38 1 pfleura2
  ! We have to follow the same procedure for every geometry
39 1 pfleura2
  ! so even for the first one, we have to convert it from zmat
40 1 pfleura2
  ! to cartesian !
41 1 pfleura2
42 1 pfleura2
  debug=valid("pathcreate")
43 1 pfleura2
  print=valid("printgeom")
44 1 pfleura2
45 1 pfleura2
  printspline=(valid("printspline").AND.(dist<=1e30))
46 1 pfleura2
47 1 pfleura2
  if (debug) Call Header("Entering CalcDist_cart")
48 1 pfleura2
49 1 pfleura2
! We want 100 points along the interpolating path
50 1 pfleura2
  NSpline=int(NMaxPtPath/100)
51 1 pfleura2
52 1 pfleura2
  if (printspline) THEN
53 1 pfleura2
     WRITE(TmpChar,'(I5)') Iopt
54 1 pfleura2
     FileSpline=Trim(adjustL(PathName)) // '_spline.' // AdjustL(TRIM(TmpChar))
55 1 pfleura2
     OPEN(IOTMP,FILE=FileSpline)
56 1 pfleura2
57 1 pfleura2
  END IF
58 1 pfleura2
59 1 pfleura2
60 1 pfleura2
  ALLOCATE(XyzTmp(Nat,3),XyzTmp2(Nat,3),DerXyz(Nat,3))
61 1 pfleura2
62 1 pfleura2
!  XyzTmp2=Reshape(XyzGeomI(1,:,:),(/Nat,3/),ORDER=(/2,1/))
63 1 pfleura2
64 1 pfleura2
  if (debug) THEN
65 1 pfleura2
     WRITE(*,*) "DBG Extrapol_cart Initial geometries"
66 1 pfleura2
     DO IGeom=1,NGeomI
67 1 pfleura2
        WRITE(*,*) 'XyzGeomI, IGeom=',IGeom
68 1 pfleura2
        DO I=1,Nat
69 1 pfleura2
           WRITE(IOOUT,'(1X,A2,3(1X,F15.6))') Nom(Atome(I)),      &
70 1 pfleura2
                (XyzGeomI(IGeom,J,I),J=1,3)
71 1 pfleura2
        END DO
72 1 pfleura2
     END DO
73 1 pfleura2
  END IF
74 1 pfleura2
75 1 pfleura2
76 1 pfleura2
! In order to mesure only the relevant distance between two points
77 1 pfleura2
! we align all geometries on the original one
78 1 pfleura2
79 1 pfleura2
   DO IGeom=1,NGeomI
80 1 pfleura2
81 1 pfleura2
      XyzTmp2=Reshape(XyzGeomI(IGeom,:,:),(/Nat,3/),ORDER=(/2,1/))
82 1 pfleura2
  ! We align this geometry with the original one
83 1 pfleura2
  ! PFL 17/July/2006: only if we have more than 4 atoms.
84 1 pfleura2
!  IF (Nat.GT.4) THEN
85 1 pfleura2
! PFL 24 Nov 2008 ->
86 1 pfleura2
! If we have frozen atoms we align only those ones.
87 1 pfleura2
! PFL 8 Feb 2011 ->
88 1 pfleura2
! I add a flag to see if we should align or not.
89 1 pfleura2
! For small systems, it might be better to let the user align himself
90 1 pfleura2
      IF (Align) THEN
91 1 pfleura2
         if (NFroz.GT.0) THEN
92 1 pfleura2
            Call AlignPartial(Nat,x0,y0,z0,                     &
93 1 pfleura2
                 xyzTmp2(1,1),xyzTmp2(1,2),xyzTMP2(1,3),       &
94 1 pfleura2
                 FrozAtoms,MRot)
95 1 pfleura2
         ELSE
96 1 pfleura2
            Call  CalcRmsd(Nat, x0,y0,z0,                              &
97 1 pfleura2
                 xyzTmp2(1,1),xyzTmp2(1,2),xyzTMP2(1,3),       &
98 1 pfleura2
                 MRot,rmsd,.TRUE.,.TRUE.)
99 1 pfleura2
         END IF
100 1 pfleura2
! <- PFL 24 Nov 2008
101 1 pfleura2
      END IF
102 1 pfleura2
! -> PFL 8 Feb 2011
103 1 pfleura2
!  END IF
104 1 pfleura2
105 1 pfleura2
  XyzGeomI(IGeom,:,:)=Reshape(XyzTmp2(:,:),(/3,Nat/),ORDER=(/2,1/))
106 1 pfleura2
 END DO
107 1 pfleura2
108 1 pfleura2
   if (print) THEN
109 1 pfleura2
      WRITE(*,*) "Aligned geometries"
110 1 pfleura2
      DO J=1, NGeomI
111 1 pfleura2
         WRITE(IOOUT,*) Nat
112 1 pfleura2
         WRITE(IOOUT,*) " Aligned geometry ",J,"/",NGeomI
113 1 pfleura2
           DO i=1,Nat
114 1 pfleura2
              WRITE(IOOUT,'(1X,A2,3(1X,F15.6))') Nom(Atome(I)),    &
115 1 pfleura2
                   XyzGeomI(J,1:3,I)
116 1 pfleura2
           END DO
117 1 pfleura2
        END DO
118 1 pfleura2
     END IF
119 1 pfleura2
120 1 pfleura2
  XyzGeomF(1,:,:)=XyzGeomI(1,:,:)
121 1 pfleura2
122 1 pfleura2
123 1 pfleura2
  ! We initialize the first geometry
124 1 pfleura2
125 1 pfleura2
  XyzTmp=Reshape(XyzGeomI(1,:,:),(/Nat,3/),ORDER=(/2,1/))
126 1 pfleura2
127 1 pfleura2
  ! We align this geometry with the original one
128 1 pfleura2
  ! PFL 17/July/2006: only if we have more than 4 atoms.
129 1 pfleura2
!  IF (Nat.GT.4) THEN
130 1 pfleura2
! PFL 24 Nov 2008 ->
131 1 pfleura2
! If we have frozen atoms we align only those ones.
132 1 pfleura2
! PFL 8 Feb 2011 ->
133 1 pfleura2
! I add a flag to see if we should align or not.
134 1 pfleura2
! For small systems, it might be better to let the user align himself
135 1 pfleura2
      IF (Align) THEN
136 1 pfleura2
         if (NFroz.GT.0) THEN
137 1 pfleura2
            Call AlignPartial(Nat,x0,y0,z0,                     &
138 1 pfleura2
                 xyzTmp(1,1),xyzTmp(1,2),xyzTMP(1,3),       &
139 1 pfleura2
                 FrozAtoms,MRot)
140 1 pfleura2
         ELSE
141 1 pfleura2
            Call  CalcRmsd(Nat, x0,y0,z0,                              &
142 1 pfleura2
                 xyzTmp(1,1),xyzTmp(1,2),xyzTMP(1,3),       &
143 1 pfleura2
                 MRot,rmsd,.TRUE.,.TRUE.)
144 1 pfleura2
         END IF
145 1 pfleura2
! <- PFL 24 Nov 2008
146 1 pfleura2
      END IF
147 1 pfleura2
! -> PFL 8 Feb 2011
148 1 pfleura2
!  END IF
149 1 pfleura2
150 1 pfleura2
151 1 pfleura2
152 1 pfleura2
  s=0.d0
153 1 pfleura2
  SGeom(1)=0.d0
154 1 pfleura2
155 1 pfleura2
  if (printspline) THEN
156 1 pfleura2
     u=0.d0
157 1 pfleura2
     DO Iat=1,Nat
158 1 pfleura2
        ! We generate the interpolated coordinates
159 1 pfleura2
        if (Linear) THEN
160 1 pfleura2
           call LinearInt(u,XyzTmp2(Iat,1),DerXyz(Iat,1),NGeomI,xgeom(1),XyzGeomI(1,1,Iat))
161 1 pfleura2
           call LinearInt(u,XyzTmp2(Iat,2),DerXyz(Iat,2),NGeomI,xgeom(1),XyzGeomI(1,2,Iat))
162 1 pfleura2
           call LinearInt(u,XyzTmp2(Iat,3),DerXyz(Iat,3),NGeomI,xgeom(1),XyzGeomI(1,3,Iat))
163 1 pfleura2
164 1 pfleura2
        ELSE
165 1 pfleura2
           call splintder(u,XyzTmp2(Iat,1),DerXyz(Iat,1),NGeomI,xgeom(1),XyzGeomI(1,1,Iat),Coef(1,3*Iat-2))
166 1 pfleura2
           call splintder(u,XyzTmp2(Iat,2),DerXyz(Iat,2),NGeomI,xgeom(1),XyzGeomI(1,2,Iat),Coef(1,3*Iat-1))
167 1 pfleura2
           call splintder(u,XyzTmp2(Iat,3),DerXyz(Iat,3),NGeomI,xgeom(1),XyzGeomI(1,3,Iat),Coef(1,3*Iat))
168 1 pfleura2
        END IF
169 1 pfleura2
     END DO
170 1 pfleura2
171 1 pfleura2
     WRITE(IOTMP,*) Nat
172 1 pfleura2
     WRITE(IOTMP,'(1X,A,1X,F15.6)') "Debug Spline - Coord=Cart,s=",s
173 1 pfleura2
     DO Iat=1,Nat
174 1 pfleura2
        WRITE(IOTMP,'(1X,A2,3(1X,F15.6))') Nom(Atome(Iat)),    &
175 1 pfleura2
                   (XyzTmp2(Iat,1:3))
176 1 pfleura2
     END DO
177 1 pfleura2
  END IF
178 1 pfleura2
179 1 pfleura2
 IdxGeom=1
180 1 pfleura2
181 1 pfleura2
  DO K=1,NMaxPtPath
182 1 pfleura2
     u=real(K)/NMaxPtPath*(NGeomI-1.)
183 1 pfleura2
184 1 pfleura2
     DO Iat=1,Nat
185 1 pfleura2
        ! We generate the interpolated coordinates
186 1 pfleura2
        if (Linear) THEN
187 1 pfleura2
           call LinearInt(u,XyzTmp2(Iat,1),DerXyz(Iat,1),NGeomI,xgeom(1),XyzGeomI(1,1,Iat))
188 1 pfleura2
           call LinearInt(u,XyzTmp2(Iat,2),DerXyz(Iat,2),NGeomI,xgeom(1),XyzGeomI(1,2,Iat))
189 1 pfleura2
           call LinearInt(u,XyzTmp2(Iat,3),DerXyz(Iat,3),NGeomI,xgeom(1),XyzGeomI(1,3,Iat))
190 1 pfleura2
191 1 pfleura2
        ELSE
192 1 pfleura2
           call splintder(u,XyzTmp2(Iat,1),DerXyz(Iat,1),NGeomI,xgeom(1),XyzGeomI(1,1,Iat),Coef(1,3*Iat-2))
193 1 pfleura2
           call splintder(u,XyzTmp2(Iat,2),DerXyz(Iat,2),NGeomI,xgeom(1),XyzGeomI(1,2,Iat),Coef(1,3*Iat-1))
194 1 pfleura2
           call splintder(u,XyzTmp2(Iat,3),DerXyz(Iat,3),NGeomI,xgeom(1),XyzGeomI(1,3,Iat),Coef(1,3*Iat))
195 1 pfleura2
        END IF
196 1 pfleura2
     END DO
197 1 pfleura2
198 1 pfleura2
199 1 pfleura2
  ! We align this geometry with the original one
200 1 pfleura2
  ! PFL 17/July/2006: only if we have more than 4 atoms.
201 1 pfleura2
!  IF (Nat.GT.4) THEN
202 1 pfleura2
! PFL 24 Nov 2008 ->
203 1 pfleura2
! If we have frozen atoms we align only those ones.
204 1 pfleura2
! PFL 8 Feb 2011 ->
205 1 pfleura2
! I add a flag to see if we should align or not.
206 1 pfleura2
! For small systems, it might be better to let the user align himself
207 1 pfleura2
      IF (Align) THEN
208 1 pfleura2
         if (NFroz.GT.0) THEN
209 1 pfleura2
            Call AlignPartial(Nat,x0,y0,z0,                     &
210 1 pfleura2
                 xyzTmp2(1,1),xyzTmp2(1,2),xyzTMP2(1,3),       &
211 1 pfleura2
                 FrozAtoms,MRot)
212 1 pfleura2
         ELSE
213 1 pfleura2
            Call  CalcRmsd(Nat, x0,y0,z0,                              &
214 1 pfleura2
                 xyzTmp2(1,1),xyzTmp2(1,2),xyzTMP2(1,3),       &
215 1 pfleura2
                 MRot,rmsd,.TRUE.,.TRUE.)
216 1 pfleura2
         END IF
217 1 pfleura2
! <- PFL 24 Nov 2008
218 1 pfleura2
      END IF
219 1 pfleura2
! -> PFL 8 Feb 2011
220 1 pfleura2
!  END IF
221 1 pfleura2
222 1 pfleura2
223 1 pfleura2
224 1 pfleura2
     ds=0.
225 1 pfleura2
     DO I=1,Nat
226 1 pfleura2
        DO J=1,3
227 1 pfleura2
           ds=ds+MassAt(I)*(XYZTMp2(I,J)-XYZTmp(I,J))**2
228 1 pfleura2
           XYZTmp(I,J)=XyzTMP2(I,J)
229 1 pfleura2
        ENDDO
230 1 pfleura2
     ENDDO
231 1 pfleura2
     s=s+sqrt(ds)
232 1 pfleura2
233 1 pfleura2
     !         if (debug) WRITE(*,*) "Debug u,s,dist",u,s,dist
234 1 pfleura2
235 1 pfleura2
  if ((printspline).AND.(MOD(K,NSpline).EQ.0)) THEN
236 1 pfleura2
     WRITE(IOTMP,*) Nat
237 1 pfleura2
     WRITE(IOTMP,'(1X,A,1X,F15.6)') "Debug Spline - Coord=Cart,s=",s
238 1 pfleura2
     DO Iat=1,Nat
239 1 pfleura2
        WRITE(IOTMP,'(1X,A2,3(1X,F15.6))') Nom(Atome(Iat)),    &
240 1 pfleura2
                   (XyzTmp2(Iat,1:3))
241 1 pfleura2
     END DO
242 1 pfleura2
  END IF
243 1 pfleura2
244 1 pfleura2
245 1 pfleura2
     if (s>=dist) THEN
246 1 pfleura2
247 1 pfleura2
        if (debug) THEN
248 1 pfleura2
           WRITE(*,*) "DBG Interpol_cart",s
249 1 pfleura2
           DO i=1,Nat
250 1 pfleura2
              WRITE(IOOUT,'(1X,A2,3(1X,F15.6))') Nom(Atome(I)),    &
251 1 pfleura2
                   (XyzTmp2(I,J),J=1,3)
252 1 pfleura2
           END DO
253 1 pfleura2
        END IF
254 1 pfleura2
255 1 pfleura2
        s=s-dist
256 1 pfleura2
        IdxGeom=IdxGeom+1
257 1 pfleura2
        SGeom(IdxGeom)=s+dist*(IdxGeom-1)
258 1 pfleura2
259 1 pfleura2
  ! We align this geometry with the original one
260 1 pfleura2
  ! PFL 17/July/2006: only if we have more than 4 atoms.
261 1 pfleura2
!  IF (Nat.GT.4) THEN
262 1 pfleura2
! PFL 24 Nov 2008 ->
263 1 pfleura2
! If we have frozen atoms we align only those ones.
264 1 pfleura2
! PFL 8 Feb 2011 ->
265 1 pfleura2
! I add a flag to see if we should align or not.
266 1 pfleura2
! For small systems, it might be better to let the user align himself
267 1 pfleura2
      IF (Align) THEN
268 1 pfleura2
         if (NFroz.GT.0) THEN
269 1 pfleura2
            Call AlignPartial(Nat,x0,y0,z0,                     &
270 1 pfleura2
                 xyzTmp2(1,1),xyzTmp2(1,2),xyzTMP2(1,3),       &
271 1 pfleura2
                 FrozAtoms,MRot)
272 1 pfleura2
         ELSE
273 1 pfleura2
            Call  CalcRmsd(Nat, x0,y0,z0,                              &
274 1 pfleura2
                 xyzTmp2(1,1),xyzTmp2(1,2),xyzTMP2(1,3),       &
275 1 pfleura2
                 MRot,rmsd,.TRUE.,.TRUE.)
276 1 pfleura2
         END IF
277 1 pfleura2
! <- PFL 24 Nov 2008
278 1 pfleura2
      END IF
279 1 pfleura2
! -> PFL 8 Feb 2011
280 1 pfleura2
!  END IF
281 1 pfleura2
282 1 pfleura2
        XyzGeomF(IdxGeom,:,:)=Reshape(XyzTmp2(:,:),(/3,Nat/),ORDER=(/2,1/))
283 1 pfleura2
        XyzTangent(IdxGeom,:)=Reshape(DerXyz(:,:),(/3*Nat/))
284 1 pfleura2
285 1 pfleura2
        if (print) THEN
286 1 pfleura2
           WRITE(IOOUT,'(1X,I5)') Nat
287 1 pfleura2
           WRITE(IOOUT,*) "# Cartesian coord for Geometry ",IdxGeom,K
288 1 pfleura2
289 1 pfleura2
           DO i=1,Nat
290 1 pfleura2
              WRITE(IOOUT,'(1X,A2,3(1X,F15.6))') Nom(Atome(I)),    &
291 1 pfleura2
                   (XyzTmp2(I,J),J=1,3)
292 1 pfleura2
           END DO
293 1 pfleura2
294 1 pfleura2
        END IF
295 1 pfleura2
     END IF  ! s>= dist
296 1 pfleura2
  ENDDO  ! K
297 1 pfleura2
298 1 pfleura2
299 1 pfleura2
  if (s>=0.9*dist) THEN
300 1 pfleura2
     s=s-dist
301 1 pfleura2
     XyzTmp2=Reshape(XyzGeomI(NGeomI,:,:),(/Nat,3/),ORDER=(/2,1/))
302 1 pfleura2
303 1 pfleura2
  if (printspline) THEN
304 1 pfleura2
     WRITE(IOTMP,*) Nat
305 1 pfleura2
     WRITE(IOTMP,*) "Debug Spline - Coord=Cart,s=",s
306 1 pfleura2
     DO Iat=1,Nat
307 1 pfleura2
        WRITE(IOTMP,'(1X,A2,3(1X,F15.6))') Nom(Atome(Iat)),    &
308 1 pfleura2
                   (XyzTmp2(Iat,1:3))
309 1 pfleura2
     END DO
310 1 pfleura2
  END IF
311 1 pfleura2
312 1 pfleura2
313 1 pfleura2
  ! We align this geometry with the original one
314 1 pfleura2
  ! PFL 17/July/2006: only if we have more than 4 atoms.
315 1 pfleura2
!  IF (Nat.GT.4) THEN
316 1 pfleura2
! PFL 24 Nov 2008 ->
317 1 pfleura2
! If we have frozen atoms we align only those ones.
318 1 pfleura2
! PFL 8 Feb 2011 ->
319 1 pfleura2
! I add a flag to see if we should align or not.
320 1 pfleura2
! For small systems, it might be better to let the user align himself
321 1 pfleura2
      IF (Align) THEN
322 1 pfleura2
         if (NFroz.GT.0) THEN
323 1 pfleura2
            Call AlignPartial(Nat,x0,y0,z0,                     &
324 1 pfleura2
                 xyzTmp2(1,1),xyzTmp2(1,2),xyzTMP2(1,3),       &
325 1 pfleura2
                 FrozAtoms,MRot)
326 1 pfleura2
         ELSE
327 1 pfleura2
            Call  CalcRmsd(Nat, x0,y0,z0,                              &
328 1 pfleura2
                 xyzTmp2(1,1),xyzTmp2(1,2),xyzTMP2(1,3),       &
329 1 pfleura2
                 MRot,rmsd,.TRUE.,.TRUE.)
330 1 pfleura2
         END IF
331 1 pfleura2
! <- PFL 24 Nov 2008
332 1 pfleura2
      END IF
333 1 pfleura2
! -> PFL 8 Feb 2011
334 1 pfleura2
!  END IF
335 1 pfleura2
336 1 pfleura2
     IdxGeom=IdxGeom+1
337 1 pfleura2
     SGeom(IdxGeom)=s+dist*(IdxGeom-1)
338 1 pfleura2
339 1 pfleura2
    IF (IdxGeom.GT.NGeomF) THEN
340 1 pfleura2
        WRITE(IOOUT,*) "!!! ERROR in Extrapol_cart !!!!"
341 1 pfleura2
        WRITE(IOOUT,*) "Too many structures. Increase NMaxPath"
342 1 pfleura2
        WRITE(*,*) "** PathCreate ***"
343 1 pfleura2
        WRITE(*,*) "Distribution of points along the path is wrong."
344 1 pfleura2
        WRITE(*,*) "Increase value of NMaxPtPath in the input file"
345 1 pfleura2
        WRITE(*,*) "Present value is:", NMaxPtPath
346 1 pfleura2
        STOP
347 1 pfleura2
     END IF
348 1 pfleura2
349 1 pfleura2
350 1 pfleura2
  ! We align this geometry with the original one
351 1 pfleura2
  ! PFL 17/July/2006: only if we have more than 4 atoms.
352 1 pfleura2
!  IF (Nat.GT.4) THEN
353 1 pfleura2
! PFL 24 Nov 2008 ->
354 1 pfleura2
! If we have frozen atoms we align only those ones.
355 1 pfleura2
! PFL 8 Feb 2011 ->
356 1 pfleura2
! I add a flag to see if we should align or not.
357 1 pfleura2
! For small systems, it might be better to let the user align himself
358 1 pfleura2
      IF (Align) THEN
359 1 pfleura2
         if (NFroz.GT.0) THEN
360 1 pfleura2
            Call AlignPartial(Nat,x0,y0,z0,                     &
361 1 pfleura2
                 xyzTmp2(1,1),xyzTmp2(1,2),xyzTMP2(1,3),       &
362 1 pfleura2
                 FrozAtoms,MRot)
363 1 pfleura2
         ELSE
364 1 pfleura2
            Call  CalcRmsd(Nat, x0,y0,z0,                              &
365 1 pfleura2
                 xyzTmp2(1,1),xyzTmp2(1,2),xyzTMP2(1,3),       &
366 1 pfleura2
                 MRot,rmsd,.TRUE.,.TRUE.)
367 1 pfleura2
         END IF
368 1 pfleura2
! <- PFL 24 Nov 2008
369 1 pfleura2
      END IF
370 1 pfleura2
! -> PFL 8 Feb 2011
371 1 pfleura2
!  END IF
372 1 pfleura2
373 1 pfleura2
     XyzGeomF(IdxGeom,:,:)=Reshape(XyzTmp2(:,:),(/3,Nat/),ORDER=(/2,1/))
374 1 pfleura2
     XyzTangent(IdxGeom,:)=Reshape(DerXyz(:,:),(/3*Nat/))
375 1 pfleura2
376 1 pfleura2
     if (print) THEN
377 1 pfleura2
        WRITE(IOOUT,'(1X,I5)') Nat
378 1 pfleura2
        WRITE(IOOUT,*) "# Cartesian coord for Geometry ",IdxGeom,K
379 1 pfleura2
380 1 pfleura2
        DO i=1,Nat
381 1 pfleura2
           WRITE(IOOUT,'(1X,A2,3(1X,F15.6))') Nom(Atome(I)),     &
382 1 pfleura2
                (XyzTmp2(I,J),J=1,3)
383 1 pfleura2
        END DO
384 1 pfleura2
     END IF
385 1 pfleura2
  END IF
386 1 pfleura2
387 1 pfleura2
  DEALLOCATE(XyzTmp,XyzTmp2)
388 1 pfleura2
389 1 pfleura2
  if (debug) WRITE(*,*) 's final =',s
390 1 pfleura2
391 1 pfleura2
  if (printspline) CLOSE(IOTMP)
392 1 pfleura2
393 1 pfleura2
  if (debug) Call Header("Extrapol_cart over")
394 1 pfleura2
395 1 pfleura2
END SUBROUTINE EXTRAPOL_CART