Statistiques
| Révision :

root / src / CalcDist_cart.f90

Historique | Voir | Annoter | Télécharger (13,61 ko)

1
SUBROUTINE CalcDist_cart(iopt,s,dist,x0,y0,z0,xgeom,Coef)
2

    
3
! This subroutine computes the curvilinear distance of the images on the path
4
! It is adapted from Extrapol_cart 
5

    
6
!----------------------------------------------------------------------
7
!  Copyright 2003-2014 Ecole Normale Supérieure de Lyon, 
8
!  Centre National de la Recherche Scientifique,
9
!  Université Claude Bernard Lyon 1. All rights reserved.
10
!
11
!  This work is registered with the Agency for the Protection of Programs 
12
!  as IDDN.FR.001.100009.000.S.P.2014.000.30625
13
!
14
!  Authors: P. Fleurat-Lessard, P. Dayal
15
!  Contact: optnpath@gmail.com
16
!
17
! This file is part of "Opt'n Path".
18
!
19
!  "Opt'n Path" is free software: you can redistribute it and/or modify
20
!  it under the terms of the GNU Affero General Public License as
21
!  published by the Free Software Foundation, either version 3 of the License,
22
!  or (at your option) any later version.
23
!
24
!  "Opt'n Path" is distributed in the hope that it will be useful,
25
!  but WITHOUT ANY WARRANTY; without even the implied warranty of
26
!
27
!  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
28
!  GNU Affero General Public License for more details.
29
!
30
!  You should have received a copy of the GNU Affero General Public License
31
!  along with "Opt'n Path". If not, see <http://www.gnu.org/licenses/>.
32
!
33
! Contact The Office of Technology Licensing, valorisation@ens-lyon.fr,
34
! for commercial licensing opportunities.
35
!----------------------------------------------------------------------
36

    
37
  use Path_module
38
  use Io_module
39

    
40

    
41
  IMPLICIT NONE
42

    
43

    
44
  REAL(KREAL), INTENT(OUT) :: s
45
  ! X0(Nat),Y0(Nat),Z0(Nat): reference geometry.
46
  REAL(KREAL), INTENT(IN) :: dist,X0(Nat),Y0(Nat),Z0(Nat)
47
  REAL(KREAL), INTENT(IN) :: Xgeom(NGeomI),Coef(NGeomI,NCoord)
48
! Iopt: Number of the cycles for the optimization
49
  INTEGER(KINT), INTENT(IN) :: Iopt
50
  INTEGER(KINT) :: IdxGeom, I, J, K, Idx,Iat, IGeom
51
! NSpline is the number of points along the interpolating path
52
  INTEGER(KINT) :: NSpline
53
! FileSpline: Filename to save the interpolating path coordinates
54
  CHARACTER(LCHARS) :: FileSpline,TmpChar
55
  REAL(KREAL) :: Rmsd,MRot(3,3), ds, u, v
56
  REAL(KREAL) :: a_val, d
57

    
58
  REAL(KREAL), ALLOCATABLE :: XyzTmp(:,:), XyzTmp2(:,:) ! (Nat,3)
59
  REAL(KREAL), ALLOCATABLE :: DerXyz(:,:) ! Nat,3
60

    
61

    
62
  LOGICAL ::  debug, print, printspline
63
  LOGICAL, EXTERNAL :: valid
64

    
65
  !We will calculate the length of the path, in MW coordinates...
66
  ! this is done is a stupid way: we interpolate the zmatrix values,
67
  ! convert them into cartesian, weight the cartesian
68
  ! and calculate the evolution of the distance ! 
69
  ! We have to follow the same procedure for every geometry
70
  ! so even for the first one, we have to convert it from zmat
71
  ! to cartesian !
72

    
73
  debug=valid("pathcreate")
74
  print=valid("printgeom")
75

    
76
  printspline=(valid("printspline").AND.(dist<=1e30))
77

    
78
  if (debug) Call Header("Entering CalcDist_cart")
79

    
80
! We want 100 points along the interpolating path
81
  NSpline=int(NMaxPtPath/100)
82

    
83
  if (printspline) THEN
84
     WRITE(TmpChar,'(I5)') Iopt
85
     FileSpline=Trim(adjustL(PathName)) // '_spline.' // AdjustL(TRIM(TmpChar))
86
     OPEN(IOTMP,FILE=FileSpline)
