Révision 8 src/EgradPath.f90
EgradPath.f90 (revision 8)  

25  25 
REAL(KREAL), ALLOCATABLE :: x(:), y(:), z(:) 
26  26 
REAL(KREAL), ALLOCATABLE :: x_k(:), y_k(:), z_k(:) 
27  27 
REAL(KREAL), ALLOCATABLE :: GeomCart(:,:) !(Nat,3) 
28 
REAL(KREAL), ALLOCATABLE :: GeomOld_dummy(:),GeomCart_old_dummy(:,:) 

29  28 
REAL(KREAL) :: E 
30  29 
LOGICAL :: Debug 
31  30 
LOGICAL, SAVE :: First=.TRUE. 
...  ...  
39  38 
CHARACTER(*), intent(in) :: string 
40  39 
logical :: isValid 
41  40 
END function VALID 
41  
42 
subroutine Egrad(E,Geom,Grad,NCoord,IGeom,IOpt,GeomCart,FOptGeom,GeomOld,GeomCart_old) 

43  
44 
! This routines calculates the energy E and the gradient Grad of 

45 
! a molecule with Geometry Geom (may be in internal coordinates), 

46 
! using for now, either Gaussian or Ext, more general later. 

47  
48 
use Path_module, only : Nat,AtName,Coord,dzdc,indzmat,Nom,Atome,massat,unit, & 

49 
prog,NCart,XyzGeomF,IntCoordF,BTransInv, XyzGeomI, & 

50 
GeomOld_all,BTransInvF,BTransInv_local,UMatF,UMat_local & 

51 
, BprimT,a0,ScanCoord, Coordinate,NPrim,BMat_BakerT,BBT,BBT_inv & 

52 
, Order,OrderInv, XPrimitiveF 

53  
54 
! IntCoordF(NGeomF,NCoord),GeomOld_all(NGeomF,NCoord) 

55 
! allocated in Path.f90 

56  
57 
use Io_module 

58  
59 
! Energy (calculated if F300K=.F., else estimated) 

60 
REAL(KREAL), INTENT (OUT) :: E 

61 
! NCoord: Number of the degrees of freedom 

62 
! IGeom: index of the geometry. 

63 
INTEGER(KINT), INTENT (IN) :: NCoord, IGeom, IOpt 

64 
! Geometry at which gradient is calculated (cf Factual also): 

65 
REAL(KREAL), INTENT (INOUT) :: Geom(NCoord) 

66 
! Gradient calculated at Geom geometry: 

67 
REAL(KREAL), INTENT (OUT) :: Grad(NCoord) 

68 
! Cartesian geometry corresponding to (Internal Geometry) Geom: 

69 
REAL(KREAL), INTENT (OUT) :: GeomCart(Nat,3) 

70 
!!! Optional, just for geometry optimization with Baker coordinates 

71 
REAL(KREAL), INTENT (IN), OPTIONAL :: GeomCart_old(Nat,3) 

72 
REAL(KREAL), INTENT (INOUT), OPTIONAL :: GeomOld(NCoord) 

73 
! FOptGeom is a flag indicating if we are doing a geom optimization 

74 
! it can be omitted so that we use a local flag: Flag_Opt_Geom 

75 
LOGICAL,INTENT (IN), OPTIONAL :: FOptGeom 

76 
! if FOptGeom is given Flag_Opt_Geom=FOptGeom, else Flag_Opt_Geom=F 

77 
LOGICAL :: Flag_Opt_Geom 

78  
79 
END subroutine Egrad 

80  
42  81 
END INTERFACE 
43  82  
44  83 
debug=valid('EGradPath') 
...  ...  
48  87 
ALLOCATE(GeomTmp(NCoord)) 
49  88 
ALLOCATE(x(Nat),y(Nat),z(Nat)) 
50  89 
ALLOCATE(x_k(Nat),y_k(Nat),z_k(Nat)) 
51 
ALLOCATE(GeomOld_dummy(NCoord)) 

52 
ALLOCATE(GeomCart_old_dummy(Nat,3)) 

53  90  
54  91  
55  92 
IF (RunMode=="PARA") THEN ! matches at L315 
...  ...  
608  645 
ELSE ! matches IF (RunMode=="PARA") THEN 
609  646 
! We will launch all calculations sequentially 
610  647 
ALLOCATE(GradTmp(NCoord)) 
611 
GeomOld_dummy=0.d0 ! Internal coordinates 

612 
GeomCart_old_dummy=0.d0 

613  648 
! We have the new path, we calculate its energy and gradient 
614  649 
IGeom0=2 
615  650 
IGeomF=NGeomF1 
...  ...  
664  699 
WRITE(*,'(12(1X,F6.3))') GeomCart 
665  700 
END IF 
666  701 

667 
IF (COORD.EQ.'BAKER') THEN 

668  702 
! GradTmp is gradient and calculated in Egrad.F, INTENT(OUT). 
669  703 
! GeomCart has INTENT(OUT) 
670 
Call EGrad_baker(E,GeomTmp,GradTmp,NCoord,IGeom,IOpt,GeomCart,Flag_Opt_Geom, & 

671 
GeomOld_dummy,GeomCart_old_dummy) 

672 
ELSE 

673 
Call EGrad(E,GeomTmp,GradTmp,NCoord,IGeom,IOpt,GeomCart,Flag_Opt_Geom) !GeomTmp=IntCoordF(IGeom,:) 

674 
END IF 

704 
Call EGrad(E,GeomTmp,GradTmp,NCoord,IGeom,IOpt,GeomCart) !GeomTmp=IntCoordF(IGeom,:) 

675  705  
676  706 
! Egrad calls ConvertBakerInternal_cart to convert GeomTmp=IntCoordF(IGeom,:) into 
677  707 
! GeomCart (Cartesian Coordinates) so that energy and gradients can be calculated 
...  ...  
694  724 
DEALLOCATE(GeomTmp) 
695  725 
DEALLOCATE(x,y,z) 
696  726 
DEALLOCATE(x_k,y_k,z_k) 
697 
DEALLOCATE(GeomOld_dummy,GeomCart_old_dummy) 

698  727 
if (debug) Call header('Exiting EgradPath') 
699  728 
RETURN 
700  729 
999 WRITE(*,*) "EgradPath : We should not be here !" 
Formats disponibles : Unified diff