hdiff output

r31537/genrigid.f90 2016-11-24 14:30:18.541931050 +0000 r31536/genrigid.f90 2016-11-24 14:30:21.021963953 +0000
753:         DR2(:) = MATMUL(DRMI2,SITESRIGIDBODY(J2,:,J1))753:         DR2(:) = MATMUL(DRMI2,SITESRIGIDBODY(J2,:,J1))
754:         DR3(:) = MATMUL(DRMI3,SITESRIGIDBODY(J2,:,J1))754:         DR3(:) = MATMUL(DRMI3,SITESRIGIDBODY(J2,:,J1))
755:         GR(3*NRIGIDBODY+3*J1-2) = GR(3*NRIGIDBODY+3*J1-2) + DOT_PRODUCT(G(3*J9-2:3*J9),DR1(:))755:         GR(3*NRIGIDBODY+3*J1-2) = GR(3*NRIGIDBODY+3*J1-2) + DOT_PRODUCT(G(3*J9-2:3*J9),DR1(:))
756:         GR(3*NRIGIDBODY+3*J1-1) = GR(3*NRIGIDBODY+3*J1-1) + DOT_PRODUCT(G(3*J9-2:3*J9),DR2(:))756:         GR(3*NRIGIDBODY+3*J1-1) = GR(3*NRIGIDBODY+3*J1-1) + DOT_PRODUCT(G(3*J9-2:3*J9),DR2(:))
757:         GR(3*NRIGIDBODY+3*J1)   = GR(3*NRIGIDBODY+3*J1)   + DOT_PRODUCT(G(3*J9-2:3*J9),DR3(:))757:         GR(3*NRIGIDBODY+3*J1)   = GR(3*NRIGIDBODY+3*J1)   + DOT_PRODUCT(G(3*J9-2:3*J9),DR3(:))
758:      ENDDO758:      ENDDO
759:   ENDDO759:   ENDDO
760: 760: 
761: ! hk286 - testing 6/6/12761: ! hk286 - testing 6/6/12
762:   IF (FREEZERIGIDBODYT .EQV. .TRUE.) THEN762:   IF (FREEZERIGIDBODYT .EQV. .TRUE.) THEN
 763:   write(*,*) "Danger: in frozen block"
763:      GR(3*NRIGIDBODY-2:3*NRIGIDBODY) = 0.0D0764:      GR(3*NRIGIDBODY-2:3*NRIGIDBODY) = 0.0D0
764:      GR(6*NRIGIDBODY-2:6*NRIGIDBODY) = 0.0D0765:      GR(6*NRIGIDBODY-2:6*NRIGIDBODY) = 0.0D0
765:   ENDIF766:   ENDIF
766: 767: 
767: ! hk286 > single atoms768: ! hk286 > single atoms
768: ! vr274 > and lattice769: ! vr274 > and lattice
769:   IF (DEGFREEDOMS > 6 * NRIGIDBODY - NLATTICECOORDS) THEN770:   IF (DEGFREEDOMS > 6 * NRIGIDBODY - NLATTICECOORDS) THEN
 771:   write(*,*) "Danger: in single atom block"
770:      DO J1 = 1, (DEGFREEDOMS - 6*NRIGIDBODY - NLATTICECOORDS)/3772:      DO J1 = 1, (DEGFREEDOMS - 6*NRIGIDBODY - NLATTICECOORDS)/3
771:         J9 = RIGIDSINGLES(J1)773:         J9 = RIGIDSINGLES(J1)
772:         GR(6*NRIGIDBODY + 3*J1-2:6*NRIGIDBODY + 3*J1) = G(3*J9-2:3*J9)774:         GR(6*NRIGIDBODY + 3*J1-2:6*NRIGIDBODY + 3*J1) = G(3*J9-2:3*J9)
773:      ENDDO775:      ENDDO
774:   ENDIF776:   ENDIF
775: 777: 
776:   IF(HAS_LATTICE_COORDS) THEN778:   IF(HAS_LATTICE_COORDS) THEN
 779:   write(*,*) "Danger: in lattice coord block"
777:       CALL GET_LATTICE_MATRIX(XR(DEGFREEDOMS-5:DEGFREEDOMS),MLATTICE)780:       CALL GET_LATTICE_MATRIX(XR(DEGFREEDOMS-5:DEGFREEDOMS),MLATTICE)
778: 781: 
779:       ! vr274> for lattice, go to reduced coordinates782:       ! vr274> for lattice, go to reduced coordinates
780:       DO J1 = 1, NRIGIDBODY783:       DO J1 = 1, NRIGIDBODY
781:           GR(3*J1-2:3*J1) =  matmul(transpose(mlattice), GR(3*J1-2:3*J1))784:           GR(3*J1-2:3*J1) =  matmul(transpose(mlattice), GR(3*J1-2:3*J1))
782:       ENDDO785:       ENDDO
783:       ! vr274> and single atoms786:       ! vr274> and single atoms
784:       IF (DEGFREEDOMS > 6 * NRIGIDBODY + NLATTICECOORDS) THEN787:       IF (DEGFREEDOMS > 6 * NRIGIDBODY + NLATTICECOORDS) THEN
785:           DO J1 = 1, (DEGFREEDOMS - 6*NRIGIDBODY - NLATTICECOORDS)/3788:           DO J1 = 1, (DEGFREEDOMS - 6*NRIGIDBODY - NLATTICECOORDS)/3
786:               J2 = 6*NRIGIDBODY + 3*J1789:               J2 = 6*NRIGIDBODY + 3*J1
976: END SUBROUTINE RBDET979: END SUBROUTINE RBDET
977: 980: 
978: SUBROUTINE GENRIGID_IMAGE_CTORIGID(NIMAGE, XYZ)981: SUBROUTINE GENRIGID_IMAGE_CTORIGID(NIMAGE, XYZ)
979: 982: 
980:   USE COMMONS, only: NATOMS983:   USE COMMONS, only: NATOMS
981:   IMPLICIT NONE984:   IMPLICIT NONE
982:   985:   
983:   INTEGER :: I, NIMAGE, NOPT 986:   INTEGER :: I, NIMAGE, NOPT 
984:   DOUBLE PRECISION :: XCOORDS(3*NATOMS), XRIGIDCOORDS (DEGFREEDOMS)987:   DOUBLE PRECISION :: XCOORDS(3*NATOMS), XRIGIDCOORDS (DEGFREEDOMS)
985:   DOUBLE PRECISION :: XYZ(3*NATOMS*(NIMAGE+2))988:   DOUBLE PRECISION :: XYZ(3*NATOMS*(NIMAGE+2))
986:  
987: ! XYZ holds the atomistic coordinates of the NIMAGE images and the two end points.989: ! XYZ holds the atomistic coordinates of the NIMAGE images and the two end points.
988:   NOPT = 3*NATOMS ! The number of (atomistic) coordinates to be optimised.990:   NOPT = 3*NATOMS ! The number of (atomistic) coordinates to be optimised.
989:   DO I=1,NIMAGE+2991:   DO I=1,NIMAGE+2
990:      XCOORDS(1:NOPT)=XYZ(NOPT*(I-1)+1:NOPT*I)992:      XCOORDS(1:NOPT)=XYZ(NOPT*(I-1)+1:NOPT*I)
991:      CALL TRANSFORMCTORIGID (XCOORDS, XRIGIDCOORDS)993:      CALL TRANSFORMCTORIGID (XCOORDS, XRIGIDCOORDS)
992:      ! Fill up the first DEGFREEDOMS coordinates in this subsection of XYZ994:      ! Fill up the first DEGFREEDOMS coordinates in this subsection of XYZ
993:      ! with the correct rigid-body coordinates.995:      ! with the correct rigid-body coordinates.
994:      XYZ(NOPT*(I-1)+1:NOPT*(I-1)+DEGFREEDOMS) = XRIGIDCOORDS(1:DEGFREEDOMS)996:      XYZ(NOPT*(I-1)+1:NOPT*(I-1)+DEGFREEDOMS) = XRIGIDCOORDS(1:DEGFREEDOMS)
995:      ! Fill up the excess with 0s.997:      ! Fill up the excess with 0s.
996:      XYZ(NOPT*(I-1)+DEGFREEDOMS+1:NOPT*(I-1)+NOPT) = 0.0D0998:      XYZ(NOPT*(I-1)+DEGFREEDOMS+1:NOPT*(I-1)+NOPT) = 0.0D0
1508:             WRITE(*,*) "Lower-left block:"1510:             WRITE(*,*) "Lower-left block:"
1509:             DO J3=4,61511:             DO J3=4,6
1510:                 WRITE(*,*) RB_IMT(J3,1:3)1512:                 WRITE(*,*) RB_IMT(J3,1:3)
1511:             ENDDO1513:             ENDDO
1512:             NFAILS = NFAILS+1  ! We will now terminate at the end of the tensor-construction step.1514:             NFAILS = NFAILS+1  ! We will now terminate at the end of the tensor-construction step.
1513:             ! We don't terminate immediately in order to count the number of failures that occur.1515:             ! We don't terminate immediately in order to count the number of failures that occur.
1514:         ENDIF1516:         ENDIF
1515:     ENDIF1517:     ENDIF
1516: 1518: 
1517: ! We have now constructed the rotational part of the metric tensor.1519: ! We have now constructed the rotational part of the metric tensor.
1518: !1520: ! Next we need to invert the matrix. But we don't seem to have DGETRI in our library?
1519: ! Next we need to invert the matrix. I've considered using a LAPACK routine, but we don't seem to have DGETRI1521: ! So I'm doing this manually for the moment.
1520: ! in our library, and in any case it's probably faster to code it explicitly for a 3x3 matrix.1522: 
 1523:     ! Perform LU decomposition of the rotational components of the matrix.
 1524:     ! Parameters are: matrix dimensions (rows then columns), the matrix itself, array bound,
 1525:     ! an array of pivot indices (to fill in) and INFO to tell us whether the routine was successful.
 1526:     !
 1527: !    LR = RB_IMT(4:6,4:6)
 1528: !    CALL DGETRF(3, 3, LR, 3, PIVOTS, INFO)
 1529: !    IF(INFO .NE. 0) THEN
 1530: !        WRITE(*,*) "genrigid> GENRIGID_NORMALMODES: Error in DGETRF. INFO =", INFO
 1531: !        STOP
 1532: !    ENDIF
 1533:     ! Invert the matrix.
 1534:     ! It probably isn't such a serious performance problem.
 1535: !    CALL DGETRI(3, LR, 3, PIVOTS, WORK, LWORK, INFO)
 1536: !    IF(INFO .NE. 0) THEN
 1537: !        WRITE(*,*) "genrigid> GENRIGID_NORMALMODES: Error in DGETRI. INFO =", INFO
 1538: !        STOP
 1539: !    ENDIF
 1540: 
 1541: !    RB_IMT(4:6,4:6) = LR
1521: 1542: 
1522:     ! Compute the determinant (use LR to save the original values in the matrix we're inverting)1543:     ! Compute the determinant (use LR to save the original values in the matrix we're inverting)
1523:     LR(:,:) = RB_IMT(4:6,4:6)1544:     LR(:,:) = RB_IMT(4:6,4:6)
1524:     DET = LR(1,1)*(LR(2,2)*LR(3,3)-LR(2,3)*LR(3,2)) - LR(1,2)*(LR(2,1)*LR(3,3)-LR(2,3)*LR(3,1)) + &1545:     DET = LR(1,1)*(LR(2,2)*LR(3,3)-LR(2,3)*LR(3,2)) - LR(1,2)*(LR(2,1)*LR(3,3)-LR(2,3)*LR(3,1)) + &
1525:         & LR(1,3)*(LR(2,1)*LR(3,2)-LR(2,2)*LR(3,1))1546:         & LR(1,3)*(LR(2,1)*LR(3,2)-LR(2,2)*LR(3,1))
1526:     IF(ABS(DET).LT.1e-8) THEN1547:     IF(ABS(DET).LT.1e-8) THEN
1527:         WRITE(*,*) "Error: Metric Tensor is singular. At this point we ought to calculate the pseudoinverse &1548:         WRITE(*,*) "Error: Metric Tensor is singular. At this point we ought to calculate the pseudoinverse &
1528:                  & and use that instead, but it's not yet implemented."1549:                  & and use that instead, but it's not yet implemented."
1529:         STOP1550:         STOP
1530:     ENDIF1551:     ENDIF
1531: 1552: 
1532:     ! Perform the inversion (we're assuming a symmetric metric tensor but that ought to be what we have)1553:     ! Perform the inversion (we're assuming a symmetric metric tensor but that ought to be what we have)
1533:     RB_IMT(4,4) = (LR(2,2)*LR(3,3)-LR(2,3)*LR(3,2))/DET1554:     RB_IMT(4,4) = (LR(2,2)*LR(3,3)-LR(2,3)*LR(3,2))/DET
1534:     RB_IMT(4,5) = -(LR(2,1)*LR(3,3)-LR(2,3)*LR(3,1))/DET1555:     RB_IMT(4,5) = -(LR(2,1)*LR(3,3)-LR(2,3)*LR(3,1))/DET
1535:     RB_IMT(4,6) = (LR(2,1)*LR(3,2)-LR(2,2)*LR(3,1))/DET1556:     RB_IMT(4,6) = (LR(2,1)*LR(3,2)-LR(2,2)*LR(3,1))/DET
1536: 1557: 
1537:     ! Copy the previous result where possible, to save on calculations 
1538:     RB_IMT(5,4) = RB_IMT(4,5) ! = -(LR(1,2)*LR(3,3)-LR(1,3)*LR(3,2))/DET1558:     RB_IMT(5,4) = RB_IMT(4,5) ! = -(LR(1,2)*LR(3,3)-LR(1,3)*LR(3,2))/DET
1539:     RB_IMT(5,5) = (LR(1,1)*LR(3,3)-LR(1,3)*LR(3,1))/DET1559:     RB_IMT(5,5) = (LR(1,1)*LR(3,3)-LR(1,3)*LR(3,1))/DET
1540:     RB_IMT(5,6) = -(LR(1,1)*LR(3,2)-LR(1,2)*LR(3,1))/DET1560:     RB_IMT(5,6) = -(LR(1,1)*LR(3,2)-LR(1,2)*LR(3,1))/DET
1541: 1561: 
1542:     RB_IMT(6,4) = RB_IMT(4,6) ! = (LR(1,2)*LR(2,3)-LR(1,3)*LR(2,2))/DET1562:     RB_IMT(6,4) = RB_IMT(4,6) ! = (LR(1,2)*LR(2,3)-LR(1,3)*LR(2,2))/DET
1543:     RB_IMT(6,5) = RB_IMT(5,6) ! = -(LR(1,1)*LR(2,3)-LR(1,3)*LR(2,1))/DET1563:     RB_IMT(6,5) = RB_IMT(5,6) ! = -(LR(1,1)*LR(2,3)-LR(1,3)*LR(2,1))/DET
1544:     RB_IMT(6,6) = (LR(1,1)*LR(2,2)-LR(1,2)*LR(2,1))/DET1564:     RB_IMT(6,6) = (LR(1,1)*LR(2,2)-LR(1,2)*LR(2,1))/DET
1545: 1565: 
1546: !    write(*,*) "After inversion, RB_IMT for rigid body ", J11566:     write(*,*) "After inversion, RB_IMT for rigid body ", J1
1547: !    write(*,*) "UL:"1567:     write(*,*) "UL:"
1548: !    DO J3=1,31568:     DO J3=1,3
1549: !        write(*,*) RB_IMT(J3,1:3)1569:         write(*,*) RB_IMT(J3,1:3)
1550: !    ENDDO1570:     ENDDO
1551: !    write(*,*) "LR:"1571:     write(*,*) "LR:"
1552: !    DO J3=4,61572:     DO J3=4,6
1553: !        write(*,*) RB_IMT(J3,4:6)1573:         write(*,*) RB_IMT(J3,4:6)
1554: !    ENDDO1574:     ENDDO
1555: 1575: 
1556:     ! We finally have the IMT for this particular body!1576:     ! We finally have the IMT for this particular body!
1557:     ! Now put it into the whole system IMT (which is block-diagonal)1577:     ! Now put it into the whole system IMT (which is block-diagonal)
1558:     ! Translational block first1578:     ! Translational block first
1559:     INVERSE_METRIC_TENSOR(3*(J1-1)+1:3*J1,3*(J1-1)+1:3*J1) = RB_IMT(1:3,1:3)1579:     INVERSE_METRIC_TENSOR(3*(J1-1)+1:3*J1,3*(J1-1)+1:3*J1) = RB_IMT(1:3,1:3)
1560:     ! Then rotational block1580:     ! Then rotational block
1561:     INVERSE_METRIC_TENSOR(3*NRIGIDBODY+3*(J1-1)+1:3*NRIGIDBODY+3*J1,3*NRIGIDBODY+3*(J1-1)+1:3*NRIGIDBODY+3*J1) = RB_IMT(4:6,4:6)1581:     INVERSE_METRIC_TENSOR(3*NRIGIDBODY+3*(J1-1)+1:3*NRIGIDBODY+3*J1,3*NRIGIDBODY+3*(J1-1)+1:3*NRIGIDBODY+3*J1) = RB_IMT(4:6,4:6)
1562: 1582: 
1563:     ! Update the number of atoms which have already been considered1583:     ! Update the number of atoms which have already been considered
1564:     DUMMY = DUMMY + NSITEPERBODY(J1)1584:     DUMMY = DUMMY + NSITEPERBODY(J1)
1970:      MCOUNT=01990:      MCOUNT=0
1971:      DO J1=1,M1991:      DO J1=1,M
1972:         IF (ZT(J1)) MCOUNT=MCOUNT+11992:         IF (ZT(J1)) MCOUNT=MCOUNT+1
1973:      ENDDO1993:      ENDDO
1974:      OPEN(UNIT=499,FILE='nmodes.dat',STATUS='UNKNOWN')1994:      OPEN(UNIT=499,FILE='nmodes.dat',STATUS='UNKNOWN')
1975:      WRITE(499,'(I6)') MCOUNT1995:      WRITE(499,'(I6)') MCOUNT
1976:      CLOSE(499)1996:      CLOSE(499)
1977:      DO J1=1,M1997:      DO J1=1,M
1978:         IF (ZT(J1)) THEN1998:         IF (ZT(J1)) THEN
1979: ! If printing the mass weighted vectors (normal modes), convert omega^21999: ! If printing the mass weighted vectors (normal modes), convert omega^2
1980: ! into the vibrational frequency in the specified unit system using FRQCONV.2000: ! into the vibrational frequency in wavenumbers (cm^(-1)). 108.52 is the
1981: ! Normally, this will be either internal units or rad/s, for compatibility with PATHSAMPLE.2001: ! conversion factor from (kcal mol-1 kg-1 A-2)^2 to cm-1.
1982: ! Other unit systems can be specified using the FRQCONV keyword.2002:            IF (MWVECTORS .AND. (AMBERT .OR. AMBER12T .OR. CHRMMT)) THEN
1983: ! NOTE: This behaviour has changed as of 23/9/16. Until now, the frequencies were always2003:               WRITE(44,'(F20.10)') DSQRT(DIAG(J1))*108.52
1984: ! multiplied by 108.52, which is the conversion factor from kCal mol^-1 and Angstrom units 
1985: ! to cm^-1 frequencies. However, this is obviously not appropriate for all systems. If 
1986: ! you wish to retrieve the old behaviour, simply add FRQCONV 108.52 to your odata file. 
1987: ! But note that the square frequencies used for the log product in path.info will then be given 
1988: ! in units of cm^-2, rather than the default which is s^-1 for AMBER and CHARMM, internal units 
1989: ! for most other potentials. 
1990:            IF (MWVECTORS) THEN 
1991:               WRITE(44,'(F20.10)') DSQRT(DIAG(J1))*FRQCONV 
1992:            ELSE2004:            ELSE
1993:               WRITE(44,'(F20.10)') DIAG(J1)2005:               WRITE(44,'(F20.10)') DIAG(J1)
1994:            ENDIF2006:            ENDIF
1995:            WRITE(44,'(3F20.10)') (HESS(J2,J1),J2=1,N)2007:            WRITE(44,'(3F20.10)') (HESS(J2,J1),J2=1,N)
1996:         ENDIF2008:         ENDIF
1997:      ENDDO2009:      ENDDO
1998:   ELSE2010:   ELSE
1999:      DO J1=M,1,-12011:      DO J1=M,1,-1
2000:         IF (ZT(J1)) THEN2012:         IF (ZT(J1)) THEN
2001: ! As above2013: ! As above
2002:            IF (MWVECTORS) THEN2014:            IF (MWVECTORS .AND. (AMBERT .OR. AMBER12T .OR. CHRMMT)) THEN
2003:               WRITE(44,'(F20.10)') DSQRT(DIAG(J1))*FRQCONV2015:               WRITE(44,'(F20.10)') DSQRT(DIAG(J1))*108.52
2004:            ELSE2016:            ELSE
2005:               WRITE(44,'(F20.10)') DIAG(J1)2017:               WRITE(44,'(F20.10)') DIAG(J1)
2006:            ENDIF2018:            ENDIF
2007:            WRITE(44,'(3F20.10)') (HESS(J2,J1),J2=1,N)2019:            WRITE(44,'(3F20.10)') (HESS(J2,J1),J2=1,N)
2008:            CALL FLUSH(44)2020:            CALL FLUSH(44)
2009:            RETURN2021:            RETURN
2010:         ENDIF2022:         ENDIF
2011:      ENDDO2023:      ENDDO
2012:   ENDIF2024:   ENDIF
2013:   CALL FLUSH(44)2025:   CALL FLUSH(44)
2693: END SUBROUTINE EXTRACT_SUBSET2705: END SUBROUTINE EXTRACT_SUBSET
2694: ! ---------------------------------------------------------------------------------2706: ! ---------------------------------------------------------------------------------
2695: ! sn402: angle-axis distance measure for rigid body systems2707: ! sn402: angle-axis distance measure for rigid body systems
2696: SUBROUTINE RB_DISTANCE(RB_DIST, RBCOORDS1, RBCOORDS2, GRAD1, GRAD2, GRADT)2708: SUBROUTINE RB_DISTANCE(RB_DIST, RBCOORDS1, RBCOORDS2, GRAD1, GRAD2, GRADT)
2697: USE COMMONS, ONLY: NATOMS, DEBUG2709: USE COMMONS, ONLY: NATOMS, DEBUG
2698: USE KEY, ONLY: PERMDIST2710: USE KEY, ONLY: PERMDIST
2699: IMPLICIT NONE2711: IMPLICIT NONE
2700: 2712: 
2701: ! RBCOORDS1, RBCOORDS2 are angle-axis coordinates for two poses of the entire rigid-body2713: ! RBCOORDS1, RBCOORDS2 are angle-axis coordinates for two poses of the entire rigid-body
2702: ! system.2714: ! system.
2703: ! GRAD1 and GRAD2 are the gradient components of the square distance with respect to2715: ! GRAD1 and GRAD2 are the gradient components of the distance function with respect to
2704: ! the first and second sets of coordinates, respectively.2716: ! the first and second sets of coordinates, respectively.
2705: ! SQ_DIST is the square distance measure between the two poses. RB_DIST = SQRT(SQ_DIST)2717: ! SQ_DIST is the square distance measure between the two poses. RB_DIST = SQRT(SQ_DIST)
2706: ! GRADT = FALSE if we don't want to compute the distance gradient this time round.2718: ! GRADT = FALSE if we don't want to compute the distance gradient this time round.
2707: DOUBLE PRECISION, INTENT(IN) :: RBCOORDS1(DEGFREEDOMS)2719: DOUBLE PRECISION, INTENT(IN) :: RBCOORDS1(DEGFREEDOMS)
2708: DOUBLE PRECISION, INTENT(IN) :: RBCOORDS2(DEGFREEDOMS)2720: DOUBLE PRECISION, INTENT(IN) :: RBCOORDS2(DEGFREEDOMS)
2709: DOUBLE PRECISION, INTENT(OUT) :: RB_DIST2721: DOUBLE PRECISION, INTENT(OUT) :: RB_DIST
2710: DOUBLE PRECISION, INTENT(OUT) :: GRAD1(DEGFREEDOMS)2722: DOUBLE PRECISION, INTENT(OUT) :: GRAD1(DEGFREEDOMS)
2711: DOUBLE PRECISION, INTENT(OUT) :: GRAD2(DEGFREEDOMS)2723: DOUBLE PRECISION, INTENT(OUT) :: GRAD2(DEGFREEDOMS)
2712: LOGICAL, INTENT(IN) :: GRADT2724: LOGICAL, INTENT(IN) :: GRADT
2713: ! Temporary variables. The TEMPGRADs hold gradients of the distance measure with respect2725: ! Temporary variables. The TEMPGRADs hold gradients of the distance measure with respect
2788: 2800: 
2789: !IF (DEBUG) THEN2801: !IF (DEBUG) THEN
2790: !    WRITE(*, *) "GRAD1"2802: !    WRITE(*, *) "GRAD1"
2791: !    DO J9 = 1, DEGFREEDOMS2803: !    DO J9 = 1, DEGFREEDOMS
2792: !        WRITE(*, *) GRAD1(J9)2804: !        WRITE(*, *) GRAD1(J9)
2793: !    ENDDO2805: !    ENDDO
2794: !    WRITE(*, *) "GRAD2"2806: !    WRITE(*, *) "GRAD2"
2795: !    DO J9 = 1, DEGFREEDOMS2807: !    DO J9 = 1, DEGFREEDOMS
2796: !        WRITE(*, *) GRAD2(J9)2808: !        WRITE(*, *) GRAD2(J9)
2797: !    ENDDO2809: !    ENDDO
2798: !    WRITE(*, *) " RB Distance", SQ_DIST, SQRT(SQ_DIST)2810: !    WRITE(*, *) "Distance", SQ_DIST, SQRT(SQ_DIST)
2799: !ENDIF2811: !ENDIF
2800: RB_DIST = SQRT(SQ_DIST)2812: RB_DIST = SQRT(SQ_DIST)
2801: RETURN2813: RETURN
2802: 2814: 
2803: END SUBROUTINE RB_DISTANCE2815: END SUBROUTINE RB_DISTANCE
2804: 2816: 
2805: ! -----------------------------------------------------------------------------2817: ! -----------------------------------------------------------------------------
2806: 2818: 
2807: function smallest_rij(r1, r2) result(rij)2819: function smallest_rij(r1, r2) result(rij)
2808:     ! Calculate the shortest vector between two rigid-body centres of mass, with or without2820:     ! Calculate the shortest vector between two rigid-body centres of mass, with or without


r31537/geopt.f 2016-11-24 14:30:18.845935077 +0000 r31536/geopt.f 2016-11-24 14:30:21.365968535 +0000
 85:  85: 
 86:       DOUBLE PRECISION ETS,EPLUS,EMINUS 86:       DOUBLE PRECISION ETS,EPLUS,EMINUS
 87:       COMMON /OEPATH/ ETS,EPLUS,EMINUS 87:       COMMON /OEPATH/ ETS,EPLUS,EMINUS
 88:  88: 
 89: ! hk286 89: ! hk286
 90:       DOUBLE PRECISION :: XCOORDS (3*NATOMS) 90:       DOUBLE PRECISION :: XCOORDS (3*NATOMS)
 91:  91: 
 92: ! cs778 92: ! cs778
 93:       DOUBLE PRECISION :: SOVER 93:       DOUBLE PRECISION :: SOVER
 94:  94: 
 95:       INTEGER :: NSTARTHESS ! sn402 
 96:  
 97:       PROD = 0.0D0  ! Initialise here, so it can be used by every other IF block 95:       PROD = 0.0D0  ! Initialise here, so it can be used by every other IF block
 98:  96: 
 99:       INFO=0 97:       INFO=0
100:       LWORK=33*3*NATOMS 98:       LWORK=33*3*NATOMS
101:       ILWORK=33*3*NATOMS 99:       ILWORK=33*3*NATOMS
102:       IF (NENDHESS.LE.0) NENDHESS=NOPT100:       IF (NENDHESS.LE.0) NENDHESS=NOPT
103: C101: C
104: C  *************** two-ended pathways ********************102: C  *************** two-ended pathways ********************
105: C103: C
106:       TTDONE=.FALSE.104:       TTDONE=.FALSE.
966:             IF (INFO.NE.0) PRINT*,'WARNING - INFO=',INFO,' in DSYEV'964:             IF (INFO.NE.0) PRINT*,'WARNING - INFO=',INFO,' in DSYEV'
967: 965: 
968:          ENDIF   ! End of IF(.NOT. UNRST) (That was a very long block!)966:          ENDIF   ! End of IF(.NOT. UNRST) (That was a very long block!)
969: !967: !
970: ! Shift zero eigenvalues for Thomson problem. DJW968: ! Shift zero eigenvalues for Thomson problem. DJW
971: !969: !
972:          IF (GTHOMSONT) THEN970:          IF (GTHOMSONT) THEN
973:             EVALUES(2*NATOMS+1:3*NATOMS)=1.0D10971:             EVALUES(2*NATOMS+1:3*NATOMS)=1.0D10
974:             CALL EIGENSORT_VAL_ASC(EVALUES,HESS,NENDHESS,3*NATOMS)972:             CALL EIGENSORT_VAL_ASC(EVALUES,HESS,NENDHESS,3*NATOMS)
975:          ENDIF973:          ENDIF
976: 974: !
977: 975: ! The test below will not necessarily spot a stationary point of the wrong index.
978:          IF (CASTEP.OR.ONETEP) THEN976: ! We could read a zero eigenvalue that is > 0 and no error message will result.
 977: !
 978: ! sn402: Could this block be moved further down so that we have all the unit conversion stuff in the same place?
 979:          IF (DEBUG.OR.AMHT.OR.CASTEP.OR.VASP.OR.QCHEM.OR.RINGPOLYMERT.OR.ONETEP) THEN
 980: ! hk286
 981:             IF (RIGIDINIT) THEN
 982:                PRINT '(A)', ' geopt> RIGIDINIT IS ON'
 983:                PRINT '(A,I6,A)',' geopt> ',DEGFREEDOMS,' Hessian eigenvalues:'
 984:                PRINT '(6G20.10)',EVALUES(NENDHESS-DEGFREEDOMS+1:NENDHESS)
 985:             ELSEIF (RBAAT) THEN
 986:                ! sn402: need to change this here, when I've decided what I'm doing about unit conversion.
 987:                PRINT '(A,I6,A)',' geopt> ',NENDHESS,' Hessian eigenvalues in cm^-1:'
 988:                DO J1 = 1, NENDHESS
 989:                   ! sn402: this should absolutely not happen! We use EVALUES later on, and we do NOT want the behaviour to depend on whether DEBUG is set!
 990: !                  IF (EVALUES(J1) < 0.0D0) EVALUES(J1) = - EVALUES(J1)
 991:                ENDDO
 992:                ! sn402: need to sort this bit out. Use a new array to store ABS(EVALUES). Also need to decide what I'm doing with the unit conversions
 993:                PRINT '(6G20.10)', DSQRT(EVALUES(1:NENDHESS)) / 8.0D10 / ATAN(1.0D0) / 2.998D0
 994:             ELSE
 995:                PRINT '(A,I6,A)',' geopt> ',NENDHESS,' Hessian eigenvalues:'
 996:                PRINT '(6G20.10)',EVALUES(1:NENDHESS)
 997:             ENDIF
 998:             IF (CASTEP.OR.ONETEP) THEN
 999:                PRINT '(A,I6,A)',' geopt> ',NENDHESS, 
 1000:      &                          ' normal mode frequencies in Hz and wavenumbers, assuming eV and Angstrom units for input:'
 1001:                IF (ONETEP) THEN
 1002:                   PRINT '(A,I6,A)',' geopt> ',NENDHESS, 
 1003:      &             ' normal mode frequencies in Hz and wavenumbers, assuming hartree and bohr units for input:'
 1004:                   DO J1=1,NENDHESS
 1005:                      IF (EVALUES(J1).GT.0.0D0) THEN
 1006:                         PRINT '(I6,2G20.10)',J1,SQRT(EVALUES(J1)*9.3757D29)/(2*3.141592654D0), 
 1007:      &                                         SQRT(EVALUES(J1)*9.3757D29)/(2*3.141592654D0*2.998D10)
 1008:                      ELSE
 1009:                         PRINT '(I6,2(G20.10,A2))',J1,SQRT(-EVALUES(J1)*9.3757D29)/(2*3.141592654D0),' i',
 1010:      &                                      SQRT(-EVALUES(J1)*9.3757D29)/(2*3.141592654D0*2.998D10),' i'
 1011:                      ENDIF
 1012:                   ENDDO
 1013:                ELSE
 1014:                   PRINT '(A,I6,A)',' geopt> ',NENDHESS, 
 1015:      &             ' normal mode frequencies in Hz and wavenumbers, assuming eV and Angstrom units for input:'
 1016:                   DO J1=1,NENDHESS
 1017:                      IF (EVALUES(J1).GT.0.0D0) THEN
 1018:                         PRINT '(I6,2G20.10)',J1,SQRT(EVALUES(J1)*9.75586D27)/(2*3.141592654D0), 
 1019:      &                                         SQRT(EVALUES(J1)*9.75586D27)/(2*3.141592654D0*2.998D10)
 1020:                      ELSE
 1021:                         PRINT '(I6,2(G20.10,A2))',J1,SQRT(-EVALUES(J1)*9.75586D27)/(2*3.141592654D0),' i',
 1022:      &                                      SQRT(-EVALUES(J1)*9.75586D27)/(2*3.141592654D0*2.998D10),' i'
 1023:                      ENDIF
 1024:                   ENDDO
 1025:                ENDIF
 1026:            ! (Still in CASTEP/ONETEP block)
979: C1027: C
980: C  Added transformation back to Cartesian basis for Hessian eigenvectors,1028: C  Added transformation back to Cartesian basis for Hessian eigenvectors,
981: C  as in "Energy Landscapes" equation (2.51). Otherwise the eigenvector1029: C  as in "Energy Landscapes" equation (2.51). Otherwise the eigenvector
982: C  components refer to mass-weighted coordinates, not Cartesians. DJW 7/11/091030: C  components refer to mass-weighted coordinates, not Cartesians. DJW 7/11/09
983: C  The eigenvectors of the mass-weighted Hessian correspond to the A matrix1031: C  The eigenvectors of the mass-weighted Hessian correspond to the A matrix
984: C  components A_{alpha gamma} for eigenvector gamma, and these vectors1032: C  components A_{alpha gamma} for eigenvector gamma, and these vectors
985: C  are orthonormal.1033: C  are orthonormal.
986: C  Second index of HESS labels the eigenvector, first index runs over components.1034: C  Second index of HESS labels the eigenvector, first index runs over components.
987: C  The transformed eigenvectors in the Cartesian basis are not orthogonal.1035: C  The transformed eigenvectors in the Cartesian basis are not orthogonal.
988: C1036: C
989: C  The relative Cartesian displacements for mass-weighted Hessian eigenvector1037: C  The relative Cartesian displacements for mass-weighted Hessian eigenvector
990: C  gamma are A_(alpha gamma}/sqrt(m_alpha) where m_alpha is the mass of the1038: C  gamma are A_(alpha gamma}/sqrt(m_alpha) where m_alpha is the mass of the
991: C  atom with component alpha. These are also the relative displacements for1039: C  atom with component alpha. These are also the relative displacements for
992: C  atoms corresponding to motion in mode gamma.1040: C  atoms corresponding to motion in mode gamma.
993: C  To put ke of k_gamma into mode gamma choose the Cartesian velocity1041: C  To put ke of k_gamma into mode gamma choose the Cartesian velocity 
994: C  components as +/- sqrt(2k_gamma) A_{alpha gamma}/sqrt(m_alpha).1042: C  components as +/- sqrt(2k_gamma) A_{alpha gamma}/sqrt(m_alpha).
995: C1043: C
996:             DO J1=1,NATOMS ! sum over components1044:                DO J1=1,NATOMS ! sum over components
997:                AMASS=1/SQRT(ATMASS(J1))1045:                   AMASS=1/SQRT(ATMASS(J1))
998:                J3=3*J11046:                   J3=3*J1
999:                DO J2=1,3*NATOMS ! sum over eigenvectors1047:                   DO J2=1,3*NATOMS ! sum over eigenvectors
1000:                   HESS(J3-2,J2)=HESS(J3-2,J2)*AMASS1048:                      HESS(J3-2,J2)=HESS(J3-2,J2)*AMASS
1001:                   HESS(J3-1,J2)=HESS(J3-1,J2)*AMASS1049:                      HESS(J3-1,J2)=HESS(J3-1,J2)*AMASS
1002:                   HESS(J3  ,J2)=HESS(J3  ,J2)*AMASS1050:                      HESS(J3  ,J2)=HESS(J3  ,J2)*AMASS
 1051:                   ENDDO
1003:                ENDDO1052:                ENDDO
1004:             ENDDO1053:                PRINT '(A)','geopt> Normalised eigenvectors of mass-weighted Hessian have been transformed to Cartesian components'
1005:             PRINT '(A)','geopt> Normalised eigenvectors of mass-weighted Hessian have been transformed to Cartesian components' 
1006: 1054: 
1007:          ELSEIF (RINGPOLYMERT.AND.PATHT) THEN1055:             ELSEIF (RINGPOLYMERT.AND.PATHT) THEN
1008: C1056: C
1009: C  For ring polymer TS calculate the quantum instanton Im F rate constants for the forward and backward1057: C  For ring polymer TS calculate the quantum instanton Im F rate constants for the forward and backward
1010: C  processes. The RP Hessian should have been mass weighted appropriately.1058: C  processes. The RP Hessian should have been mass weighted appropriately.
1011: C  Assume mass, length and energy in atomic units, otherwise we need a conversion factor1059: C  Assume mass, length and energy in atomic units, otherwise we need a conversion factor
1012: C  for hbar. PROD already contains the ln product of positive Hessian eigenvalues.1060: C  for hbar. PROD already contains the ln product of positive Hessian eigenvalues.
1013: C  Each eigenvalue is an angular frequency squared.1061: C  Each eigenvalue is an angular frequency squared.
1014: C  We need the energies of the + amd - minima as well, so a path calculation is required.1062: C  We need the energies of the + amd - minima as well, so a path calculation is required.
1015: C1063: C
1016:             QFAC=LOG(RPIMAGES/RPBETA)1064:                QFAC=LOG(RPIMAGES/RPBETA)
1017:             IF (RPIMAGES.GT.1) THEN1065:                IF (RPIMAGES.GT.1) THEN
1018:                DUMMY=0.0D01066:                   DUMMY=0.0D0
1019:                DO J1=1,RPDOF1067:                   DO J1=1,RPDOF
1020:                   DUMMY=DUMMY+LOG(RPMASSES(J1))1068:                      DUMMY=DUMMY+LOG(RPMASSES(J1))
1021:                ENDDO1069:                   ENDDO
1022:                DUMMY=DUMMY/RPDOF ! ln of geometric mean mass for RPDOF degrees of freedom1070:                   DUMMY=DUMMY/RPDOF ! ln of geometric mean mass for RPDOF degrees of freedom
1023:                RPBN=0.0D01071:                   RPBN=0.0D0
1024:                DO J2=1,RPDOF ! images 1 and RPIMAGES1072:                   DO J2=1,RPDOF ! images 1 and RPIMAGES
1025:                   RPBN=RPBN+(Q(J2)-Q(RPDOF*(RPIMAGES-1)+J2))**21073:                      RPBN=RPBN+(Q(J2)-Q(RPDOF*(RPIMAGES-1)+J2))**2
1026:                ENDDO1074:                   ENDDO
1027:                DO J1=1,RPIMAGES-1 ! images J1 and J1+11075:                   DO J1=1,RPIMAGES-1 ! images J1 and J1+1
1028:                   DO J2=1,RPDOF1076:                      DO J2=1,RPDOF
1029:                      RPBN=RPBN+(Q(RPDOF*(J1-1)+J2)-Q(RPDOF*J1+J2))**21077:                         RPBN=RPBN+(Q(RPDOF*(J1-1)+J2)-Q(RPDOF*J1+J2))**2
 1078:                      ENDDO
1030:                   ENDDO1079:                   ENDDO
1031:                ENDDO 
1032: !1080: !
1033: !  This isn't right - the formula in section V has reciprocal factors of g1081: !  This isn't right - the formula in section V has reciprocal factors of g
1034: !  in the frequencies as well. Need to check further.1082: !  in the frequencies as well. Need to check further.
1035: !1083: !
1036:                QFAC=QFAC+(0.5D0)*DUMMY+0.5D0*LOG(RPBN*RPIMAGES/(6.283185307D0*RPBETA))1084:                   QFAC=QFAC+(0.5D0)*DUMMY+0.5D0*LOG(RPBN*RPIMAGES/(6.283185307D0*RPBETA))
1037:      &                           -0.5D0*PROD-(RPIMAGES-2)*LOG(RPBETA/RPIMAGES)1085:      &                              -0.5D0*PROD-(RPIMAGES-2)*LOG(RPBETA/RPIMAGES)
1038:             ELSE1086:                ELSE
1039:             ENDIF1087:                ENDIF
1040:             PRINT '(2(A,G20.10))',' geopt> ln(k_instanton^+ * Q^+)=',QFAC-(ETS-EPLUS)*RPBETA/RPIMAGES,' E+=',EPLUS1088:                PRINT '(2(A,G20.10))',' geopt> ln(k_instanton^+ * Q^+)=',QFAC-(ETS-EPLUS)*RPBETA/RPIMAGES,' E+=',EPLUS
1041:             PRINT '(2(A,G20.10))',' geopt> ln(k_instanton^- * Q^-)=',QFAC-(ETS-EMINUS)*RPBETA/RPIMAGES,' E-=',EMINUS1089:                PRINT '(2(A,G20.10))',' geopt> ln(k_instanton^- * Q^-)=',QFAC-(ETS-EMINUS)*RPBETA/RPIMAGES,' E-=',EMINUS
1042:          ENDIF 
1043:  
1044:          ! To avoid lots of messy IF blocks, we define the following variable to help us skip over dummy values with RIGIDINIT 
1045:          IF(RIGIDINIT) THEN 
1046:              ! This is the first entry in EVALUES which does not correspond to a dummy value 
1047:              NSTARTHESS = NENDHESS-DEGFREEDOMS+1 
1048:          ELSE 
1049:              NSTARTHESS = 1  ! No dummy values, so we start reading from the beginning 
1050:          ENDIF 
1051:  
1052:          ! Do some intermediate output printing to show the computed eigenvalues 
1053:          ! sn402: I decided not to completely remove the hard-coded unit conversions here, to avoid breaking backwards compatibility 
1054:          IF(DEBUG.OR.AMHT.OR.CASTEP.OR.VASP.OR.QCHEM.OR.RINGPOLYMERT.OR.ONETEP.OR.TTM3T.OR.SDT.OR.BOWMANT.OR.CHRMMT) THEN 
1055: ! hk286 
1056:             IF (ONETEP) THEN 
1057:                PRINT '(A,I6,A)',' geopt> Frequencies in wavenumbers, assuming hartree and bohr units for input:' 
1058:                DO J1=NSTARTHESS,NENDHESS 
1059:                   IF (EVALUES(J1).GT.0.0D0) THEN 
1060:                      PRINT '(I6,2G20.10)',J1,SQRT(EVALUES(J1)*9.3757D29)/(2*3.141592654D0), 
1061:      &                                      SQRT(EVALUES(J1)*9.3757D29)/(2*3.141592654D0*2.998D10) 
1062:                   ELSE 
1063:                      PRINT '(I6,2(G20.10,A2))',J1,SQRT(-EVALUES(J1)*9.3757D29)/(2*3.141592654D0),' i', 
1064:      &                                      SQRT(-EVALUES(J1)*9.3757D29)/(2*3.141592654D0*2.998D10),' i' 
1065:                   ENDIF 
1066:                ENDDO 
1067:             ELSEIF (CASTEP) THEN 
1068:                PRINT '(A,I6,A)',' geopt> ',NENDHESS, 
1069:      &          ' normal mode frequencies in Hz and wavenumbers, assuming eV and Angstrom units for input:' 
1070:                DO J1=NSTARTHESS,NENDHESS 
1071:                   IF (EVALUES(J1).GT.0.0D0) THEN 
1072:                      PRINT '(I6,2G20.10)',J1,SQRT(EVALUES(J1)*9.75586D27)/(2*3.141592654D0), 
1073:      &                                      SQRT(EVALUES(J1)*9.75586D27)/(2*3.141592654D0*2.998D10) 
1074:                   ELSE 
1075:                      PRINT '(I6,2(G20.10,A2))',J1,SQRT(-EVALUES(J1)*9.75586D27)/(2*3.141592654D0),' i', 
1076:      &                                   SQRT(-EVALUES(J1)*9.75586D27)/(2*3.141592654D0*2.998D10),' i' 
1077:                   ENDIF 
1078:                ENDDO 
1079:             ELSEIF (CHRMMT) THEN 
1080:                PRINT '(A,I6,A)',' geopt> ',3*NATOMS,' normal mode frequencies in Hz and wavenumbers' 
1081:                DO J1=NSTARTHESS,3*NATOMS 
1082:                   IF (EVALUES(J1).GT.0.0D0) THEN 
1083:                      PRINT '(I6,2G20.10E3)',J1,SQRT(EVALUES(J1)*4.184D26)/(2*3.141592654D0), 
1084:      &                 SQRT(EVALUES(J1)*4.184D26)/(2*3.141592654D0*2.998D10) 
1085:                   ELSE 
1086:                      PRINT '(I6,2(G20.10,A2))',J1,SQRT(-EVALUES(J1)*4.184D26)/(2*3.141592654D0),' i', 
1087:      &                 SQRT(-EVALUES(J1)*4.184D26)/(2*3.141592654D0*2.998D10),' i' 
1088:                   ENDIF 
1089:                ENDDO 
1090:             ELSEIF (TTM3T.OR.SDT) THEN 
1091: ! hk286 
1092:                PRINT '(A,I6,A)',' geopt> ',NENDHESS-NSTARTHESS + 1, ' normal mode frequencies in Hz and wavenumbers' 
1093:                DO J1=NSTARTHESS,NENDHESS 
1094:                   IF (EVALUES(J1).GT.0.0D0) THEN 
1095:                      PRINT '(I6,2G20.10E3)',J1,SQRT(EVALUES(J1)*4.184D26)/(2*3.141592654D0), 
1096:      &                       SQRT(EVALUES(J1)*4.184D26)/(2*3.141592654D0*2.998D10) 
1097:                   ELSE 
1098:                      PRINT '(I6,2(G20.10,A2))',J1,SQRT(-EVALUES(J1)*4.184D26)/(2*3.141592654D0),' i', 
1099:      &                       SQRT(-EVALUES(J1)*4.184D26)/(2*3.141592654D0*2.998D10),' i' 
1100:                   ENDIF 
1101:                ENDDO 
1102:             ELSEIF (BOWMANT) THEN 
1103:                ! sn402: not sure whether the Bowman potential is supposed to be compatible with genrigid 
1104:                ! I've changed the array indices so that this bit of code is compatible. 
1105:                PRINT '(A,I6,A)',' geopt> ',NENDHESS-NSTARTHESS+1, ' normal mode frequencies in Hz and wavenumbers' 
1106:                DO J1=NSTARTHESS,NENDHESS 
1107:                   IF (EVALUES(J1).GT.0.0D0) THEN 
1108:                      PRINT '(I6,2G20.10)',J1,SQRT(EVALUES(J1)*2625.47D26)/(2*3.141592654D0), 
1109:      &                    SQRT(EVALUES(J1)*2625.47D26)/(2*3.141592654D0*2.998D10) 
1110:                   ELSE 
1111:                      PRINT '(I6,2(G20.10,A2))',J1,SQRT(-EVALUES(J1)*2625.47D26)/(2*3.141592654D0),' i', 
1112:      &                    SQRT(-EVALUES(J1)*2625.47D26)/(2*3.141592654D0*2.998D10),' i' 
1113:                   ENDIF 
1114:                ENDDO 
1115:             ELSE 
1116:                PRINT '(A,I6,A)',' geopt> ',(NENDHESS-NSTARTHESS+1),' Hessian eigenvalues:' 
1117:                PRINT '(6G20.10)',EVALUES(NSTARTHESS:NENDHESS) 
1118:                PRINT '(A,I6,A)',' geopt> Frequencies in specified units:' 
1119:                PRINT '(6G20.10)',DSQRT(ABS(EVALUES(NSTARTHESS:NENDHESS)))*FRQCONV 
1120:             ENDIF1090:             ENDIF
1121:          ENDIF  ! DEBUG block1091:          ENDIF ! End of IF(DEBUG.OR. systems)
1122:  
1123: 1092: 
1124:          ! ZT and LZT determines which normal mode frequencies will be printed out. Generally, this means identifying the1093:          ! ZT and LZT determines which normal mode frequencies will be printed out. Generally, this means identifying the
1125:          ! zero eigenvalues, which will be at the front (or perhaps the end) of the eigenvalue vector.1094:          ! zero eigenvalues, which will be at the front (or perhaps the end) of the eigenvalue vector.
1126:          ! In this case, all the normal modes are set to print - but this conflicts with the documentation which suggests1095:          ! In this case, all the normal modes are set to print - but this conflicts with the documentation which suggests
1127:          ! that only non-zero eigenvalues should be printed.1096:          ! that only non-zero eigenvalues should be printed.
1128:          LZT(1:NOPT)=.TRUE.1097:          LZT(1:NOPT)=.TRUE.
1129:          ! sn402: Adding this bit to make the behaviour match that described in the documentation.1098:          ! sn402: Adding this bit to make the behaviour match that described in the documentation.
1130:          DO J1=1,NOPT1099:          DO J1=1,NOPT
1131:             IF (ABS(EVALUES(J1)).LT.EVCUT) LZT(J1)=.FALSE. ! EVCUT determines the minimum magnitude for a non-zero eigenvalue1100:             IF (ABS(EVALUES(J1)).LT.EVCUT) LZT(J1)=.FALSE. ! EVCUT determines the minimum magnitude for a non-zero eigenvalue
1132:          ENDDO1101:          ENDDO
1153:                CALL GENRIGID_VDUMP(EVALUES,LZT,NOPT,NOPT)1122:                CALL GENRIGID_VDUMP(EVALUES,LZT,NOPT,NOPT)
1154:             ELSE1123:             ELSE
1155:                CALL VDUMP(EVALUES,LZT,NOPT,3*NATOMS)1124:                CALL VDUMP(EVALUES,LZT,NOPT,3*NATOMS)
1156:             ENDIF1125:             ENDIF
1157:          ENDIF1126:          ENDIF
1158:          PROD=0.0D01127:          PROD=0.0D0
1159: 1128: 
1160: ! Now we calculate the log product of positive frequencies, which will be written to min.data.info. This must be done regardless of whether we are dumping eigenvectors.1129: ! Now we calculate the log product of positive frequencies, which will be written to min.data.info. This must be done regardless of whether we are dumping eigenvectors.
1161: ! Unit conversions are added to the product in a separate block - see below. At the moment, the eigenvalues should be in internal units.1130: ! Unit conversions are added to the product in a separate block - see below. At the moment, the eigenvalues should be in internal units.
1162: ! hk2861131: ! hk286
1163:          ! MINFRQ2 is the (log of the) smallest positive hessian eigenvalue (i.e. smallest square frequency)1132:          IF (RIGIDINIT) THEN
1164:          IF (NENDHESS-NEXMODES.GT.0) THEN1133:             ! Note, there is no separate IF(RBAAT) block here, because there are no dummy eigenvalues in that case.
1165:             MINFRQ2=LOG(EVALUES(NENDHESS-NEXMODES))1134:             ! MINFRQ2 is the (log of the) smallest positive hessian eigenvalue (i.e. smallest square frequency)
1166:          ELSE1135:             IF (NENDHESS-NEXMODES.GT.0) THEN
1167:             ! Dummy value, if there are no positive eigenvalues.1136:                MINFRQ2=LOG(EVALUES(NENDHESS-NEXMODES))
1168:             MINFRQ2=1.0D01137:             ELSE
1169:          ENDIF1138:                ! Dummy value, if there are no positive eigenvalues.
1170:          EWARN=.FALSE.1139:                MINFRQ2=1.0D0
1171: 1140:             ENDIF
1172:          DO I1=NSTARTHESS,NENDHESS-NEXMODES1141:             EWARN=.FALSE.
1173:             IF (I1.GT.NSTARTHESS) THEN1142:             ! This slightly awkward index choice arises because the first block of EVALUES now contains dummy values set to 10^10
1174:                IF (EVALUES(I1-1).NE.0.0D0) THEN1143:             ! and the real eigenvalues are then listed in descending order.
1175:                   IF (ABS(EVALUES(I1)/EVALUES(I1-1)).LT.1.0D-3) THEN1144:             DO I1=NENDHESS-DEGFREEDOMS+1,NENDHESS-NEXMODES
1176:                      PRINT '(A,G20.10,A,G20.10)',' geopt> WARNING - decrease in magnitude of eigenvalues from ',EVALUES(I1-1),1145:                IF (I1.GT.NENDHESS-DEGFREEDOMS+1) THEN
1177:      &                    ' to ',EVALUES(I1)1146:                   IF (EVALUES(I1-1).NE.0.0D0) THEN
1178:                      PRINT '(A)',' geopt> WARNING - this could indicate a stationary point of the wrong index'1147:                      IF (ABS(EVALUES(I1)/EVALUES(I1-1)).LT.1.0D-2) THEN
1179:                      EWARN=.TRUE.1148:                         PRINT '(A,G20.10,A,G20.10)',' geopt> WARNING - decrease in magnitude of eigenvalues from ',EVALUES(I1-1),
 1149:      &                       ' to ',EVALUES(I1)
 1150:                         PRINT '(A)',' geopt> WARNING - this could indicate a stationary point of the wrong index'
 1151:                         EWARN=.TRUE.
 1152:                      ENDIF
1180:                   ENDIF1153:                   ENDIF
1181:                ENDIF1154:                ENDIF
1182:             ENDIF1155:                ! Calculate the actual log product here!
1183:             ! Calculate the actual log product here!1156:                IF (EVALUES(I1).GT.0.0D0) THEN
1184:             IF (EVALUES(I1).GT.0.0D0) THEN1157:                   PROD=PROD+DLOG(EVALUES(I1))
1185:                PROD=PROD+DLOG(EVALUES(I1))1158:                ELSE
 1159:                   IF (I1.LT.(NENDHESS-NEXMODES)) PRINT *,'Higher order saddle detected: eigenvalue ',EVALUES(I1)
 1160:                   ! jmc put in this test mainly for pathsample purposes...
 1161:                ENDIF 
 1162:             ENDDO
 1163:          ELSE
 1164:             IF (NENDHESS-NEXMODES.GT.0) THEN
 1165:                MINFRQ2=LOG(EVALUES(NENDHESS-NEXMODES))
1186:             ELSE1166:             ELSE
1187:                IF (I1.LT.(NENDHESS-NEXMODES)) PRINT *,'Higher order saddle detected: eigenvalue ',EVALUES(I1)1167:                MINFRQ2=1.0D0
 1168:             ENDIF
 1169:             EWARN=.FALSE.
 1170:             DO I1=1,NENDHESS - NEXMODES
 1171:                IF (I1.GT.1) THEN
 1172:                   IF (EVALUES(I1-1).NE.0.0D0) THEN
 1173:                      IF (ABS(EVALUES(I1)/EVALUES(I1-1)).LT.1.0D-3) THEN
 1174:                         PRINT '(A,G20.10,A,G20.10)',' geopt> WARNING - decrease in magnitude of eigenvalues from ',EVALUES(I1-1),
 1175:      &                       ' to ',EVALUES(I1)
 1176:                         PRINT '(A)',' geopt> WARNING - this could indicate a stationary point of the wrong index'
 1177:                         EWARN=.TRUE.
 1178:                      ENDIF
 1179:                   ENDIF
 1180:                ENDIF
 1181:                IF (EVALUES(I1).GT.0.0D0) THEN
 1182:                   PROD=PROD+DLOG(EVALUES(I1))
 1183:                ELSE
 1184:                   IF (I1.LT.(NENDHESS-NEXMODES)) PRINT *,'Higher order saddle detected: eigenvalue ',EVALUES(I1)
1188:                ! jmc put in this test mainly for pathsample purposes...1185:                ! jmc put in this test mainly for pathsample purposes...
 1186:                ENDIF 
 1187:             ENDDO
 1188:             IF (DEBUG.AND.CHRMMT) THEN
 1189:                PRINT '(A,I6,A)',' geopt> ',3*NATOMS,' normal mode frequencies in Hz and wavenumbers'
 1190:                DO J1=1,3*NATOMS
 1191:                   IF (EVALUES(J1).GT.0.0D0) THEN
 1192:                      PRINT '(I6,2G20.10E3)',J1,SQRT(EVALUES(J1)*4.184D26)/(2*3.141592654D0),
 1193:      &                 SQRT(EVALUES(J1)*4.184D26)/(2*3.141592654D0*2.998D10)
 1194:                   ELSE
 1195:                      PRINT '(I6,2(G20.10,A2))',J1,SQRT(-EVALUES(J1)*4.184D26)/(2*3.141592654D0),' i',
 1196:      &                 SQRT(-EVALUES(J1)*4.184D26)/(2*3.141592654D0*2.998D10),' i'
 1197:                   ENDIF
 1198:                ENDDO
1189:             ENDIF1199:             ENDIF
1190:          ENDDO1200:          ENDIF
1191: 1201: 
1192: ! Applying a unit conversion to PROD for the potentials which need it. Remember that PROD is a sum of logs, so multiplying1202: ! Applying a unit conversion to PROD for the potentials which need it. Remember that PROD is a sum of logs, so multiplying
1193: ! the frequencies by a conversion factor is the same as adding the conversion factor to the sum (which is what we do here).1203: ! the frequencies by a conversion factor is the same as adding the conversion factor to the sum (which is what we do here).
1194: ! NB: FRQCONV is defined as the conversion factor to go from internal units to SI (or another unit system) for the frequencies,1204:          IF (CHRMMT.OR.AMBERT.OR.NABT.OR.AMBER12T.OR.SDT.OR.TTM3T.OR.QTIP4PFT) THEN
1195: ! not the square frequencies. However, PROD contains a log of squared frequencies. So we need to square FRQCONV (i.e. double its log)1205: C
1196:          IF (FRQCONV.NE.1.0D0) THEN1206: C if charmm need to convert this to (radian/s)^2, rather than charmm units
1197: 1207: C conversion factor for this is 4.184 x 10^26
1198:             MINFRQ2=MINFRQ2+LOG(FRQCONV)*21208: C same for AMBER
 1209: C
 1210:             MINFRQ2=MINFRQ2+LOG(4.184D26)
1199: ! hk2861211: ! hk286
1200:             IF (RIGIDINIT) THEN1212:             IF (RIGIDINIT) THEN
1201:                PROD=PROD+(DEGFREEDOMS-NEXMODES)*DLOG(FRQCONV)*21213:                PROD=PROD+(DEGFREEDOMS-NEXMODES)*DLOG(4.184D26)
1202:                WRITE (*,'(A,G20.10)') ' geopt> ln product scaled to desired frequency units by ',1214:                WRITE (*,'(A,G20.10)') ' geopt> ln product scaled to SI units (radian/s)^2 by ',(DEGFREEDOMS-NEXMODES)*DLOG(4.184D26)
1203:      &                                (DEGFREEDOMS-NEXMODES)*DLOG(FRQCONV)*2 
1204:             ELSE1215:             ELSE
1205:                PROD=PROD+(3*NATOMS-NEXMODES)*DLOG(FRQCONV)*21216:                PROD=PROD+(3*NATOMS-NEXMODES)*DLOG(4.184D26)
1206:                WRITE (*,'(A,G20.10)') ' geopt> ln product scaled to desired frequency units by ',(3*NATOMS-NEXMODES)*DLOG(FRQCONV)*21217:                WRITE (*,'(A,G20.10)') ' geopt> ln product scaled to SI units (radian/s)^2 by ',(3*NATOMS-NEXMODES)*DLOG(4.184D26)
1207:             ENDIF1218:             ENDIF
1208: 1219:             IF (TTM3T.OR.SDT.OR.DEBUG) THEN
 1220: ! hk286
 1221:                IF (RIGIDINIT) THEN
 1222:                   PRINT '(A,I6,A)',' geopt> ',NENDHESS - (3*NATOMS-DEGFREEDOMS),
 1223:      &                 ' normal mode frequencies in Hz and wavenumbers'
 1224:                   DO J1=NENDHESS-DEGFREEDOMS+1,NENDHESS
 1225:                      IF (EVALUES(J1).GT.0.0D0) THEN
 1226:                         PRINT '(I6,2G20.10E3)',J1,SQRT(EVALUES(J1)*4.184D26)/(2*3.141592654D0),
 1227:      &                       SQRT(EVALUES(J1)*4.184D26)/(2*3.141592654D0*2.998D10)
 1228:                      ELSE
 1229:                         PRINT '(I6,2(G20.10,A2))',J1,SQRT(-EVALUES(J1)*4.184D26)/(2*3.141592654D0),' i',
 1230:      &                       SQRT(-EVALUES(J1)*4.184D26)/(2*3.141592654D0*2.998D10),' i'
 1231:                      ENDIF
 1232:                   ENDDO
 1233:                ELSE
 1234:                   PRINT '(A,I6,A)',' geopt> ',NENDHESS,
 1235:      &                 ' normal mode frequencies in Hz and wavenumbers'
 1236:                   DO J1=1,NENDHESS
 1237:                      IF (EVALUES(J1).GT.0.0D0) THEN
 1238:                         PRINT '(I6,2G20.10E3)',J1,SQRT(EVALUES(J1)*4.184D26)/(2*3.141592654D0),
 1239:      &                       SQRT(EVALUES(J1)*4.184D26)/(2*3.141592654D0*2.998D10)
 1240:                      ELSE
 1241:                         PRINT '(I6,2(G20.10,A2))',J1,SQRT(-EVALUES(J1)*4.184D26)/(2*3.141592654D0),' i',
 1242:      &                       SQRT(-EVALUES(J1)*4.184D26)/(2*3.141592654D0*2.998D10),' i'
 1243:                      ENDIF
 1244:                   ENDDO
 1245:                ENDIF
 1246:             ENDIF
 1247:          ENDIF
 1248:          IF (BOWMANT) THEN
 1249: C
 1250: C If Bowman need to convert this to (radian/s)^2
 1251: C conversion factor for this is 2625.47 x 10^26
 1252: C
 1253:             MINFRQ2=MINFRQ2+LOG(2625.47D26)
 1254:             PROD=PROD+(3*NATOMS-NEXMODES)*DLOG(2625.47D26)
 1255:             WRITE (*,'(A,G20.10)') ' geopt> ln product scaled to SI units (radian/s)^2 by ',(3*NATOMS-NEXMODES)*DLOG(2625.47D26)
 1256:             PRINT '(A,I6,A)',' geopt> ',NENDHESS,
 1257:      &           ' normal mode frequencies in Hz and wavenumbers'
 1258:             DO J1=1,NENDHESS
 1259:                IF (EVALUES(J1).GT.0.0D0) THEN
 1260:                   PRINT '(I6,2G20.10)',J1,SQRT(EVALUES(J1)*2625.47D26)/(2*3.141592654D0),
 1261:      &                 SQRT(EVALUES(J1)*2625.47D26)/(2*3.141592654D0*2.998D10)
 1262:                ELSE
 1263:                   PRINT '(I6,2(G20.10,A2))',J1,SQRT(-EVALUES(J1)*2625.47D26)/(2*3.141592654D0),' i',
 1264:      &                 SQRT(-EVALUES(J1)*2625.47D26)/(2*3.141592654D0*2.998D10),' i'
 1265:                ENDIF
 1266:             ENDDO
1209:          ENDIF1267:          ENDIF
1210: 1268: 
1211: ! hk2861269: ! hk286
1212:          IF (RIGIDINIT) THEN1270:          IF (RIGIDINIT) THEN
1213:             IF (NENDHESS-NEXMODES.GT.0) WRITE(*,'(A,I8,A,F20.10)') ' geopt> Log product of ',NENDHESS-NEXMODES-3*NATOMS+DEGFREEDOMS,1271:             IF (NENDHESS-NEXMODES.GT.0) WRITE(*,'(A,I8,A,F20.10)') ' geopt> Log product of ',NENDHESS-NEXMODES-3*NATOMS+DEGFREEDOMS,
1214:      &           ' positive Hessian eigenvalues=',PROD1272:      &           ' positive Hessian eigenvalues=',PROD
 1273:             !kr366> dumps frqs into dump.frqs, used with GETMINFRQS keyword from PATHSAMPLE
 1274:             IF (DUMPFRQST) THEN
 1275:                 IF (FILTH.EQ.0) THEN
 1276:                    OPEN(91220,FILE='frqs.dump',POSITION='APPEND',ACTION='WRITE',STATUS='UNKNOWN')
 1277:                 ELSE
 1278:                    OPEN(91220,FILE='frqs.dump.'//TRIM(ADJUSTL(FILTHSTR)),POSITION='APPEND',ACTION='WRITE',STATUS='UNKNOWN')
 1279:                 END IF
 1280:                 WRITE(91220,*)  PROD
 1281:                 CLOSE(91220)
 1282:             ENDIF
1215:          ELSE1283:          ELSE
1216:             IF (NENDHESS-NEXMODES.GT.0) WRITE(*,'(A,I8,A,F20.10)') ' geopt> Log product of ',NENDHESS-NEXMODES,1284:             IF (NENDHESS-NEXMODES.GT.0) WRITE(*,'(A,I8,A,F20.10)') ' geopt> Log product of ',NENDHESS-NEXMODES,
1217:      &           ' positive Hessian eigenvalues=',PROD1285:      &           ' positive Hessian eigenvalues=',PROD
1218:          ENDIF1286:             !kr366> dumps frqs into dump.frqs, used with GETMINFRQS keyword from PATHSAMPLE
1219: 1287:             IF (DUMPFRQST) THEN
1220:          !kr366> dumps frqs into dump.frqs, used with GETMINFRQS keyword from PATHSAMPLE1288:                 IF (FILTH.EQ.0) THEN
1221:          IF (DUMPFRQST) THEN1289:                    OPEN(91220,FILE='frqs.dump',POSITION='APPEND',ACTION='WRITE',STATUS='UNKNOWN')
1222:              IF (FILTH.EQ.0) THEN1290:                 ELSE
1223:                 OPEN(91220,FILE='frqs.dump',POSITION='APPEND',ACTION='WRITE',STATUS='UNKNOWN')1291:                    OPEN(91220,FILE='frqs.dump.'//TRIM(ADJUSTL(FILTHSTR)),POSITION='APPEND',ACTION='WRITE',STATUS='UNKNOWN')
1224:              ELSE1292:                 END IF
1225:                 OPEN(91220,FILE='frqs.dump.'//TRIM(ADJUSTL(FILTHSTR)),POSITION='APPEND',ACTION='WRITE',STATUS='UNKNOWN')1293:                 WRITE(91220,*)  PROD
1226:              END IF1294:                 CLOSE(91220)
1227:              WRITE(91220,*)  PROD1295:             ENDIF
1228:              CLOSE(91220) 
1229:          ENDIF1296:          ENDIF
1230: 1297: 
1231:       ENDIF  ! End of IF(ENDHESS .AND. ...) (This block contains most of the subroutine, at the time of writing)1298:       ENDIF  ! End of IF(ENDHESS .AND. ...) (This block contains most of the subroutine, at the time of writing)
1232: 1299: 
1233:       IF (CHRMMT.AND.CALCDIHE) THEN1300:       IF (CHRMMT.AND.CALCDIHE) THEN
1234:          STOP 'Necessary CHARMM routines not implemented yet for NSEG>1'1301:          STOP 'Necessary CHARMM routines not implemented yet for NSEG>1'
1235: C         LSELECT=.FALSE.1302: C         LSELECT=.FALSE.
1236: C         CALL CHCALCRGYR(RGYR,Q,LSELECT)1303: C         CALL CHCALCRGYR(RGYR,Q,LSELECT)
1237: C         LNATIVE=.FALSE.1304: C         LNATIVE=.FALSE.
1238: C         CALL CHCALCNUMHB(NUMHB,Q,LNATIVE)1305: C         CALL CHCALCNUMHB(NUMHB,Q,LNATIVE)
1464: !1531: !
1465: !           OPEN(UNIT=100,FILE='min.data.info',STATUS='UNKNOWN')1532: !           OPEN(UNIT=100,FILE='min.data.info',STATUS='UNKNOWN')
1466:             ! sn402: need Cartesian coords to calculate the inertia tensor1533:             ! sn402: need Cartesian coords to calculate the inertia tensor
1467:             IF (RIGIDINIT .AND. (ATOMRIGIDCOORDT .EQV. .FALSE.)) THEN1534:             IF (RIGIDINIT .AND. (ATOMRIGIDCOORDT .EQV. .FALSE.)) THEN
1468:               CALL TRANSFORMRIGIDTOC(1, NRIGIDBODY, DUMQ, Q(1:DEGFREEDOMS))1535:               CALL TRANSFORMRIGIDTOC(1, NRIGIDBODY, DUMQ, Q(1:DEGFREEDOMS))
1469:             ENDIF1536:             ENDIF
1470:             IF (BHINTERPT.AND.(.NOT.REOPTIMISEENDPOINTS)) ENERGY=BHENERGY1537:             IF (BHINTERPT.AND.(.NOT.REOPTIMISEENDPOINTS)) ENERGY=BHENERGY
1471:             IF (BISECTT.AND.(.NOT.REOPTIMISEENDPOINTS)) ENERGY=BISECTENERGY1538:             IF (BISECTT.AND.(.NOT.REOPTIMISEENDPOINTS)) ENERGY=BISECTENERGY
1472:             IF (LOWESTFRQT) THEN1539:             IF (LOWESTFRQT) THEN
1473:                IF (CHRMMT.OR.UNRST.OR.AMBERT.OR.NABT.OR.AMBER12T) THEN1540:                IF (CHRMMT.OR.UNRST.OR.AMBERT.OR.NABT.OR.AMBER12T) THEN
1474:                   ! NOTE: PROD is a log product of square frequencies in the square of the units defined by FRQCONV. 
1475:                   WRITE(881,'(2F20.10,I6,5F20.10)') ENERGY,PROD,HORDER,ITX,ITY,ITZ,MINCURVE,MINFRQ21541:                   WRITE(881,'(2F20.10,I6,5F20.10)') ENERGY,PROD,HORDER,ITX,ITY,ITZ,MINCURVE,MINFRQ2
1476:                ELSE1542:                ELSE
1477:                   CALL INERTIA2(Q,ITX,ITY,ITZ)1543:                   CALL INERTIA2(Q,ITX,ITY,ITZ)
1478:                   ! NOTE: PROD is a log product of square frequencies in the square of the units defined by FRQCONV. 
1479:                   WRITE(881,'(2F20.10,I6,5F20.10)') ENERGY,PROD,HORDER,ITX,ITY,ITZ,MINCURVE,MINFRQ21544:                   WRITE(881,'(2F20.10,I6,5F20.10)') ENERGY,PROD,HORDER,ITX,ITY,ITZ,MINCURVE,MINFRQ2
1480:                ENDIF1545:                ENDIF
1481:             ELSE   1546:             ELSE   
1482:                IF (CHRMMT.OR.UNRST.OR.AMBERT.OR.NABT.OR.AMBER12T) THEN1547:                IF (CHRMMT.OR.UNRST.OR.AMBERT.OR.NABT.OR.AMBER12T) THEN
1483:                   ! NOTE: PROD is a log product of square frequencies in the square of the unit defined by FRQCONV. 
1484:                   ! The default is SI units (s^-2) in this case. 
1485:                   WRITE(881,'(2F20.10,I6,4F20.10)') ENERGY,PROD,HORDER,ITX,ITY,ITZ1548:                   WRITE(881,'(2F20.10,I6,4F20.10)') ENERGY,PROD,HORDER,ITX,ITY,ITZ
1486:                ELSE1549:                ELSE
1487:                   IF(RIGIDINIT .AND. (ATOMRIGIDCOORDT .EQV. .FALSE.)) THEN1550:                   IF(RIGIDINIT .AND. (ATOMRIGIDCOORDT .EQV. .FALSE.)) THEN
1488:                       CALL INERTIA2(DUMQ,ITX,ITY,ITZ)1551:                       CALL INERTIA2(DUMQ,ITX,ITY,ITZ)
1489:                   ELSE IF (GTHOMSONT) THEN1552:                   ELSE IF (GTHOMSONT) THEN
1490:                      CALL GTHOMSONANGTOC(TMPC(1:3*NATOMS), Q(1:3*NATOMS), NATOMS)1553:                      CALL GTHOMSONANGTOC(TMPC(1:3*NATOMS), Q(1:3*NATOMS), NATOMS)
1491:                      CALL INERTIA2(TMPC,ITX,ITY,ITZ)1554:                      CALL INERTIA2(TMPC,ITX,ITY,ITZ)
1492:                   ENDIF1555:                   ENDIF
1493: 1556: 
1494:                   ! Write the header line to min.data.info. PROD should be 1 if NOFRQS is set, or a positive real value1557:                   ! Write the header line to min.data.info. PROD should be 1 if NOFRQS is set, or a positive real value
1495:                   ! if ENDHESS is set. If neither of these is set, PROD is probably undefined (for some reason we don't1558:                   ! if ENDHESS is set. If neither of these is set, PROD is probably undefined (for some reason we don't
1496:                   ! calculate it in the MFLAG section - I'll look into adding it) -sn4021559:                   ! calculate it in the MFLAG section - I'll look into adding it) -sn402
1497:                   ! If we do have ENDHESS and not NOFRQS, PROD is a log product of square frequencies in the square of 
1498:                   ! the unit defined by FRQCONV. 
1499:                   WRITE(881,'(2F20.10,I6,4F20.10)') ENERGY,PROD,HORDER,ITX,ITY,ITZ1560:                   WRITE(881,'(2F20.10,I6,4F20.10)') ENERGY,PROD,HORDER,ITX,ITY,ITZ
1500:                ENDIF1561:                ENDIF
1501:             ENDIF1562:             ENDIF
1502:             NRES=NMRES1563:             NRES=NMRES
1503: 1564: 
1504:             IF (AMHT) THEN1565:             IF (AMHT) THEN
1505:                GLY_COUNT = 01566:                GLY_COUNT = 0
1506:                SDUMMY='AM'1567:                SDUMMY='AM'
1507:                DO J2=1,NRES1568:                DO J2=1,NRES
1508:                  IF (SEQ(J2).EQ.8) THEN1569:                  IF (SEQ(J2).EQ.8) THEN


r31537/key.f90 2016-11-24 14:30:19.153939166 +0000 r31536/key.f90 2016-11-24 14:30:21.909976194 +0000
100:      &        NEBRESEEDDEL2, INTCONSTRAINTTOL, INTCONSTRAINTDEL, RBCUTOFF, INTCONSTRAINTREP, INTCONSTRAINREPCUT, &100:      &        NEBRESEEDDEL2, INTCONSTRAINTTOL, INTCONSTRAINTDEL, RBCUTOFF, INTCONSTRAINTREP, INTCONSTRAINREPCUT, &
101:      &        REDOK, REDOFRAC, D1INIT, D2INIT, REDOE1, REDOE2, RPBETA, REPCON, PFORCE, &101:      &        REDOK, REDOFRAC, D1INIT, D2INIT, REDOE1, REDOE2, RPBETA, REPCON, PFORCE, &
102:      &        CPCONSTRAINTTOL, CPCONSTRAINTDEL, CPCONSTRAINTREP, CPCONSTRAINREPCUT, CPCONFRAC, &102:      &        CPCONSTRAINTTOL, CPCONSTRAINTDEL, CPCONSTRAINTREP, CPCONSTRAINREPCUT, CPCONFRAC, &
103:      &        INTLJTOL, INTLJDEL, INTLJEPS, IMSEPMIN, IMSEPMAX, TRAPK, MINOVERLAP, &103:      &        INTLJTOL, INTLJDEL, INTLJEPS, IMSEPMIN, IMSEPMAX, TRAPK, MINOVERLAP, &
104:      &        INTFREEZETOL, LOCALPERMCUT, LOCALPERMCUT2, LOCALPERMCUTINC, CHECKREPCUTOFF, CONCUTABS, &104:      &        INTFREEZETOL, LOCALPERMCUT, LOCALPERMCUT2, LOCALPERMCUTINC, CHECKREPCUTOFF, CONCUTABS, &
105:      &        CONCUTFRAC, ENDNUMHESSDELTA, DNEBEFRAC, QCHEMSCALE, KAA, SIGMAAA, QUIPATOMMASS, TEMPERATURE1, &105:      &        CONCUTFRAC, ENDNUMHESSDELTA, DNEBEFRAC, QCHEMSCALE, KAA, SIGMAAA, QUIPATOMMASS, TEMPERATURE1, &
106:      &        DISTORTINST,DELTAINST,MOLPROSCALE,COVER,STTSRMSCONV,LAN_DIST,LANCONV,LANFACTOR, &106:      &        DISTORTINST,DELTAINST,MOLPROSCALE,COVER,STTSRMSCONV,LAN_DIST,LANCONV,LANFACTOR, &
107:      &        STOCKEXP, JPARAM, MCPATHTEMP, MCPATHDMAX, MCPATHSTEP, MCPATHACCRATIO, BIASFAC, &107:      &        STOCKEXP, JPARAM, MCPATHTEMP, MCPATHDMAX, MCPATHSTEP, MCPATHACCRATIO, BIASFAC, &
108:      &        MCADDDEV, MCPATHQMIN, MCPATHQMAX, RPHQMIN, RPHQMAX, RPHTEMP, TWISTF, TWISTREF, MCPATHADDREF, &108:      &        MCADDDEV, MCPATHQMIN, MCPATHQMAX, RPHQMIN, RPHQMAX, RPHTEMP, TWISTF, TWISTREF, MCPATHADDREF, &
109:      &        MCPATHGWS, MCPATHGWQ, MCPATHNEGLECT, MCPATHTOL, FRAMESDIFF,TMRATIO, INTMINFAC, MLPLAMBDA, COLL_TOL, KLIM, SCA, &109:      &        MCPATHGWS, MCPATHGWQ, MCPATHNEGLECT, MCPATHTOL, FRAMESDIFF,TMRATIO, INTMINFAC, MLPLAMBDA, COLL_TOL, KLIM, SCA, &
110:      &        NEBMAXERISE, GDSQ, FLATEDIFF, QCIADDREPCUT, QCIADDREPEPS, QCIRADSHIFT, INTCONCUT, MLQLAMBDA, FRQCONV, FRQCONV2110:      &        NEBMAXERISE, GDSQ, FLATEDIFF, QCIADDREPCUT, QCIADDREPEPS, QCIRADSHIFT, INTCONCUT, MLQLAMBDA
111: 111: 
112: !     sf344112: !     sf344
113:       DOUBLE PRECISION :: PCUTOFF,PYA11(3),PYA21(3),PYA12(3),PYA22(3),PEPSILON1(3),PSCALEFAC1(2),PSCALEFAC2(2), &113:       DOUBLE PRECISION :: PCUTOFF,PYA11(3),PYA21(3),PYA12(3),PYA22(3),PEPSILON1(3),PSCALEFAC1(2),PSCALEFAC2(2), &
114:      &                     PEPSILONATTR(2),PSIGMAATTR(2), PYOVERLAPTHRESH, LJSITECOORDS(3), LJGSITESIGMA, LJGSITEEPS, &114:      &                     PEPSILONATTR(2),PSIGMAATTR(2), PYOVERLAPTHRESH, LJSITECOORDS(3), LJGSITESIGMA, LJGSITEEPS, &
115:      &                     PYLOCALSTEP(2)115:      &                     PYLOCALSTEP(2)
116:  116:  
117:       DOUBLE PRECISION, ALLOCATABLE :: POINTSDECA(:), POINTSICOS(:)117:       DOUBLE PRECISION, ALLOCATABLE :: POINTSDECA(:), POINTSICOS(:)
118:       DOUBLE PRECISION, ALLOCATABLE :: VT(:), pya1bin(:,:),pya2bin(:,:)118:       DOUBLE PRECISION, ALLOCATABLE :: VT(:), pya1bin(:,:),pya2bin(:,:)
119:       LOGICAL          :: LJSITE,BLJSITE,LJSITEATTR,PYBINARYT,PARAMONOVPBCX,PARAMONOVPBCY,PARAMONOVPBCZ,PARAMONOVCUTOFF119:       LOGICAL          :: LJSITE,BLJSITE,LJSITEATTR,PYBINARYT,PARAMONOVPBCX,PARAMONOVPBCY,PARAMONOVPBCZ,PARAMONOVCUTOFF
120:       LOGICAL          :: PYGPERIODICT,ELLIPSOIDT,LJSITECOORDST,REALIGNXYZ,MULTISITEPYT,LJGSITET,NORMALMODET120:       LOGICAL          :: PYGPERIODICT,ELLIPSOIDT,LJSITECOORDST,REALIGNXYZ,MULTISITEPYT,LJGSITET,NORMALMODET


r31537/keywords.f 2016-11-24 14:30:19.473943412 +0000 r31536/keywords.f 2016-11-24 14:30:22.257980402 +0000
142:          CHARACTER (LEN=2) :: FREEZEGROUPTYPE142:          CHARACTER (LEN=2) :: FREEZEGROUPTYPE
143:          LOGICAL :: FREEZEGROUPT, TURNOFFCHECKCHIRALITY, MLPDONE, MLPNORM,  MLQDONE, MLQNORM143:          LOGICAL :: FREEZEGROUPT, TURNOFFCHECKCHIRALITY, MLPDONE, MLPNORM,  MLQDONE, MLQNORM
144:          LOGICAL :: RES_IN_LIST144:          LOGICAL :: RES_IN_LIST
145:          DOUBLE PRECISION LPI145:          DOUBLE PRECISION LPI
146:          INTEGER DATA_UNIT146:          INTEGER DATA_UNIT
147:          CHARACTER(LEN=13) :: AAOPTION147:          CHARACTER(LEN=13) :: AAOPTION
148:          CHARACTER(LEN=20) :: AMBERSTR148:          CHARACTER(LEN=20) :: AMBERSTR
149: 149: 
150:          INTEGER :: MAXNSETS150:          INTEGER :: MAXNSETS
151: 151: 
152:          DOUBLE PRECISION :: DUMMY_FRQCONV  ! sn402: Used to ensure that the FRQCONV keyword always overrides 
153:                                             ! the default value for a potential 
154:  
155:          LPI=3.14159265358979323846264338327950288419716939937510D0152:          LPI=3.14159265358979323846264338327950288419716939937510D0
156:          AAA=0153:          AAA=0
157:          AAB=0154:          AAB=0
158:          ABB=0155:          ABB=0
159:          PAA=0156:          PAA=0
160:          PAB=0157:          PAB=0
161:          PBB=0158:          PBB=0
162:          QAA=0159:          QAA=0
163:          QAB=0160:          QAB=0
164:          QBB=0161:          QBB=0
889:          BLJSITE=.FALSE.886:          BLJSITE=.FALSE.
890:          LJSITECOORDST=.FALSE.887:          LJSITECOORDST=.FALSE.
891:          LJSITEATTR=.FALSE.888:          LJSITEATTR=.FALSE.
892:          PCUTOFF=999.0D0889:          PCUTOFF=999.0D0
893:          CLOSESTALIGNMENT=.FALSE.890:          CLOSESTALIGNMENT=.FALSE.
894:          DF1T=.FALSE.891:          DF1T=.FALSE.
895:          PULLT=.FALSE.892:          PULLT=.FALSE.
896:          CHEMSHIFT=.FALSE.893:          CHEMSHIFT=.FALSE.
897:          METRICTENSOR=.FALSE.894:          METRICTENSOR=.FALSE.
898: 895: 
899:          FRQCONV = 1.0D0 
900:          DUMMY_FRQCONV = 0.0D0 
901:  
902:          QUIPARGSTRT=.FALSE.896:          QUIPARGSTRT=.FALSE.
903:          QUIPPARAMST=.FALSE.897:          QUIPPARAMST=.FALSE.
904: 898: 
905:          EIGENONLY=.FALSE.899:          EIGENONLY=.FALSE.
906:          COVER=0.990d0900:          COVER=0.990d0
907:          OVERCONV=.FALSE.901:          OVERCONV=.FALSE.
908:          TRUSTMODET=.FALSE.902:          TRUSTMODET=.FALSE.
909:          TMRATIO=0.71D0903:          TMRATIO=0.71D0
910: 904: 
911:          JPARAM=0.001D0905:          JPARAM=0.001D0
989:          ENDIF983:          ENDIF
990:          ! 984:          ! 
991:          ! POINTS - keyword at the end of the list of options after which985:          ! POINTS - keyword at the end of the list of options after which
992:          ! the Cartesian coordinates follow. Must be present unless VARIABLES or RINGPOLYMER986:          ! the Cartesian coordinates follow. Must be present unless VARIABLES or RINGPOLYMER
993:          ! is present instead. MACHINE keyword overrides POINTS. If MACHINE is987:          ! is present instead. MACHINE keyword overrides POINTS. If MACHINE is
994:          ! true coordinates that were read from odata file will be overwritten988:          ! true coordinates that were read from odata file will be overwritten
995:          ! with coordinates from a direct access file, in which case section of989:          ! with coordinates from a direct access file, in which case section of
996:          ! odata file after POINTS keyword is used only to read in the labels. (SAT)990:          ! odata file after POINTS keyword is used only to read in the labels. (SAT)
997:          ! 991:          ! 
998:          IF (END.OR.WORD.EQ.'STOP'.OR.WORD.EQ.'POINTS') THEN992:          IF (END.OR.WORD.EQ.'STOP'.OR.WORD.EQ.'POINTS') THEN
999:  
1000:             ! sn402: Once we have finished reading keywords, check to see whether we need to overwrite 
1001:             ! a default value of FRQCONV 
1002:             IF(DUMMY_FRQCONV.NE.0.0D0) THEN 
1003:                FRQCONV = DUMMY_FRQCONV 
1004:                WRITE(*,*) "keywords> Overwriting default unit conversion factor for frequencies" 
1005:                WRITE(*,*) "Conversion factor: ", FRQCONV 
1006:             ENDIF 
1007:             FRQCONV2 = FRQCONV*FRQCONV 
1008:  
1009:             RETURN993:             RETURN
1010:          ENDIF994:          ENDIF
1011: 995: 
1012:          IF (WORD.EQ.'    ' .OR.WORD.EQ.'NOTE'.OR.WORD.EQ.'COMMENT'996:          IF (WORD.EQ.'    ' .OR.WORD.EQ.'NOTE'.OR.WORD.EQ.'COMMENT'
1013:      &   .OR.WORD.EQ.'\\'.OR.WORD.EQ."!".OR.WORD.EQ."#") THEN997:      &   .OR.WORD.EQ.'\\'.OR.WORD.EQ."!".OR.WORD.EQ."#") THEN
1014:             GOTO 190998:             GOTO 190
1015: ! 999: ! 
1016: ! Enforce flatland.1000: ! Enforce flatland.
1017: ! 1001: ! 
1018:          ELSE IF (WORD .EQ. '2D') THEN1002:          ELSE IF (WORD .EQ. '2D') THEN
1229:                      WRITE(4431,'(A,I6)') 'FREEZE ', I1213:                      WRITE(4431,'(A,I6)') 'FREEZE ', I
1230:                  ! IF working in LT mode, FREEZE all atoms <GROUPRADIUS from the GROUPCENTRE atom1214:                  ! IF working in LT mode, FREEZE all atoms <GROUPRADIUS from the GROUPCENTRE atom
1231:                   ELSE IF((FREEZEGROUPTYPE == "LT") .AND. (DISTGROUPCENTRE < GROUPRADIUS)) THEN1215:                   ELSE IF((FREEZEGROUPTYPE == "LT") .AND. (DISTGROUPCENTRE < GROUPRADIUS)) THEN
1232:                      NFREEZE = NFREEZE + 11216:                      NFREEZE = NFREEZE + 1
1233:                      FROZEN(I) = .TRUE.1217:                      FROZEN(I) = .TRUE.
1234:                      WRITE(4431,'(A,I6)') 'FREEZE ',I1218:                      WRITE(4431,'(A,I6)') 'FREEZE ',I
1235:                   END IF1219:                   END IF
1236:                END DO1220:                END DO
1237:                CLOSE(4431)1221:                CLOSE(4431)
1238:             END IF1222:             END IF
1239:  
1240:             ! sn402: added (see comments at keyword FRQCONV) 
1241:             IF (DUMMY_FRQCONV .EQ. 0.0D0) THEN 
1242:                 FRQCONV = 2.045483D13 
1243:                 WRITE(*,*) "keywords> Set frequency conversion factor to the AMBER default value: ", FRQCONV 
1244:                 WRITE(*,*) "keywords> This corresponds to frequencies being given in radians/s" 
1245:             ELSE 
1246:                 FRQCONV = DUMMY_FRQCONV 
1247:                 WRITE(*,*) "keywords> Set frequency conversion factor to the user-specified value: ", FRQCONV 
1248:             ENDIF 
1249:             FRQCONV2 = FRQCONV*FRQCONV 
1250:  
1251:             WRITE (*,'(A)') 'Warning: AMBER12 keyword must come last in odata'1223:             WRITE (*,'(A)') 'Warning: AMBER12 keyword must come last in odata'
1252:             RETURN1224:             RETURN
1253: 1225: 
1254: ! sf344> start of AMBER 9 keywords1226: ! sf344> start of AMBER 9 keywords
1255:          ELSE IF (WORD.EQ.'AMBER9') THEN1227:          ELSE IF (WORD.EQ.'AMBER9') THEN
1256:             AMBERT=.TRUE.1228:             AMBERT=.TRUE.
1257: ! jmc49> make sure that chirality and cis/trans isomerization checks are on by default1229: ! jmc49> make sure that chirality and cis/trans isomerization checks are on by default
1258:             IF (.NOT.TURNOFFCHECKCHIRALITY) CHECKCHIRALT=.TRUE.1230:             IF (.NOT.TURNOFFCHECKCHIRALITY) CHECKCHIRALT=.TRUE.
1259:             IF (.NOT.CISTRANS) NOCISTRANS=.TRUE.1231:             IF (.NOT.CISTRANS) NOCISTRANS=.TRUE.
1260: ! 1232: ! 
1285:                      WRITE(4431,'(A,I6)') 'FREEZE ',J11257:                      WRITE(4431,'(A,I6)') 'FREEZE ',J1
1286:                      ! IF working in LT mode, FREEZE all atoms <GROUPRADIUS from the GROUPCENTRE atom1258:                      ! IF working in LT mode, FREEZE all atoms <GROUPRADIUS from the GROUPCENTRE atom
1287:                   ELSE IF((FREEZEGROUPTYPE=="LT").AND.(DISTGROUPCENTRE.LT.GROUPRADIUS)) THEN1259:                   ELSE IF((FREEZEGROUPTYPE=="LT").AND.(DISTGROUPCENTRE.LT.GROUPRADIUS)) THEN
1288:                      NFREEZE=NFREEZE+11260:                      NFREEZE=NFREEZE+1
1289:                      FROZEN(J1)=.TRUE.1261:                      FROZEN(J1)=.TRUE.
1290:                      WRITE(4431,'(A,I6)') 'FREEZE ',J11262:                      WRITE(4431,'(A,I6)') 'FREEZE ',J1
1291:                   END IF1263:                   END IF
1292:                END DO1264:                END DO
1293:                CLOSE(4431)1265:                CLOSE(4431)
1294:             ENDIF1266:             ENDIF
1295:  
1296: ! 1267: ! 
1297: ! csw34> A copy of the FROZEN array called FROZENAMBER is created to be passed through to AMBERINTERFACE1268: ! csw34> A copy of the FROZEN array called FROZENAMBER is created to be passed through to AMBERINTERFACE
1298: ! 1269: ! 
1299:             ALLOCATE(FROZENAMBER(NATOMS))1270:             ALLOCATE(FROZENAMBER(NATOMS))
1300:             FROZENAMBER(:)=FROZEN(:)1271:             FROZENAMBER(:)=FROZEN(:)
1301:             IF(.NOT.ALLOCATED(ATMASS)) ALLOCATE(ATMASS(NATOMS))1272:             IF(.NOT.ALLOCATED(ATMASS)) ALLOCATE(ATMASS(NATOMS))
1302:             ATMASS(1:NATOMS) = ATMASS1(1:NATOMS)1273:             ATMASS(1:NATOMS) = ATMASS1(1:NATOMS)
1303:             DO J1=1,3*NATOMS1274:             DO J1=1,3*NATOMS
1304:                Q(J1) = COORDS1(J1)1275:                Q(J1) = COORDS1(J1)
1305:             END DO1276:             END DO
1306: ! save atom names in array zsym1277: ! save atom names in array zsym
1307:             do J1=1,natoms1278:             do J1=1,natoms
1308:             zsym(J1) = ih(m04+J1-1)1279:             zsym(J1) = ih(m04+J1-1)
1309:             end do1280:             end do
1310: ! initialise MME1281: ! initialise MME
1311:             CALL MMEINITWRAPPER(TRIM(ADJUSTL(PRMTOP))//C_NULL_CHAR,IGB,SALTCON,RGBMAX,SQRT(CUT))1282:             CALL MMEINITWRAPPER(TRIM(ADJUSTL(PRMTOP))//C_NULL_CHAR,IGB,SALTCON,RGBMAX,SQRT(CUT))
1312:  
1313:             ! sn402: added (see comments at keyword FRQCONV) 
1314:             IF (DUMMY_FRQCONV .EQ. 0.0D0) THEN 
1315:                 FRQCONV = 2.045483D13 
1316:                 WRITE(*,*) "keywords> Set frequency conversion factor to the AMBER default value: ", FRQCONV 
1317:                 WRITE(*,*) "keywords> This corresponds to frequencies being given in radians/s" 
1318:             ELSE 
1319:                 FRQCONV = DUMMY_FRQCONV 
1320:                 WRITE(*,*) "keywords> Set frequency conversion factor to the user-specified value: ", FRQCONV 
1321:             ENDIF 
1322:             FRQCONV2 = FRQCONV*FRQCONV 
1323:  
1324:             RETURN1283:             RETURN
1325: ! initialise unit numbers1284: ! initialise unit numbers
1326:             ambpdb_unit=11101285:             ambpdb_unit=1110
1327:             ambrst_unit=11111286:             ambrst_unit=1111
1328:             mdinfo_unit=11121287:             mdinfo_unit=1112
1329:             mdcrd_unit =11131288:             mdcrd_unit =1113
1330: 1289: 
1331:          ELSE IF (WORD.EQ.'AMBERIC') THEN1290:          ELSE IF (WORD.EQ.'AMBERIC') THEN
1332:             PRINT*, "amberic"1291:             PRINT*, "amberic"
1333:             AMBERICT = .TRUE.1292:             AMBERICT = .TRUE.
1389:             IF(.NOT.ALLOCATED(ATMASS)) ALLOCATE(ATMASS(NATOMS))1348:             IF(.NOT.ALLOCATED(ATMASS)) ALLOCATE(ATMASS(NATOMS))
1390: ! for the NAB interface, ATMASS is also set up in mme2wrapper, and that setting1349: ! for the NAB interface, ATMASS is also set up in mme2wrapper, and that setting
1391: ! overrides the one from below. However, both originate from the same prmtop file,1350: ! overrides the one from below. However, both originate from the same prmtop file,
1392: ! so they should be the same. ATMASS is being assigned here so that it's somewhat consistent1351: ! so they should be the same. ATMASS is being assigned here so that it's somewhat consistent
1393: ! with the AMBER interface.1352: ! with the AMBER interface.
1394:             ATMASS(1:NATOMS) = ATMASS1(1:NATOMS)1353:             ATMASS(1:NATOMS) = ATMASS1(1:NATOMS)
1395:             WRITE(prmtop,'(A)') 'coords.prmtop'1354:             WRITE(prmtop,'(A)') 'coords.prmtop'
1396:             igbnab=igb1355:             igbnab=igb
1397:             if(igb==6) igbnab=0     ! this is also in vacuo, but NAB doesn't understand igb=6!1356:             if(igb==6) igbnab=0     ! this is also in vacuo, but NAB doesn't understand igb=6!
1398:             CALL MMEINITWRAPPER(trim(adjustl(prmtop))//C_NULL_CHAR,igbnab,saltcon,rgbmax,sqrt(cut))1357:             CALL MMEINITWRAPPER(trim(adjustl(prmtop))//C_NULL_CHAR,igbnab,saltcon,rgbmax,sqrt(cut))
1399:  
1400:             ! sn402: added (see comments at keyword FRQCONV) 
1401:             IF (DUMMY_FRQCONV .EQ. 0.0D0) THEN 
1402:                 FRQCONV = 2.045483D13 
1403:                 WRITE(*,*) "keywords> Set frequency conversion factor to the NAB default value: ", FRQCONV 
1404:                 WRITE(*,*) "keywords> This corresponds to frequencies being given in radians/s" 
1405:             ELSE 
1406:                 FRQCONV = DUMMY_FRQCONV 
1407:                 WRITE(*,*) "keywords> Set frequency conversion factor to the user-specified value: ", FRQCONV 
1408:             ENDIF 
1409:             FRQCONV2 = FRQCONV*FRQCONV 
1410:  
1411:             RETURN1358:             RETURN
1412: 1359: 
1413:          ELSE IF (WORD.eq.'DF1') THEN1360:          ELSE IF (WORD.eq.'DF1') THEN
1414:             DF1T=.TRUE.1361:             DF1T=.TRUE.
1415: 1362: 
1416:          ELSE IF (WORD.eq.'DUMPSTRUCTURES') THEN1363:          ELSE IF (WORD.eq.'DUMPSTRUCTURES') THEN
1417:             DUMPSTRUCTURES=.TRUE.1364:             DUMPSTRUCTURES=.TRUE.
1418:             WRITE(*,'(A)') ' keywords> Final structures will be dumped in different formats (.rst, .xyz, .pdb)'1365:             WRITE(*,'(A)') ' keywords> Final structures will be dumped in different formats (.rst, .xyz, .pdb)'
1419: ! 1366: ! 
1420: ! Distinguish between old C of M/Euler and new angle/axis coordinates for1367: ! Distinguish between old C of M/Euler and new angle/axis coordinates for
1686:             call param_arrayBLN(LJREP_BLN,LJATT_BLN,A_BLN,B_BLN,C_BLN,D_BLN,BEADLETTER,BLNSSTRUCT,1633:             call param_arrayBLN(LJREP_BLN,LJATT_BLN,A_BLN,B_BLN,C_BLN,D_BLN,BEADLETTER,BLNSSTRUCT,
1687:      &      LJREPBB, LJATTBB, LJREPLL, LJATTLL, LJREPNN, LJATTNN,1634:      &      LJREPBB, LJATTBB, LJREPLL, LJATTLL, LJREPNN, LJATTNN,
1688:      &      HABLN, HBBLN, HCBLN, HDBLN, EABLN, EBBLN, ECBLN, EDBLN, TABLN, TBBLN, TCBLN, TDBLN, NATOMS)1635:      &      HABLN, HBBLN, HCBLN, HDBLN, EABLN, EBBLN, ECBLN, EDBLN, TABLN, TBBLN, TCBLN, TDBLN, NATOMS)
1689: ! 1636: ! 
1690: ! Yimin Wang and Joel Bowman's water potential (2010)1637: ! Yimin Wang and Joel Bowman's water potential (2010)
1691: ! 1638: ! 
1692:          ELSE IF (WORD.EQ.'BOWMAN') THEN1639:          ELSE IF (WORD.EQ.'BOWMAN') THEN
1693:             BOWMANT=.TRUE.1640:             BOWMANT=.TRUE.
1694:             CALL READI(BOWMANPES)1641:             CALL READI(BOWMANPES)
1695:             CALL READA(BOWMANDIR)1642:             CALL READA(BOWMANDIR)
1696:  
1697:             ! sn402: added (see comments at keyword FRQCONV) 
1698:             FRQCONV = 5.123934D14 
1699:             WRITE(*,*) "keywords> Set frequency conversion factor to the SD default value: ", FRQCONV 
1700:             WRITE(*,*) "keywords> This corresponds to frequencies being given in radians/s" 
1701: ! 1643: ! 
1702: ! BSMIN calculates a steepest-descent path using gradient only information1644: ! BSMIN calculates a steepest-descent path using gradient only information
1703: ! with convergence criterion GMAX for the RMS force and initial precision1645: ! with convergence criterion GMAX for the RMS force and initial precision
1704: ! EPS. The Bulirsch-Stoer algorithm is used.1646: ! EPS. The Bulirsch-Stoer algorithm is used.
1705: ! 1647: ! 
1706:          ELSE IF (WORD.EQ.'BSMIN') THEN1648:          ELSE IF (WORD.EQ.'BSMIN') THEN
1707:             BSMIN=.TRUE.1649:             BSMIN=.TRUE.
1708:             IF (NITEMS.GT.1) CALL READF(GMAX)1650:             IF (NITEMS.GT.1) CALL READF(GMAX)
1709:             IF (NITEMS.GT.2) CALL READF(EPS)1651:             IF (NITEMS.GT.2) CALL READF(EPS)
1710: 1652: 
1893:                STOP1835:                STOP
1894:             ENDIF1836:             ENDIF
1895:             DO J1=1,801837:             DO J1=1,80
1896:                IF (SYS(J1:J1).EQ.' ') THEN1838:                IF (SYS(J1:J1).EQ.' ') THEN
1897:                   LSYS=J1-11839:                   LSYS=J1-1
1898:                   GOTO 221840:                   GOTO 22
1899:                ENDIF1841:                ENDIF
1900:             ENDDO1842:             ENDDO
1901: 22          CONTINUE1843: 22          CONTINUE
1902: 1844: 
1903:             ! sn402 
1904:             WRITE(*,*) "keywords> WARNING: there is currently no default frequency conversion set for CASTEP" 
1905:             WRITE(*,*) "keywords> Log products of frequencies will be computed in internal units." 
1906:             WRITE(*,*) "keywords> To learn how to set a default conversion factor, check the comments for  
1907:      &                            the FRQCONV keyword in keywords.f" 
1908: 1845: 
1909: 1846: 
1910: ! 1847: ! 
1911: ! charmm stuff (DAE)1848: ! charmm stuff (DAE)
1912: ! 1849: ! 
1913:          ELSE IF (WORD.EQ.'CHARMM') THEN1850:          ELSE IF (WORD.EQ.'CHARMM') THEN
1914:             CHRMMT=.TRUE.1851:             CHRMMT=.TRUE.
1915:             IF (.NOT.CISTRANS) THEN1852:             IF (.NOT.CISTRANS) THEN
1916:                NOCISTRANS=.TRUE.1853:                NOCISTRANS=.TRUE.
1917:                CHECKOMEGAT=.TRUE.1854:                CHECKOMEGAT=.TRUE.
2010:                ! We use CEILING to round up the index of the dihedral. This prevents1947:                ! We use CEILING to round up the index of the dihedral. This prevents
2011:                ! getting DMODE=0, and ensures uniform sampling.1948:                ! getting DMODE=0, and ensures uniform sampling.
2012:                DMODE=DIHETOTWIST(CEILING(PSRANDOM*NTWISTABLE))1949:                DMODE=DIHETOTWIST(CEILING(PSRANDOM*NTWISTABLE))
2013:                WRITE(*,*) 'keywords> Twisting dihedral IICD=',DMODE1950:                WRITE(*,*) 'keywords> Twisting dihedral IICD=',DMODE
2014:                CALL TWISTDIHE(Q,DMODE,DPERT)1951:                CALL TWISTDIHE(Q,DMODE,DPERT)
2015:             ENDIF1952:             ENDIF
2016:             IF (PERTDIHET) THEN1953:             IF (PERTDIHET) THEN
2017:                CALL PERTDIHE(Q,CHPMIN,CHPMAX,CHNMIN,CHNMAX,ISEED)1954:                CALL PERTDIHE(Q,CHPMIN,CHPMAX,CHNMIN,CHNMAX,ISEED)
2018:             ENDIF1955:             ENDIF
2019:             IF (INTMINT) CALL GETNINT(NINTS)  ! DJW - this is OK because CHARMM is the last keyword!1956:             IF (INTMINT) CALL GETNINT(NINTS)  ! DJW - this is OK because CHARMM is the last keyword!
2020:  
2021:             ! sn402: added (see comments at keyword FRQCONV) 
2022:             FRQCONV = 2.045483D13 
2023:             WRITE(*,*) "keywords> Set frequency conversion factor to the CHARMM default value: ", FRQCONV 
2024:             WRITE(*,*) "keywords> This corresponds to frequencies being given in radians/s" 
2025:  
2026: ! 1957: ! 
2027: ! csw34> If using the CHARMM SCC-DFTB potential, we assume that all1958: ! csw34> If using the CHARMM SCC-DFTB potential, we assume that all
2028: ! atoms are QM. If you are using a mixed QM/MM system, you should either1959: ! atoms are QM. If you are using a mixed QM/MM system, you should either
2029: ! not use the CHARMMDFTB keyword, or re-code it to check for fully QM1960: ! not use the CHARMMDFTB keyword, or re-code it to check for fully QM
2030: ! systems. This keyword essentially prevents unnessesary printing!1961: ! systems. This keyword essentially prevents unnessesary printing!
2031: ! 1962: ! 
2032:          ELSE IF (WORD.EQ.'CHARMMDFTB') THEN1963:          ELSE IF (WORD.EQ.'CHARMMDFTB') THEN
2033:             CHARMMDFTBT=.TRUE.1964:             CHARMMDFTBT=.TRUE.
2034:             WRITE(*,'(A)') 'keywords> WARNING - All atoms assumed to be QM, NBONDS calls disabled'1965:             WRITE(*,'(A)') 'keywords> WARNING - All atoms assumed to be QM, NBONDS calls disabled'
2035:          ELSE IF (WORD.EQ.'CHARMMNOTUPDATE') THEN1966:          ELSE IF (WORD.EQ.'CHARMMNOTUPDATE') THEN
2965:                   READ(FUNIT,*) NFREEZE2896:                   READ(FUNIT,*) NFREEZE
2966:                   DO J1=1,NFREEZE2897:                   DO J1=1,NFREEZE
2967:                      READ(FUNIT,*) NDUM2898:                      READ(FUNIT,*) NDUM
2968:                      FROZEN(NDUM)=.TRUE.2899:                      FROZEN(NDUM)=.TRUE.
2969:                   ENDDO2900:                   ENDDO
2970:                   ! 2901:                   ! 
2971:                   ! csw34> If neither, FREEZE used incorrectly - STOP2902:                   ! csw34> If neither, FREEZE used incorrectly - STOP
2972:                   ! 2903:                   ! 
2973:                ELSE2904:                ELSE
2974:                   WRITE (*,'(A)') ' ERROR: FREEZE specified incorrectly'2905:                   WRITE (*,'(A)') ' ERROR: FREEZE specified incorrectly'
2975:                   WRITE(*,*) "Specify frozen atoms either on the keyword line, or in a file called 'frozen'" 
2976:                   STOP2906:                   STOP
2977:                ENDIF2907:                ENDIF
2978:             ENDIF2908:             ENDIF
2979: 2909: 
2980: ! 2910: ! 
2981: Cjbr36      > FREEZERANGE of atoms2911: Cjbr36      > FREEZERANGE of atoms
2982: ! 2912: ! 
2983:          ELSE IF (WORD.EQ.'FREEZERANGE') THEN2913:          ELSE IF (WORD.EQ.'FREEZERANGE') THEN
2984:             FREEZE=.TRUE.2914:             FREEZE=.TRUE.
2985:             FREEZERANGE=.TRUE.2915:             FREEZERANGE=.TRUE.
3043:                   ENDDO2973:                   ENDDO
3044:                   NDUMMY=NDUMMY+NPERMSIZE(J1)2974:                   NDUMMY=NDUMMY+NPERMSIZE(J1)
3045:                ENDDO2975:                ENDDO
3046:             ENDIF2976:             ENDIF
3047: ! 2977: ! 
3048: ! Strings keyword.2978: ! Strings keyword.
3049: ! 2979: ! 
3050:          ELSE IF (WORD.EQ.'FREEZENODES') THEN2980:          ELSE IF (WORD.EQ.'FREEZENODES') THEN
3051:             FREEZENODEST=.TRUE.2981:             FREEZENODEST=.TRUE.
3052:             CALL READF(FREEZETOL)2982:             CALL READF(FREEZETOL)
3053:  
3054:          ELSE IF (WORD.EQ.'FRQCONV') THEN 
3055:             ! sn402: I'm implementing a new way of handling unit conversions when calculating frequencies. 
3056:             ! In line with the documention on the OPTIM website, the default behaviour is to leave all frequencies 
3057:             ! in internal units and only convert to SI at the very end of a calculation (typically after obtaining rate 
3058:             ! constants). However, this will not be appropriate for some potentials, so I'm implementing a general unit 
3059:             ! conversion scheme. All unit conversions will eventually be done using a variable FRQCONV set in this 
3060:             ! subroutine, which is the factor required to convert a frequency from the internal units of the current 
3061:             ! potential into another desired unit system. 
3062:             ! For example, AMBER and CHARMM work with energy units of kCalmol^-1 and distance units of Angstrom, so the 
3063:             ! natural frequency units are (kCal mol^-1/(amu Angstrom^2))^1/2 
3064:             ! However, we usually want frequencies to be written out in radians/s, for use by PATHSAMPLE. In that case, 
3065:             ! FRQCONV = sqrt(4.184E26) = 2.045483D13 
3066:             ! The AMBER, CHARMM and NAB keywords will use this as their default value of FRQCONV. 
3067:             ! If you want your potential to default to printing frequencies in a unit other than internal units, set a value 
3068:             ! of FRQCONV in the relevant block of this subroutine. 
3069:             ! To override the default frequency units for a particular job, use this keyword, FRQCONV conv 
3070:             ! The variable FRQCONV will be set equal to this argument conv at the end of the subroutine, so it doesn't matter 
3071:             ! whether this keyword is placed before or after the keyword which activates your potential. 
3072:             ! Note that if you want to override a default, your conversion factor will be applied to the raw eigenvalues instead 
3073:             ! of the default, not as well as the default. So if you want AMBER frequencies in cm^-1, you must specify the conversion 
3074:             ! factor from internals to cm^-1, not the conversion factor for s^-1 to cm^-1. (In this example, the conversion factor 
3075:             ! required is FRQCONV 108.52D0) 
3076:             CALL READF(DUMMY_FRQCONV) 
3077:  
3078: ! 2983: ! 
3079: ! GGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGG2984: ! GGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGG
3080: ! 2985: ! 
3081: ! 2986: ! 
3082: ! GAMESS-UK tells the program to read derivative information in2987: ! GAMESS-UK tells the program to read derivative information in
3083: ! GAMESS-UK format.                                        - default FALSE2988: ! GAMESS-UK format.                                        - default FALSE
3084:          ELSE IF (WORD.EQ.'GAMESS-UK') THEN2989:          ELSE IF (WORD.EQ.'GAMESS-UK') THEN
3085:             GAMESSUK=.TRUE.2990:             GAMESSUK=.TRUE.
3086:             CALL READA(SYS)2991:             CALL READA(SYS)
3087:             DO J1=1,802992:             DO J1=1,80
4431:          ELSE IF (WORD == 'NEWCONNECT') THEN4336:          ELSE IF (WORD == 'NEWCONNECT') THEN
4432:             NEWCONNECTT = .TRUE.4337:             NEWCONNECTT = .TRUE.
4433:             CONNECTT = .TRUE.4338:             CONNECTT = .TRUE.
4434:             OPTIMIZETS = .TRUE.4339:             OPTIMIZETS = .TRUE.
4435:             IF (NITEMS.GT.1) CALL READI(NCONMAX)4340:             IF (NITEMS.GT.1) CALL READI(NCONMAX)
4436:             IF (NITEMS.GT.2) CALL READI(NTRIESMAX)4341:             IF (NITEMS.GT.2) CALL READI(NTRIESMAX)
4437:             IF (NITEMS.GT.3) CALL READF(IMAGEDENSITY)4342:             IF (NITEMS.GT.3) CALL READF(IMAGEDENSITY)
4438:             IF (NITEMS.GT.4) CALL READF(ITERDENSITY)4343:             IF (NITEMS.GT.4) CALL READF(ITERDENSITY)
4439:             IF (NITEMS.GT.5) CALL READI(IMAGEMAX)4344:             IF (NITEMS.GT.5) CALL READI(IMAGEMAX)
4440:             IF (NITEMS.GT.6) CALL READF(IMAGEINCR)4345:             IF (NITEMS.GT.6) CALL READF(IMAGEINCR)
4441:             ! Currently, the next line clashes with the equivalent parameter in NEWNEB - both are being read into the 
4442:             ! same variable, so only one value will ever be used. 
4443:             IF (NITEMS.GT.7) CALL READF(RMSTOL)4346:             IF (NITEMS.GT.7) CALL READF(RMSTOL)
4444:             ! The following line ought to fix the problem, but I've not implemented it properly yet. 
4445:             !IF (NITEMS.GT.7) CALL READF(NEWCONNECT_RMSTOL) 
4446:             IMAGEMAX=MAX(IMAGEMAX,NIMAGE+2)4347:             IMAGEMAX=MAX(IMAGEMAX,NIMAGE+2)
4447: ! 4348: ! 
4448: ! If NEWCONNECT is specified the values read below are only used for the first cycle.4349: ! If NEWCONNECT is specified the values read below are only used for the first cycle.
4449: ! If NEWNEB is used with OLDCONNECT then the values read on the NEWNEB line are4350: ! If NEWNEB is used with OLDCONNECT then the values read on the NEWNEB line are
4450: ! used in every cycle. If NEWCONNECT is used then a NEWNEB line isn;t necessary.4351: ! used in every cycle. If NEWCONNECT is used then a NEWNEB line isn;t necessary.
4451: ! 4352: ! 
4452:          ELSE IF (WORD == 'NEWNEB') THEN4353:          ELSE IF (WORD == 'NEWNEB') THEN
4453:             NEWNEBT=.TRUE.4354:             NEWNEBT=.TRUE.
4454:             FCD=.TRUE.4355:             FCD=.TRUE.
4455:             IF (NITEMS.GT.1) CALL READI(NNNIMAGE)4356:             IF (NITEMS.GT.1) CALL READI(NNNIMAGE)
4629:             ENDIF4530:             ENDIF
4630:             NTIPT = .TRUE.4531:             NTIPT = .TRUE.
4631:             RBAAT = .TRUE.4532:             RBAAT = .TRUE.
4632:             NRBSITES = 44533:             NRBSITES = 4
4633:             ALLOCATE(RBSITE(NRBSITES,3))4534:             ALLOCATE(RBSITE(NRBSITES,3))
4634:             ALLOCATE(STCHRG(NRBSITES))4535:             ALLOCATE(STCHRG(NRBSITES))
4635:             NTSITES = NATOMS*NRBSITES/24536:             NTSITES = NATOMS*NRBSITES/2
4636:             IF (PERMDIST) THEN ! correct all permutations allowed if perm.allow is not given explicitly4537:             IF (PERMDIST) THEN ! correct all permutations allowed if perm.allow is not given explicitly
4637:                IF (NPERMSIZE(1).EQ.NATOMS) NPERMSIZE(1)=NATOMS/24538:                IF (NPERMSIZE(1).EQ.NATOMS) NPERMSIZE(1)=NATOMS/2
4638:             ENDIF4539:             ENDIF
4639:  
4640:             FRQCONV = 53.0883746D0 
4641:             WRITE(*,*) "keywords> Frequencies (and square frequencies) will be given in cm^-1 (cm^-2)" 
4642:             WRITE(*,*) "keywords> FRQCONV = ", FRQCONV 
4643: ! 4540: ! 
4644: ! OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO4541: ! OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
4645: ! 4542: ! 
4646:          ELSE IF (WORD.EQ.'ODIHE') THEN4543:          ELSE IF (WORD.EQ.'ODIHE') THEN
4647:             ODIHET=.TRUE.4544:             ODIHET=.TRUE.
4648:             WRITE(*,'(A)') 'ODIHE set: dihedral-angle order parameter will be calculated'4545:             WRITE(*,'(A)') 'ODIHE set: dihedral-angle order parameter will be calculated'
4649:             WRITE(*,'(A)') 'using the reference structure supplied in ref.crd'4546:             WRITE(*,'(A)') 'using the reference structure supplied in ref.crd'
4650: ! 4547: ! 
4651: ! Add an octahedral field to the potential of magnitude FOH.4548: ! Add an octahedral field to the potential of magnitude FOH.
4652: ! 4549: ! 
4858:                CALL FLUSH(6)4755:                CALL FLUSH(6)
4859:                STOP4756:                STOP
4860:             ENDIF4757:             ENDIF
4861:             DO J1=1,804758:             DO J1=1,80
4862:                IF (SYS(J1:J1).EQ.' ') THEN4759:                IF (SYS(J1:J1).EQ.' ') THEN
4863:                   LSYS=J1-14760:                   LSYS=J1-1
4864:                   GOTO 244761:                   GOTO 24
4865:                ENDIF4762:                ENDIF
4866:             ENDDO4763:             ENDDO
4867: 24          CONTINUE4764: 24          CONTINUE
4868:  
4869:             ! sn402 
4870:             WRITE(*,*) "keywords> WARNING: there is currently no default frequency conversion set for ONETEP" 
4871:             WRITE(*,*) "keywords> Log products of frequencies will be computed in internal units." 
4872:             WRITE(*,*) "keywords> To learn how to set a default conversion factor, check the comments for  
4873:      &                            the FRQCONV keyword in keywords.f" 
4874:  
4875: ! 4765: ! 
4876: ! Optimise TS with SQVV4766: ! Optimise TS with SQVV
4877: ! 4767: ! 
4878:          ELSE IF (WORD == 'OPTIMIZETS') THEN4768:          ELSE IF (WORD == 'OPTIMIZETS') THEN
4879:             OPTIMIZETS=.TRUE.4769:             OPTIMIZETS=.TRUE.
4880: ! 4770: ! 
4881: ! Distance cutoff for distinguishing atoms in the same orbit for LPERMDIST and LOCALPERMDIST4771: ! Distance cutoff for distinguishing atoms in the same orbit for LPERMDIST and LOCALPERMDIST
4882: ! 4772: ! 
4883:          ELSE IF (WORD.EQ.'ORBITGEOMTOL') THEN4773:          ELSE IF (WORD.EQ.'ORBITGEOMTOL') THEN
4884:             CALL READF(LPDGEOMDIFFTOL)4774:             CALL READF(LPDGEOMDIFFTOL)
5594: ! 5484: ! 
5595:          ELSE IF (WORD.EQ.'QSPCFW') THEN5485:          ELSE IF (WORD.EQ.'QSPCFW') THEN
5596:             QSPCFWT=.TRUE.5486:             QSPCFWT=.TRUE.
5597: ! 5487: ! 
5598: ! qTIP4PF flexible water model introduced by Habershon et al. (JCP 131, 024501 (2009))5488: ! qTIP4PF flexible water model introduced by Habershon et al. (JCP 131, 024501 (2009))
5599: ! Coded by Javier.5489: ! Coded by Javier.
5600: ! 5490: ! 
5601:          ELSE IF (WORD.EQ.'QTIP4PF') THEN5491:          ELSE IF (WORD.EQ.'QTIP4PF') THEN
5602:             QTIP4PFT=.TRUE.5492:             QTIP4PFT=.TRUE.
5603: 5493: 
5604:             ! sn402: added (see comments at keyword FRQCONV) 
5605:             FRQCONV = 2.045483D13 
5606:             WRITE(*,*) "keywords> Set frequency conversion factor to the QTIP4PF default value: ", FRQCONV 
5607:             WRITE(*,*) "keywords> This corresponds to frequencies being given in radians/s" 
5608:  
5609:          ELSE IF (WORD.EQ.'QUIPARGSTR') THEN5494:          ELSE IF (WORD.EQ.'QUIPARGSTR') THEN
5610:             QUIPARGSTRT=.TRUE.5495:             QUIPARGSTRT=.TRUE.
5611:             QARGSTR='IP LJ'5496:             QARGSTR='IP LJ'
5612:             CALL READA(QARGSTR)5497:             CALL READA(QARGSTR)
5613: 5498: 
5614:          ELSE IF (WORD.EQ.'QUIPPARAMS') THEN5499:          ELSE IF (WORD.EQ.'QUIPPARAMS') THEN
5615:             QUIPPARAMST=.TRUE.5500:             QUIPPARAMST=.TRUE.
5616:             QUIPATOMTYPE='Ag '5501:             QUIPATOMTYPE='Ag '
5617:             QUIPATOMMASS=1.0D05502:             QUIPATOMMASS=1.0D0
5618:             IF (NITEMS.GT.1) THEN5503:             IF (NITEMS.GT.1) THEN
6039: ! 5924: ! 
6040:          ELSE IF (WORD.EQ.'SD') THEN5925:          ELSE IF (WORD.EQ.'SD') THEN
6041:             SDT=.TRUE.5926:             SDT=.TRUE.
6042:             CALL READI(SDOXYGEN)5927:             CALL READI(SDOXYGEN)
6043:             CALL READI(SDHYDROGEN)5928:             CALL READI(SDHYDROGEN)
6044:             CALL READI(SDCHARGE)5929:             CALL READI(SDCHARGE)
6045:             IF (SDOXYGEN*SDHYDROGEN.EQ.0) THEN5930:             IF (SDOXYGEN*SDHYDROGEN.EQ.0) THEN
6046:                PRINT '(A,2I6)', ' keyword> ERROR *** number of SD oxygens and hydrogens=',SDOXYGEN,SDHYDROGEN5931:                PRINT '(A,2I6)', ' keyword> ERROR *** number of SD oxygens and hydrogens=',SDOXYGEN,SDHYDROGEN
6047:                STOP5932:                STOP
6048:             ENDIF5933:             ENDIF
6049:  
6050:             ! sn402: added (see comments at keyword FRQCONV) 
6051:             FRQCONV = 2.045483D13 
6052:             WRITE(*,*) "keywords> Set frequency conversion factor to the SD default value: ", FRQCONV 
6053:             WRITE(*,*) "keywords> This corresponds to frequencies being given in radians/s" 
6054:  
6055:          ELSE IF (WORD.EQ.'STOCK') THEN5934:          ELSE IF (WORD.EQ.'STOCK') THEN
6056:             STOCKT=.TRUE.5935:             STOCKT=.TRUE.
6057: ! RIGIDBODY=.TRUE.5936: ! RIGIDBODY=.TRUE.
6058: ! NRBSITES=1 ! used in current GMIN5937: ! NRBSITES=1 ! used in current GMIN
6059:             CALL READF(STOCKMU)5938:             CALL READF(STOCKMU)
6060:             CALL READF(STOCKLAMBDA)5939:             CALL READF(STOCKLAMBDA)
6061: ! ALLOCATE(SITE(NRBSITES,3))5940: ! ALLOCATE(SITE(NRBSITES,3))
6062: ! 5941: ! 
6063: ! STOCKSPIN randomises the orientation of a Stockmayer cluster at any point in5942: ! STOCKSPIN randomises the orientation of a Stockmayer cluster at any point in
6064: ! an optimisation where a dipole vector becomes aligned with the z axis (which5943: ! an optimisation where a dipole vector becomes aligned with the z axis (which
6178: ! 6057: ! 
6179: ! TRAPMK is used for the trap potential in EYtrap coded by Ersin Yurtsever.6058: ! TRAPMK is used for the trap potential in EYtrap coded by Ersin Yurtsever.
6180: ! 6059: ! 
6181:          ELSE IF (WORD .EQ. 'TRAPMK') THEN6060:          ELSE IF (WORD .EQ. 'TRAPMK') THEN
6182:             MKTRAPT=.TRUE.6061:             MKTRAPT=.TRUE.
6183: ! 6062: ! 
6184: ! Xantheas' TTM3-F water potential6063: ! Xantheas' TTM3-F water potential
6185: ! 6064: ! 
6186:          ELSE IF (WORD.EQ.'TTM3') THEN6065:          ELSE IF (WORD.EQ.'TTM3') THEN
6187:             TTM3T=.TRUE.6066:             TTM3T=.TRUE.
6188:  
6189:             ! sn402: added (see comments at keyword FRQCONV) 
6190:             FRQCONV = 2.045483D13 
6191:             WRITE(*,*) "keywords> Set frequency conversion factor to the TTM3 default value: ", FRQCONV 
6192:             WRITE(*,*) "keywords> This corresponds to frequencies being given in radians/s" 
6193: ! 6067: ! 
6194: ! Includes sidechain angles in the TWISTDIHE list.6068: ! Includes sidechain angles in the TWISTDIHE list.
6195: ! 6069: ! 
6196:          ELSE IF (WORD.EQ.'TSIDECHAIN') THEN6070:          ELSE IF (WORD.EQ.'TSIDECHAIN') THEN
6197:             TSIDECHAIN=.TRUE.6071:             TSIDECHAIN=.TRUE.
6198: 6072: 
6199: ! jbr36 - Tunneling splitting active6073: ! jbr36 - Tunneling splitting active
6200:          ELSE IF (WORD.EQ.'TSPLITTING') THEN6074:          ELSE IF (WORD.EQ.'TSPLITTING') THEN
6201:             TSPLITTINGT=.TRUE.6075:             TSPLITTINGT=.TRUE.
6202:             WRITE(*,*) 'Splitting is not implemented fully yet'6076:             WRITE(*,*) 'Splitting is not implemented fully yet'


r31537/ncutils.f90 2016-11-24 14:30:18.241927067 +0000 r31536/ncutils.f90 2016-11-24 14:30:20.701959718 +0000
1520: ! format and updated for AMBER, NAB and AMH 30/5/11 DJW.1520: ! format and updated for AMBER, NAB and AMH 30/5/11 DJW.
1521: !1521: !
1522:      SUBROUTINE MAKEPATHINFO1522:      SUBROUTINE MAKEPATHINFO
1523:      USE SYMINF1523:      USE SYMINF
1524:      USE MODHESS1524:      USE MODHESS
1525:      USE MODCHARMM1525:      USE MODCHARMM
1526:      USE PORFUNCS1526:      USE PORFUNCS
1527:      USE MODUNRES1527:      USE MODUNRES
1528:      USE KEY, ONLY: FILTH, FILTHSTR, UNRST, TWOD, BULKT, MACHINE, RIGIDBODY, NOFRQS, PERMDIST, &1528:      USE KEY, ONLY: FILTH, FILTHSTR, UNRST, TWOD, BULKT, MACHINE, RIGIDBODY, NOFRQS, PERMDIST, &
1529:   &                 AMHT, SEQ, SDT, NRES_AMH_TEMP, AMBERT, NABT, MACROCYCLET, TTM3T, BOWMANT, &1529:   &                 AMHT, SEQ, SDT, NRES_AMH_TEMP, AMBERT, NABT, MACROCYCLET, TTM3T, BOWMANT, &
1530:   &                 HESSDUMPT,INSTANTONSTARTDUMPT, RBAAT, AMBER12T, VARIABLES, FRQCONV21530:   &                 HESSDUMPT,INSTANTONSTARTDUMPT, METRICTENSOR, RBAAT, AMBER12T, VARIABLES
1531: 1531: 
1532:      USE COMMONS, ONLY: ATMASS, NINTS, ZSYM, PARAM1, PARAM2, PARAM3, DEBUG1532:      USE COMMONS, ONLY: ATMASS, NINTS, ZSYM, PARAM1, PARAM2, PARAM3, DEBUG
1533: 1533: 
1534:      USE GENRIGID1534:      USE GENRIGID
1535: 1535: 
1536:      IMPLICIT NONE1536:      IMPLICIT NONE
1537:      DOUBLE PRECISION RMAT(3,3), DIST, DIST21537:      DOUBLE PRECISION RMAT(3,3), DIST, DIST2
1538: 1538: 
1539: !    LOCAL AMH VARIABLES1539: !    LOCAL AMH VARIABLES
1540:      INTEGER :: I_RES, GLY_COUNT1540:      INTEGER :: I_RES, GLY_COUNT
1580:               ENDIF1580:               ENDIF
1581:               IF (.NOT.NOFRQS) THEN1581:               IF (.NOT.NOFRQS) THEN
1582:               ! sn402: Haven't tested this bit yet: copied it across from MAKEALLPATHINFO. Beware if using RIGIDINIT1582:               ! sn402: Haven't tested this bit yet: copied it across from MAKEALLPATHINFO. Beware if using RIGIDINIT
1583:               ! and DUMPPATH without NOFRQS also set.1583:               ! and DUMPPATH without NOFRQS also set.
1584:                  IF (RIGIDINIT) THEN1584:                  IF (RIGIDINIT) THEN
1585:                     CALL GENRIGID_EIGENVALUES(MI(DUMMY%I)%DATA%X, ATMASS, DIAG, INFO)1585:                     CALL GENRIGID_EIGENVALUES(MI(DUMMY%I)%DATA%X, ATMASS, DIAG, INFO)
1586:                     IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN1586:                     IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
1587:                         CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)1587:                         CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
1588:                     ENDIF1588:                     ENDIF
1589:                     IF (MACHINE) THEN1589:                     IF (MACHINE) THEN
1590:                         ! The eigenvalues are squared frequencies in internal units. FRQCONV2=(FRQCONV)^2 is the conversion1590:                         WRITE(88) (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
1591:                         ! factor required to go from square internal frequency units to the desired square frequency units. 
1592:                         ! If all masses in the system are equal, we usually choose FRQCONV=1 and calculate the frequencies in 
1593:                         ! internal units. Otherwise, we must convert to SI here so FRQCONV is usually the conversion factor required 
1594:                         ! to convert internal frequency units to rad/s. This is the default value for CHARMM and AMBER 
1595:                         WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS) 
1596:                     ELSE1591:                     ELSE
1597:                         WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)1592:                         WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
1598:                     ENDIF1593:                     ENDIF
1599:                  ELSE1594:                  ELSE
1600:                     IF (ENDNUMHESS) THEN1595:                     IF (ENDNUMHESS) THEN
1601:                         CALL MAKENUMHESS(MI(DUMMY%I)%DATA%X,NATOMS)1596:                         CALL MAKENUMHESS(MI(DUMMY%I)%DATA%X,NATOMS)
1602:                     ELSE1597:                     ELSE
1603:                         CALL POTENTIAL(MI(DUMMY%I)%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)1598:                         CALL POTENTIAL(MI(DUMMY%I)%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
1604:                     ENDIF1599:                     ENDIF
1605:                     CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)1600:                     CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
1606:                     ! sn402: This block should probably be moved so it gets executed for RIGIDINIT as well. 
1607:                     IF (HESSDUMPT) THEN1601:                     IF (HESSDUMPT) THEN
1608:                         LUNIT=GETUNIT()1602:                         LUNIT=GETUNIT()
1609:                         OPEN(LUNIT,FILE='minhess.plus',STATUS='UNKNOWN',POSITION ='APPEND')1603:                         OPEN(LUNIT,FILE='minhess.plus',STATUS='UNKNOWN',POSITION ='APPEND')
1610:                         WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)1604:                         WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)
1611:                         CLOSE(LUNIT)1605:                         CLOSE(LUNIT)
1612:                     ENDIF1606:                     ENDIF
1613:                     CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)1607:                     CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
1614:                     IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)1608:                     IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)
1615: 1609: 
1616: ! jbr36 - writes the first input for qm rate calculations from classical rates1610: ! jbr36 - writes the first input for qm rate calculations from classical rates
1623:                        WRITE(LUNIT,*) "Coordinates"1617:                        WRITE(LUNIT,*) "Coordinates"
1624:                        WRITE(LUNIT,*) MI(DUMMY%I)%DATA%X1618:                        WRITE(LUNIT,*) MI(DUMMY%I)%DATA%X
1625:                        WRITE(LUNIT,*) "Hessian Eigenvalues"1619:                        WRITE(LUNIT,*) "Hessian Eigenvalues"
1626:                        WRITE(LUNIT,*) DIAG1620:                        WRITE(LUNIT,*) DIAG
1627:                        WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"1621:                        WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"
1628:                        WRITE(LUNIT,*) ATMASS1622:                        WRITE(LUNIT,*) ATMASS
1629:                        CLOSE(LUNIT)1623:                        CLOSE(LUNIT)
1630:                     ENDIF1624:                     ENDIF
1631: 1625: 
1632:                     IF (MACHINE) THEN1626:                     IF (MACHINE) THEN
1633:                        WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,NOPT)1627:                        WRITE(88) (DIAG(J2)*4.184D26,J2=1,NOPT)
1634:                     ELSE1628:                     ELSE
1635:                        WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT)1629:                        WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,NOPT)
1636:                     ENDIF1630:                     ENDIF
1637:                  ENDIF1631:                  ENDIF
1638:               ENDIF1632:               ENDIF
1639:            ELSEIF (AMBER12T.OR.AMBERT.OR.NABT) THEN1633:            ELSEIF (AMBER12T.OR.AMBERT.OR.NABT) THEN
1640:               IF (.NOT.MACROCYCLET) THEN1634:               IF (.NOT.MACROCYCLET) THEN
1641:                  HORDER=11635:                  HORDER=1
1642:                  FPGRP='C1'1636:                  FPGRP='C1'
1643:               ELSE1637:               ELSE
1644:                  CALL SYMMETRY(HORDER,.FALSE.,MI(DUMMY%I)%DATA%X,INERTIA)1638:                  CALL SYMMETRY(HORDER,.FALSE.,MI(DUMMY%I)%DATA%X,INERTIA)
1645:               ENDIF1639:               ENDIF
1650:               ENDIF1644:               ENDIF
1651:               IF (.NOT.NOFRQS) THEN1645:               IF (.NOT.NOFRQS) THEN
1652:               ! sn402: Haven't tested this bit yet: copied it across from MAKEALLPATHINFO. Beware if using RIGIDINIT1646:               ! sn402: Haven't tested this bit yet: copied it across from MAKEALLPATHINFO. Beware if using RIGIDINIT
1653:               ! and DUMPPATH without NOFRQS also set.1647:               ! and DUMPPATH without NOFRQS also set.
1654:                  IF (RIGIDINIT) THEN1648:                  IF (RIGIDINIT) THEN
1655:                     CALL GENRIGID_EIGENVALUES(MI(DUMMY%I)%DATA%X, ATMASS, DIAG, INFO)1649:                     CALL GENRIGID_EIGENVALUES(MI(DUMMY%I)%DATA%X, ATMASS, DIAG, INFO)
1656:                     IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN1650:                     IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
1657:                         CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)1651:                         CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
1658:                     ENDIF1652:                     ENDIF
1659:                     IF (MACHINE) THEN1653:                     IF (MACHINE) THEN
1660:                         WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)1654:                         WRITE(88) (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
1661:                     ELSE1655:                     ELSE
1662:                         WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)1656:                         WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
1663:                     ENDIF1657:                     ENDIF
1664:                  ELSE1658:                  ELSE
1665:                     IF (ENDNUMHESS.OR.AMBERT.OR.AMBER12T) THEN1659:                     IF (ENDNUMHESS.OR.AMBERT.OR.AMBER12T) THEN
1666:                         CALL MAKENUMHESS(MI(DUMMY%I)%DATA%X,NATOMS)1660:                         CALL MAKENUMHESS(MI(DUMMY%I)%DATA%X,NATOMS)
1667:                     ELSE1661:                     ELSE
1668:                         CALL POTENTIAL(MI(DUMMY%I)%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)1662:                         CALL POTENTIAL(MI(DUMMY%I)%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
1669:                     ENDIF1663:                     ENDIF
1670:                     CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)1664:                     CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
1671:                     IF (HESSDUMPT) THEN1665:                     IF (HESSDUMPT) THEN
1672:                         LUNIT=GETUNIT()1666:                         LUNIT=GETUNIT()
1685:                           write(LUNIT,*) DUMMY11679:                           write(LUNIT,*) DUMMY1
1686:                           write(LUNIT,*) "Coordinates"1680:                           write(LUNIT,*) "Coordinates"
1687:                           write(LUNIT,*) MI(DUMMY%I)%DATA%X1681:                           write(LUNIT,*) MI(DUMMY%I)%DATA%X
1688:                           write(LUNIT,*) "Hessian Eigenvalues"1682:                           write(LUNIT,*) "Hessian Eigenvalues"
1689:                           write(LUNIT,*) DIAG1683:                           write(LUNIT,*) DIAG
1690:                           write(LUNIT,*) "Masses in amu (M(12C)=12)"1684:                           write(LUNIT,*) "Masses in amu (M(12C)=12)"
1691:                           write(LUNIT,*) ATMASS1685:                           write(LUNIT,*) ATMASS
1692:                           close(LUNIT)1686:                           close(LUNIT)
1693:                     ENDIF1687:                     ENDIF
1694:                     IF (MACHINE) THEN1688:                     IF (MACHINE) THEN
1695:                         WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,NOPT)1689:                         WRITE(88) (DIAG(J2)*4.184D26,J2=1,NOPT)
1696:                     ELSE1690:                     ELSE
1697:                         WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT)1691:                         WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,NOPT)
1698:                     ENDIF1692:                     ENDIF
1699:                  ENDIF1693:                  ENDIF
1700:               ENDIF1694:               ENDIF
1701:            ELSEIF (UNRST) THEN1695:            ELSEIF (UNRST) THEN
1702:               HORDER=11696:               HORDER=1
1703:               FPGRP='C1'1697:               FPGRP='C1'
1704:               WRITE(88,'(I6,1X,A4)') HORDER,FPGRP1698:               WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
1705:               IF (.NOT.NOFRQS) THEN1699:               IF (.NOT.NOFRQS) THEN
1706:                  IF (ENDNUMHESS) THEN1700:                  IF (ENDNUMHESS) THEN
1707:                     CALL MAKENUMINTHESS(NINTS,NATOMS)1701:                     CALL MAKENUMINTHESS(NINTS,NATOMS)
1708:                     CALL GETSTUFF(KD,NNZ,NINTB)1702:                     CALL GETSTUFF(KD,NNZ,NINTB)
1709:                     CALL INTSECDET(MI(DUMMY%I)%DATA%X,NOPT,KD,NNZ,NINTB,DIAG)1703:                     CALL INTSECDET(MI(DUMMY%I)%DATA%X,NOPT,KD,NNZ,NINTB,DIAG)
1710:                  ELSE1704:                  ELSE
1711:                     CALL POTENTIAL(MI(DUMMY%I)%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)1705:                     CALL POTENTIAL(MI(DUMMY%I)%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
1712:                  ENDIF1706:                  ENDIF
1713:                  WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT)  ! FRQCONV2 is 1.0 by default for UNRES1707:                  WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)
1714:               ENDIF1708:               ENDIF
1715:            ELSEIF (AMHT) THEN1709:            ELSEIF (AMHT) THEN
1716:               HORDER=11710:               HORDER=1
1717:               FPGRP='C1'1711:               FPGRP='C1'
1718:               WRITE(88,'(I6,1X,A4)') HORDER,FPGRP1712:               WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
1719:               IF (.NOT.NOFRQS) THEN1713:               IF (.NOT.NOFRQS) THEN
1720:                  IF (ENDNUMHESS) THEN1714:                  IF (ENDNUMHESS) THEN
1721:                     CALL MAKENUMHESS(MI(DUMMY%I)%DATA%X,NATOMS)1715:                     CALL MAKENUMHESS(MI(DUMMY%I)%DATA%X,NATOMS)
1722:                  ELSE1716:                  ELSE
1723:                     CALL POTENTIAL(MI(DUMMY%I)%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)1717:                     CALL POTENTIAL(MI(DUMMY%I)%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
1724:                  ENDIF1718:                  ENDIF
1725:                  CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)1719:                  CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
1726:                  IF (HESSDUMPT) THEN1720:                  IF (HESSDUMPT) THEN
1727:                     LUNIT=GETUNIT()1721:                     LUNIT=GETUNIT()
1728:                     OPEN(LUNIT,FILE='minhess.plus',STATUS='UNKNOWN',POSITION ='APPEND')1722:                     OPEN(LUNIT,FILE='minhess.plus',STATUS='UNKNOWN',POSITION ='APPEND')
1729:                     WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)1723:                     WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)
1730:                     CLOSE(LUNIT)1724:                     CLOSE(LUNIT)
1731:                  ENDIF1725:                  ENDIF
1732:                  CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)1726:                  CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
1733:                  IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)1727:                  IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)
1734:                  ! sn402: I may have changed the behaviour here. I've added in the factor of FRQCONV2, which wasn't there1728:                  WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)
1735:                  ! previously. However, the default FRQCONV2 for AMH is not 1.0, so this will actually change the values 
1736:                  ! that are printed out, unless you use the 'FRQCONV' keyword to override the default value. 
1737:                  WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT) 
1738: ! jbr36 - writes the first input for qm rate calculations from classical rates1729: ! jbr36 - writes the first input for qm rate calculations from classical rates
1739:                     IF (INSTANTONSTARTDUMPT) THEN1730:                     IF (INSTANTONSTARTDUMPT) THEN
1740: !                      CALL POTENTIAL(MI(DUMMY%I)%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)1731: !                      CALL POTENTIAL(MI(DUMMY%I)%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
1741:                       LUNIT=5551732:                       LUNIT=555
1742:                       open(LUNIT,file='qmrate_reactant.plus.txt', action='write')1733:                       open(LUNIT,file='qmrate_reactant.plus.txt', action='write')
1743:                       write(LUNIT,'(a)') "Energy and Hessian eigenvalues of reactant.plus"1734:                       write(LUNIT,'(a)') "Energy and Hessian eigenvalues of reactant.plus"
1744:                       write(LUNIT,*) NATOMS,NATOMS*31735:                       write(LUNIT,*) NATOMS,NATOMS*3
1745:                       write(LUNIT,*) DUMMY11736:                       write(LUNIT,*) DUMMY1
1746:                       write(LUNIT,*) "Coordinates"1737:                       write(LUNIT,*) "Coordinates"
1747:                       write(LUNIT,*) MI(DUMMY%I)%DATA%X1738:                       write(LUNIT,*) MI(DUMMY%I)%DATA%X
1754:               ENDIF1745:               ENDIF
1755:            ELSE1746:            ELSE
1756:               IF (VARIABLES) THEN1747:               IF (VARIABLES) THEN
1757:                  HORDER=11748:                  HORDER=1
1758:                  FPGRP='C1'1749:                  FPGRP='C1'
1759:               ELSE1750:               ELSE
1760:                  CALL SYMMETRY(HORDER,.FALSE.,MI(DUMMY%I)%DATA%X,INERTIA)1751:                  CALL SYMMETRY(HORDER,.FALSE.,MI(DUMMY%I)%DATA%X,INERTIA)
1761:               ENDIF1752:               ENDIF
1762:               WRITE(88,'(I6,1X,A4)') HORDER,FPGRP1753:               WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
1763:               IF (.NOT.NOFRQS) THEN1754:               IF (.NOT.NOFRQS) THEN
1764:                  IF (RIGIDINIT) THEN1755:                   ! sn402: The following block copied across from MAKEALLPATHINFO without much testing.
1765:                     CALL GENRIGID_EIGENVALUES(MI(DUMMY%I)%DATA%X, ATMASS, DIAG, INFO)1756:                   ! sn402: Currently there are two different methods implemented for finding the normal modes of
 1757:                   ! local rigid bodies. GENRIGID_NORMALMODES makes use of the metric tensor formulation and so should
 1758:                   ! in principle be more accurate. Eventually this should be made the default (or indeed only) option
 1759:                   ! and the keyword METRICTENSOR should be removed.
 1760:                   IF (RIGIDINIT) THEN
 1761:                      IF(METRICTENSOR) THEN
 1762:                          CALL GENRIGID_NORMALMODES(MI(DUMMY%I)%DATA%X, ATMASS, DIAG, INFO)
 1763:                      ELSE
 1764:                          CALL GENRIGID_EIGENVALUES(MI(DUMMY%I)%DATA%X, ATMASS, DIAG, INFO)
 1765:                      ENDIF
1766: 1766: 
1767:                     IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN1767:                      IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
1768:                        CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)1768:                         CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
1769:                     ENDIF1769:                     ENDIF
1770: ! hk286 - compute normal modes for rigid body angle axis, go to moving frame1770: ! hk286 - compute normal modes for rigid body angle axis, go to moving frame
1771:                  ELSE IF (RBAAT) THEN1771:                   ELSE IF (RBAAT) THEN
1772:                     RBAANORMALMODET = .TRUE.1772:                     RBAANORMALMODET = .TRUE.
1773:                     CALL POTENTIAL(MI(DUMMY%I)%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)1773:                     CALL POTENTIAL(MI(DUMMY%I)%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
1774:                     CALL NRMLMD (MI(DUMMY%I)%DATA%X, DIAG, .FALSE.)1774:                     CALL NRMLMD (MI(DUMMY%I)%DATA%X, DIAG, .FALSE.)
1775:                     RBAANORMALMODET = .FALSE.1775:                     RBAANORMALMODET = .FALSE.
1776: !                   WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)1776: !                   WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)
1777:                  ELSE1777:                  ELSE
1778:                     IF (ENDNUMHESS) THEN1778:                     IF (ENDNUMHESS) THEN
1779:                         CALL MAKENUMHESS(MI(DUMMY%I)%DATA%X,NATOMS)1779:                         CALL MAKENUMHESS(MI(DUMMY%I)%DATA%X,NATOMS)
1780:                     ELSE1780:                     ELSE
1781:                        CALL POTENTIAL(MI(DUMMY%I)%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)1781:                         CALL POTENTIAL(MI(DUMMY%I)%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
1782:                     ENDIF1782:                     ENDIF
1783:                     CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)1783:                     CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
1784:                     IF (HESSDUMPT) THEN1784:                     IF (HESSDUMPT) THEN
1785:                         LUNIT=GETUNIT()1785:                         LUNIT=GETUNIT()
1786:                         OPEN(LUNIT,FILE='minhess.plus',STATUS='UNKNOWN',POSITION ='APPEND')1786:                         OPEN(LUNIT,FILE='minhess.plus',STATUS='UNKNOWN',POSITION ='APPEND')
1787:                         WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)1787:                         WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)
1788:                         CLOSE(LUNIT)1788:                         CLOSE(LUNIT)
1789:                     ENDIF1789:                     ENDIF
1790:                     CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)1790:                     CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
1791:                     IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)1791:                     IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)
1800:                       write(LUNIT,*) "Coordinates"1800:                       write(LUNIT,*) "Coordinates"
1801:                       write(LUNIT,*) MI(DUMMY%I)%DATA%X1801:                       write(LUNIT,*) MI(DUMMY%I)%DATA%X
1802:                       write(LUNIT,*) "Hessian Eigenvalues"1802:                       write(LUNIT,*) "Hessian Eigenvalues"
1803:                       write(LUNIT,*) DIAG1803:                       write(LUNIT,*) DIAG
1804:                       write(LUNIT,*) "Masses in amu (M(12C)=12)"1804:                       write(LUNIT,*) "Masses in amu (M(12C)=12)"
1805:                       write(LUNIT,*) ATMASS1805:                       write(LUNIT,*) ATMASS
1806:                       close(LUNIT)1806:                       close(LUNIT)
1807:                     ENDIF1807:                     ENDIF
1808:                  ENDIF1808:                  ENDIF
1809:                  IF (SDT.OR.TTM3T) THEN1809:                  IF (SDT.OR.TTM3T) THEN
1810:                     ! The defauly FRQCONV value for SDT and TTM3T is the same as CHARMM/AMBER, i.e. converts1810:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,NOPT)
1811:                     ! frequencies to SI units of (rad/s)^-2 
1812:                     WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT) 
1813:                  ELSEIF (BOWMANT) THEN1811:                  ELSEIF (BOWMANT) THEN
1814:                     WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT)1812:                     WRITE(88,'(3G20.10)') (DIAG(J2)*2625.47D26,J2=1,NOPT)
1815:                  ELSEIF (RIGIDINIT) THEN1813:                  ELSEIF (RIGIDINIT) THEN
1816:                     IF (MACHINE) THEN1814:                     IF (MACHINE) THEN
1817:                         WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)1815:                         WRITE(88) (DIAG(J2),J2=1,DEGFREEDOMS)
1818:                     ELSE1816:                     ELSE
1819:                         WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)1817:                         WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,DEGFREEDOMS)
1820:                     ENDIF1818:                     ENDIF
1821:                  ELSE1819:                  ELSE
1822:                     WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT)1820:                     WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)
1823:                  ENDIF1821:                  ENDIF
1824:               ENDIF1822:               ENDIF
1825:            ENDIF1823:            ENDIF
1826:         ELSE1824:         ELSE
1827:            IF (VARIABLES) THEN1825:            IF (VARIABLES) THEN
1828:               HORDER=11826:               HORDER=1
1829:               FPGRP='C1'1827:               FPGRP='C1'
1830:            ELSE1828:            ELSE
1831:               CALL SYMMETRY(HORDER,.FALSE.,MI(DUMMY%I)%DATA%X,INERTIA)1829:               CALL SYMMETRY(HORDER,.FALSE.,MI(DUMMY%I)%DATA%X,INERTIA)
1832:            ENDIF1830:            ENDIF
1909:               ! sn402: copied this across from MAKEALLPATHINFO1907:               ! sn402: copied this across from MAKEALLPATHINFO
1910:                 IF (RIGIDINIT) THEN1908:                 IF (RIGIDINIT) THEN
1911: ! hk286 - TS is recorded in rigid body coordinates1909: ! hk286 - TS is recorded in rigid body coordinates
1912:                      ATOMRIGIDCOORDT = .FALSE.1910:                      ATOMRIGIDCOORDT = .FALSE.
1913:                      CALL GENRIGID_EIGENVALUES(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X, ATMASS, DIAG, INFO)1911:                      CALL GENRIGID_EIGENVALUES(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X, ATMASS, DIAG, INFO)
1914:                      ATOMRIGIDCOORDT = .TRUE.1912:                      ATOMRIGIDCOORDT = .TRUE.
1915:                      IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN1913:                      IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
1916:                         CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)1914:                         CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
1917:                      ENDIF1915:                      ENDIF
1918:                      IF (MACHINE) THEN1916:                      IF (MACHINE) THEN
1919:                         WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)1917:                         WRITE(88) (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
1920:                      ELSE1918:                      ELSE
1921:                         WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)1919:                         WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
1922:                      ENDIF1920:                      ENDIF
1923:                 ELSE1921:                 ELSE
1924:                     IF (ENDNUMHESS) THEN1922:                     IF (ENDNUMHESS) THEN
1925:                         CALL MAKENUMHESS(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,NATOMS)1923:                         CALL MAKENUMHESS(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,NATOMS)
1926:                     ELSE1924:                     ELSE
1927:                         CALL POTENTIAL(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)1925:                         CALL POTENTIAL(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
1928:                     ENDIF1926:                     ENDIF
1929:                     CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)1927:                     CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
1930:                     IF (HESSDUMPT) THEN1928:                     IF (HESSDUMPT) THEN
1931:                         LUNIT=GETUNIT()1929:                         LUNIT=GETUNIT()
1945:                       write(LUNIT,*) DUMMY11943:                       write(LUNIT,*) DUMMY1
1946:                       write(LUNIT,*) "Coordinates"1944:                       write(LUNIT,*) "Coordinates"
1947:                       write(LUNIT,*) TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X1945:                       write(LUNIT,*) TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X
1948:                       write(LUNIT,*) "Hessian Eigenvalues"1946:                       write(LUNIT,*) "Hessian Eigenvalues"
1949:                       write(LUNIT,*) DIAG1947:                       write(LUNIT,*) DIAG
1950:                       write(LUNIT,*) "Masses in amu (M(12C)=12)"1948:                       write(LUNIT,*) "Masses in amu (M(12C)=12)"
1951:                       write(LUNIT,*) ATMASS1949:                       write(LUNIT,*) ATMASS
1952:                       close(LUNIT)1950:                       close(LUNIT)
1953:                     ENDIF1951:                     ENDIF
1954:                     IF (MACHINE) THEN1952:                     IF (MACHINE) THEN
1955:                         WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,NOPT)1953:                         WRITE(88) (DIAG(J2)*4.184D26,J2=1,NOPT)
1956:                     ELSE1954:                     ELSE
1957:                         WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT)1955:                         WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,NOPT)
1958:                     ENDIF1956:                     ENDIF
1959:                 ENDIF1957:                 ENDIF
1960:               ENDIF1958:               ENDIF
1961:            ELSE IF (AMBER12T.OR.AMBERT.OR.NABT) THEN1959:            ELSE IF (AMBER12T.OR.AMBERT.OR.NABT) THEN
1962:               IF (.NOT.MACROCYCLET) THEN1960:               IF (.NOT.MACROCYCLET) THEN
1963:                  HORDER=11961:                  HORDER=1
1964:                  FPGRP='C1'1962:                  FPGRP='C1'
1965:               ELSE1963:               ELSE
1966:                  CALL SYMMETRY(HORDER,.FALSE.,TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,INERTIA)1964:                  CALL SYMMETRY(HORDER,.FALSE.,TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,INERTIA)
1967:               ENDIF1965:               ENDIF
1974:               ! sn402: copied this across from MAKEALLPATHINFO1972:               ! sn402: copied this across from MAKEALLPATHINFO
1975:                 IF (RIGIDINIT) THEN1973:                 IF (RIGIDINIT) THEN
1976: ! hk286 - TS is recorded in rigid body coordinates1974: ! hk286 - TS is recorded in rigid body coordinates
1977:                      ATOMRIGIDCOORDT = .FALSE.1975:                      ATOMRIGIDCOORDT = .FALSE.
1978:                      CALL GENRIGID_EIGENVALUES(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X, ATMASS, DIAG, INFO)1976:                      CALL GENRIGID_EIGENVALUES(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X, ATMASS, DIAG, INFO)
1979:                      ATOMRIGIDCOORDT = .TRUE.1977:                      ATOMRIGIDCOORDT = .TRUE.
1980:                      IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN1978:                      IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
1981:                         CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)1979:                         CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
1982:                      ENDIF1980:                      ENDIF
1983:                      IF (MACHINE) THEN1981:                      IF (MACHINE) THEN
1984:                         WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)1982:                         WRITE(88) (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
1985:                      ELSE1983:                      ELSE
1986:                         WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)1984:                         WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
1987:                      ENDIF1985:                      ENDIF
1988:                 ELSE1986:                 ELSE
1989:                     IF (ENDNUMHESS.OR.AMBERT.OR.AMBER12T) THEN1987:                     IF (ENDNUMHESS.OR.AMBERT.OR.AMBER12T) THEN
1990:                         CALL MAKENUMHESS(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,NATOMS)1988:                         CALL MAKENUMHESS(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,NATOMS)
1991:                     ELSE1989:                     ELSE
1992:                         CALL POTENTIAL(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)1990:                         CALL POTENTIAL(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
1993:                     ENDIF1991:                     ENDIF
1994:                     CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)1992:                     CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
1995:                     IF (HESSDUMPT) THEN1993:                     IF (HESSDUMPT) THEN
1996:                         LUNIT=GETUNIT()1994:                         LUNIT=GETUNIT()
2010:                       write(LUNIT,*) DUMMY12008:                       write(LUNIT,*) DUMMY1
2011:                       write(LUNIT,*) "Coordinates"2009:                       write(LUNIT,*) "Coordinates"
2012:                       write(LUNIT,*) TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X2010:                       write(LUNIT,*) TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X
2013:                       write(LUNIT,*) "Hessian Eigenvalues"2011:                       write(LUNIT,*) "Hessian Eigenvalues"
2014:                       write(LUNIT,*) DIAG2012:                       write(LUNIT,*) DIAG
2015:                       write(LUNIT,*) "Masses in amu (M(12C)=12)"2013:                       write(LUNIT,*) "Masses in amu (M(12C)=12)"
2016:                       write(LUNIT,*) ATMASS2014:                       write(LUNIT,*) ATMASS
2017:                       close(LUNIT)2015:                       close(LUNIT)
2018:                     ENDIF2016:                     ENDIF
2019:                     IF (MACHINE) THEN2017:                     IF (MACHINE) THEN
2020:                         WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,NOPT)2018:                         WRITE(88) (DIAG(J2)*4.184D26,J2=1,NOPT)
2021:                     ELSE2019:                     ELSE
2022:                         WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT)2020:                         WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,NOPT)
2023:                     ENDIF2021:                     ENDIF
2024:                 ENDIF2022:                 ENDIF
2025:               ENDIF2023:               ENDIF
2026:            ELSEIF (UNRST) THEN2024:            ELSEIF (UNRST) THEN
2027:               HORDER=12025:               HORDER=1
2028:               FPGRP='C1'2026:               FPGRP='C1'
2029:               WRITE(88,'(I6,1X,A4)') HORDER,FPGRP2027:               WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
2030:               IF (.NOT.NOFRQS) THEN2028:               IF (.NOT.NOFRQS) THEN
2031:                  IF (ENDNUMHESS) THEN2029:                  IF (ENDNUMHESS) THEN
2032:                     CALL MAKENUMINTHESS(NINTS,NATOMS)2030:                     CALL MAKENUMINTHESS(NINTS,NATOMS)
2033:                     CALL GETSTUFF(KD,NNZ,NINTB)2031:                     CALL GETSTUFF(KD,NNZ,NINTB)
2034:                     CALL INTSECDET(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,NOPT,KD,NNZ,NINTB,DIAG)2032:                     CALL INTSECDET(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,NOPT,KD,NNZ,NINTB,DIAG)
2035:                  ELSE2033:                  ELSE
2036:                     CALL POTENTIAL(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)2034:                     CALL POTENTIAL(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
2037:                  ENDIF2035:                  ENDIF
2038:                  DO J2=1,NINTS-12036:                  DO J2=1,NINTS-1
2039:                     IF (DIAG(J2).LT.0.0D0) PRINT *,'Higher order saddle found in pathway - ts ',i,'eigenvalue ',DIAG(J2)2037:                     IF (DIAG(J2).LT.0.0D0) PRINT *,'Higher order saddle found in pathway - ts ',i,'eigenvalue ',DIAG(J2)
2040:                  END DO2038:                  END DO
2041:                  WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT)2039:                  WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)
2042:               ENDIF2040:               ENDIF
2043:            ELSEIF (AMHT) THEN2041:            ELSEIF (AMHT) THEN
2044:               WRITE(88,'(I6,1X,A4)') 1,' C1'2042:               WRITE(88,'(I6,1X,A4)') 1,' C1'
2045:               IF (.NOT.NOFRQS) THEN2043:               IF (.NOT.NOFRQS) THEN
2046:                  IF (ENDNUMHESS) THEN2044:                  IF (ENDNUMHESS) THEN
2047:                     CALL MAKENUMHESS(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,NATOMS)2045:                     CALL MAKENUMHESS(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,NATOMS)
2048:                  ELSE2046:                  ELSE
2049:                     CALL POTENTIAL(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)2047:                     CALL POTENTIAL(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
2050:                 ENDIF2048:                 ENDIF
2051:                 CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)2049:                 CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
2052:                  IF (HESSDUMPT) THEN2050:                  IF (HESSDUMPT) THEN
2053:                     LUNIT=GETUNIT()2051:                     LUNIT=GETUNIT()
2054:                     OPEN(LUNIT,FILE='tshess',STATUS='UNKNOWN',POSITION ='APPEND')2052:                     OPEN(LUNIT,FILE='tshess',STATUS='UNKNOWN',POSITION ='APPEND')
2055:                     WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)2053:                     WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)
2056:                     CLOSE(LUNIT)2054:                     CLOSE(LUNIT)
2057:                  ENDIF2055:                  ENDIF
2058:                 CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)2056:                 CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
2059:                 IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)2057:                 IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)
2060:                 WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT)2058:                 WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)
2061: ! jbr36 - writes the first input for qm rate calculations from classical rates2059: ! jbr36 - writes the first input for qm rate calculations from classical rates
2062:                     IF (INSTANTONSTARTDUMPT) THEN2060:                     IF (INSTANTONSTARTDUMPT) THEN
2063: !                      CALL POTENTIAL(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)2061: !                      CALL POTENTIAL(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
2064:                       LUNIT=5552062:                       LUNIT=555
2065:                       open(LUNIT,file='qmrate_ts.txt', action='write')2063:                       open(LUNIT,file='qmrate_ts.txt', action='write')
2066:                       write(LUNIT,'(a)') "Energy and Hessian eigenvalues of transition state"2064:                       write(LUNIT,'(a)') "Energy and Hessian eigenvalues of transition state"
2067:                       write(LUNIT,*) NATOMS,NATOMS*32065:                       write(LUNIT,*) NATOMS,NATOMS*3
2068:                       write(LUNIT,*) DUMMY12066:                       write(LUNIT,*) DUMMY1
2069:                       write(LUNIT,*) "Coordinates"2067:                       write(LUNIT,*) "Coordinates"
2070:                       write(LUNIT,*) TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X2068:                       write(LUNIT,*) TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X
2080:                  HORDER=12078:                  HORDER=1
2081:                  FPGRP='C1'2079:                  FPGRP='C1'
2082:               ELSE2080:               ELSE
2083:                  CALL SYMMETRY(HORDER,.FALSE.,TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,INERTIA)2081:                  CALL SYMMETRY(HORDER,.FALSE.,TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,INERTIA)
2084:               ENDIF2082:               ENDIF
2085:               WRITE(88,'(I6,1X,A4)') HORDER,FPGRP2083:               WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
2086:               IF (.NOT.NOFRQS) THEN2084:               IF (.NOT.NOFRQS) THEN
2087:               ! sn402: copied this across from MAKEALLPATHINFO2085:               ! sn402: copied this across from MAKEALLPATHINFO
2088:                   IF (RIGIDINIT) THEN2086:                   IF (RIGIDINIT) THEN
2089: ! hk286 - TS is recorded in rigid body coordinates2087: ! hk286 - TS is recorded in rigid body coordinates
2090: ! sn402 - but for some reason we have ATOMRIGIDCOORDT set to TRUE at this point (which suggests cartesian coordinates) 
2091: ! In order for GENRIGID_EIGENVALUES to work, we switch it to FALSE for the duration of this call. 
2092:                     ATOMRIGIDCOORDT = .FALSE.2088:                     ATOMRIGIDCOORDT = .FALSE.
2093:                     CALL GENRIGID_EIGENVALUES(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X, ATMASS, DIAG, INFO)2089:                     IF(METRICTENSOR) THEN
 2090:                         CALL GENRIGID_NORMALMODES(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X, ATMASS, DIAG, INFO)
 2091:                     ELSE
 2092:                         CALL GENRIGID_EIGENVALUES(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X, ATMASS, DIAG, INFO)
 2093:                     ENDIF
2094:                     ATOMRIGIDCOORDT = .TRUE.2094:                     ATOMRIGIDCOORDT = .TRUE.
2095:                     IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN2095:                     IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
2096:                         CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)2096:                         CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
2097:                     ENDIF2097:                     ENDIF
2098: ! hk286 - compute normal modes for rigid body angle axis, go to moving frame2098: ! hk286 - compute normal modes for rigid body angle axis, go to moving frame
2099:                   ELSE IF (RBAAT) THEN2099:                   ELSE IF (RBAAT) THEN
2100:                     RBAANORMALMODET = .TRUE.2100:                     RBAANORMALMODET = .TRUE.
2101:                     CALL POTENTIAL(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)2101:                     CALL POTENTIAL(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
2102:                     CALL NRMLMD (TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X, DIAG, .FALSE.)2102:                     CALL NRMLMD (TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X, DIAG, .FALSE.)
2103:                     RBAANORMALMODET = .FALSE.2103:                     RBAANORMALMODET = .FALSE.
2129:                       write(LUNIT,*) TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X2129:                       write(LUNIT,*) TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X
2130:                       write(LUNIT,*) "Hessian Eigenvalues"2130:                       write(LUNIT,*) "Hessian Eigenvalues"
2131:                       write(LUNIT,*) DIAG2131:                       write(LUNIT,*) DIAG
2132:                       write(LUNIT,*) "Masses in amu (M(12C)=12)"2132:                       write(LUNIT,*) "Masses in amu (M(12C)=12)"
2133:                       write(LUNIT,*) ATMASS2133:                       write(LUNIT,*) ATMASS
2134:                       close(LUNIT)2134:                       close(LUNIT)
2135:                     ENDIF2135:                     ENDIF
2136:                   ENDIF2136:                   ENDIF
2137: 2137: 
2138:                  IF (SDT.OR.TTM3T) THEN2138:                  IF (SDT.OR.TTM3T) THEN
2139:                     WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT)2139:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,NOPT)
2140:                  ELSEIF (BOWMANT) THEN2140:                  ELSEIF (BOWMANT) THEN
2141:                     WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT)2141:                     WRITE(88,'(3G20.10)') (DIAG(J2)*2625.47D26,J2=1,NOPT)
2142:                  ELSEIF (RIGIDINIT) THEN2142:                  ELSEIF (RIGIDINIT) THEN
2143:                     IF (MACHINE) THEN2143:                     IF (MACHINE) THEN
2144:                         WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)2144:                         WRITE(88) (DIAG(J2),J2=1,DEGFREEDOMS)
2145:                     ELSE2145:                     ELSE
2146:                         WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)2146:                         WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,DEGFREEDOMS)
2147:                     ENDIF2147:                     ENDIF
2148:                  ELSE2148:                  ELSE
2149:                     WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT)2149:                     WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)
2150:                  ENDIF2150:                  ENDIF
2151:               ENDIF2151:               ENDIF
2152:            ENDIF2152:            ENDIF
2153:         ELSE2153:         ELSE
2154:            IF (VARIABLES) THEN2154:            IF (VARIABLES) THEN
2155:               HORDER=12155:               HORDER=1
2156:               FPGRP='C1'2156:               FPGRP='C1'
2157:            ELSE2157:            ELSE
2158:               CALL SYMMETRY(HORDER,.FALSE.,TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,INERTIA)2158:               CALL SYMMETRY(HORDER,.FALSE.,TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,INERTIA)
2159:            ENDIF2159:            ENDIF
2160:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP2160:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
2161:         ENDIF2161:         ENDIF
2162: 2162: 
2163:         ! We now align the coords of the transition state with the first minimum in the triple.2163: !        write(*,*) "Calling MINPERMDIST now. First argument is minimum, second is TS. I think the TS is in AA coords."
2164:         IF(RIGIDINIT) THEN2164:         IF(RIGIDINIT) THEN
2165:             ! Need to put the TS back into cartesian coords in order to align it with the first minimum 
2166:             CALL TRANSFORMRIGIDTOC (1, NRIGIDBODY, XCOORDS, TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X(1:DEGFREEDOMS))2165:             CALL TRANSFORMRIGIDTOC (1, NRIGIDBODY, XCOORDS, TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X(1:DEGFREEDOMS))
2167:             CALL MINPERMDIST(MI(DUMMY%I)%DATA%X,XCOORDS,NATOMS,DEBUG,PARAM1,PARAM2,PARAM3,BULKT,TWOD,DIST,DIST2,RIGIDBODY,RMAT)2166:             CALL MINPERMDIST(MI(DUMMY%I)%DATA%X,XCOORDS,NATOMS,DEBUG,PARAM1,PARAM2,PARAM3,BULKT,TWOD,DIST,DIST2,RIGIDBODY,RMAT)
2168:         ELSE2167:         ELSE
2169:             CALL MINPERMDIST(MI(DUMMY%I)%DATA%X,TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,NATOMS,DEBUG, &2168:             CALL MINPERMDIST(MI(DUMMY%I)%DATA%X,TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,NATOMS,DEBUG, &
2170:     &                    PARAM1,PARAM2,PARAM3,BULKT,TWOD,DIST,DIST2,RIGIDBODY,RMAT)2169:     &                    PARAM1,PARAM2,PARAM3,BULKT,TWOD,DIST,DIST2,RIGIDBODY,RMAT)
2171:         ENDIF2170:         ENDIF
 2171: !        write(*,*) "After MINPERMDIST call."
2172: 2172: 
2173:         DISTPF=DIST2173:         DISTPF=DIST
2174:         IF (MACHINE) THEN2174:         IF (MACHINE) THEN
2175:             IF (RIGIDINIT) THEN2175:             IF (RIGIDINIT) THEN
2176: !                CALL TRANSFORMRIGIDTOC (1, NRIGIDBODY, XCOORDS, TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X(1:DEGFREEDOMS))2176: !                CALL TRANSFORMRIGIDTOC (1, NRIGIDBODY, XCOORDS, TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X(1:DEGFREEDOMS))
2177:                 WRITE(88) (XCOORDS(J2),J2=1,NOPT)2177:                 WRITE(88) (XCOORDS(J2),J2=1,NOPT)
2178:             ELSE2178:             ELSE
2179:                 WRITE(88) (TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X(J2),J2=1,NOPT)2179:                 WRITE(88) (TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X(J2),J2=1,NOPT)
2180:             ENDIF2180:             ENDIF
2181:         ELSEIF (AMHT) THEN2181:         ELSEIF (AMHT) THEN
2230: 2230: 
2231: !2231: !
2232: !  Dump min to path.info2232: !  Dump min to path.info
2233: !2233: !
2234:      SUBROUTINE MAKEMINPATHINFO(MINIMUM)2234:      SUBROUTINE MAKEMINPATHINFO(MINIMUM)
2235:      USE SYMINF 2235:      USE SYMINF 
2236:      USE MODHESS2236:      USE MODHESS
2237:      USE MODCHARMM2237:      USE MODCHARMM
2238:      USE MODUNRES2238:      USE MODUNRES
2239:      USE KEY, ONLY: FILTH, FILTHSTR, UNRST, TWOD, BULKT, MACHINE, NOFRQS, AMBERT, NABT, AMHT, SEQ, TARFL, NRES_AMH_TEMP, SDT, &2239:      USE KEY, ONLY: FILTH, FILTHSTR, UNRST, TWOD, BULKT, MACHINE, NOFRQS, AMBERT, NABT, AMHT, SEQ, TARFL, NRES_AMH_TEMP, SDT, &
2240:           AMBER12T, RBAAT, MACROCYCLET, GTHOMSONT, TTM3T, BOWMANT, HESSDUMPT, INSTANTONSTARTDUMPT,FREEZE,NONFREEZE, FRQCONV22240:           AMBER12T, RBAAT, MACROCYCLET, GTHOMSONT, TTM3T, BOWMANT, HESSDUMPT, INSTANTONSTARTDUMPT,FREEZE,NONFREEZE, METRICTENSOR ! hk286
2241:      USE COMMONS, ONLY: ATMASS, NINTS, ZSYM2241:      USE COMMONS, ONLY: ATMASS, NINTS, ZSYM
2242:      USE PORFUNCS2242:      USE PORFUNCS
2243:      USE GENRIGID2243:      USE GENRIGID
2244:      IMPLICIT NONE2244:      IMPLICIT NONE
2245: 2245: 
2246:      CHARACTER(LEN=20) :: PINFOSTRING2246:      CHARACTER(LEN=20) :: PINFOSTRING
2247:      DOUBLE PRECISION :: DIHE,ALLANG,DISTPF,DUMMY1,GRAD(3*NATOMS),RMS,DIAG(3*NATOMS),TEMPA(9*NATOMS),DUMQ(3*NATOMS)2247:      DOUBLE PRECISION :: DIHE,ALLANG,DISTPF,DUMMY1,GRAD(3*NATOMS),RMS,DIAG(3*NATOMS),TEMPA(9*NATOMS),DUMQ(3*NATOMS)
2248:      INTEGER :: HORDER,INFO,J2,K1,RECLEN,ISTAT,J1,LUNIT,GETUNIT, MINIMUM2248:      INTEGER :: HORDER,INFO,J2,K1,RECLEN,ISTAT,J1,LUNIT,GETUNIT, MINIMUM
2249:      LOGICAL :: BTEST,KD,NNZ,NINTB,MINFRQDONE2249:      LOGICAL :: BTEST,KD,NNZ,NINTB,MINFRQDONE
2250:      DOUBLE PRECISION :: QMIN(3*NATOMS),FRQSMIN(3*NATOMS),EMIN,INERTIA(3,3)2250:      DOUBLE PRECISION :: QMIN(3*NATOMS),FRQSMIN(3*NATOMS),EMIN,INERTIA(3,3)
2288:            ELSE2288:            ELSE
2289:               WRITE(88,'(I6,1X,A4)') HORDER,FPGRP2289:               WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
2290:            ENDIF2290:            ENDIF
2291:            IF (.NOT.NOFRQS) THEN2291:            IF (.NOT.NOFRQS) THEN
2292:               IF (RIGIDINIT) THEN2292:               IF (RIGIDINIT) THEN
2293:                  CALL GENRIGID_EIGENVALUES(QMIN, ATMASS, DIAG, INFO)2293:                  CALL GENRIGID_EIGENVALUES(QMIN, ATMASS, DIAG, INFO)
2294:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN2294:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
2295:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)2295:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
2296:                  ENDIF2296:                  ENDIF
2297:                  IF (MACHINE) THEN2297:                  IF (MACHINE) THEN
2298:                     WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)2298:                     WRITE(88) (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
2299:                  ELSE2299:                  ELSE
2300:                     WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)2300:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
2301:                  ENDIF2301:                  ENDIF
2302:               ELSE2302:               ELSE
2303:                  IF (ENDNUMHESS) THEN2303:                  IF (ENDNUMHESS) THEN
2304:                     CALL MAKENUMHESS(QMIN,NATOMS)2304:                     CALL MAKENUMHESS(QMIN,NATOMS)
2305:                  ELSE2305:                  ELSE
2306:                     CALL POTENTIAL(QMIN,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)2306:                     CALL POTENTIAL(QMIN,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
2307:                  ENDIF2307:                  ENDIF
2308:                  CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)2308:                  CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
2309:                  IF (HESSDUMPT) THEN2309:                  IF (HESSDUMPT) THEN
2310:                     LUNIT=GETUNIT()2310:                     LUNIT=GETUNIT()
2323:                     WRITE(LUNIT,*) DUMMY12323:                     WRITE(LUNIT,*) DUMMY1
2324:                     WRITE(LUNIT,*) "Coordinates"2324:                     WRITE(LUNIT,*) "Coordinates"
2325:                     WRITE(LUNIT,*) QMIN2325:                     WRITE(LUNIT,*) QMIN
2326:                     WRITE(LUNIT,*) "Hessian Eigenvalues"2326:                     WRITE(LUNIT,*) "Hessian Eigenvalues"
2327:                     WRITE(LUNIT,*) DIAG2327:                     WRITE(LUNIT,*) DIAG
2328:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"2328:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"
2329:                     WRITE(LUNIT,*) ATMASS2329:                     WRITE(LUNIT,*) ATMASS
2330:                     CLOSE(LUNIT)2330:                     CLOSE(LUNIT)
2331:                  ENDIF2331:                  ENDIF
2332:                  IF (MACHINE) THEN2332:                  IF (MACHINE) THEN
2333:                     WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,3*NATOMS)2333:                     WRITE(88) (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
2334:                  ELSE2334:                  ELSE
2335:                     WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,3*NATOMS)2335:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
2336:                  ENDIF2336:                  ENDIF
2337:               ENDIF2337:               ENDIF
2338:            ENDIF2338:            ENDIF
2339:         ELSEIF (AMBER12T.OR.AMBERT.OR.NABT) THEN2339:         ELSEIF (AMBER12T.OR.AMBERT.OR.NABT) THEN
2340:            IF (.NOT.MACROCYCLET) THEN2340:            IF (.NOT.MACROCYCLET) THEN
2341:               HORDER=1 2341:               HORDER=1 
2342:               FPGRP='C1'2342:               FPGRP='C1'
2343:            ELSE2343:            ELSE
2344:               CALL SYMMETRY(HORDER,.FALSE.,QMIN,INERTIA)2344:               CALL SYMMETRY(HORDER,.FALSE.,QMIN,INERTIA)
2345:            ENDIF2345:            ENDIF
2348:            ELSE2348:            ELSE
2349:               WRITE(88,'(I6,1X,A4)') HORDER,FPGRP2349:               WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
2350:            ENDIF2350:            ENDIF
2351:            IF (.NOT.NOFRQS) THEN2351:            IF (.NOT.NOFRQS) THEN
2352:               IF (RIGIDINIT) THEN2352:               IF (RIGIDINIT) THEN
2353:                  CALL GENRIGID_EIGENVALUES(QMIN, ATMASS, DIAG, INFO)2353:                  CALL GENRIGID_EIGENVALUES(QMIN, ATMASS, DIAG, INFO)
2354:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN2354:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
2355:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)2355:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
2356:                  ENDIF2356:                  ENDIF
2357:                  IF (MACHINE) THEN2357:                  IF (MACHINE) THEN
2358:                     WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)2358:                     WRITE(88) (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
2359:                  ELSE2359:                  ELSE
2360:                     WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)2360:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
2361:                  ENDIF2361:                  ENDIF
2362:               ELSE2362:               ELSE
2363:                  IF (ENDNUMHESS.OR.AMBERT.OR.AMBER12T) THEN2363:                  IF (ENDNUMHESS.OR.AMBERT.OR.AMBER12T) THEN
2364:                     CALL MAKENUMHESS(QMIN,NATOMS)2364:                     CALL MAKENUMHESS(QMIN,NATOMS)
2365:                  ELSE2365:                  ELSE
2366:                     CALL POTENTIAL(QMIN,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)2366:                     CALL POTENTIAL(QMIN,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
2367:                  ENDIF2367:                  ENDIF
2368:                  CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)2368:                  CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
2369:                  IF (HESSDUMPT) THEN2369:                  IF (HESSDUMPT) THEN
2370:                     LUNIT=GETUNIT()2370:                     LUNIT=GETUNIT()
2389:                     WRITE(LUNIT,*) DUMMY12389:                     WRITE(LUNIT,*) DUMMY1
2390:                     WRITE(LUNIT,*) "Coordinates"2390:                     WRITE(LUNIT,*) "Coordinates"
2391:                     WRITE(LUNIT,*) QMIN2391:                     WRITE(LUNIT,*) QMIN
2392:                     WRITE(LUNIT,*) "Hessian Eigenvalues"2392:                     WRITE(LUNIT,*) "Hessian Eigenvalues"
2393:                     WRITE(LUNIT,*) DIAG2393:                     WRITE(LUNIT,*) DIAG
2394:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"2394:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"
2395:                     WRITE(LUNIT,*) ATMASS2395:                     WRITE(LUNIT,*) ATMASS
2396:                     CLOSE(LUNIT)2396:                     CLOSE(LUNIT)
2397:                  ENDIF2397:                  ENDIF
2398:                  IF (MACHINE) THEN2398:                  IF (MACHINE) THEN
2399:                     WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,3*NATOMS)2399:                     WRITE(88) (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
2400:                  ELSE2400:                  ELSE
2401:                     WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,3*NATOMS)2401:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
2402:                  ENDIF2402:                  ENDIF
2403:               ENDIF2403:               ENDIF
2404:            ENDIF2404:            ENDIF
2405:         ELSEIF (UNRST) THEN2405:         ELSEIF (UNRST) THEN
2406:            HORDER=12406:            HORDER=1
2407:            FPGRP='C1'2407:            FPGRP='C1'
2408:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP2408:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
2409:            IF (.NOT.NOFRQS) THEN2409:            IF (.NOT.NOFRQS) THEN
2410:               IF (ENDNUMHESS) THEN2410:               IF (ENDNUMHESS) THEN
2411:                  CALL MAKENUMINTHESS(NINTS,NATOMS)2411:                  CALL MAKENUMINTHESS(NINTS,NATOMS)
2412:                  CALL GETSTUFF(KD,NNZ,NINTB)2412:                  CALL GETSTUFF(KD,NNZ,NINTB)
2413:                  CALL INTSECDET(QMIN,3*NATOMS,KD,NNZ,NINTB,DIAG)2413:                  CALL INTSECDET(QMIN,3*NATOMS,KD,NNZ,NINTB,DIAG)
2414:               ELSE2414:               ELSE
2415:                  CALL POTENTIAL(QMIN,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)2415:                  CALL POTENTIAL(QMIN,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
2416:               ENDIF2416:               ENDIF
2417:               WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,3*NATOMS)2417:               WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,3*NATOMS)
2418:            ENDIF2418:            ENDIF
2419:         ELSEIF (AMHT) THEN2419:         ELSEIF (AMHT) THEN
2420:            WRITE(88,'(I6,1X,A4)') 1,' C1'2420:            WRITE(88,'(I6,1X,A4)') 1,' C1'
2421:            IF (.NOT.NOFRQS) THEN2421:            IF (.NOT.NOFRQS) THEN
2422:               IF (ENDNUMHESS) THEN2422:               IF (ENDNUMHESS) THEN
2423:                  CALL MAKENUMHESS(QMIN,NATOMS)2423:                  CALL MAKENUMHESS(QMIN,NATOMS)
2424:               ELSE2424:               ELSE
2425:                  CALL POTENTIAL(QMIN,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)2425:                  CALL POTENTIAL(QMIN,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
2426:               ENDIF2426:               ENDIF
2427:               CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)2427:               CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
2428:                  IF (HESSDUMPT) THEN2428:                  IF (HESSDUMPT) THEN
2429:                     LUNIT=GETUNIT()2429:                     LUNIT=GETUNIT()
2430:                     OPEN(LUNIT,FILE='minhess.plus',STATUS='UNKNOWN',POSITION ='APPEND')2430:                     OPEN(LUNIT,FILE='minhess.plus',STATUS='UNKNOWN',POSITION ='APPEND')
2431:                     WRITE(LUNIT,'(6G20.10)') HESS(1:3*NATOMS,1:3*NATOMS)2431:                     WRITE(LUNIT,'(6G20.10)') HESS(1:3*NATOMS,1:3*NATOMS)
2432:                     CLOSE(LUNIT)2432:                     CLOSE(LUNIT)
2433:                  ENDIF2433:                  ENDIF
2434:               CALL DSYEV('N','U',3*NATOMS,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)2434:               CALL DSYEV('N','U',3*NATOMS,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
2435:               IF (DIAG(1).LT.DIAG(3*NATOMS)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,3*NATOMS,3*NATOMS)2435:               IF (DIAG(1).LT.DIAG(3*NATOMS)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,3*NATOMS,3*NATOMS)
2436:               WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,3*NATOMS)2436:               WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,3*NATOMS)
2437: ! jbr36 - writes the first input for qm rate calculations from classical rates2437: ! jbr36 - writes the first input for qm rate calculations from classical rates
2438:                     IF (INSTANTONSTARTDUMPT) THEN2438:                     IF (INSTANTONSTARTDUMPT) THEN
2439: !                      CALL POTENTIAL(QPLUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)2439: !                      CALL POTENTIAL(QPLUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
2440:                       LUNIT=5552440:                       LUNIT=555
2441:                       open(LUNIT,file='qmrate_reactant.plus.txt', action='write')2441:                       open(LUNIT,file='qmrate_reactant.plus.txt', action='write')
2442:                       write(LUNIT,'(a)') "Energy and Hessian eigenvalues of reactant.plus"2442:                       write(LUNIT,'(a)') "Energy and Hessian eigenvalues of reactant.plus"
2443:                       write(LUNIT,*) NATOMS,NATOMS*32443:                       write(LUNIT,*) NATOMS,NATOMS*3
2444:                       write(LUNIT,*) DUMMY12444:                       write(LUNIT,*) DUMMY1
2445:                       write(LUNIT,*) "Coordinates"2445:                       write(LUNIT,*) "Coordinates"
2446:                       write(LUNIT,*) QMIN2446:                       write(LUNIT,*) QMIN
2467:                  LUNIT=GETUNIT()2467:                  LUNIT=GETUNIT()
2468:                  OPEN(LUNIT,FILE='minhess.plus',STATUS='UNKNOWN',POSITION ='APPEND')2468:                  OPEN(LUNIT,FILE='minhess.plus',STATUS='UNKNOWN',POSITION ='APPEND')
2469:                  WRITE(LUNIT,'(6G20.10)') HESS(1:3*NATOMS,1:3*NATOMS)2469:                  WRITE(LUNIT,'(6G20.10)') HESS(1:3*NATOMS,1:3*NATOMS)
2470:                  CLOSE(LUNIT)2470:                  CLOSE(LUNIT)
2471:               ENDIF2471:               ENDIF
2472:               CALL DSYEV('N','U',3*NATOMS,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)2472:               CALL DSYEV('N','U',3*NATOMS,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
2473:               IF (DIAG(1).LT.DIAG(3*NATOMS)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,3*NATOMS,3*NATOMS)2473:               IF (DIAG(1).LT.DIAG(3*NATOMS)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,3*NATOMS,3*NATOMS)
2474:            ENDIF2474:            ENDIF
2475:            WRITE(88,'(3G20.10)') (1.0D10, J2=1, NATOMS)2475:            WRITE(88,'(3G20.10)') (1.0D10, J2=1, NATOMS)
2476:            IF (SDT.OR.TTM3T) THEN2476:            IF (SDT.OR.TTM3T) THEN
2477:               ! Surely this is nonsense? We can't have SDT and GTHOMSONT both true at the same time???2477:               WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,2*NATOMS)
2478:               WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,2*NATOMS) 
2479:            ELSEIF (BOWMANT) THEN2478:            ELSEIF (BOWMANT) THEN
2480:               WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,2*NATOMS)2479:               WRITE(88,'(3G20.10)') (DIAG(J2)*2625.47D26,J2=1,2*NATOMS)
2481:            ELSE2480:            ELSE
2482:               WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,2*NATOMS)2481:               WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,2*NATOMS)
2483:            ENDIF2482:            ENDIF
2484:            2483:            
2485:         ELSE2484:         ELSE
2486:            CALL SYMMETRY(HORDER,.FALSE.,QMIN,INERTIA)2485:            CALL SYMMETRY(HORDER,.FALSE.,QMIN,INERTIA)
2487:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP2486:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
2488:            IF (.NOT.NOFRQS) THEN2487:            IF (.NOT.NOFRQS) THEN
 2488:               ! sn402: Currently there are two different methods implemented for finding the normal modes of
 2489:               ! local rigid bodies. GENRIGID_NORMALMODES makes use of the metric tensor formulation and so should
 2490:               ! in principle be more accurate. Eventually this should be made the default (or indeed only) option
 2491:               ! and the keyword METRICTENSOR should be removed.
2489:               IF (RIGIDINIT) THEN2492:               IF (RIGIDINIT) THEN
2490:                  CALL GENRIGID_EIGENVALUES(QMIN, ATMASS, DIAG, INFO)2493:                  IF(METRICTENSOR) THEN
 2494:                      write(*,*) "ATMASS going in:"
 2495:                      write(*,*) ATMASS
 2496:                      CALL GENRIGID_NORMALMODES(QMIN, ATMASS, DIAG, INFO)
 2497:                  ELSE
 2498:                      CALL GENRIGID_EIGENVALUES(QMIN, ATMASS, DIAG, INFO)
 2499:                  ENDIF
2491: 2500: 
2492:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN2501:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
2493:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)2502:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
2494:                  ENDIF2503:                  ENDIF
2495: ! hk286 - compute normal modes for rigid body angle axis, go to moving frame2504: ! hk286 - compute normal modes for rigid body angle axis, go to moving frame
2496:               ELSE IF (RBAAT) THEN2505:               ELSE IF (RBAAT) THEN
2497:                  RBAANORMALMODET = .TRUE.2506:                  RBAANORMALMODET = .TRUE.
2498:                  CALL POTENTIAL(QMIN,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)2507:                  CALL POTENTIAL(QMIN,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
2499:                  CALL NRMLMD (QMIN, DIAG, .FALSE.)2508:                  CALL NRMLMD (QMIN, DIAG, .FALSE.)
2500:                  RBAANORMALMODET = .FALSE.2509:                  RBAANORMALMODET = .FALSE.
2523:                     WRITE(LUNIT,*) "Coordinates"2532:                     WRITE(LUNIT,*) "Coordinates"
2524:                     WRITE(LUNIT,*) QMIN2533:                     WRITE(LUNIT,*) QMIN
2525:                     WRITE(LUNIT,*) "Hessian Eigenvalues"2534:                     WRITE(LUNIT,*) "Hessian Eigenvalues"
2526:                     WRITE(LUNIT,*) DIAG2535:                     WRITE(LUNIT,*) DIAG
2527:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"2536:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"
2528:                     WRITE(LUNIT,*) ATMASS2537:                     WRITE(LUNIT,*) ATMASS
2529:                     CLOSE(LUNIT)2538:                     CLOSE(LUNIT)
2530:                  ENDIF2539:                  ENDIF
2531:               ENDIF2540:               ENDIF
2532:               IF (SDT.OR.TTM3T) THEN2541:               IF (SDT.OR.TTM3T) THEN
2533:                  WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,3*NATOMS)2542:                  WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
2534:               ELSEIF (BOWMANT) THEN2543:               ELSEIF (BOWMANT) THEN
2535:                  WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,3*NATOMS)2544:                  WRITE(88,'(3G20.10)') (DIAG(J2)*2625.47D26,J2=1,3*NATOMS)
2536:               ELSEIF (RIGIDINIT) THEN2545:               ELSEIF (RIGIDINIT) THEN
2537:                  IF (MACHINE) THEN2546:                  IF (MACHINE) THEN
2538: !                    WRITE(88) (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)2547: !                    WRITE(88) (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
2539:                     WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)2548:                     WRITE(88) (DIAG(J2),J2=1,DEGFREEDOMS)
2540:                  ELSE2549:                  ELSE
2541:                     WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)2550:                     WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,DEGFREEDOMS)
2542: !                    WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)2551: !                    WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
2543:                  ENDIF2552:                  ENDIF
2544:               ELSE2553:               ELSE
2545:                  WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,3*NATOMS)2554:                  WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,3*NATOMS)
2546:               ENDIF2555:               ENDIF
2547:            ENDIF2556:            ENDIF
2548:         ENDIF2557:         ENDIF
2549:      ELSE2558:      ELSE
2550:         CALL SYMMETRY(HORDER,.FALSE.,QMIN,INERTIA)2559:         CALL SYMMETRY(HORDER,.FALSE.,QMIN,INERTIA)
2551:         WRITE(88,'(I6,1X,A4)') HORDER,FPGRP2560:         WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
2552:      ENDIF2561:      ENDIF
2553:      IF (MACHINE) THEN2562:      IF (MACHINE) THEN
2554:         IF (GTHOMSONT) THEN2563:         IF (GTHOMSONT) THEN
2555:            CALL GTHOMSONANGTOC(TMPCOORDS, QMIN, NATOMS)2564:            CALL GTHOMSONANGTOC(TMPCOORDS, QMIN, NATOMS)
2595: !2604: !
2596: !  Dump TS to path.info 2605: !  Dump TS to path.info 
2597: !2606: !
2598:      SUBROUTINE MAKETSPATHINFO(TSN)2607:      SUBROUTINE MAKETSPATHINFO(TSN)
2599: 2608: 
2600:      USE SYMINF 2609:      USE SYMINF 
2601:      USE MODHESS2610:      USE MODHESS
2602:      USE MODCHARMM2611:      USE MODCHARMM
2603:      USE MODUNRES2612:      USE MODUNRES
2604:      USE KEY, ONLY: FILTH, FILTHSTR, UNRST, TWOD, BULKT, MACHINE, NOFRQS, AMBERT, NABT, AMHT, SEQ, TARFL, NRES_AMH_TEMP, SDT, &2613:      USE KEY, ONLY: FILTH, FILTHSTR, UNRST, TWOD, BULKT, MACHINE, NOFRQS, AMBERT, NABT, AMHT, SEQ, TARFL, NRES_AMH_TEMP, SDT, &
2605:           AMBER12T, RBAAT, MACROCYCLET, GTHOMSONT, TTM3T, BOWMANT, HESSDUMPT, INSTANTONSTARTDUMPT,FREEZE,NONFREEZE, FRQCONV22614:           AMBER12T, RBAAT, MACROCYCLET, GTHOMSONT, TTM3T, BOWMANT, HESSDUMPT, INSTANTONSTARTDUMPT,FREEZE,NONFREEZE, METRICTENSOR ! hk286
2606:      USE COMMONS, ONLY: ATMASS, NINTS, ZSYM2615:      USE COMMONS, ONLY: ATMASS, NINTS, ZSYM
2607:      USE PORFUNCS2616:      USE PORFUNCS
2608:      USE GENRIGID2617:      USE GENRIGID
2609:      IMPLICIT NONE2618:      IMPLICIT NONE
2610: 2619: 
2611:      CHARACTER(LEN=20) :: PINFOSTRING2620:      CHARACTER(LEN=20) :: PINFOSTRING
2612:      DOUBLE PRECISION :: DIHE,ALLANG,DISTPF,DUMMY1,GRAD(3*NATOMS),RMS,DIAG(3*NATOMS),TEMPA(9*NATOMS),DUMQ(3*NATOMS)2621:      DOUBLE PRECISION :: DIHE,ALLANG,DISTPF,DUMMY1,GRAD(3*NATOMS),RMS,DIAG(3*NATOMS),TEMPA(9*NATOMS),DUMQ(3*NATOMS)
2613:      INTEGER :: HORDER,INFO,J2,K1,RECLEN,ISTAT,J1,LUNIT,GETUNIT,TSN2622:      INTEGER :: HORDER,INFO,J2,K1,RECLEN,ISTAT,J1,LUNIT,GETUNIT,TSN
2614:      LOGICAL :: BTEST,KD,NNZ,NINTB,TSFRQDONE2623:      LOGICAL :: BTEST,KD,NNZ,NINTB,TSFRQDONE
2615:      DOUBLE PRECISION :: QTS(3*NATOMS),FRQSTS(3*NATOMS),ETS,INERTIA(3,3)2624:      DOUBLE PRECISION :: QTS(3*NATOMS),FRQSTS(3*NATOMS),ETS,INERTIA(3,3)
2655:            IF (.NOT.NOFRQS) THEN2664:            IF (.NOT.NOFRQS) THEN
2656:               IF (RIGIDINIT) THEN2665:               IF (RIGIDINIT) THEN
2657: ! hk286 - TS is recorded in rigid body coordinates2666: ! hk286 - TS is recorded in rigid body coordinates
2658:                  ATOMRIGIDCOORDT = .FALSE.2667:                  ATOMRIGIDCOORDT = .FALSE.
2659:                  CALL GENRIGID_EIGENVALUES(QTS, ATMASS, DIAG, INFO)2668:                  CALL GENRIGID_EIGENVALUES(QTS, ATMASS, DIAG, INFO)
2660:                  ATOMRIGIDCOORDT = .TRUE.2669:                  ATOMRIGIDCOORDT = .TRUE.
2661:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN2670:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
2662:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)2671:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
2663:                  ENDIF2672:                  ENDIF
2664:                  IF (MACHINE) THEN2673:                  IF (MACHINE) THEN
2665:                     WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)2674:                     WRITE(88) (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
2666:                  ELSE2675:                  ELSE
2667:                     WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)2676:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
2668:                  ENDIF2677:                  ENDIF
2669:               ELSE2678:               ELSE
2670:                  IF (ENDNUMHESS) THEN2679:                  IF (ENDNUMHESS) THEN
2671:                     CALL MAKENUMHESS(QTS,NATOMS)2680:                     CALL MAKENUMHESS(QTS,NATOMS)
2672:                  ELSE2681:                  ELSE
2673:                     CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)2682:                     CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
2674:                  ENDIF2683:                  ENDIF
2675:                  CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)2684:                  CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
2676:                  IF (HESSDUMPT) THEN2685:                  IF (HESSDUMPT) THEN
2677:                     LUNIT=GETUNIT()2686:                     LUNIT=GETUNIT()
2690:                     WRITE(LUNIT,*) DUMMY12699:                     WRITE(LUNIT,*) DUMMY1
2691:                     WRITE(LUNIT,*) "Coordinates"2700:                     WRITE(LUNIT,*) "Coordinates"
2692:                     WRITE(LUNIT,*) QTS2701:                     WRITE(LUNIT,*) QTS
2693:                     WRITE(LUNIT,*) "Hessian Eigenvalues"2702:                     WRITE(LUNIT,*) "Hessian Eigenvalues"
2694:                     WRITE(LUNIT,*) DIAG2703:                     WRITE(LUNIT,*) DIAG
2695:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"2704:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"
2696:                     WRITE(LUNIT,*) ATMASS2705:                     WRITE(LUNIT,*) ATMASS
2697:                     CLOSE(LUNIT)2706:                     CLOSE(LUNIT)
2698:                  ENDIF2707:                  ENDIF
2699:                  IF (MACHINE) THEN2708:                  IF (MACHINE) THEN
2700:                     WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,3*NATOMS)2709:                     WRITE(88) (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
2701:                  ELSE2710:                  ELSE
2702:                     WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,3*NATOMS)2711:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
2703:                  ENDIF2712:                  ENDIF
2704:               ENDIF2713:               ENDIF
2705:            ENDIF2714:            ENDIF
2706:         ELSE IF (AMBER12T.OR.AMBERT.OR.NABT) THEN2715:         ELSE IF (AMBER12T.OR.AMBERT.OR.NABT) THEN
2707:            IF (.NOT.MACROCYCLET) THEN2716:            IF (.NOT.MACROCYCLET) THEN
2708:               HORDER=12717:               HORDER=1
2709:               FPGRP='C1'2718:               FPGRP='C1'
2710:            ELSE2719:            ELSE
2711:               CALL SYMMETRY(HORDER,.FALSE.,QTS,INERTIA)2720:               CALL SYMMETRY(HORDER,.FALSE.,QTS,INERTIA)
2712:            ENDIF2721:            ENDIF
2718:            IF (.NOT.NOFRQS) THEN2727:            IF (.NOT.NOFRQS) THEN
2719:               IF (RIGIDINIT) THEN2728:               IF (RIGIDINIT) THEN
2720: ! h286 - TS is saved in rigid body coordinates2729: ! h286 - TS is saved in rigid body coordinates
2721:                  ATOMRIGIDCOORDT = .FALSE.2730:                  ATOMRIGIDCOORDT = .FALSE.
2722:                  CALL GENRIGID_EIGENVALUES(QTS, ATMASS, DIAG, INFO)2731:                  CALL GENRIGID_EIGENVALUES(QTS, ATMASS, DIAG, INFO)
2723:                  ATOMRIGIDCOORDT = .TRUE.2732:                  ATOMRIGIDCOORDT = .TRUE.
2724:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN2733:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
2725:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)2734:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
2726:                  ENDIF2735:                  ENDIF
2727:                  IF (MACHINE) THEN2736:                  IF (MACHINE) THEN
2728:                     WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)2737:                     WRITE(88) (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
2729:                  ELSE2738:                  ELSE
2730:                     WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)2739:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
2731:                  ENDIF2740:                  ENDIF
2732:               ELSE2741:               ELSE
2733:                  IF (ENDNUMHESS.OR.AMBERT.OR.AMBER12T) THEN2742:                  IF (ENDNUMHESS.OR.AMBERT.OR.AMBER12T) THEN
2734:                     CALL MAKENUMHESS(QTS,NATOMS)2743:                     CALL MAKENUMHESS(QTS,NATOMS)
2735:                  ELSE2744:                  ELSE
2736:                     CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)2745:                     CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
2737:                  ENDIF2746:                  ENDIF
2738:                  CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)2747:                  CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
2739:                  IF (HESSDUMPT) THEN2748:                  IF (HESSDUMPT) THEN
2740:                     LUNIT=GETUNIT()2749:                     LUNIT=GETUNIT()
2759:                     WRITE(LUNIT,*) DUMMY12768:                     WRITE(LUNIT,*) DUMMY1
2760:                     WRITE(LUNIT,*) "Coordinates"2769:                     WRITE(LUNIT,*) "Coordinates"
2761:                     WRITE(LUNIT,*) QTS2770:                     WRITE(LUNIT,*) QTS
2762:                     WRITE(LUNIT,*) "Hessian Eigenvalues"2771:                     WRITE(LUNIT,*) "Hessian Eigenvalues"
2763:                     WRITE(LUNIT,*) DIAG2772:                     WRITE(LUNIT,*) DIAG
2764:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"2773:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"
2765:                     WRITE(LUNIT,*) ATMASS2774:                     WRITE(LUNIT,*) ATMASS
2766:                     CLOSE(LUNIT)2775:                     CLOSE(LUNIT)
2767:                  ENDIF2776:                  ENDIF
2768:                  IF (MACHINE) THEN2777:                  IF (MACHINE) THEN
2769:                     WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,3*NATOMS)2778:                     WRITE(88) (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
2770:                  ELSE2779:                  ELSE
2771:                     WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,3*NATOMS)2780:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
2772:                  ENDIF2781:                  ENDIF
2773:               ENDIF2782:               ENDIF
2774:            ENDIF2783:            ENDIF
2775:         ELSEIF (UNRST) THEN2784:         ELSEIF (UNRST) THEN
2776:            HORDER=12785:            HORDER=1
2777:            FPGRP='C1'2786:            FPGRP='C1'
2778:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP2787:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
2779:            IF (.NOT.NOFRQS) THEN2788:            IF (.NOT.NOFRQS) THEN
2780:               IF (ENDNUMHESS) THEN2789:               IF (ENDNUMHESS) THEN
2781:                  CALL MAKENUMINTHESS(NINTS,NATOMS)2790:                  CALL MAKENUMINTHESS(NINTS,NATOMS)
2782:                  CALL GETSTUFF(KD,NNZ,NINTB)2791:                  CALL GETSTUFF(KD,NNZ,NINTB)
2783:                  CALL INTSECDET(QTS,3*NATOMS,KD,NNZ,NINTB,DIAG)2792:                  CALL INTSECDET(QTS,3*NATOMS,KD,NNZ,NINTB,DIAG)
2784:               ELSE2793:               ELSE
2785:                  CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)2794:                  CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
2786:               ENDIF2795:               ENDIF
2787:               DO J2=1,NINTS-12796:               DO J2=1,NINTS-1
2788:                  IF (DIAG(J2).LT.0.0D0) PRINT *,'Higher order saddle found in pathway - ts eigenvalue ',DIAG(J2)2797:                  IF (DIAG(J2).LT.0.0D0) PRINT *,'Higher order saddle found in pathway - ts eigenvalue ',DIAG(J2)
2789:               END DO2798:               END DO
2790:               WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,3*NATOMS)2799:               WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,3*NATOMS)
2791:            ENDIF2800:            ENDIF
2792:         ELSEIF (AMHT) THEN2801:         ELSEIF (AMHT) THEN
2793:            WRITE(88,'(I6,1X,A4)') 1,' C1'2802:            WRITE(88,'(I6,1X,A4)') 1,' C1'
2794:            IF (.NOT.NOFRQS) THEN2803:            IF (.NOT.NOFRQS) THEN
2795:               IF (ENDNUMHESS) THEN2804:               IF (ENDNUMHESS) THEN
2796:                  CALL MAKENUMHESS(QTS,NATOMS)2805:                  CALL MAKENUMHESS(QTS,NATOMS)
2797:               ELSE2806:               ELSE
2798:                  CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)2807:                  CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
2799:               ENDIF2808:               ENDIF
2800:               CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)2809:               CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
2801:                  IF (HESSDUMPT) THEN2810:                  IF (HESSDUMPT) THEN
2802:                     LUNIT=GETUNIT()2811:                     LUNIT=GETUNIT()
2803:                     OPEN(LUNIT,FILE='tshess',STATUS='UNKNOWN',POSITION ='APPEND')2812:                     OPEN(LUNIT,FILE='tshess',STATUS='UNKNOWN',POSITION ='APPEND')
2804:                     WRITE(LUNIT,'(6G20.10)') HESS(1:3*NATOMS,1:3*NATOMS)2813:                     WRITE(LUNIT,'(6G20.10)') HESS(1:3*NATOMS,1:3*NATOMS)
2805:                     CLOSE(LUNIT)2814:                     CLOSE(LUNIT)
2806:                  ENDIF2815:                  ENDIF
2807:               CALL DSYEV('N','U',3*NATOMS,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)2816:               CALL DSYEV('N','U',3*NATOMS,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
2808:               IF (DIAG(1).LT.DIAG(3*NATOMS)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,3*NATOMS,3*NATOMS)2817:               IF (DIAG(1).LT.DIAG(3*NATOMS)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,3*NATOMS,3*NATOMS)
2809:               WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,3*NATOMS)2818:               WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,3*NATOMS)
2810: ! jbr36 - writes the first input for qm rate calculations from classical rates2819: ! jbr36 - writes the first input for qm rate calculations from classical rates
2811:                     IF (INSTANTONSTARTDUMPT) THEN2820:                     IF (INSTANTONSTARTDUMPT) THEN
2812: !                      CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)2821: !                      CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
2813:                       LUNIT=5552822:                       LUNIT=555
2814:                       open(LUNIT,file='qmrate_ts.txt', action='write')2823:                       open(LUNIT,file='qmrate_ts.txt', action='write')
2815:                       write(LUNIT,'(a)') "Energy and Hessian eigenvalues of transition state"2824:                       write(LUNIT,'(a)') "Energy and Hessian eigenvalues of transition state"
2816:                       write(LUNIT,*) NATOMS,NATOMS*32825:                       write(LUNIT,*) NATOMS,NATOMS*3
2817:                       write(LUNIT,*) DUMMY12826:                       write(LUNIT,*) DUMMY1
2818:                       write(LUNIT,*) "Coordinates"2827:                       write(LUNIT,*) "Coordinates"
2819:                       write(LUNIT,*) QTS2828:                       write(LUNIT,*) QTS
2844:                  ENDIF2853:                  ENDIF
2845:               CALL DSYEV('N','U',3*NATOMS,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)2854:               CALL DSYEV('N','U',3*NATOMS,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
2846:               IF (DIAG(1).LT.DIAG(3*NATOMS)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,3*NATOMS,3*NATOMS)2855:               IF (DIAG(1).LT.DIAG(3*NATOMS)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,3*NATOMS,3*NATOMS)
2847:               IF (DIAG(3*NATOMS) < 0.0) THEN2856:               IF (DIAG(3*NATOMS) < 0.0) THEN
2848:                  DIAG(2*NATOMS) = DIAG(3*NATOMS)2857:                  DIAG(2*NATOMS) = DIAG(3*NATOMS)
2849:               ENDIF2858:               ENDIF
2850: 2859: 
2851:            ENDIF2860:            ENDIF
2852:            WRITE(88,'(3G20.10)') (1.0D10, J2=1, NATOMS)2861:            WRITE(88,'(3G20.10)') (1.0D10, J2=1, NATOMS)
2853:            IF (SDT.OR.TTM3T) THEN2862:            IF (SDT.OR.TTM3T) THEN
2854:               WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,2*NATOMS)2863:               WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,2*NATOMS)
2855:            ELSEIF (BOWMANT) THEN2864:            ELSEIF (BOWMANT) THEN
2856:               WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,2*NATOMS)2865:               WRITE(88,'(3G20.10)') (DIAG(J2)*2625.47D26,J2=1,2*NATOMS)
2857:            ELSE2866:            ELSE
2858:               WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,2*NATOMS)2867:               WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,2*NATOMS)
2859:            ENDIF2868:            ENDIF
2860: 2869: 
2861:         ELSE2870:         ELSE
2862:            CALL SYMMETRY(HORDER,.FALSE.,QTS,INERTIA)2871:            CALL SYMMETRY(HORDER,.FALSE.,QTS,INERTIA)
2863:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP2872:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
2864:            IF (.NOT.NOFRQS) THEN2873:            IF (.NOT.NOFRQS) THEN
2865:               IF (RIGIDINIT) THEN2874:               IF (RIGIDINIT) THEN
2866: ! hk286 - TS is recorded in rigid body coordinates2875: ! hk286 - TS is recorded in rigid body coordinates
2867:                  ATOMRIGIDCOORDT = .FALSE.2876:                  ATOMRIGIDCOORDT = .FALSE.
2868:                  CALL GENRIGID_EIGENVALUES(QTS, ATMASS, DIAG, INFO)2877:                  IF(METRICTENSOR) THEN
 2878:                      CALL GENRIGID_NORMALMODES(QTS, ATMASS, DIAG, INFO)
 2879:                  ELSE
 2880:                      CALL GENRIGID_EIGENVALUES(QTS, ATMASS, DIAG, INFO)
 2881:                  ENDIF
2869:                  ATOMRIGIDCOORDT = .TRUE.2882:                  ATOMRIGIDCOORDT = .TRUE.
2870:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN2883:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
2871:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)2884:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
2872:                  ENDIF2885:                  ENDIF
2873: ! hk286 - compute normal modes for rigid body angle axis, go to moving frame2886: ! hk286 - compute normal modes for rigid body angle axis, go to moving frame
2874:               ELSE IF (RBAAT) THEN2887:               ELSE IF (RBAAT) THEN
2875:                  RBAANORMALMODET = .TRUE.2888:                  RBAANORMALMODET = .TRUE.
2876:                  CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)2889:                  CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
2877:                  CALL NRMLMD (QTS, DIAG, .FALSE.)2890:                  CALL NRMLMD (QTS, DIAG, .FALSE.)
2878:                  RBAANORMALMODET = .FALSE.2891:                  RBAANORMALMODET = .FALSE.
2901:                     WRITE(LUNIT,*) "Coordinates"2914:                     WRITE(LUNIT,*) "Coordinates"
2902:                     WRITE(LUNIT,*) QTS2915:                     WRITE(LUNIT,*) QTS
2903:                     WRITE(LUNIT,*) "Hessian Eigenvalues"2916:                     WRITE(LUNIT,*) "Hessian Eigenvalues"
2904:                     WRITE(LUNIT,*) DIAG2917:                     WRITE(LUNIT,*) DIAG
2905:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"2918:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"
2906:                     WRITE(LUNIT,*) ATMASS2919:                     WRITE(LUNIT,*) ATMASS
2907:                     CLOSE(LUNIT)2920:                     CLOSE(LUNIT)
2908:                  ENDIF2921:                  ENDIF
2909:               ENDIF2922:               ENDIF
2910:               IF (SDT.OR.TTM3T) THEN2923:               IF (SDT.OR.TTM3T) THEN
2911:                  WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,3*NATOMS)2924:                  WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
2912:               ELSEIF (BOWMANT) THEN2925:               ELSEIF (BOWMANT) THEN
2913:                  WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,3*NATOMS)2926:                  WRITE(88,'(3G20.10)') (DIAG(J2)*2625.47D26,J2=1,3*NATOMS)
2914:               ELSEIF (RIGIDINIT) THEN2927:               ELSEIF (RIGIDINIT) THEN
2915:                  IF (MACHINE) THEN2928:                  IF (MACHINE) THEN
2916: !                    WRITE(88) (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)2929: !                    WRITE(88) (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
2917:                     WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)2930:                     WRITE(88) (DIAG(J2),J2=1,DEGFREEDOMS)
2918:                  ELSE2931:                  ELSE
2919:                     WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)2932:                     WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,DEGFREEDOMS)
2920: !                    WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)2933: !                    WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
2921:                  ENDIF2934:                  ENDIF
2922:               ELSE2935:               ELSE
2923:                  WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,3*NATOMS)2936:                  WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,3*NATOMS)
2924:               ENDIF2937:               ENDIF
2925:            ENDIF2938:            ENDIF
2926:         ENDIF2939:         ENDIF
2927:      ELSE2940:      ELSE
2928:         CALL SYMMETRY(HORDER,.FALSE.,QTS,INERTIA)2941:         CALL SYMMETRY(HORDER,.FALSE.,QTS,INERTIA)
2929:         WRITE(88,'(I6,1X,A4)') HORDER,FPGRP2942:         WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
2930:      ENDIF2943:      ENDIF
2931:      IF (MACHINE) THEN2944:      IF (MACHINE) THEN
2932:         IF (GTHOMSONT) THEN2945:         IF (GTHOMSONT) THEN
2933:            CALL GTHOMSONANGTOC(TMPCOORDS, QTS, NATOMS)2946:            CALL GTHOMSONANGTOC(TMPCOORDS, QTS, NATOMS)
2981: 2994: 
2982: !2995: !
2983: !  Dump the latest min-sad-min triple to path.info in the usual format2996: !  Dump the latest min-sad-min triple to path.info in the usual format
2984: !  2997: !  
2985:      SUBROUTINE MAKEALLPATHINFO(QTS,QPLUS,QMINUS,ETS,EPLUS,EMINUS,FRQSTS,FRQSPLUS,FRQSMINUS)2998:      SUBROUTINE MAKEALLPATHINFO(QTS,QPLUS,QMINUS,ETS,EPLUS,EMINUS,FRQSTS,FRQSPLUS,FRQSMINUS)
2986:      USE SYMINF 2999:      USE SYMINF 
2987:      USE MODHESS3000:      USE MODHESS
2988:      USE MODCHARMM3001:      USE MODCHARMM
2989:      USE MODUNRES3002:      USE MODUNRES
2990:      USE KEY, ONLY: FILTH, FILTHSTR, UNRST, TWOD, BULKT, MACHINE, NOFRQS, AMBERT, NABT, AMHT, SEQ, TARFL, NRES_AMH_TEMP, SDT, &3003:      USE KEY, ONLY: FILTH, FILTHSTR, UNRST, TWOD, BULKT, MACHINE, NOFRQS, AMBERT, NABT, AMHT, SEQ, TARFL, NRES_AMH_TEMP, SDT, &
2991:           AMBER12T, RBAAT, MACROCYCLET, GTHOMSONT, TTM3T, BOWMANT, HESSDUMPT, INSTANTONSTARTDUMPT,FREEZE,NONFREEZE, &3004:           AMBER12T, RBAAT, MACROCYCLET, GTHOMSONT, TTM3T, BOWMANT, HESSDUMPT, INSTANTONSTARTDUMPT,FREEZE,NONFREEZE, METRICTENSOR, & ! hk286
2992:   &       VARIABLES, FRQCONV23005:   &       VARIABLES
2993:      USE COMMONS, ONLY: ATMASS, NINTS, ZSYM3006:      USE COMMONS, ONLY: ATMASS, NINTS, ZSYM
2994:      USE PORFUNCS3007:      USE PORFUNCS
2995:      USE GENRIGID3008:      USE GENRIGID
2996:      IMPLICIT NONE3009:      IMPLICIT NONE
2997: 3010: 
2998:      CHARACTER(LEN=20) :: PINFOSTRING3011:      CHARACTER(LEN=20) :: PINFOSTRING
2999:      DOUBLE PRECISION :: DIHE,ALLANG,DISTPF,DUMMY1,GRAD(NOPT),RMS,DIAG(NOPT),TEMPA(9*NATOMS),DUMQ(NOPT)3012:      DOUBLE PRECISION :: DIHE,ALLANG,DISTPF,DUMMY1,GRAD(NOPT),RMS,DIAG(NOPT),TEMPA(9*NATOMS),DUMQ(NOPT)
3000:      INTEGER :: HORDER,INFO,J2,K1,RECLEN,ISTAT,J1,LUNIT,GETUNIT3013:      INTEGER :: HORDER,INFO,J2,K1,RECLEN,ISTAT,J1,LUNIT,GETUNIT
3001:      LOGICAL :: BTEST,KD,NNZ,NINTB,TSFRQDONE,MINFRQDONE3014:      LOGICAL :: BTEST,KD,NNZ,NINTB,TSFRQDONE,MINFRQDONE
3002:      DOUBLE PRECISION :: QTS(NOPT),QPLUS(NOPT),QMINUS(NOPT),FRQSTS(NOPT),FRQSPLUS(NOPT),FRQSMINUS(NOPT), &3015:      DOUBLE PRECISION :: QTS(NOPT),QPLUS(NOPT),QMINUS(NOPT),FRQSTS(NOPT),FRQSPLUS(NOPT),FRQSMINUS(NOPT), &
3042:            ELSE3055:            ELSE
3043:               WRITE(88,'(I6,1X,A4)') HORDER,FPGRP3056:               WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
3044:            ENDIF3057:            ENDIF
3045:            IF (.NOT.NOFRQS) THEN3058:            IF (.NOT.NOFRQS) THEN
3046:               IF (RIGIDINIT) THEN3059:               IF (RIGIDINIT) THEN
3047:                  CALL GENRIGID_EIGENVALUES(QPLUS, ATMASS, DIAG, INFO)3060:                  CALL GENRIGID_EIGENVALUES(QPLUS, ATMASS, DIAG, INFO)
3048:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN3061:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
3049:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)3062:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
3050:                  ENDIF3063:                  ENDIF
3051:                  IF (MACHINE) THEN3064:                  IF (MACHINE) THEN
3052:                     WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)3065:                     WRITE(88) (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
3053:                  ELSE3066:                  ELSE
3054:                     WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)3067:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
3055:                  ENDIF3068:                  ENDIF
3056:               ELSE3069:               ELSE
3057:                  IF (ENDNUMHESS) THEN3070:                  IF (ENDNUMHESS) THEN
3058:                     CALL MAKENUMHESS(QPLUS,NATOMS)3071:                     CALL MAKENUMHESS(QPLUS,NATOMS)
3059:                  ELSE3072:                  ELSE
3060:                     CALL POTENTIAL(QPLUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3073:                     CALL POTENTIAL(QPLUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3061:                  ENDIF3074:                  ENDIF
3062:                  CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)3075:                  CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
3063:                  IF (HESSDUMPT) THEN3076:                  IF (HESSDUMPT) THEN
3064:                     LUNIT=GETUNIT()3077:                     LUNIT=GETUNIT()
3077:                     WRITE(LUNIT,*) DUMMY13090:                     WRITE(LUNIT,*) DUMMY1
3078:                     WRITE(LUNIT,*) "Coordinates"3091:                     WRITE(LUNIT,*) "Coordinates"
3079:                     WRITE(LUNIT,*) QPLUS3092:                     WRITE(LUNIT,*) QPLUS
3080:                     WRITE(LUNIT,*) "Hessian Eigenvalues"3093:                     WRITE(LUNIT,*) "Hessian Eigenvalues"
3081:                     WRITE(LUNIT,*) DIAG3094:                     WRITE(LUNIT,*) DIAG
3082:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"3095:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"
3083:                     WRITE(LUNIT,*) ATMASS3096:                     WRITE(LUNIT,*) ATMASS
3084:                     CLOSE(LUNIT)3097:                     CLOSE(LUNIT)
3085:                  ENDIF3098:                  ENDIF
3086:                  IF (MACHINE) THEN3099:                  IF (MACHINE) THEN
3087:                     WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,NOPT)3100:                     WRITE(88) (DIAG(J2)*4.184D26,J2=1,NOPT)
3088:                  ELSE3101:                  ELSE
3089:                     WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT)3102:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,NOPT)
3090:                  ENDIF3103:                  ENDIF
3091:               ENDIF3104:               ENDIF
3092:            ENDIF3105:            ENDIF
3093:         ELSEIF (AMBER12T.OR.AMBERT.OR.NABT) THEN3106:         ELSEIF (AMBER12T.OR.AMBERT.OR.NABT) THEN
3094:            IF (.NOT.MACROCYCLET) THEN3107:            IF (.NOT.MACROCYCLET) THEN
3095:               HORDER=1 3108:               HORDER=1 
3096:               FPGRP='C1'3109:               FPGRP='C1'
3097:            ELSE3110:            ELSE
3098:               CALL SYMMETRY(HORDER,.FALSE.,QPLUS,INERTIA)3111:               CALL SYMMETRY(HORDER,.FALSE.,QPLUS,INERTIA)
3099:            ENDIF3112:            ENDIF
3102:            ELSE3115:            ELSE
3103:               WRITE(88,'(I6,1X,A4)') HORDER,FPGRP3116:               WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
3104:            ENDIF3117:            ENDIF
3105:            IF (.NOT.NOFRQS) THEN3118:            IF (.NOT.NOFRQS) THEN
3106:               IF (RIGIDINIT) THEN3119:               IF (RIGIDINIT) THEN
3107:                  CALL GENRIGID_EIGENVALUES(QPLUS, ATMASS, DIAG, INFO)3120:                  CALL GENRIGID_EIGENVALUES(QPLUS, ATMASS, DIAG, INFO)
3108:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN3121:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
3109:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)3122:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
3110:                  ENDIF3123:                  ENDIF
3111:                  IF (MACHINE) THEN3124:                  IF (MACHINE) THEN
3112:                     WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)3125:                     WRITE(88) (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
3113:                  ELSE3126:                  ELSE
3114:                     WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)3127:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
3115:                  ENDIF3128:                  ENDIF
3116:               ELSE3129:               ELSE
3117:                  IF (ENDNUMHESS.OR.AMBERT.OR.AMBER12T) THEN3130:                  IF (ENDNUMHESS.OR.AMBERT.OR.AMBER12T) THEN
3118:                     CALL MAKENUMHESS(QPLUS,NATOMS)3131:                     CALL MAKENUMHESS(QPLUS,NATOMS)
3119:                  ELSE3132:                  ELSE
3120:                     CALL POTENTIAL(QPLUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3133:                     CALL POTENTIAL(QPLUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3121:                  ENDIF3134:                  ENDIF
3122:                  CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)3135:                  CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
3123:                  IF (HESSDUMPT) THEN3136:                  IF (HESSDUMPT) THEN
3124:                     LUNIT=GETUNIT()3137:                     LUNIT=GETUNIT()
3143:                     WRITE(LUNIT,*) DUMMY13156:                     WRITE(LUNIT,*) DUMMY1
3144:                     WRITE(LUNIT,*) "Coordinates"3157:                     WRITE(LUNIT,*) "Coordinates"
3145:                     WRITE(LUNIT,*) QPLUS3158:                     WRITE(LUNIT,*) QPLUS
3146:                     WRITE(LUNIT,*) "Hessian Eigenvalues"3159:                     WRITE(LUNIT,*) "Hessian Eigenvalues"
3147:                     WRITE(LUNIT,*) DIAG3160:                     WRITE(LUNIT,*) DIAG
3148:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"3161:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"
3149:                     WRITE(LUNIT,*) ATMASS3162:                     WRITE(LUNIT,*) ATMASS
3150:                     CLOSE(LUNIT)3163:                     CLOSE(LUNIT)
3151:                  ENDIF3164:                  ENDIF
3152:                  IF (MACHINE) THEN3165:                  IF (MACHINE) THEN
3153:                     WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,NOPT)3166:                     WRITE(88) (DIAG(J2)*4.184D26,J2=1,NOPT)
3154:                  ELSE3167:                  ELSE
3155:                     WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT)3168:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,NOPT)
3156:                  ENDIF3169:                  ENDIF
3157:               ENDIF3170:               ENDIF
3158:            ENDIF3171:            ENDIF
3159:         ELSEIF (UNRST) THEN3172:         ELSEIF (UNRST) THEN
3160:            HORDER=13173:            HORDER=1
3161:            FPGRP='C1'3174:            FPGRP='C1'
3162:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP3175:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
3163:            IF (.NOT.NOFRQS) THEN3176:            IF (.NOT.NOFRQS) THEN
3164:               IF (ENDNUMHESS) THEN3177:               IF (ENDNUMHESS) THEN
3165:                  CALL MAKENUMINTHESS(NINTS,NATOMS)3178:                  CALL MAKENUMINTHESS(NINTS,NATOMS)
3166:                  CALL GETSTUFF(KD,NNZ,NINTB)3179:                  CALL GETSTUFF(KD,NNZ,NINTB)
3167:                  CALL INTSECDET(QPLUS,NOPT,KD,NNZ,NINTB,DIAG)3180:                  CALL INTSECDET(QPLUS,NOPT,KD,NNZ,NINTB,DIAG)
3168:               ELSE3181:               ELSE
3169:                  CALL POTENTIAL(QPLUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3182:                  CALL POTENTIAL(QPLUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3170:               ENDIF3183:               ENDIF
3171:               WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT)3184:               WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)
3172:            ENDIF3185:            ENDIF
3173:         ELSEIF (AMHT) THEN3186:         ELSEIF (AMHT) THEN
3174:            WRITE(88,'(I6,1X,A4)') 1,' C1'3187:            WRITE(88,'(I6,1X,A4)') 1,' C1'
3175:            IF (.NOT.NOFRQS) THEN3188:            IF (.NOT.NOFRQS) THEN
3176:               IF (ENDNUMHESS) THEN3189:               IF (ENDNUMHESS) THEN
3177:                  CALL MAKENUMHESS(QPLUS,NATOMS)3190:                  CALL MAKENUMHESS(QPLUS,NATOMS)
3178:               ELSE3191:               ELSE
3179:                  CALL POTENTIAL(QPLUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3192:                  CALL POTENTIAL(QPLUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3180:               ENDIF3193:               ENDIF
3181:               CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)3194:               CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
3182:                  IF (HESSDUMPT) THEN3195:                  IF (HESSDUMPT) THEN
3183:                     LUNIT=GETUNIT()3196:                     LUNIT=GETUNIT()
3184:                     OPEN(LUNIT,FILE='minhess.plus',STATUS='UNKNOWN',POSITION ='APPEND')3197:                     OPEN(LUNIT,FILE='minhess.plus',STATUS='UNKNOWN',POSITION ='APPEND')
3185:                     WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)3198:                     WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)
3186:                     CLOSE(LUNIT)3199:                     CLOSE(LUNIT)
3187:                  ENDIF3200:                  ENDIF
3188:               CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)3201:               CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
3189:               IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)3202:               IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)
3190:               WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT)3203:               WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)
3191: ! jbr36 - writes the first input for qm rate calculations from classical rates3204: ! jbr36 - writes the first input for qm rate calculations from classical rates
3192:                     IF (INSTANTONSTARTDUMPT) THEN3205:                     IF (INSTANTONSTARTDUMPT) THEN
3193: !                      CALL POTENTIAL(QPLUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3206: !                      CALL POTENTIAL(QPLUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3194:                       LUNIT=5553207:                       LUNIT=555
3195:                       open(LUNIT,file='qmrate_reactant.plus.txt', action='write')3208:                       open(LUNIT,file='qmrate_reactant.plus.txt', action='write')
3196:                       write(LUNIT,'(a)') "Energy and Hessian eigenvalues of reactant.plus"3209:                       write(LUNIT,'(a)') "Energy and Hessian eigenvalues of reactant.plus"
3197:                       write(LUNIT,*) NATOMS,NATOMS*33210:                       write(LUNIT,*) NATOMS,NATOMS*3
3198:                       write(LUNIT,*) DUMMY13211:                       write(LUNIT,*) DUMMY1
3199:                       write(LUNIT,*) "Coordinates"3212:                       write(LUNIT,*) "Coordinates"
3200:                       write(LUNIT,*) QPLUS3213:                       write(LUNIT,*) QPLUS
3221:                  LUNIT=GETUNIT()3234:                  LUNIT=GETUNIT()
3222:                  OPEN(LUNIT,FILE='minhess.plus',STATUS='UNKNOWN',POSITION ='APPEND')3235:                  OPEN(LUNIT,FILE='minhess.plus',STATUS='UNKNOWN',POSITION ='APPEND')
3223:                  WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)3236:                  WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)
3224:                  CLOSE(LUNIT)3237:                  CLOSE(LUNIT)
3225:               ENDIF3238:               ENDIF
3226:               CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)3239:               CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
3227:               IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)3240:               IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)
3228:            ENDIF3241:            ENDIF
3229:            WRITE(88,'(3G20.10)') (1.0D10, J2=1, NATOMS)3242:            WRITE(88,'(3G20.10)') (1.0D10, J2=1, NATOMS)
3230:            IF (SDT.OR.TTM3T) THEN3243:            IF (SDT.OR.TTM3T) THEN
3231:               WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,2*NATOMS)3244:               WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,2*NATOMS)
3232:            ELSEIF (BOWMANT) THEN3245:            ELSEIF (BOWMANT) THEN
3233:               WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,2*NATOMS)3246:               WRITE(88,'(3G20.10)') (DIAG(J2)*2625.47D26,J2=1,2*NATOMS)
3234:            ELSE3247:            ELSE
3235:               WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,2*NATOMS)3248:               WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,2*NATOMS)
3236:            ENDIF3249:            ENDIF
3237:            3250:            
3238:         ELSE3251:         ELSE
3239:            IF (VARIABLES) THEN3252:            IF (VARIABLES) THEN
3240:               HORDER=13253:               HORDER=1
3241:               FPGRP='C1'3254:               FPGRP='C1'
3242:            ELSE3255:            ELSE
3243:               CALL SYMMETRY(HORDER,.FALSE.,QPLUS,INERTIA)3256:               CALL SYMMETRY(HORDER,.FALSE.,QPLUS,INERTIA)
3244:            ENDIF3257:            ENDIF
3245:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP3258:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
3246:            IF (.NOT.NOFRQS) THEN3259:            IF (.NOT.NOFRQS) THEN
 3260:               ! sn402: Currently there are two different methods implemented for finding the normal modes of
 3261:               ! local rigid bodies. GENRIGID_NORMALMODES makes use of the metric tensor formulation and so should
 3262:               ! in principle be more accurate. Eventually this should be made the default (or indeed only) option
 3263:               ! and the keyword METRICTENSOR should be removed.
3247:               IF (RIGIDINIT) THEN3264:               IF (RIGIDINIT) THEN
3248:                  CALL GENRIGID_EIGENVALUES(QPLUS, ATMASS, DIAG, INFO)3265:                  IF(METRICTENSOR) THEN
 3266:                      write(*,*) "ATMASS going in:"
 3267:                      write(*,*) ATMASS
 3268:                      CALL GENRIGID_NORMALMODES(QPLUS, ATMASS, DIAG, INFO)
 3269:                  ELSE
 3270:                      CALL GENRIGID_EIGENVALUES(QPLUS, ATMASS, DIAG, INFO)
 3271:                  ENDIF
3249: 3272: 
3250:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN3273:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
3251:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)3274:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
3252:                  ENDIF3275:                  ENDIF
3253: ! hk286 - compute normal modes for rigid body angle axis, go to moving frame3276: ! hk286 - compute normal modes for rigid body angle axis, go to moving frame
3254:               ELSE IF (RBAAT) THEN3277:               ELSE IF (RBAAT) THEN
3255:                  RBAANORMALMODET = .TRUE.3278:                  RBAANORMALMODET = .TRUE.
3256:                  CALL POTENTIAL(QPLUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3279:                  CALL POTENTIAL(QPLUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3257:                  CALL NRMLMD (QPLUS, DIAG, .FALSE.)3280:                  CALL NRMLMD (QPLUS, DIAG, .FALSE.)
3258:                  RBAANORMALMODET = .FALSE.3281:                  RBAANORMALMODET = .FALSE.
3281:                     WRITE(LUNIT,*) "Coordinates"3304:                     WRITE(LUNIT,*) "Coordinates"
3282:                     WRITE(LUNIT,*) QPLUS3305:                     WRITE(LUNIT,*) QPLUS
3283:                     WRITE(LUNIT,*) "Hessian Eigenvalues"3306:                     WRITE(LUNIT,*) "Hessian Eigenvalues"
3284:                     WRITE(LUNIT,*) DIAG3307:                     WRITE(LUNIT,*) DIAG
3285:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"3308:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"
3286:                     WRITE(LUNIT,*) ATMASS3309:                     WRITE(LUNIT,*) ATMASS
3287:                     CLOSE(LUNIT)3310:                     CLOSE(LUNIT)
3288:                  ENDIF3311:                  ENDIF
3289:               ENDIF3312:               ENDIF
3290:               IF (SDT.OR.TTM3T) THEN3313:               IF (SDT.OR.TTM3T) THEN
3291:                  WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT)3314:                  WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,NOPT)
3292:               ELSEIF (BOWMANT) THEN3315:               ELSEIF (BOWMANT) THEN
3293:                  WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT)3316:                  WRITE(88,'(3G20.10)') (DIAG(J2)*2625.47D26,J2=1,NOPT)
3294:               ELSEIF (RIGIDINIT) THEN3317:               ELSEIF (RIGIDINIT) THEN
3295:                  IF (MACHINE) THEN3318:                  IF (MACHINE) THEN
3296: !                    WRITE(88) (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)3319: !                    WRITE(88) (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
3297:                     WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)3320:                     WRITE(88) (DIAG(J2),J2=1,DEGFREEDOMS)
3298:                  ELSE3321:                  ELSE
3299:                     WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)3322:                     WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,DEGFREEDOMS)
3300: !                    WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)3323: !                    WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
3301:                  ENDIF3324:                  ENDIF
3302:               ELSE3325:               ELSE
3303:                  WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT)3326:                  WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)
3304:               ENDIF3327:               ENDIF
3305:            ENDIF3328:            ENDIF
3306:         ENDIF3329:         ENDIF
3307:      ELSE3330:      ELSE
3308:         IF (VARIABLES) THEN3331:         IF (VARIABLES) THEN
3309:            HORDER=13332:            HORDER=1
3310:            FPGRP='C1'3333:            FPGRP='C1'
3311:         ELSE3334:         ELSE
3312:            CALL SYMMETRY(HORDER,.FALSE.,QPLUS,INERTIA)3335:            CALL SYMMETRY(HORDER,.FALSE.,QPLUS,INERTIA)
3313:         ENDIF3336:         ENDIF
3383:            IF (.NOT.NOFRQS) THEN3406:            IF (.NOT.NOFRQS) THEN
3384:               IF (RIGIDINIT) THEN3407:               IF (RIGIDINIT) THEN
3385: ! hk286 - TS is recorded in rigid body coordinates3408: ! hk286 - TS is recorded in rigid body coordinates
3386:                  ATOMRIGIDCOORDT = .FALSE.3409:                  ATOMRIGIDCOORDT = .FALSE.
3387:                  CALL GENRIGID_EIGENVALUES(QTS, ATMASS, DIAG, INFO)3410:                  CALL GENRIGID_EIGENVALUES(QTS, ATMASS, DIAG, INFO)
3388:                  ATOMRIGIDCOORDT = .TRUE.3411:                  ATOMRIGIDCOORDT = .TRUE.
3389:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN3412:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
3390:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)3413:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
3391:                  ENDIF3414:                  ENDIF
3392:                  IF (MACHINE) THEN3415:                  IF (MACHINE) THEN
3393:                     WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)3416:                     WRITE(88) (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
3394:                  ELSE3417:                  ELSE
3395:                     WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)3418:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
3396:                  ENDIF3419:                  ENDIF
3397:               ELSE3420:               ELSE
3398:                  IF (ENDNUMHESS) THEN3421:                  IF (ENDNUMHESS) THEN
3399:                     CALL MAKENUMHESS(QTS,NATOMS)3422:                     CALL MAKENUMHESS(QTS,NATOMS)
3400:                  ELSE3423:                  ELSE
3401:                     CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3424:                     CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3402:                  ENDIF3425:                  ENDIF
3403:                  CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)3426:                  CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
3404:                  IF (HESSDUMPT) THEN3427:                  IF (HESSDUMPT) THEN
3405:                     LUNIT=GETUNIT()3428:                     LUNIT=GETUNIT()
3418:                     WRITE(LUNIT,*) DUMMY13441:                     WRITE(LUNIT,*) DUMMY1
3419:                     WRITE(LUNIT,*) "Coordinates"3442:                     WRITE(LUNIT,*) "Coordinates"
3420:                     WRITE(LUNIT,*) QTS3443:                     WRITE(LUNIT,*) QTS
3421:                     WRITE(LUNIT,*) "Hessian Eigenvalues"3444:                     WRITE(LUNIT,*) "Hessian Eigenvalues"
3422:                     WRITE(LUNIT,*) DIAG3445:                     WRITE(LUNIT,*) DIAG
3423:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"3446:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"
3424:                     WRITE(LUNIT,*) ATMASS3447:                     WRITE(LUNIT,*) ATMASS
3425:                     CLOSE(LUNIT)3448:                     CLOSE(LUNIT)
3426:                  ENDIF3449:                  ENDIF
3427:                  IF (MACHINE) THEN3450:                  IF (MACHINE) THEN
3428:                     WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,NOPT)3451:                     WRITE(88) (DIAG(J2)*4.184D26,J2=1,NOPT)
3429:                  ELSE3452:                  ELSE
3430:                     WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT)3453:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,NOPT)
3431:                  ENDIF3454:                  ENDIF
3432:               ENDIF3455:               ENDIF
3433:            ENDIF3456:            ENDIF
3434:         ELSE IF (AMBER12T.OR.AMBERT.OR.NABT) THEN3457:         ELSE IF (AMBER12T.OR.AMBERT.OR.NABT) THEN
3435:            IF (.NOT.MACROCYCLET) THEN3458:            IF (.NOT.MACROCYCLET) THEN
3436:               HORDER=13459:               HORDER=1
3437:               FPGRP='C1'3460:               FPGRP='C1'
3438:            ELSE3461:            ELSE
3439:               CALL SYMMETRY(HORDER,.FALSE.,QTS,INERTIA)3462:               CALL SYMMETRY(HORDER,.FALSE.,QTS,INERTIA)
3440:            ENDIF3463:            ENDIF
3446:            IF (.NOT.NOFRQS) THEN3469:            IF (.NOT.NOFRQS) THEN
3447:               IF (RIGIDINIT) THEN3470:               IF (RIGIDINIT) THEN
3448: ! h286 - TS is saved in rigid body coordinates3471: ! h286 - TS is saved in rigid body coordinates
3449:                  ATOMRIGIDCOORDT = .FALSE.3472:                  ATOMRIGIDCOORDT = .FALSE.
3450:                  CALL GENRIGID_EIGENVALUES(QTS, ATMASS, DIAG, INFO)3473:                  CALL GENRIGID_EIGENVALUES(QTS, ATMASS, DIAG, INFO)
3451:                  ATOMRIGIDCOORDT = .TRUE.3474:                  ATOMRIGIDCOORDT = .TRUE.
3452:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN3475:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
3453:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)3476:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
3454:                  ENDIF3477:                  ENDIF
3455:                  IF (MACHINE) THEN3478:                  IF (MACHINE) THEN
3456:                     WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)3479:                     WRITE(88) (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
3457:                  ELSE3480:                  ELSE
3458:                     WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)3481:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
3459:                  ENDIF3482:                  ENDIF
3460:               ELSE3483:               ELSE
3461:                  IF (ENDNUMHESS.OR.AMBERT.OR.AMBER12T) THEN3484:                  IF (ENDNUMHESS.OR.AMBERT.OR.AMBER12T) THEN
3462:                     CALL MAKENUMHESS(QTS,NATOMS)3485:                     CALL MAKENUMHESS(QTS,NATOMS)
3463:                  ELSE3486:                  ELSE
3464:                     CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3487:                     CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3465:                  ENDIF3488:                  ENDIF
3466:                  CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)3489:                  CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
3467:                  IF (HESSDUMPT) THEN3490:                  IF (HESSDUMPT) THEN
3468:                     LUNIT=GETUNIT()3491:                     LUNIT=GETUNIT()
3487:                     WRITE(LUNIT,*) DUMMY13510:                     WRITE(LUNIT,*) DUMMY1
3488:                     WRITE(LUNIT,*) "Coordinates"3511:                     WRITE(LUNIT,*) "Coordinates"
3489:                     WRITE(LUNIT,*) QTS3512:                     WRITE(LUNIT,*) QTS
3490:                     WRITE(LUNIT,*) "Hessian Eigenvalues"3513:                     WRITE(LUNIT,*) "Hessian Eigenvalues"
3491:                     WRITE(LUNIT,*) DIAG3514:                     WRITE(LUNIT,*) DIAG
3492:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"3515:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"
3493:                     WRITE(LUNIT,*) ATMASS3516:                     WRITE(LUNIT,*) ATMASS
3494:                     CLOSE(LUNIT)3517:                     CLOSE(LUNIT)
3495:                  ENDIF3518:                  ENDIF
3496:                  IF (MACHINE) THEN3519:                  IF (MACHINE) THEN
3497:                     WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,NOPT)3520:                     WRITE(88) (DIAG(J2)*4.184D26,J2=1,NOPT)
3498:                  ELSE3521:                  ELSE
3499:                     WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT)3522:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,NOPT)
3500:                  ENDIF3523:                  ENDIF
3501:               ENDIF3524:               ENDIF
3502:            ENDIF3525:            ENDIF
3503:         ELSEIF (UNRST) THEN3526:         ELSEIF (UNRST) THEN
3504:            HORDER=13527:            HORDER=1
3505:            FPGRP='C1'3528:            FPGRP='C1'
3506:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP3529:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
3507:            IF (.NOT.NOFRQS) THEN3530:            IF (.NOT.NOFRQS) THEN
3508:               IF (ENDNUMHESS) THEN3531:               IF (ENDNUMHESS) THEN
3509:                  CALL MAKENUMINTHESS(NINTS,NATOMS)3532:                  CALL MAKENUMINTHESS(NINTS,NATOMS)
3510:                  CALL GETSTUFF(KD,NNZ,NINTB)3533:                  CALL GETSTUFF(KD,NNZ,NINTB)
3511:                  CALL INTSECDET(QTS,NOPT,KD,NNZ,NINTB,DIAG)3534:                  CALL INTSECDET(QTS,NOPT,KD,NNZ,NINTB,DIAG)
3512:               ELSE3535:               ELSE
3513:                  CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3536:                  CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3514:               ENDIF3537:               ENDIF
3515:               DO J2=1,NINTS-13538:               DO J2=1,NINTS-1
3516:                  IF (DIAG(J2).LT.0.0D0) PRINT *,'Higher order saddle found in pathway - ts eigenvalue ',DIAG(J2)3539:                  IF (DIAG(J2).LT.0.0D0) PRINT *,'Higher order saddle found in pathway - ts eigenvalue ',DIAG(J2)
3517:               END DO3540:               END DO
3518:               WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT)3541:               WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)
3519:            ENDIF3542:            ENDIF
3520:         ELSEIF (AMHT) THEN3543:         ELSEIF (AMHT) THEN
3521:            WRITE(88,'(I6,1X,A4)') 1,' C1'3544:            WRITE(88,'(I6,1X,A4)') 1,' C1'
3522:            IF (.NOT.NOFRQS) THEN3545:            IF (.NOT.NOFRQS) THEN
3523:               IF (ENDNUMHESS) THEN3546:               IF (ENDNUMHESS) THEN
3524:                  CALL MAKENUMHESS(QTS,NATOMS)3547:                  CALL MAKENUMHESS(QTS,NATOMS)
3525:               ELSE3548:               ELSE
3526:                  CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3549:                  CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3527:               ENDIF3550:               ENDIF
3528:               CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)3551:               CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
3529:                  IF (HESSDUMPT) THEN3552:                  IF (HESSDUMPT) THEN
3530:                     LUNIT=GETUNIT()3553:                     LUNIT=GETUNIT()
3531:                     OPEN(LUNIT,FILE='tshess',STATUS='UNKNOWN',POSITION ='APPEND')3554:                     OPEN(LUNIT,FILE='tshess',STATUS='UNKNOWN',POSITION ='APPEND')
3532:                     WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)3555:                     WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)
3533:                     CLOSE(LUNIT)3556:                     CLOSE(LUNIT)
3534:                  ENDIF3557:                  ENDIF
3535:               CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)3558:               CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
3536:               IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)3559:               IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)
3537:               WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT)3560:               WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)
3538: ! jbr36 - writes the first input for qm rate calculations from classical rates3561: ! jbr36 - writes the first input for qm rate calculations from classical rates
3539:                     IF (INSTANTONSTARTDUMPT) THEN3562:                     IF (INSTANTONSTARTDUMPT) THEN
3540: !                      CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3563: !                      CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3541:                       LUNIT=5553564:                       LUNIT=555
3542:                       open(LUNIT,file='qmrate_ts.txt', action='write')3565:                       open(LUNIT,file='qmrate_ts.txt', action='write')
3543:                       write(LUNIT,'(a)') "Energy and Hessian eigenvalues of transition state"3566:                       write(LUNIT,'(a)') "Energy and Hessian eigenvalues of transition state"
3544:                       write(LUNIT,*) NATOMS,NATOMS*33567:                       write(LUNIT,*) NATOMS,NATOMS*3
3545:                       write(LUNIT,*) DUMMY13568:                       write(LUNIT,*) DUMMY1
3546:                       write(LUNIT,*) "Coordinates"3569:                       write(LUNIT,*) "Coordinates"
3547:                       write(LUNIT,*) QTS3570:                       write(LUNIT,*) QTS
3572:                  ENDIF3595:                  ENDIF
3573:               CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)3596:               CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
3574:               IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)3597:               IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)
3575:               IF (DIAG(3*NATOMS) < 0.0) THEN3598:               IF (DIAG(3*NATOMS) < 0.0) THEN
3576:                  DIAG(2*NATOMS) = DIAG(3*NATOMS)3599:                  DIAG(2*NATOMS) = DIAG(3*NATOMS)
3577:               ENDIF3600:               ENDIF
3578: 3601: 
3579:            ENDIF3602:            ENDIF
3580:            WRITE(88,'(3G20.10)') (1.0D10, J2=1, NATOMS)3603:            WRITE(88,'(3G20.10)') (1.0D10, J2=1, NATOMS)
3581:            IF (SDT.OR.TTM3T) THEN3604:            IF (SDT.OR.TTM3T) THEN
3582:               WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,2*NATOMS)3605:               WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,2*NATOMS)
3583:            ELSEIF (BOWMANT) THEN3606:            ELSEIF (BOWMANT) THEN
3584:               WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,2*NATOMS)3607:               WRITE(88,'(3G20.10)') (DIAG(J2)*2625.47D26,J2=1,2*NATOMS)
3585:            ELSE3608:            ELSE
3586:               WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,2*NATOMS)3609:               WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,2*NATOMS)
3587:            ENDIF3610:            ENDIF
3588: 3611: 
3589:         ELSE3612:         ELSE
3590:            IF (VARIABLES) THEN3613:            IF (VARIABLES) THEN
3591:               HORDER=13614:               HORDER=1
3592:               FPGRP='C1'3615:               FPGRP='C1'
3593:            ELSE3616:            ELSE
3594:               CALL SYMMETRY(HORDER,.FALSE.,QTS,INERTIA)3617:               CALL SYMMETRY(HORDER,.FALSE.,QTS,INERTIA)
3595:            ENDIF3618:            ENDIF
3596:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP3619:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
3597:            IF (.NOT.NOFRQS) THEN3620:            IF (.NOT.NOFRQS) THEN
3598:               IF (RIGIDINIT) THEN3621:               IF (RIGIDINIT) THEN
3599: ! hk286 - TS is recorded in rigid body coordinates3622: ! hk286 - TS is recorded in rigid body coordinates
3600:                  ATOMRIGIDCOORDT = .FALSE.3623:                  ATOMRIGIDCOORDT = .FALSE.
3601:                  CALL GENRIGID_EIGENVALUES(QTS, ATMASS, DIAG, INFO)3624:                  IF(METRICTENSOR) THEN
 3625:                      CALL GENRIGID_NORMALMODES(QTS, ATMASS, DIAG, INFO)
 3626:                  ELSE
 3627:                      CALL GENRIGID_EIGENVALUES(QTS, ATMASS, DIAG, INFO)
 3628:                  ENDIF
3602:                  ATOMRIGIDCOORDT = .TRUE.3629:                  ATOMRIGIDCOORDT = .TRUE.
3603:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN3630:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
3604:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)3631:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
3605:                  ENDIF3632:                  ENDIF
3606: ! hk286 - compute normal modes for rigid body angle axis, go to moving frame3633: ! hk286 - compute normal modes for rigid body angle axis, go to moving frame
3607:               ELSE IF (RBAAT) THEN3634:               ELSE IF (RBAAT) THEN
3608:                  RBAANORMALMODET = .TRUE.3635:                  RBAANORMALMODET = .TRUE.
3609:                  CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3636:                  CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3610:                  CALL NRMLMD (QTS, DIAG, .FALSE.)3637:                  CALL NRMLMD (QTS, DIAG, .FALSE.)
3611:                  RBAANORMALMODET = .FALSE.3638:                  RBAANORMALMODET = .FALSE.
3635:                     WRITE(LUNIT,*) "Coordinates"3662:                     WRITE(LUNIT,*) "Coordinates"
3636:                     WRITE(LUNIT,*) QTS3663:                     WRITE(LUNIT,*) QTS
3637:                     WRITE(LUNIT,*) "Hessian Eigenvalues"3664:                     WRITE(LUNIT,*) "Hessian Eigenvalues"
3638:                     WRITE(LUNIT,*) DIAG3665:                     WRITE(LUNIT,*) DIAG
3639:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"3666:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"
3640:                     WRITE(LUNIT,*) ATMASS3667:                     WRITE(LUNIT,*) ATMASS
3641:                     CLOSE(LUNIT)3668:                     CLOSE(LUNIT)
3642:                  ENDIF3669:                  ENDIF
3643:               ENDIF3670:               ENDIF
3644:               IF (SDT.OR.TTM3T) THEN3671:               IF (SDT.OR.TTM3T) THEN
3645:                  WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT)3672:                  WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,NOPT)
3646:               ELSEIF (BOWMANT) THEN3673:               ELSEIF (BOWMANT) THEN
3647:                  WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT)3674:                  WRITE(88,'(3G20.10)') (DIAG(J2)*2625.47D26,J2=1,NOPT)
3648:               ELSEIF (RIGIDINIT) THEN3675:               ELSEIF (RIGIDINIT) THEN
3649:                  IF (MACHINE) THEN3676:                  IF (MACHINE) THEN
3650: !                    WRITE(88) (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)3677: !                    WRITE(88) (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
3651:                     WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)3678:                     WRITE(88) (DIAG(J2),J2=1,DEGFREEDOMS)
3652:                  ELSE3679:                  ELSE
3653:                     WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)3680:                     WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,DEGFREEDOMS)
3654: !                    WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)3681: !                    WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
3655:                  ENDIF3682:                  ENDIF
3656:               ELSE3683:               ELSE
3657:                  WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT)3684:                  WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)
3658:               ENDIF3685:               ENDIF
3659:            ENDIF3686:            ENDIF
3660:         ENDIF3687:         ENDIF
3661:      ELSE3688:      ELSE
3662:         IF (VARIABLES) THEN3689:         IF (VARIABLES) THEN
3663:            HORDER=13690:            HORDER=1
3664:            FPGRP='C1'3691:            FPGRP='C1'
3665:         ELSE3692:         ELSE
3666:            CALL SYMMETRY(HORDER,.FALSE.,QTS,INERTIA)3693:            CALL SYMMETRY(HORDER,.FALSE.,QTS,INERTIA)
3667:         ENDIF3694:         ENDIF
3742:            ELSE3769:            ELSE
3743:               WRITE(88,'(I6,1X,A4)') HORDER,FPGRP3770:               WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
3744:            ENDIF3771:            ENDIF
3745:            IF (.NOT.NOFRQS) THEN3772:            IF (.NOT.NOFRQS) THEN
3746:               IF (RIGIDINIT) THEN3773:               IF (RIGIDINIT) THEN
3747:                  CALL GENRIGID_EIGENVALUES(QMINUS, ATMASS, DIAG, INFO)3774:                  CALL GENRIGID_EIGENVALUES(QMINUS, ATMASS, DIAG, INFO)
3748:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN3775:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
3749:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)3776:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
3750:                  ENDIF3777:                  ENDIF
3751:                  IF (MACHINE) THEN3778:                  IF (MACHINE) THEN
3752:                     WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)3779:                     WRITE(88) (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
3753:                  ELSE3780:                  ELSE
3754:                     WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)3781:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
3755:                  ENDIF3782:                  ENDIF
3756:               ELSE3783:               ELSE
3757:                  IF (ENDNUMHESS) THEN3784:                  IF (ENDNUMHESS) THEN
3758:                     CALL MAKENUMHESS(QMINUS,NATOMS)3785:                     CALL MAKENUMHESS(QMINUS,NATOMS)
3759:                  ELSE3786:                  ELSE
3760:                     CALL POTENTIAL(QMINUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3787:                     CALL POTENTIAL(QMINUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3761:                  ENDIF3788:                  ENDIF
3762:                  CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)3789:                  CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
3763:                  IF (HESSDUMPT) THEN3790:                  IF (HESSDUMPT) THEN
3764:                     LUNIT=GETUNIT()3791:                     LUNIT=GETUNIT()
3777:                     WRITE(LUNIT,*) DUMMY13804:                     WRITE(LUNIT,*) DUMMY1
3778:                     WRITE(LUNIT,*) "Coordinates"3805:                     WRITE(LUNIT,*) "Coordinates"
3779:                     WRITE(LUNIT,*) QMINUS3806:                     WRITE(LUNIT,*) QMINUS
3780:                     WRITE(LUNIT,*) "Hessian Eigenvalues"3807:                     WRITE(LUNIT,*) "Hessian Eigenvalues"
3781:                     WRITE(LUNIT,*) DIAG3808:                     WRITE(LUNIT,*) DIAG
3782:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"3809:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"
3783:                     WRITE(LUNIT,*) ATMASS3810:                     WRITE(LUNIT,*) ATMASS
3784:                     CLOSE(LUNIT)3811:                     CLOSE(LUNIT)
3785:                  ENDIF3812:                  ENDIF
3786:                  IF (MACHINE) THEN3813:                  IF (MACHINE) THEN
3787:                     WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,NOPT)3814:                     WRITE(88) (DIAG(J2)*4.184D26,J2=1,NOPT)
3788:                  ELSE3815:                  ELSE
3789:                     WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT)3816:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,NOPT)
3790:                  ENDIF3817:                  ENDIF
3791:               ENDIF3818:               ENDIF
3792:            ENDIF3819:            ENDIF
3793:         ELSEIF (AMBER12T.OR.AMBERT.OR.NABT) THEN3820:         ELSEIF (AMBER12T.OR.AMBERT.OR.NABT) THEN
3794:            IF (.NOT.MACROCYCLET) THEN3821:            IF (.NOT.MACROCYCLET) THEN
3795:               HORDER=13822:               HORDER=1
3796:               FPGRP='C1'3823:               FPGRP='C1'
3797:            ELSE3824:            ELSE
3798:               CALL SYMMETRY(HORDER,.FALSE.,QMINUS,INERTIA)3825:               CALL SYMMETRY(HORDER,.FALSE.,QMINUS,INERTIA)
3799:            ENDIF3826:            ENDIF
3802:            ELSE3829:            ELSE
3803:               WRITE(88,'(I6,1X,A4)') HORDER,FPGRP3830:               WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
3804:            ENDIF3831:            ENDIF
3805:            IF (.NOT.NOFRQS) THEN3832:            IF (.NOT.NOFRQS) THEN
3806:               IF (RIGIDINIT) THEN3833:               IF (RIGIDINIT) THEN
3807:                  CALL GENRIGID_EIGENVALUES(QMINUS, ATMASS, DIAG, INFO)3834:                  CALL GENRIGID_EIGENVALUES(QMINUS, ATMASS, DIAG, INFO)
3808:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN3835:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
3809:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)3836:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
3810:                  ENDIF3837:                  ENDIF
3811:                  IF (MACHINE) THEN3838:                  IF (MACHINE) THEN
3812:                     WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)3839:                     WRITE(88) (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
3813:                  ELSE3840:                  ELSE
3814:                     WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)3841:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
3815:                  ENDIF3842:                  ENDIF
3816:               ELSE3843:               ELSE
3817:                  IF (ENDNUMHESS.OR.AMBERT.OR.AMBER12T) THEN3844:                  IF (ENDNUMHESS.OR.AMBERT.OR.AMBER12T) THEN
3818:                     CALL MAKENUMHESS(QMINUS,NATOMS)3845:                     CALL MAKENUMHESS(QMINUS,NATOMS)
3819:                  ELSE3846:                  ELSE
3820:                     CALL POTENTIAL(QMINUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3847:                     CALL POTENTIAL(QMINUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3821:                  ENDIF3848:                  ENDIF
3822:                  CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)3849:                  CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
3823:                  IF (HESSDUMPT) THEN3850:                  IF (HESSDUMPT) THEN
3824:                     LUNIT=GETUNIT()3851:                     LUNIT=GETUNIT()
3843:                     WRITE(LUNIT,*) DUMMY13870:                     WRITE(LUNIT,*) DUMMY1
3844:                     WRITE(LUNIT,*) "Coordinates"3871:                     WRITE(LUNIT,*) "Coordinates"
3845:                     WRITE(LUNIT,*) QMINUS3872:                     WRITE(LUNIT,*) QMINUS
3846:                     WRITE(LUNIT,*) "Hessian Eigenvalues"3873:                     WRITE(LUNIT,*) "Hessian Eigenvalues"
3847:                     WRITE(LUNIT,*) DIAG3874:                     WRITE(LUNIT,*) DIAG
3848:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"3875:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"
3849:                     WRITE(LUNIT,*) ATMASS3876:                     WRITE(LUNIT,*) ATMASS
3850:                     CLOSE(LUNIT)3877:                     CLOSE(LUNIT)
3851:                  ENDIF3878:                  ENDIF
3852:                  IF (MACHINE) THEN3879:                  IF (MACHINE) THEN
3853:                     WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,NOPT)3880:                     WRITE(88) (DIAG(J2)*4.184D26,J2=1,NOPT)
3854:                  ELSE3881:                  ELSE
3855:                     WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT)3882:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,NOPT)
3856:                  ENDIF3883:                  ENDIF
3857:               ENDIF3884:               ENDIF
3858:            ENDIF3885:            ENDIF
3859:         ELSEIF (UNRST) THEN3886:         ELSEIF (UNRST) THEN
3860:            HORDER=13887:            HORDER=1
3861:            FPGRP='C1'3888:            FPGRP='C1'
3862:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP3889:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
3863:            IF (.NOT.NOFRQS) THEN3890:            IF (.NOT.NOFRQS) THEN
3864:               IF (ENDNUMHESS) THEN3891:               IF (ENDNUMHESS) THEN
3865:                  CALL MAKENUMINTHESS(NINTS,NATOMS)3892:                  CALL MAKENUMINTHESS(NINTS,NATOMS)
3866:                  CALL GETSTUFF(KD,NNZ,NINTB)3893:                  CALL GETSTUFF(KD,NNZ,NINTB)
3867:                  CALL INTSECDET(QMINUS,NOPT,KD,NNZ,NINTB,DIAG)3894:                  CALL INTSECDET(QMINUS,NOPT,KD,NNZ,NINTB,DIAG)
3868:               ELSE3895:               ELSE
3869:                  CALL POTENTIAL(QMINUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3896:                  CALL POTENTIAL(QMINUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3870:               ENDIF3897:               ENDIF
3871:               WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT)3898:               WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)
3872:            ENDIF3899:            ENDIF
3873:         ELSEIF (AMHT) THEN3900:         ELSEIF (AMHT) THEN
3874:            WRITE(88,'(I6,1X,A4)') 1,' C1'3901:            WRITE(88,'(I6,1X,A4)') 1,' C1'
3875:            IF (.NOT.NOFRQS) THEN3902:            IF (.NOT.NOFRQS) THEN
3876:               IF (ENDNUMHESS) THEN3903:               IF (ENDNUMHESS) THEN
3877:                  CALL MAKENUMHESS(QMINUS,NATOMS)3904:                  CALL MAKENUMHESS(QMINUS,NATOMS)
3878:               ELSE3905:               ELSE
3879:                  CALL POTENTIAL(QMINUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3906:                  CALL POTENTIAL(QMINUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3880:              ENDIF3907:              ENDIF
3881:              CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)3908:              CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
3882:                  IF (HESSDUMPT) THEN3909:                  IF (HESSDUMPT) THEN
3883:                     LUNIT=GETUNIT()3910:                     LUNIT=GETUNIT()
3884:                     OPEN(LUNIT,FILE='minhess.minus',STATUS='UNKNOWN',POSITION ='APPEND')3911:                     OPEN(LUNIT,FILE='minhess.minus',STATUS='UNKNOWN',POSITION ='APPEND')
3885:                     WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)3912:                     WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)
3886:                     CLOSE(LUNIT)3913:                     CLOSE(LUNIT)
3887:                  ENDIF3914:                  ENDIF
3888:              CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)3915:              CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
3889:              IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)3916:              IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)
3890:              WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT)3917:              WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)
3891: ! jbr36 - writes the first input for qm rate calculations from classical rates3918: ! jbr36 - writes the first input for qm rate calculations from classical rates
3892:                     IF (INSTANTONSTARTDUMPT) THEN3919:                     IF (INSTANTONSTARTDUMPT) THEN
3893: !                      CALL POTENTIAL(QMINUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3920: !                      CALL POTENTIAL(QMINUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3894:                       LUNIT=5553921:                       LUNIT=555
3895:                       open(LUNIT,file='qmrate_reactant.minus.txt', action='write')3922:                       open(LUNIT,file='qmrate_reactant.minus.txt', action='write')
3896:                       write(LUNIT,'(a)') "Energy and Hessian eigenvalues of reactant.minus"3923:                       write(LUNIT,'(a)') "Energy and Hessian eigenvalues of reactant.minus"
3897:                       write(LUNIT,*) NATOMS,NATOMS*33924:                       write(LUNIT,*) NATOMS,NATOMS*3
3898:                       write(LUNIT,*) QMINUS3925:                       write(LUNIT,*) QMINUS
3899:                       write(LUNIT,*) "Coordinates"3926:                       write(LUNIT,*) "Coordinates"
3900:                       write(LUNIT,*) DUMQ3927:                       write(LUNIT,*) DUMQ
3923:                     OPEN(LUNIT,FILE='minhess.minus',STATUS='UNKNOWN',POSITION ='APPEND')3950:                     OPEN(LUNIT,FILE='minhess.minus',STATUS='UNKNOWN',POSITION ='APPEND')
3924:                     WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)3951:                     WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)
3925:                     CLOSE(LUNIT)3952:                     CLOSE(LUNIT)
3926:                  ENDIF3953:                  ENDIF
3927:               CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)3954:               CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
3928:               IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)3955:               IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)
3929:            ENDIF3956:            ENDIF
3930:            ! hk2863957:            ! hk286
3931:            WRITE(88,'(3G20.10)') (1.0D10,J2=1,NATOMS)3958:            WRITE(88,'(3G20.10)') (1.0D10,J2=1,NATOMS)
3932:            IF (SDT.OR.TTM3T) THEN3959:            IF (SDT.OR.TTM3T) THEN
3933:               WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,2*NATOMS)3960:               WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,2*NATOMS)
3934:            ELSEIF (BOWMANT) THEN3961:            ELSEIF (BOWMANT) THEN
3935:               WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,2*NATOMS)3962:               WRITE(88,'(3G20.10)') (DIAG(J2)*2625.47D26,J2=1,2*NATOMS)
3936:            ELSE3963:            ELSE
3937:               WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,2*NATOMS)3964:               WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,2*NATOMS)
3938:            ENDIF3965:            ENDIF
3939:         ELSE3966:         ELSE
3940:            IF (VARIABLES) THEN3967:            IF (VARIABLES) THEN
3941:               HORDER=13968:               HORDER=1
3942:               FPGRP='C1'3969:               FPGRP='C1'
3943:            ELSE3970:            ELSE
3944:               CALL SYMMETRY(HORDER,.FALSE.,QMINUS,INERTIA)3971:               CALL SYMMETRY(HORDER,.FALSE.,QMINUS,INERTIA)
3945:            ENDIF3972:            ENDIF
3946:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP3973:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
3947:            IF (.NOT.NOFRQS) THEN3974:            IF (.NOT.NOFRQS) THEN
3948:               IF (RIGIDINIT) THEN3975:               IF (RIGIDINIT) THEN
3949:                  CALL GENRIGID_EIGENVALUES(QMINUS, ATMASS, DIAG, INFO)3976:                  IF(METRICTENSOR) THEN
3950: 3977:                      CALL GENRIGID_NORMALMODES(QMINUS, ATMASS, DIAG, INFO)
 3978:                  ELSE
 3979:                      CALL GENRIGID_EIGENVALUES(QMINUS, ATMASS, DIAG, INFO)
 3980:                  ENDIF
3951:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN3981:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
3952:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)3982:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
3953:                  ENDIF3983:                  ENDIF
3954: ! hk286 - compute normal modes for rigid body angle axis, go to moving frame3984: ! hk286 - compute normal modes for rigid body angle axis, go to moving frame
3955:               ELSE IF (RBAAT) THEN3985:               ELSE IF (RBAAT) THEN
3956:                  RBAANORMALMODET = .TRUE.3986:                  RBAANORMALMODET = .TRUE.
3957:                  CALL POTENTIAL(QMINUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3987:                  CALL POTENTIAL(QMINUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3958:                  CALL NRMLMD (QMINUS, DIAG, .FALSE.)3988:                  CALL NRMLMD (QMINUS, DIAG, .FALSE.)
3959:                  RBAANORMALMODET = .FALSE.3989:                  RBAANORMALMODET = .FALSE.
3960:               ELSE3990:               ELSE
3982:                     WRITE(LUNIT,*) "Coordinates"4012:                     WRITE(LUNIT,*) "Coordinates"
3983:                     WRITE(LUNIT,*) QMINUS4013:                     WRITE(LUNIT,*) QMINUS
3984:                     WRITE(LUNIT,*) "Hessian Eigenvalues"4014:                     WRITE(LUNIT,*) "Hessian Eigenvalues"
3985:                     WRITE(LUNIT,*) DIAG4015:                     WRITE(LUNIT,*) DIAG
3986:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"4016:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"
3987:                     WRITE(LUNIT,*) ATMASS4017:                     WRITE(LUNIT,*) ATMASS
3988:                     CLOSE(LUNIT)4018:                     CLOSE(LUNIT)
3989:                  ENDIF4019:                  ENDIF
3990:               ENDIF4020:               ENDIF
3991:               IF (SDT.OR.TTM3T) THEN4021:               IF (SDT.OR.TTM3T) THEN
3992:                  WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT)4022:                  WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,NOPT)
3993:               ELSEIF (RIGIDINIT) THEN4023:               ELSEIF (RIGIDINIT) THEN
3994:                  IF (MACHINE) THEN4024:                  IF (MACHINE) THEN
3995: !                    WRITE(88) (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)4025: !                    WRITE(88) (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
3996:                     WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)4026:                     WRITE(88) (DIAG(J2),J2=1,DEGFREEDOMS)
3997:                  ELSE4027:                  ELSE
3998:                     WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS)4028:                     WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,DEGFREEDOMS)
3999: !                    WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)4029: !                    WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
4000:                  ENDIF4030:                  ENDIF
4001:               ELSEIF (BOWMANT) THEN4031:               ELSEIF (BOWMANT) THEN
4002:                  WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT)4032:                  WRITE(88,'(3G20.10)') (DIAG(J2)*2625.47D26,J2=1,NOPT)
4003:               ELSE4033:               ELSE
4004:                  WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT)4034:                  WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)
4005:               ENDIF4035:               ENDIF
4006:            ENDIF4036:            ENDIF
4007:         ENDIF4037:         ENDIF
4008:      ELSE4038:      ELSE
4009:         IF (VARIABLES) THEN4039:         IF (VARIABLES) THEN
4010:            HORDER=14040:            HORDER=1
4011:            FPGRP='C1'4041:            FPGRP='C1'
4012:         ELSE4042:         ELSE
4013:            CALL SYMMETRY(HORDER,.FALSE.,QMINUS,INERTIA)4043:            CALL SYMMETRY(HORDER,.FALSE.,QMINUS,INERTIA)
4014:         ENDIF4044:         ENDIF


r31537/path.f 2016-11-24 14:30:19.781947504 +0000 r31536/path.f 2016-11-24 14:30:22.561984399 +0000
1077:             DO J1=1,NSTEPPLUS+NSTEPMINUS+11077:             DO J1=1,NSTEPPLUS+NSTEPMINUS+1
1078:                PATHLENGTH(J1)=NEG*PATHLENGTH(J1)1078:                PATHLENGTH(J1)=NEG*PATHLENGTH(J1)
1079:             ENDDO1079:             ENDDO
1080:             LUNIT=GETUNIT()1080:             LUNIT=GETUNIT()
1081:             OPEN(UNIT=LUNIT,FILE='EofS.fold',STATUS='UNKNOWN')1081:             OPEN(UNIT=LUNIT,FILE='EofS.fold',STATUS='UNKNOWN')
1082:             DO J1=1,NSTEPPLUS+NSTEPMINUS+11082:             DO J1=1,NSTEPPLUS+NSTEPMINUS+1
1083:                WRITE(LUNIT,'(3G20.10)') PATHLENGTH(J1),EOFS(J1),EOFS(J1)-MAX(EOFS(1),EOFS(NSTEPPLUS+NSTEPMINUS+1))1083:                WRITE(LUNIT,'(3G20.10)') PATHLENGTH(J1),EOFS(J1),EOFS(J1)-MAX(EOFS(1),EOFS(NSTEPPLUS+NSTEPMINUS+1))
1084:             ENDDO1084:             ENDDO
1085:             CLOSE(LUNIT)1085:             CLOSE(LUNIT)
1086: 1086: 
1087:             ! sn402: Added IF blocks to deal with rigid body systems here1087:             CALL POTENTIAL(QPLUS,EPLUS,VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
1088:             IF(RIGIDINIT) THEN1088:             CALL DSYEV('V','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,3*NOPT,INFO) 
1089:                 WRITE(*,*) "path> Warning: RIGIDINIT not tested with RATIOS" 
1090:                 ! sn402: Not sure whether ATMASS is always set here, and if it isn't then this call won't work. Needs review. 
1091:                 CALL GENRIGID_EIGENVALUES(QPLUS, ATMASS, DIAG, INFO) 
1092:                 ! We need EPLUS (and possibly VNEW?) as well as the eigenvalues, so we need an extra potential call. 
1093:                 CALL POTENTIAL(QPLUS,EPLUS,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.) 
1094:             ELSEIF(RBAAT) THEN 
1095:                 WRITE(*,*) "path> Warning: RATIOS not tested with rigid body potentials" 
1096:                 CALL NRMLMD(QPLUS, DIAG, .FALSE.) 
1097:                 ! We need EPLUS (and possibly VNEW?) as well as the eigenvalues, so we need an extra potential call. 
1098:                 CALL POTENTIAL(QPLUS,EPLUS,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.) 
1099:             ELSE 
1100:                 CALL POTENTIAL(QPLUS,EPLUS,VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.) 
1101:                 CALL DSYEV('V','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,3*NOPT,INFO) 
1102:             ENDIF 
1103:             CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)1089:             CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)
1104:  
1105:             IF (DEBUG) THEN1090:             IF (DEBUG) THEN
1106:                PRINT '(A)','+ min energy'1091:                PRINT '(A)','+ min energy'
1107:                PRINT '(G20.10)',EPLUS1092:                PRINT '(G20.10)',EPLUS
1108:                PRINT '(A)','+ min eigenvalues:'1093:                PRINT '(A)','+ min eigenvalues:'
1109:                PRINT '(3G20.10)',DIAG(1:NOPT)1094:                PRINT '(3G20.10)',DIAG(1:NOPT)
1110:             ENDIF1095:             ENDIF
1111:             LAMBDAP=DIAG(NOPT-NZERO)1096:             LAMBDAP=DIAG(NOPT-NZERO)
1112: 1097:             CALL POTENTIAL(QMINUS,EMINUS,VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
1113:             ! sn402: Added IF blocks to deal with rigid body systems here1098:             CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,3*NOPT,INFO) 
1114:             IF(RIGIDINIT) THEN 
1115:                 WRITE(*,*) "path> Warning: RIGIDINIT not tested with RATIOS" 
1116:                 ! sn402: Not sure whether ATMASS is always set here, and if it isn't then this call won't work. Needs review. 
1117:                 CALL GENRIGID_EIGENVALUES(QMINUS, ATMASS, DIAG, INFO) 
1118:                 CALL POTENTIAL(QMINUS,EMINUS,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.) 
1119:             ELSEIF(RBAAT) THEN 
1120:                 WRITE(*,*) "path> Warning: RATIOS not tested with rigid body potentials" 
1121:                 CALL NRMLMD(QMINUS, DIAG, .FALSE.) 
1122:                 CALL POTENTIAL(QMINUS,EMINUS,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.) 
1123:             ELSE 
1124:                 CALL POTENTIAL(QMINUS,EMINUS,VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.) 
1125:                 CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,3*NOPT,INFO) 
1126:             ENDIF 
1127:             CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)1099:             CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)
1128:  
1129:             IF (DEBUG) THEN1100:             IF (DEBUG) THEN
1130:                PRINT '(A)','- min energy'1101:                PRINT '(A)','- min energy'
1131:                PRINT '(G20.10)',EMINUS1102:                PRINT '(G20.10)',EMINUS
1132:                PRINT '(A)','- min eigenvalues:'1103:                PRINT '(A)','- min eigenvalues:'
1133:                PRINT '(3G20.10)',DIAG(1:NOPT)1104:                PRINT '(3G20.10)',DIAG(1:NOPT)
1134:             ENDIF1105:             ENDIF
1135: 1106: 
1136:             LAMBDAM=DIAG(NOPT-NZERO)1107:             LAMBDAM=DIAG(NOPT-NZERO)
1137: 1108:             CALL POTENTIAL(QINIT,EOFS(NSTEPPLUS+1),VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
1138:             ! sn402: Added IF blocks to deal with rigid body systems here1109:             CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,3*NOPT,INFO) 
1139:             IF(RIGIDINIT) THEN 
1140:                 WRITE(*,*) "path> Warning: RIGIDINIT not tested with RATIOS" 
1141:                 ! sn402: Not sure whether ATMASS is always set here, and if it isn't then this call won't work. Needs review. 
1142:                 CALL GENRIGID_EIGENVALUES(QINIT, ATMASS, DIAG, INFO) 
1143:                 CALL POTENTIAL(QINIT,EOFS(NSTEPPLUS+1),VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.) 
1144:             ELSEIF(RBAAT) THEN 
1145:                 WRITE(*,*) "path> Warning: RATIOS not tested with rigid body potentials" 
1146:                 CALL NRMLMD(QINIT, DIAG, .FALSE.) 
1147:                 CALL POTENTIAL(QINIT,EOFS(NSTEPPLUS+1),VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.) 
1148:             ELSE 
1149:                 CALL POTENTIAL(QINIT,EOFS(NSTEPPLUS+1),VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.) 
1150:                 CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,3*NOPT,INFO) 
1151:             ENDIF 
1152:             CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)1110:             CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)
1153:  
1154:             IF (DEBUG) THEN1111:             IF (DEBUG) THEN
1155:                PRINT '(A)','ts energy'1112:                PRINT '(A)','ts energy'
1156:                PRINT '(G20.10)',EOFS(NSTEPPLUS+1)1113:                PRINT '(G20.10)',EOFS(NSTEPPLUS+1)
1157:                PRINT '(A)','ts eigenvalues:'1114:                PRINT '(A)','ts eigenvalues:'
1158:                PRINT '(3G20.10)',DIAG(1:NOPT)1115:                PRINT '(3G20.10)',DIAG(1:NOPT)
1159:             ENDIF1116:             ENDIF
1160:             LAMBDATS=DIAG(NOPT)1117:             LAMBDATS=DIAG(NOPT)
1161:             CALL NEWMINDIST(QPLUS,QINIT,NATOMS,DISTP,.FALSE.,.FALSE.,ZSYMSAVE,.FALSE.,RIGIDBODY,DEBUG,RMAT)1118:             CALL NEWMINDIST(QPLUS,QINIT,NATOMS,DISTP,.FALSE.,.FALSE.,ZSYMSAVE,.FALSE.,RIGIDBODY,DEBUG,RMAT)
1162:             CALL NEWMINDIST(QMINUS,QINIT,NATOMS,DISTM,.FALSE.,.FALSE.,ZSYMSAVE,.FALSE.,RIGIDBODY,DEBUG,RMAT)1119:             CALL NEWMINDIST(QMINUS,QINIT,NATOMS,DISTM,.FALSE.,.FALSE.,ZSYMSAVE,.FALSE.,RIGIDBODY,DEBUG,RMAT)
1163:             LUNIT=GETUNIT()1120:             LUNIT=GETUNIT()
1187:      &            6*(Eofs(nstepplus+1)-Eofs(1))/(ABS(lambdats)*DISTP**2),1144:      &            6*(Eofs(nstepplus+1)-Eofs(1))/(ABS(lambdats)*DISTP**2),
1188:      &           -6*(Eofs(nstepplus+nstepminus+1)-Eofs(nstepplus+1))/(lambdam*PATHLENGTH(NSTEPPLUS+NSTEPMINUS+1)**2),1145:      &           -6*(Eofs(nstepplus+nstepminus+1)-Eofs(nstepplus+1))/(lambdam*PATHLENGTH(NSTEPPLUS+NSTEPMINUS+1)**2),
1189:      &            6*(Eofs(nstepplus+1)-Eofs(1))/(lambdap*PATHLENGTH(1)**2),1146:      &            6*(Eofs(nstepplus+1)-Eofs(1))/(lambdap*PATHLENGTH(1)**2),
1190:      &           -6*(Eofs(nstepplus+nstepminus+1)-Eofs(nstepplus+1))/(lambdam*DISTM**2),1147:      &           -6*(Eofs(nstepplus+nstepminus+1)-Eofs(nstepplus+1))/(lambdam*DISTM**2),
1191:      &            6*(Eofs(nstepplus+1)-Eofs(1))/(lambdap*DISTP**2),1148:      &            6*(Eofs(nstepplus+1)-Eofs(1))/(lambdap*DISTP**2),
1192:      &            PATHLENGTH(NSTEPPLUS+NSTEPMINUS+1),PATHLENGTH(1),DISTM, DISTP1149:      &            PATHLENGTH(NSTEPPLUS+NSTEPMINUS+1),PATHLENGTH(1),DISTM, DISTP
1193:             ENDIF1150:             ENDIF
1194:             CLOSE(LUNIT)1151:             CLOSE(LUNIT)
1195:       ENDIF1152:       ENDIF
1196: C end tvb1153: C end tvb
1197: C (i.e. end of IF(RATIOS)1154: C
1198:  
1199:       SLENGTH=PATHLENGTH(NSTEPPLUS+NSTEPMINUS+1)-PATHLENGTH(1)1155:       SLENGTH=PATHLENGTH(NSTEPPLUS+NSTEPMINUS+1)-PATHLENGTH(1)
1200:       DISP=SQRT(SUM2)1156:       DISP=SQRT(SUM2)
1201: C     GAMMA=SUM4*NDUMMY*NATOMS/SUM2**2  !  WCOMMENT1157: C     GAMMA=SUM4*NDUMMY*NATOMS/SUM2**2  !  WCOMMENT
1202:       GAMMA=SUM4*NATOMSIMUL/SUM2**21158:       GAMMA=SUM4*NATOMSIMUL/SUM2**2
1203:       NTILDE=SUM2**2/SUM41159:       NTILDE=SUM2**2/SUM4
1204:       IF (CHECKINDEX.AND.RATIOS.AND..NOT.CONNECTT) THEN1160:       IF (CHECKINDEX.AND.RATIOS.AND..NOT.CONNECTT) THEN
1205:          SMINUS=PATHLENGTH(NSTEPPLUS+NSTEPMINUS+1)1161:          SMINUS=PATHLENGTH(NSTEPPLUS+NSTEPMINUS+1)
1206:          SPLUS=PATHLENGTH(1)1162:          SPLUS=PATHLENGTH(1)
1207:          STS=PATHLENGTH(NSTEPPLUS+1)1163:          STS=PATHLENGTH(NSTEPPLUS+1)
1208:          IF (EPLUS.LT.EMINUS) THEN1164:          IF (EPLUS.LT.EMINUS) THEN
1765:       END IF ! unrst1721:       END IF ! unrst
1766: !1722: !
1767: ! This is where the path.info file is dumped for PATH runs without a1723: ! This is where the path.info file is dumped for PATH runs without a
1768: ! CONNECT or NEWCONNECT keyword. It is a triple for both DUMPPATH and1724: ! CONNECT or NEWCONNECT keyword. It is a triple for both DUMPPATH and
1769: ! DUMPALLPATHS.1725: ! DUMPALLPATHS.
1770: !1726: !
1771:       IF ((DUMPPATH.OR.DUMPALLPATHS).AND.(.NOT.CONNECTT)) THEN1727:       IF ((DUMPPATH.OR.DUMPALLPATHS).AND.(.NOT.CONNECTT)) THEN
1772:          IF (UNRST) WRITE(*,'(A)') '*** NOTE - pathlengths calculated from saved Cartesian coords will be rubbish1728:          IF (UNRST) WRITE(*,'(A)') '*** NOTE - pathlengths calculated from saved Cartesian coords will be rubbish
1773:      & as they have been placed in the standard unres orientation.'1729:      & as they have been placed in the standard unres orientation.'
1774:          IF (ZSYMSAVE.EQ.'CD') WRITE(*,'(A)') 'WARNING, symmetry and normal modes not implemented properly for CAPSID'1730:          IF (ZSYMSAVE.EQ.'CD') WRITE(*,'(A)') 'WARNING, symmetry and normal modes not implemented properly for CAPSID'
 1731:          IF (UNRST) THEN
 1732:             IF (CALCDIHE) THEN
 1733:                 CALL UNRESCALCDIHEREF(DIHE,ALLANG,QPLUS)
 1734:             ELSE
 1735:                 DIHE=0.5D0 ! dummy order param for pathsample related purposes
 1736:             ENDIF
 1737: C jmc         WRITE(88,'(3G25.15)') EPLUS, DIHE, ALLANG
 1738:             WRITE(88,'(2G25.15)') EPLUS, DIHE
 1739:          ELSE
 1740:             WRITE(88,'(G25.15)') EPLUS
 1741:          ENDIF
 1742:          IF (ZSYMSAVE(1:1).EQ.'W') THEN
 1743:             IF (ZSYMSAVE.EQ.'W4') IPOT=4
 1744:             IF (ZSYMSAVE.EQ.'W3') IPOT=3
 1745:             IF (ZSYMSAVE.EQ.'W2') IPOT=2
 1746:             IF (ZSYMSAVE.EQ.'W1') IPOT=1
 1747: C           DO J2=1,NATOMS
 1748:             DO J2=1,NATOMS/2 ! WCOMMENT
 1749:                CALL CONVERT(QPLUS(3*(J2-1)+1),QPLUS(3*(J2-1)+2),QPLUS(3*(J2-1)+3),
 1750: C    1                      QPLUS(3*(NATOMS+J2-1)+1),QPLUS(3*(NATOMS+J2-1)+2),QPLUS(3*(NATOMS+J2-1)+3),
 1751:      1                      QPLUS(3*(NATOMS/2+J2-1)+1),QPLUS(3*(NATOMS/2+J2-1)+2),QPLUS(3*(NATOMS/2+J2-1)+3),
 1752:      2                      OVEC,H1VEC,H2VEC)
 1753:                QW(9*(J2-1)+1)=OVEC(1) ! WCOMMENT
 1754:                QW(9*(J2-1)+2)=OVEC(2)
 1755:                QW(9*(J2-1)+3)=OVEC(3)
 1756:                QW(9*(J2-1)+4)=H1VEC(1)
 1757:                QW(9*(J2-1)+5)=H1VEC(2)
 1758:                QW(9*(J2-1)+6)=H1VEC(3)
 1759:                QW(9*(J2-1)+7)=H2VEC(1)
 1760:                QW(9*(J2-1)+8)=H2VEC(2)
 1761:                QW(9*(J2-1)+9)=H2VEC(3)
 1762:             ENDDO 
 1763: C           NATOMS=NATOMS*3 ! WCOMMENT
 1764:             NATOMSSAVE=NATOMS
 1765:             NATOMS=(NATOMS/2)*3
 1766:             CALL SYMMETRY(HORDER,.FALSE.,QW,INERTIA) ! WCOMMENT
 1767: C           NATOMS=NATOMS/3 ! WCOMMENT
 1768:             NATOMS=2*(NATOMS/3)
 1769:             NATOMS=NATOMSSAVE
 1770:             WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
 1771: C           DO J2=1,6*NATOMS ! WCOMMENT
 1772:             DO J2=1,3*NATOMS
 1773:                Q(J2)=QPLUS(J2)
 1774:             ENDDO
 1775: C           CALL H2OMODES(NATOMS,IPOT,Q,DIAG) ! WCOMMENT
 1776:             CALL H2OMODES(NATOMS/2,IPOT,Q,DIAG)
 1777: C           WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,6*NATOMS) ! WCOMMENT
 1778:             IF (.NOT.NOFRQS) WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,3*NATOMS)
1775: 1779: 
 1780: ! hk286 - compute potential for normal modes, notice the toggle
 1781:          ELSE IF (RBAAT) THEN
 1782:             IF (.NOT.NOFRQS) THEN
 1783:                RBAANORMALMODET = .TRUE.
 1784:                CALL POTENTIAL(Q,EPLUS,VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
 1785:                CALL NRMLMD (Q, DIAG, .FALSE.)
 1786:                RBAANORMALMODET = .FALSE.
 1787:                WRITE(88, '(A,A)') "1  ", "C1" ! TEMP Solution
 1788:                WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,3*NATOMS)
 1789:             ENDIF  
 1790: ! hk286
 1791: !
 1792: ! Hessian eigenvalues will generally be shifted even if we have them - so we need to recalculate
 1793: !
 1794: !        ELSE IF ((FRQSPLUS(NOPT).EQ.0.0D0).OR.CHRMMT.OR.UNRST.OR.AMBERT.OR.NABT.OR.AMHT) THEN
 1795:          ELSE IF (.TRUE.) THEN
 1796:             DO J2=1,NOPT
 1797:                Q(J2)=QPLUS(J2)
 1798:             ENDDO
 1799: !           IF (.NOT.UNRST) CALL POTENTIAL(Q,EPLUS,VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
 1800:             IF (CHRMMT) THEN
 1801:                HORDER=1
 1802:                FPGRP='C1'
 1803:                IF (RIGIDINIT.AND.(.NOT.NOFRQS)) THEN
 1804:                  CALL GENRIGID_EIGENVALUES(Q, ATMASS, DIAG, INFO)
 1805:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
 1806:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
 1807:                  ENDIF
 1808:                ELSE
 1809:                  IF (ENDNUMHESS) THEN
 1810:                     CALL MAKENUMHESS(Q,NATOMS)
 1811:                  ELSEIF (.NOT.NOFRQS) THEN
 1812:                     CALL POTENTIAL(Q,EPLUS,VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
 1813:                  ENDIF
 1814:                  IF (.NOT.NOFRQS) CALL MASSWT2(NATOMS,ATMASS,Q,VNEW,.TRUE.)
 1815:                ENDIF
 1816:             ELSE IF (AMBERT .OR. AMBER12T) THEN
 1817:                IF (.NOT.MACROCYCLET) THEN
 1818:                   HORDER=1
 1819:                   FPGRP='C1'
 1820:                ELSE
 1821:                   CALL SYMMETRY(HORDER,.FALSE.,Q,INERTIA)
 1822:                ENDIF
 1823:                IF (RIGIDINIT.AND.(.NOT.NOFRQS)) THEN
 1824:                  CALL GENRIGID_EIGENVALUES(Q, ATMASS, DIAG, INFO)
 1825:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
 1826:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
 1827:                  ENDIF
 1828:                ELSE
 1829:                  IF (ENDNUMHESS) THEN
 1830:                      CALL MAKENUMHESS(Q,NATOMS)
 1831:                  ENDIF
 1832:                  IF (.NOT.NOFRQS) CALL MASSWT2(NATOMS,ATMASS,Q,VNEW,.TRUE.)
 1833:                ENDIF
 1834:             ELSE IF (NABT) THEN
 1835:                HORDER=1
 1836:                FPGRP='C1'
 1837:                IF (RIGIDINIT.AND.(.NOT.NOFRQS)) THEN
 1838:                  CALL GENRIGID_EIGENVALUES(Q, ATMASS, DIAG, INFO)
 1839:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
 1840:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
 1841:                  ENDIF
 1842:                ELSE
 1843:                  IF (ENDNUMHESS) THEN
 1844:                     CALL MAKENUMHESS(Q,NATOMS)
 1845:                  ELSEIF (.NOT.NOFRQS) THEN
 1846:                     CALL POTENTIAL(Q,EPLUS,VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
 1847:                  ENDIF
 1848:                  IF (.NOT.NOFRQS) CALL MASSWT2(NATOMS,ATMASS,Q,VNEW,.TRUE.)
 1849:                ENDIF
 1850:             ELSEIF (AMHT) THEN
 1851:                HORDER=1
 1852:                FPGRP='C1'
 1853:                IF (ENDNUMHESS) THEN
 1854:                    CALL MAKENUMHESS(Q,NATOMS)
 1855:                ELSEIF (.NOT.NOFRQS) THEN
 1856:                   CALL POTENTIAL(Q,EPLUS,VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
 1857:                ENDIF
 1858:                IF (.NOT.NOFRQS) CALL MASSWT2(NATOMS,ATMASS,Q,VNEW,.TRUE.)
 1859:             ELSE IF (UNRST) THEN
 1860:                DO J2=1,nres
 1861:                   c(1,J2)=Q(6*(J2-1)+1)
 1862:                   c(2,J2)=Q(6*(J2-1)+2)
 1863:                   c(3,J2)=Q(6*(J2-1)+3)
 1864:                   c(1,J2+nres)=Q(6*(J2-1)+4)
 1865:                   c(2,J2+nres)=Q(6*(J2-1)+5)
 1866:                   c(3,J2+nres)=Q(6*(J2-1)+6)
 1867:                ENDDO
 1868:                CALL UPDATEDC
 1869:                CALL int_from_cart(.true.,.false.)
 1870:                CALL chainbuild
 1871:                HORDER=1
 1872:                FPGRP='C1'
 1873:                IF (ENDNUMHESS) THEN
 1874:                   CALL MAKENUMINTHESS(NINTS,NATOMS)
 1875:                   CALL GETSTUFF(KD,NNZ,NINTB)
 1876:                   CALL INTSECDET(Q,3*NATOMS,KD,NNZ,NINTB,DIAG)
 1877:                ELSEIF (.NOT.NOFRQS) THEN
 1878:                   CALL POTENTIAL(Q,EPLUS,VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
 1879:                ENDIF
 1880:             ELSEIF (GTHOMSONT) THEN
 1881:                CALL GTHOMSONANGTOC(TMPCOORDS,Q,NATOMS)
 1882:                CALL SYMMETRY(HORDER,.FALSE.,TMPCOORDS,INERTIA)
 1883:                IF (.NOT.NOFRQS) THEN
 1884:                   IF (ENDNUMHESS) THEN
 1885:                      CALL MAKENUMHESS(Q,NATOMS)
 1886:                   ELSE
 1887:                      CALL POTENTIAL(Q,EPLUS,VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
 1888:                   ENDIF
 1889:                ENDIF
 1890:             ELSE
 1891:                 ! sn402: needs testing
 1892:                IF (RIGIDINIT.AND.(.NOT.NOFRQS)) THEN
 1893:                  CALL GENRIGID_EIGENVALUES(Q, ATMASS, DIAG, INFO)
 1894:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
 1895:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
 1896:                  ENDIF
 1897:                ELSE
 1898:                   IF (ENDNUMHESS) THEN
 1899:                       CALL MAKENUMHESS(Q,NATOMS)
 1900:                   ELSEIF (.NOT.NOFRQS) THEN
 1901:                       CALL POTENTIAL(Q,EPLUS,VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
 1902:                   ENDIF
 1903:                   CALL SYMMETRY(HORDER,.FALSE.,Q,INERTIA)
 1904:                   IF (.NOT.NOFRQS) CALL MASSWT(NATOMS,ATMASS,Q,VNEW,.TRUE.)
 1905:                ENDIF
 1906:             ENDIF
 1907:             if (machine) then
 1908:                  WRITE(88) HORDER,FPGRP
 1909:             else
 1910:                  WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
 1911:             endif
 1912:             IF (HESSDUMPT) THEN
 1913:                LUNIT=GETUNIT()
 1914:                OPEN(LUNIT,FILE='minhess.plus',STATUS='UNKNOWN',POSITION ='APPEND')
 1915:                WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)
 1916:                CLOSE(LUNIT)
 1917:             ENDIF
1776: 1918: 
1777:          CALL MAKE_PATHINFO_POINT(QPLUS, EPLUS, 'minhess.plus', .FALSE.)1919:             IF (.NOT.(UNRST.OR.NOFRQS.OR.RIGIDINIT)) THEN
1778: 1920: ! hk286 - computing normal modes
1779:          CALL MAKE_PATHINFO_POINT(QINIT, ETS, 'tshess', .TRUE.)1921:                IF (RBAAT) THEN
1780: 1922:                   RBAANORMALMODET = .TRUE.
1781:          CALL MAKE_PATHINFO_POINT(QMINUS, EMINUS, 'minhess.minus', .TRUE.)1923:                   CALL NRMLMD (Q, DIAG, .FALSE.)
 1924:                   RBAANORMALMODET = .FALSE.
 1925:                ELSE
 1926:                   CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,3*NOPT,INFO)
 1927:                   IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)
 1928:                ENDIF
 1929:             ENDIF
1782: 1930: 
1783:          CLOSE(88) 
1784: 1931: 
1785:       else if (machine.and..not.connectt) then1932: ! hk286
1786: C SAT this is for the case when we need points for minima to be output in binary format, but do not want expensive Hessian1933: ! sn402: added RIGIDMOLECULEST
1787: C diagonalization, which is required to produce "path.info" file1934:             IF (CHRMMT.OR.AMBERT.OR.AMBER12T.OR.NABT.OR.RIGIDMOLECULEST) THEN
1788:          inquire(iolength=reclen) (diag(J1),J1=1,3*Natoms)1935:                if (machine) then
1789:          open(unit=38,file="points1.out",status='unknown',form='unformatted',access='direct',recl=reclen)1936:                   IF (RIGIDINIT) THEN
1790:          write(38,rec=1) (QPLUS(J2),J2=1,NOPT)1937:                     IF (.NOT.NOFRQS) WRITE(88) (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
1791:          close(38)1938:                   ELSE
1792:          open(unit=38,file="points2.out",status='unknown',form='unformatted',access='direct',recl=reclen)1939:                     IF (.NOT.NOFRQS) WRITE(88) (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
1793:          write(38,rec=1) (QMINUS(J2),J2=1,NOPT)1940:                   ENDIF
1794:          close(38)1941:                else
1795:       endif1942:                   IF (RIGIDINIT) THEN
 1943:                     IF (.NOT.NOFRQS) WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
 1944:                   ELSE
 1945:                     IF (.NOT.NOFRQS) WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
 1946:                   ENDIF
 1947:                endif
 1948:             ELSEIF (GTHOMSONT) THEN
 1949:                IF (.NOT.NOFRQS) WRITE(88,'(3G20.10)') (1.0D10, J2=1, NATOMS)
 1950:                IF (.NOT.NOFRQS) WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,2*NATOMS)
 1951:             ELSE
 1952:                IF (.NOT.NOFRQS) WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)
1796: 1953: 
1797:       BFGSTST=BFGSTSTSAVE1954:             ENDIF
1798:       IVEC=IVECSAVE1955:          ELSE
1799:       IVEC2=IVEC2SAVE1956: !           WRITE(*,*) ' dumping pathway ..... PLUS'
 1957: !           WRITE(*,*) QPLUS(:)
 1958:             DO J2=1,NOPT
 1959:                Q(J2)=QPLUS(J2)
 1960:             ENDDO
 1961:             IF (VARIABLES) THEN
 1962:                HORDER=1
 1963:                FPGRP='C1'
 1964:             ELSE
 1965:                CALL SYMMETRY(HORDER,.FALSE.,Q,INERTIA)
 1966:             ENDIF
 1967:             WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
 1968:             WRITE(88,'(3G20.10)') (FRQSPLUS(J2),J2=1,NOPT)
 1969:          ENDIF
1800: 1970: 
1801:       IF (ALLOCATED(Q1)) DEALLOCATE(Q1)1971:          IF (MACHINE) then
1802:       IF (ALLOCATED(Q2)) DEALLOCATE(Q2)1972:             IF (GTHOMSONT) THEN
1803:       IF (ALLOCATED(QW)) DEALLOCATE(QW)1973:                CALL GTHOMSONANGTOC(TMPCOORDS, QPLUS, NATOMS)
1804:       IF (ALLOCATED(QFRAMEP)) DEALLOCATE(QFRAMEP)1974:                WRITE(88) (TMPCOORDS(J2), J2=1, 3*NATOMS)
1805:       IF (ALLOCATED(QFRAMEM)) DEALLOCATE(QFRAMEM)1975:              ELSE IF (RIGIDINIT) THEN
1806:       IF (ALLOCATED(EOFS)) DEALLOCATE(EOFS, PATHLENGTH, EOFSFRAMEP, EOFSFRAMEM)1976:                 CALL TRANSFORMRIGIDTOC (1, NRIGIDBODY, XCOORDS, QPLUS)
 1977:                 WRITE(88) (XCOORDS(J2),J2=1,3*NATOMS)
 1978:              ELSE 
 1979:                 WRITE(88) (QPLUS(J2),J2=1,NOPT)
 1980:              ENDIF
 1981:              WRITE(88) ETS
1807: 1982: 
1808:       RETURN1983:          ELSEIF (AMHT) THEN
1809:       END 
1810: 1984: 
1811: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1985: !  THIS IS FOR PLACE HOLDING C-BETAS FOR GLYCINE IN AMH
 1986:             GLY_COUNT = 0
1812: 1987: 
1813:       SUBROUTINE MAKE_PATHINFO_POINT(Q, E, HESSDUMP_FNAME, ISTS)1988:             DO J2=1, NRES_AMH_TEMP
1814:       USE COMMONS1989:                IF (SEQ(J2).EQ.8) THEN
1815:       USE KEY1990:                    WRITE(88,*)QPLUS(9*(J2-1)+1-GLY_COUNT*3), 
1816:       USE SYMINF1991:      &              QPLUS(9*(J2-1)+2-GLY_COUNT*3),QPLUS(9*(J2-1)+3-GLY_COUNT*3)
1817:       USE modcharmm1992:                   WRITE(88,*)QPLUS(9*(J2-1)+1-GLY_COUNT*3), 
1818:       USE MODUNRES1993:      &              QPLUS(9*(J2-1)+2-GLY_COUNT*3),QPLUS(9*(J2-1)+3-GLY_COUNT*3)
1819:       USE MODHESS1994:                   WRITE(88,*)QPLUS(9*(J2-1)+4-GLY_COUNT*3), 
1820:       USE GENRIGID1995:      &               QPLUS(9*(J2-1)+5-GLY_COUNT*3),QPLUS(9*(J2-1)+6-GLY_COUNT*3)
1821: 1996:                   GLY_COUNT = GLY_COUNT + 1
1822:       IMPLICIT NONE1997:                ELSE
1823: 1998:                  WRITE(88,*)QPLUS(9*(J2-1)+1-GLY_COUNT*3), 
1824:       DOUBLE PRECISION, INTENT(IN)   :: Q(NOPT)          ! Coordinate vector for the point that we want to write out1999:      &              QPLUS(9*(J2-1)+2-GLY_COUNT*3),QPLUS(9*(J2-1)+3-GLY_COUNT*3)
1825:       DOUBLE PRECISION, INTENT(IN)   :: E                ! Energy for the point that we want to write out2000:                  WRITE(88,*)QPLUS(9*(J2-1)+4-GLY_COUNT*3), 
1826:       CHARACTER(*), INTENT(IN) :: HESSDUMP_FNAME   ! Name of the file to which the hessian will be dumped2001:      &              QPLUS(9*(J2-1)+5-GLY_COUNT*3),QPLUS(9*(J2-1)+6-GLY_COUNT*3)
1827:                                                          ! (if DUMPHESS is set)2002:                 WRITE(88,*)QPLUS(9*(J2-1)+7-GLY_COUNT*3), 
1828:       LOGICAL, INTENT(IN)            :: ISTS             ! TRUE if the point is a transition state, false otherwise2003:      &              QPLUS(9*(J2-1)+8-GLY_COUNT*3),QPLUS(9*(J2-1)+9-GLY_COUNT*3)
1829: 2004:                ENDIF
1830:       ! Element labels for writing to path.info files2005:             ENDDO
1831:       CHARACTER(LEN=5) :: ZSYMSAVE2006:             WRITE(88,'(F25.15)') ETS
1832:       COMMON /SYS/ ZSYMSAVE2007:          ELSE
1833: 2008:              IF (GTHOMSONT) THEN
1834:       ! Variables for calls to POTENTIAL and SYMMETRY2009:                CALL GTHOMSONANGTOC(TMPCOORDS, QPLUS, NATOMS)
1835:       DOUBLE PRECISION :: VNEW(NOPT), DIAG(NOPT), RMS2010:                WRITE(88,'(3F25.15)') (TMPCOORDS(J2),J2=1, 3*NATOMS)
1836:       DOUBLE PRECISION :: INERTIA(3,3)2011:               ELSE IF (RIGIDINIT) THEN
1837:       INTEGER          :: HORDER2012:                  CALL TRANSFORMRIGIDTOC (1, NRIGIDBODY, XCOORDS, QPLUS)
1838: 2013:                  WRITE(88,'(3F25.15)') (XCOORDS(J2),J2=1,3*NATOMS)
1839:       ! Variables for dumping Hessian2014:               ELSE
1840:       INTEGER :: LUNIT, GETUNIT2015:                  WRITE(88,'(3F25.15)') (QPLUS(J2),J2=1,NOPT)
1841: 2016:               ENDIF
1842:       ! Variables for old water potential2017:               WRITE(88,'(F25.15)') ETS
1843:       INTEGER                                     :: NATOMSSAVE, IPOT2018:          ENDIF
1844:       DOUBLE PRECISION                            :: OVEC(3), H1VEC(3), H2VEC(3) 
1845:       DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: QW 
1846:  
1847:       ! Variables for UNRES, AMH 
1848:       INTEGER          :: KD, NNZ, NINTB, GLY_COUNT 
1849:       DOUBLE PRECISION :: DIHE, ALLANG 
1850:  
1851:       ! Dummy variables 
1852:       DOUBLE PRECISION :: XCOORDS(NOPT), TMPCOORDS(NOPT), TEMPA(9*NATOMS) 
1853:       INTEGER          :: J1, J2, INFO 
1854:  
1855:       ! We have identified a stationary point (minimum or ts) and now wish to write its information to a path.info file. 
1856:       ! We know the energy and coordinates of the point, we need to determine the point group and the normal mode frequencies. 
1857:       ! This is done here. 
1858:       ! (Note, sometimes we may have already calculated frequencies but if so they have probably been shifted, so we don't 
1859:       ! use them. We calculate new ones instead) 
1860: 2019: 
 2020:          IF (ZSYMSAVE(1:1).EQ.'W') THEN
 2021:             IF (ZSYMSAVE.EQ.'W4') IPOT=4
 2022:             IF (ZSYMSAVE.EQ.'W3') IPOT=3
 2023:             IF (ZSYMSAVE.EQ.'W2') IPOT=2
 2024:             IF (ZSYMSAVE.EQ.'W1') IPOT=1
 2025: C           DO J2=1,NATOMS ! WCOMMENT
 2026:             DO J2=1,NATOMS/2
 2027:                CALL CONVERT(QINIT(3*(J2-1)+1),QINIT(3*(J2-1)+2),QINIT(3*(J2-1)+3),
 2028: C    1                      QINIT(3*(NATOMS+J2-1)+1),QINIT(3*(NATOMS+J2-1)+2),QINIT(3*(NATOMS+J2-1)+3),
 2029:      1                      QINIT(3*(NATOMS/2+J2-1)+1),QINIT(3*(NATOMS/2+J2-1)+2),QINIT(3*(NATOMS/2+J2-1)+3),
 2030:      2                      OVEC,H1VEC,H2VEC)
 2031:                QW(9*(J2-1)+1)=OVEC(1)
 2032:                QW(9*(J2-1)+2)=OVEC(2)
 2033:                QW(9*(J2-1)+3)=OVEC(3)
 2034:                QW(9*(J2-1)+4)=H1VEC(1)
 2035:                QW(9*(J2-1)+5)=H1VEC(2)
 2036:                QW(9*(J2-1)+6)=H1VEC(3)
 2037:                QW(9*(J2-1)+7)=H2VEC(1)
 2038:                QW(9*(J2-1)+8)=H2VEC(2)
 2039:                QW(9*(J2-1)+9)=H2VEC(3)
 2040:             ENDDO 
 2041: C           NATOMS=NATOMS*3 ! WCOMMENT
 2042:             NATOMSSAVE=NATOMS
 2043:             NATOMS=(NATOMS/2)*3
 2044:             CALL SYMMETRY(HORDER,.FALSE.,QW,INERTIA) ! WCOMMENT
 2045: C           NATOMS=NATOMS/3 ! WCOMMENT
 2046:             NATOMS=2*(NATOMS/3)
 2047:             NATOMS=NATOMSSAVE
 2048:             WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
 2049: C           DO J2=1,6*NATOMS ! WCOMMENT
 2050:             DO J2=1,3*NATOMS
 2051:                Q(J2)=QINIT(J2)
 2052:             ENDDO
 2053: C           CALL H2OMODES(NATOMS,IPOT,Q,DIAG) ! WCOMMENT
 2054:             CALL H2OMODES(NATOMS/2,IPOT,Q,DIAG)
 2055: C           WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,6*NATOMS) ! WCOMMENT
 2056:             IF (.NOT.NOFRQS) WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,3*NATOMS)
1861: 2057: 
1862:       ! First, we deal with a couple of the more special cases. Both of these should be largely obsolete now: the GENRIGID 
1863:       ! versions of rigid body potentials (including the TIP potentials) are more likely to be maintained. 
1864:       IF (ZSYMSAVE(1:1).EQ.'W') THEN 
1865:          IF (ZSYMSAVE.EQ.'W4') IPOT=4 
1866:          IF (ZSYMSAVE.EQ.'W3') IPOT=3 
1867:          IF (ZSYMSAVE.EQ.'W2') IPOT=2 
1868:          IF (ZSYMSAVE.EQ.'W1') IPOT=1 
1869: C        DO J2=1,NATOMS 
1870:          DO J2=1,NATOMS/2 ! WCOMMENT 
1871:             CALL CONVERT(Q(3*(J2-1)+1),Q(3*(J2-1)+2),Q(3*(J2-1)+3), 
1872: C    1                Q(3*(NATOMS+J2-1)+1),Q(3*(NATOMS+J2-1)+2),Q(3*(NATOMS+J2-1)+3), 
1873:      1                Q(3*(NATOMS/2+J2-1)+1),Q(3*(NATOMS/2+J2-1)+2),Q(3*(NATOMS/2+J2-1)+3), 
1874:      2                OVEC,H1VEC,H2VEC) 
1875:             QW(9*(J2-1)+1)=OVEC(1) ! WCOMMENT 
1876:             QW(9*(J2-1)+2)=OVEC(2) 
1877:             QW(9*(J2-1)+3)=OVEC(3) 
1878:             QW(9*(J2-1)+4)=H1VEC(1) 
1879:             QW(9*(J2-1)+5)=H1VEC(2) 
1880:             QW(9*(J2-1)+6)=H1VEC(3) 
1881:             QW(9*(J2-1)+7)=H2VEC(1) 
1882:             QW(9*(J2-1)+8)=H2VEC(2) 
1883:             QW(9*(J2-1)+9)=H2VEC(3) 
1884:          ENDDO 
1885: C        NATOMS=NATOMS*3 ! WCOMMENT 
1886:          NATOMSSAVE=NATOMS 
1887:          NATOMS=(NATOMS/2)*3 
1888:          CALL SYMMETRY(HORDER,.FALSE.,QW,INERTIA) ! WCOMMENT 
1889: C        NATOMS=NATOMS/3 ! WCOMMENT 
1890:          NATOMS=2*(NATOMS/3) 
1891:          NATOMS=NATOMSSAVE 
1892:          WRITE(88,'(I6,1X,A4)') HORDER,FPGRP 
1893: C        CALL H2OMODES(NATOMS,IPOT,Q,DIAG) ! WCOMMENT 
1894:          CALL H2OMODES(NATOMS/2,IPOT,Q,DIAG) 
1895: C        WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,6*NATOMS) ! WCOMMENT 
1896:          IF (.NOT.NOFRQS) WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,3*NATOMS) 
1897:  
1898:       ! sn402: For the small number of potentials coded in the fully-rigid form (RBAAT), we can use the NRMLMD subroutine 
1899:       ! directly to calculate the Hessian and calculate its eigenvalues. We write squared angular frequencies in whatever 
1900:       ! time unit is specified by FRQCONV (see documentation and comments in keywords.f) 
1901: ! hk286 - compute potential for normal modes, notice the toggle2058: ! hk286 - compute potential for normal modes, notice the toggle
1902:       ELSE IF (RBAAT) THEN2059:          ELSE IF (RBAAT) THEN
1903:          IF (.NOT.NOFRQS) THEN2060:             IF (.NOT.NOFRQS) THEN
1904:             RBAANORMALMODET = .TRUE.2061:                RBAANORMALMODET = .TRUE.
1905:             CALL POTENTIAL(Q,E,VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)2062:                CALL POTENTIAL(Q,ETS,VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
1906:             CALL NRMLMD (Q, DIAG, .FALSE.)2063:                CALL NRMLMD (Q, DIAG, .FALSE.)
1907:             RBAANORMALMODET = .FALSE.2064:                RBAANORMALMODET = .FALSE.
1908:             WRITE(88, '(G20.10)') E2065:                WRITE(88,'(A,A)') "1  ", "C1" ! TEMP Solution
1909:             ! The following line should definitely not be hard-coded in!2066:                WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,3*NATOMS)
1910:             WRITE(88, '(A,A)') "1  ", "C1" ! TEMP Solution2067:             ENDIF  
1911:             WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,3*NATOMS)  ! sn402: Added the frequency conversion 
1912:          ENDIF 
1913: ! hk2862068: ! hk286
1914: 2069: !
1915:       !!!!! This is the start of the main block to calculate normal mode frequencies. !!!!!2070: ! Hessian eigenvalues will generally be shifted even if we have them - so we need to recalculate
1916:       !!!!! A similar procedure is followed for all remaining potentials. !!!!!2071: !
1917: 2072: !        ELSE IF ((FRQSTS(NOPT).EQ.0.0D0).OR.CHRMMT.OR.UNRST.OR.AMBERT.OR.NABT.OR.AMHT) THEN
1918:       ELSE2073:          ELSE IF (.TRUE.) THEN
1919: 2074:             DO J2=1,NOPT
1920:          IF (CHRMMT .OR. AMBERT .OR. AMBER12T .OR. NABT .OR. AMHT) THEN2075:                Q(J2)=QINIT(J2)
1921:             IF((AMBERT .OR. AMBER12T) .AND. MACROCYCLET) THEN2076:             ENDDO
1922:                CALL SYMMETRY(HORDER,.FALSE.,Q,INERTIA)2077: !           IF (.NOT.UNRST) CALL POTENTIAL(Q,ETS,VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
1923:             ELSE2078:             IF (CHRMMT) THEN
1924:                HORDER=12079:                HORDER=1
1925:                FPGRP='C1'2080:                FPGRP='C1'
1926:             ENDIF2081:                IF (RIGIDINIT.AND.(.NOT.NOFRQS)) THEN
1927:             ! We will shortly want to calculate the Hessian eigenvalues. For most systems, we start by computing the hessian2082:                  CALL GENRIGID_EIGENVALUES(Q, ATMASS, DIAG, INFO)
1928:             ! using either MAKENUMHESS or POTENTIAL. With rigid bodies, the hessian is calculated within GENRIGID_EIGENVALUES,2083:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
1929:             ! so we can save on a call to POTENTIAL if we do the complete diagonalisation here instead.2084:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
1930:             IF (RIGIDINIT.AND.(.NOT.NOFRQS)) THEN2085:                  ENDIF
1931:                ! This returns the square frequencies in internal units.2086:                ELSE
1932:                CALL GENRIGID_EIGENVALUES(Q, ATMASS, DIAG, INFO)2087:                  IF (ENDNUMHESS) THEN
1933:                IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN2088:                     CALL MAKENUMHESS(Q,NATOMS)
1934:                   CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)2089:                  ELSEIF (.NOT.NOFRQS) THEN
 2090:                     CALL POTENTIAL(Q,ETS,VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
 2091:                  ENDIF
 2092:                  IF (.NOT.NOFRQS) CALL MASSWT2(NATOMS,ATMASS,Q,VNEW,.TRUE.) ! ?should this be MASSWT2 for CHARMM?
1935:                ENDIF2093:                ENDIF
1936:             ELSE2094:             ELSE IF (AMBERT .OR. AMBER12T) THEN
 2095:                IF (.NOT.MACROCYCLET) THEN
 2096:                   HORDER=1
 2097:                   FPGRP='C1'
 2098:                ELSE
 2099:                   CALL SYMMETRY(HORDER,.FALSE.,Q,INERTIA)
 2100:                ENDIF
 2101:                IF (RIGIDINIT.AND.(.NOT.NOFRQS)) THEN
 2102:                  CALL GENRIGID_EIGENVALUES(Q, ATMASS, DIAG, INFO)
 2103:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
 2104:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
 2105:                  ENDIF
 2106:                ELSE
 2107:                  IF (.NOT.NOFRQS) THEN
 2108:                     CALL MAKENUMHESS(Q,NATOMS)
 2109:                     CALL MASSWT2(NATOMS,ATMASS,Q,VNEW,.TRUE.)
 2110:                  ENDIF
 2111:                ENDIF
 2112:             ELSE IF (AMHT) THEN
 2113:                HORDER=1
 2114:                FPGRP='C1'
1937:                IF (ENDNUMHESS) THEN2115:                IF (ENDNUMHESS) THEN
1938:                   CALL MAKENUMHESS(Q,NATOMS)2116:                   CALL MAKENUMHESS(Q,NATOMS)
1939:                ELSEIF (.NOT.NOFRQS .AND. (.NOT.(AMBERT .OR. AMBER12T))) THEN2117:                ELSEIF (.NOT.NOFRQS) THEN
1940:                   ! sn402: I'm not sure why we don't do this for AMBER, but I'm retaining the original behaviour here.2118:                   CALL POTENTIAL(Q,ETS,VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
1941:                   CALL POTENTIAL(Q,E,VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.) 
1942:                ENDIF2119:                ENDIF
1943:                IF (.NOT.NOFRQS) CALL MASSWT2(NATOMS,ATMASS,Q,VNEW,.TRUE.)2120:                IF (.NOT.NOFRQS) CALL MASSWT2(NATOMS,ATMASS,Q,VNEW,.TRUE.)
 2121:             ELSE IF (NABT) THEN
 2122:                HORDER=1
 2123:                FPGRP='C1'
 2124:                IF (RIGIDINIT.AND.(.NOT.NOFRQS)) THEN
 2125:                  CALL GENRIGID_EIGENVALUES(Q, ATMASS, DIAG, INFO)
 2126:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
 2127:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
 2128:                  ENDIF
 2129:                ELSE
 2130:                  IF (ENDNUMHESS) THEN
 2131:                   CALL MAKENUMHESS(Q,NATOMS)
 2132:                  ELSEIF (.NOT.NOFRQS) THEN
 2133:                   CALL POTENTIAL(Q,ETS,VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
 2134:                  END IF
 2135:                  IF (.NOT.NOFRQS) CALL MASSWT2(NATOMS,ATMASS,Q,VNEW,.TRUE.)
 2136:                ENDIF
 2137:             ELSEIF (UNRST) THEN
 2138:                DO J2=1,nres
 2139:                   c(1,J2)=Q(6*(J2-1)+1)
 2140:                   c(2,J2)=Q(6*(J2-1)+2)
 2141:                   c(3,J2)=Q(6*(J2-1)+3)
 2142:                   c(1,J2+nres)=Q(6*(J2-1)+4)
 2143:                   c(2,J2+nres)=Q(6*(J2-1)+5)
 2144:                   c(3,J2+nres)=Q(6*(J2-1)+6)
 2145:                ENDDO
 2146:                CALL UPDATEDC
 2147:                CALL int_from_cart(.true.,.false.)
 2148:                CALL chainbuild
 2149:                HORDER=1
 2150:                FPGRP='C1'
 2151:                IF (ENDNUMHESS) THEN
 2152:                   CALL MAKENUMINTHESS(NINTS,NATOMS)
 2153:                   CALL GETSTUFF(KD,NNZ,NINTB)
 2154:                   CALL INTSECDET(Q,3*NATOMS,KD,NNZ,NINTB,DIAG)
 2155:                ELSEIF (.NOT.NOFRQS) THEN
 2156:                   CALL POTENTIAL(Q,ETS,VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
 2157:                ENDIF
 2158:             ELSEIF (GTHOMSONT) THEN
 2159:                CALL GTHOMSONANGTOC(TMPCOORDS,Q,NATOMS)
 2160:                CALL SYMMETRY(HORDER,.FALSE.,TMPCOORDS,INERTIA)
 2161:                IF (.NOT.NOFRQS) THEN
 2162:                   IF (ENDNUMHESS) THEN
 2163:                      CALL MAKENUMHESS(Q,NATOMS)
 2164:                   ELSE
 2165:                      CALL POTENTIAL(Q,ETS,VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
 2166:                   ENDIF
 2167:                ENDIF
 2168:             ELSE
 2169:                 ! sn402: needs testing
 2170:                IF (RIGIDINIT.AND.(.NOT.NOFRQS)) THEN
 2171:                  CALL GENRIGID_EIGENVALUES(Q, ATMASS, DIAG, INFO)
 2172:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
 2173:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
 2174:                  ENDIF
 2175:                ELSE
 2176:                   IF (ENDNUMHESS) THEN
 2177:                       CALL MAKENUMHESS(Q,NATOMS)
 2178:                   ELSEIF (.NOT.NOFRQS) THEN
 2179:                       CALL POTENTIAL(Q,ETS,VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
 2180:                   ENDIF
 2181:                   CALL SYMMETRY(HORDER,.FALSE.,Q,INERTIA)
 2182:                   IF (.NOT.NOFRQS) CALL MASSWT(NATOMS,ATMASS,Q,VNEW,.TRUE.)
 2183:                ENDIF
1944:             ENDIF2184:             ENDIF
1945:          ELSE IF (UNRST) THEN2185:             if (machine) then
1946:             IF(RIGIDINIT) THEN2186:                  WRITE(88) HORDER,FPGRP
1947:                WRITE(*,*) "path> ERROR: RIGIDINIT option not coded for UNRES in path.f"2187:             else
1948:                STOP2188:                  WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
1949:             ENDIF2189:             endif
1950:             DO J2=1,nres2190:             IF (HESSDUMPT) THEN
1951:                c(1,J2)=Q(6*(J2-1)+1)2191:                LUNIT=GETUNIT()
1952:                c(2,J2)=Q(6*(J2-1)+2)2192:                OPEN(LUNIT,FILE='tshess',STATUS='UNKNOWN',POSITION ='APPEND')
1953:                c(3,J2)=Q(6*(J2-1)+3)2193:                WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)
1954:                c(1,J2+nres)=Q(6*(J2-1)+4)2194:                CLOSE(LUNIT)
1955:                c(2,J2+nres)=Q(6*(J2-1)+5) 
1956:                c(3,J2+nres)=Q(6*(J2-1)+6) 
1957:             ENDDO 
1958:             CALL UPDATEDC 
1959:             CALL int_from_cart(.true.,.false.) 
1960:             CALL chainbuild 
1961:             HORDER=1 
1962:             FPGRP='C1' 
1963:             IF (ENDNUMHESS) THEN 
1964:                CALL MAKENUMINTHESS(NINTS,NATOMS) 
1965:                CALL GETSTUFF(KD,NNZ,NINTB) 
1966:                CALL INTSECDET(Q,3*NATOMS,KD,NNZ,NINTB,DIAG) 
1967:             ELSEIF (.NOT.NOFRQS) THEN 
1968:                CALL POTENTIAL(Q,E,VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.) 
1969:             ENDIF2195:             ENDIF
1970:          ELSEIF (GTHOMSONT) THEN2196: 
1971:             CALL GTHOMSONANGTOC(TMPCOORDS,Q,NATOMS)2197:             IF (.NOT.(UNRST.OR.NOFRQS.OR.RIGIDINIT)) THEN
1972:             CALL SYMMETRY(HORDER,.FALSE.,TMPCOORDS,INERTIA)2198: ! hk286 - computing normal modes
1973:             IF (.NOT.NOFRQS) THEN2199:                IF (RBAAT) THEN
1974:                IF (ENDNUMHESS) THEN2200:                   RBAANORMALMODET = .TRUE.
1975:                   CALL MAKENUMHESS(Q,NATOMS)2201:                   CALL NRMLMD (Q, DIAG, .FALSE.)
 2202:                   RBAANORMALMODET = .FALSE.
1976:                ELSE2203:                ELSE
1977:                   CALL POTENTIAL(Q,E,VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)2204:                   CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,3*NOPT,INFO)
 2205:                   IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)
 2206:                   IF (GTHOMSONT) THEN
 2207:                      IF (DIAG(3*NATOMS) < 0.0) THEN
 2208:                         DIAG(2*NATOMS) = DIAG(3*NATOMS)
 2209:                      ENDIF
 2210:                   ENDIF
 2211: 
1978:                ENDIF2212:                ENDIF
 2213: ! hk286
 2214:             ENDIF
 2215: ! sn402 addition
 2216:             IF (CHRMMT.OR.AMBERT.OR.AMBER12T.OR.NABT.OR.RIGIDMOLECULEST.OR.GTHOMSONT) THEN
 2217:                if (machine) then
 2218:                   IF (GTHOMSONT) THEN
 2219:                      IF (.NOT.NOFRQS) WRITE(88) (1.0D10, J2=1, NATOMS)
 2220:                      IF (.NOT.NOFRQS) WRITE(88) (DIAG(J2),J2=1,2*NATOMS)
 2221:                   ELSEIF (RIGIDINIT) THEN
 2222:                     IF (.NOT.NOFRQS) WRITE(88) (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
 2223:                   ELSE
 2224:                     IF (.NOT.NOFRQS) WRITE(88) (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
 2225:                   ENDIF
 2226:                else
 2227:                   IF (GTHOMSONT) THEN
 2228:                      IF (.NOT.NOFRQS) WRITE(88,'(3G20.10)') (1.0D10, J2=1, NATOMS)
 2229:                      IF (.NOT.NOFRQS) WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,2*NATOMS)
 2230:                   ELSEIF (RIGIDINIT) THEN
 2231:                     IF (.NOT.NOFRQS) WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
 2232:                   ELSE
 2233:                     IF (.NOT.NOFRQS) WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
 2234:                   ENDIF
 2235:                endif
 2236:             ELSE
 2237:                IF (.NOT.NOFRQS) WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)
1979:             ENDIF2238:             ENDIF
1980:          ELSE2239:          ELSE
1981:             IF (RIGIDINIT.AND.(.NOT.NOFRQS)) THEN2240: !           WRITE(*,*) ' dumping pathway ..... TS '
1982:               ! sn402: see comment above (in the IF(AMBER) block)2241: !           WRITE(*,*) QINIT(:)
1983:               CALL GENRIGID_EIGENVALUES(Q, ATMASS, DIAG, INFO)2242:             DO J2=1,NOPT
1984:               IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN2243:                Q(J2)=QINIT(J2)
1985:                  CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)2244:             ENDDO
1986:               ENDIF2245:             IF (VARIABLES) THEN
1987:               CALL SYMMETRY(HORDER,.FALSE.,Q,INERTIA) ! sn402: I think this needs to be here?2246:                HORDER=1
 2247:                FPGRP='C1'
1988:             ELSE2248:             ELSE
1989:                IF (ENDNUMHESS) THEN 
1990:                    CALL MAKENUMHESS(Q,NATOMS) 
1991:                ELSEIF (.NOT.NOFRQS) THEN 
1992:                    CALL POTENTIAL(Q,E,VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.) 
1993:                ENDIF 
1994:                CALL SYMMETRY(HORDER,.FALSE.,Q,INERTIA)2249:                CALL SYMMETRY(HORDER,.FALSE.,Q,INERTIA)
1995:                IF (.NOT.NOFRQS) CALL MASSWT2(NATOMS,ATMASS,Q,VNEW,.TRUE.) 
1996:             ENDIF2250:             ENDIF
 2251:             WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
 2252:             IF (.NOT.NOFRQS) WRITE(88,'(3G20.10)') (FRQSTS(J2),J2=1,NOPT)
1997:          ENDIF2253:          ENDIF
 2254:          IF (MACHINE) THEN
 2255:             IF (GTHOMSONT) THEN
 2256:                CALL GTHOMSONANGTOC(TMPCOORDS, QINIT, NATOMS)
 2257:                WRITE(88) (TMPCOORDS(J2), J2=1, 3*NATOMS)
 2258:               ELSEIF (RIGIDINIT) THEN
 2259:                  CALL TRANSFORMRIGIDTOC (1, NRIGIDBODY, XCOORDS, QINIT)
 2260:                  WRITE(88) (XCOORDS(J2),J2=1,3*NATOMS)
 2261:               ELSE
 2262:                  WRITE(88) (QINIT(J2),J2=1,NOPT)
 2263:               ENDIF
 2264:          ELSEIF (AMHT) THEN
1998: 2265: 
1999:          ! Dump the Hessian to a file, if we're doing that.2266: !       READ SEQUENCE
2000:          IF (HESSDUMPT) THEN 
2001:             LUNIT=GETUNIT() 
2002:             OPEN(LUNIT,FILE=TRIM(ADJUSTL(HESSDUMP_FNAME)),STATUS='UNKNOWN',POSITION ='APPEND') 
2003:             WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT) 
2004:             CLOSE(LUNIT) 
2005:          ENDIF 
2006:  
2007:          ! Diagonalise the Hessian to obtain the squared frequencies. 
2008:          ! In the case of NOFRQS, we obviously don't need to do the diagonalisation! 
2009:          ! In the case of UNRST and RIGIDINIT, we've already done it. 
2010:          IF (.NOT.(UNRST.OR.NOFRQS.OR.RIGIDINIT)) THEN 
2011:             CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,3*NOPT,INFO) 
2012:             IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT) 
2013:          ENDIF 
2014: 2267: 
 2268: !  THIS IS FOR PLACE HOLDING C-BETAS FOR GLYCINE IN AMH
2015: 2269: 
2016:          ! We now have everything we need to write this point to the path.info file:2270:             GLY_COUNT = 0
2017:          !    (i) The energy of the point 
2018:          !    (ii) The point group 
2019:          !    (iii) The Hessian eigenvalues 
2020:          !    (iv) The coordinates 
2021:          ! We now proceed to write these to the file. 
2022: 2271: 
2023:          ! (i), (ii) Write the first two header lines for this point: The energy of the point,2272:             DO J2=1, NRES_AMH_TEMP
2024:          ! followed by the point group order and symbol.2273:                IF (SEQ(J2).EQ.8) THEN
 2274: !             WRITE(2,*)SEQ(J2) , J2
 2275:                    WRITE(88,*)QINIT(9*(J2-1)+1-GLY_COUNT*3), 
 2276:      &              QINIT(9*(J2-1)+2-GLY_COUNT*3),QINIT(9*(J2-1)+3-GLY_COUNT*3)
 2277:                   WRITE(88,*)QINIT(9*(J2-1)+1-GLY_COUNT*3), 
 2278:      &              QINIT(9*(J2-1)+2-GLY_COUNT*3),QINIT(9*(J2-1)+3-GLY_COUNT*3)
 2279:                   WRITE(88,*)QINIT(9*(J2-1)+4-GLY_COUNT*3), 
 2280:      &              QINIT(9*(J2-1)+5-GLY_COUNT*3),QINIT(9*(J2-1)+6-GLY_COUNT*3)
 2281:                   GLY_COUNT = GLY_COUNT + 1
 2282:                ELSE
 2283: !            WRITE(2,*)SEQ(J2) , J2
 2284:                  WRITE(88,*)QINIT(9*(J2-1)+1-GLY_COUNT*3), 
 2285:      &             QINIT(9*(J2-1)+2-GLY_COUNT*3),QINIT(9*(J2-1)+3-GLY_COUNT*3)
 2286:                  WRITE(88,*)QINIT(9*(J2-1)+4-GLY_COUNT*3), 
 2287:      &             QINIT(9*(J2-1)+5-GLY_COUNT*3),QINIT(9*(J2-1)+6-GLY_COUNT*3)
 2288:                  WRITE(88,*)QINIT(9*(J2-1)+7-GLY_COUNT*3), 
 2289:      &             QINIT(9*(J2-1)+8-GLY_COUNT*3),QINIT(9*(J2-1)+9-GLY_COUNT*3)
 2290:                ENDIF
 2291:              ENDDO
 2292:          ELSE
 2293:             IF (GTHOMSONT) THEN
 2294:                CALL GTHOMSONANGTOC(TMPCOORDS, QINIT, NATOMS)
 2295:                WRITE(88,'(3F25.15)') (TMPCOORDS(J2), J2=1, 3*NATOMS)
 2296:               ELSEIF (RIGIDINIT) THEN
 2297:                  CALL TRANSFORMRIGIDTOC (1, NRIGIDBODY, XCOORDS, QINIT)
 2298:                  WRITE(88,'(3F25.15)') (XCOORDS(J2),J2=1,3*NATOMS)
 2299:               ELSE
 2300:                  WRITE(88,'(3F25.15)') (QINIT(J2),J2=1,NOPT)
 2301:               ENDIF
 2302:          ENDIF
2025: 2303: 
2026:          ! (i)2304:          IF (UNRST) THEN
2027:          IF (UNRST .AND. (.NOT. ISTS)) THEN 
2028:             IF (CALCDIHE) THEN2305:             IF (CALCDIHE) THEN
2029:                 CALL UNRESCALCDIHEREF(DIHE,ALLANG,Q)2306:                 CALL UNRESCALCDIHEREF(DIHE,ALLANG,QMINUS)
2030:             ELSE2307:             ELSE
2031:                 DIHE=0.5D0 ! dummy order param for pathsample related purposes2308:                 DIHE=0.5D0 ! dummy order param for pathsample related purposes
2032:             ENDIF2309:             ENDIF
2033:             IF(MACHINE) THEN2310: C jmc         WRITE(88,'(3G25.15)') EPLUS, DIHE, ALLANG
2034:                WRITE(88) E, DIHE2311:             WRITE(88,'(2G25.15)') EMINUS, DIHE
 2312:          ELSE
 2313:             WRITE(88,'(G25.15)') EMINUS
 2314:          ENDIF
 2315: 
 2316:          IF (ZSYMSAVE(1:1).EQ.'W') THEN
 2317:             IF (ZSYMSAVE.EQ.'W4') IPOT=4
 2318:             IF (ZSYMSAVE.EQ.'W3') IPOT=3
 2319:             IF (ZSYMSAVE.EQ.'W2') IPOT=2
 2320:             IF (ZSYMSAVE.EQ.'W1') IPOT=1
 2321: C           DO J2=1,NATOMS ! WCOMMENT
 2322:             DO J2=1,NATOMS/2
 2323:                CALL CONVERT(QMINUS(3*(J2-1)+1),QMINUS(3*(J2-1)+2),QMINUS(3*(J2-1)+3),
 2324: C    1                   QMINUS(3*(NATOMS+J2-1)+1),QMINUS(3*(NATOMS+J2-1)+2),QMINUS(3*(NATOMS+J2-1)+3),
 2325:      1                   QMINUS(3*(NATOMS/2+J2-1)+1),QMINUS(3*(NATOMS/2+J2-1)+2),QMINUS(3*(NATOMS/2+J2-1)+3),
 2326:      2                   OVEC,H1VEC,H2VEC)
 2327:                QW(9*(J2-1)+1)=OVEC(1) ! WCOMMENT
 2328:                QW(9*(J2-1)+2)=OVEC(2)
 2329:                QW(9*(J2-1)+3)=OVEC(3)
 2330:                QW(9*(J2-1)+4)=H1VEC(1)
 2331:                QW(9*(J2-1)+5)=H1VEC(2)
 2332:                QW(9*(J2-1)+6)=H1VEC(3)
 2333:                QW(9*(J2-1)+7)=H2VEC(1)
 2334:                QW(9*(J2-1)+8)=H2VEC(2)
 2335:                QW(9*(J2-1)+9)=H2VEC(3)
 2336:             ENDDO 
 2337: C           NATOMS=NATOMS*3 ! WCOMMENT
 2338:             NATOMSSAVE=NATOMS
 2339:             NATOMS=(NATOMS/2)*3
 2340:             CALL SYMMETRY(HORDER,.FALSE.,QW,INERTIA) ! WCOMMENT
 2341: C           NATOMS=NATOMS/3 ! WCOMMENT
 2342:             NATOMS=2*(NATOMS/3)
 2343:             NATOMS=NATOMSSAVE
 2344:             WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
 2345: C           DO J2=1,6*NATOMS ! WCOMMENT
 2346:             DO J2=1,3*NATOMS
 2347:                Q(J2)=QMINUS(J2)
 2348:             ENDDO
 2349: C           CALL H2OMODES(NATOMS,IPOT,Q,DIAG)
 2350:             CALL H2OMODES(NATOMS/2,IPOT,Q,DIAG)
 2351: C           WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,6*NATOMS) ! WCOMMENT
 2352:             IF (.NOT.NOFRQS) WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,3*NATOMS)
 2353: 
 2354: ! hk286 - compute potential for normal modes, notice the toggle
 2355:          ELSE IF (RBAAT) THEN
 2356:             IF (.NOT.NOFRQS) THEN
 2357:                RBAANORMALMODET = .TRUE.
 2358:                CALL POTENTIAL(Q,EMINUS,VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
 2359:                CALL NRMLMD (Q, DIAG, .FALSE.)
 2360:                RBAANORMALMODET = .FALSE.
 2361:                WRITE(88, '(A,A)') "1  ", "C1" ! TEMP Solution
 2362:                WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,3*NATOMS)
 2363:             ENDIF  
 2364: ! hk286
 2365: 
 2366: !
 2367: ! Hessian eigenvalues will generally be shifted even if we have them - so we need to recalculate
 2368: !
 2369: !        ELSE IF ((FRQSMINUS(NOPT).EQ.0.0D0).OR.CHRMMT.OR.UNRST.OR.AMBERT.OR.NABT.OR.AMHT) THEN
 2370:          ELSE IF (.TRUE.) THEN
 2371:             DO J2=1,NOPT
 2372:                Q(J2)=QMINUS(J2)
 2373:             ENDDO
 2374: !           IF (.NOT.UNRST) CALL POTENTIAL(Q,EMINUS,VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
 2375:             IF (CHRMMT) THEN
 2376:                HORDER=1
 2377:                FPGRP='C1'
 2378:                IF (RIGIDINIT) THEN
 2379:                  CALL GENRIGID_EIGENVALUES(Q, ATMASS, DIAG, INFO)
 2380:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
 2381:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
 2382:                  ENDIF
 2383:                ELSE
 2384:                  IF (ENDNUMHESS) THEN
 2385:                     CALL MAKENUMHESS(Q,NATOMS)
 2386:                  ELSEIF (.NOT.NOFRQS) THEN
 2387:                     CALL POTENTIAL(Q,EMINUS,VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
 2388:                  ENDIF
 2389:                  IF (.NOT.NOFRQS) CALL MASSWT2(NATOMS,ATMASS,Q,VNEW,.TRUE.) ! ?should this be MASSWT2 for CHARMM?
 2390:                ENDIF
 2391:             ELSE IF (AMBERT.OR.AMBER12T) THEN
 2392:                IF (.NOT.MACROCYCLET) THEN
 2393:                   HORDER=1
 2394:                   FPGRP='C1'
 2395:                ELSE
 2396:                   CALL SYMMETRY(HORDER,.FALSE.,Q,INERTIA)
 2397:                ENDIF
 2398:                IF (RIGIDINIT) THEN
 2399:                  CALL GENRIGID_EIGENVALUES(Q, ATMASS, DIAG, INFO)
 2400:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
 2401:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
 2402:                  ENDIF
 2403:                ELSE
 2404:                  IF (.NOT.NOFRQS) THEN
 2405:                     CALL MAKENUMHESS(Q,NATOMS)
 2406:                     CALL MASSWT2(NATOMS,ATMASS,Q,VNEW,.TRUE.)
 2407:                  ENDIF
 2408:                ENDIF
 2409:             ELSE IF (NABT) THEN
 2410:                HORDER=1
 2411:                FPGRP='C1'
 2412:                IF (RIGIDINIT) THEN
 2413:                  CALL GENRIGID_EIGENVALUES(Q, ATMASS, DIAG, INFO)
 2414:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
 2415:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
 2416:                  ENDIF
 2417:                ELSE
 2418:                  IF (ENDNUMHESS) THEN              
 2419:                   CALL MAKENUMHESS(Q,NATOMS)
 2420:                  ELSEIF (.NOT.NOFRQS) THEN
 2421:                   CALL POTENTIAL(Q,EMINUS,VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
 2422:                  END IF
 2423:                  IF (.NOT.NOFRQS) CALL MASSWT2(NATOMS,ATMASS,Q,VNEW,.TRUE.)
 2424:                ENDIF
 2425:             ELSE IF (AMHT) THEN
 2426:                HORDER=1
 2427:                FPGRP='C1'
 2428:                IF (ENDNUMHESS) THEN              
 2429:                   CALL MAKENUMHESS(Q,NATOMS)
 2430:                ELSEIF (.NOT.NOFRQS) THEN
 2431:                   CALL POTENTIAL(Q,EMINUS,VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
 2432:                ENDIF
 2433:                IF (.NOT.NOFRQS) CALL MASSWT2(NATOMS,ATMASS,Q,VNEW,.TRUE.)
 2434:             ELSE IF (UNRST) THEN
 2435:                DO J2=1,nres
 2436:                   c(1,J2)=Q(6*(J2-1)+1)
 2437:                   c(2,J2)=Q(6*(J2-1)+2)
 2438:                   c(3,J2)=Q(6*(J2-1)+3)
 2439:                   c(1,J2+nres)=Q(6*(J2-1)+4)
 2440:                   c(2,J2+nres)=Q(6*(J2-1)+5)
 2441:                   c(3,J2+nres)=Q(6*(J2-1)+6)
 2442:                ENDDO
 2443:                CALL UPDATEDC
 2444:                CALL int_from_cart(.true.,.false.)
 2445:                CALL chainbuild
 2446:                HORDER=1
 2447:                FPGRP='C1'
 2448:                IF (ENDNUMHESS) THEN
 2449:                   CALL MAKENUMINTHESS(NINTS,NATOMS)
 2450:                   CALL GETSTUFF(KD,NNZ,NINTB)
 2451:                   CALL INTSECDET(Q,3*NATOMS,KD,NNZ,NINTB,DIAG)
 2452:                ELSEIF (.NOT.NOFRQS) THEN
 2453:                   CALL POTENTIAL(Q,EMINUS,VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
 2454:                ENDIF
 2455:             ELSEIF (GTHOMSONT) THEN
 2456:                CALL GTHOMSONANGTOC(TMPCOORDS,Q,NATOMS)
 2457:                CALL SYMMETRY(HORDER,.FALSE.,TMPCOORDS,INERTIA)
 2458:                IF (.NOT.NOFRQS) THEN
 2459:                   IF (ENDNUMHESS) THEN
 2460:                      CALL MAKENUMHESS(Q,NATOMS)
 2461:                   ELSE
 2462:                      CALL POTENTIAL(Q,EMINUS,VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
 2463:                   ENDIF
 2464:                ENDIF
 2465:                ! sn402: needs testing
 2466:             ELSE
 2467:                IF (RIGIDINIT) THEN
 2468:                  CALL GENRIGID_EIGENVALUES(Q, ATMASS, DIAG, INFO)
 2469:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
 2470:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
 2471:                  ENDIF
 2472:                ELSE
 2473:                   IF (ENDNUMHESS) THEN
 2474:                       CALL MAKENUMHESS(Q,NATOMS)
 2475:                   ELSEIF (.NOT.NOFRQS) THEN
 2476:                       CALL POTENTIAL(Q,EMINUS,VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
 2477:                   ENDIF
 2478:                   CALL SYMMETRY(HORDER,.FALSE.,Q,INERTIA)
 2479:                   IF (.NOT.NOFRQS) CALL MASSWT(NATOMS,ATMASS,Q,VNEW,.TRUE.)
 2480:                ENDIF
 2481:             ENDIF
 2482:             if (machine) then
 2483:                  WRITE(88) HORDER,FPGRP
 2484:             else
 2485:                  WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
 2486:             endif
 2487:             IF (HESSDUMPT) THEN
 2488:                LUNIT=GETUNIT()
 2489:                OPEN(LUNIT,FILE='minhess.minus',STATUS='UNKNOWN',POSITION ='APPEND')
 2490:                WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)
 2491:                CLOSE(LUNIT)
 2492:             ENDIF
 2493:             IF (.NOT.(UNRST.OR.NOFRQS.OR.RIGIDINIT)) THEN
 2494: ! hk286 - computing normal modes
 2495:                IF (RBAAT) THEN
 2496:                   RBAANORMALMODET = .TRUE.
 2497:                   CALL NRMLMD (Q, DIAG, .FALSE.)
 2498:                   RBAANORMALMODET = .FALSE.
 2499:                ELSE
 2500:                   CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
 2501:                   IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)
 2502:                ENDIF
 2503: ! hk286
 2504:             ENDIF
 2505: 
 2506: 
 2507:             IF (CHRMMT.OR.AMBERT.OR.AMBER12T.OR.NABT.OR.RIGIDMOLECULEST.OR.GTHOMSONT) THEN
 2508:                if (machine) then
 2509:                   IF (GTHOMSONT) THEN
 2510:                      IF (.NOT.NOFRQS) WRITE(88) (1.0D10, J2=1, NATOMS)
 2511:                      IF (.NOT.NOFRQS) WRITE(88) (DIAG(J2),J2=1,2*NATOMS)
 2512:                   ELSEIF (RIGIDINIT) THEN
 2513:                     IF (.NOT.NOFRQS) WRITE(88) (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
 2514:                   ELSE
 2515:                     IF (.NOT.NOFRQS) WRITE(88) (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
 2516:                   ENDIF
 2517:                else
 2518:                   IF (GTHOMSONT) THEN
 2519:                      IF (.NOT.NOFRQS) WRITE(88,'(3G20.10)') (1.0D10, J2=1, NATOMS)
 2520:                      IF (.NOT.NOFRQS) WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,2*NATOMS)
 2521:                   ELSEIF (RIGIDINIT) THEN
 2522:                     IF (.NOT.NOFRQS) WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
 2523:                   ELSE
 2524:                     IF (.NOT.NOFRQS) WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
 2525:                   ENDIF
 2526:                endif
2035:             ELSE2527:             ELSE
2036:                WRITE(88,'(2G25.15)') E, DIHE2528:                IF (.NOT.NOFRQS) WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)
2037:             ENDIF2529:             ENDIF
2038:          ELSE2530:          ELSE
2039:             IF(MACHINE) THEN2531: !           WRITE(*,*) ' dumping pathway ..... MINUS'
2040:                 WRITE(88) E2532: !           WRITE(*,*) QMINUS(:)
 2533:             DO J2=1,NOPT
 2534:                Q(J2)=QMINUS(J2)
 2535:             ENDDO
 2536:             IF (VARIABLES) THEN
 2537:                HORDER=1
 2538:                FPGRP='C1'
2041:             ELSE2539:             ELSE
2042:                 WRITE(88,'(F25.15)') E2540:                CALL SYMMETRY(HORDER,.FALSE.,Q,INERTIA)
2043:             ENDIF2541:             ENDIF
 2542:             WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
 2543:             IF (.NOT.NOFRQS) WRITE(88,'(3G20.10)') (FRQSMINUS(J2),J2=1,NOPT)
2044:          ENDIF2544:          ENDIF
2045:          ! (ii)2545:          IF (MACHINE) THEN
2046:          if (machine) then2546:             IF (GTHOMSONT) THEN
2047:               WRITE(88) HORDER,FPGRP2547:                CALL GTHOMSONANGTOC(TMPCOORDS, QMINUS, NATOMS)
2048:          else2548:                WRITE(88) (TMPCOORDS(J2), J2=1, 3*NATOMS)
2049:               WRITE(88,'(I6,1X,A4)') HORDER,FPGRP2549:               ELSEIF (RIGIDINIT) THEN
2050:          endif2550:                  CALL TRANSFORMRIGIDTOC (1, NRIGIDBODY, XCOORDS, QMINUS)
 2551:                  WRITE(88) (XCOORDS(J2),J2=1,3*NATOMS)
 2552:               ELSE
 2553:                  WRITE(88) (QMINUS(J2),J2=1,NOPT)
 2554:               ENDIF
 2555:          ELSEIF (AMHT) THEN
2051: 2556: 
2052:          ! (iii) Now write the frequencies. In line with what PATHSAMPLE is expecting, these are squared angular frequencies.2557: !       READ SEQUENCE
2053:          ! The default units are (rad/s)^2 for AMBER, CHARMM and a few others (see keywords.f), and (rad/[time])^2 for everything 
2054:          ! else, where [time] denotes the internal time unit for the potential in question. 
2055:          ! FRQCONV can be set manually if you want your square frequencies in a different unit. 
2056: ! hk286 
2057:          IF (.NOT. NOFRQS) THEN 
2058:              IF (GTHOMSONT) THEN 
2059:                 if (machine) then 
2060:                    WRITE(88) (1.0D10, J2=1, NATOMS) 
2061:                    WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,2*NATOMS) 
2062:                 else 
2063:                    WRITE(88,'(3G20.10)') (1.0D10, J2=1, NATOMS) 
2064:                    WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,2*NATOMS) 
2065:                 endif 
2066:              ELSE 
2067:                  if (machine) then 
2068:                      IF (RIGIDINIT) THEN 
2069:                          WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS) 
2070:                      ELSE 
2071:                          WRITE(88) (DIAG(J2)*FRQCONV2,J2=1,NOPT) 
2072:                      ENDIF 
2073:                  else 
2074:                      IF (RIGIDINIT) THEN 
2075:                          WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,DEGFREEDOMS) 
2076:                      ELSE 
2077:                          WRITE(88,'(3G20.10)') (DIAG(J2)*FRQCONV2,J2=1,NOPT) 
2078:                      ENDIF 
2079:                  endif 
2080:              ENDIF 
2081:          ENDIF 
2082: 2558: 
2083:       ENDIF2559: !  THIS IS FOR PLACE HOLDING C-BETAS FOR GLYCINE IN AMH
2084: 2560: 
2085:       ! (iv) Finally, write the coordinates of the point.2561:             GLY_COUNT = 0
2086: 2562: 
2087:       IF (MACHINE) then2563:             DO J2=1,NRES_AMH_TEMP
2088:           IF (GTHOMSONT) THEN2564:                IF (SEQ(J2).EQ.8) THEN
2089:             CALL GTHOMSONANGTOC(TMPCOORDS, Q, NATOMS)2565: !             WRITE(2,*)SEQ(J2) , J2
2090:             WRITE(88) (TMPCOORDS(J2), J2=1, 3*NATOMS)2566:                    WRITE(88,*)QMINUS(9*(J2-1)+1-GLY_COUNT*3), 
2091:           ELSE IF (RIGIDINIT) THEN2567:      &              QMINUS(9*(J2-1)+2-GLY_COUNT*3),QMINUS(9*(J2-1)+3-GLY_COUNT*3)
2092:              CALL TRANSFORMRIGIDTOC (1, NRIGIDBODY, XCOORDS, Q)2568:                   WRITE(88,*)QMINUS(9*(J2-1)+1-GLY_COUNT*3), 
2093:              WRITE(88) (XCOORDS(J2),J2=1,3*NATOMS)2569:      &              QMINUS(9*(J2-1)+2-GLY_COUNT*3),QMINUS(9*(J2-1)+3-GLY_COUNT*3)
2094:           ELSE2570:                   WRITE(88,*)QMINUS(9*(J2-1)+4-GLY_COUNT*3), 
2095:              WRITE(88) (Q(J2),J2=1,NOPT)2571:      &             QMINUS(9*(J2-1)+5-GLY_COUNT*3),QMINUS(9*(J2-1)+6-GLY_COUNT*3)
2096:           ENDIF2572:                   GLY_COUNT = GLY_COUNT + 1
2097:       ELSEIF (AMHT) THEN2573:                ELSE
 2574: !            WRITE(2,*)SEQ(J2) , J2
 2575:                  WRITE(88,*)QMINUS(9*(J2-1)+1-GLY_COUNT*3), 
 2576:      &             QMINUS(9*(J2-1)+2-GLY_COUNT*3),QMINUS(9*(J2-1)+3-GLY_COUNT*3)
 2577:                  WRITE(88,*)QMINUS(9*(J2-1)+4-GLY_COUNT*3), 
 2578:      &             QMINUS(9*(J2-1)+5-GLY_COUNT*3),QMINUS(9*(J2-1)+6-GLY_COUNT*3)
 2579:                 WRITE(88,*)QMINUS(9*(J2-1)+7-GLY_COUNT*3), 
 2580:      &             QMINUS(9*(J2-1)+8-GLY_COUNT*3),QMINUS(9*(J2-1)+9-GLY_COUNT*3)
 2581:                ENDIF
 2582:            ENDDO
 2583:          ELSE
 2584:             IF (GTHOMSONT) THEN
 2585:                CALL GTHOMSONANGTOC(TMPCOORDS, QMINUS, NATOMS)
 2586:                WRITE(88,'(3F25.15)') (TMPCOORDS(J2), J2=1, 3*NATOMS)
 2587:               ELSEIF (RIGIDINIT) THEN
 2588:                  CALL TRANSFORMRIGIDTOC (1, NRIGIDBODY, XCOORDS, QMINUS)
 2589:                  WRITE(88,'(3F25.15)') (XCOORDS(J2),J2=1,3*NATOMS)
 2590:               ELSE
 2591:                  WRITE(88,'(3F25.15)') (QMINUS(J2),J2=1,NOPT)
 2592:               ENDIF
 2593:          ENDIF
 2594:          CLOSE(88)
 2595:       else if (machine.and..not.connectt) then
 2596: C SAT this is for the case when we need points for minima to be output in binary format, but do not want expensive Hessian
 2597: C diagonalization, which is required to produce "path.info" file
 2598:          inquire(iolength=reclen) (diag(J1),J1=1,3*Natoms)
 2599:          open(unit=38,file="points1.out",status='unknown',form='unformatted',access='direct',recl=reclen)
 2600:          write(38,rec=1) (QPLUS(J2),J2=1,NOPT)
 2601:          close(38)
 2602:          open(unit=38,file="points2.out",status='unknown',form='unformatted',access='direct',recl=reclen)
 2603:          write(38,rec=1) (QMINUS(J2),J2=1,NOPT)
 2604:          close(38)
 2605:       endif
2098: 2606: 
2099: !  THIS IS FOR PLACE HOLDING C-BETAS FOR GLYCINE IN AMH2607:       BFGSTST=BFGSTSTSAVE
2100:          GLY_COUNT = 02608:       IVEC=IVECSAVE
 2609:       IVEC2=IVEC2SAVE
2101: 2610: 
2102:          DO J2=1, NRES_AMH_TEMP2611:       IF (ALLOCATED(Q1)) DEALLOCATE(Q1)
2103:             IF (SEQ(J2).EQ.8) THEN2612:       IF (ALLOCATED(Q2)) DEALLOCATE(Q2)
2104:                WRITE(88,*)Q(9*(J2-1)+1-GLY_COUNT*3),2613:       IF (ALLOCATED(QW)) DEALLOCATE(QW)
2105:      &           Q(9*(J2-1)+2-GLY_COUNT*3),Q(9*(J2-1)+3-GLY_COUNT*3)2614:       IF (ALLOCATED(QFRAMEP)) DEALLOCATE(QFRAMEP)
2106:                WRITE(88,*)Q(9*(J2-1)+1-GLY_COUNT*3),2615:       IF (ALLOCATED(QFRAMEM)) DEALLOCATE(QFRAMEM)
2107:      &           Q(9*(J2-1)+2-GLY_COUNT*3),Q(9*(J2-1)+3-GLY_COUNT*3)2616:       IF (ALLOCATED(EOFS)) DEALLOCATE(EOFS, PATHLENGTH, EOFSFRAMEP, EOFSFRAMEM)
2108:                WRITE(88,*)Q(9*(J2-1)+4-GLY_COUNT*3),2617: 
2109:      &               Q(9*(J2-1)+5-GLY_COUNT*3),Q(9*(J2-1)+6-GLY_COUNT*3)2618:       RETURN
2110:                GLY_COUNT = GLY_COUNT + 12619:       END
2111:             ELSE 
2112:               WRITE(88,*)Q(9*(J2-1)+1-GLY_COUNT*3), 
2113:      &           Q(9*(J2-1)+2-GLY_COUNT*3),Q(9*(J2-1)+3-GLY_COUNT*3) 
2114:               WRITE(88,*)Q(9*(J2-1)+4-GLY_COUNT*3), 
2115:      &           Q(9*(J2-1)+5-GLY_COUNT*3),Q(9*(J2-1)+6-GLY_COUNT*3) 
2116:              WRITE(88,*)Q(9*(J2-1)+7-GLY_COUNT*3), 
2117:      &           Q(9*(J2-1)+8-GLY_COUNT*3),Q(9*(J2-1)+9-GLY_COUNT*3) 
2118:             ENDIF 
2119:          ENDDO 
2120:       ELSE 
2121:           IF (GTHOMSONT) THEN 
2122:             CALL GTHOMSONANGTOC(TMPCOORDS, Q, NATOMS) 
2123:             WRITE(88,'(3F25.15)') (TMPCOORDS(J2),J2=1, 3*NATOMS) 
2124:            ELSE IF (RIGIDINIT) THEN 
2125:               CALL TRANSFORMRIGIDTOC (1, NRIGIDBODY, XCOORDS, Q) 
2126:               WRITE(88,'(3F25.15)') (XCOORDS(J2),J2=1,3*NATOMS) 
2127:            ELSE 
2128:               WRITE(88,'(3F25.15)') (Q(J2),J2=1,NOPT) 
2129:            ENDIF 
2130:       ENDIF 
2131: 2620: 
2132:       END SUBROUTINE 


r31537/rigidb.f90 2016-11-24 14:30:20.089951590 +0000 r31536/rigidb.f90 2016-11-24 14:30:22.865988445 +0000
2052: !     We adopt Pohorille's notation for clarity:2052: !     We adopt Pohorille's notation for clarity:
2053: !     K matrix : block diagonal kinetic energy matrix (6N x 6N)2053: !     K matrix : block diagonal kinetic energy matrix (6N x 6N)
2054: !     kblock : for each rigid body we have one 6x6 matrix which consists2054: !     kblock : for each rigid body we have one 6x6 matrix which consists
2055: !     of two blocks : left upper or "mass" diagonal submatrix2055: !     of two blocks : left upper or "mass" diagonal submatrix
2056: !     and right lower or inertia tensor matrix. Here kblock2056: !     and right lower or inertia tensor matrix. Here kblock
2057: !     is the 3 x 3 inertia tensor.2057: !     is the 3 x 3 inertia tensor.
2058: !     KD     : using the diagonalized kinetic energy tensor2058: !     KD     : using the diagonalized kinetic energy tensor
2059: !     we keep track of the diagonal of KD only2059: !     we keep track of the diagonal of KD only
2060: !     U      : eigenvector matrix (Pohorille's S)2060: !     U      : eigenvector matrix (Pohorille's S)
2061: 2061: 
2062: !     This has now been deprecated. Use the FRQCONV keyword to set your unit conversions. For the TIP4P potential, 
2063: !     the value given here is set as the default value of FRQCONV, so frequencies will be given in cm^-1. 
2064: !     Frequency conversion factor: Energy in KJ/mol and length in angstrom2062: !     Frequency conversion factor: Energy in KJ/mol and length in angstrom
2065: !     to get frequencies in cm^{-1}      2063: !     to get frequencies in cm^{-1}      
2066: !      FRQCNV = 1.D03/(2.D0*4.D0*DATAN(1.D0)*2.998D0)2064:       FRQCNV = 1.D03/(2.D0*4.D0*DATAN(1.D0)*2.998D0)
2067: 2065: 
2068: !     Initialize2066: !     Initialize
2069:       U(:,:) = 0.D02067:       U(:,:) = 0.D0
2070:       IR     = 02068:       IR     = 0
2071:       IC     = 02069:       IC     = 0
2072: 2070: 
2073: !     Get the site positions2071: !     Get the site positions
2074:       OFFSET = 3*NATOMS/22072:       OFFSET = 3*NATOMS/2
2075:       GTEST = .FALSE.; STEST = .FALSE.2073:       GTEST = .FALSE.; STEST = .FALSE.
2076: 2074: 
2130:       IF (EIGENVECTORT) THEN2128:       IF (EIGENVECTORT) THEN
2131:          CALL DSYEV('V','L',NDIM,AP,NDIM,FRQN,WORK,LWORK,INFO)2129:          CALL DSYEV('V','L',NDIM,AP,NDIM,FRQN,WORK,LWORK,INFO)
2132:       ELSE2130:       ELSE
2133:          CALL DSYEV('N','L',NDIM,AP,NDIM,FRQN,WORK,LWORK,INFO)2131:          CALL DSYEV('N','L',NDIM,AP,NDIM,FRQN,WORK,LWORK,INFO)
2134:       ENDIF2132:       ENDIF
2135: 2133: 
2136:       ! sn402: commented this out: it doesn't play well with geopt, because this subroutine actually sorts2134:       ! sn402: commented this out: it doesn't play well with geopt, because this subroutine actually sorts
2137:       ! eigenvalues into descending order but geopt expects ascending order.2135:       ! eigenvalues into descending order but geopt expects ascending order.
2138: !      call eigensort_val_asc(FRQN,AP,NDIM,3*NATOMS)2136: !      call eigensort_val_asc(FRQN,AP,NDIM,3*NATOMS)
2139: 2137: 
2140:  
2141:  
2142: !  sn402: As of 23/9/16, I'm rationalising the frequency unit conversions. These are now controlled by a single keyword, 
2143: ! FRQCONV. Check the comments on that keyword in keywords.f for more information. 
2144: !      DO I = 1, NDIM2138: !      DO I = 1, NDIM
2145: !         IF (FRQN(I) > 0.0D0) THEN2139: !         IF (FRQN(I) > 0.0D0) THEN
2146: !            FRQN(I) = FRQCNV * SQRT((FRQN(I)))2140: !            FRQN(I) = FRQCNV * SQRT((FRQN(I)))
2147: !         ELSE2141: !         ELSE
2148: !            FRQN(I) = -FRQCNV * SQRT((-FRQN(I)))2142: !            FRQN(I) = -FRQCNV * SQRT((-FRQN(I)))
2149: !         ENDIF2143: !         ENDIF
2150: !      ENDDO2144: !      ENDDO
2151: !      FRQN(:) = FRQCNV*SQRT(ABS(FRQN(:)))2145: !      FRQN(:) = FRQCNV*SQRT(ABS(FRQN(:)))
2152: 2146: 
2153: !      IF(.FALSE.) THEN2147:       ! sn402: This conversion factor is not general and unexplained, so I'm getting rid of it for now.
2154: !      FRQN(:) = FRQN(:) * 1.0D262148:       ! It is presumably converting squared frequencies in internal units (kJmol^-1 amu^-1 Angs^-2) to s^-2.
2155: !      ENDIF2149:       ! But this is not the right place for unit conversions. I'm going to implement a general solution to the
 2150:       ! unit problem in the near future.
 2151:       IF(.FALSE.) THEN
 2152:       FRQN(:) = FRQN(:) * 1.0D26
 2153:       ENDIF
2156: !      print *, 'FRQN'2154: !      print *, 'FRQN'
2157: !      print *, FRQN2155: !      print *, FRQN
2158: 2156: 
2159: !      PRINT *, "CALLED FREQ"2157: !      PRINT *, "CALLED FREQ"
2160: !      PRINT *, FRQN2158: !      PRINT *, FRQN
2161: 2159: 
2162:       IF (EIGENVECTORT) THEN      2160:       IF (EIGENVECTORT) THEN      
2163:          HESS = AP2161:          HESS = AP
2164:       ENDIF2162:       ENDIF
2165: 2163: 


r31537/vdump.f 2016-11-24 14:30:20.389955570 +0000 r31536/vdump.f 2016-11-24 14:30:23.169992454 +0000
 38: !       some non-real modes have zero eiganvalue. 38: !       some non-real modes have zero eiganvalue.
 39:             MCOUNT=0 39:             MCOUNT=0
 40:             DO J1=1,N 40:             DO J1=1,N
 41:                 IF (ZT(J1)) MCOUNT=MCOUNT+1 41:                 IF (ZT(J1)) MCOUNT=MCOUNT+