87

    
88
  END IF
89

    
90

    
91
  ALLOCATE(XyzTmp(Nat,3),XyzTmp2(Nat,3),DerXyz(Nat,3))
92

    
93
!  XyzTmp2=Reshape(XyzGeomI(1,:,:),(/Nat,3/),ORDER=(/2,1/))
94

    
95
  if (debug) THEN
96
     WRITE(*,*) "DBG Extrapol_cart Initial geometries"
97
     DO IGeom=1,NGeomI
98
        WRITE(*,*) 'XyzGeomI, IGeom=',IGeom
99
        DO I=1,Nat
100
           WRITE(IOOUT,'(1X,A2,3(1X,F15.6))') Nom(Atome(I)),      &
101
                (XyzGeomI(IGeom,J,I),J=1,3)
102
        END DO
103
     END DO
104
  END IF
105

    
106

    
107
! In order to mesure only the relevant distance between two points
108
! we align all geometries on the original one
109

    
110
   DO IGeom=1,NGeomI
111

    
112
      XyzTmp2=Reshape(XyzGeomI(IGeom,:,:),(/Nat,3/),ORDER=(/2,1/))
113
  ! We align this geometry with the original one
114
  ! PFL 17/July/2006: only if we have more than 4 atoms.
115
!  IF (Nat.GT.4) THEN
116
! PFL 24 Nov 2008 ->
117
! If we have frozen atoms we align only those ones.
118
! PFL 8 Feb 2011 ->
119
! I add a flag to see if we should align or not.
120
! For small systems, it might be better to let the user align himself
121
      IF (Align) THEN
122
         if (NFroz.GT.0) THEN
123
            Call AlignPartial(Nat,x0,y0,z0,                     &
124
                 xyzTmp2(1,1),xyzTmp2(1,2),xyzTMP2(1,3),       &
125
                 FrozAtoms,MRot)
126
         ELSE
127
            Call  CalcRmsd(Nat, x0,y0,z0,                              &
128
                 xyzTmp2(1,1),xyzTmp2(1,2),xyzTMP2(1,3),       &
129
                 MRot,rmsd,.TRUE.,.TRUE.)
130
         END IF
131
! <- PFL 24 Nov 2008
132
      END IF
133
! -> PFL 8 Feb 2011
134
!  END IF
135

    
136
  XyzGeomI(IGeom,:,:)=Reshape(XyzTmp2(:,:),(/3,Nat/),ORDER=(/2,1/))
137
 END DO
138

    
139
   if (print) THEN
140
      WRITE(*,*) "Aligned geometries"
141
      DO J=1, NGeomI
142
         WRITE(IOOUT,*) Nat
143
         WRITE(IOOUT,*) " Aligned geometry ",J,"/",NGeomI
144
           DO i=1,Nat
145
              WRITE(IOOUT,'(1X,A2,3(1X,F15.6))') Nom(Atome(I)),    &
146
                   XyzGeomI(J,1:3,I)
147
           END DO
148
        END DO
149
     END IF
150

    
151
  XyzGeomF(1,:,:)=XyzGeomI(1,:,:)
152

    
153

    
154
  ! We initialize the first geometry
155

    
156
  XyzTmp=Reshape(XyzGeomI(1,:,:),(/Nat,3/),ORDER=(/2,1/))
157

    
158
  ! We align this geometry with the original one
159
  ! PFL 17/July/2006: only if we have more than 4 atoms.
160
!  IF (Nat.GT.4) THEN
161
! PFL 24 Nov 2008 ->
162
! If we have frozen atoms we align only those ones.
163
! PFL 8 Feb 2011 ->
164
! I add a flag to see if we should align or not.
165
! For small systems, it might be better to let the user align himself
166
      IF (Align) THEN
167
         if (NFroz.GT.0) THEN
168
            Call AlignPartial(Nat,x0,y0,z0,                     &
169
                 xyzTmp(1,1),xyzTmp(1,2),xyzTMP(1,3),       &
170
                 FrozAtoms,MRot)
171
         ELSE
172
            Call  CalcRmsd(Nat, x0,y0,z0,                              &
173
                 xyzTmp(1,1),xyzTmp(1,2),xyzTMP(1,3),       &
174
                 MRot,rmsd,.TRUE.,.TRUE.)
175
         END IF
176
! <- PFL 24 Nov 2008
177
      END IF
178
! -> PFL 8 Feb 2011
179
!  END IF
180

    
181

    
182

    
183
  s=0.d0
184
  SGeom(1)=0.d0
185

    
186
  if (printspline) THEN
187
     u=0.d0
188
     DO Iat=1,Nat
189
        ! We generate the interpolated coordinates
190
        if (Linear) THEN
191
           call LinearInt(u,XyzTmp2(Iat,1),DerXyz(Iat,1),NGeomI,xgeom(1),XyzGeomI(1,1,Iat))
192
           call LinearInt(u,XyzTmp2(Iat,2),DerXyz(Iat,2),NGeomI,xgeom(1),XyzGeomI(1,2,Iat))
193
           call LinearInt(u,XyzTmp2(Iat,3),DerXyz(Iat,3),NGeomI,xgeom(1),XyzGeomI(1,3,Iat))
194

    
195
        ELSE
196
           call splintder(u,XyzTmp2(Iat,1),DerXyz(Iat,1),NGeomI,xgeom(1),XyzGeomI(1,1,Iat),Coef(1,3*Iat-2))
197
           call splintder(u,XyzTmp2(Iat,2),DerXyz(Iat,2),NGeomI,xgeom(1),XyzGeomI(1,2,Iat),Coef(1,3*Iat-1))
198
           call splintder(u,XyzTmp2(Iat,3),DerXyz(Iat,3),NGeomI,xgeom(1),XyzGeomI(1,3,Iat),Coef(1,3*Iat))
199
        END IF
200
     END DO
201

    
202
     WRITE(IOTMP,*) Nat
203
     WRITE(IOTMP,'(1X,A,1X,F15.6)') "Debug Spline - Coord=Cart,s=",s
204
     DO Iat=1,Nat
205
        WRITE(IOTMP,'(1X,A2,3(1X,F15.6))') Nom(Atome(Iat)),    &
206
                   (XyzTmp2(Iat,1:3))
207
     END DO
208
  END IF
209

    
210
 IdxGeom=1
211

    
212
  DO K=1,NMaxPtPath
213
     u=real(K)/NMaxPtPath*(NGeomI-1.)
214

    
215
     DO Iat=1,Nat
216
        ! We generate the interpolated coordinates
217
        if (Linear) THEN
218
           call LinearInt(u,XyzTmp2(Iat,1),DerXyz(Iat,1),NGeomI,xgeom(1),XyzGeomI(1,1,Iat))
219
           call LinearInt(u,XyzTmp2(Iat,2),DerXyz(Iat,2),NGeomI,xgeom(1),XyzGeomI(1,2,Iat))
220
           call LinearInt(u,XyzTmp2(Iat,3),DerXyz(Iat,3),NGeomI,xgeom(1),XyzGeomI(1,3,Iat))
221

    
222
        ELSE
223
           call splintder(u,XyzTmp2(Iat,1),DerXyz(Iat,1),NGeomI,xgeom(1),XyzGeomI(1,1,Iat),Coef(1,3*Iat-2))
224
           call splintder(u,XyzTmp2(Iat,2),DerXyz(Iat,2),NGeomI,xgeom(1),XyzGeomI(1,2,Iat),Coef(1,3*Iat-1))
225
           call splintder(u,XyzTmp2(Iat,3),DerXyz(Iat,3),NGeomI,xgeom(1),XyzGeomI(1,3,Iat),Coef(1,3*Iat))
226
        END IF
227
     END DO
228

    
229

    
230
  ! We align this geometry with the original one
231
  ! PFL 17/July/2006: only if we have more than 4 atoms.
232
!  IF (Nat.GT.4) THEN
233
! PFL 24 Nov 2008 ->
234
! If we have frozen atoms we align only those ones.
235
! PFL 8 Feb 2011 ->
236
! I add a flag to see if we should align or not.
237
! For small systems, it might be better to let the user align himself
238
      IF (Align) THEN
239
         if (NFroz.GT.0) THEN
240
            Call AlignPartial(Nat,x0,y0,z0,                     &
241
                 xyzTmp2(1,1),xyzTmp2(1,2),xyzTMP2(1,3),       &
242
                 FrozAtoms,MRot)
243
         ELSE
244
            Call  CalcRmsd(Nat, x0,y0,z0,                              &
245
                 xyzTmp2(1,1),xyzTmp2(1,2),xyzTMP2(1,3),       &
246
                 MRot,rmsd,.TRUE.,.TRUE.)
247
         END IF
248
! <- PFL 24 Nov 2008
249
      END IF
250
! -> PFL 8 Feb 2011
251
!  END IF
252

    
253

    
254

    
255
     ds=0.
256
     DO I=1,Nat
257
        DO J=1,3
258
           ds=ds+MassAt(I)*(XYZTMp2(I,J)-XYZTmp(I,J))**2
259
           XYZTmp(I,J)=XyzTMP2(I,J)
260
        ENDDO
261
     ENDDO
262
     s=s+sqrt(ds)
263

    
264
     !         if (debug) WRITE(*,*) "Debug u,s,dist",u,s,dist
265

    
266
  if ((printspline).AND.(MOD(K,NSpline).EQ.0)) THEN
267
     WRITE(IOTMP,*) Nat
268
     WRITE(IOTMP,'(1X,A,1X,F15.6)') "Debug Spline - Coord=Cart,s=",s
269
     DO Iat=1,Nat
270
        WRITE(IOTMP,'(1X,A2,3(1X,F15.6))') Nom(Atome(Iat)),    &
271
                   (XyzTmp2(Iat,1:3))
272
     END DO
273
  END IF
274

    
275

    
276
     if (s>=dist) THEN
277

    
278
        if (debug) THEN
279
           WRITE(*,*) "DBG Interpol_cart",s
280
           DO i=1,Nat
281
              WRITE(IOOUT,'(1X,A2,3(1X,F15.6))') Nom(Atome(I)),    &
282
                   (XyzTmp2(I,J),J=1,3)
283
           END DO
284
        END IF
285

    
286
        s=s-dist
287
        IdxGeom=IdxGeom+1
288
        SGeom(IdxGeom)=s+dist*(IdxGeom-1)
289

    
290
  ! We align this geometry with the original one
291
  ! PFL 17/July/2006: only if we have more than 4 atoms.
292
!  IF (Nat.GT.4) THEN
293
! PFL 24 Nov 2008 ->
294
! If we have frozen atoms we align only those ones.
295
! PFL 8 Feb 2011 ->
296
! I add a flag to see if we should align or not.
297
! For small systems, it might be better to let the user align himself
298
      IF (Align) THEN
299
         if (NFroz.GT.0) THEN
300
            Call AlignPartial(Nat,x0,y0,z0,                     &
301
                 xyzTmp2(1,1),xyzTmp2(1,2),xyzTMP2(1,3),       &
302
                 FrozAtoms,MRot)
303
         ELSE
304
            Call  CalcRmsd(Nat, x0,y0,z0,                              &
305
                 xyzTmp2(1,1),xyzTmp2(1,2),xyzTMP2(1,3),       &
306
                 MRot,rmsd,.TRUE.,.TRUE.)
307
         END IF
308
! <- PFL 24 Nov 2008
309
      END IF
310
! -> PFL 8 Feb 2011
311
!  END IF
312

    
313
        XyzGeomF(IdxGeom,:,:)=Reshape(XyzTmp2(:,:),(/3,Nat/),ORDER=(/2,1/))
314
        XyzTangent(IdxGeom,:)=Reshape(DerXyz(:,:),(/3*Nat/))
315

    
316
        if (print) THEN
317
           WRITE(IOOUT,'(1X,I5)') Nat
318
           WRITE(IOOUT,*) "# Cartesian coord for Geometry ",IdxGeom,K
319

    
320
           DO i=1,Nat
321
              WRITE(IOOUT,'(1X,A2,3(1X,F15.6))') Nom(Atome(I)),    &
322
                   (XyzTmp2(I,J),J=1,3)
323
           END DO
324

    
325
        END IF
326
     END IF  ! s>= dist
327
  ENDDO  ! K
328

    
329

    
330
  if (s>=0.9*dist) THEN
331
     s=s-dist
332
     XyzTmp2=Reshape(XyzGeomI(NGeomI,:,:),(/Nat,3/),ORDER=(/2,1/))
333

    
334
  if (printspline) THEN
335
     WRITE(IOTMP,*) Nat
336
     WRITE(IOTMP,*) "Debug Spline - Coord=Cart,s=",s
337
     DO Iat=1,Nat
338
        WRITE(IOTMP,'(1X,A2,3(1X,F15.6))') Nom(Atome(Iat)),    &
339
                   (XyzTmp2(Iat,1:3))
340
     END DO
341
  END IF
342

    
343

    
344
  ! We align this geometry with the original one
345
  ! PFL 17/July/2006: only if we have more than 4 atoms.
346
!  IF (Nat.GT.4) THEN
347
! PFL 24 Nov 2008 ->
348
! If we have frozen atoms we align only those ones.
349
! PFL 8 Feb 2011 ->
350
! I add a flag to see if we should align or not.
351
! For small systems, it might be better to let the user align himself
352
      IF (Align) THEN
353
         if (NFroz.GT.0) THEN
354
            Call AlignPartial(Nat,x0,y0,z0,                     &
355
                 xyzTmp2(1,1),xyzTmp2(1,2),xyzTMP2(1,3),       &
356
                 FrozAtoms,MRot)
357
         ELSE
358
            Call  CalcRmsd(Nat, x0,y0,z0,                              &
359
                 xyzTmp2(1,1),xyzTmp2(1,2),xyzTMP2(1,3),       &
360
                 MRot,rmsd,.TRUE.,.TRUE.)
361
         END IF
362
! <- PFL 24 Nov 2008
363
      END IF
364
! -> PFL 8 Feb 2011
365
!  END IF
366

    
367
     IdxGeom=IdxGeom+1
368
     SGeom(IdxGeom)=s+dist*(IdxGeom-1)
369

    
370
    IF (IdxGeom.GT.NGeomF) THEN
371
        WRITE(IOOUT,*) "!!! ERROR in Extrapol_cart !!!!"
372
        WRITE(IOOUT,*) "Too many structures. Increase NMaxPath"
373
        WRITE(*,*) "** PathCreate ***"
374
        WRITE(*,*) "Distribution of points along the path is wrong."
375
        WRITE(*,*) "Increase value of NMaxPtPath in the input file"
376
        WRITE(*,*) "Present value is:", NMaxPtPath
377
        STOP
378
     END IF
379

    
380

    
381
  ! We align this geometry with the original one
382
  ! PFL 17/July/2006: only if we have more than 4 atoms.
383
!  IF (Nat.GT.4) THEN
384
! PFL 24 Nov 2008 ->
385
! If we have frozen atoms we align only those ones.
386
! PFL 8 Feb 2011 ->
387
! I add a flag to see if we should align or not.
388
! For small systems, it might be better to let the user align himself
389
      IF (Align) THEN
390
         if (NFroz.GT.0) THEN
391
            Call AlignPartial(Nat,x0,y0,z0,                     &
392
                 xyzTmp2(1,1),xyzTmp2(1,2),xyzTMP2(1,3),       &
393
                 FrozAtoms,MRot)
394
         ELSE
395
            Call  CalcRmsd(Nat, x0,y0,z0,                              &
396
                 xyzTmp2(1,1),xyzTmp2(1,2),xyzTMP2(1,3),       &
397
                 MRot,rmsd,.TRUE.,.TRUE.)
398
         END IF
399
! <- PFL 24 Nov 2008
400
      END IF
401
! -> PFL 8 Feb 2011
402
!  END IF
403

    
404
     XyzGeomF(IdxGeom,:,:)=Reshape(XyzTmp2(:,:),(/3,Nat/),ORDER=(/2,1/))
405
     XyzTangent(IdxGeom,:)=Reshape(DerXyz(:,:),(/3*Nat/))
406

    
407
     if (print) THEN
408
        WRITE(IOOUT,'(1X,I5)') Nat
409
        WRITE(IOOUT,*) "# Cartesian coord for Geometry ",IdxGeom,K
410

    
411
        DO i=1,Nat
412
           WRITE(IOOUT,'(1X,A2,3(1X,F15.6))') Nom(Atome(I)),     &
413
                (XyzTmp2(I,J),J=1,3)
414
        END DO
415
     END IF
416
  END IF
417

    
418
  DEALLOCATE(XyzTmp,XyzTmp2)
419

    
420
  if (debug) WRITE(*,*) 's final =',s
421

    
422
  if (printspline) CLOSE(IOTMP)
423

    
424
  if (debug) Call Header("Extrapol_cart over")
425

    
426
END SUBROUTINE EXTRAPOL_CART