hdiff output

r29791/connect.f 2016-01-21 22:30:06.955301608 +0000 r29790/connect.f 2016-01-21 22:30:11.783366243 +0000
1857:                   TRYNEB=.TRUE.1857:                   TRYNEB=.TRUE.
1858:                   IGUESS=11858:                   IGUESS=1
1859:                   WRITE(*,'(A,I4)') 'IGUESS=',IGUESS1859:                   WRITE(*,'(A,I4)') 'IGUESS=',IGUESS
1860:                ENDIF1860:                ENDIF
1861:             ELSE1861:             ELSE
1862:                IF (NEBT) THEN1862:                IF (NEBT) THEN
1863:                   CALL OLDNEB(.FALSE.,PTEST,ENERGY,MAXNEBBFGS,PERM,Q)1863:                   CALL OLDNEB(.FALSE.,PTEST,ENERGY,MAXNEBBFGS,PERM,Q)
1864:                   CALL POTENTIAL(Q,ENERGY,VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)1864:                   CALL POTENTIAL(Q,ENERGY,VNEW,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
1865:                ELSEIF (NEWNEBT) THEN1865:                ELSEIF (NEWNEBT) THEN
1866:                   OldConnect=.TRUE. ! changes behaviour of NEWNEB, ts guess should come back in Q1866:                   OldConnect=.TRUE. ! changes behaviour of NEWNEB, ts guess should come back in Q
1867:                   CALL NEWNEB(.FALSE.,DCOORDS,EINITIAL,Q,EFINAL,FIN,.TRUE.)1867:                   CALL NEWNEB(.FALSE.,DCOORDS,EINITIAL,Q,EFINAL,FIN,MorePrinting2,.TRUE.)
1868:                ENDIF1868:                ENDIF
1869:             ENDIF1869:             ENDIF
1870:          ELSEIF (UNRST) THEN1870:          ELSEIF (UNRST) THEN
1871:             IF (GUESSTST.AND.(.NOT.TRYNEB)) THEN1871:             IF (GUESSTST.AND.(.NOT.TRYNEB)) THEN
1872: C last guess is now midway around the long arc from start to finish; all others are equally spaced along shorter arc1872: C last guess is now midway around the long arc from start to finish; all others are equally spaced along shorter arc
1873:                IF (IGUESS.EQ.NGUESS) THEN1873:                IF (IGUESS.EQ.NGUESS) THEN
1874:                   TWISTFRAC = -1.D01874:                   TWISTFRAC = -1.D0
1875:                ELSE1875:                ELSE
1876:                   TWISTFRAC=1.0D0*IGUESS/NGUESS1876:                   TWISTFRAC=1.0D0*IGUESS/NGUESS
1877:                ENDIF1877:                ENDIF
1884:                ELSE1884:                ELSE
1885:                   CALL UNRESGUESSTS(Q,.FALSE.,PTEST,TWISTTYPE,TWISTFRAC,GUESSFAIL,DISTPF)1885:                   CALL UNRESGUESSTS(Q,.FALSE.,PTEST,TWISTTYPE,TWISTFRAC,GUESSFAIL,DISTPF)
1886:                END IF1886:                END IF
1887:                FAILT=.FALSE.1887:                FAILT=.FALSE.
1888:                IF (GUESSFAIL) THEN1888:                IF (GUESSFAIL) THEN
1889:                   PRINT *,'guessfail true, calling newneb'1889:                   PRINT *,'guessfail true, calling newneb'
1890:                   IF (NEBT) THEN1890:                   IF (NEBT) THEN
1891:                      CALL OLDNEB(.FALSE.,PTEST,ENERGY,MAXNEBBFGS,PERM,Q)1891:                      CALL OLDNEB(.FALSE.,PTEST,ENERGY,MAXNEBBFGS,PERM,Q)
1892:                   ELSEIF (NEWNEBT) THEN1892:                   ELSEIF (NEWNEBT) THEN
1893:                      OldConnect=.TRUE. ! changes behaviour of NEWNEB, ts guess should come back in Q1893:                      OldConnect=.TRUE. ! changes behaviour of NEWNEB, ts guess should come back in Q
1894:                      CALL NEWNEB(.FALSE.,DCOORDS,EINITIAL,Q,EFINAL,FIN,.TRUE.)1894:                      CALL NEWNEB(.FALSE.,DCOORDS,EINITIAL,Q,EFINAL,FIN,MorePrinting2,.TRUE.)
1895:                   ENDIF1895:                   ENDIF
1896:                   TRYNEB=.TRUE.1896:                   TRYNEB=.TRUE.
1897:                   IGUESS=11897:                   IGUESS=1
1898:                   WRITE(*,'(A,I4)') 'IGUESS=',IGUESS1898:                   WRITE(*,'(A,I4)') 'IGUESS=',IGUESS
1899:                ELSE1899:                ELSE
1900:                   KNOWE=.FALSE. ! jmc testing, to fix rather large bug with intbfgsts.....1900:                   KNOWE=.FALSE. ! jmc testing, to fix rather large bug with intbfgsts.....
1901:                   KNOWG=.FALSE.1901:                   KNOWG=.FALSE.
1902:                ENDIF1902:                ENDIF
1903:             ELSE1903:             ELSE
1904:                IF (NEBT) THEN1904:                IF (NEBT) THEN
1905:                   CALL OLDNEB(.FALSE.,PTEST,ENERGY,MAXNEBBFGS,PERM,Q)1905:                   CALL OLDNEB(.FALSE.,PTEST,ENERGY,MAXNEBBFGS,PERM,Q)
1906:                ELSEIF (NEWNEBT) THEN1906:                ELSEIF (NEWNEBT) THEN
1907:                   OldConnect=.TRUE. ! changes behaviour of NEWNEB, ts guess should come back in Q1907:                   OldConnect=.TRUE. ! changes behaviour of NEWNEB, ts guess should come back in Q
1908:                   CALL NEWNEB(.FALSE.,DCOORDS,EINITIAL,Q,EFINAL,FIN,.TRUE.)1908:                   CALL NEWNEB(.FALSE.,DCOORDS,EINITIAL,Q,EFINAL,FIN,MorePrinting2,.TRUE.)
1909:                ENDIF1909:                ENDIF
1910:             ENDIF1910:             ENDIF
1911:          ELSE1911:          ELSE
1912:             IF (NEBT) THEN1912:             IF (NEBT) THEN
1913:                CALL OLDNEB(.FALSE.,PTEST,ENERGY,MAXNEBBFGS,PERM,Q)1913:                CALL OLDNEB(.FALSE.,PTEST,ENERGY,MAXNEBBFGS,PERM,Q)
1914:             ELSEIF (NEWNEBT) THEN1914:             ELSEIF (NEWNEBT) THEN
1915:                OldConnect=.TRUE. ! changes behaviour of NEWNEB, ts guess should come back in Q1915:                OldConnect=.TRUE. ! changes behaviour of NEWNEB, ts guess should come back in Q
1916:                CALL NEWNEB(.FALSE.,DCOORDS,EINITIAL,Q,EFINAL,FIN,.TRUE.)1916:                CALL NEWNEB(.FALSE.,DCOORDS,EINITIAL,Q,EFINAL,FIN,MorePrinting2,.TRUE.)
1917:             ENDIF1917:             ENDIF
1918:          ENDIF1918:          ENDIF
1919: C        IF (PERM) NIMAGE=NIMAGESAVE1919: C        IF (PERM) NIMAGE=NIMAGESAVE
1920:       ENDIF1920:       ENDIF
1921: !1921: !
1922: ! Must set the energy of the highest image for use in secdiag routine with bfgsts.1922: ! Must set the energy of the highest image for use in secdiag routine with bfgsts.
1923: !1923: !
1924:       IF (NEWNEBT) ENERGY=EMAX1924:       IF (NEWNEBT) ENERGY=EMAX
1925:       FIXD=.FALSE.1925:       FIXD=.FALSE.
1926: C1926: C


r29791/dummy_userpot.f90 2016-01-21 22:30:07.179304607 +0000 r29790/dummy_userpot.f90 2016-01-21 22:30:12.039369670 +0000
 58:     integer, intent(in) :: dof 58:     integer, intent(in) :: dof
 59:     double precision, intent(in) :: x(dof) 59:     double precision, intent(in) :: x(dof)
 60:     double precision, intent(in) :: y(dof) 60:     double precision, intent(in) :: y(dof)
 61:     double precision, intent(out) :: dist 61:     double precision, intent(out) :: dist
 62:      62:     
 63:     print *,'ERROR: you are using dmacrys with a non-dmacrys binary' 63:     print *,'ERROR: you are using dmacrys with a non-dmacrys binary'
 64:     stop 64:     stop
 65: end subroutine userpot_distance 65: end subroutine userpot_distance
 66:  66: 
 67: subroutine userpot_dump_configuration(filename, coords) 67: subroutine userpot_dump_configuration(filename, coords)
 68: implicit none 
 69: double precision COORDS(*) 
 70: CHARACTER filename 
 71:      68:     
 72: end subroutine 69: end subroutine
 73:  70: 
 74: subroutine userpot_dump_lowest 71: subroutine userpot_dump_lowest
 75: end subroutine 72: end subroutine


r29791/getparams.f 2016-01-21 22:30:07.395307501 +0000 r29790/getparams.f 2016-01-21 22:30:12.287372990 +0000
604:             CALL READF(DUMMY)604:             CALL READF(DUMMY)
605:             CALL READF(DUMMY)605:             CALL READF(DUMMY)
606:             CALL READF(DUMMY)606:             CALL READF(DUMMY)
607:             NATOMS=NATOMS+1607:             NATOMS=NATOMS+1
608:             GOTO 300608:             GOTO 300
609:          ENDIF609:          ENDIF
610:       ENDIF610:       ENDIF
611: 400   CLOSE(5)611: 400   CLOSE(5)
612:   612:   
613:       WRITE(*,'(A,I6)') ' getparams> Number of atoms (or variables)  determined as ',NATOMS613:       WRITE(*,'(A,I6)') ' getparams> Number of atoms (or variables)  determined as ',NATOMS
614:       NOPT=3*NATOMS 
615:       IF (VARIABLES) NOPT=NATOMS 
616:       WRITE(*,'(A,I6)') ' getparams> Number of optimisation degrees of freedom ',NOPT 
617: 614: 
618:       CALL OPTIM(FILTH,FILTH2,ARGSTRING)615:       CALL OPTIM(FILTH,FILTH2,ARGSTRING)
619: 616: 
620: 617: 
621:       STOP      618:       STOP      
622:       END PROGRAM OPTIM3619:       END PROGRAM OPTIM3


r29791/grad.f90 2016-01-21 22:30:05.439281318 +0000 r29790/grad.f90 2016-01-21 22:30:10.027342734 +0000
 38:   &                      DISTREF, ADDREPT, NEBRESEEDDEL2, NEBRESEEDPOW1, NEBRESEEDPOW2, CHECKCONINT 38:   &                      DISTREF, ADDREPT, NEBRESEEDDEL2, NEBRESEEDPOW1, NEBRESEEDPOW2, CHECKCONINT
 39:           USE COMMONS, ONLY : PARAM1, PARAM2, PARAM3, DEBUG 39:           USE COMMONS, ONLY : PARAM1, PARAM2, PARAM3, DEBUG
 40:           IMPLICIT NONE 40:           IMPLICIT NONE
 41:             41:            
 42:           INTEGER :: J1,J2,K,J3,J4,J5,JOUT,JIN,NSHRINK,NSHRINKATOM(NATOMS),J6,NATTACH,NATTACHS,NMAXINT,NMININT,LUNIT 42:           INTEGER :: J1,J2,K,J3,J4,J5,JOUT,JIN,NSHRINK,NSHRINKATOM(NATOMS),J6,NATTACH,NATTACHS,NMAXINT,NMININT,LUNIT
 43:           DOUBLE PRECISION :: PERPCOMP=0.1D0 43:           DOUBLE PRECISION :: PERPCOMP=0.1D0
 44:           DOUBLE PRECISION :: DIHEDIST,TMPRMS,QINT(NINTS*(NIMAGE+2)),DIFFM(NINTS),DIFFP(NINTS) ! JMC 44:           DOUBLE PRECISION :: DIHEDIST,TMPRMS,QINT(NINTS*(NIMAGE+2)),DIFFM(NINTS),DIFFP(NINTS) ! JMC
 45:           DOUBLE PRECISION DIST 45:           DOUBLE PRECISION DIST
 46:           DOUBLE PRECISION :: PI=3.141592653589793D0 46:           DOUBLE PRECISION :: PI=3.141592653589793D0
 47:           DOUBLE PRECISION TEMP1(NOPT), TEMP2(NOPT), GGGSAVE(NOPT*(NIMAGE+2)), DUMMY, DUMMY2, SPRING(NOPT*(NIMAGE+2)), & 47:           DOUBLE PRECISION TEMP1(NOPT), TEMP2(NOPT), GGGSAVE(NOPT*(NIMAGE+2)), DUMMY, DUMMY2, SPRING(NOPT*(NIMAGE+2)), &
 48:   &                        TRUEPERP(NOPT*(NIMAGE+2)), IMCOORDS(NOPT), RSITE(NOPT), RMAT(3,3), D, DIST2, LX(3), LV(3), & 48:   &                        TRUEPERP(NOPT*(NIMAGE+2)), IMCOORDS(3*NATOMS), RSITE(3*NATOMS), RMAT(3,3), D, DIST2, LX(3), LV(3), &
 49:   &                        REPGRAD(NOPT), MAGREP, MEAND, VS(3), VF(3), MP1S(3), MP2S(3), MP1F(3), MP2F(3), DS, DF, D1, D2, DI, DJ, & 49:   &                        REPGRAD(3), MAGREP, MEAND, VS(3), VF(3), MP1S(3), MP2S(3), MP1F(3), MP2F(3), DS, DF, D1, D2, DI, DJ, &
 50:   &                        MP2SS(3), MP2FF(3), MP1SS(3), MP1FF(3), DSS, DFF, DISTA, DISTB 50:   &                        MP2SS(3), MP2FF(3), MP1SS(3), MP1FF(3), DSS, DFF, DISTA, DISTB
 51:           INTEGER, ALLOCATABLE :: IREPTEMP(:) 51:           INTEGER, ALLOCATABLE :: IREPTEMP(:)
 52:           LOGICAL SHRINKT(NATOMS) 52:           LOGICAL SHRINKT(NATOMS)
 53:           DOUBLE PRECISION EEETMP(NIMAGE+2), MYGTMP(NOPT*(NIMAGE+2)), ETMP, RMSTMP, GETUNIT 53:           DOUBLE PRECISION EEETMP(NIMAGE+2), MYGTMP(NOPT*(NIMAGE+2)), ETMP, RMSTMP, GETUNIT
 54:            54:           
 55:           CALL TRUEPOTEG 55:           CALL TRUEPOTEG(.TRUE.)
 56:  56: 
 57: !         IF (INTCONSTRAINTT.AND.(INTCONFRAC.LT.1.0D0)) THEN 57: !         IF (INTCONSTRAINTT.AND.(INTCONFRAC.LT.1.0D0)) THEN
 58: !            EEETMP(1:NIMAGE+2)=EEE(1:NIMAGE+2) 58: !            EEETMP(1:NIMAGE+2)=EEE(1:NIMAGE+2)
 59: !            MYGTMP(1:NOPT*(NIMAGE+2))=GGG(1:NOPT*(NIMAGE+2)) 59: !            MYGTMP(1:NOPT*(NIMAGE+2))=GGG(1:NOPT*(NIMAGE+2))
 60: !            IF (CHECKCONINT) THEN 60: !            IF (CHECKCONINT) THEN
 61: !               CALL CONGRAD2(NMAXINT,NMININT,ETMP,XYZ,GGG,EEE,IMGFREEZE,RMSTMP) 61: !               CALL CONGRAD2(NMAXINT,NMININT,ETMP,XYZ,GGG,EEE,IMGFREEZE,RMSTMP)
 62: !            ELSE 62: !            ELSE
 63: !               CALL CONGRAD(NMAXINT,NMININT,ETMP,XYZ,GGG,EEE,IMGFREEZE,RMSTMP) 63: !               CALL CONGRAD(NMAXINT,NMININT,ETMP,XYZ,GGG,EEE,IMGFREEZE,RMSTMP)
 64: !            ENDIF 64: !            ENDIF
 65: !            LUNIT=GETUNIT() 65: !            LUNIT=GETUNIT()
427:                 DO J1=2,NIMAGE+1427:                 DO J1=2,NIMAGE+1
428:                    IF ((BADIMAGE(J1).AND.(REPPOW(J2).GT.0)).OR.(BADPEPTIDE(J1).AND.(REPPOW(J2).LT.0))) THEN428:                    IF ((BADIMAGE(J1).AND.(REPPOW(J2).GT.0)).OR.(BADPEPTIDE(J1).AND.(REPPOW(J2).LT.0))) THEN
429: !429: !
430: !  Add repulsive/constraint terms defined as interatomic distances.430: !  Add repulsive/constraint terms defined as interatomic distances.
431: !431: !
432: 432: 
433:                       DIST=SQRT((XYZ(NOPT*(J1-1)+3*(ORDERI(J2)-1)+1)-XYZ(NOPT*(J1-1)+3*(ORDERJ(J2)-1)+1))**2 &433:                       DIST=SQRT((XYZ(NOPT*(J1-1)+3*(ORDERI(J2)-1)+1)-XYZ(NOPT*(J1-1)+3*(ORDERJ(J2)-1)+1))**2 &
434:   &                            +(XYZ(NOPT*(J1-1)+3*(ORDERI(J2)-1)+2)-XYZ(NOPT*(J1-1)+3*(ORDERJ(J2)-1)+2))**2 &434:   &                            +(XYZ(NOPT*(J1-1)+3*(ORDERI(J2)-1)+2)-XYZ(NOPT*(J1-1)+3*(ORDERJ(J2)-1)+2))**2 &
435:   &                            +(XYZ(NOPT*(J1-1)+3*(ORDERI(J2)-1)+3)-XYZ(NOPT*(J1-1)+3*(ORDERJ(J2)-1)+3))**2)435:   &                            +(XYZ(NOPT*(J1-1)+3*(ORDERI(J2)-1)+3)-XYZ(NOPT*(J1-1)+3*(ORDERJ(J2)-1)+3))**2)
436: 436: 
437:                       REPGRAD(1:NOPT)=0.0D0437:                       REPGRAD(1:3*NATOMS)=0.0D0
438: 438: 
439:                       DUMMY=DIST-DISTREF(J2)  !  DJW BUG this J2 was J1!439:                       DUMMY=DIST-DISTREF(J2)  !  DJW BUG this J2 was J1!
440:                       IF (DUMMY.EQ.0.0D0) DUMMY=1.0D-10440:                       IF (DUMMY.EQ.0.0D0) DUMMY=1.0D-10
441: 441: 
442:                       REPGRAD(3*(ORDERI(J2)-1)+1:3*(ORDERI(J2)-1)+3)= &442:                       REPGRAD(3*(ORDERI(J2)-1)+1:3*(ORDERI(J2)-1)+3)= &
443:      &                 -REPPOW(J2)*EPSALPHA(J2) &443:      &                 -REPPOW(J2)*EPSALPHA(J2) &
444:      &                  *(XYZ((J1-1)*NOPT+3*(ORDERI(J2)-1)+1:(J1-1)*NOPT+3*(ORDERI(J2)-1)+3) &444:      &                  *(XYZ((J1-1)*NOPT+3*(ORDERI(J2)-1)+1:(J1-1)*NOPT+3*(ORDERI(J2)-1)+3) &
445:      &                   -XYZ((J1-1)*NOPT+3*(ORDERJ(J2)-1)+1:(J1-1)*NOPT+3*(ORDERJ(J2)-1)+3)) &445:      &                   -XYZ((J1-1)*NOPT+3*(ORDERJ(J2)-1)+1:(J1-1)*NOPT+3*(ORDERJ(J2)-1)+3)) &
446:      &                         /(DIST*DUMMY**(REPPOW(J2)+1))446:      &                         /(DIST*DUMMY**(REPPOW(J2)+1))
447: 447: 
521:                   ! calculate the beast Gspr perp - (Gspr perp, Gt perp)* Gt perp/(Gt perp, Gt perp)521:                   ! calculate the beast Gspr perp - (Gspr perp, Gt perp)* Gt perp/(Gt perp, Gt perp)
522:                 DUMMY=DOT_PRODUCT(GGG(NOPT*JT+1:NOPT*(JT+1)),GGG(NOPT*JT+1:NOPT*(JT+1)))522:                 DUMMY=DOT_PRODUCT(GGG(NOPT*JT+1:NOPT*(JT+1)),GGG(NOPT*JT+1:NOPT*(JT+1)))
523:                 IF (DUMMY.EQ.0.0D0) DUMMY=1.0D-100523:                 IF (DUMMY.EQ.0.0D0) DUMMY=1.0D-100
524:                   SSS(NOPT*JS+1:NOPT*(JS+1)) = SSS(NOPT*JS+1:NOPT*(JS+1)) - &524:                   SSS(NOPT*JS+1:NOPT*(JS+1)) = SSS(NOPT*JS+1:NOPT*(JS+1)) - &
525:                   & DOT_PRODUCT(SSS(NOPT*JS+1:NOPT*(JS+1)),GGG(NOPT*JT+1:NOPT*(JT+1)))*GGG(NOPT*JT+1:NOPT*(JT+1))/ &525:                   & DOT_PRODUCT(SSS(NOPT*JS+1:NOPT*(JS+1)),GGG(NOPT*JT+1:NOPT*(JT+1)))*GGG(NOPT*JT+1:NOPT*(JT+1))/ &
526:                   & DUMMY526:                   & DUMMY
527:              ENDIF527:              ENDIF
528:           ENDIF528:           ENDIF
529:      END SUBROUTINE NUDGE529:      END SUBROUTINE NUDGE
530: 530: 
531:      SUBROUTINE TRUEPOTEG531:      SUBROUTINE TRUEPOTEG(GTEST)
532:        USE PORFUNCS532:        USE PORFUNCS
533:        USE NEBDATA533:        USE NEBDATA
534:        USE KEYNEB,ONLY: NIMAGE534:        USE KEYNEB,ONLY: NIMAGE
535:        USE MODUNRES, ONLY: C,NRES535:        USE MODUNRES, ONLY: C,NRES
536:        USE KEY, ONLY: UNRST, FREEZENODEST, INTEPSILON536:        USE KEY, ONLY: UNRST, FREEZENODEST, INTEPSILON
537:        USE INTCOMMONS, ONLY : DESMINT, NNZ, KD, NINTC, PREVDIH, DIHINFO537:        USE INTCOMMONS, ONLY : DESMINT, NNZ, KD, NINTC, PREVDIH, DIHINFO
538:        USE MODCHARMM, ONLY: CHRMMT, ACESOLV, NCHENCALLS, ACEUPSTEP538:        USE MODCHARMM, ONLY: CHRMMT, ACESOLV, NCHENCALLS, ACEUPSTEP
539:        IMPLICIT NONE539:        IMPLICIT NONE
540: 540: 
 541:        LOGICAL, INTENT(IN) :: GTEST
 542: 
541:        INTEGER :: I,J543:        INTEGER :: I,J
542:        DOUBLE PRECISION :: RMSTMP,HARVEST,DPRAND544:        DOUBLE PRECISION :: RMSTMP,HARVEST,DPRAND
543: 545: 
544:        DOUBLE PRECISION :: DUMINT(NINTC)546:        DOUBLE PRECISION :: DUMINT(NINTC)
545: 547: 
546:        ! energy and gradient for images548:        ! energy and gradient for images
547: !      PRINT '(A)',' '549: !      PRINT '(A)',' '
548: !      PRINT '(A,I8,A,G20.10,A)','image ',1,' energy ',EEE(1),' points:'550: !      PRINT '(A,I8,A,G20.10,A)','image ',1,' energy ',EEE(1),' points:'
549: !      PRINT '(3G20.10)',XYZ(NOPT*(1-1)+1:NOPT*(1-1)+3)551: !      PRINT '(3G20.10)',XYZ(3*NATOMS*(1-1)+1:3*NATOMS*(1-1)+3)
550:        DO I=2,NIMAGE+1552:        DO I=2,NIMAGE+1
551: 553: 
552:           IF (FREEZENODEST) THEN554:           IF (FREEZENODEST) THEN
553:              IF (DESMINT) THEN555:              IF (DESMINT) THEN
554:                 print*, 'nebgrad>> DESMINT not implemented with freezenodes.'556:                 print*, 'nebgrad>> DESMINT not implemented with freezenodes.'
555:                 STOP557:                 STOP
556:              ENDIF558:              ENDIF
557:              ! for nodes that didn't move, set true gradient to previous value559:              ! for nodes that didn't move, set true gradient to previous value
558:              IF (IMGFREEZE(I-1)) THEN560:              IF (IMGFREEZE(I-1)) THEN
559:                 GGG(NOPT*(I-1)+1:NOPT*I) = TRUEGRAD(NOPT*(I-1)+1:NOPT*I)561:                 GGG(NOPT*(I-1)+1:NOPT*I) = TRUEGRAD(NOPT*(I-1)+1:NOPT*I)
576:              ENDDO578:              ENDDO
577:              CALL UPDATEDC579:              CALL UPDATEDC
578:              CALL INT_FROM_CART(.TRUE.,.FALSE.)580:              CALL INT_FROM_CART(.TRUE.,.FALSE.)
579:              CALL CHAINBUILD581:              CALL CHAINBUILD
580:           ENDIF582:           ENDIF
581: 583: 
582: !bs360: update ACE Born radii for each image584: !bs360: update ACE Born radii for each image
583:           IF(CHRMMT.AND.ACESOLV) NCHENCALLS=ACEUPSTEP-1585:           IF(CHRMMT.AND.ACESOLV) NCHENCALLS=ACEUPSTEP-1
584:           IF (DESMINT) THEN586:           IF (DESMINT) THEN
585: 587: 
586:              CALL POTENTIAL(XYZCART(NOPT*(I-1)+1:NOPT*I),EEE(I), &588:              CALL POTENTIAL(XYZCART(3*NATOMS*(I-1)+1:3*NATOMS*I),EEE(I), &
587:   &                   GGGCART(NOPT*(I-1)+1:NOPT*I),.TRUE.,.FALSE.,RMSTMP,.FALSE.,.FALSE.)589:   &                   GGGCART(3*NATOMS*(I-1)+1:3*NATOMS*I),.TRUE.,.FALSE.,RMSTMP,.FALSE.,.FALSE.)
588:              PREVDIH => DIHINFO(I,:)590:              PREVDIH => DIHINFO(I,:)
589:              CALL TRANSFORM(XYZCART(NOPT*(I-1)+1:NOPT*I),GGGCART(NOPT*(I-1)+1:NOPT*I),&591:              CALL TRANSFORM(XYZCART(3*NATOMS*(I-1)+1:3*NATOMS*I),GGGCART(3*NATOMS*(I-1)+1:3*NATOMS*I),&
590:                   & DUMINT,GGG(NOPT*(I-1)+1:NOPT*I), NINTC,NOPT,NNZ,.TRUE.,.FALSE.,KD,INTEPSILON)592:                   & DUMINT,GGG(NOPT*(I-1)+1:NOPT*I), NINTC,3*NATOMS,NNZ,.TRUE.,.FALSE.,KD,INTEPSILON)
591:              TRUEGRAD(NOPT*(I-1)+1:NOPT*I)=GGGCART(NOPT*(I-1)+1:NOPT*I) ! SAVE FOR PASSING TO BFGSTS LATER593:              TRUEGRAD(3*NATOMS*(I-1)+1:3*NATOMS*I)=GGGCART(3*NATOMS*(I-1)+1:3*NATOMS*I) ! SAVE FOR PASSING TO BFGSTS LATER
592:           ELSE594:           ELSE
593:              CALL POTENTIAL(XYZ(NOPT*(I-1)+1:NOPT*I),EEE(I),GGG(NOPT*(I-1)+1:NOPT*I),.TRUE.,.FALSE.,RMSTMP,.FALSE.,.FALSE.)595:              CALL POTENTIAL(XYZ(NOPT*(I-1)+1:NOPT*I),EEE(I),GGG(NOPT*(I-1)+1:NOPT*I),.TRUE.,.FALSE.,RMSTMP,.FALSE.,.FALSE.)
594:              TRUEGRAD(NOPT*(I-1)+1:NOPT*I)=GGG(NOPT*(I-1)+1:NOPT*I) ! SAVE FOR PASSING TO BFGSTS LATER596:              TRUEGRAD(NOPT*(I-1)+1:NOPT*I)=GGG(NOPT*(I-1)+1:NOPT*I) ! SAVE FOR PASSING TO BFGSTS LATER
595:           ENDIF597:           ENDIF
596: !         PRINT '(A,I8,A,G20.10,A)','image ',I,' energy ',EEE(I),' points:'598: !         PRINT '(A,I8,A,G20.10,A)','image ',I,' energy ',EEE(I),' points:'
597: !         PRINT '(3G20.10)',XYZ(NOPT*(I-1)+1:NOPT*(I-1)+3)599: !         PRINT '(3G20.10)',XYZ(3*NATOMS*(I-1)+1:3*NATOMS*(I-1)+3)
598: 600: 
599:           IF ( EEE(I) > HUGE(EEE(I)) ) THEN ! BAD GUESS - HIGH-ENERGY IMAGE601:           IF ( EEE(I) > HUGE(EEE(I)) ) THEN ! BAD GUESS - HIGH-ENERGY IMAGE
600:              PRINT *, "IMAGE",I," IS BAD! - TRYING TO LOWER IT's energy..."602:              PRINT *, "IMAGE",I," IS BAD! - TRYING TO LOWER IT's energy..."
601:              IF (DESMINT) THEN603:              IF (DESMINT) THEN
602:                 print*, 'nebgrad>> bad energy perturbation not implemented with DESMINT yet.'604:                 print*, 'nebgrad>> bad energy perturbation not implemented with DESMINT yet.'
603:                 STOP605:                 STOP
604:              ENDIF606:              ENDIF
605:              DO J=1,NOPT ! CHANGING GEOMETRY RANDOMLY607:              DO J=1,NOPT ! CHANGING GEOMETRY RANDOMLY
606:                 !                        call random_number(harvest)608:                 !                        call random_number(harvest)
607:                 HARVEST=DPRAND()609:                 HARVEST=DPRAND()
628:              TRUEGRAD(NOPT*(I-1)+1:NOPT*I)=GGG(NOPT*(I-1)+1:NOPT*I) ! SAVE FOR PASSING TO BFGSTS LATER630:              TRUEGRAD(NOPT*(I-1)+1:NOPT*I)=GGG(NOPT*(I-1)+1:NOPT*I) ! SAVE FOR PASSING TO BFGSTS LATER
629: 631: 
630:              IF ( EEE(I) > HUGE(EEE(I)) ) THEN632:              IF ( EEE(I) > HUGE(EEE(I)) ) THEN
631:                 PRINT *, "Failed."633:                 PRINT *, "Failed."
632:                 CALL TSUMMARY634:                 CALL TSUMMARY
633:                 STOP635:                 STOP
634:              ENDIF636:              ENDIF
635:           ENDIF637:           ENDIF
636:        ENDDO638:        ENDDO
637: !      PRINT '(A,I8,A,G20.10,A)','image ',NIMAGE+2,' energy ',EEE(NIMAGE+2),' points:'639: !      PRINT '(A,I8,A,G20.10,A)','image ',NIMAGE+2,' energy ',EEE(NIMAGE+2),' points:'
638: !      PRINT '(3G20.10)',XYZ(NOPT*(NIMAGE+2-1)+1:NOPT*(NIMAGE+2-1)+3)640: !      PRINT '(3G20.10)',XYZ(3*NATOMS*(NIMAGE+2-1)+1:3*NATOMS*(NIMAGE+2-1)+3)
639:      END SUBROUTINE TRUEPOTEG641:      END SUBROUTINE TRUEPOTEG
640: 642: 
641: END MODULE GRADIENTS643: END MODULE GRADIENTS


r29791/ido.f90 2016-01-21 22:30:04.331266570 +0000 r29790/ido.f90 2016-01-21 22:30:08.919327901 +0000
 17: !   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA 17: !   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 18: ! 18: !
 19: MODULE IDOMODULE 19: MODULE IDOMODULE
 20:      USE CONNECTDATA 20:      USE CONNECTDATA
 21:      USE CONNECTUTILS 21:      USE CONNECTUTILS
 22:      USE KEYCONNECT 22:      USE KEYCONNECT
 23:      IMPLICIT NONE 23:      IMPLICIT NONE
 24:      CONTAINS 24:      CONTAINS
 25:  25: 
 26: SUBROUTINE INITIALISE(NA,EI,Q,EF,FIN,ENDPOINTSEP) 26: SUBROUTINE INITIALISE(NA,EI,Q,EF,FIN,ENDPOINTSEP)
 27:      USE KEY, ONLY: READSP, INTIMAGE, INTLJT, INTCONSTRAINTT, FREEZENODEST, ATOMACTIVE, MLP3T 27:      USE KEY, ONLY: READSP, INTIMAGE, INTLJT, INTCONSTRAINTT, FREEZENODEST, ATOMACTIVE
 28:      IMPLICIT NONE 28:      IMPLICIT NONE
 29:       29:      
 30:      INTEGER,INTENT(IN)           :: NA 30:      INTEGER,INTENT(IN)           :: NA
 31:      DOUBLE PRECISION,INTENT(IN)           :: ENDPOINTSEP 31:      DOUBLE PRECISION,INTENT(IN)           :: ENDPOINTSEP
 32:      DOUBLE PRECISION,POINTER              :: EI,EF 32:      DOUBLE PRECISION,POINTER              :: EI,EF
 33:      DOUBLE PRECISION,POINTER,DIMENSION(:) :: Q,FIN 33:      DOUBLE PRECISION,POINTER,DIMENSION(:) :: Q,FIN
 34:  34: 
 35:      INTEGER J2, NPLUS, NMINUS, MINPOS, NMINA, NMINB, NTSDUMP, NDUMMY, NMINDUMP, IOERROR, NMAXINT, NMININT 35:      INTEGER J2, NPLUS, NMINUS, MINPOS, NMINA, NMINB, NTSDUMP, NDUMMY, NMINDUMP, IOERROR, NMAXINT, NMININT
 36:      LOGICAL MINNEW 36:      LOGICAL MINNEW
 37:      DOUBLE PRECISION, POINTER :: ETEMP, LOCALPOINTS(:) 37:      DOUBLE PRECISION, POINTER :: ETEMP, LOCALPOINTS(:)
 39:      DOUBLE PRECISION  DJWDUMMY, CONSTRAINTE, XYZLOCAL(6*NA), GGGLOCAL(6*NA), RMSLOCAL, MINCOORDS(2,3*NA), EEELOCAL(INTIMAGE+2) 39:      DOUBLE PRECISION  DJWDUMMY, CONSTRAINTE, XYZLOCAL(6*NA), GGGLOCAL(6*NA), RMSLOCAL, MINCOORDS(2,3*NA), EEELOCAL(INTIMAGE+2)
 40:      INTEGER, ALLOCATABLE :: ACTUALMIN(:) 40:      INTEGER, ALLOCATABLE :: ACTUALMIN(:)
 41:      LOGICAL PERMUTE, IMGFREEZELOCAL(0), FREEZENODESTLOCAL 41:      LOGICAL PERMUTE, IMGFREEZELOCAL(0), FREEZENODESTLOCAL
 42: !    LOGICAL EDGEINT(INTIMAGE+1,NA,NA) 42: !    LOGICAL EDGEINT(INTIMAGE+1,NA,NA)
 43:  43: 
 44:      INTEGER INVERT,INDEX(NA),IMATCH, INTIMAGESAVE 44:      INTEGER INVERT,INDEX(NA),IMATCH, INTIMAGESAVE
 45:  45: 
 46:      NULLIFY(ETEMP, LOCALPOINTS) 46:      NULLIFY(ETEMP, LOCALPOINTS)
 47:      NATOMS=NA 47:      NATOMS=NA
 48:      NOPT=3*NATOMS 48:      NOPT=3*NATOMS
 49:      IF (MLP3T) NOPT=NATOMS 
 50:      ALLOCATE(G(NOPT),MI(MINRACKSIZE),TS(TSRACKSIZE)) 49:      ALLOCATE(G(NOPT),MI(MINRACKSIZE),TS(TSRACKSIZE))
 51:  50: 
 52:      ! endpoints initialisation 51:      ! endpoints initialisation
 53:      NMIN=2 52:      NMIN=2
 54:      MI(1)%DATA%E => EI 53:      MI(1)%DATA%E => EI
 55:      MI(2)%DATA%E => EF 54:      MI(2)%DATA%E => EF
 56:      MI(1)%DATA%X => Q 55:      MI(1)%DATA%X => Q
 57:      MI(2)%DATA%X => FIN 56:      MI(2)%DATA%X => FIN
 58:      ALLOCATE(MI(2)%DATA%D(1),MI(2)%DATA%NTRIES(1),MI(2)%DATA%INTNTRIES(1)) 57:      ALLOCATE(MI(2)%DATA%D(1),MI(2)%DATA%NTRIES(1),MI(2)%DATA%INTNTRIES(1))
 59:      MI(2)%DATA%D(1) = ENDPOINTSEP 58:      MI(2)%DATA%D(1) = ENDPOINTSEP
242:         OPEN(UNIT=82,FILE='ts.data',STATUS='OLD')241:         OPEN(UNIT=82,FILE='ts.data',STATUS='OLD')
243:         ZEROTARGET=0.0D0 242:         ZEROTARGET=0.0D0 
244:         DO243:         DO
245:           ALLOCATE(ETEMP,LOCALPOINTS(1:NOPT))244:           ALLOCATE(ETEMP,LOCALPOINTS(1:NOPT))
246:           READ(82,*,END=14) ETEMP,DJWDUMMY,NDUMMY,NPLUS,NMINUS245:           READ(82,*,END=14) ETEMP,DJWDUMMY,NDUMMY,NPLUS,NMINUS
247:           NTSDUMP=NTSDUMP+1246:           NTSDUMP=NTSDUMP+1
248:           READ(15,REC=NTSDUMP) (LOCALPOINTS(J2),J2=1,NOPT)247:           READ(15,REC=NTSDUMP) (LOCALPOINTS(J2),J2=1,NOPT)
249:           IF (NTS==TSRACKSIZE) CALL REALLOCATETSRACK248:           IF (NTS==TSRACKSIZE) CALL REALLOCATETSRACK
250:           NTS=NTS+1249:           NTS=NTS+1
251:           TS(NTS)%DATA%E => ETEMP250:           TS(NTS)%DATA%E => ETEMP
252:           PRINT *,'ido> A NOPT=',NOPT 
253:           PRINT *,'ido> A SIZE ts=',SIZE(TS(NTS)%DATA%X(:)) 
254:           TS(NTS)%DATA%X => LOCALPOINTS251:           TS(NTS)%DATA%X => LOCALPOINTS
255:           TS(NTS)%DATA%EVALMIN => ZEROTARGET ! WE DON;T ASSUME THE E/VALUE AND E/VECTOR WERE SAVED252:           TS(NTS)%DATA%EVALMIN => ZEROTARGET ! WE DON;T ASSUME THE E/VALUE AND E/VECTOR WERE SAVED
256:                                              ! must NOT use pointer = thing - pointer is dereferenced, not set!253:                                              ! must NOT use pointer = thing - pointer is dereferenced, not set!
257:                                              ! Same thing would be needed for pointer vecs, but we shouldn't use it!254:                                              ! Same thing would be needed for pointer vecs, but we shouldn't use it!
258:           TS(NTS)%DATA%P = ACTUALMIN(NPLUS)  ! THE FOLLOWING COMPONENTS ARE NOT POINTERS!255:           TS(NTS)%DATA%P = ACTUALMIN(NPLUS)  ! THE FOLLOWING COMPONENTS ARE NOT POINTERS!
259:           TS(NTS)%DATA%M = ACTUALMIN(NMINUS)256:           TS(NTS)%DATA%M = ACTUALMIN(NMINUS)
260:           ! set zero distance between connected minima for dijkstra weight257:           ! set zero distance between connected minima for dijkstra weight
261:           CALL SETDISTANCE(ACTUALMIN(NPLUS),ACTUALMIN(NMINUS),0.0D0)258:           CALL SETDISTANCE(ACTUALMIN(NPLUS),ACTUALMIN(NMINUS),0.0D0)
262:           IF (INTERPCOSTFUNCTION) CALL SETINTERP(ACTUALMIN(NPLUS),ACTUALMIN(NMINUS),0.0D0)259:           IF (INTERPCOSTFUNCTION) CALL SETINTERP(ACTUALMIN(NPLUS),ACTUALMIN(NMINUS),0.0D0)
263:           TS(NTS)%DATA%SLENGTH = 0.0D0260:           TS(NTS)%DATA%SLENGTH = 0.0D0


r29791/intlbfgs.f90 2016-01-21 22:30:07.623310555 +0000 r29790/intlbfgs.f90 2016-01-21 22:30:12.499375828 +0000
 35:      & BFGSTST, NSTEPS, IMSEPMIN, IMSEPMAX, MAXINTIMAGE, EDIFFTOL, INTFREEZET, INTFREEZETOL, FREEZE, & 35:      & BFGSTST, NSTEPS, IMSEPMIN, IMSEPMAX, MAXINTIMAGE, EDIFFTOL, INTFREEZET, INTFREEZETOL, FREEZE, &
 36:      & INTFROZEN, CHECKREPINTERVAL, NNREPULSIVE, INTFREEZEMIN, RIGIDBODY, TWOD, BULKT, INTIMAGECHECK, & 36:      & INTFROZEN, CHECKREPINTERVAL, NNREPULSIVE, INTFREEZEMIN, RIGIDBODY, TWOD, BULKT, INTIMAGECHECK, &
 37:      & CONCUT, NCONGEOM, CONCUTLOCAL, NONEBMAX, WHOLEDNEB, PERMGUESS, QCIPERMCHECK, QCIPERMCHECKINT 37:      & CONCUT, NCONGEOM, CONCUTLOCAL, NONEBMAX, WHOLEDNEB, PERMGUESS, QCIPERMCHECK, QCIPERMCHECKINT
 38: USE COMMONS, ONLY: NATOMS, NOPT, ZSYM, DEBUG, PARAM1, PARAM2, PARAM3, REDOPATH 38: USE COMMONS, ONLY: NATOMS, NOPT, ZSYM, DEBUG, PARAM1, PARAM2, PARAM3, REDOPATH
 39: USE MODEFOL 39: USE MODEFOL
 40:  40: 
 41: IMPLICIT NONE  41: IMPLICIT NONE 
 42:  42: 
 43: DOUBLE PRECISION, INTENT(IN) :: QSTART(NOPT), QFINISH(NOPT)  ! The two end points 43: DOUBLE PRECISION, INTENT(IN) :: QSTART(NOPT), QFINISH(NOPT)  ! The two end points
 44: INTEGER D, U 44: INTEGER D, U
 45: DOUBLE PRECISION DMAX, DF, DMIN, DISTANCE 45: DOUBLE PRECISION DMAX, DF, DMIN
 46: INTEGER NDECREASE, NFAIL, NMAXINT, NMININT, JMAX, JMIN, INTIMAGESAVE, NOFF, J1, J2, ISTAT, POSITION, M1, M2 46: INTEGER NDECREASE, NFAIL, NMAXINT, NMININT, JMAX, JMIN, INTIMAGESAVE, NOFF, J1, J2, ISTAT, POSITION, M1, M2
 47: LOGICAL KNOWE, KNOWG, KNOWH, ADDATOM, PTEST, MFLAG, PRINTOPTIMIZETS, PRINTOPTIMIZEMIN, ADDREP(NATOMS), & 47: LOGICAL KNOWE, KNOWG, KNOWH, ADDATOM, PTEST, MFLAG, PRINTOPTIMIZETS, PRINTOPTIMIZEMIN, ADDREP(NATOMS), &
 48:    &    INTMAXT, MINNEW 48:    &    INTMAXT, MINNEW
 49: COMMON /KNOWN/ KNOWE, KNOWG, KNOWH 49: COMMON /KNOWN/ KNOWE, KNOWG, KNOWH
 50:  50: 
 51: DOUBLE PRECISION EDUMMY,EVALMIN,EVALMAX,DUMMY,DUMMY2(1) 51: DOUBLE PRECISION EDUMMY,EVALMIN,EVALMAX,DUMMY,DUMMY2(1)
 52: INTEGER POINT,NPT,J3,J4,NIMAGEFREEZE,NACTIVE,NBEST,NEWATOM,LMINFOUND,NSIDE,ITDONE,LTSFOUND,MIN1ID,MIN2ID 52: INTEGER POINT,NPT,J3,J4,NIMAGEFREEZE,NACTIVE,NBEST,NEWATOM,LMINFOUND,NSIDE,ITDONE,LTSFOUND,MIN1ID,MIN2ID
 53: INTEGER STARTID, FINISHID 53: INTEGER STARTID, FINISHID
 54: INTEGER TURNONORDER(NATOMS),NBACKTRACK,NQCIFREEZE 54: INTEGER TURNONORDER(NATOMS),NBACKTRACK,NQCIFREEZE
 55: DOUBLE PRECISION, DIMENSION(3*NATOMS) :: LGDUMMY, VECS, XDIAG 55: DOUBLE PRECISION, DIMENSION(3*NATOMS) :: LGDUMMY, VECS, XDIAG
734:          ENDIF734:          ENDIF
735:       ENDIF735:       ENDIF
736:    ENDIF736:    ENDIF
737: ! 737: ! 
738: ! End of add/subtract images block.738: ! End of add/subtract images block.
739: !  739: !  
740:    IF (QCIPERMCHECK.AND.(MOD(NITERDONE,QCIPERMCHECKINT).EQ.0)) THEN740:    IF (QCIPERMCHECK.AND.(MOD(NITERDONE,QCIPERMCHECKINT).EQ.0)) THEN
741:       LDEBUG=.FALSE.741:       LDEBUG=.FALSE.
742:       DO J2=2,NIMAGE+2742:       DO J2=2,NIMAGE+2
743:          CALL MINPERMDIST(XYZ((J2-2)*NOPT+1:(J2-1)*NOPT),XYZ((J2-1)*NOPT+1:J2*NOPT),NATOMS,LDEBUG, &743:          CALL MINPERMDIST(XYZ((J2-2)*NOPT+1:(J2-1)*NOPT),XYZ((J2-1)*NOPT+1:J2*NOPT),NATOMS,LDEBUG, &
744:   &                    PARAM1,PARAM2,PARAM3,BULKT,TWOD,DISTANCE,DIST2,RIGIDBODY,RMAT)744:   &                    PARAM1,PARAM2,PARAM3,BULKT,TWOD,D,DIST2,RIGIDBODY,RMAT)
745:       ENDDO745:       ENDDO
746:    ENDIF746:    ENDIF
747:    IF (.NOT.SWITCHED) THEN747:    IF (.NOT.SWITCHED) THEN
748:       IF (MOD(NITERDONE,CHECKREPINTERVAL).EQ.0) CALL CHECKREP(INTIMAGE,XYZ,NOPT,0,1)748:       IF (MOD(NITERDONE,CHECKREPINTERVAL).EQ.0) CALL CHECKREP(INTIMAGE,XYZ,NOPT,0,1)
749:       IF (CHECKCONINT) THEN749:       IF (CHECKCONINT) THEN
750:          CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)750:          CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
751:       ELSE751:       ELSE
752:          CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)752:          CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
753:       ENDIF753:       ENDIF
754:       IF ((ETOTAL-EOLD.LT.1.0D100).OR.ADDATOM) THEN ! MAXERISE effectively set to 1.0D100 here754:       IF ((ETOTAL-EOLD.LT.1.0D100).OR.ADDATOM) THEN ! MAXERISE effectively set to 1.0D100 here
1462:                M2=MIN(STARTID,FINISHID)1462:                M2=MIN(STARTID,FINISHID)
1463:                NIMAGE=(DTOTAL+(J3-NSIDE-1)*DINCREMENT-DISTPREV)*(IMAGEDENSITY+IMAGEINCR*MI(M1)%DATA%NTRIES(M2))1463:                NIMAGE=(DTOTAL+(J3-NSIDE-1)*DINCREMENT-DISTPREV)*(IMAGEDENSITY+IMAGEINCR*MI(M1)%DATA%NTRIES(M2))
1464: 1464: 
1465:                IF (NIMAGE >= IMAGEMAX) NIMAGE=IMAGEMAX1465:                IF (NIMAGE >= IMAGEMAX) NIMAGE=IMAGEMAX
1466:                IF (NIMAGE >= IMAGEMAX) MI(MAX(STARTID,FINISHID))%DATA%NTRIES(MIN(STARTID,FINISHID))=NTRIESMAX1466:                IF (NIMAGE >= IMAGEMAX) MI(MAX(STARTID,FINISHID))%DATA%NTRIES(MIN(STARTID,FINISHID))=NTRIESMAX
1467:                IF (NIMAGE < 2 ) NIMAGE=21467:                IF (NIMAGE < 2 ) NIMAGE=2
1468:                NITERMAX=NIMAGE*ITERDENSITY 1468:                NITERMAX=NIMAGE*ITERDENSITY 
1469:                PRINT '(A,I8,G20.10,2F12.2,I8)',' NIMAGE,dist,IMAGEDENSITY,IMAGEINCR,NATTEMPTS=', &1469:                PRINT '(A,I8,G20.10,2F12.2,I8)',' NIMAGE,dist,IMAGEDENSITY,IMAGEINCR,NATTEMPTS=', &
1470:   &                NIMAGE,DTOTAL-DISTPREV,IMAGEDENSITY,IMAGEINCR,MI(M1)%DATA%NTRIES(M2)1470:   &                NIMAGE,DTOTAL-DISTPREV,IMAGEDENSITY,IMAGEINCR,MI(M1)%DATA%NTRIES(M2)
1471: 1471: 
1472: !              CALL MINPERMDIST(CMIN1,LOCALCOORDS,NATOMS,DEBUG,PARAM1,PARAM2,PARAM3,BULKT,TWOD,DISTANCE,DIST2, &1472: !              CALL MINPERMDIST(CMIN1,LOCALCOORDS,NATOMS,DEBUG,PARAM1,PARAM2,PARAM3,BULKT,TWOD,D,DIST2, &
1473: !  &                             RIGIDBODY,RMAT)1473: !  &                             RIGIDBODY,RMAT)
1474:                CALL MAKEINTNEBIMAGES(NIMAGE,INTIMAGE,DINCREMENT,DISTPREV,DTOTAL+(J3-NSIDE-1)*DINCREMENT,XYZ)1474:                CALL MAKEINTNEBIMAGES(NIMAGE,INTIMAGE,DINCREMENT,DISTPREV,DTOTAL+(J3-NSIDE-1)*DINCREMENT,XYZ)
1475:                PRINT '(A,2I6,A,G12.4,A,3I6)',' intlbfgs> DNEB for minima ',STARTID,FINISHID,' dist=', &1475:                PRINT '(A,2I6,A,G12.4,A,3I6)',' intlbfgs> DNEB for minima ',STARTID,FINISHID,' dist=', &
1476:   &                        DTOTAL+(J3-NSIDE-1)*DINCREMENT-DISTPREV,' Attempts, images and iterations=', &1476:   &                        DTOTAL+(J3-NSIDE-1)*DINCREMENT-DISTPREV,' Attempts, images and iterations=', &
1477:   &                                   MI(M1)%DATA%NTRIES(M2), NIMAGE, NITERMAX1477:   &                                   MI(M1)%DATA%NTRIES(M2), NIMAGE, NITERMAX
1478:                MI(M1)%DATA%NTRIES(M2)=MI(M1)%DATA%NTRIES(M2)+11478:                MI(M1)%DATA%NTRIES(M2)=MI(M1)%DATA%NTRIES(M2)+1
1479:                TSRESET=.FALSE.1479:                TSRESET=.FALSE.
1480:                IF (LTSFOUND.EQ.0) TSRESET=.TRUE.1480:                IF (LTSFOUND.EQ.0) TSRESET=.TRUE.
1481:                CALL NEWNEB(.FALSE.,DUMMY2,EMINPREV,CMIN1,EDUMMY,LOCALCOORDS,TSRESET)1481:                CALL NEWNEB(.FALSE.,DUMMY2,EMINPREV,CMIN1,EDUMMY,LOCALCOORDS,TSRESET)
1482:                LTSFOUND=NTSFOUND1482:                LTSFOUND=NTSFOUND
1532:       NIMAGE=(DTOTAL-DISTPREV)*(IMAGEDENSITY+IMAGEINCR*MI(M1)%DATA%NTRIES(M2))1532:       NIMAGE=(DTOTAL-DISTPREV)*(IMAGEDENSITY+IMAGEINCR*MI(M1)%DATA%NTRIES(M2))
1533: 1533: 
1534:       IF (NIMAGE >= IMAGEMAX) NIMAGE=IMAGEMAX1534:       IF (NIMAGE >= IMAGEMAX) NIMAGE=IMAGEMAX
1535:       IF (NIMAGE >= IMAGEMAX) MI(M1)%DATA%NTRIES(M2)=NTRIESMAX1535:       IF (NIMAGE >= IMAGEMAX) MI(M1)%DATA%NTRIES(M2)=NTRIESMAX
1536:       IF (NIMAGE < 2 ) NIMAGE=21536:       IF (NIMAGE < 2 ) NIMAGE=2
1537:       NITERMAX=NIMAGE*ITERDENSITY 1537:       NITERMAX=NIMAGE*ITERDENSITY 
1538: 1538: 
1539:       PRINT '(A,I8,G20.10,2F12.2,I8)',' NIMAGE,dist,IMAGEDENSITY,IMAGEINCR,NATTEMPTS=', &1539:       PRINT '(A,I8,G20.10,2F12.2,I8)',' NIMAGE,dist,IMAGEDENSITY,IMAGEINCR,NATTEMPTS=', &
1540:   &                 NIMAGE,DTOTAL-DISTPREV,IMAGEDENSITY,IMAGEINCR,MI(M1)%DATA%NTRIES(M2)1540:   &                 NIMAGE,DTOTAL-DISTPREV,IMAGEDENSITY,IMAGEINCR,MI(M1)%DATA%NTRIES(M2)
1541: 1541: 
1542: !  CALL MINPERMDIST(CMIN1,LOCALCOORDS,NATOMS,DEBUG,PARAM1,PARAM2,PARAM3,BULKT,TWOD,DISTANCE,DIST2,RIGIDBODY,RMAT)1542: !  CALL MINPERMDIST(CMIN1,LOCALCOORDS,NATOMS,DEBUG,PARAM1,PARAM2,PARAM3,BULKT,TWOD,D,DIST2,RIGIDBODY,RMAT)
1543:       CALL MAKEINTNEBIMAGES(NIMAGE,INTIMAGE,DINCREMENT,DISTPREV,DTOTAL,XYZ)1543:       CALL MAKEINTNEBIMAGES(NIMAGE,INTIMAGE,DINCREMENT,DISTPREV,DTOTAL,XYZ)
1544:       PRINT '(A,2I6,A,G12.4,A,3I6)',' intlbfgs> DNEB run for minima ',STARTID,FINISHID,' dist=', &1544:       PRINT '(A,2I6,A,G12.4,A,3I6)',' intlbfgs> DNEB run for minima ',STARTID,FINISHID,' dist=', &
1545:   &       DTOTAL-DISTPREV,' Attempts, images and iterations=', &1545:   &       DTOTAL-DISTPREV,' Attempts, images and iterations=', &
1546:   &          MI(M1)%DATA%NTRIES(M2), NIMAGE, NITERMAX1546:   &          MI(M1)%DATA%NTRIES(M2), NIMAGE, NITERMAX
1547: 1547: 
1548:       MI(M1)%DATA%NTRIES(M2)=MI(M1)%DATA%NTRIES(M2)+11548:       MI(M1)%DATA%NTRIES(M2)=MI(M1)%DATA%NTRIES(M2)+1
1549:       TSRESET=.FALSE.1549:       TSRESET=.FALSE.
1550:       IF (LTSFOUND.EQ.0) TSRESET=.TRUE.1550:       IF (LTSFOUND.EQ.0) TSRESET=.TRUE.
1551:       CALL NEWNEB(.FALSE.,DUMMY2,EMINPREV,CMIN1,EDUMMY,LOCALCOORDS,TSRESET)1551:       CALL NEWNEB(.FALSE.,DUMMY2,EMINPREV,CMIN1,EDUMMY,LOCALCOORDS,TSRESET)
1552:       DEALLOCATE(INTNEBIMAGES)1552:       DEALLOCATE(INTNEBIMAGES)
2435: END SUBROUTINE DOADDATOM2435: END SUBROUTINE DOADDATOM
2436: 2436: 
2437: SUBROUTINE CHECKPERC(LXYZ,LINTCONSTRAINTTOL,NQCIFREEZE,NCPFIT)2437: SUBROUTINE CHECKPERC(LXYZ,LINTCONSTRAINTTOL,NQCIFREEZE,NCPFIT)
2438: USE KEY, ONLY : ATOMACTIVE, NCONSTRAINT, INTFROZEN, CONI, CONJ, CONDISTREF, INTCONMAX, INTCONSTRAINTTOL, &2438: USE KEY, ONLY : ATOMACTIVE, NCONSTRAINT, INTFROZEN, CONI, CONJ, CONDISTREF, INTCONMAX, INTCONSTRAINTTOL, &
2439:   &             INTCONSEP, INTFREEZET, NCONGEOM, CONGEOM, CONIFIX, CONJFIX, CONDISTREFFIX, &2439:   &             INTCONSEP, INTFREEZET, NCONGEOM, CONGEOM, CONIFIX, CONJFIX, CONDISTREFFIX, &
2440:   &             NCONSTRAINTFIX, BULKT, TWOD, RIGIDBODY, CONDATT, CONCUT, CONCUTFIX2440:   &             NCONSTRAINTFIX, BULKT, TWOD, RIGIDBODY, CONDATT, CONCUT, CONCUTFIX
2441: USE COMMONS, ONLY: NATOMS, DEBUG, NOPT, PARAM1, PARAM2, PARAM32441: USE COMMONS, ONLY: NATOMS, DEBUG, NOPT, PARAM1, PARAM2, PARAM3
2442: IMPLICIT NONE2442: IMPLICIT NONE
2443: INTEGER NDIST1(NATOMS), NCYCLE, DMIN1, DMAX1, NUNCON1, J1, J2, J3, NQCIFREEZE, J4, NCPFIT2443: INTEGER NDIST1(NATOMS), NCYCLE, DMIN1, DMAX1, NUNCON1, J1, J2, J3, NQCIFREEZE, J4, NCPFIT
2444: DOUBLE PRECISION LINTCONSTRAINTTOL, MAXCONDIST, MINCONDIST, DS, DF, LXYZ(NOPT*2)2444: DOUBLE PRECISION LINTCONSTRAINTTOL, MAXCONDIST, MINCONDIST, DS, DF, LXYZ(NOPT*2)
2445: DOUBLE PRECISION DSMIN, DSMAX, DSMEAN, DISTANCE, DIST2, RMAT(3,3)2445: DOUBLE PRECISION DSMIN, DSMAX, DSMEAN, D, DIST2, RMAT(3,3)
2446: LOGICAL CHANGED2446: LOGICAL CHANGED
2447: LOGICAL :: CALLED=.FALSE.2447: LOGICAL :: CALLED=.FALSE.
2448: SAVE CALLED2448: SAVE CALLED
2449: 2449: 
2450: LINTCONSTRAINTTOL=INTCONSTRAINTTOL2450: LINTCONSTRAINTTOL=INTCONSTRAINTTOL
2451: 2451: 
2452: IF (.NOT.ALLOCATED(ATOMACTIVE)) ALLOCATE(ATOMACTIVE(NATOMS))2452: IF (.NOT.ALLOCATED(ATOMACTIVE)) ALLOCATE(ATOMACTIVE(NATOMS))
2453: !2453: !
2454: ! Fixed constraints based on congeom file entries2454: ! Fixed constraints based on congeom file entries
2455: ! Just need to adjust the list based on any frozen atoms. We2455: ! Just need to adjust the list based on any frozen atoms. We
2490:       ENDDO2490:       ENDDO
2491:       NCONSTRAINT=J22491:       NCONSTRAINT=J2
2492:       PRINT '(A,I6,A)',' checkperc> After allowing for frozen atoms there are ',NCONSTRAINT,' constraints'2492:       PRINT '(A,I6,A)',' checkperc> After allowing for frozen atoms there are ',NCONSTRAINT,' constraints'
2493:       RETURN 2493:       RETURN 
2494:    ELSE2494:    ELSE
2495: !2495: !
2496: ! Put reference minima in optimal permutational alignment with reference minimum one.2496: ! Put reference minima in optimal permutational alignment with reference minimum one.
2497: !2497: !
2498:       DO J2=2,NCONGEOM2498:       DO J2=2,NCONGEOM
2499:          CALL MINPERMDIST(CONGEOM(1,1:3*NATOMS),CONGEOM(J2,1:3*NATOMS),NATOMS,DEBUG, &2499:          CALL MINPERMDIST(CONGEOM(1,1:3*NATOMS),CONGEOM(J2,1:3*NATOMS),NATOMS,DEBUG, &
2500:   &                       PARAM1,PARAM2,PARAM3,BULKT,TWOD,DISTANCE,DIST2,RIGIDBODY,RMAT)2500:   &                       PARAM1,PARAM2,PARAM3,BULKT,TWOD,D,DIST2,RIGIDBODY,RMAT)
2501:       ENDDO2501:       ENDDO
2502:    ENDIF2502:    ENDIF
2503:    ALLOCATE(CONIFIX(INTCONMAX),CONJFIX(INTCONMAX),CONCUTFIX(INTCONMAX),CONDISTREFFIX(INTCONMAX))2503:    ALLOCATE(CONIFIX(INTCONMAX),CONJFIX(INTCONMAX),CONCUTFIX(INTCONMAX),CONDISTREFFIX(INTCONMAX))
2504: ENDIF2504: ENDIF
2505: 2505: 
2506: 51   NCONSTRAINT=0 2506: 51   NCONSTRAINT=0 
2507: MAXCONDIST=-1.0D02507: MAXCONDIST=-1.0D0
2508: MINCONDIST=1.0D1002508: MINCONDIST=1.0D100
2509: IF (NCONGEOM.LT.2) THEN 2509: IF (NCONGEOM.LT.2) THEN 
2510:    DO J2=1,NATOMS2510:    DO J2=1,NATOMS


r29791/keywords.f 2016-01-21 22:30:07.835313392 +0000 r29790/keywords.f 2016-01-21 22:30:12.735378989 +0000
3699:          IF (NMLP.NE.NATOMS) THEN3699:          IF (NMLP.NE.NATOMS) THEN
3700:             PRINT '(A,2I8)', 'keywords> ERROR *** NATOMS,NMLP=',NATOMS,NMLP3700:             PRINT '(A,2I8)', 'keywords> ERROR *** NATOMS,NMLP=',NATOMS,NMLP
3701:             STOP3701:             STOP
3702:          ENDIF3702:          ENDIF
3703:          LUNIT=GETUNIT()3703:          LUNIT=GETUNIT()
3704:          OPEN(LUNIT,FILE='MLPdata',STATUS='OLD')3704:          OPEN(LUNIT,FILE='MLPdata',STATUS='OLD')
3705:          ALLOCATE(MLPDAT(MLPDATA,MLPIN),MLPOUTCOME(MLPDATA))3705:          ALLOCATE(MLPDAT(MLPDATA,MLPIN),MLPOUTCOME(MLPDATA))
3706:          DO J1=1,MLPDATA3706:          DO J1=1,MLPDATA
3707:             READ(LUNIT,*) MLPDAT(J1,1:MLPIN),MLPOUTCOME(J1)3707:             READ(LUNIT,*) MLPDAT(J1,1:MLPIN),MLPOUTCOME(J1)
3708:             MLPOUTCOME(J1)=MLPOUTCOME(J1)+1 ! to shift the range to 1 to 43708:             MLPOUTCOME(J1)=MLPOUTCOME(J1)+1 ! to shift the range to 1 to 4
3709: !           WRITE(*,'(9G15.5,I8)') MLPDAT(J1,1:MLPIN),MLPOUTCOME(J1)3709:             WRITE(*,'(9G15.5,I8)') MLPDAT(J1,1:MLPIN),MLPOUTCOME(J1)
3710:          ENDDO3710:          ENDDO
3711: ! 3711: ! 
3712: ! MODE n  specifies the eigenvector to follow                  - default n=03712: ! MODE n  specifies the eigenvector to follow                  - default n=0
3713: ! 3713: ! 
3714:          ELSE IF (WORD.EQ.'MODE') THEN3714:          ELSE IF (WORD.EQ.'MODE') THEN
3715:             CALL READI(IVEC)3715:             CALL READI(IVEC)
3716:             IF (NITEMS.GT.2) THEN3716:             IF (NITEMS.GT.2) THEN
3717:                CALL READI(IVEC2)3717:                CALL READI(IVEC2)
3718:             ELSE3718:             ELSE
3719:                ! IVEC2=IVEC3719:                ! IVEC2=IVEC


r29791/lbfgs.f90 2016-01-21 22:30:05.647284104 +0000 r29790/lbfgs.f90 2016-01-21 22:30:10.251345734 +0000
 28:      USE NEBUTILS 28:      USE NEBUTILS
 29:      USE GRADIENTS 29:      USE GRADIENTS
 30:      USE NEBOUTPUT 30:      USE NEBOUTPUT
 31:      USE PORFUNCS 31:      USE PORFUNCS
 32:      USE MODCHARMM, ONLY : CHRMMT,CHECKOMEGAT 32:      USE MODCHARMM, ONLY : CHRMMT,CHECKOMEGAT
 33:      USE KEY, ONLY : FREEZENODEST, FREEZETOL, DESMDEBUG, MAXNEBBFGS, NEBMUPDATE, NEBDGUESS, & 33:      USE KEY, ONLY : FREEZENODEST, FREEZETOL, DESMDEBUG, MAXNEBBFGS, NEBMUPDATE, NEBDGUESS, &
 34:           & DESMAXEJUMP,INTEPSILON, DESMAXAVGE, KADJUSTFRAC, KADJUSTFRQ, DNEBSWITCH, KADJUSTTOL, NEBRESEEDT, & 34:           & DESMAXEJUMP,INTEPSILON, DESMAXAVGE, KADJUSTFRAC, KADJUSTFRQ, DNEBSWITCH, KADJUSTTOL, NEBRESEEDT, &
 35:           & NEBRESEEDINT, NEBRESEEDEMAX, NEBRESEEDBMAX, NEBKFINAL, NEBFACTOR, & 35:           & NEBRESEEDINT, NEBRESEEDEMAX, NEBRESEEDBMAX, NEBKFINAL, NEBFACTOR, &
 36:           & NREPMAX, ORDERI, ORDERJ, EPSALPHA, NREPULSIVE, DISTREF, ADDREPT, NEBKINITIAL, & 36:           & NREPMAX, ORDERI, ORDERJ, EPSALPHA, NREPULSIVE, DISTREF, ADDREPT, NEBKINITIAL, &
 37:           & NEBRESEEDDEL1, NEBRESEEDDEL2, NEBRESEEDPOW1, NEBRESEEDPOW2, REPPOW, & 37:           & NEBRESEEDDEL1, NEBRESEEDDEL2, NEBRESEEDPOW1, NEBRESEEDPOW2, REPPOW, &
 38:           & BULKT, REDOTSIM, NREPMAX, COLDFUSIONLIMIT, DNEBEFRAC, VARIABLES 38:           & BULKT, REDOTSIM, NREPMAX, COLDFUSIONLIMIT, DNEBEFRAC
 39:      USE INTCOMMONS, ONLY : DESMINT, NNZ, KD, NINTC, PREVDIH, DIHINFO 39:      USE INTCOMMONS, ONLY : DESMINT, NNZ, KD, NINTC, PREVDIH, DIHINFO
 40:      USE COMMONS, ONLY: REDOPATHNEB 40:      USE COMMONS, ONLY: REDOPATHNEB
 41: ! hk286 41: ! hk286
 42:      USE GENRIGID 42:      USE GENRIGID
 43:  43: 
 44:      IMPLICIT NONE  44:      IMPLICIT NONE 
 45:  45: 
 46:      INTEGER,INTENT(IN) :: D,U  ! DIMENSIONALITY OF THE PROBLEM AND NUMBER OF UPDATES 46:      INTEGER,INTENT(IN) :: D,U  ! DIMENSIONALITY OF THE PROBLEM AND NUMBER OF UPDATES
 47:      INTEGER NPERSIST           ! number of persistent minima 47:      INTEGER NPERSIST           ! number of persistent minima
 48:      INTEGER PERSISTTHRESH      ! persistence threshold 48:      INTEGER PERSISTTHRESH      ! persistence threshold
 52:      DOUBLE PRECISION DIJ, DMAX, DS, DF, EWORST, EMAX, BESTE 52:      DOUBLE PRECISION DIJ, DMAX, DS, DF, EWORST, EMAX, BESTE
 53:      DOUBLE PRECISION, ALLOCATABLE :: REPTEMP(:) 53:      DOUBLE PRECISION, ALLOCATABLE :: REPTEMP(:)
 54:      INTEGER, ALLOCATABLE :: IREPTEMP(:) 54:      INTEGER, ALLOCATABLE :: IREPTEMP(:)
 55:      INTEGER MAXIM, NDECREASE, NFAIL 55:      INTEGER MAXIM, NDECREASE, NFAIL
 56:      LOGICAL KNOWE, KNOWG, KNOWH, ADDATOM 56:      LOGICAL KNOWE, KNOWG, KNOWH, ADDATOM
 57:      COMMON /KNOWN/ KNOWE, KNOWG, KNOWH 57:      COMMON /KNOWN/ KNOWE, KNOWG, KNOWH
 58:  58: 
 59:      INTEGER :: J2,POINT,BOUND,NPT,CP,I,ISTAT,J1,JMINUS,JPLUS,J3,JDO,J4,NPEPFAIL,NBADTOTAL 59:      INTEGER :: J2,POINT,BOUND,NPT,CP,I,ISTAT,J1,JMINUS,JPLUS,J3,JDO,J4,NPEPFAIL,NBADTOTAL
 60:      INTEGER AT1(NATOMS),AT2(NATOMS),AT3(NATOMS),AT4(NATOMS) 60:      INTEGER AT1(NATOMS),AT2(NATOMS),AT3(NATOMS),AT4(NATOMS)
 61:      DOUBLE PRECISION :: YS,YY,SQ,YR,BETA,GNORM,DDOT,DUMMY,STPMIN,PREVGRAD,MEANSEP,EMINUS,EPLUS, & 61:      DOUBLE PRECISION :: YS,YY,SQ,YR,BETA,GNORM,DDOT,DUMMY,STPMIN,PREVGRAD,MEANSEP,EMINUS,EPLUS, &
 62:   &                      LCOORDS(NOPT), ENERGY, INVDTOACTIVE(NATOMS), STIME 62:   &                      LCOORDS(3*NATOMS), ENERGY, INVDTOACTIVE(NATOMS), STIME
 63:      DOUBLE PRECISION,DIMENSION(D)     :: GTMP,DIAG,STP 63:      DOUBLE PRECISION,DIMENSION(D)     :: GTMP,DIAG,STP
 64:      DOUBLE PRECISION,DIMENSION(U)     :: RHO1,ALPHA 64:      DOUBLE PRECISION,DIMENSION(U)     :: RHO1,ALPHA
 65:      DOUBLE PRECISION,DIMENSION(0:U,D) :: SEARCHSTEP,GDIF 65:      DOUBLE PRECISION,DIMENSION(0:U,D) :: SEARCHSTEP,GDIF
 66:  66: 
 67:      ! efk: for freezenodes 67:      ! efk: for freezenodes
 68:      DOUBLE PRECISION :: TESTG, TOTGNORM 68:      DOUBLE PRECISION :: TESTG, TOTGNORM
 69:      INTEGER :: IM 69:      INTEGER :: IM
 70:  70: 
 71:      ! efk: for internals 71:      ! efk: for internals
 72:      LOGICAL :: FAILED, INTPTEST, SKIPPED, AMIDEFAIL 72:      LOGICAL :: FAILED, INTPTEST, SKIPPED, AMIDEFAIL
 73:      DOUBLE PRECISION :: STEPCART(NOPT), AVGE, COORDS(NOPT) 73:      DOUBLE PRECISION :: STEPCART(3*NATOMS), AVGE, COORDS(3*NATOMS)
 74:      DOUBLE PRECISION :: TMPRMS, TESTE, LGDUMMY(NOPT) 74:      DOUBLE PRECISION :: TMPRMS, TESTE, LGDUMMY(3*NATOMS)
 75:  75: 
 76:      CALL MYCPU_TIME(STIME,.FALSE.) 76:      CALL MYCPU_TIME(STIME,.FALSE.)
 77:  77: 
 78:      NTIMESMIN(1:NIMAGE)=0 ! number of consecutive steps the image is identified as a local minimum in the profile 78:      NTIMESMIN(1:NIMAGE)=0 ! number of consecutive steps the image is identified as a local minimum in the profile
 79: !    PERSISTTHRESH=50      ! persistence identification threshold 79: !    PERSISTTHRESH=50      ! persistence identification threshold
 80:      PERSISTTHRESH=HUGE(1)      ! persistence identification threshold 80:      PERSISTTHRESH=HUGE(1)      ! persistence identification threshold
 81:      NPERSIST=0 81:      NPERSIST=0
 82:      PREVGRAD=1.0D100 82:      PREVGRAD=1.0D100
 83:      INTPTEST = .FALSE. 83:      INTPTEST = .FALSE.
 84:      IF (DESMDEBUG) MOREPRINTING = .TRUE. 84:      IF (DESMDEBUG) MOREPRINTING = .TRUE.
227:            ENDIF227:            ENDIF
228:         ENDDO228:         ENDDO
229:      ENDIF229:      ENDIF
230:      !  We now have the proposed step - update geometry and calculate new gradient230:      !  We now have the proposed step - update geometry and calculate new gradient
231:      IF (DESMINT) THEN231:      IF (DESMINT) THEN
232:         DO IM = 1,NIMAGE232:         DO IM = 1,NIMAGE
233:            FAILED = .TRUE.233:            FAILED = .TRUE.
234:            DO WHILE (FAILED)234:            DO WHILE (FAILED)
235:               PREVDIH => DIHINFO(IM+1,:)235:               PREVDIH => DIHINFO(IM+1,:)
236:               CALL TRANSBACKDELTA(STP(NOPT*(IM-1)+1:NOPT*IM)*SEARCHSTEP(POINT,NOPT*(IM-1)+1:NOPT*IM),&236:               CALL TRANSBACKDELTA(STP(NOPT*(IM-1)+1:NOPT*IM)*SEARCHSTEP(POINT,NOPT*(IM-1)+1:NOPT*IM),&
237:                    & STEPCART,XCART(NOPT*(IM-1)+1:NOPT*IM),NINTC, &237:                    & STEPCART,XCART(3*NATOMS*(IM-1)+1:3*NATOMS*IM),NINTC, &
238:                    & NOPT,NNZ,KD,FAILED,INTPTEST,INTEPSILON)238:                    & 3*NATOMS,NNZ,KD,FAILED,INTPTEST,INTEPSILON)
239:               CALL POTENTIAL(XCART(NOPT*(IM-1)+1:NOPT*IM) +STEPCART,TESTE,LGDUMMY,.FALSE.,.FALSE.,TMPRMS,.FALSE.,.FALSE.)239:               CALL POTENTIAL(XCART(3*NATOMS*(IM-1)+1:3*NATOMS*IM) +STEPCART,TESTE,LGDUMMY,.FALSE.,.FALSE.,TMPRMS,.FALSE.,.FALSE.)
240: 240: 
241:               IF (TESTE-EEE(IM+1).GT.DESMAXEJUMP.AND.EEE(IM+1).LT.0) THEN241:               IF (TESTE-EEE(IM+1).GT.DESMAXEJUMP.AND.EEE(IM+1).LT.0) THEN
242:                  IF (MOREPRINTING) print*, 'Too great an energy increase, skip image.', IM, TESTE, EEE(IM+1)242:                  IF (MOREPRINTING) print*, 'Too great an energy increase, skip image.', IM, TESTE, EEE(IM+1)
243:                  STP(NOPT*(IM-1)+1:NOPT*IM) = 0.0D0     243:                  STP(NOPT*(IM-1)+1:NOPT*IM) = 0.0D0     
244:                  STEPIMAGE(IM) = 0.0D0244:                  STEPIMAGE(IM) = 0.0D0
245:                  SKIPPED = .TRUE.245:                  SKIPPED = .TRUE.
246:               ENDIF246:               ENDIF
247:               IF (FAILED) THEN247:               IF (FAILED) THEN
248:                  STP(NOPT*(IM-1)+1:NOPT*IM) = STP(NOPT*(IM-1)+1:NOPT*IM)*0.1D0        248:                  STP(NOPT*(IM-1)+1:NOPT*IM) = STP(NOPT*(IM-1)+1:NOPT*IM)*0.1D0        
249:                  STEPIMAGE(IM) = STEPIMAGE(IM)*0.1D0249:                  STEPIMAGE(IM) = STEPIMAGE(IM)*0.1D0
250:                  IF (MOREPRINTING) print*, 'neblbfgs>> Decreasing step to ', IM, STEPIMAGE(IM)                 250:                  IF (MOREPRINTING) print*, 'neblbfgs>> Decreasing step to ', IM, STEPIMAGE(IM)                 
251:               ENDIF251:               ENDIF
252:            ENDDO252:            ENDDO
253:            IF (.NOT.SKIPPED) XCART(NOPT*(IM-1)+1:NOPT*IM) = XCART(NOPT*(IM-1)+1:NOPT*IM) +STEPCART253:            IF (.NOT.SKIPPED) XCART(3*NATOMS*(IM-1)+1:3*NATOMS*IM) = XCART(3*NATOMS*(IM-1)+1:3*NATOMS*IM) +STEPCART
254:            SKIPPED = .FALSE.254:            SKIPPED = .FALSE.
255:         ENDDO255:         ENDDO
256:      ENDIF256:      ENDIF
257:      NDECREASE=0257:      NDECREASE=0
258: 20   X(1:D) = X(1:D) + STP(1:D)*SEARCHSTEP(POINT,1:D)258: 20   X(1:D) = X(1:D) + STP(1:D)*SEARCHSTEP(POINT,1:D)
259: 259: 
260:      IF (PREVGRAD.LT.DNEBSWITCH) THEN260:      IF (PREVGRAD.LT.DNEBSWITCH) THEN
261:         CALL OLDNEBGRADIENT261:         CALL OLDNEBGRADIENT
262:      ELSE262:      ELSE
263:         CALL NEBGRADIENT263:         CALL NEBGRADIENT
391:         NPEPFAIL=0391:         NPEPFAIL=0
392:         NBADTOTAL=0392:         NBADTOTAL=0
393:         DO J1=1,NIMAGE+2393:         DO J1=1,NIMAGE+2
394:            IF (CHRMMT.AND.CHECKOMEGAT) THEN 394:            IF (CHRMMT.AND.CHECKOMEGAT) THEN 
395:                AMIDEFAIL=.FALSE.395:                AMIDEFAIL=.FALSE.
396: ! hk286 396: ! hk286 
397:                IF (RIGIDINIT) THEN397:                IF (RIGIDINIT) THEN
398:                   CALL TRANSFORMRIGIDTOC (1, NRIGIDBODY, COORDS(1:3*NATOMS), XYZ((J1-1)*3*NATOMS+1:(J1-1)*3*NATOMS+DEGFREEDOMS))398:                   CALL TRANSFORMRIGIDTOC (1, NRIGIDBODY, COORDS(1:3*NATOMS), XYZ((J1-1)*3*NATOMS+1:(J1-1)*3*NATOMS+DEGFREEDOMS))
399:                ELSE399:                ELSE
400: ! hk286400: ! hk286
401:                   COORDS(1:NOPT)=XYZ((J1-1)*NOPT+1:J1*NOPT)401:                   COORDS(1:NOPT)=XYZ((J1-1)*3*NATOMS+1:J1*3*NATOMS)
402:                ENDIF402:                ENDIF
403: !              CALL CHECKOMEGA(COORDS,AMIDEFAIL)403: !              CALL CHECKOMEGA(COORDS,AMIDEFAIL)
404:                CALL DJWCHECKOMEGA(COORDS,AMIDEFAIL,NPEPFAIL,AT1,AT2,AT3,AT4)404:                CALL DJWCHECKOMEGA(COORDS,AMIDEFAIL,NPEPFAIL,AT1,AT2,AT3,AT4)
405:                IF (AMIDEFAIL) THEN405:                IF (AMIDEFAIL) THEN
406:                   PRINT '(2(A,I6))',' potential> WARNING *** cis peptide bond(s) detected for image ',J1,' total=',NPEPFAIL406:                   PRINT '(2(A,I6))',' potential> WARNING *** cis peptide bond(s) detected for image ',J1,' total=',NPEPFAIL
407:                   BADPEPTIDE(J1)=.TRUE.407:                   BADPEPTIDE(J1)=.TRUE.
408:               ENDIF408:               ENDIF
409:            ENDIF409:            ENDIF
410:            IF (EEE(J1).GT.NEBRESEEDEMAX) BADIMAGE(J1)=.TRUE.410:            IF (EEE(J1).GT.NEBRESEEDEMAX) BADIMAGE(J1)=.TRUE.
411:            IF ((EEE(J1)-EEE(1).GT.NEBRESEEDBMAX).AND.(EEE(J1)-EEE(NIMAGE+2).GT.NEBRESEEDBMAX)) BADIMAGE(J1)=.TRUE.411:            IF ((EEE(J1)-EEE(1).GT.NEBRESEEDBMAX).AND.(EEE(J1)-EEE(NIMAGE+2).GT.NEBRESEEDBMAX)) BADIMAGE(J1)=.TRUE.
412:            IF (BADIMAGE(J1).OR.BADPEPTIDE(J1)) NBADTOTAL=NBADTOTAL+1412:            IF (BADIMAGE(J1).OR.BADPEPTIDE(J1)) NBADTOTAL=NBADTOTAL+1
413:         ENDDO413:         ENDDO
414:         IF (BADIMAGE(1).OR.BADPEPTIDE(1)) PRINT '(A)','lbfgs> WARNING - bad starting image will not be replaced'414:         IF (BADIMAGE(1).OR.BADPEPTIDE(1)) PRINT '(A)','lbfgs> WARNING - bad starting image will not be replaced'
415:         IF (BADIMAGE(NIMAGE+2).OR.BADPEPTIDE(NIMAGE+2)) PRINT '(A)','lbfgs> WARNING - bad final image will not be replaced'415:         IF (BADIMAGE(NIMAGE+2).OR.BADPEPTIDE(NIMAGE+2)) PRINT '(A)','lbfgs> WARNING - bad final image will not be replaced'
416:         J1=2416:         J1=2
417:         imageloop: DO 417:         imageloop: DO 
418:            IF (BADIMAGE(J1).AND.(.NOT.VARIABLES)) THEN418:            IF (BADIMAGE(J1)) THEN
419:               DO J2=J1-1,1,-1419:               DO J2=J1-1,1,-1
420:                  IF ((.NOT.BADIMAGE(J2)).OR.(J2.EQ.1)) THEN420:                  IF ((.NOT.BADIMAGE(J2)).OR.(J2.EQ.1)) THEN
421:                     JMINUS=J2421:                     JMINUS=J2
422:                     EMINUS=EEE(J2)422:                     EMINUS=EEE(J2)
423:                     EXIT423:                     EXIT
424:                  ENDIF424:                  ENDIF
425:               ENDDO425:               ENDDO
426:               DO J2=J1+1,NIMAGE+2426:               DO J2=J1+1,NIMAGE+2
427:                  IF ((.NOT.BADIMAGE(J2)).OR.(J2.EQ.NIMAGE+2)) THEN427:                  IF ((.NOT.BADIMAGE(J2)).OR.(J2.EQ.NIMAGE+2)) THEN
428:                     JPLUS=J2428:                     JPLUS=J2
443:                     JDO=J2443:                     JDO=J2
444:                  ENDIF444:                  ENDIF
445:               ENDDO445:               ENDDO
446:               PRINT '(A,I6,A,G20.10)','lbfgs> highest bad image in this range is number ',JDO,' energy=',EEE(JDO)446:               PRINT '(A,I6,A,G20.10)','lbfgs> highest bad image in this range is number ',JDO,' energy=',EEE(JDO)
447:               DMAX=-1.0D0447:               DMAX=-1.0D0
448:               DO J2=1,NATOMS448:               DO J2=1,NATOMS
449:                  J3loop: DO J3=J2+1,NATOMS449:                  J3loop: DO J3=J2+1,NATOMS
450:                     DO J4=1,NREPULSIVE450:                     DO J4=1,NREPULSIVE
451:                        IF ((ORDERI(J4).EQ.J2).AND.(ORDERJ(J4).EQ.J3)) CYCLE J3loop451:                        IF ((ORDERI(J4).EQ.J2).AND.(ORDERJ(J4).EQ.J3)) CYCLE J3loop
452:                     ENDDO452:                     ENDDO
453:                     DIJ=SQRT((XYZ((JDO-1)*NOPT+3*(J2-1)+1)-XYZ((JDO-1)*NOPT+3*(J3-1)+1))**2 &453:                     DIJ=SQRT((XYZ((JDO-1)*3*NATOMS+3*(J2-1)+1)-XYZ((JDO-1)*3*NATOMS+3*(J3-1)+1))**2 &
454:   &                         +(XYZ((JDO-1)*NOPT+3*(J2-1)+2)-XYZ((JDO-1)*NOPT+3*(J3-1)+2))**2 &454:   &                         +(XYZ((JDO-1)*3*NATOMS+3*(J2-1)+2)-XYZ((JDO-1)*3*NATOMS+3*(J3-1)+2))**2 &
455:   &                         +(XYZ((JDO-1)*NOPT+3*(J2-1)+3)-XYZ((JDO-1)*NOPT+3*(J3-1)+3))**2) 455:   &                         +(XYZ((JDO-1)*3*NATOMS+3*(J2-1)+3)-XYZ((JDO-1)*3*NATOMS+3*(J3-1)+3))**2) 
456:                     DS =SQRT((XYZ(3*(J2-1)+1)-XYZ(3*(J3-1)+1))**2 &456:                     DS =SQRT((XYZ(3*(J2-1)+1)-XYZ(3*(J3-1)+1))**2 &
457:   &                         +(XYZ(3*(J2-1)+2)-XYZ(3*(J3-1)+2))**2 &457:   &                         +(XYZ(3*(J2-1)+2)-XYZ(3*(J3-1)+2))**2 &
458:   &                         +(XYZ(3*(J2-1)+3)-XYZ(3*(J3-1)+3))**2) 458:   &                         +(XYZ(3*(J2-1)+3)-XYZ(3*(J3-1)+3))**2) 
459:                     DF =SQRT((XYZ((NIMAGE+1)*NOPT+3*(J2-1)+1)-XYZ((NIMAGE+1)*NOPT+3*(J3-1)+1))**2 &459:                     DF =SQRT((XYZ((NIMAGE+1)*3*NATOMS+3*(J2-1)+1)-XYZ((NIMAGE+1)*3*NATOMS+3*(J3-1)+1))**2 &
460:   &                         +(XYZ((NIMAGE+1)*NOPT+3*(J2-1)+2)-XYZ((NIMAGE+1)*NOPT+3*(J3-1)+2))**2 &460:   &                         +(XYZ((NIMAGE+1)*3*NATOMS+3*(J2-1)+2)-XYZ((NIMAGE+1)*3*NATOMS+3*(J3-1)+2))**2 &
461:   &                         +(XYZ((NIMAGE+1)*NOPT+3*(J2-1)+3)-XYZ((NIMAGE+1)*NOPT+3*(J3-1)+3))**2) 461:   &                         +(XYZ((NIMAGE+1)*3*NATOMS+3*(J2-1)+3)-XYZ((NIMAGE+1)*3*NATOMS+3*(J3-1)+3))**2) 
462:                     DUMMY=MIN(ABS(DIJ-DF),ABS(DIJ-DS))/DIJ462:                     DUMMY=MIN(ABS(DIJ-DF),ABS(DIJ-DS))/DIJ
463: !463: !
464: !  We need DIJ to be less than both or greater than both distances in the end points.464: !  We need DIJ to be less than both or greater than both distances in the end points.
465: !465: !
466:                     IF (((DIJ-DF)*(DIJ-DS).GT.0.0D0).AND.(DUMMY.GT.DMAX)) THEN466:                     IF (((DIJ-DF)*(DIJ-DS).GT.0.0D0).AND.(DUMMY.GT.DMAX)) THEN
467:                        DMAX=DUMMY467:                        DMAX=DUMMY
468: !                      PRINT '(A,2I6,5G20.10)','lbfgs> I,J,DIJ,DS,DF,DUMMY=',J2,J3,DIJ,DS,DF,DUMMY468: !                      PRINT '(A,2I6,5G20.10)','lbfgs> I,J,DIJ,DS,DF,DUMMY=',J2,J3,DIJ,DS,DF,DUMMY
469:                     ENDIF469:                     ENDIF
470:                  ENDDO J3loop470:                  ENDDO J3loop
471:               ENDDO471:               ENDDO
472:               DO J2=1,NATOMS472:               DO J2=1,NATOMS
473:                  DO J3=J2+1,NATOMS473:                  DO J3=J2+1,NATOMS
474:                     DIJ=SQRT((XYZ((JDO-1)*NOPT+3*(J2-1)+1)-XYZ((JDO-1)*NOPT+3*(J3-1)+1))**2 &474:                     DIJ=SQRT((XYZ((JDO-1)*3*NATOMS+3*(J2-1)+1)-XYZ((JDO-1)*3*NATOMS+3*(J3-1)+1))**2 &
475:   &                         +(XYZ((JDO-1)*NOPT+3*(J2-1)+2)-XYZ((JDO-1)*NOPT+3*(J3-1)+2))**2 &475:   &                         +(XYZ((JDO-1)*3*NATOMS+3*(J2-1)+2)-XYZ((JDO-1)*3*NATOMS+3*(J3-1)+2))**2 &
476:   &                         +(XYZ((JDO-1)*NOPT+3*(J2-1)+3)-XYZ((JDO-1)*NOPT+3*(J3-1)+3))**2) 476:   &                         +(XYZ((JDO-1)*3*NATOMS+3*(J2-1)+3)-XYZ((JDO-1)*3*NATOMS+3*(J3-1)+3))**2) 
477:                     DS =SQRT((XYZ(3*(J2-1)+1)-XYZ(3*(J3-1)+1))**2 &477:                     DS =SQRT((XYZ(3*(J2-1)+1)-XYZ(3*(J3-1)+1))**2 &
478:   &                         +(XYZ(3*(J2-1)+2)-XYZ(3*(J3-1)+2))**2 &478:   &                         +(XYZ(3*(J2-1)+2)-XYZ(3*(J3-1)+2))**2 &
479:   &                         +(XYZ(3*(J2-1)+3)-XYZ(3*(J3-1)+3))**2) 479:   &                         +(XYZ(3*(J2-1)+3)-XYZ(3*(J3-1)+3))**2) 
480:                     DF =SQRT((XYZ((NIMAGE+1)*NOPT+3*(J2-1)+1)-XYZ((NIMAGE+1)*NOPT+3*(J3-1)+1))**2 &480:                     DF =SQRT((XYZ((NIMAGE+1)*3*NATOMS+3*(J2-1)+1)-XYZ((NIMAGE+1)*3*NATOMS+3*(J3-1)+1))**2 &
481:   &                         +(XYZ((NIMAGE+1)*NOPT+3*(J2-1)+2)-XYZ((NIMAGE+1)*NOPT+3*(J3-1)+2))**2 &481:   &                         +(XYZ((NIMAGE+1)*3*NATOMS+3*(J2-1)+2)-XYZ((NIMAGE+1)*3*NATOMS+3*(J3-1)+2))**2 &
482:   &                         +(XYZ((NIMAGE+1)*NOPT+3*(J2-1)+3)-XYZ((NIMAGE+1)*NOPT+3*(J3-1)+3))**2) 482:   &                         +(XYZ((NIMAGE+1)*3*NATOMS+3*(J2-1)+3)-XYZ((NIMAGE+1)*3*NATOMS+3*(J3-1)+3))**2) 
483:                     DUMMY=MIN(ABS(DIJ-DF),ABS(DIJ-DS))/DIJ483:                     DUMMY=MIN(ABS(DIJ-DF),ABS(DIJ-DS))/DIJ
484:                     IF ((DIJ-DF)*(DIJ-DS).GT.0.0D0) THEN484:                     IF ((DIJ-DF)*(DIJ-DS).GT.0.0D0) THEN
485:                        IF (DUMMY.GT.0.9D0*DMAX) THEN485:                        IF (DUMMY.GT.0.9D0*DMAX) THEN
486:                           NOTNEW=.FALSE.486:                           NOTNEW=.FALSE.
487:                           reploop: DO J4=1,NREPULSIVE487:                           reploop: DO J4=1,NREPULSIVE
488:                              IF ((ORDERI(J4).EQ.J2).AND.(ORDERJ(J4).EQ.J3)) THEN488:                              IF ((ORDERI(J4).EQ.J2).AND.(ORDERJ(J4).EQ.J3)) THEN
489:                                 NOTNEW=.TRUE.489:                                 NOTNEW=.TRUE.
490:                                 EXIT reploop 490:                                 EXIT reploop 
491:                              ENDIF491:                              ENDIF
492:                           ENDDO reploop492:                           ENDDO reploop
543: 888                          CONTINUE543: 888                          CONTINUE
544:                           ENDIF544:                           ENDIF
545:                        ENDIF545:                        ENDIF
546:                     ENDIF546:                     ENDIF
547:                  ENDDO547:                  ENDDO
548:               ENDDO548:               ENDDO
549: 549: 
550:               J2=JMINUS550:               J2=JMINUS
551:               IF (EPLUS.GT.EMINUS) J2=JPLUS551:               IF (EPLUS.GT.EMINUS) J2=JPLUS
552: 552: 
553:               X((JDO-2)*NOPT+1:(JDO-1)*NOPT)=XYZ((J2-1)*NOPT+1:J2*NOPT)553:               X((JDO-2)*3*NATOMS+1:(JDO-1)*3*NATOMS)=XYZ((J2-1)*3*NATOMS+1:J2*3*NATOMS)
554:               EIMAGE(JDO-1)=EIMAGE(J2-1)554:               EIMAGE(JDO-1)=EIMAGE(J2-1)
555:               PRINT '(A,I6,A,G20.10)','lbfgs> image ',JDO,' reinterpolated energy=',EIMAGE(JDO-1)555:               PRINT '(A,I6,A,G20.10)','lbfgs> image ',JDO,' reinterpolated energy=',EIMAGE(JDO-1)
556: !556: !
557: ! Change all the other bad images in this range.557: ! Change all the other bad images in this range.
558: !558: !
559:               DO J3=JMINUS+1,JDO-1559:               DO J3=JMINUS+1,JDO-1
560: !560: !
561: !  Reset to MINUS end point561: !  Reset to MINUS end point
562: !562: !
563:                  LCOORDS(1:NOPT)=XYZ((JMINUS-1)*NOPT+1:JMINUS*NOPT)563:                  LCOORDS(1:3*NATOMS)=XYZ((JMINUS-1)*3*NATOMS+1:JMINUS*3*NATOMS)
564: !                XYZ((J3-1)*NOPT+1:J3*NOPT)=LCOORDS(1:NOPT)564: !                XYZ((J3-1)*3*NATOMS+1:J3*3*NATOMS)=LCOORDS(1:3*NATOMS)
565:                  X((J3-2)*NOPT+1:(J3-1)*NOPT)=LCOORDS(1:NOPT)565:                  X((J3-2)*3*NATOMS+1:(J3-1)*3*NATOMS)=LCOORDS(1:3*NATOMS)
566:                  CALL POTENTIAL(LCOORDS,ENERGY,LGDUMMY,.FALSE.,.FALSE.,RMS,.FALSE.,.FALSE.)566:                  CALL POTENTIAL(LCOORDS,ENERGY,LGDUMMY,.FALSE.,.FALSE.,RMS,.FALSE.,.FALSE.)
567: !                EEE(J3)=ENERGY567: !                EEE(J3)=ENERGY
568:                  EIMAGE(J3-1)=ENERGY568:                  EIMAGE(J3-1)=ENERGY
569:                  PRINT '(A,I6,A,G20.10)','lbfgs> image ',J3,' reinterpolated energy=',ENERGY569:                  PRINT '(A,I6,A,G20.10)','lbfgs> image ',J3,' reinterpolated energy=',ENERGY
570:               ENDDO570:               ENDDO
571:               DO J3=JDO+1,JPLUS-1571:               DO J3=JDO+1,JPLUS-1
572: !572: !
573: !  Reset to PLUS end point573: !  Reset to PLUS end point
574: !574: !
575:                  LCOORDS(1:NOPT)=XYZ((JPLUS-1)*NOPT+1:JPLUS*NOPT)575:                  LCOORDS(1:3*NATOMS)=XYZ((JPLUS-1)*3*NATOMS+1:JPLUS*3*NATOMS)
576: !                XYZ((J3-1)*NOPT+1:J3*NOPT)=LCOORDS(1:NOPT)576: !                XYZ((J3-1)*3*NATOMS+1:J3*3*NATOMS)=LCOORDS(1:3*NATOMS)
577:                  X((J3-2)*NOPT+1:(J3-1)*NOPT)=LCOORDS(1:NOPT)577:                  X((J3-2)*3*NATOMS+1:(J3-1)*3*NATOMS)=LCOORDS(1:3*NATOMS)
578:                  CALL POTENTIAL(LCOORDS,ENERGY,LGDUMMY,.FALSE.,.FALSE.,RMS,.FALSE.,.FALSE.)578:                  CALL POTENTIAL(LCOORDS,ENERGY,LGDUMMY,.FALSE.,.FALSE.,RMS,.FALSE.,.FALSE.)
579: !                EEE(J3)=ENERGY579: !                EEE(J3)=ENERGY
580:                  EIMAGE(J3-1)=ENERGY580:                  EIMAGE(J3-1)=ENERGY
581:                  PRINT '(A,I6,A,G20.10)','lbfgs> image ',J3,' reinterpolated energy=',ENERGY581:                  PRINT '(A,I6,A,G20.10)','lbfgs> image ',J3,' reinterpolated energy=',ENERGY
582:               ENDDO582:               ENDDO
583: !             NEWNEBK(JMINUS:JPLUS-1)=NEBKINITIAL583: !             NEWNEBK(JMINUS:JPLUS-1)=NEBKINITIAL
584: !             PRINT '(A,G20.10)','lbfgs> for bad images DNEB force constants reset to ',NEBKINITIAL584: !             PRINT '(A,G20.10)','lbfgs> for bad images DNEB force constants reset to ',NEBKINITIAL
585:               J1=JPLUS+1585:               J1=JPLUS+1
586:            ELSE586:            ELSE
587:               J1=J1+1587:               J1=J1+1


r29791/minpermdist.f90 2016-01-21 22:30:08.059316389 +0000 r29790/minpermdist.f90 2016-01-21 22:30:12.947381828 +0000
 50: !  The centres of coordinates for COORDSA and COORDSB can be anywhere. On return, the 50: !  The centres of coordinates for COORDSA and COORDSB can be anywhere. On return, the
 51: !  centre of coordinates of COORDSA will be the same as for COORDSB, unless we 51: !  centre of coordinates of COORDSA will be the same as for COORDSB, unless we
 52: !  are doing an ion trap potential. 52: !  are doing an ion trap potential.
 53: ! 53: !
 54: SUBROUTINE MINPERMDIST(COORDSB,COORDSA,NATOMS,DEBUG,BOXLX,BOXLY,BOXLZ,BULKT,TWOD,DISTANCE,DIST2,RIGID,RMATBEST) 54: SUBROUTINE MINPERMDIST(COORDSB,COORDSA,NATOMS,DEBUG,BOXLX,BOXLY,BOXLZ,BULKT,TWOD,DISTANCE,DIST2,RIGID,RMATBEST)
 55: USE KEY,ONLY : NPERMGROUP, NPERMSIZE, PERMGROUP, NSETS, SETS, STOCKT, GEOMDIFFTOL, AMBERT, & 55: USE KEY,ONLY : NPERMGROUP, NPERMSIZE, PERMGROUP, NSETS, SETS, STOCKT, GEOMDIFFTOL, AMBERT, &
 56:   &            NFREEZE, NABT, RBAAT, ANGLEAXIS2, BESTPERM, LOCALPERMDIST, PULLT, EFIELDT, NTSITES, & 56:   &            NFREEZE, NABT, RBAAT, ANGLEAXIS2, BESTPERM, LOCALPERMDIST, PULLT, EFIELDT, NTSITES, &
 57:   &            RIGIDBODY, PERMDIST, OHCELLT, LPERMDIST, EYTRAPT, MKTRAPT, LOCALPERMCUT, LOCALPERMCUT2, & 57:   &            RIGIDBODY, PERMDIST, OHCELLT, LPERMDIST, EYTRAPT, MKTRAPT, LOCALPERMCUT, LOCALPERMCUT2, &
 58:   &            LOCALPERMCUTINC, NOINVERSION, MIEFT, & 58:   &            LOCALPERMCUTINC, NOINVERSION, MIEFT, &
 59:   &            EDIFFTOL, GMAX, CONVR, ATOMMATCHDIST, NRANROT, GTHOMSONT, GTHOMMET, & ! hk286 59:   &            EDIFFTOL, GMAX, CONVR, ATOMMATCHDIST, NRANROT, GTHOMSONT, GTHOMMET, & ! hk286
 60:   &            PHI4MODT, MCPATHT, AMBER12T, VARIABLES 60:   &            PHI4MODT, MCPATHT, AMBER12T
 61: USE COMMONS,ONLY : NOPT 
 62: USE MODCHARMM,ONLY : CHRMMT 61: USE MODCHARMM,ONLY : CHRMMT
 63: USE MODAMBER9, ONLY: NOPERMPROCHIRAL, PROCHIRALH 62: USE MODAMBER9, ONLY: NOPERMPROCHIRAL, PROCHIRALH
 64: USE INTCOMMONS, ONLY : INTMINPERMT, INTINTERPT, DESMINT, OLDINTMINPERMT, INTDISTANCET 63: USE INTCOMMONS, ONLY : INTMINPERMT, INTINTERPT, DESMINT, OLDINTMINPERMT, INTDISTANCET
 65: USE INTCUTILS, ONLY : INTMINPERM, OLD_INTMINPERM, INTMINPERM_CHIRAL, INTDISTANCE 64: USE INTCUTILS, ONLY : INTMINPERM, OLD_INTMINPERM, INTMINPERM_CHIRAL, INTDISTANCE
 66: USE GENRIGID 65: USE GENRIGID
 67: USE AMBER12_INTERFACE_MOD 66: USE AMBER12_INTERFACE_MOD
 68: USE CHIRALITY 67: USE CHIRALITY
 69: IMPLICIT NONE 68: IMPLICIT NONE
 70:  69: 
 71: INTEGER :: MAXIMUMTRIES=10 70: INTEGER :: MAXIMUMTRIES=10
 85: DOUBLE PRECISION BMDIST, BMCOORDS(3*NATOMS), BMCOORDSSV(3*NATOMS) 84: DOUBLE PRECISION BMDIST, BMCOORDS(3*NATOMS), BMCOORDSSV(3*NATOMS)
 86: DOUBLE PRECISION TEMPCOORDSA(DEGFREEDOMS), TEMPCOORDSB(DEGFREEDOMS) ! sn402 85: DOUBLE PRECISION TEMPCOORDSA(DEGFREEDOMS), TEMPCOORDSB(DEGFREEDOMS) ! sn402
 87: INTEGER NEWPERM(NATOMS), ALLPERM(NATOMS), SAVEPERM(NATOMS) 86: INTEGER NEWPERM(NATOMS), ALLPERM(NATOMS), SAVEPERM(NATOMS)
 88: CHARACTER(LEN=5) ZSYMSAVE 87: CHARACTER(LEN=5) ZSYMSAVE
 89: COMMON /SYS/ ZSYMSAVE 88: COMMON /SYS/ ZSYMSAVE
 90:  89: 
 91: ! hk286 90: ! hk286
 92: IF (GTHOMSONT) THEN 91: IF (GTHOMSONT) THEN
 93:    CALL GTHOMSONMINPERMDIST(COORDSB,COORDSA,NATOMS,DEBUG,BOXLX,BOXLY,BOXLZ,BULKT,TWOD,DISTANCE,DIST2,RIGID,RMATBEST) 92:    CALL GTHOMSONMINPERMDIST(COORDSB,COORDSA,NATOMS,DEBUG,BOXLX,BOXLY,BOXLZ,BULKT,TWOD,DISTANCE,DIST2,RIGID,RMATBEST)
 94:    RETURN 93:    RETURN
 95: ELSEIF (VARIABLES) THEN 
 96:    DISTANCE=0.0D0 
 97:    DO J1=1,NOPT 
 98:       DISTANCE=DISTANCE+(COORDSA(J1)-COORDSB(J1))**2 
 99:    ENDDO 
100:    DISTANCE=SQRT(DISTANCE) 
101:    RETURN 
102: ENDIF 94: ENDIF
103:  95: 
104: ! sn402 96: ! sn402
105: IF (RIGIDINIT) THEN 97: IF (RIGIDINIT) THEN
106:     IF(DEBUG) THEN 98:     IF(DEBUG) THEN
107:         IF(.NOT.(ANY(ABS(COORDSA(DEGFREEDOMS+1:3*NATOMS)) .GT. 1.0E-10))) THEN 99:         IF(.NOT.(ANY(ABS(COORDSA(DEGFREEDOMS+1:3*NATOMS)) .GT. 1.0E-10))) THEN
108:             WRITE(*,*) "minpermdist> Warning: COORDSA seems to be in AA coords. Last block:"100:             WRITE(*,*) "minpermdist> Warning: COORDSA seems to be in AA coords. Last block:"
109: !            WRITE(*,*) COORDSA(3*NATOMS-2:3*NATOMS)101: !            WRITE(*,*) COORDSA(3*NATOMS-2:3*NATOMS)
110:             WRITE(*,*) COORDSA(DEGFREEDOMS+1:3*NATOMS)102:             WRITE(*,*) COORDSA(DEGFREEDOMS+1:3*NATOMS)
111:             WRITE(*,*) "Transforming to Cartesians."103:             WRITE(*,*) "Transforming to Cartesians."


r29791/MLP3.f90 2016-01-21 22:30:05.219278370 +0000 r29790/MLP3.f90 2016-01-21 22:30:09.819339951 +0000
 25: IF (SECT) HESS(1:NMLP,1:NMLP)=0.0D0 25: IF (SECT) HESS(1:NMLP,1:NMLP)=0.0D0
 26: DO J1=1,MLPDATA 26: DO J1=1,MLPDATA
 27:    MLPOUTJ1=MLPOUTCOME(J1) 27:    MLPOUTJ1=MLPOUTCOME(J1)
 28:    DO J2=1,MLPHIDDEN 28:    DO J2=1,MLPHIDDEN
 29:       DUMMY1=0.0D0 29:       DUMMY1=0.0D0
 30:       DO J3=1,MLPIN 30:       DO J3=1,MLPIN
 31:          DUMMY1=DUMMY1+X((J2-1)*MLPIN+J3)*MLPDAT(J1,J3) 31:          DUMMY1=DUMMY1+X((J2-1)*MLPIN+J3)*MLPDAT(J1,J3)
 32:       ENDDO 32:       ENDDO
 33:       TANHSUM(J2)=TANH(DUMMY1)  33:       TANHSUM(J2)=TANH(DUMMY1) 
 34:       DYW1G(J2)=TANHSUM(J2) 34:       DYW1G(J2)=TANHSUM(J2)
 35: !     PRINT *,'DUMMY1=',DUMMY1 35:       SECH2(J2)=1.0D0/COSH(DUMMY1)**2 
 36:       IF (ABS(DUMMY1).GT.20.0D0) THEN 
 37:          SECH2(J2)=0.0D0 
 38:       ELSE 
 39:          SECH2(J2)=1.0D0/COSH(DUMMY1)**2  
 40:       ENDIF 
 41:    ENDDO 36:    ENDDO
 42:    DUMMY3=0.0D0 37:    DUMMY3=0.0D0
 43:    DO J4=1,MLPOUT 38:    DO J4=1,MLPOUT
 44:       DUMMY2=0.0D0 39:       DUMMY2=0.0D0
 45:       DO J2=1,MLPHIDDEN 40:       DO J2=1,MLPHIDDEN
 46:          DO J3=1,MLPIN 41:          DO J3=1,MLPIN
 47:             DYW2G(J4,J2,J3)=X( MLPOFFSET + (J4-1)*MLPHIDDEN + J2 ) * MLPDAT(J1,J3)*SECH2(J2) 42:             DYW2G(J4,J2,J3)=X( MLPOFFSET + (J4-1)*MLPHIDDEN + J2 ) * MLPDAT(J1,J3)*SECH2(J2)
 48:          ENDDO 43:          ENDDO
 49:          DUMMY2=DUMMY2+X(MLPOFFSET+(J4-1)*MLPHIDDEN+J2)*TANHSUM(J2) 44:          DUMMY2=DUMMY2+X(MLPOFFSET+(J4-1)*MLPHIDDEN+J2)*TANHSUM(J2)
 50:       ENDDO 45:       ENDDO
 51:       IF (DUMMY2.GT.50.0D0) DUMMY2=50.0D0 ! to prevent FPE 
 52:       Y(J4)=DUMMY2 46:       Y(J4)=DUMMY2
 53:       DUMMY3=DUMMY3+EXP(DUMMY2) 47:       DUMMY3=DUMMY3+EXP(DUMMY2)
 54:    ENDDO   48:    ENDDO  
 55:    DO J4=1,MLPOUT 49:    DO J4=1,MLPOUT
 56:       PROB(J4)=EXP(Y(J4))/DUMMY3 50:       PROB(J4)=EXP(Y(J4))/DUMMY3
 57:    ENDDO 51:    ENDDO
 58:    PMLPOUTJ1=PROB(MLPOUTJ1) 52:    PMLPOUTJ1=PROB(MLPOUTJ1)
 59: !  IF (DEBUG) THEN 53: !  IF (DEBUG) THEN
 60: !     WRITE(*,'(A,I8,A)') 'MLP3> data point ',J1,' outputs and probabilities:' 54: !     WRITE(*,'(A,I8,A)') 'MLP3> data point ',J1,' outputs and probabilities:'
 61: !     WRITE(*,'(8G15.5)') Y(1:MLPOUT),PROB(1:MLPOUT) 55: !     WRITE(*,'(8G15.5)') Y(1:MLPOUT),PROB(1:MLPOUT)


r29791/ncutils.f90 2016-01-21 22:30:04.571269693 +0000 r29790/ncutils.f90 2016-01-21 22:30:09.143330898 +0000
 27:           USE NEBTOCONNECT 27:           USE NEBTOCONNECT
 28:           USE KEYUTILS 28:           USE KEYUTILS
 29:           USE KEY,ONLY : RIGIDBODY, BULKT, TWOD, PERMDIST 29:           USE KEY,ONLY : RIGIDBODY, BULKT, TWOD, PERMDIST
 30:           USE COMMONS,ONLY : PARAM1,PARAM2,PARAM3,DEBUG 30:           USE COMMONS,ONLY : PARAM1,PARAM2,PARAM3,DEBUG
 31:           IMPLICIT NONE 31:           IMPLICIT NONE
 32:           LOGICAL :: NCISNEWTS 32:           LOGICAL :: NCISNEWTS
 33:           TYPE(TSFOUNDTYPE),INTENT(IN) :: TSTOCHECK 33:           TYPE(TSFOUNDTYPE),INTENT(IN) :: TSTOCHECK
 34:           DOUBLE PRECISION RMAT(3,3), DIST2 34:           DOUBLE PRECISION RMAT(3,3), DIST2
 35:            35:           
 36:           INTEGER :: I, SAMEAS 36:           INTEGER :: I, SAMEAS
 37:           DOUBLE PRECISION :: XCOORDS1(NOPT), XCOORDS2(NOPT) 37:           DOUBLE PRECISION :: XCOORDS1(3*NATOMS), XCOORDS2(3*NATOMS)
 38:  38: 
 39:           SAMEAS=0 39:           SAMEAS=0
 40:           IF (NTS==0) THEN 40:           IF (NTS==0) THEN
 41:                NCISNEWTS=.TRUE. 41:                NCISNEWTS=.TRUE.
 42:                RETURN 42:                RETURN
 43:           ENDIF 43:           ENDIF
 44:  44: 
 45:           DO I=1,NTS 45:           DO I=1,NTS
 46:                IF (ABS(TSTOCHECK%E-TS(I)%DATA%E) < EDIFFTOL) THEN 46:                IF (ABS(TSTOCHECK%E-TS(I)%DATA%E) < EDIFFTOL) THEN
 47:                   IF (RIGIDINIT) THEN 47:                   IF (RIGIDINIT) THEN
 71:      SUBROUTINE ISNEWMIN(E,COORD,MINPOS,NEW,REDOPATH,PERMUTE,INVERT,INDEX,I) 71:      SUBROUTINE ISNEWMIN(E,COORD,MINPOS,NEW,REDOPATH,PERMUTE,INVERT,INDEX,I)
 72:           USE KEYUTILS 72:           USE KEYUTILS
 73:           USE KEY,ONLY : RIGIDBODY, BULKT, TWOD, PERMDIST !msb50 73:           USE KEY,ONLY : RIGIDBODY, BULKT, TWOD, PERMDIST !msb50
 74:           USE COMMONS,ONLY : PARAM1,PARAM2,PARAM3,DEBUG 74:           USE COMMONS,ONLY : PARAM1,PARAM2,PARAM3,DEBUG
 75:           USE INTCOMMONS, ONLY : INTMINPERMT, INTINTERPT 75:           USE INTCOMMONS, ONLY : INTMINPERMT, INTINTERPT
 76:           IMPLICIT NONE 76:           IMPLICIT NONE
 77:            77:           
 78:           DOUBLE PRECISION,POINTER     :: E,COORD(:)  78:           DOUBLE PRECISION,POINTER     :: E,COORD(:) 
 79:           INTEGER,INTENT(OUT) :: MINPOS ! IF MINIMUM NEW IT IS EQUAL TO NMIN+1; OTHERWISE - POSITION IN MIN ARRAY 79:           INTEGER,INTENT(OUT) :: MINPOS ! IF MINIMUM NEW IT IS EQUAL TO NMIN+1; OTHERWISE - POSITION IN MIN ARRAY
 80:           LOGICAL,INTENT(OUT) :: NEW 80:           LOGICAL,INTENT(OUT) :: NEW
 81:           DOUBLE PRECISION QTEMP(NOPT) 81:           DOUBLE PRECISION QTEMP(3*NATOMS)
 82:           INTEGER :: I 82:           INTEGER :: I
 83:           INTEGER INVERT, INDEX(NATOMS), J2 83:           INTEGER INVERT, INDEX(NATOMS), J2
 84:           LOGICAL PERMUTE,SUCCESS,REDOPATH 84:           LOGICAL PERMUTE,SUCCESS,REDOPATH
 85:           DOUBLE PRECISION D, DIST2, RMAT(3,3) 85:           DOUBLE PRECISION D, DIST2, RMAT(3,3)
 86:  86: 
 87:           MINPOS=NMIN+1 87:           MINPOS=NMIN+1
 88:           NEW=.TRUE. 88:           NEW=.TRUE.
 89:   89:  
 90:           DO I=1,NMIN 90:           DO I=1,NMIN
 91:              PERMUTE=.FALSE. 91:              PERMUTE=.FALSE.
 92:              IF (DEBUG) PRINT '(A,I6,2G20.10)',' isnewmin> I,E,MI(I)%DATA%E=',I,E,MI(I)%DATA%E 92:              IF (DEBUG) PRINT '(A,I6,2G20.10)',' isnewmin> I,E,MI(I)%DATA%E=',I,E,MI(I)%DATA%E
 93:              IF (ABS(E-MI(I)%DATA%E) < EDIFFTOL) THEN 93:              IF (ABS(E-MI(I)%DATA%E) < EDIFFTOL) THEN
 94:                 CALL MINPERMDIST(COORD,MI(I)%DATA%X(1:NOPT), NATOMS, & 94:                 CALL MINPERMDIST(COORD,MI(I)%DATA%X(1:3*NATOMS), NATOMS, &
 95:   &                                DEBUG,PARAM1,PARAM2,PARAM3,BULKT,TWOD,D,DIST2,RIGIDBODY,RMAT) 95:   &                                DEBUG,PARAM1,PARAM2,PARAM3,BULKT,TWOD,D,DIST2,RIGIDBODY,RMAT)
 96:                 IF (DEBUG) PRINT '(A,G20.10)','isnewmin> minimum distance=',D 96:                 IF (DEBUG) PRINT '(A,G20.10)','isnewmin> minimum distance=',D
 97:                 IF (D<GEOMDIFFTOL) THEN 97:                 IF (D<GEOMDIFFTOL) THEN
 98:                    NEW=.FALSE. 98:                    NEW=.FALSE.
 99:                    MINPOS=I 99:                    MINPOS=I
100:                    IF (DEBUG) PRINT '(A,I6)','isnewmin> MINPOS=',I100:                    IF (DEBUG) PRINT '(A,I6)','isnewmin> MINPOS=',I
101:                    RETURN101:                    RETURN
102:                 ENDIF102:                 ENDIF
103:              ENDIF103:              ENDIF
104:           ENDDO104:           ENDDO
105: 105: 
106: !                 SUCCESS=.FALSE. 106: !                 SUCCESS=.FALSE. 
107: ! !107: ! !
108: ! !  If they are the same minimum then GETPERM should be more reliable than mindist. DJW108: ! !  If they are the same minimum then GETPERM should be more reliable than mindist. DJW
109: ! !  Even if the permutation-inversion is the identity!109: ! !  Even if the permutation-inversion is the identity!
110: ! !  GETPERM changes the first argument, but not the second.110: ! !  GETPERM changes the first argument, but not the second.
111: ! !  However! GETPERM will fail if the stationary points are within EDiffTol but111: ! !  However! GETPERM will fail if the stationary points are within EDiffTol but
112: ! !  don;t line up sufficiently well. 112: ! !  don;t line up sufficiently well. 
113: ! !113: ! !
114: !                 QTEMP(1:NOPT)=MI(I)%DATA%X(1:NOPT)114: !                 QTEMP(1:3*NATOMS)=MI(I)%DATA%X(1:3*NATOMS)
115: !                 CALL GETPERM(QTEMP,COORD,INVERT,INDEX,SUCCESS)115: !                 CALL GETPERM(QTEMP,COORD,INVERT,INDEX,SUCCESS)
116: ! 116: ! 
117: !                 IF (SUCCESS) THEN117: !                 IF (SUCCESS) THEN
118: !                    ATOMLOOP: DO J2=1,NATOMS118: !                    ATOMLOOP: DO J2=1,NATOMS
119: !                       IF ((INVERT.NE.1).OR.(INDEX(J2).NE.J2)) THEN119: !                       IF ((INVERT.NE.1).OR.(INDEX(J2).NE.J2)) THEN
120: !                          PERMUTE=.TRUE.120: !                          PERMUTE=.TRUE.
121: !                          MINPOS=I121: !                          MINPOS=I
122: !                          EXIT ATOMLOOP122: !                          EXIT ATOMLOOP
123: !                       ENDIF123: !                       ENDIF
124: !                    ENDDO ATOMLOOP124: !                    ENDDO ATOMLOOP
174:      END SUBROUTINE TESTSAMEMIN174:      END SUBROUTINE TESTSAMEMIN
175: 175: 
176:      SUBROUTINE ADDNEWMIN(E,COORD)176:      SUBROUTINE ADDNEWMIN(E,COORD)
177:           USE KEYDECIDE,ONLY : INTERPCOSTFUNCTION177:           USE KEYDECIDE,ONLY : INTERPCOSTFUNCTION
178:           USE KEY,ONLY : RIGIDBODY, PERMDIST,TWOD,BULKT,INTCONSTRAINTT,INTLJT,INTIMAGE,FREEZENODEST, &178:           USE KEY,ONLY : RIGIDBODY, PERMDIST,TWOD,BULKT,INTCONSTRAINTT,INTLJT,INTIMAGE,FREEZENODEST, &
179:   &                      ATOMACTIVE,GEOMDIFFTOL, EDIFFTOL179:   &                      ATOMACTIVE,GEOMDIFFTOL, EDIFFTOL
180:           USE COMMONS,ONLY : PARAM1,PARAM2,PARAM3,DEBUG180:           USE COMMONS,ONLY : PARAM1,PARAM2,PARAM3,DEBUG
181:           IMPLICIT NONE181:           IMPLICIT NONE
182:           DOUBLE PRECISION RMAT(3,3), DIST2182:           DOUBLE PRECISION RMAT(3,3), DIST2
183:           DOUBLE PRECISION,POINTER :: E,COORD(:)183:           DOUBLE PRECISION,POINTER :: E,COORD(:)
184:           DOUBLE PRECISION VNEW(NOPT), RMS, ENERGY  !!! DJW184:           DOUBLE PRECISION VNEW(3*NATOMS), RMS, ENERGY  !!! DJW
185:           INTEGER :: I, NMAXINT, NMININT, INTIMAGESAVE, J1, J2185:           INTEGER :: I, NMAXINT, NMININT, INTIMAGESAVE, J1, J2
186:           DOUBLE PRECISION MINCOORDS(2,NOPT), CONSTRAINTE, XYZLOCAL(2*NOPT), GGGLOCAL(2*NOPT), RMSLOCAL, &186:           DOUBLE PRECISION MINCOORDS(2,3*NATOMS), CONSTRAINTE, XYZLOCAL(6*NATOMS), GGGLOCAL(6*NATOMS), RMSLOCAL, &
187:   &                        EEELOCAL(INTIMAGE+2)187:   &                        EEELOCAL(INTIMAGE+2)
188:           LOGICAL IMGFREEZELOCAL(0), FREEZENODESTLOCAL188:           LOGICAL IMGFREEZELOCAL(0), FREEZENODESTLOCAL
189: !         LOGICAL EDGEINT(INTIMAGE+1,NATOMS,NATOMS)189: !         LOGICAL EDGEINT(INTIMAGE+1,NATOMS,NATOMS)
190: 190: 
191:           IF (NMIN==MINRACKSIZE) CALL REALLOCATEMINRACK191:           IF (NMIN==MINRACKSIZE) CALL REALLOCATEMINRACK
192: 192: 
193:           NMIN=NMIN+1193:           NMIN=NMIN+1
194:           MI(NMIN)%DATA%E => E194:           MI(NMIN)%DATA%E => E
195:           MI(NMIN)%DATA%X => COORD195:           MI(NMIN)%DATA%X => COORD
196: !         DO I=1,NMIN196: !         DO I=1,NMIN
595: ! as atoms in the following subroutine. 595: ! as atoms in the following subroutine. 
596: ! A good solution would probably be to define an unambiguous sense for the596: ! A good solution would probably be to define an unambiguous sense for the
597: ! dipoles so that this problem doesn't arise. It could also cause problems597: ! dipoles so that this problem doesn't arise. It could also cause problems
598: ! in recognising identical minima.598: ! in recognising identical minima.
599: !599: !
600: ! Merges path output files to produce full pathway for the rearrangement;600: ! Merges path output files to produce full pathway for the rearrangement;
601: ! frames in path are reversed as needed;601: ! frames in path are reversed as needed;
602: !602: !
603:      SUBROUTINE MERGEXYZEOFS  603:      SUBROUTINE MERGEXYZEOFS  
604:           USE KEY, ONLY: FILTH,UNRST,FILTHSTR,RIGIDBODY,BULKT,TWOD,STOCKT,STOCKAAT,RBAAT,PERMDIST, MIEFT, &604:           USE KEY, ONLY: FILTH,UNRST,FILTHSTR,RIGIDBODY,BULKT,TWOD,STOCKT,STOCKAAT,RBAAT,PERMDIST, MIEFT, &
605:   &                      AMHT,SEQ,NTSITES,NENDDUP, GTHOMSONT, PAPT, NFREEZE, VARIABLES ! hk286605:   &                      AMHT,SEQ,NTSITES,NENDDUP, GTHOMSONT, PAPT, NFREEZE ! hk286
606:           USE KEYUTILS        ! frames in bits that are glued together are rotated accordingly;606:           USE KEYUTILS        ! frames in bits that are glued together are rotated accordingly;
607:           USE KEYCONNECT,ONLY : NCNSTEPS607:           USE KEYCONNECT,ONLY : NCNSTEPS
608:           USE COMMONS,ONLY : PARAM1,PARAM2,PARAM3,DEBUG608:           USE COMMONS,ONLY : PARAM1,PARAM2,PARAM3,DEBUG
609:           USE AMHGLOBALS, ONLY : NMRES609:           USE AMHGLOBALS, ONLY : NMRES
610: 610: 
611:           IMPLICIT NONE       ! prerequisites: chain of min/ts constructed; assumes path is dumping plus side of the path611:           IMPLICIT NONE       ! prerequisites: chain of min/ts constructed; assumes path is dumping plus side of the path
612:                               ! first, and there are no blank lines after last frame (!)612:                               ! first, and there are no blank lines after last frame (!)
613:                               ! does somewhat similar with EofS.ts files as well..613:                               ! does somewhat similar with EofS.ts files as well..
614:           DOUBLE PRECISION RMAT(3,3), Q2(4)614:           DOUBLE PRECISION RMAT(3,3), Q2(4)
615:           INTEGER :: I,J,K,EOF,J1,J2,INDEXTS !,FL615:           INTEGER :: I,J,K,EOF,J1,J2,INDEXTS !,FL
766:                   IF (EOF==0) THEN766:                   IF (EOF==0) THEN
767:                        BACKSPACE 40767:                        BACKSPACE 40
768:                   ELSE768:                   ELSE
769:                        EXIT769:                        EXIT
770:                   ENDIF770:                   ENDIF
771:                   IF (K<0) PRINT*,'k=',k ! stupid fix for stupid Sun compiler bug771:                   IF (K<0) PRINT*,'k=',k ! stupid fix for stupid Sun compiler bug
772:                                          ! need to access k to prevent SEGV       DJW772:                                          ! need to access k to prevent SEGV       DJW
773:                     773:                     
774:                   ALLOCATE(TAIL); NULLIFY(TAIL%NEXT,TAIL%PREVIOUS,TAIL%Q,TAIL%SYM,TAIL%LINE)774:                   ALLOCATE(TAIL); NULLIFY(TAIL%NEXT,TAIL%PREVIOUS,TAIL%Q,TAIL%SYM,TAIL%LINE)
775:                     775:                     
776:                   ALLOCATE(TAIL%Q(NOPT),TAIL%SYM(NATOMS))776:                   ALLOCATE(TAIL%Q(3*NATOMS),TAIL%SYM(NATOMS))
777:                   READ(40,'(a)')777:                   READ(40,'(a)')
778:                   READ(40,'(a)') tail%comment778:                   READ(40,'(a)') tail%comment
779:                   IF (STOCKT) THEN779:                   IF (STOCKT) THEN
780:                      DO J=1,(NATOMS/2)780:                      DO J=1,(NATOMS/2)
781:                         READ(40,'(a5,1x,3f20.10,tr13,3f20.10)') tail%sym(j), &781:                         READ(40,'(a5,1x,3f20.10,tr13,3f20.10)') tail%sym(j), &
782:   &                     tail%q(3*(j-1)+1),tail%q(3*(j-1)+2),tail%q(3*(j-1)+3), &782:   &                     tail%q(3*(j-1)+1),tail%q(3*(j-1)+2),tail%q(3*(j-1)+3), &
783:   &                     tail%q(3*((NATOMS/2)+j-1)+1),tail%q(3*((NATOMS/2)+j-1)+2),tail%q(3*((NATOMS/2)+j-1)+3)783:   &                     tail%q(3*((NATOMS/2)+j-1)+1),tail%q(3*((NATOMS/2)+j-1)+2),tail%q(3*((NATOMS/2)+j-1)+3)
784:                         DLENGTH=TAIL%Q(3*((NATOMS/2)+J-1)+1)**2 &784:                         DLENGTH=TAIL%Q(3*((NATOMS/2)+J-1)+1)**2 &
785:   &                            +TAIL%Q(3*((NATOMS/2)+J-1)+2)**2 & 785:   &                            +TAIL%Q(3*((NATOMS/2)+J-1)+2)**2 & 
786:   &                            +TAIL%Q(3*((NATOMS/2)+J-1)+3)**2 786:   &                            +TAIL%Q(3*((NATOMS/2)+J-1)+3)**2 
817:                            NDUMMY=NDUMMY+1817:                            NDUMMY=NDUMMY+1
818:                            READ(40,'(a5,1x,3f20.10)') tail%sym(NDUMMY),tail%Q(3*(NDUMMY-1)+1),tail%Q(3*(NDUMMY-1)+2),  &818:                            READ(40,'(a5,1x,3f20.10)') tail%sym(NDUMMY),tail%Q(3*(NDUMMY-1)+1),tail%Q(3*(NDUMMY-1)+2),  &
819:      &                                                tail%Q(3*(NDUMMY-1)+3)819:      &                                                tail%Q(3*(NDUMMY-1)+3)
820:                         ENDIF820:                         ENDIF
821:                      ENDDO821:                      ENDDO
822:                   ELSEIF (GTHOMSONT) THEN822:                   ELSEIF (GTHOMSONT) THEN
823:                      DO J = 1, NATOMS823:                      DO J = 1, NATOMS
824:                         READ(40,'(a5,1x,3f20.10)') tail%sym(1), TMPCOORDS(3*(J-1)+1), TMPCOORDS(3*(J-1)+2), TMPCOORDS(3*(J-1)+3)824:                         READ(40,'(a5,1x,3f20.10)') tail%sym(1), TMPCOORDS(3*(J-1)+1), TMPCOORDS(3*(J-1)+2), TMPCOORDS(3*(J-1)+3)
825:                         CALL GTHOMSONCTOANG(TMPCOORDS(1:3*NATOMS), tail%q(1:3*NATOMS), NATOMS, 0)825:                         CALL GTHOMSONCTOANG(TMPCOORDS(1:3*NATOMS), tail%q(1:3*NATOMS), NATOMS, 0)
826:                      ENDDO826:                      ENDDO
827:                   ELSEIF (VARIABLES) THEN 
828:                      DO J=1,NOPT 
829:                         READ(40,'(a5,1x,3f20.10)') tail%sym(j),tail%q(j) 
830:                      ENDDO 
831:                   ELSE827:                   ELSE
832:                      DO J=1,NATOMS828:                      DO J=1,NATOMS
833:                         READ(40,'(a5,1x,3f20.10)') tail%sym(j),tail%q(3*(j-1)+1),tail%q(3*(j-1)+2),tail%q(3*(j-1)+3)829:                         READ(40,'(a5,1x,3f20.10)') tail%sym(j),tail%q(3*(j-1)+1),tail%q(3*(j-1)+2),tail%q(3*(j-1)+3)
834:                      ENDDO830:                      ENDDO
835:                   ENDIF831:                   ENDIF
836:                   832:                   
837:                   IF (ASSOCIATED(TMP)) THEN833:                   IF (ASSOCIATED(TMP)) THEN
838:                        TMP%NEXT => TAIL834:                        TMP%NEXT => TAIL
839:                        TAIL%PREVIOUS => TMP 835:                        TAIL%PREVIOUS => TMP 
840:                   ENDIF836:                   ENDIF
857:                   TMP => TAIL; NULLIFY(TAIL)853:                   TMP => TAIL; NULLIFY(TAIL)
858:                   CMXA=0.0D0; CMYA=0.0D0; CMZA=0.0D0854:                   CMXA=0.0D0; CMYA=0.0D0; CMZA=0.0D0
859:                   IF (RBAAT) THEN855:                   IF (RBAAT) THEN
860:                      CMAX = 0.0D0; CMAY = 0.0D0; CMAZ = 0.0D0856:                      CMAX = 0.0D0; CMAY = 0.0D0; CMAZ = 0.0D0
861:                      DO J1 = 1, (NATOMS/2)857:                      DO J1 = 1, (NATOMS/2)
862:                         CMAX = CMAX + TMP%Q(3*(J1-1)+1)858:                         CMAX = CMAX + TMP%Q(3*(J1-1)+1)
863:                         CMAY = CMAY + TMP%Q(3*(J1-1)+2)859:                         CMAY = CMAY + TMP%Q(3*(J1-1)+2)
864:                         CMAZ = CMAZ + TMP%Q(3*(J1-1)+3)860:                         CMAZ = CMAZ + TMP%Q(3*(J1-1)+3)
865:                      ENDDO861:                      ENDDO
866:                      CMAX = 2*CMAX/NATOMS; CMAY = 2*CMAY/NATOMS; CMAZ = 2*CMAZ/NATOMS862:                      CMAX = 2*CMAX/NATOMS; CMAY = 2*CMAY/NATOMS; CMAZ = 2*CMAZ/NATOMS
867:                   ELSEIF (GTHOMSONT.OR.VARIABLES) THEN863:                   ELSEIF (GTHOMSONT) THEN
868:                   ELSE864:                   ELSE
869:                      DO J1=1,NATOMS865:                      DO J1=1,NATOMS
870:                         CMXA=CMXA+TMP%Q(3*(J1-1)+1)866:                         CMXA=CMXA+TMP%Q(3*(J1-1)+1)
871:                         CMYA=CMYA+TMP%Q(3*(J1-1)+2)867:                         CMYA=CMYA+TMP%Q(3*(J1-1)+2)
872:                         CMZA=CMZA+TMP%Q(3*(J1-1)+3)868:                         CMZA=CMZA+TMP%Q(3*(J1-1)+3)
873:                      ENDDO869:                      ENDDO
874:                      CMXA=CMXA/NATOMS; CMYA=CMYA/NATOMS; CMZA=CMZA/NATOMS870:                      CMXA=CMXA/NATOMS; CMYA=CMYA/NATOMS; CMZA=CMZA/NATOMS
875:                   ENDIF871:                   ENDIF
876:                   IF (I.EQ.1) THEN872:                   IF (I.EQ.1) THEN
877:                      CMXFIX=CMXA; CMYFIX=CMYA; CMZFIX=CMZA;873:                      CMXFIX=CMXA; CMYFIX=CMYA; CMZFIX=CMZA;
891:                            CALL GTHOMSONMINPERMDIST(TMPCOORDS, TMPCOORDS2, NATOMS, DEBUG, PARAM1, PARAM2, PARAM3, &887:                            CALL GTHOMSONMINPERMDIST(TMPCOORDS, TMPCOORDS2, NATOMS, DEBUG, PARAM1, PARAM2, PARAM3, &
892:                                 BULKT, TWOD, DIST, DIST2, RIGIDBODY, RMAT)888:                                 BULKT, TWOD, DIST, DIST2, RIGIDBODY, RMAT)
893:  889:  
894:                         ELSE 890:                         ELSE 
895:                            CALL MINPERMDIST(LASTFRAME,TMP%Q,NATOMS,DEBUG,PARAM1,PARAM2,PARAM3,BULKT,TWOD,DIST,DIST2,RIGIDBODY,RMAT)891:                            CALL MINPERMDIST(LASTFRAME,TMP%Q,NATOMS,DEBUG,PARAM1,PARAM2,PARAM3,BULKT,TWOD,DIST,DIST2,RIGIDBODY,RMAT)
896:                         ENDIF892:                         ENDIF
897:                      ELSE893:                      ELSE
898:                         IF (RBAAT) THEN894:                         IF (RBAAT) THEN
899:                            CALL RBMINDIST(LASTFRAME,TMP%Q,NATOMS,DIST,Q2,DEBUG)895:                            CALL RBMINDIST(LASTFRAME,TMP%Q,NATOMS,DIST,Q2,DEBUG)
900:                            CALL QROTMAT (Q2, RMATBEST)896:                            CALL QROTMAT (Q2, RMATBEST)
901:                         ELSEIF (VARIABLES) THEN 
902:                         ELSE897:                         ELSE
903:                            CALL NEWMINDIST(LASTFRAME,TMP%Q,NATOMS,D,BULKT,TWOD,TMP%SYM(1),.TRUE.,RIGIDBODY,DEBUG,RMAT)898:                            CALL NEWMINDIST(LASTFRAME,TMP%Q,NATOMS,D,BULKT,TWOD,TMP%SYM(1),.TRUE.,RIGIDBODY,DEBUG,RMAT)
904:                            CALL NEWROTGEOM(NATOMS,TMP%Q,RMAT,CMXA,CMYA,CMZA)899:                            CALL NEWROTGEOM(NATOMS,TMP%Q,RMAT,CMXA,CMYA,CMZA)
905:                            IF(.NOT.MIEFT) THEN900:                            IF(.NOT.MIEFT) THEN
906:                               DO J1=1,NATOMS901:                               DO J1=1,NATOMS
907:                                  J2=3*J1902:                                  J2=3*J1
908:                                  TMP%Q(J2-2)=TMP%Q(J2-2)+CMXFIX-CMXA903:                                  TMP%Q(J2-2)=TMP%Q(J2-2)+CMXFIX-CMXA
909:                                  TMP%Q(J2-1)=TMP%Q(J2-1)+CMYFIX-CMYA904:                                  TMP%Q(J2-1)=TMP%Q(J2-1)+CMYFIX-CMYA
910:                                  TMP%Q(J2)  =TMP%Q(J2)  +CMZFIX-CMZA905:                                  TMP%Q(J2)  =TMP%Q(J2)  +CMZFIX-CMZA
911:                               ENDDO906:                               ENDDO
955:                               J2 = 3*J1950:                               J2 = 3*J1
956:                               XS(J2-2:J2) = MATMUL(RMATBEST,XS(J2-2:J2))951:                               XS(J2-2:J2) = MATMUL(RMATBEST,XS(J2-2:J2))
957:                            ENDDO952:                            ENDDO
958:                            IF (PERMDIST .AND. (.NOT. PAPT)) THEN953:                            IF (PERMDIST .AND. (.NOT. PAPT)) THEN
959:                               DO J1 = 1, NATOMS/2954:                               DO J1 = 1, NATOMS/2
960:                                  J2 = 3*J1955:                                  J2 = 3*J1
961:                                  TMP%Q(J2-2:J2) = MATMUL(RMATBEST,TMP%Q(J2-2:J2))956:                                  TMP%Q(J2-2:J2) = MATMUL(RMATBEST,TMP%Q(J2-2:J2))
962:                               ENDDO957:                               ENDDO
963:                            ELSE958:                            ELSE
964:                               CALL RBROT(TMP%Q,X,Q2,NATOMS)959:                               CALL RBROT(TMP%Q,X,Q2,NATOMS)
965:                               TMP%Q(1:NOPT) = X(1:NOPT) 960:                               TMP%Q(1:3*NATOMS) = X(1:3*NATOMS) 
966:                            ENDIF961:                            ENDIF
967:                         ENDIF962:                         ENDIF
968:                         IF (STOCKAAT) THEN963:                         IF (STOCKAAT) THEN
969:                            CALL STFRAME(TMP%COMMENT,XS,XV)964:                            CALL STFRAME(TMP%COMMENT,XS,XV)
970:                         ELSE965:                         ELSE
971:                            CALL RBFRAME(TMP%COMMENT,XS,TMP%Q,RMATBEST)966:                            CALL RBFRAME(TMP%COMMENT,XS,TMP%Q,RMATBEST)
972:                         ENDIF967:                         ENDIF
973: 968: 
974: ! hk286 - fix this (?)969: ! hk286 - fix this (?)
975:                      ELSEIF (GTHOMSONT) THEN970:                      ELSEIF (GTHOMSONT) THEN
983: ! Duplicate the first frame if requested to make movies pause978: ! Duplicate the first frame if requested to make movies pause
984: ! at end points.979: ! at end points.
985: !980: !
986:                         IF ((I.EQ.1).AND.(K.EQ.1).AND.(NENDDUP.GT.0)) THEN981:                         IF ((I.EQ.1).AND.(K.EQ.1).AND.(NENDDUP.GT.0)) THEN
987:                            IF (DEBUG) PRINT '(A,3I6)','ncutils> writing NENDDUP extra start frames'982:                            IF (DEBUG) PRINT '(A,3I6)','ncutils> writing NENDDUP extra start frames'
988:                            DO J2=1,NENDDUP983:                            DO J2=1,NENDDUP
989:                               CALL WRITEFRAME(TMP%COMMENT,TMP%SYM,TMP%Q)984:                               CALL WRITEFRAME(TMP%COMMENT,TMP%SYM,TMP%Q)
990:                            ENDDO985:                            ENDDO
991:                         ENDIF986:                         ENDIF
992:                      ELSE987:                      ELSE
993:                         IF ((I>1.AND.K>1) .AND. (.NOT.(UNRST.OR.VARIABLES))) THEN988:                         IF ((I>1.AND.K>1) .AND. (.NOT.UNRST)) THEN
994:                            IF (.NOT.BULKT) THEN989:                            IF (.NOT.BULKT) THEN
995:                               CALL NEWROTGEOM(NATOMS,TMP%Q,RMAT,CMXA,CMYA,CMZA)990:                               CALL NEWROTGEOM(NATOMS,TMP%Q,RMAT,CMXA,CMYA,CMZA)
996:                               IF(.NOT.MIEFT) THEN991:                               IF(.NOT.MIEFT) THEN
997:                                  DO J1=1,NATOMS992:                                  DO J1=1,NATOMS
998:                                     J2=3*J1993:                                     J2=3*J1
999:                                     TMP%Q(J2-2)=TMP%Q(J2-2)+CMXFIX-CMXA994:                                     TMP%Q(J2-2)=TMP%Q(J2-2)+CMXFIX-CMXA
1000:                                     TMP%Q(J2-1)=TMP%Q(J2-1)+CMYFIX-CMYA995:                                     TMP%Q(J2-1)=TMP%Q(J2-1)+CMYFIX-CMYA
1001:                                     TMP%Q(J2)  =TMP%Q(J2)  +CMZFIX-CMZA996:                                     TMP%Q(J2)  =TMP%Q(J2)  +CMZFIX-CMZA
1002:                                  ENDDO997:                                  ENDDO
1003:                               ENDIF998:                               ENDIF
1049:                   TMP => HEAD; NULLIFY(HEAD)1044:                   TMP => HEAD; NULLIFY(HEAD)
1050:                   CMXA=0.0D0; CMYA=0.0D0; CMZA=0.0D01045:                   CMXA=0.0D0; CMYA=0.0D0; CMZA=0.0D0
1051:                   IF (RBAAT) THEN1046:                   IF (RBAAT) THEN
1052:                      CMAX = 0.0D0; CMAY = 0.0D0; CMAZ = 0.0D01047:                      CMAX = 0.0D0; CMAY = 0.0D0; CMAZ = 0.0D0
1053:                      DO J1 = 1, (NATOMS/2)1048:                      DO J1 = 1, (NATOMS/2)
1054:                         CMAX = CMAX + TMP%Q(3*(J1-1)+1)1049:                         CMAX = CMAX + TMP%Q(3*(J1-1)+1)
1055:                         CMAY = CMAY + TMP%Q(3*(J1-1)+2)1050:                         CMAY = CMAY + TMP%Q(3*(J1-1)+2)
1056:                         CMAZ = CMAZ + TMP%Q(3*(J1-1)+3)1051:                         CMAZ = CMAZ + TMP%Q(3*(J1-1)+3)
1057:                      ENDDO1052:                      ENDDO
1058:                      CMAX = 2*CMAX/NATOMS; CMAY = 2*CMAY/NATOMS; CMAZ = 2*CMAZ/NATOMS1053:                      CMAX = 2*CMAX/NATOMS; CMAY = 2*CMAY/NATOMS; CMAZ = 2*CMAZ/NATOMS
1059:                   ELSEIF (GTHOMSONT.OR.VARIABLES) THEN1054:                   ELSEIF (GTHOMSONT) THEN
1060:                   ELSE1055:                   ELSE
1061:                      DO J1=1,NATOMS1056:                      DO J1=1,NATOMS
1062:                         CMXA=CMXA+TMP%Q(3*(J1-1)+1)1057:                         CMXA=CMXA+TMP%Q(3*(J1-1)+1)
1063:                         CMYA=CMYA+TMP%Q(3*(J1-1)+2)1058:                         CMYA=CMYA+TMP%Q(3*(J1-1)+2)
1064:                         CMZA=CMZA+TMP%Q(3*(J1-1)+3)1059:                         CMZA=CMZA+TMP%Q(3*(J1-1)+3)
1065:                      ENDDO1060:                      ENDDO
1066:                      CMXA=CMXA/NATOMS; CMYA=CMYA/NATOMS; CMZA=CMZA/NATOMS1061:                      CMXA=CMXA/NATOMS; CMYA=CMYA/NATOMS; CMZA=CMZA/NATOMS
1067:                   ENDIF1062:                   ENDIF
1068:                   IF (I.EQ.1) THEN1063:                   IF (I.EQ.1) THEN
1069:                      CMXFIX=CMXA; CMYFIX=CMYA; CMZFIX=CMZA;1064:                      CMXFIX=CMXA; CMYFIX=CMYA; CMZFIX=CMZA;
1078:                            CALL GTHOMSONANGTOC(TMPCOORDS2(1:3*NATOMS/2), TMP%Q(1:3*NATOMS), NATOMS)1073:                            CALL GTHOMSONANGTOC(TMPCOORDS2(1:3*NATOMS/2), TMP%Q(1:3*NATOMS), NATOMS)
1079:                            CALL GTHOMSONMINPERMDIST(TMPCOORDS, TMPCOORDS2, NATOMS, DEBUG, PARAM1, PARAM2, PARAM3, &1074:                            CALL GTHOMSONMINPERMDIST(TMPCOORDS, TMPCOORDS2, NATOMS, DEBUG, PARAM1, PARAM2, PARAM3, &
1080:                                 BULKT, TWOD, DIST, DIST2, RIGIDBODY, RMAT) 1075:                                 BULKT, TWOD, DIST, DIST2, RIGIDBODY, RMAT) 
1081:                         ELSE1076:                         ELSE
1082:                            CALL MINPERMDIST(LASTFRAME,TMP%Q,NATOMS,DEBUG,PARAM1,PARAM2,PARAM3,BULKT,TWOD,DIST,DIST2,RIGIDBODY,RMAT)1077:                            CALL MINPERMDIST(LASTFRAME,TMP%Q,NATOMS,DEBUG,PARAM1,PARAM2,PARAM3,BULKT,TWOD,DIST,DIST2,RIGIDBODY,RMAT)
1083:                         ENDIF1078:                         ENDIF
1084:                      ELSE1079:                      ELSE
1085:                         IF (RBAAT) THEN1080:                         IF (RBAAT) THEN
1086:                            CALL RBMINDIST(LASTFRAME,TMP%Q,NATOMS,DIST,Q2,DEBUG)1081:                            CALL RBMINDIST(LASTFRAME,TMP%Q,NATOMS,DIST,Q2,DEBUG)
1087:                            CALL QROTMAT (Q2, RMATBEST)1082:                            CALL QROTMAT (Q2, RMATBEST)
1088:                         ELSEIF (VARIABLES) THEN 
1089:                         ELSE1083:                         ELSE
1090:                            CALL NEWMINDIST(LASTFRAME,TMP%Q,NATOMS,D,BULKT,TWOD,TMP%SYM(1),.TRUE.,RIGIDBODY,DEBUG,RMAT)1084:                            CALL NEWMINDIST(LASTFRAME,TMP%Q,NATOMS,D,BULKT,TWOD,TMP%SYM(1),.TRUE.,RIGIDBODY,DEBUG,RMAT)
1091:                            CALL NEWROTGEOM(NATOMS,TMP%Q,RMAT,CMXA,CMYA,CMZA)1085:                            CALL NEWROTGEOM(NATOMS,TMP%Q,RMAT,CMXA,CMYA,CMZA)
1092:                            IF (NFREEZE.LE.0 .AND..NOT.MIEFT) THEN1086:                            IF (NFREEZE.LE.0 .AND..NOT.MIEFT) THEN
1093:                               DO J1=1,NATOMS1087:                               DO J1=1,NATOMS
1094:                                  J2=3*J11088:                                  J2=3*J1
1095:                                  TMP%Q(J2-2)=TMP%Q(J2-2)+CMXFIX-CMXA1089:                                  TMP%Q(J2-2)=TMP%Q(J2-2)+CMXFIX-CMXA
1096:                                  TMP%Q(J2-1)=TMP%Q(J2-1)+CMYFIX-CMYA1090:                                  TMP%Q(J2-1)=TMP%Q(J2-1)+CMYFIX-CMYA
1097:                                  TMP%Q(J2)  =TMP%Q(J2)  +CMZFIX-CMZA1091:                                  TMP%Q(J2)  =TMP%Q(J2)  +CMZFIX-CMZA
1098:                               ENDDO1092:                               ENDDO
1142:                               J2 = 3*J11136:                               J2 = 3*J1
1143:                               XS(J2-2:J2) = MATMUL(RMATBEST,XS(J2-2:J2))1137:                               XS(J2-2:J2) = MATMUL(RMATBEST,XS(J2-2:J2))
1144:                            ENDDO1138:                            ENDDO
1145:                            IF (PERMDIST .AND. (.NOT. PAPT)) THEN1139:                            IF (PERMDIST .AND. (.NOT. PAPT)) THEN
1146:                               DO J1 = 1, NATOMS/21140:                               DO J1 = 1, NATOMS/2
1147:                                  J2 = 3*J11141:                                  J2 = 3*J1
1148:                                  TMP%Q(J2-2:J2) = MATMUL(RMATBEST,TMP%Q(J2-2:J2))1142:                                  TMP%Q(J2-2:J2) = MATMUL(RMATBEST,TMP%Q(J2-2:J2))
1149:                               ENDDO1143:                               ENDDO
1150:                            ELSE1144:                            ELSE
1151:                               CALL RBROT(TMP%Q,X,Q2,NATOMS)1145:                               CALL RBROT(TMP%Q,X,Q2,NATOMS)
1152:                               TMP%Q(1:NOPT) = X(1:NOPT) 1146:                               TMP%Q(1:3*NATOMS) = X(1:3*NATOMS) 
1153:                            ENDIF1147:                            ENDIF
1154:                         ENDIF1148:                         ENDIF
1155:                         IF (STOCKAAT) THEN1149:                         IF (STOCKAAT) THEN
1156:                            CALL STFRAME(TMP%COMMENT,XS,XV)1150:                            CALL STFRAME(TMP%COMMENT,XS,XV)
1157:                         ELSE1151:                         ELSE
1158:                            CALL RBFRAME(TMP%COMMENT,XS,TMP%Q,RMATBEST)1152:                            CALL RBFRAME(TMP%COMMENT,XS,TMP%Q,RMATBEST)
1159:                         ENDIF                    1153:                         ENDIF                    
1160: ! hk286 - fix this1154: ! hk286 - fix this
1161:                      ELSEIF (GTHOMSONT) THEN1155:                      ELSEIF (GTHOMSONT) THEN
1162:                         IF ((I>1.AND.K>1).AND.(.NOT.UNRST)) THEN1156:                         IF ((I>1.AND.K>1).AND.(.NOT.UNRST)) THEN
1169: ! Duplicate the first frame if requested to make movies pause1163: ! Duplicate the first frame if requested to make movies pause
1170: ! at end points.1164: ! at end points.
1171: !1165: !
1172:                         IF ((I.EQ.1).AND.(K.EQ.1).AND.(NENDDUP.GT.0)) THEN1166:                         IF ((I.EQ.1).AND.(K.EQ.1).AND.(NENDDUP.GT.0)) THEN
1173:                            IF (DEBUG) PRINT '(A,3I6)','ncutils> writing NENDDUP extra start frames'1167:                            IF (DEBUG) PRINT '(A,3I6)','ncutils> writing NENDDUP extra start frames'
1174:                            DO J2=1,NENDDUP1168:                            DO J2=1,NENDDUP
1175:                               CALL WRITEFRAME(TMP%COMMENT,TMP%SYM,TMP%Q)1169:                               CALL WRITEFRAME(TMP%COMMENT,TMP%SYM,TMP%Q)
1176:                            ENDDO1170:                            ENDDO
1177:                         ENDIF1171:                         ENDIF
1178:                      ELSE1172:                      ELSE
1179:                         IF ((I>1.AND.K>1).AND.(.NOT.(UNRST.OR.VARIABLES))) THEN1173:                         IF ((I>1.AND.K>1).AND.(.NOT.UNRST)) THEN
1180:                            IF (.NOT.BULKT) THEN1174:                            IF (.NOT.BULKT) THEN
1181:                               CALL NEWROTGEOM(NATOMS,TMP%Q,RMAT,CMXA,CMYA,CMZA) 1175:                               CALL NEWROTGEOM(NATOMS,TMP%Q,RMAT,CMXA,CMYA,CMZA) 
1182:                               IF (NFREEZE.LE.0.AND..NOT.MIEFT) THEN1176:                               IF (NFREEZE.LE.0.AND..NOT.MIEFT) THEN
1183:                                  DO J1=1,NATOMS1177:                                  DO J1=1,NATOMS
1184:                                     TMP%Q(3*(J1-1)+1)=TMP%Q(3*(J1-1)+1)-CMXA+CMXFIX1178:                                     TMP%Q(3*(J1-1)+1)=TMP%Q(3*(J1-1)+1)-CMXA+CMXFIX
1185:                                     TMP%Q(3*(J1-1)+2)=TMP%Q(3*(J1-1)+2)-CMYA+CMYFIX1179:                                     TMP%Q(3*(J1-1)+2)=TMP%Q(3*(J1-1)+2)-CMYA+CMYFIX
1186:                                     TMP%Q(3*(J1-1)+3)=TMP%Q(3*(J1-1)+3)-CMZA+CMZFIX1180:                                     TMP%Q(3*(J1-1)+3)=TMP%Q(3*(J1-1)+3)-CMZA+CMZFIX
1187:                                  ENDDO1181:                                  ENDDO
1188:                               ENDIF1182:                               ENDIF
1189:                            ELSE1183:                            ELSE
1287:              DUMMY=>DUMMY%NEXT1281:              DUMMY=>DUMMY%NEXT
1288:              I=I+11282:              I=I+1
1289:           ENDDO1283:           ENDDO
1290:           DEALLOCATE(LASTFRAME)1284:           DEALLOCATE(LASTFRAME)
1291:           CLOSE(50)1285:           CLOSE(50)
1292:           IF (RBAAT) CLOSE(55)1286:           IF (RBAAT) CLOSE(55)
1293:           CLOSE(41)1287:           CLOSE(41)
1294:      END SUBROUTINE MERGEXYZEOFS1288:      END SUBROUTINE MERGEXYZEOFS
1295: 1289: 
1296:      SUBROUTINE WRITEFRAME(C,S,Q)1290:      SUBROUTINE WRITEFRAME(C,S,Q)
1297:           USE KEY,ONLY : STOCKT, RBAAT, STOCKAAT, NTSITES, PAIRCOLOURT, GTHOMSONT, VARIABLES1291:           USE KEY,ONLY : STOCKT, RBAAT, STOCKAAT, NTSITES, PAIRCOLOURT, GTHOMSONT
1298:           IMPLICIT NONE1292:           IMPLICIT NONE
1299: 1293: 
1300:           CHARACTER(LEN=132),INTENT(IN)         :: C1294:           CHARACTER(LEN=132),INTENT(IN)         :: C
1301:           CHARACTER(LEN=5),POINTER,DIMENSION(:) :: S1295:           CHARACTER(LEN=5),POINTER,DIMENSION(:) :: S
1302:           DOUBLE PRECISION,POINTER,DIMENSION(:) :: Q1296:           DOUBLE PRECISION,POINTER,DIMENSION(:) :: Q
1303:           DOUBLE PRECISION SITES(3*NTSITES), P(3), RM(3,3)1297:           DOUBLE PRECISION SITES(3*NTSITES), P(3), RM(3,3)
1304:           CHARACTER(LEN=2) ZSTRING(NATOMS)1298:           CHARACTER(LEN=2) ZSTRING(NATOMS)
1305: 1299: 
1306:           INTEGER :: J1300:           INTEGER :: J
1307:           DOUBLE PRECISION :: TMPCOORDS(9*NATOMS/2)1301:           DOUBLE PRECISION :: TMPCOORDS(9*NATOMS/2)
1346:                    ELSEIF (ZSTRING(J).EQ.'X2') THEN1340:                    ELSEIF (ZSTRING(J).EQ.'X2') THEN
1347:                       WRITE(50,'(A5,1X,6F20.10)') ZSTRING(J),Q(3*(J-1)+1),Q(3*(J-1)+2),Q(3*(J-1)+3), &1341:                       WRITE(50,'(A5,1X,6F20.10)') ZSTRING(J),Q(3*(J-1)+1),Q(3*(J-1)+2),Q(3*(J-1)+3), &
1348:    &                                              0.0D0,0.0D0,0.0D01342:    &                                              0.0D0,0.0D0,0.0D0
1349:                    ELSE1343:                    ELSE
1350:                       WRITE(50,'(A5,1X,6F20.10)') ZSTRING(J),Q(3*(J-1)+1),Q(3*(J-1)+2),Q(3*(J-1)+3), &1344:                       WRITE(50,'(A5,1X,6F20.10)') ZSTRING(J),Q(3*(J-1)+1),Q(3*(J-1)+2),Q(3*(J-1)+3), &
1351:    &                                              1.0D0,0.0D0,0.0D01345:    &                                              1.0D0,0.0D0,0.0D0
1352:                    ENDIF1346:                    ENDIF
1353:                 ENDDO1347:                 ENDDO
1354: 1348: 
1355:              ELSE1349:              ELSE
1356:                 IF (VARIABLES) THEN1350:                 DO J=1,NATOMS
1357:                    DO J=1,NOPT1351:                    WRITE(50,'(A5,1X,3F20.10)') S(J),Q(3*(J-1)+1),Q(3*(J-1)+2),Q(3*(J-1)+3)
1358:                       WRITE(50,'(A5,1X,F20.10)') S(J),Q(J)1352:                 ENDDO
1359:                    ENDDO 
1360:                 ELSE 
1361:                    DO J=1,NATOMS 
1362:                       WRITE(50,'(A5,1X,3F20.10)') S(J),Q(3*(J-1)+1),Q(3*(J-1)+2),Q(3*(J-1)+3) 
1363:                    ENDDO 
1364:                 ENDIF 
1365:              ENDIF1353:              ENDIF
1366:           ENDIF1354:           ENDIF
1367:      END SUBROUTINE WRITEFRAME1355:      END SUBROUTINE WRITEFRAME
1368: 1356: 
1369:      SUBROUTINE WRITEFRAMEUNRES(C,S,Q) ! JMC WRITE COORDS PLUS DUMMY PEPTIDE GROUPS FOR UNRES VISUALISATION PURPOSES1357:      SUBROUTINE WRITEFRAMEUNRES(C,S,Q) ! JMC WRITE COORDS PLUS DUMMY PEPTIDE GROUPS FOR UNRES VISUALISATION PURPOSES
1370:           IMPLICIT NONE1358:           IMPLICIT NONE
1371: 1359: 
1372:           CHARACTER(LEN=132),INTENT(IN)         :: C1360:           CHARACTER(LEN=132),INTENT(IN)         :: C
1373:           CHARACTER(LEN=5),POINTER,DIMENSION(:) :: S1361:           CHARACTER(LEN=5),POINTER,DIMENSION(:) :: S
1374:           DOUBLE PRECISION,POINTER,DIMENSION(:)          :: Q1362:           DOUBLE PRECISION,POINTER,DIMENSION(:)          :: Q
1436:           INTEGER,POINTER :: FINALPATHTS(:)1424:           INTEGER,POINTER :: FINALPATHTS(:)
1437: 1425: 
1438:           INTEGER :: RECLEN, I,J, NSP,NMINSAVED,NTSSAVED,REC1,REC21426:           INTEGER :: RECLEN, I,J, NSP,NMINSAVED,NTSSAVED,REC1,REC2
1439:           INTEGER,POINTER :: MINRECORDS(:)1427:           INTEGER,POINTER :: MINRECORDS(:)
1440:           LOGICAL,POINTER :: MINSAVED(:)1428:           LOGICAL,POINTER :: MINSAVED(:)
1441:           CHARACTER(LEN=256) :: MYSTR1429:           CHARACTER(LEN=256) :: MYSTR
1442:           1430:           
1443:           ALLOCATE(MINRECORDS(NMIN),MINSAVED(NMIN))1431:           ALLOCATE(MINRECORDS(NMIN),MINSAVED(NMIN))
1444:           MINSAVED=.FALSE.1432:           MINSAVED=.FALSE.
1445:           MINRECORDS=01433:           MINRECORDS=0
1446:           INQUIRE(IOLENGTH=RECLEN) (MI(DUMMY%I)%DATA%X(I),I=1,NOPT)1434:           INQUIRE(IOLENGTH=RECLEN) (MI(DUMMY%I)%DATA%X(I),I=1,3*NATOMS)
1447:           1435:           
1448:           IF (FINISHED) THEN1436:           IF (FINISHED) THEN
1449:                DUMMY=>START1437:                DUMMY=>START
1450:                NSP=01438:                NSP=0
1451:                DO1439:                DO
1452:                     NSP=NSP+11440:                     NSP=NSP+1
1453:                     WRITE(MYSTR,*) NSP1441:                     WRITE(MYSTR,*) NSP
1454:                     MYSTR='points'//trim(adjustl(mystr))//'.out'1442:                     MYSTR='points'//trim(adjustl(mystr))//'.out'
1455:                     OPEN(UNIT=38,FILE=TRIM(ADJUSTL(MYSTR)),STATUS='unknown',form='unformatted',access='direct',recl=reclen)1443:                     OPEN(UNIT=38,FILE=TRIM(ADJUSTL(MYSTR)),STATUS='unknown',form='unformatted',access='direct',recl=reclen)
1456:                     WRITE(38,REC=1) (MI(DUMMY%I)%DATA%X(I),I=1,NOPT)1444:                     WRITE(38,REC=1) (MI(DUMMY%I)%DATA%X(I),I=1,3*NATOMS)
1457:                     CLOSE(38)1445:                     CLOSE(38)
1458:                     IF (ASSOCIATED(DUMMY%NEXT)) THEN1446:                     IF (ASSOCIATED(DUMMY%NEXT)) THEN
1459:                          NSP=NSP+11447:                          NSP=NSP+1
1460:                          WRITE(MYSTR,*) NSP1448:                          WRITE(MYSTR,*) NSP
1461:                          MYSTR='points'//trim(adjustl(mystr))//'.out'1449:                          MYSTR='points'//trim(adjustl(mystr))//'.out'
1462:                          OPEN(UNIT=38,FILE=TRIM(ADJUSTL(MYSTR)),STATUS='unknown',form='unformatted',access='direct',recl=reclen)1450:                          OPEN(UNIT=38,FILE=TRIM(ADJUSTL(MYSTR)),STATUS='unknown',form='unformatted',access='direct',recl=reclen)
1463:                          WRITE(38,REC=1) (TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X(I),I=1,NOPT)1451:                          WRITE(38,REC=1) (TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X(I),I=1,NOPT)
1464:                          CLOSE(38)1452:                          CLOSE(38)
1465:                          DUMMY=>DUMMY%NEXT1453:                          DUMMY=>DUMMY%NEXT
1466:                     ELSE1454:                     ELSE
1478:                NMINSAVED=01466:                NMINSAVED=0
1479:                NTSSAVED=01467:                NTSSAVED=0
1480:                MAIN: DO J=1,NTS1468:                MAIN: DO J=1,NTS
1481:                     IF (TS(J)%DATA%BAD) CYCLE ! DATA%P AND DATA%M WILL BE UNDEFINED!1469:                     IF (TS(J)%DATA%BAD) CYCLE ! DATA%P AND DATA%M WILL BE UNDEFINED!
1482:                     IF (ASSOCIATED(FINALPATHTS)) THEN1470:                     IF (ASSOCIATED(FINALPATHTS)) THEN
1483:                          DO I=1,SIZE(FINALPATHTS)1471:                          DO I=1,SIZE(FINALPATHTS)
1484:                               IF (FINALPATHTS(I)==J) CYCLE MAIN1472:                               IF (FINALPATHTS(I)==J) CYCLE MAIN
1485:                          ENDDO     1473:                          ENDDO     
1486:                     ENDIF1474:                     ENDIF
1487:                     NTSSAVED=NTSSAVED+11475:                     NTSSAVED=NTSSAVED+1
1488:                     WRITE(38,REC=NTSSAVED) ( TS(J)%DATA%X(I),I=1,NOPT )1476:                     WRITE(38,REC=NTSSAVED) ( TS(J)%DATA%X(I),I=1,3*NATOMS )
1489:                     IF (MINSAVED(TS(J)%DATA%P)) THEN1477:                     IF (MINSAVED(TS(J)%DATA%P)) THEN
1490:                          REC1=MINRECORDS(TS(J)%DATA%P)1478:                          REC1=MINRECORDS(TS(J)%DATA%P)
1491:                     ELSE1479:                     ELSE
1492:                          NMINSAVED=NMINSAVED+11480:                          NMINSAVED=NMINSAVED+1
1493:                          MINSAVED(TS(J)%DATA%P)=.TRUE.1481:                          MINSAVED(TS(J)%DATA%P)=.TRUE.
1494:                          MINRECORDS(TS(J)%DATA%P)=NMINSAVED1482:                          MINRECORDS(TS(J)%DATA%P)=NMINSAVED
1495:                          WRITE(40,REC=NMINSAVED) ( MI(TS(J)%DATA%P)%DATA%X(I),I=1,NOPT )1483:                          WRITE(40,REC=NMINSAVED) ( MI(TS(J)%DATA%P)%DATA%X(I),I=1,3*NATOMS )
1496:                          REC1=NMINSAVED1484:                          REC1=NMINSAVED
1497:                     ENDIF1485:                     ENDIF
1498:                     IF (MINSAVED(TS(J)%DATA%M)) THEN1486:                     IF (MINSAVED(TS(J)%DATA%M)) THEN
1499:                          REC2=MINRECORDS(TS(J)%DATA%M)1487:                          REC2=MINRECORDS(TS(J)%DATA%M)
1500:                     ELSE1488:                     ELSE
1501:                          NMINSAVED=NMINSAVED+11489:                          NMINSAVED=NMINSAVED+1
1502:                          MINSAVED(TS(J)%DATA%M)=.TRUE.1490:                          MINSAVED(TS(J)%DATA%M)=.TRUE.
1503:                          MINRECORDS(TS(J)%DATA%M)=NMINSAVED1491:                          MINRECORDS(TS(J)%DATA%M)=NMINSAVED
1504:                          WRITE(40,REC=NMINSAVED) ( MI(TS(J)%DATA%M)%DATA%X(I),I=1,NOPT )1492:                          WRITE(40,REC=NMINSAVED) ( MI(TS(J)%DATA%M)%DATA%X(I),I=1,3*NATOMS )
1505:                          REC2=NMINSAVED1493:                          REC2=NMINSAVED
1506:                     ENDIF1494:                     ENDIF
1507:                     WRITE(39,'(2i10)') rec1,rec21495:                     WRITE(39,'(2i10)') rec1,rec2
1508:                ENDDO MAIN1496:                ENDDO MAIN
1509:                CLOSE(39)1497:                CLOSE(39)
1510:                CLOSE(38)1498:                CLOSE(38)
1511:                CLOSE(40)1499:                CLOSE(40)
1512:                IF (ASSOCIATED(FINALPATHTS)) DEALLOCATE(FINALPATHTS)1500:                IF (ASSOCIATED(FINALPATHTS)) DEALLOCATE(FINALPATHTS)
1513:           ENDIF1501:           ENDIF
1514:      END SUBROUTINE DUMPDB1502:      END SUBROUTINE DUMPDB
1518: ! format and updated for AMBER, NAB and AMH 30/5/11 DJW.1506: ! format and updated for AMBER, NAB and AMH 30/5/11 DJW.
1519: !1507: !
1520:      SUBROUTINE MAKEPATHINFO1508:      SUBROUTINE MAKEPATHINFO
1521:      USE SYMINF1509:      USE SYMINF
1522:      USE MODHESS1510:      USE MODHESS
1523:      USE MODCHARMM1511:      USE MODCHARMM
1524:      USE PORFUNCS1512:      USE PORFUNCS
1525:      USE MODUNRES1513:      USE MODUNRES
1526:      USE KEY, ONLY: FILTH, FILTHSTR, UNRST, TWOD, BULKT, MACHINE, RIGIDBODY, NOFRQS, PERMDIST, &1514:      USE KEY, ONLY: FILTH, FILTHSTR, UNRST, TWOD, BULKT, MACHINE, RIGIDBODY, NOFRQS, PERMDIST, &
1527:   &                 AMHT, SEQ, SDT, NRES_AMH_TEMP, AMBERT, NABT, MACROCYCLET, TTM3T, BOWMANT, &1515:   &                 AMHT, SEQ, SDT, NRES_AMH_TEMP, AMBERT, NABT, MACROCYCLET, TTM3T, BOWMANT, &
1528:   &                 HESSDUMPT,INSTANTONSTARTDUMPT, METRICTENSOR, RBAAT, AMBER12T, VARIABLES1516:   &                 HESSDUMPT,INSTANTONSTARTDUMPT, METRICTENSOR, RBAAT, AMBER12T
1529: 1517: 
1530:      USE COMMONS, ONLY: ATMASS, NINTS, ZSYM, PARAM1, PARAM2, PARAM3, DEBUG1518:      USE COMMONS, ONLY: ATMASS, NINTS, ZSYM, PARAM1, PARAM2, PARAM3, DEBUG
1531: 1519: 
1532:      USE GENRIGID1520:      USE GENRIGID
1533: 1521: 
1534:      IMPLICIT NONE1522:      IMPLICIT NONE
1535:      DOUBLE PRECISION RMAT(3,3), DIST, DIST21523:      DOUBLE PRECISION RMAT(3,3), DIST, DIST2
1536: 1524: 
1537: !    LOCAL AMH VARIABLES1525: !    LOCAL AMH VARIABLES
1538:      INTEGER :: I_RES, GLY_COUNT1526:      INTEGER :: I_RES, GLY_COUNT
1539:      CHARACTER(LEN=5) :: TARFL1527:      CHARACTER(LEN=5) :: TARFL
1540: 1528: 
1541:      CHARACTER(LEN=20) :: PINFOSTRING1529:      CHARACTER(LEN=20) :: PINFOSTRING
1542:      DOUBLE PRECISION :: DIHE,ALLANG,DISTPF,DUMMY1,GRAD(NOPT),RMS,DIAG(NOPT),TEMPA(9*NATOMS),DUMQ(NOPT)1530:      DOUBLE PRECISION :: DIHE,ALLANG,DISTPF,DUMMY1,GRAD(3*NATOMS),RMS,DIAG(3*NATOMS),TEMPA(9*NATOMS),DUMQ(3*NATOMS)
1543:      DOUBLE PRECISION :: PREVIOUSTS(NOPT), INERTIA(3,3)1531:      DOUBLE PRECISION :: PREVIOUSTS(3*NATOMS), INERTIA(3,3)
1544:      INTEGER :: HORDER,I,INFO,J2,K1,RECLEN,ISTAT,LUNIT,GETUNIT1532:      INTEGER :: HORDER,I,INFO,J2,K1,RECLEN,ISTAT,LUNIT,GETUNIT
1545:      LOGICAL :: BTEST,KD,NNZ,NINTB,TSFRQDONE,MINFRQDONE,AGAIN1533:      LOGICAL :: BTEST,KD,NNZ,NINTB,TSFRQDONE,MINFRQDONE,AGAIN
1546:      DOUBLE PRECISION :: XRIGIDCOORDS(DEGFREEDOMS), XCOORDS(NOPT) ! sn402: for GENRIGID1534:      DOUBLE PRECISION :: XRIGIDCOORDS(DEGFREEDOMS), XCOORDS(3*NATOMS) ! sn402: for GENRIGID
1547:      TSFRQDONE=.FALSE.1535:      TSFRQDONE=.FALSE.
1548:      MINFRQDONE=.FALSE.1536:      MINFRQDONE=.FALSE.
1549: 1537: 
1550:      DUMMY=>START1538:      DUMMY=>START
1551:      I=11539:      I=1
1552:      DO1540:      DO
1553:         AGAIN=.TRUE.1541:         AGAIN=.TRUE.
1554: 642     CONTINUE1542: 642     CONTINUE
1555:         IF (UNRST.AND.CALCDIHE) THEN1543:         IF (UNRST.AND.CALCDIHE) THEN
1556:            CALL UNRESCALCDIHEREF(DIHE,ALLANG,MI(DUMMY%I)%DATA%X)1544:            CALL UNRESCALCDIHEREF(DIHE,ALLANG,MI(DUMMY%I)%DATA%X)
1592:                  ELSE1580:                  ELSE
1593:                     IF (ENDNUMHESS) THEN1581:                     IF (ENDNUMHESS) THEN
1594:                         CALL MAKENUMHESS(MI(DUMMY%I)%DATA%X,NATOMS)1582:                         CALL MAKENUMHESS(MI(DUMMY%I)%DATA%X,NATOMS)
1595:                     ELSE1583:                     ELSE
1596:                         CALL POTENTIAL(MI(DUMMY%I)%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)1584:                         CALL POTENTIAL(MI(DUMMY%I)%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
1597:                     ENDIF1585:                     ENDIF
1598:                     CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)1586:                     CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
1599:                     IF (HESSDUMPT) THEN1587:                     IF (HESSDUMPT) THEN
1600:                         LUNIT=GETUNIT()1588:                         LUNIT=GETUNIT()
1601:                         OPEN(LUNIT,FILE='minhess.plus',STATUS='UNKNOWN',POSITION ='APPEND')1589:                         OPEN(LUNIT,FILE='minhess.plus',STATUS='UNKNOWN',POSITION ='APPEND')
1602:                         WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)1590:                         WRITE(LUNIT,'(6G20.10)') HESS(1:3*NATOMS,1:3*NATOMS)
1603:                         CLOSE(LUNIT)1591:                         CLOSE(LUNIT)
1604:                     ENDIF1592:                     ENDIF
1605:                     CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)1593:                     CALL DSYEV('N','U',3*NATOMS,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
1606:                     IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)1594:                     IF (DIAG(1).LT.DIAG(3*NATOMS)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,3*NATOMS,3*NATOMS)
1607: 1595: 
1608: ! jbr36 - writes the first input for qm rate calculations from classical rates1596: ! jbr36 - writes the first input for qm rate calculations from classical rates
1609:                     IF (INSTANTONSTARTDUMPT) THEN1597:                     IF (INSTANTONSTARTDUMPT) THEN
1610:                        LUNIT=5551598:                        LUNIT=555
1611:                        OPEN(LUNIT,file='qmrate_reactant.plus.txt', action='WRITE')1599:                        OPEN(LUNIT,file='qmrate_reactant.plus.txt', action='WRITE')
1612:                        WRITE(LUNIT,'(a)') "Energy and Hessian eigenvalues of reactant.plus"1600:                        WRITE(LUNIT,'(a)') "Energy and Hessian eigenvalues of reactant.plus"
1613:                        WRITE(LUNIT,*) NATOMS,NATOMS*31601:                        WRITE(LUNIT,*) NATOMS,NATOMS*3
1614:                        WRITE(LUNIT,*) DUMMY11602:                        WRITE(LUNIT,*) DUMMY1
1615:                        WRITE(LUNIT,*) "Coordinates"1603:                        WRITE(LUNIT,*) "Coordinates"
1616:                        WRITE(LUNIT,*) MI(DUMMY%I)%DATA%X1604:                        WRITE(LUNIT,*) MI(DUMMY%I)%DATA%X
1617:                        WRITE(LUNIT,*) "Hessian Eigenvalues"1605:                        WRITE(LUNIT,*) "Hessian Eigenvalues"
1618:                        WRITE(LUNIT,*) DIAG1606:                        WRITE(LUNIT,*) DIAG
1619:                        WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"1607:                        WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"
1620:                        WRITE(LUNIT,*) ATMASS1608:                        WRITE(LUNIT,*) ATMASS
1621:                        CLOSE(LUNIT)1609:                        CLOSE(LUNIT)
1622:                     ENDIF1610:                     ENDIF
1623: 1611: 
1624:                     IF (MACHINE) THEN1612:                     IF (MACHINE) THEN
1625:                        WRITE(88) (DIAG(J2)*4.184D26,J2=1,NOPT)1613:                        WRITE(88) (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
1626:                     ELSE1614:                     ELSE
1627:                        WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,NOPT)1615:                        WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
1628:                     ENDIF1616:                     ENDIF
1629:                  ENDIF1617:                  ENDIF
1630:               ENDIF1618:               ENDIF
1631:            ELSEIF (AMBER12T.OR.AMBERT.OR.NABT) THEN1619:            ELSEIF (AMBER12T.OR.AMBERT.OR.NABT) THEN
1632:               IF (.NOT.MACROCYCLET) THEN1620:               IF (.NOT.MACROCYCLET) THEN
1633:                  HORDER=11621:                  HORDER=1
1634:                  FPGRP='C1'1622:                  FPGRP='C1'
1635:               ELSE1623:               ELSE
1636:                  CALL SYMMETRY(HORDER,.FALSE.,MI(DUMMY%I)%DATA%X,INERTIA)1624:                  CALL SYMMETRY(HORDER,.FALSE.,MI(DUMMY%I)%DATA%X,INERTIA)
1637:               ENDIF1625:               ENDIF
1656:                  ELSE1644:                  ELSE
1657:                     IF (ENDNUMHESS.OR.AMBERT.OR.AMBER12T) THEN1645:                     IF (ENDNUMHESS.OR.AMBERT.OR.AMBER12T) THEN
1658:                         CALL MAKENUMHESS(MI(DUMMY%I)%DATA%X,NATOMS)1646:                         CALL MAKENUMHESS(MI(DUMMY%I)%DATA%X,NATOMS)
1659:                     ELSE1647:                     ELSE
1660:                         CALL POTENTIAL(MI(DUMMY%I)%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)1648:                         CALL POTENTIAL(MI(DUMMY%I)%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
1661:                     ENDIF1649:                     ENDIF
1662:                     CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)1650:                     CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
1663:                     IF (HESSDUMPT) THEN1651:                     IF (HESSDUMPT) THEN
1664:                         LUNIT=GETUNIT()1652:                         LUNIT=GETUNIT()
1665:                         OPEN(LUNIT,FILE='minhess.plus',STATUS='UNKNOWN',POSITION ='APPEND')1653:                         OPEN(LUNIT,FILE='minhess.plus',STATUS='UNKNOWN',POSITION ='APPEND')
1666:                         WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)1654:                         WRITE(LUNIT,'(6G20.10)') HESS(1:3*NATOMS,1:3*NATOMS)
1667:                         CLOSE(LUNIT)1655:                         CLOSE(LUNIT)
1668:                     ENDIF1656:                     ENDIF
1669:                     CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)1657:                     CALL DSYEV('N','U',3*NATOMS,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
1670:                     IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)1658:                     IF (DIAG(1).LT.DIAG(3*NATOMS)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,3*NATOMS,3*NATOMS)
1671: ! jbr36 - writes the first input for qm rate calculations from classical rates1659: ! jbr36 - writes the first input for qm rate calculations from classical rates
1672:                     IF (INSTANTONSTARTDUMPT) THEN1660:                     IF (INSTANTONSTARTDUMPT) THEN
1673:                           LUNIT=5551661:                           LUNIT=555
1674:                           open(LUNIT,file='qmrate_reactant.plus.txt', action='write')1662:                           open(LUNIT,file='qmrate_reactant.plus.txt', action='write')
1675:                           write(LUNIT,'(a)') "Energy and Hessian eigenvalues of reactant.plus"1663:                           write(LUNIT,'(a)') "Energy and Hessian eigenvalues of reactant.plus"
1676:                           write(LUNIT,*) NATOMS,NATOMS*31664:                           write(LUNIT,*) NATOMS,NATOMS*3
1677:                           write(LUNIT,*) DUMMY11665:                           write(LUNIT,*) DUMMY1
1678:                           write(LUNIT,*) "Coordinates"1666:                           write(LUNIT,*) "Coordinates"
1679:                           write(LUNIT,*) MI(DUMMY%I)%DATA%X1667:                           write(LUNIT,*) MI(DUMMY%I)%DATA%X
1680:                           write(LUNIT,*) "Hessian Eigenvalues"1668:                           write(LUNIT,*) "Hessian Eigenvalues"
1681:                           write(LUNIT,*) DIAG1669:                           write(LUNIT,*) DIAG
1682:                           write(LUNIT,*) "Masses in amu (M(12C)=12)"1670:                           write(LUNIT,*) "Masses in amu (M(12C)=12)"
1683:                           write(LUNIT,*) ATMASS1671:                           write(LUNIT,*) ATMASS
1684:                           close(LUNIT)1672:                           close(LUNIT)
1685:                     ENDIF1673:                     ENDIF
1686:                     IF (MACHINE) THEN1674:                     IF (MACHINE) THEN
1687:                         WRITE(88) (DIAG(J2)*4.184D26,J2=1,NOPT)1675:                         WRITE(88) (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
1688:                     ELSE1676:                     ELSE
1689:                         WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,NOPT)1677:                         WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
1690:                     ENDIF1678:                     ENDIF
1691:                  ENDIF1679:                  ENDIF
1692:               ENDIF1680:               ENDIF
1693:            ELSEIF (UNRST) THEN1681:            ELSEIF (UNRST) THEN
1694:               HORDER=11682:               HORDER=1
1695:               FPGRP='C1'1683:               FPGRP='C1'
1696:               WRITE(88,'(I6,1X,A4)') HORDER,FPGRP1684:               WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
1697:               IF (.NOT.NOFRQS) THEN1685:               IF (.NOT.NOFRQS) THEN
1698:                  IF (ENDNUMHESS) THEN1686:                  IF (ENDNUMHESS) THEN
1699:                     CALL MAKENUMINTHESS(NINTS,NATOMS)1687:                     CALL MAKENUMINTHESS(NINTS,NATOMS)
1700:                     CALL GETSTUFF(KD,NNZ,NINTB)1688:                     CALL GETSTUFF(KD,NNZ,NINTB)
1701:                     CALL INTSECDET(MI(DUMMY%I)%DATA%X,NOPT,KD,NNZ,NINTB,DIAG)1689:                     CALL INTSECDET(MI(DUMMY%I)%DATA%X,3*NATOMS,KD,NNZ,NINTB,DIAG)
1702:                  ELSE1690:                  ELSE
1703:                     CALL POTENTIAL(MI(DUMMY%I)%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)1691:                     CALL POTENTIAL(MI(DUMMY%I)%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
1704:                  ENDIF1692:                  ENDIF
1705:                  WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)1693:                  WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,3*NATOMS)
1706:               ENDIF1694:               ENDIF
1707:            ELSEIF (AMHT) THEN1695:            ELSEIF (AMHT) THEN
1708:               HORDER=11696:               HORDER=1
1709:               FPGRP='C1'1697:               FPGRP='C1'
1710:               WRITE(88,'(I6,1X,A4)') HORDER,FPGRP1698:               WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
1711:               IF (.NOT.NOFRQS) THEN1699:               IF (.NOT.NOFRQS) THEN
1712:                  IF (ENDNUMHESS) THEN1700:                  IF (ENDNUMHESS) THEN
1713:                     CALL MAKENUMHESS(MI(DUMMY%I)%DATA%X,NATOMS)1701:                     CALL MAKENUMHESS(MI(DUMMY%I)%DATA%X,NATOMS)
1714:                  ELSE1702:                  ELSE
1715:                     CALL POTENTIAL(MI(DUMMY%I)%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)1703:                     CALL POTENTIAL(MI(DUMMY%I)%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
1716:                  ENDIF1704:                  ENDIF
1717:                  CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)1705:                  CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
1718:                  IF (HESSDUMPT) THEN1706:                  IF (HESSDUMPT) THEN
1719:                     LUNIT=GETUNIT()1707:                     LUNIT=GETUNIT()
1720:                     OPEN(LUNIT,FILE='minhess.plus',STATUS='UNKNOWN',POSITION ='APPEND')1708:                     OPEN(LUNIT,FILE='minhess.plus',STATUS='UNKNOWN',POSITION ='APPEND')
1721:                     WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)1709:                     WRITE(LUNIT,'(6G20.10)') HESS(1:3*NATOMS,1:3*NATOMS)
1722:                     CLOSE(LUNIT)1710:                     CLOSE(LUNIT)
1723:                  ENDIF1711:                  ENDIF
1724:                  CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)1712:                  CALL DSYEV('N','U',3*NATOMS,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
1725:                  IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)1713:                  IF (DIAG(1).LT.DIAG(3*NATOMS)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,3*NATOMS,3*NATOMS)
1726:                  WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)1714:                  WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,3*NATOMS)
1727: ! jbr36 - writes the first input for qm rate calculations from classical rates1715: ! jbr36 - writes the first input for qm rate calculations from classical rates
1728:                     IF (INSTANTONSTARTDUMPT) THEN1716:                     IF (INSTANTONSTARTDUMPT) THEN
1729: !                      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.)
1730:                       LUNIT=5551718:                       LUNIT=555
1731:                       open(LUNIT,file='qmrate_reactant.plus.txt', action='write')1719:                       open(LUNIT,file='qmrate_reactant.plus.txt', action='write')
1732:                       write(LUNIT,'(a)') "Energy and Hessian eigenvalues of reactant.plus"1720:                       write(LUNIT,'(a)') "Energy and Hessian eigenvalues of reactant.plus"
1733:                       write(LUNIT,*) NATOMS,NATOMS*31721:                       write(LUNIT,*) NATOMS,NATOMS*3
1734:                       write(LUNIT,*) DUMMY11722:                       write(LUNIT,*) DUMMY1
1735:                       write(LUNIT,*) "Coordinates"1723:                       write(LUNIT,*) "Coordinates"
1736:                       write(LUNIT,*) MI(DUMMY%I)%DATA%X1724:                       write(LUNIT,*) MI(DUMMY%I)%DATA%X
1737:                       write(LUNIT,*) "Hessian Eigenvalues"1725:                       write(LUNIT,*) "Hessian Eigenvalues"
1738:                       write(LUNIT,*) DIAG1726:                       write(LUNIT,*) DIAG
1739:                       write(LUNIT,*) "Masses in amu (M(12C)=12)"1727:                       write(LUNIT,*) "Masses in amu (M(12C)=12)"
1740:                       write(LUNIT,*) ATMASS1728:                       write(LUNIT,*) ATMASS
1741:                       close(LUNIT)1729:                       close(LUNIT)
1742:                     ENDIF1730:                     ENDIF
1743:               ENDIF1731:               ENDIF
1744:            ELSE1732:            ELSE
1745:               IF (VARIABLES) THEN1733:               CALL SYMMETRY(HORDER,.FALSE.,MI(DUMMY%I)%DATA%X,INERTIA)
1746:                  HORDER=1 
1747:                  FPGRP='C1' 
1748:               ELSE 
1749:                  CALL SYMMETRY(HORDER,.FALSE.,MI(DUMMY%I)%DATA%X,INERTIA) 
1750:               ENDIF 
1751:               WRITE(88,'(I6,1X,A4)') HORDER,FPGRP1734:               WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
1752:               IF (.NOT.NOFRQS) THEN1735:               IF (.NOT.NOFRQS) THEN
1753:                   ! sn402: The following block copied across from MAKEALLPATHINFO without much testing.1736:                   ! sn402: The following block copied across from MAKEALLPATHINFO without much testing.
1754:                   ! sn402: Currently there are two different methods implemented for finding the normal modes of1737:                   ! sn402: Currently there are two different methods implemented for finding the normal modes of
1755:                   ! local rigid bodies. GENRIGID_NORMALMODES makes use of the metric tensor formulation and so should1738:                   ! local rigid bodies. GENRIGID_NORMALMODES makes use of the metric tensor formulation and so should
1756:                   ! in principle be more accurate. Eventually this should be made the default (or indeed only) option1739:                   ! in principle be more accurate. Eventually this should be made the default (or indeed only) option
1757:                   ! and the keyword METRICTENSOR should be removed.1740:                   ! and the keyword METRICTENSOR should be removed.
1758:                   IF (RIGIDINIT) THEN1741:                   IF (RIGIDINIT) THEN
1759:                      IF(METRICTENSOR) THEN1742:                      IF(METRICTENSOR) THEN
1760:                          CALL GENRIGID_NORMALMODES(MI(DUMMY%I)%DATA%X, ATMASS, DIAG, INFO)1743:                          CALL GENRIGID_NORMALMODES(MI(DUMMY%I)%DATA%X, ATMASS, DIAG, INFO)
1764: 1747: 
1765:                      IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN1748:                      IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
1766:                         CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)1749:                         CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
1767:                     ENDIF1750:                     ENDIF
1768: ! hk286 - compute normal modes for rigid body angle axis, go to moving frame1751: ! hk286 - compute normal modes for rigid body angle axis, go to moving frame
1769:                   ELSE IF (RBAAT) THEN1752:                   ELSE IF (RBAAT) THEN
1770:                     RBAANORMALMODET = .TRUE.1753:                     RBAANORMALMODET = .TRUE.
1771:                     CALL POTENTIAL(MI(DUMMY%I)%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)1754:                     CALL POTENTIAL(MI(DUMMY%I)%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
1772:                     CALL NRMLMD (MI(DUMMY%I)%DATA%X, DIAG, .FALSE.)1755:                     CALL NRMLMD (MI(DUMMY%I)%DATA%X, DIAG, .FALSE.)
1773:                     RBAANORMALMODET = .FALSE.1756:                     RBAANORMALMODET = .FALSE.
1774: !                   WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)1757: !                   WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,3*NATOMS)
1775:                  ELSE1758:                  ELSE
1776:                     IF (ENDNUMHESS) THEN1759:                     IF (ENDNUMHESS) THEN
1777:                         CALL MAKENUMHESS(MI(DUMMY%I)%DATA%X,NATOMS)1760:                         CALL MAKENUMHESS(MI(DUMMY%I)%DATA%X,NATOMS)
1778:                     ELSE1761:                     ELSE
1779:                         CALL POTENTIAL(MI(DUMMY%I)%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)1762:                         CALL POTENTIAL(MI(DUMMY%I)%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
1780:                     ENDIF1763:                     ENDIF
1781:                     CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)1764:                     CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
1782:                     IF (HESSDUMPT) THEN1765:                     IF (HESSDUMPT) THEN
1783:                         LUNIT=GETUNIT()1766:                         LUNIT=GETUNIT()
1784:                         OPEN(LUNIT,FILE='minhess.plus',STATUS='UNKNOWN',POSITION ='APPEND')1767:                         OPEN(LUNIT,FILE='minhess.plus',STATUS='UNKNOWN',POSITION ='APPEND')
1785:                         WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)1768:                         WRITE(LUNIT,'(6G20.10)') HESS(1:3*NATOMS,1:3*NATOMS)
1786:                         CLOSE(LUNIT)1769:                         CLOSE(LUNIT)
1787:                     ENDIF1770:                     ENDIF
1788:                     CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)1771:                     CALL DSYEV('N','U',3*NATOMS,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
1789:                     IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)1772:                     IF (DIAG(1).LT.DIAG(3*NATOMS)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,3*NATOMS,3*NATOMS)
1790: ! jbr36 - writes the first input for qm rate calculations from classical rates1773: ! jbr36 - writes the first input for qm rate calculations from classical rates
1791:                     IF (INSTANTONSTARTDUMPT) THEN1774:                     IF (INSTANTONSTARTDUMPT) THEN
1792: !                      CALL POTENTIAL(MI(DUMMY%I)%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)1775: !                      CALL POTENTIAL(MI(DUMMY%I)%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
1793:                       LUNIT=5551776:                       LUNIT=555
1794:                       open(LUNIT,file='qmrate_reactant.plus.txt', action='write')1777:                       open(LUNIT,file='qmrate_reactant.plus.txt', action='write')
1795:                       write(LUNIT,'(a)') "Energy and Hessian eigenvalues of reactant.plus"1778:                       write(LUNIT,'(a)') "Energy and Hessian eigenvalues of reactant.plus"
1796:                       write(LUNIT,*) NATOMS,NATOMS*31779:                       write(LUNIT,*) NATOMS,NATOMS*3
1797:                       write(LUNIT,*) DUMMY11780:                       write(LUNIT,*) DUMMY1
1798:                       write(LUNIT,*) "Coordinates"1781:                       write(LUNIT,*) "Coordinates"
1799:                       write(LUNIT,*) MI(DUMMY%I)%DATA%X1782:                       write(LUNIT,*) MI(DUMMY%I)%DATA%X
1800:                       write(LUNIT,*) "Hessian Eigenvalues"1783:                       write(LUNIT,*) "Hessian Eigenvalues"
1801:                       write(LUNIT,*) DIAG1784:                       write(LUNIT,*) DIAG
1802:                       write(LUNIT,*) "Masses in amu (M(12C)=12)"1785:                       write(LUNIT,*) "Masses in amu (M(12C)=12)"
1803:                       write(LUNIT,*) ATMASS1786:                       write(LUNIT,*) ATMASS
1804:                       close(LUNIT)1787:                       close(LUNIT)
1805:                     ENDIF1788:                     ENDIF
1806:                  ENDIF1789:                  ENDIF
1807:                  IF (SDT.OR.TTM3T) THEN1790:                  IF (SDT.OR.TTM3T) THEN
1808:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,NOPT)1791:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
1809:                  ELSEIF (BOWMANT) THEN1792:                  ELSEIF (BOWMANT) THEN
1810:                     WRITE(88,'(3G20.10)') (DIAG(J2)*2625.47D26,J2=1,NOPT)1793:                     WRITE(88,'(3G20.10)') (DIAG(J2)*2625.47D26,J2=1,3*NATOMS)
1811:                  ELSEIF (RIGIDINIT) THEN1794:                  ELSEIF (RIGIDINIT) THEN
1812:                     IF (MACHINE) THEN1795:                     IF (MACHINE) THEN
1813:                         WRITE(88) (DIAG(J2),J2=1,DEGFREEDOMS)1796:                         WRITE(88) (DIAG(J2),J2=1,DEGFREEDOMS)
1814:                     ELSE1797:                     ELSE
1815:                         WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,DEGFREEDOMS)1798:                         WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,DEGFREEDOMS)
1816:                     ENDIF1799:                     ENDIF
1817:                  ELSE1800:                  ELSE
1818:                     WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)1801:                     WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,3*NATOMS)
1819:                  ENDIF1802:                  ENDIF
1820:               ENDIF1803:               ENDIF
1821:            ENDIF1804:            ENDIF
1822:         ELSE1805:         ELSE
1823:            IF (VARIABLES) THEN1806:            CALL SYMMETRY(HORDER,.FALSE.,MI(DUMMY%I)%DATA%X,INERTIA)
1824:               HORDER=1 
1825:               FPGRP='C1' 
1826:            ELSE 
1827:               CALL SYMMETRY(HORDER,.FALSE.,MI(DUMMY%I)%DATA%X,INERTIA) 
1828:            ENDIF 
1829:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP1807:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
1830:         ENDIF1808:         ENDIF
1831: 1809: 
1832:         IF (I.GT.1) THEN1810:         IF (I.GT.1) THEN
1833:            IF(RIGIDINIT) THEN1811:            IF(RIGIDINIT) THEN
1834:                CALL TRANSFORMRIGIDTOC(1, NRIGIDBODY, XCOORDS, PREVIOUSTS)1812:                CALL TRANSFORMRIGIDTOC(1, NRIGIDBODY, XCOORDS, PREVIOUSTS)
1835:                CALL MINPERMDIST(XCOORDS,MI(DUMMY%I)%DATA%X,NATOMS,DEBUG, &1813:                CALL MINPERMDIST(XCOORDS,MI(DUMMY%I)%DATA%X,NATOMS,DEBUG, &
1836:     &                       PARAM1,PARAM2,PARAM3,BULKT,TWOD,DIST,DIST2,RIGIDBODY,RMAT)1814:     &                       PARAM1,PARAM2,PARAM3,BULKT,TWOD,DIST,DIST2,RIGIDBODY,RMAT)
1837:            ELSE1815:            ELSE
1838:                CALL MINPERMDIST(PREVIOUSTS,MI(DUMMY%I)%DATA%X,NATOMS,DEBUG, &1816:                CALL MINPERMDIST(PREVIOUSTS,MI(DUMMY%I)%DATA%X,NATOMS,DEBUG, &
1839:     &                       PARAM1,PARAM2,PARAM3,BULKT,TWOD,DIST,DIST2,RIGIDBODY,RMAT)1817:     &                       PARAM1,PARAM2,PARAM3,BULKT,TWOD,DIST,DIST2,RIGIDBODY,RMAT)
1840:            ENDIF1818:            ENDIF
1841:            DISTPF=DIST1819:            DISTPF=DIST
1842:         ENDIF1820:         ENDIF
1843: 1821: 
1844:         IF (MACHINE) THEN1822:         IF (MACHINE) THEN
1845:              WRITE(88) (MI(DUMMY%I)%DATA%X(J2),J2=1,NOPT)1823:              WRITE(88) (MI(DUMMY%I)%DATA%X(J2),J2=1,3*NATOMS)
1846:         ELSEIF (AMHT) THEN1824:         ELSEIF (AMHT) THEN
1847: 1825: 
1848: !  THIS IS FOR PLACE HOLDING C-BETAS FOR GLYCINE IN AMH1826: !  THIS IS FOR PLACE HOLDING C-BETAS FOR GLYCINE IN AMH
1849:            GLY_COUNT = 01827:            GLY_COUNT = 0
1850: 1828: 
1851:            DO J2=1, NRES_AMH_TEMP1829:            DO J2=1, NRES_AMH_TEMP
1852:               IF (SEQ(J2).EQ.8) THEN1830:               IF (SEQ(J2).EQ.8) THEN
1853: !             WRITE(2,*)SEQ(J2) , J21831: !             WRITE(2,*)SEQ(J2) , J2
1854:                   WRITE(88,*)MI(DUMMY%I)%DATA%X(9*(J2-1)+1-GLY_COUNT*3), &1832:                   WRITE(88,*)MI(DUMMY%I)%DATA%X(9*(J2-1)+1-GLY_COUNT*3), &
1855:                   MI(DUMMY%I)%DATA%X(9*(J2-1)+2-GLY_COUNT*3),MI(DUMMY%I)%DATA%X(9*(J2-1)+3-GLY_COUNT*3)1833:                   MI(DUMMY%I)%DATA%X(9*(J2-1)+2-GLY_COUNT*3),MI(DUMMY%I)%DATA%X(9*(J2-1)+3-GLY_COUNT*3)
1862: !            WRITE(2,*)SEQ(J2) , J21840: !            WRITE(2,*)SEQ(J2) , J2
1863:                 WRITE(88,*)MI(DUMMY%I)%DATA%X(9*(J2-1)+1-GLY_COUNT*3), &1841:                 WRITE(88,*)MI(DUMMY%I)%DATA%X(9*(J2-1)+1-GLY_COUNT*3), &
1864:                   MI(DUMMY%I)%DATA%X(9*(J2-1)+2-GLY_COUNT*3),MI(DUMMY%I)%DATA%X(9*(J2-1)+3-GLY_COUNT*3)1842:                   MI(DUMMY%I)%DATA%X(9*(J2-1)+2-GLY_COUNT*3),MI(DUMMY%I)%DATA%X(9*(J2-1)+3-GLY_COUNT*3)
1865:                 WRITE(88,*)MI(DUMMY%I)%DATA%X(9*(J2-1)+4-GLY_COUNT*3), &1843:                 WRITE(88,*)MI(DUMMY%I)%DATA%X(9*(J2-1)+4-GLY_COUNT*3), &
1866:                   MI(DUMMY%I)%DATA%X(9*(J2-1)+5-GLY_COUNT*3),MI(DUMMY%I)%DATA%X(9*(J2-1)+6-GLY_COUNT*3)1844:                   MI(DUMMY%I)%DATA%X(9*(J2-1)+5-GLY_COUNT*3),MI(DUMMY%I)%DATA%X(9*(J2-1)+6-GLY_COUNT*3)
1867:                WRITE(88,*)MI(DUMMY%I)%DATA%X(9*(J2-1)+7-GLY_COUNT*3), &1845:                WRITE(88,*)MI(DUMMY%I)%DATA%X(9*(J2-1)+7-GLY_COUNT*3), &
1868:                   MI(DUMMY%I)%DATA%X(9*(J2-1)+8-GLY_COUNT*3),MI(DUMMY%I)%DATA%X(9*(J2-1)+9-GLY_COUNT*3)1846:                   MI(DUMMY%I)%DATA%X(9*(J2-1)+8-GLY_COUNT*3),MI(DUMMY%I)%DATA%X(9*(J2-1)+9-GLY_COUNT*3)
1869:               ENDIF1847:               ENDIF
1870:            ENDDO1848:            ENDDO
1871:         ELSE1849:         ELSE
1872:            WRITE(88,'(3F25.15)') (MI(DUMMY%I)%DATA%X(J2),J2=1,NOPT)1850:            WRITE(88,'(3F25.15)') (MI(DUMMY%I)%DATA%X(J2),J2=1,3*NATOMS)
1873:         ENDIF1851:         ENDIF
1874: 1852: 
1875:         IF (.NOT.ASSOCIATED(DUMMY%NEXT)) EXIT1853:         IF (.NOT.ASSOCIATED(DUMMY%NEXT)) EXIT
1876:         IF ((I.GT.1).AND.AGAIN) THEN ! dump all intervening minima twice1854:         IF ((I.GT.1).AND.AGAIN) THEN ! dump all intervening minima twice
1877:            AGAIN=.FALSE.1855:            AGAIN=.FALSE.
1878:            GOTO 6421856:            GOTO 642
1879:         ENDIF1857:         ENDIF
1880: 1858: 
1881:         IF (MACHINE) THEN1859:         IF (MACHINE) THEN
1882:            WRITE(88) TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%E1860:            WRITE(88) TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%E
1919:                 ELSE1897:                 ELSE
1920:                     IF (ENDNUMHESS) THEN1898:                     IF (ENDNUMHESS) THEN
1921:                         CALL MAKENUMHESS(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,NATOMS)1899:                         CALL MAKENUMHESS(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,NATOMS)
1922:                     ELSE1900:                     ELSE
1923:                         CALL POTENTIAL(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)1901:                         CALL POTENTIAL(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
1924:                     ENDIF1902:                     ENDIF
1925:                     CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)1903:                     CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
1926:                     IF (HESSDUMPT) THEN1904:                     IF (HESSDUMPT) THEN
1927:                         LUNIT=GETUNIT()1905:                         LUNIT=GETUNIT()
1928:                         OPEN(LUNIT,FILE='tshess',STATUS='UNKNOWN',POSITION ='APPEND')1906:                         OPEN(LUNIT,FILE='tshess',STATUS='UNKNOWN',POSITION ='APPEND')
1929:                         WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)1907:                         WRITE(LUNIT,'(6G20.10)') HESS(1:3*NATOMS,1:3*NATOMS)
1930:                         CLOSE(LUNIT)1908:                         CLOSE(LUNIT)
1931:                     ENDIF1909:                     ENDIF
1932:                     CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)1910:                     CALL DSYEV('N','U',3*NATOMS,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
1933:                     IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)1911:                     IF (DIAG(1).LT.DIAG(3*NATOMS)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,3*NATOMS,3*NATOMS)
1934: ! jbr36 - writes the first input for qm rate calculations from classical rates1912: ! jbr36 - writes the first input for qm rate calculations from classical rates
1935:                     IF (INSTANTONSTARTDUMPT) THEN1913:                     IF (INSTANTONSTARTDUMPT) THEN
1936: !                      CALL POTENTIAL(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)1914: !                      CALL POTENTIAL(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
1937:                       LUNIT=5551915:                       LUNIT=555
1938:                       open(LUNIT,file='qmrate_ts.txt', action='write')1916:                       open(LUNIT,file='qmrate_ts.txt', action='write')
1939:                       write(LUNIT,'(a)') "Energy and Hessian eigenvalues of transition state"1917:                       write(LUNIT,'(a)') "Energy and Hessian eigenvalues of transition state"
1940:                       write(LUNIT,*) NATOMS,NATOMS*31918:                       write(LUNIT,*) NATOMS,NATOMS*3
1941:                       write(LUNIT,*) DUMMY11919:                       write(LUNIT,*) DUMMY1
1942:                       write(LUNIT,*) "Coordinates"1920:                       write(LUNIT,*) "Coordinates"
1943:                       write(LUNIT,*) TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X1921:                       write(LUNIT,*) TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X
1944:                       write(LUNIT,*) "Hessian Eigenvalues"1922:                       write(LUNIT,*) "Hessian Eigenvalues"
1945:                       write(LUNIT,*) DIAG1923:                       write(LUNIT,*) DIAG
1946:                       write(LUNIT,*) "Masses in amu (M(12C)=12)"1924:                       write(LUNIT,*) "Masses in amu (M(12C)=12)"
1947:                       write(LUNIT,*) ATMASS1925:                       write(LUNIT,*) ATMASS
1948:                       close(LUNIT)1926:                       close(LUNIT)
1949:                     ENDIF1927:                     ENDIF
1950:                     IF (MACHINE) THEN1928:                     IF (MACHINE) THEN
1951:                         WRITE(88) (DIAG(J2)*4.184D26,J2=1,NOPT)1929:                         WRITE(88) (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
1952:                     ELSE1930:                     ELSE
1953:                         WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,NOPT)1931:                         WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
1954:                     ENDIF1932:                     ENDIF
1955:                 ENDIF1933:                 ENDIF
1956:               ENDIF1934:               ENDIF
1957:            ELSE IF (AMBER12T.OR.AMBERT.OR.NABT) THEN1935:            ELSE IF (AMBER12T.OR.AMBERT.OR.NABT) THEN
1958:               IF (.NOT.MACROCYCLET) THEN1936:               IF (.NOT.MACROCYCLET) THEN
1959:                  HORDER=11937:                  HORDER=1
1960:                  FPGRP='C1'1938:                  FPGRP='C1'
1961:               ELSE1939:               ELSE
1962:                  CALL SYMMETRY(HORDER,.FALSE.,TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,INERTIA)1940:                  CALL SYMMETRY(HORDER,.FALSE.,TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,INERTIA)
1963:               ENDIF1941:               ENDIF
1984:                 ELSE1962:                 ELSE
1985:                     IF (ENDNUMHESS.OR.AMBERT.OR.AMBER12T) THEN1963:                     IF (ENDNUMHESS.OR.AMBERT.OR.AMBER12T) THEN
1986:                         CALL MAKENUMHESS(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,NATOMS)1964:                         CALL MAKENUMHESS(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,NATOMS)
1987:                     ELSE1965:                     ELSE
1988:                         CALL POTENTIAL(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)1966:                         CALL POTENTIAL(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
1989:                     ENDIF1967:                     ENDIF
1990:                     CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)1968:                     CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
1991:                     IF (HESSDUMPT) THEN1969:                     IF (HESSDUMPT) THEN
1992:                         LUNIT=GETUNIT()1970:                         LUNIT=GETUNIT()
1993:                         OPEN(LUNIT,FILE='tshess',STATUS='UNKNOWN',POSITION ='APPEND')1971:                         OPEN(LUNIT,FILE='tshess',STATUS='UNKNOWN',POSITION ='APPEND')
1994:                         WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)1972:                         WRITE(LUNIT,'(6G20.10)') HESS(1:3*NATOMS,1:3*NATOMS)
1995:                         CLOSE(LUNIT)1973:                         CLOSE(LUNIT)
1996:                     ENDIF1974:                     ENDIF
1997:                     CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)1975:                     CALL DSYEV('N','U',3*NATOMS,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
1998:                     IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)1976:                     IF (DIAG(1).LT.DIAG(3*NATOMS)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,3*NATOMS,3*NATOMS)
1999: ! jbr36 - writes the first input for qm rate calculations from classical rates1977: ! jbr36 - writes the first input for qm rate calculations from classical rates
2000:                     IF (INSTANTONSTARTDUMPT) THEN1978:                     IF (INSTANTONSTARTDUMPT) THEN
2001: !                      CALL POTENTIAL(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)1979: !                      CALL POTENTIAL(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
2002:                       LUNIT=5551980:                       LUNIT=555
2003:                       open(LUNIT,file='qmrate_ts.txt', action='write')1981:                       open(LUNIT,file='qmrate_ts.txt', action='write')
2004:                       write(LUNIT,'(a)') "Energy and Hessian eigenvalues of transition state"1982:                       write(LUNIT,'(a)') "Energy and Hessian eigenvalues of transition state"
2005:                       write(LUNIT,*) NATOMS,NATOMS*31983:                       write(LUNIT,*) NATOMS,NATOMS*3
2006:                       write(LUNIT,*) DUMMY11984:                       write(LUNIT,*) DUMMY1
2007:                       write(LUNIT,*) "Coordinates"1985:                       write(LUNIT,*) "Coordinates"
2008:                       write(LUNIT,*) TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X1986:                       write(LUNIT,*) TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X
2009:                       write(LUNIT,*) "Hessian Eigenvalues"1987:                       write(LUNIT,*) "Hessian Eigenvalues"
2010:                       write(LUNIT,*) DIAG1988:                       write(LUNIT,*) DIAG
2011:                       write(LUNIT,*) "Masses in amu (M(12C)=12)"1989:                       write(LUNIT,*) "Masses in amu (M(12C)=12)"
2012:                       write(LUNIT,*) ATMASS1990:                       write(LUNIT,*) ATMASS
2013:                       close(LUNIT)1991:                       close(LUNIT)
2014:                     ENDIF1992:                     ENDIF
2015:                     IF (MACHINE) THEN1993:                     IF (MACHINE) THEN
2016:                         WRITE(88) (DIAG(J2)*4.184D26,J2=1,NOPT)1994:                         WRITE(88) (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
2017:                     ELSE1995:                     ELSE
2018:                         WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,NOPT)1996:                         WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
2019:                     ENDIF1997:                     ENDIF
2020:                 ENDIF1998:                 ENDIF
2021:               ENDIF1999:               ENDIF
2022:            ELSEIF (UNRST) THEN2000:            ELSEIF (UNRST) THEN
2023:               HORDER=12001:               HORDER=1
2024:               FPGRP='C1'2002:               FPGRP='C1'
2025:               WRITE(88,'(I6,1X,A4)') HORDER,FPGRP2003:               WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
2026:               IF (.NOT.NOFRQS) THEN2004:               IF (.NOT.NOFRQS) THEN
2027:                  IF (ENDNUMHESS) THEN2005:                  IF (ENDNUMHESS) THEN
2028:                     CALL MAKENUMINTHESS(NINTS,NATOMS)2006:                     CALL MAKENUMINTHESS(NINTS,NATOMS)
2029:                     CALL GETSTUFF(KD,NNZ,NINTB)2007:                     CALL GETSTUFF(KD,NNZ,NINTB)
2030:                     CALL INTSECDET(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,NOPT,KD,NNZ,NINTB,DIAG)2008:                     CALL INTSECDET(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,3*NATOMS,KD,NNZ,NINTB,DIAG)
2031:                  ELSE2009:                  ELSE
2032:                     CALL POTENTIAL(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)2010:                     CALL POTENTIAL(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
2033:                  ENDIF2011:                  ENDIF
2034:                  DO J2=1,NINTS-12012:                  DO J2=1,NINTS-1
2035:                     IF (DIAG(J2).LT.0.0D0) PRINT *,'Higher order saddle found in pathway - ts ',i,'eigenvalue ',DIAG(J2)2013:                     IF (DIAG(J2).LT.0.0D0) PRINT *,'Higher order saddle found in pathway - ts ',i,'eigenvalue ',DIAG(J2)
2036:                  END DO2014:                  END DO
2037:                  WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)2015:                  WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,3*NATOMS)
2038:               ENDIF2016:               ENDIF
2039:            ELSEIF (AMHT) THEN2017:            ELSEIF (AMHT) THEN
2040:               WRITE(88,'(I6,1X,A4)') 1,' C1'2018:               WRITE(88,'(I6,1X,A4)') 1,' C1'
2041:               IF (.NOT.NOFRQS) THEN2019:               IF (.NOT.NOFRQS) THEN
2042:                  IF (ENDNUMHESS) THEN2020:                  IF (ENDNUMHESS) THEN
2043:                     CALL MAKENUMHESS(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,NATOMS)2021:                     CALL MAKENUMHESS(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,NATOMS)
2044:                  ELSE2022:                  ELSE
2045:                     CALL POTENTIAL(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)2023:                     CALL POTENTIAL(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
2046:                 ENDIF2024:                 ENDIF
2047:                 CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)2025:                 CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
2048:                  IF (HESSDUMPT) THEN2026:                  IF (HESSDUMPT) THEN
2049:                     LUNIT=GETUNIT()2027:                     LUNIT=GETUNIT()
2050:                     OPEN(LUNIT,FILE='tshess',STATUS='UNKNOWN',POSITION ='APPEND')2028:                     OPEN(LUNIT,FILE='tshess',STATUS='UNKNOWN',POSITION ='APPEND')
2051:                     WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)2029:                     WRITE(LUNIT,'(6G20.10)') HESS(1:3*NATOMS,1:3*NATOMS)
2052:                     CLOSE(LUNIT)2030:                     CLOSE(LUNIT)
2053:                  ENDIF2031:                  ENDIF
2054:                 CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)2032:                 CALL DSYEV('N','U',3*NATOMS,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
2055:                 IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)2033:                 IF (DIAG(1).LT.DIAG(3*NATOMS)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,3*NATOMS,3*NATOMS)
2056:                 WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)2034:                 WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,3*NATOMS)
2057: ! jbr36 - writes the first input for qm rate calculations from classical rates2035: ! jbr36 - writes the first input for qm rate calculations from classical rates
2058:                     IF (INSTANTONSTARTDUMPT) THEN2036:                     IF (INSTANTONSTARTDUMPT) THEN
2059: !                      CALL POTENTIAL(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)2037: !                      CALL POTENTIAL(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
2060:                       LUNIT=5552038:                       LUNIT=555
2061:                       open(LUNIT,file='qmrate_ts.txt', action='write')2039:                       open(LUNIT,file='qmrate_ts.txt', action='write')
2062:                       write(LUNIT,'(a)') "Energy and Hessian eigenvalues of transition state"2040:                       write(LUNIT,'(a)') "Energy and Hessian eigenvalues of transition state"
2063:                       write(LUNIT,*) NATOMS,NATOMS*32041:                       write(LUNIT,*) NATOMS,NATOMS*3
2064:                       write(LUNIT,*) DUMMY12042:                       write(LUNIT,*) DUMMY1
2065:                       write(LUNIT,*) "Coordinates"2043:                       write(LUNIT,*) "Coordinates"
2066:                       write(LUNIT,*) TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X2044:                       write(LUNIT,*) TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X
2067:                       write(LUNIT,*) "Hessian Eigenvalues"2045:                       write(LUNIT,*) "Hessian Eigenvalues"
2068:                       write(LUNIT,*) DIAG2046:                       write(LUNIT,*) DIAG
2069:                       write(LUNIT,*) "Masses in amu (M(12C)=12)"2047:                       write(LUNIT,*) "Masses in amu (M(12C)=12)"
2070:                       write(LUNIT,*) ATMASS2048:                       write(LUNIT,*) ATMASS
2071:                       close(LUNIT)2049:                       close(LUNIT)
2072:                     ENDIF2050:                     ENDIF
2073:               ENDIF2051:               ENDIF
2074:            ELSE2052:            ELSE
2075:               IF (VARIABLES) THEN2053:               CALL SYMMETRY(HORDER,.FALSE.,TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,INERTIA)
2076:                  HORDER=1 
2077:                  FPGRP='C1' 
2078:               ELSE 
2079:                  CALL SYMMETRY(HORDER,.FALSE.,TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,INERTIA) 
2080:               ENDIF 
2081:               WRITE(88,'(I6,1X,A4)') HORDER,FPGRP2054:               WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
2082:               IF (.NOT.NOFRQS) THEN2055:               IF (.NOT.NOFRQS) THEN
2083:               ! sn402: copied this across from MAKEALLPATHINFO2056:               ! sn402: copied this across from MAKEALLPATHINFO
2084:                   IF (RIGIDINIT) THEN2057:                   IF (RIGIDINIT) THEN
2085: ! hk286 - TS is recorded in rigid body coordinates2058: ! hk286 - TS is recorded in rigid body coordinates
2086:                     ATOMRIGIDCOORDT = .FALSE.2059:                     ATOMRIGIDCOORDT = .FALSE.
2087:                     IF(METRICTENSOR) THEN2060:                     IF(METRICTENSOR) THEN
2088:                         CALL GENRIGID_NORMALMODES(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X, ATMASS, DIAG, INFO)2061:                         CALL GENRIGID_NORMALMODES(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X, ATMASS, DIAG, INFO)
2089:                     ELSE2062:                     ELSE
2090:                         CALL GENRIGID_EIGENVALUES(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X, ATMASS, DIAG, INFO)2063:                         CALL GENRIGID_EIGENVALUES(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X, ATMASS, DIAG, INFO)
2092:                     ATOMRIGIDCOORDT = .TRUE.2065:                     ATOMRIGIDCOORDT = .TRUE.
2093:                     IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN2066:                     IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
2094:                         CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)2067:                         CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
2095:                     ENDIF2068:                     ENDIF
2096: ! hk286 - compute normal modes for rigid body angle axis, go to moving frame2069: ! hk286 - compute normal modes for rigid body angle axis, go to moving frame
2097:                   ELSE IF (RBAAT) THEN2070:                   ELSE IF (RBAAT) THEN
2098:                     RBAANORMALMODET = .TRUE.2071:                     RBAANORMALMODET = .TRUE.
2099:                     CALL POTENTIAL(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)2072:                     CALL POTENTIAL(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
2100:                     CALL NRMLMD (TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X, DIAG, .FALSE.)2073:                     CALL NRMLMD (TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X, DIAG, .FALSE.)
2101:                     RBAANORMALMODET = .FALSE.2074:                     RBAANORMALMODET = .FALSE.
2102: !                   WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)2075: !                   WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,3*NATOMS)
2103:                   ELSE2076:                   ELSE
2104:                     IF (ENDNUMHESS) THEN2077:                     IF (ENDNUMHESS) THEN
2105:                         CALL MAKENUMHESS(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,NATOMS)2078:                         CALL MAKENUMHESS(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,NATOMS)
2106:                     ELSE2079:                     ELSE
2107:                         CALL POTENTIAL(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)2080:                         CALL POTENTIAL(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
2108:                     ENDIF2081:                     ENDIF
2109:                     CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)2082:                     CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
2110:                     IF (HESSDUMPT) THEN2083:                     IF (HESSDUMPT) THEN
2111:                         LUNIT=GETUNIT()2084:                         LUNIT=GETUNIT()
2112:                         OPEN(LUNIT,FILE='tshess',STATUS='UNKNOWN',POSITION ='APPEND')2085:                         OPEN(LUNIT,FILE='tshess',STATUS='UNKNOWN',POSITION ='APPEND')
2113:                         WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)2086:                         WRITE(LUNIT,'(6G20.10)') HESS(1:3*NATOMS,1:3*NATOMS)
2114:                         CLOSE(LUNIT)2087:                         CLOSE(LUNIT)
2115:                     ENDIF2088:                     ENDIF
2116:                     CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)2089:                     CALL DSYEV('N','U',3*NATOMS,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
2117:                     IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)2090:                     IF (DIAG(1).LT.DIAG(3*NATOMS)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,3*NATOMS,3*NATOMS)
2118: ! jbr36 - writes the first input for qm rate calculations from classical rates2091: ! jbr36 - writes the first input for qm rate calculations from classical rates
2119:                     IF (INSTANTONSTARTDUMPT) THEN2092:                     IF (INSTANTONSTARTDUMPT) THEN
2120: !                      CALL POTENTIAL(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)2093: !                      CALL POTENTIAL(TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
2121:                       LUNIT=5552094:                       LUNIT=555
2122:                       open(LUNIT,file='qmrate_ts.txt', action='write')2095:                       open(LUNIT,file='qmrate_ts.txt', action='write')
2123:                       write(LUNIT,'(a)') "Energy and Hessian eigenvalues of transition state"2096:                       write(LUNIT,'(a)') "Energy and Hessian eigenvalues of transition state"
2124:                       write(LUNIT,*) NATOMS,NATOMS*32097:                       write(LUNIT,*) NATOMS,NATOMS*3
2125:                       write(LUNIT,*) DUMMY12098:                       write(LUNIT,*) DUMMY1
2126:                       write(LUNIT,*) "Coordinates"2099:                       write(LUNIT,*) "Coordinates"
2127:                       write(LUNIT,*) TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X2100:                       write(LUNIT,*) TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X
2128:                       write(LUNIT,*) "Hessian Eigenvalues"2101:                       write(LUNIT,*) "Hessian Eigenvalues"
2129:                       write(LUNIT,*) DIAG2102:                       write(LUNIT,*) DIAG
2130:                       write(LUNIT,*) "Masses in amu (M(12C)=12)"2103:                       write(LUNIT,*) "Masses in amu (M(12C)=12)"
2131:                       write(LUNIT,*) ATMASS2104:                       write(LUNIT,*) ATMASS
2132:                       close(LUNIT)2105:                       close(LUNIT)
2133:                     ENDIF2106:                     ENDIF
2134:                   ENDIF2107:                   ENDIF
2135: 2108: 
2136:                  IF (SDT.OR.TTM3T) THEN2109:                  IF (SDT.OR.TTM3T) THEN
2137:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,NOPT)2110:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
2138:                  ELSEIF (BOWMANT) THEN2111:                  ELSEIF (BOWMANT) THEN
2139:                     WRITE(88,'(3G20.10)') (DIAG(J2)*2625.47D26,J2=1,NOPT)2112:                     WRITE(88,'(3G20.10)') (DIAG(J2)*2625.47D26,J2=1,3*NATOMS)
2140:                  ELSEIF (RIGIDINIT) THEN2113:                  ELSEIF (RIGIDINIT) THEN
2141:                     IF (MACHINE) THEN2114:                     IF (MACHINE) THEN
2142:                         WRITE(88) (DIAG(J2),J2=1,DEGFREEDOMS)2115:                         WRITE(88) (DIAG(J2),J2=1,DEGFREEDOMS)
2143:                     ELSE2116:                     ELSE
2144:                         WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,DEGFREEDOMS)2117:                         WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,DEGFREEDOMS)
2145:                     ENDIF2118:                     ENDIF
2146:                  ELSE2119:                  ELSE
2147:                     WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)2120:                     WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,3*NATOMS)
2148:                  ENDIF2121:                  ENDIF
2149:               ENDIF2122:               ENDIF
2150:            ENDIF2123:            ENDIF
2151:         ELSE2124:         ELSE
2152:            IF (VARIABLES) THEN2125:            CALL SYMMETRY(HORDER,.FALSE.,TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,INERTIA)
2153:               HORDER=1 
2154:               FPGRP='C1' 
2155:            ELSE 
2156:               CALL SYMMETRY(HORDER,.FALSE.,TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,INERTIA) 
2157:            ENDIF 
2158:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP2126:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
2159:         ENDIF2127:         ENDIF
2160: 2128: 
2161: !        write(*,*) "Calling MINPERMDIST now. First argument is minimum, second is TS. I think the TS is in AA coords."2129: !        write(*,*) "Calling MINPERMDIST now. First argument is minimum, second is TS. I think the TS is in AA coords."
2162:         IF(RIGIDINIT) THEN2130:         IF(RIGIDINIT) THEN
2163:             CALL TRANSFORMRIGIDTOC (1, NRIGIDBODY, XCOORDS, TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X(1:DEGFREEDOMS))2131:             CALL TRANSFORMRIGIDTOC (1, NRIGIDBODY, XCOORDS, TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X(1:DEGFREEDOMS))
2164:             CALL MINPERMDIST(MI(DUMMY%I)%DATA%X,XCOORDS,NATOMS,DEBUG,PARAM1,PARAM2,PARAM3,BULKT,TWOD,DIST,DIST2,RIGIDBODY,RMAT)2132:             CALL MINPERMDIST(MI(DUMMY%I)%DATA%X,XCOORDS,NATOMS,DEBUG,PARAM1,PARAM2,PARAM3,BULKT,TWOD,DIST,DIST2,RIGIDBODY,RMAT)
2165:         ELSE2133:         ELSE
2166:             CALL MINPERMDIST(MI(DUMMY%I)%DATA%X,TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,NATOMS,DEBUG, &2134:             CALL MINPERMDIST(MI(DUMMY%I)%DATA%X,TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X,NATOMS,DEBUG, &
2167:     &                    PARAM1,PARAM2,PARAM3,BULKT,TWOD,DIST,DIST2,RIGIDBODY,RMAT)2135:     &                    PARAM1,PARAM2,PARAM3,BULKT,TWOD,DIST,DIST2,RIGIDBODY,RMAT)
2208:               ENDIF2176:               ENDIF
2209:            ENDDO2177:            ENDDO
2210:         ELSE2178:         ELSE
2211:             IF (RIGIDINIT) THEN2179:             IF (RIGIDINIT) THEN
2212: !                CALL TRANSFORMRIGIDTOC (1, NRIGIDBODY, XCOORDS, TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X(1:DEGFREEDOMS))2180: !                CALL TRANSFORMRIGIDTOC (1, NRIGIDBODY, XCOORDS, TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X(1:DEGFREEDOMS))
2213:                 WRITE(88,'(3F25.15)') (XCOORDS(J2),J2=1,3*NATOMS)2181:                 WRITE(88,'(3F25.15)') (XCOORDS(J2),J2=1,3*NATOMS)
2214:             ELSE2182:             ELSE
2215:                 WRITE(88,'(3F25.15)') (TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X(J2),J2=1,NOPT)2183:                 WRITE(88,'(3F25.15)') (TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X(J2),J2=1,NOPT)
2216:             ENDIF2184:             ENDIF
2217:         ENDIF2185:         ENDIF
2218:         PREVIOUSTS(1:NOPT)=TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X(1:NOPT)2186:         PREVIOUSTS=TS(MI(DUMMY%I)%DATA%CTS(DUMMY%J))%DATA%X
2219:         DUMMY=>DUMMY%NEXT2187:         DUMMY=>DUMMY%NEXT
2220:         I=I+12188:         I=I+1
2221:      ENDDO2189:      ENDDO
2222:      CALL FLUSH(88)2190:      CALL FLUSH(88)
2223:      CLOSE(88)2191:      CLOSE(88)
2224: 2192: 
2225:      END SUBROUTINE MAKEPATHINFO2193:      END SUBROUTINE MAKEPATHINFO
2226: 2194: 
2227: !2195: !
2228: !  Dump min to path.info2196: !  Dump min to path.info
2990: 2958: 
2991: !2959: !
2992: !  Dump the latest min-sad-min triple to path.info in the usual format2960: !  Dump the latest min-sad-min triple to path.info in the usual format
2993: !  2961: !  
2994:      SUBROUTINE MAKEALLPATHINFO(QTS,QPLUS,QMINUS,ETS,EPLUS,EMINUS,FRQSTS,FRQSPLUS,FRQSMINUS)2962:      SUBROUTINE MAKEALLPATHINFO(QTS,QPLUS,QMINUS,ETS,EPLUS,EMINUS,FRQSTS,FRQSPLUS,FRQSMINUS)
2995:      USE SYMINF 2963:      USE SYMINF 
2996:      USE MODHESS2964:      USE MODHESS
2997:      USE MODCHARMM2965:      USE MODCHARMM
2998:      USE MODUNRES2966:      USE MODUNRES
2999:      USE KEY, ONLY: FILTH, FILTHSTR, UNRST, TWOD, BULKT, MACHINE, NOFRQS, AMBERT, NABT, AMHT, SEQ, TARFL, NRES_AMH_TEMP, SDT, &2967:      USE KEY, ONLY: FILTH, FILTHSTR, UNRST, TWOD, BULKT, MACHINE, NOFRQS, AMBERT, NABT, AMHT, SEQ, TARFL, NRES_AMH_TEMP, SDT, &
3000:           AMBER12T, RBAAT, MACROCYCLET, GTHOMSONT, TTM3T, BOWMANT, HESSDUMPT, INSTANTONSTARTDUMPT,FREEZE,NONFREEZE, METRICTENSOR, & ! hk2862968:           AMBER12T, RBAAT, MACROCYCLET, GTHOMSONT, TTM3T, BOWMANT, HESSDUMPT, INSTANTONSTARTDUMPT,FREEZE,NONFREEZE, METRICTENSOR ! hk286
3001:   &       VARIABLES 
3002:      USE COMMONS, ONLY: ATMASS, NINTS, ZSYM2969:      USE COMMONS, ONLY: ATMASS, NINTS, ZSYM
3003:      USE PORFUNCS2970:      USE PORFUNCS
3004:      USE GENRIGID2971:      USE GENRIGID
3005:      IMPLICIT NONE2972:      IMPLICIT NONE
3006: 2973: 
3007:      CHARACTER(LEN=20) :: PINFOSTRING2974:      CHARACTER(LEN=20) :: PINFOSTRING
3008:      DOUBLE PRECISION :: DIHE,ALLANG,DISTPF,DUMMY1,GRAD(NOPT),RMS,DIAG(NOPT),TEMPA(9*NATOMS),DUMQ(NOPT)2975:      DOUBLE PRECISION :: DIHE,ALLANG,DISTPF,DUMMY1,GRAD(3*NATOMS),RMS,DIAG(3*NATOMS),TEMPA(9*NATOMS),DUMQ(3*NATOMS)
3009:      INTEGER :: HORDER,INFO,J2,K1,RECLEN,ISTAT,J1,LUNIT,GETUNIT2976:      INTEGER :: HORDER,INFO,J2,K1,RECLEN,ISTAT,J1,LUNIT,GETUNIT
3010:      LOGICAL :: BTEST,KD,NNZ,NINTB,TSFRQDONE,MINFRQDONE2977:      LOGICAL :: BTEST,KD,NNZ,NINTB,TSFRQDONE,MINFRQDONE
3011:      DOUBLE PRECISION :: QTS(NOPT),QPLUS(NOPT),QMINUS(NOPT),FRQSTS(NOPT),FRQSPLUS(NOPT),FRQSMINUS(NOPT), &2978:      DOUBLE PRECISION :: QTS(3*NATOMS),QPLUS(3*NATOMS),QMINUS(3*NATOMS),FRQSTS(3*NATOMS),FRQSPLUS(3*NATOMS),FRQSMINUS(3*NATOMS), &
3012:     &                    ETS,EPLUS,EMINUS,INERTIA(3,3)2979:     &                    ETS,EPLUS,EMINUS,INERTIA(3,3)
3013: 2980: 
3014: !    LOCAL AMH VARIABLES2981: !    LOCAL AMH VARIABLES
3015:      INTEGER :: I_RES, GLY_COUNT2982:      INTEGER :: I_RES, GLY_COUNT
3016: 2983: 
3017:      DOUBLE PRECISION :: TMPCOORDS(9*NATOMS/2), TMPHESS(2*NATOMS,2*NATOMS)2984:      DOUBLE PRECISION :: TMPCOORDS(9*NATOMS/2), TMPHESS(2*NATOMS,2*NATOMS)
3018:      DOUBLE PRECISION :: XRIGIDCOORDS(DEGFREEDOMS), XCOORDS(NOPT)2985:      DOUBLE PRECISION :: XRIGIDCOORDS(DEGFREEDOMS), XCOORDS(3*NATOMS)
3019: 2986: 
3020:      LOGICAL KNOWE, KNOWG, KNOWH2987:      LOGICAL KNOWE, KNOWG, KNOWH
3021:      COMMON /KNOWN/ KNOWE, KNOWG, KNOWH2988:      COMMON /KNOWN/ KNOWE, KNOWG, KNOWH
3022: 2989: 
3023:      TSFRQDONE=.FALSE.  ! ASSUME THAT WE NEVER KNOW THE FREQUENCIES2990:      TSFRQDONE=.FALSE.  ! ASSUME THAT WE NEVER KNOW THE FREQUENCIES
3024:      MINFRQDONE=.FALSE. ! ASSUME THAT WE NEVER KNOW THE FREQUENCIES2991:      MINFRQDONE=.FALSE. ! ASSUME THAT WE NEVER KNOW THE FREQUENCIES
3025: 2992: 
3026: !2993: !
3027: !  First dump the + minimum.2994: !  First dump the + minimum.
3028: !  2995: !  
3065:               ELSE3032:               ELSE
3066:                  IF (ENDNUMHESS) THEN3033:                  IF (ENDNUMHESS) THEN
3067:                     CALL MAKENUMHESS(QPLUS,NATOMS)3034:                     CALL MAKENUMHESS(QPLUS,NATOMS)
3068:                  ELSE3035:                  ELSE
3069:                     CALL POTENTIAL(QPLUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3036:                     CALL POTENTIAL(QPLUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3070:                  ENDIF3037:                  ENDIF
3071:                  CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)3038:                  CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
3072:                  IF (HESSDUMPT) THEN3039:                  IF (HESSDUMPT) THEN
3073:                     LUNIT=GETUNIT()3040:                     LUNIT=GETUNIT()
3074:                     OPEN(LUNIT,FILE='minhess.plus',STATUS='UNKNOWN',POSITION ='APPEND')3041:                     OPEN(LUNIT,FILE='minhess.plus',STATUS='UNKNOWN',POSITION ='APPEND')
3075:                     WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)3042:                     WRITE(LUNIT,'(6G20.10)') HESS(1:3*NATOMS,1:3*NATOMS)
3076:                     CLOSE(LUNIT)3043:                     CLOSE(LUNIT)
3077:                  ENDIF3044:                  ENDIF
3078:                  CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)3045:                  CALL DSYEV('N','U',3*NATOMS,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
3079:                  IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)3046:                  IF (DIAG(1).LT.DIAG(3*NATOMS)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,3*NATOMS,3*NATOMS)
3080: ! jbr36 - writes the first input for qm rate calculations from classical rates3047: ! jbr36 - writes the first input for qm rate calculations from classical rates
3081:                  IF (INSTANTONSTARTDUMPT) THEN3048:                  IF (INSTANTONSTARTDUMPT) THEN
3082:                     LUNIT=5553049:                     LUNIT=555
3083:                     OPEN(LUNIT,file='qmrate_reactant.plus.txt', action='WRITE')3050:                     OPEN(LUNIT,file='qmrate_reactant.plus.txt', action='WRITE')
3084:                     WRITE(LUNIT,'(a)') "Energy and Hessian eigenvalues of reactant.plus"3051:                     WRITE(LUNIT,'(a)') "Energy and Hessian eigenvalues of reactant.plus"
3085:                     WRITE(LUNIT,*) NATOMS,NATOMS*33052:                     WRITE(LUNIT,*) NATOMS,NATOMS*3
3086:                     WRITE(LUNIT,*) DUMMY13053:                     WRITE(LUNIT,*) DUMMY1
3087:                     WRITE(LUNIT,*) "Coordinates"3054:                     WRITE(LUNIT,*) "Coordinates"
3088:                     WRITE(LUNIT,*) QPLUS3055:                     WRITE(LUNIT,*) QPLUS
3089:                     WRITE(LUNIT,*) "Hessian Eigenvalues"3056:                     WRITE(LUNIT,*) "Hessian Eigenvalues"
3090:                     WRITE(LUNIT,*) DIAG3057:                     WRITE(LUNIT,*) DIAG
3091:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"3058:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"
3092:                     WRITE(LUNIT,*) ATMASS3059:                     WRITE(LUNIT,*) ATMASS
3093:                     CLOSE(LUNIT)3060:                     CLOSE(LUNIT)
3094:                  ENDIF3061:                  ENDIF
3095:                  IF (MACHINE) THEN3062:                  IF (MACHINE) THEN
3096:                     WRITE(88) (DIAG(J2)*4.184D26,J2=1,NOPT)3063:                     WRITE(88) (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
3097:                  ELSE3064:                  ELSE
3098:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,NOPT)3065:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
3099:                  ENDIF3066:                  ENDIF
3100:               ENDIF3067:               ENDIF
3101:            ENDIF3068:            ENDIF
3102:         ELSEIF (AMBER12T.OR.AMBERT.OR.NABT) THEN3069:         ELSEIF (AMBER12T.OR.AMBERT.OR.NABT) THEN
3103:            IF (.NOT.MACROCYCLET) THEN3070:            IF (.NOT.MACROCYCLET) THEN
3104:               HORDER=1 3071:               HORDER=1 
3105:               FPGRP='C1'3072:               FPGRP='C1'
3106:            ELSE3073:            ELSE
3107:               CALL SYMMETRY(HORDER,.FALSE.,QPLUS,INERTIA)3074:               CALL SYMMETRY(HORDER,.FALSE.,QPLUS,INERTIA)
3108:            ENDIF3075:            ENDIF
3125:               ELSE3092:               ELSE
3126:                  IF (ENDNUMHESS.OR.AMBERT.OR.AMBER12T) THEN3093:                  IF (ENDNUMHESS.OR.AMBERT.OR.AMBER12T) THEN
3127:                     CALL MAKENUMHESS(QPLUS,NATOMS)3094:                     CALL MAKENUMHESS(QPLUS,NATOMS)
3128:                  ELSE3095:                  ELSE
3129:                     CALL POTENTIAL(QPLUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3096:                     CALL POTENTIAL(QPLUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3130:                  ENDIF3097:                  ENDIF
3131:                  CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)3098:                  CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
3132:                  IF (HESSDUMPT) THEN3099:                  IF (HESSDUMPT) THEN
3133:                     LUNIT=GETUNIT()3100:                     LUNIT=GETUNIT()
3134:                     OPEN(LUNIT,FILE='minhess.plus',STATUS='UNKNOWN',POSITION ='APPEND')3101:                     OPEN(LUNIT,FILE='minhess.plus',STATUS='UNKNOWN',POSITION ='APPEND')
3135:                     WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)3102:                     WRITE(LUNIT,'(6G20.10)') HESS(1:3*NATOMS,1:3*NATOMS)
3136:                     CLOSE(LUNIT)3103:                     CLOSE(LUNIT)
3137:                  ENDIF3104:                  ENDIF
3138:                  IF (FREEZE) THEN3105:                  IF (FREEZE) THEN
3139:                     CALL SWEEP_ZERO()3106:                     CALL SWEEP_ZERO()
3140:                     DIAG=0.0D03107:                     DIAG=0.0D0
3141:                     CALL DSYEV('N','U',3*NONFREEZE,NONFROZENHESS,SIZE(NONFROZENHESS,1),DIAG(1:3*NONFREEZE),TEMPA,9*NONFREEZE,INFO)3108:                     CALL DSYEV('N','U',3*NONFREEZE,NONFROZENHESS,SIZE(NONFROZENHESS,1),DIAG(1:3*NONFREEZE),TEMPA,9*NONFREEZE,INFO)
3142:                  ELSE3109:                  ELSE
3143:                     CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)3110:                     CALL DSYEV('N','U',3*NATOMS,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
3144:                  ENDIF3111:                  ENDIF
3145:                  IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)3112:                  IF (DIAG(1).LT.DIAG(3*NATOMS)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,3*NATOMS,3*NATOMS)
3146: ! jbr36 - writes the first input for qm rate calculations from classical rates3113: ! jbr36 - writes the first input for qm rate calculations from classical rates
3147:                  IF (INSTANTONSTARTDUMPT) THEN3114:                  IF (INSTANTONSTARTDUMPT) THEN
3148:                     LUNIT=5553115:                     LUNIT=555
3149:                     OPEN(LUNIT,file='qmrate_reactant.plus.txt', action='WRITE')3116:                     OPEN(LUNIT,file='qmrate_reactant.plus.txt', action='WRITE')
3150:                     WRITE(LUNIT,'(a)') "Energy and Hessian eigenvalues of reactant.plus"3117:                     WRITE(LUNIT,'(a)') "Energy and Hessian eigenvalues of reactant.plus"
3151:                     WRITE(LUNIT,*) NATOMS,NATOMS*33118:                     WRITE(LUNIT,*) NATOMS,NATOMS*3
3152:                     WRITE(LUNIT,*) DUMMY13119:                     WRITE(LUNIT,*) DUMMY1
3153:                     WRITE(LUNIT,*) "Coordinates"3120:                     WRITE(LUNIT,*) "Coordinates"
3154:                     WRITE(LUNIT,*) QPLUS3121:                     WRITE(LUNIT,*) QPLUS
3155:                     WRITE(LUNIT,*) "Hessian Eigenvalues"3122:                     WRITE(LUNIT,*) "Hessian Eigenvalues"
3156:                     WRITE(LUNIT,*) DIAG3123:                     WRITE(LUNIT,*) DIAG
3157:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"3124:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"
3158:                     WRITE(LUNIT,*) ATMASS3125:                     WRITE(LUNIT,*) ATMASS
3159:                     CLOSE(LUNIT)3126:                     CLOSE(LUNIT)
3160:                  ENDIF3127:                  ENDIF
3161:                  IF (MACHINE) THEN3128:                  IF (MACHINE) THEN
3162:                     WRITE(88) (DIAG(J2)*4.184D26,J2=1,NOPT)3129:                     WRITE(88) (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
3163:                  ELSE3130:                  ELSE
3164:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,NOPT)3131:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
3165:                  ENDIF3132:                  ENDIF
3166:               ENDIF3133:               ENDIF
3167:            ENDIF3134:            ENDIF
3168:         ELSEIF (UNRST) THEN3135:         ELSEIF (UNRST) THEN
3169:            HORDER=13136:            HORDER=1
3170:            FPGRP='C1'3137:            FPGRP='C1'
3171:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP3138:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
3172:            IF (.NOT.NOFRQS) THEN3139:            IF (.NOT.NOFRQS) THEN
3173:               IF (ENDNUMHESS) THEN3140:               IF (ENDNUMHESS) THEN
3174:                  CALL MAKENUMINTHESS(NINTS,NATOMS)3141:                  CALL MAKENUMINTHESS(NINTS,NATOMS)
3175:                  CALL GETSTUFF(KD,NNZ,NINTB)3142:                  CALL GETSTUFF(KD,NNZ,NINTB)
3176:                  CALL INTSECDET(QPLUS,NOPT,KD,NNZ,NINTB,DIAG)3143:                  CALL INTSECDET(QPLUS,3*NATOMS,KD,NNZ,NINTB,DIAG)
3177:               ELSE3144:               ELSE
3178:                  CALL POTENTIAL(QPLUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3145:                  CALL POTENTIAL(QPLUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3179:               ENDIF3146:               ENDIF
3180:               WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)3147:               WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,3*NATOMS)
3181:            ENDIF3148:            ENDIF
3182:         ELSEIF (AMHT) THEN3149:         ELSEIF (AMHT) THEN
3183:            WRITE(88,'(I6,1X,A4)') 1,' C1'3150:            WRITE(88,'(I6,1X,A4)') 1,' C1'
3184:            IF (.NOT.NOFRQS) THEN3151:            IF (.NOT.NOFRQS) THEN
3185:               IF (ENDNUMHESS) THEN3152:               IF (ENDNUMHESS) THEN
3186:                  CALL MAKENUMHESS(QPLUS,NATOMS)3153:                  CALL MAKENUMHESS(QPLUS,NATOMS)
3187:               ELSE3154:               ELSE
3188:                  CALL POTENTIAL(QPLUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3155:                  CALL POTENTIAL(QPLUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3189:               ENDIF3156:               ENDIF
3190:               CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)3157:               CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
3191:                  IF (HESSDUMPT) THEN3158:                  IF (HESSDUMPT) THEN
3192:                     LUNIT=GETUNIT()3159:                     LUNIT=GETUNIT()
3193:                     OPEN(LUNIT,FILE='minhess.plus',STATUS='UNKNOWN',POSITION ='APPEND')3160:                     OPEN(LUNIT,FILE='minhess.plus',STATUS='UNKNOWN',POSITION ='APPEND')
3194:                     WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)3161:                     WRITE(LUNIT,'(6G20.10)') HESS(1:3*NATOMS,1:3*NATOMS)
3195:                     CLOSE(LUNIT)3162:                     CLOSE(LUNIT)
3196:                  ENDIF3163:                  ENDIF
3197:               CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)3164:               CALL DSYEV('N','U',3*NATOMS,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
3198:               IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)3165:               IF (DIAG(1).LT.DIAG(3*NATOMS)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,3*NATOMS,3*NATOMS)
3199:               WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)3166:               WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,3*NATOMS)
3200: ! jbr36 - writes the first input for qm rate calculations from classical rates3167: ! jbr36 - writes the first input for qm rate calculations from classical rates
3201:                     IF (INSTANTONSTARTDUMPT) THEN3168:                     IF (INSTANTONSTARTDUMPT) THEN
3202: !                      CALL POTENTIAL(QPLUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3169: !                      CALL POTENTIAL(QPLUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3203:                       LUNIT=5553170:                       LUNIT=555
3204:                       open(LUNIT,file='qmrate_reactant.plus.txt', action='write')3171:                       open(LUNIT,file='qmrate_reactant.plus.txt', action='write')
3205:                       write(LUNIT,'(a)') "Energy and Hessian eigenvalues of reactant.plus"3172:                       write(LUNIT,'(a)') "Energy and Hessian eigenvalues of reactant.plus"
3206:                       write(LUNIT,*) NATOMS,NATOMS*33173:                       write(LUNIT,*) NATOMS,NATOMS*3
3207:                       write(LUNIT,*) DUMMY13174:                       write(LUNIT,*) DUMMY1
3208:                       write(LUNIT,*) "Coordinates"3175:                       write(LUNIT,*) "Coordinates"
3209:                       write(LUNIT,*) QPLUS3176:                       write(LUNIT,*) QPLUS
3222:            IF (.NOT.NOFRQS) THEN3189:            IF (.NOT.NOFRQS) THEN
3223:               IF (ENDNUMHESS) THEN3190:               IF (ENDNUMHESS) THEN
3224:                  CALL MAKENUMHESS(QPLUS,NATOMS)3191:                  CALL MAKENUMHESS(QPLUS,NATOMS)
3225:               ELSE3192:               ELSE
3226:                  CALL POTENTIAL(QPLUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3193:                  CALL POTENTIAL(QPLUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3227:               ENDIF3194:               ENDIF
3228:               CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)3195:               CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
3229:               IF (HESSDUMPT) THEN3196:               IF (HESSDUMPT) THEN
3230:                  LUNIT=GETUNIT()3197:                  LUNIT=GETUNIT()
3231:                  OPEN(LUNIT,FILE='minhess.plus',STATUS='UNKNOWN',POSITION ='APPEND')3198:                  OPEN(LUNIT,FILE='minhess.plus',STATUS='UNKNOWN',POSITION ='APPEND')
3232:                  WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)3199:                  WRITE(LUNIT,'(6G20.10)') HESS(1:3*NATOMS,1:3*NATOMS)
3233:                  CLOSE(LUNIT)3200:                  CLOSE(LUNIT)
3234:               ENDIF3201:               ENDIF
3235:               CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)3202:               CALL DSYEV('N','U',3*NATOMS,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
3236:               IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)3203:               IF (DIAG(1).LT.DIAG(3*NATOMS)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,3*NATOMS,3*NATOMS)
3237:            ENDIF3204:            ENDIF
3238:            WRITE(88,'(3G20.10)') (1.0D10, J2=1, NATOMS)3205:            WRITE(88,'(3G20.10)') (1.0D10, J2=1, NATOMS)
3239:            IF (SDT.OR.TTM3T) THEN3206:            IF (SDT.OR.TTM3T) THEN
3240:               WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,2*NATOMS)3207:               WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,2*NATOMS)
3241:            ELSEIF (BOWMANT) THEN3208:            ELSEIF (BOWMANT) THEN
3242:               WRITE(88,'(3G20.10)') (DIAG(J2)*2625.47D26,J2=1,2*NATOMS)3209:               WRITE(88,'(3G20.10)') (DIAG(J2)*2625.47D26,J2=1,2*NATOMS)
3243:            ELSE3210:            ELSE
3244:               WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,2*NATOMS)3211:               WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,2*NATOMS)
3245:            ENDIF3212:            ENDIF
3246:            3213:            
3247:         ELSE3214:         ELSE
3248:            IF (VARIABLES) THEN3215:            CALL SYMMETRY(HORDER,.FALSE.,QPLUS,INERTIA)
3249:               HORDER=1 
3250:               FPGRP='C1' 
3251:            ELSE 
3252:               CALL SYMMETRY(HORDER,.FALSE.,QPLUS,INERTIA) 
3253:            ENDIF 
3254:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP3216:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
3255:            IF (.NOT.NOFRQS) THEN3217:            IF (.NOT.NOFRQS) THEN
3256:               ! sn402: Currently there are two different methods implemented for finding the normal modes of3218:               ! sn402: Currently there are two different methods implemented for finding the normal modes of
3257:               ! local rigid bodies. GENRIGID_NORMALMODES makes use of the metric tensor formulation and so should3219:               ! local rigid bodies. GENRIGID_NORMALMODES makes use of the metric tensor formulation and so should
3258:               ! in principle be more accurate. Eventually this should be made the default (or indeed only) option3220:               ! in principle be more accurate. Eventually this should be made the default (or indeed only) option
3259:               ! and the keyword METRICTENSOR should be removed.3221:               ! and the keyword METRICTENSOR should be removed.
3260:               IF (RIGIDINIT) THEN3222:               IF (RIGIDINIT) THEN
3261:                  IF(METRICTENSOR) THEN3223:                  IF(METRICTENSOR) THEN
3262:                      write(*,*) "ATMASS going in:"3224:                      write(*,*) "ATMASS going in:"
3263:                      write(*,*) ATMASS3225:                      write(*,*) ATMASS
3278:               ELSE3240:               ELSE
3279:                  IF (ENDNUMHESS) THEN3241:                  IF (ENDNUMHESS) THEN
3280:                     CALL MAKENUMHESS(QPLUS,NATOMS)3242:                     CALL MAKENUMHESS(QPLUS,NATOMS)
3281:                  ELSE3243:                  ELSE
3282:                     CALL POTENTIAL(QPLUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3244:                     CALL POTENTIAL(QPLUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3283:                  ENDIF3245:                  ENDIF
3284:                  CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)3246:                  CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
3285:                  IF (HESSDUMPT) THEN3247:                  IF (HESSDUMPT) THEN
3286:                     LUNIT=GETUNIT()3248:                     LUNIT=GETUNIT()
3287:                     OPEN(LUNIT,FILE='minhess.plus',STATUS='UNKNOWN',POSITION ='APPEND')3249:                     OPEN(LUNIT,FILE='minhess.plus',STATUS='UNKNOWN',POSITION ='APPEND')
3288:                     WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)3250:                     WRITE(LUNIT,'(6G20.10)') HESS(1:3*NATOMS,1:3*NATOMS)
3289:                     CLOSE(LUNIT)3251:                     CLOSE(LUNIT)
3290:                  ENDIF3252:                  ENDIF
3291:                  CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)3253:                  CALL DSYEV('N','U',3*NATOMS,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
3292:                  IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)3254:                  IF (DIAG(1).LT.DIAG(3*NATOMS)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,3*NATOMS,3*NATOMS)
3293: ! jbr36 - writes the first input for qm rate calculations from classical rates3255: ! jbr36 - writes the first input for qm rate calculations from classical rates
3294:                  IF (INSTANTONSTARTDUMPT) THEN3256:                  IF (INSTANTONSTARTDUMPT) THEN
3295:                     LUNIT=5553257:                     LUNIT=555
3296:                     OPEN(LUNIT,file='qmrate_reactant.plus.txt', action='WRITE')3258:                     OPEN(LUNIT,file='qmrate_reactant.plus.txt', action='WRITE')
3297:                     WRITE(LUNIT,'(a)') "Energy and Hessian eigenvalues of reactant.plus"3259:                     WRITE(LUNIT,'(a)') "Energy and Hessian eigenvalues of reactant.plus"
3298:                     WRITE(LUNIT,*) NATOMS,NATOMS*33260:                     WRITE(LUNIT,*) NATOMS,NATOMS*3
3299:                     WRITE(LUNIT,*) DUMMY13261:                     WRITE(LUNIT,*) DUMMY1
3300:                     WRITE(LUNIT,*) "Coordinates"3262:                     WRITE(LUNIT,*) "Coordinates"
3301:                     WRITE(LUNIT,*) QPLUS3263:                     WRITE(LUNIT,*) QPLUS
3302:                     WRITE(LUNIT,*) "Hessian Eigenvalues"3264:                     WRITE(LUNIT,*) "Hessian Eigenvalues"
3303:                     WRITE(LUNIT,*) DIAG3265:                     WRITE(LUNIT,*) DIAG
3304:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"3266:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"
3305:                     WRITE(LUNIT,*) ATMASS3267:                     WRITE(LUNIT,*) ATMASS
3306:                     CLOSE(LUNIT)3268:                     CLOSE(LUNIT)
3307:                  ENDIF3269:                  ENDIF
3308:               ENDIF3270:               ENDIF
3309:               IF (SDT.OR.TTM3T) THEN3271:               IF (SDT.OR.TTM3T) THEN
3310:                  WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,NOPT)3272:                  WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
3311:               ELSEIF (BOWMANT) THEN3273:               ELSEIF (BOWMANT) THEN
3312:                  WRITE(88,'(3G20.10)') (DIAG(J2)*2625.47D26,J2=1,NOPT)3274:                  WRITE(88,'(3G20.10)') (DIAG(J2)*2625.47D26,J2=1,3*NATOMS)
3313:               ELSEIF (RIGIDINIT) THEN3275:               ELSEIF (RIGIDINIT) THEN
3314:                  IF (MACHINE) THEN3276:                  IF (MACHINE) THEN
3315: !                    WRITE(88) (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)3277: !                    WRITE(88) (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
3316:                     WRITE(88) (DIAG(J2),J2=1,DEGFREEDOMS)3278:                     WRITE(88) (DIAG(J2),J2=1,DEGFREEDOMS)
3317:                  ELSE3279:                  ELSE
3318:                     WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,DEGFREEDOMS)3280:                     WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,DEGFREEDOMS)
3319: !                    WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)3281: !                    WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
3320:                  ENDIF3282:                  ENDIF
3321:               ELSE3283:               ELSE
3322:                  WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)3284:                  WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,3*NATOMS)
3323:               ENDIF3285:               ENDIF
3324:            ENDIF3286:            ENDIF
3325:         ENDIF3287:         ENDIF
3326:      ELSE3288:      ELSE
3327:         IF (VARIABLES) THEN3289:         CALL SYMMETRY(HORDER,.FALSE.,QPLUS,INERTIA)
3328:            HORDER=1 
3329:            FPGRP='C1' 
3330:         ELSE 
3331:            CALL SYMMETRY(HORDER,.FALSE.,QPLUS,INERTIA) 
3332:         ENDIF 
3333:         WRITE(88,'(I6,1X,A4)') HORDER,FPGRP3290:         WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
3334:      ENDIF3291:      ENDIF
3335:      IF (MACHINE) THEN3292:      IF (MACHINE) THEN
3336:         IF (GTHOMSONT) THEN3293:         IF (GTHOMSONT) THEN
3337:            CALL GTHOMSONANGTOC(TMPCOORDS, QPLUS, NATOMS)3294:            CALL GTHOMSONANGTOC(TMPCOORDS, QPLUS, NATOMS)
3338:            WRITE(88) (TMPCOORDS, J2=1, NOPT)3295:            WRITE(88) (TMPCOORDS, J2=1, 3*NATOMS)
3339:         ELSE3296:         ELSE
3340:            WRITE(88) (QPLUS,J2=1,NOPT)3297:            WRITE(88) (QPLUS,J2=1,3*NATOMS)
3341:         ENDIF3298:         ENDIF
3342:      ELSEIF (AMHT) THEN3299:      ELSEIF (AMHT) THEN
3343: 3300: 
3344: !  THIS IS FOR PLACE HOLDING C-BETAS FOR GLYCINE IN AMH3301: !  THIS IS FOR PLACE HOLDING C-BETAS FOR GLYCINE IN AMH
3345:         GLY_COUNT = 03302:         GLY_COUNT = 0
3346: 3303: 
3347:         DO J2=1, NRES_AMH_TEMP3304:         DO J2=1, NRES_AMH_TEMP
3348:            IF (SEQ(J2).EQ.8) THEN3305:            IF (SEQ(J2).EQ.8) THEN
3349: !             WRITE(2,*)SEQ(J2) , J23306: !             WRITE(2,*)SEQ(J2) , J2
3350:                WRITE(88,*)QPLUS(9*(J2-1)+1-GLY_COUNT*3), &3307:                WRITE(88,*)QPLUS(9*(J2-1)+1-GLY_COUNT*3), &
3362:                QPLUS(9*(J2-1)+5-GLY_COUNT*3),QPLUS(9*(J2-1)+6-GLY_COUNT*3)3319:                QPLUS(9*(J2-1)+5-GLY_COUNT*3),QPLUS(9*(J2-1)+6-GLY_COUNT*3)
3363:             WRITE(88,*)QPLUS(9*(J2-1)+7-GLY_COUNT*3), &3320:             WRITE(88,*)QPLUS(9*(J2-1)+7-GLY_COUNT*3), &
3364:                QPLUS(9*(J2-1)+8-GLY_COUNT*3),QPLUS(9*(J2-1)+9-GLY_COUNT*3)3321:                QPLUS(9*(J2-1)+8-GLY_COUNT*3),QPLUS(9*(J2-1)+9-GLY_COUNT*3)
3365:            ENDIF3322:            ENDIF
3366:         ENDDO3323:         ENDDO
3367:      ELSE3324:      ELSE
3368:          IF (GTHOMSONT) THEN3325:          IF (GTHOMSONT) THEN
3369:             CALL GTHOMSONANGTOC(TMPCOORDS, QPLUS, NATOMS)3326:             CALL GTHOMSONANGTOC(TMPCOORDS, QPLUS, NATOMS)
3370:             WRITE(88,'(3F25.15)') (TMPCOORDS(J2), J2=1, 3*NATOMS)3327:             WRITE(88,'(3F25.15)') (TMPCOORDS(J2), J2=1, 3*NATOMS)
3371:          ELSE                       3328:          ELSE                       
3372:             WRITE(88,'(3F25.15)') (QPLUS(J2),J2=1,NOPT)3329:             WRITE(88,'(3F25.15)') (QPLUS(J2),J2=1,3*NATOMS)
3373:          ENDIF3330:          ENDIF
3374:      ENDIF3331:      ENDIF
3375: !3332: !
3376: ! now the transition state3333: ! now the transition state
3377: !3334: !
3378:      IF (MACHINE) THEN3335:      IF (MACHINE) THEN
3379:           WRITE(88) ETS3336:           WRITE(88) ETS
3380:      ELSE3337:      ELSE
3381:           WRITE(88,'(F25.15)') ETS3338:           WRITE(88,'(F25.15)') ETS
3382:      ENDIF3339:      ENDIF
3416:               ELSE3373:               ELSE
3417:                  IF (ENDNUMHESS) THEN3374:                  IF (ENDNUMHESS) THEN
3418:                     CALL MAKENUMHESS(QTS,NATOMS)3375:                     CALL MAKENUMHESS(QTS,NATOMS)
3419:                  ELSE3376:                  ELSE
3420:                     CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3377:                     CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3421:                  ENDIF3378:                  ENDIF
3422:                  CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)3379:                  CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
3423:                  IF (HESSDUMPT) THEN3380:                  IF (HESSDUMPT) THEN
3424:                     LUNIT=GETUNIT()3381:                     LUNIT=GETUNIT()
3425:                     OPEN(LUNIT,FILE='tshess',STATUS='UNKNOWN',POSITION ='APPEND')3382:                     OPEN(LUNIT,FILE='tshess',STATUS='UNKNOWN',POSITION ='APPEND')
3426:                     WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)3383:                     WRITE(LUNIT,'(6G20.10)') HESS(1:3*NATOMS,1:3*NATOMS)
3427:                     CLOSE(LUNIT)3384:                     CLOSE(LUNIT)
3428:                  ENDIF3385:                  ENDIF
3429:                  CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)3386:                  CALL DSYEV('N','U',3*NATOMS,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
3430:                  IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)3387:                  IF (DIAG(1).LT.DIAG(3*NATOMS)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,3*NATOMS,3*NATOMS)
3431: ! jbr36 - writes the first input for qm rate calculations from classical rates3388: ! jbr36 - writes the first input for qm rate calculations from classical rates
3432:                  IF (INSTANTONSTARTDUMPT) THEN3389:                  IF (INSTANTONSTARTDUMPT) THEN
3433:                     LUNIT=5553390:                     LUNIT=555
3434:                     OPEN(LUNIT,file='qmrate_ts.txt', action='WRITE')3391:                     OPEN(LUNIT,file='qmrate_ts.txt', action='WRITE')
3435:                     WRITE(LUNIT,'(a)') "Energy and Hessian eigenvalues of transition state"3392:                     WRITE(LUNIT,'(a)') "Energy and Hessian eigenvalues of transition state"
3436:                     WRITE(LUNIT,*) NATOMS,NATOMS*33393:                     WRITE(LUNIT,*) NATOMS,NATOMS*3
3437:                     WRITE(LUNIT,*) DUMMY13394:                     WRITE(LUNIT,*) DUMMY1
3438:                     WRITE(LUNIT,*) "Coordinates"3395:                     WRITE(LUNIT,*) "Coordinates"
3439:                     WRITE(LUNIT,*) QTS3396:                     WRITE(LUNIT,*) QTS
3440:                     WRITE(LUNIT,*) "Hessian Eigenvalues"3397:                     WRITE(LUNIT,*) "Hessian Eigenvalues"
3441:                     WRITE(LUNIT,*) DIAG3398:                     WRITE(LUNIT,*) DIAG
3442:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"3399:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"
3443:                     WRITE(LUNIT,*) ATMASS3400:                     WRITE(LUNIT,*) ATMASS
3444:                     CLOSE(LUNIT)3401:                     CLOSE(LUNIT)
3445:                  ENDIF3402:                  ENDIF
3446:                  IF (MACHINE) THEN3403:                  IF (MACHINE) THEN
3447:                     WRITE(88) (DIAG(J2)*4.184D26,J2=1,NOPT)3404:                     WRITE(88) (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
3448:                  ELSE3405:                  ELSE
3449:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,NOPT)3406:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
3450:                  ENDIF3407:                  ENDIF
3451:               ENDIF3408:               ENDIF
3452:            ENDIF3409:            ENDIF
3453:         ELSE IF (AMBER12T.OR.AMBERT.OR.NABT) THEN3410:         ELSE IF (AMBER12T.OR.AMBERT.OR.NABT) THEN
3454:            IF (.NOT.MACROCYCLET) THEN3411:            IF (.NOT.MACROCYCLET) THEN
3455:               HORDER=13412:               HORDER=1
3456:               FPGRP='C1'3413:               FPGRP='C1'
3457:            ELSE3414:            ELSE
3458:               CALL SYMMETRY(HORDER,.FALSE.,QTS,INERTIA)3415:               CALL SYMMETRY(HORDER,.FALSE.,QTS,INERTIA)
3459:            ENDIF3416:            ENDIF
3479:               ELSE3436:               ELSE
3480:                  IF (ENDNUMHESS.OR.AMBERT.OR.AMBER12T) THEN3437:                  IF (ENDNUMHESS.OR.AMBERT.OR.AMBER12T) THEN
3481:                     CALL MAKENUMHESS(QTS,NATOMS)3438:                     CALL MAKENUMHESS(QTS,NATOMS)
3482:                  ELSE3439:                  ELSE
3483:                     CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3440:                     CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3484:                  ENDIF3441:                  ENDIF
3485:                  CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)3442:                  CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
3486:                  IF (HESSDUMPT) THEN3443:                  IF (HESSDUMPT) THEN
3487:                     LUNIT=GETUNIT()3444:                     LUNIT=GETUNIT()
3488:                     OPEN(LUNIT,FILE='tshess',STATUS='UNKNOWN',POSITION ='APPEND')3445:                     OPEN(LUNIT,FILE='tshess',STATUS='UNKNOWN',POSITION ='APPEND')
3489:                     WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)3446:                     WRITE(LUNIT,'(6G20.10)') HESS(1:3*NATOMS,1:3*NATOMS)
3490:                     CLOSE(LUNIT)3447:                     CLOSE(LUNIT)
3491:                  ENDIF3448:                  ENDIF
3492:                  IF (FREEZE) THEN3449:                  IF (FREEZE) THEN
3493:                     CALL SWEEP_ZERO()3450:                     CALL SWEEP_ZERO()
3494:                     DIAG=0.0D03451:                     DIAG=0.0D0
3495:                     CALL DSYEV('N','U',3*NONFREEZE,NONFROZENHESS,SIZE(NONFROZENHESS,1),DIAG(1:3*NONFREEZE),TEMPA,9*NONFREEZE,INFO)3452:                     CALL DSYEV('N','U',3*NONFREEZE,NONFROZENHESS,SIZE(NONFROZENHESS,1),DIAG(1:3*NONFREEZE),TEMPA,9*NONFREEZE,INFO)
3496:                  ELSE3453:                  ELSE
3497:                     CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)3454:                     CALL DSYEV('N','U',3*NATOMS,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
3498:                  ENDIF3455:                  ENDIF
3499:                  IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)3456:                  IF (DIAG(1).LT.DIAG(3*NATOMS)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,3*NATOMS,3*NATOMS)
3500: ! jbr36 - writes the first input for qm rate calculations from classical rates3457: ! jbr36 - writes the first input for qm rate calculations from classical rates
3501:                  IF (INSTANTONSTARTDUMPT) THEN3458:                  IF (INSTANTONSTARTDUMPT) THEN
3502:                     LUNIT=5553459:                     LUNIT=555
3503:                     OPEN(LUNIT,file='qmrate_ts.txt', action='WRITE')3460:                     OPEN(LUNIT,file='qmrate_ts.txt', action='WRITE')
3504:                     WRITE(LUNIT,'(a)') "Energy and Hessian eigenvalues of transition state"3461:                     WRITE(LUNIT,'(a)') "Energy and Hessian eigenvalues of transition state"
3505:                     WRITE(LUNIT,*) NATOMS,NATOMS*33462:                     WRITE(LUNIT,*) NATOMS,NATOMS*3
3506:                     WRITE(LUNIT,*) DUMMY13463:                     WRITE(LUNIT,*) DUMMY1
3507:                     WRITE(LUNIT,*) "Coordinates"3464:                     WRITE(LUNIT,*) "Coordinates"
3508:                     WRITE(LUNIT,*) QTS3465:                     WRITE(LUNIT,*) QTS
3509:                     WRITE(LUNIT,*) "Hessian Eigenvalues"3466:                     WRITE(LUNIT,*) "Hessian Eigenvalues"
3510:                     WRITE(LUNIT,*) DIAG3467:                     WRITE(LUNIT,*) DIAG
3511:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"3468:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"
3512:                     WRITE(LUNIT,*) ATMASS3469:                     WRITE(LUNIT,*) ATMASS
3513:                     CLOSE(LUNIT)3470:                     CLOSE(LUNIT)
3514:                  ENDIF3471:                  ENDIF
3515:                  IF (MACHINE) THEN3472:                  IF (MACHINE) THEN
3516:                     WRITE(88) (DIAG(J2)*4.184D26,J2=1,NOPT)3473:                     WRITE(88) (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
3517:                  ELSE3474:                  ELSE
3518:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,NOPT)3475:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
3519:                  ENDIF3476:                  ENDIF
3520:               ENDIF3477:               ENDIF
3521:            ENDIF3478:            ENDIF
3522:         ELSEIF (UNRST) THEN3479:         ELSEIF (UNRST) THEN
3523:            HORDER=13480:            HORDER=1
3524:            FPGRP='C1'3481:            FPGRP='C1'
3525:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP3482:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
3526:            IF (.NOT.NOFRQS) THEN3483:            IF (.NOT.NOFRQS) THEN
3527:               IF (ENDNUMHESS) THEN3484:               IF (ENDNUMHESS) THEN
3528:                  CALL MAKENUMINTHESS(NINTS,NATOMS)3485:                  CALL MAKENUMINTHESS(NINTS,NATOMS)
3529:                  CALL GETSTUFF(KD,NNZ,NINTB)3486:                  CALL GETSTUFF(KD,NNZ,NINTB)
3530:                  CALL INTSECDET(QTS,NOPT,KD,NNZ,NINTB,DIAG)3487:                  CALL INTSECDET(QTS,3*NATOMS,KD,NNZ,NINTB,DIAG)
3531:               ELSE3488:               ELSE
3532:                  CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3489:                  CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3533:               ENDIF3490:               ENDIF
3534:               DO J2=1,NINTS-13491:               DO J2=1,NINTS-1
3535:                  IF (DIAG(J2).LT.0.0D0) PRINT *,'Higher order saddle found in pathway - ts eigenvalue ',DIAG(J2)3492:                  IF (DIAG(J2).LT.0.0D0) PRINT *,'Higher order saddle found in pathway - ts eigenvalue ',DIAG(J2)
3536:               END DO3493:               END DO
3537:               WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)3494:               WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,3*NATOMS)
3538:            ENDIF3495:            ENDIF
3539:         ELSEIF (AMHT) THEN3496:         ELSEIF (AMHT) THEN
3540:            WRITE(88,'(I6,1X,A4)') 1,' C1'3497:            WRITE(88,'(I6,1X,A4)') 1,' C1'
3541:            IF (.NOT.NOFRQS) THEN3498:            IF (.NOT.NOFRQS) THEN
3542:               IF (ENDNUMHESS) THEN3499:               IF (ENDNUMHESS) THEN
3543:                  CALL MAKENUMHESS(QTS,NATOMS)3500:                  CALL MAKENUMHESS(QTS,NATOMS)
3544:               ELSE3501:               ELSE
3545:                  CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3502:                  CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3546:               ENDIF3503:               ENDIF
3547:               CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)3504:               CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
3548:                  IF (HESSDUMPT) THEN3505:                  IF (HESSDUMPT) THEN
3549:                     LUNIT=GETUNIT()3506:                     LUNIT=GETUNIT()
3550:                     OPEN(LUNIT,FILE='tshess',STATUS='UNKNOWN',POSITION ='APPEND')3507:                     OPEN(LUNIT,FILE='tshess',STATUS='UNKNOWN',POSITION ='APPEND')
3551:                     WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)3508:                     WRITE(LUNIT,'(6G20.10)') HESS(1:3*NATOMS,1:3*NATOMS)
3552:                     CLOSE(LUNIT)3509:                     CLOSE(LUNIT)
3553:                  ENDIF3510:                  ENDIF
3554:               CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)3511:               CALL DSYEV('N','U',3*NATOMS,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
3555:               IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)3512:               IF (DIAG(1).LT.DIAG(3*NATOMS)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,3*NATOMS,3*NATOMS)
3556:               WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)3513:               WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,3*NATOMS)
3557: ! jbr36 - writes the first input for qm rate calculations from classical rates3514: ! jbr36 - writes the first input for qm rate calculations from classical rates
3558:                     IF (INSTANTONSTARTDUMPT) THEN3515:                     IF (INSTANTONSTARTDUMPT) THEN
3559: !                      CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3516: !                      CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3560:                       LUNIT=5553517:                       LUNIT=555
3561:                       open(LUNIT,file='qmrate_ts.txt', action='write')3518:                       open(LUNIT,file='qmrate_ts.txt', action='write')
3562:                       write(LUNIT,'(a)') "Energy and Hessian eigenvalues of transition state"3519:                       write(LUNIT,'(a)') "Energy and Hessian eigenvalues of transition state"
3563:                       write(LUNIT,*) NATOMS,NATOMS*33520:                       write(LUNIT,*) NATOMS,NATOMS*3
3564:                       write(LUNIT,*) DUMMY13521:                       write(LUNIT,*) DUMMY1
3565:                       write(LUNIT,*) "Coordinates"3522:                       write(LUNIT,*) "Coordinates"
3566:                       write(LUNIT,*) QTS3523:                       write(LUNIT,*) QTS
3579:            IF (.NOT.NOFRQS) THEN3536:            IF (.NOT.NOFRQS) THEN
3580:               IF (ENDNUMHESS) THEN3537:               IF (ENDNUMHESS) THEN
3581:                  CALL MAKENUMHESS(QTS,NATOMS)3538:                  CALL MAKENUMHESS(QTS,NATOMS)
3582:               ELSE3539:               ELSE
3583:                  CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3540:                  CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3584:               ENDIF3541:               ENDIF
3585:               CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)3542:               CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
3586:                  IF (HESSDUMPT) THEN3543:                  IF (HESSDUMPT) THEN
3587:                     LUNIT=GETUNIT()3544:                     LUNIT=GETUNIT()
3588:                     OPEN(LUNIT,FILE='tshess',STATUS='UNKNOWN',POSITION ='APPEND')3545:                     OPEN(LUNIT,FILE='tshess',STATUS='UNKNOWN',POSITION ='APPEND')
3589:                     WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)3546:                     WRITE(LUNIT,'(6G20.10)') HESS(1:3*NATOMS,1:3*NATOMS)
3590:                     CLOSE(LUNIT)3547:                     CLOSE(LUNIT)
3591:                  ENDIF3548:                  ENDIF
3592:               CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)3549:               CALL DSYEV('N','U',3*NATOMS,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
3593:               IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)3550:               IF (DIAG(1).LT.DIAG(3*NATOMS)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,3*NATOMS,3*NATOMS)
3594:               IF (DIAG(3*NATOMS) < 0.0) THEN3551:               IF (DIAG(3*NATOMS) < 0.0) THEN
3595:                  DIAG(2*NATOMS) = DIAG(3*NATOMS)3552:                  DIAG(2*NATOMS) = DIAG(3*NATOMS)
3596:               ENDIF3553:               ENDIF
3597: 3554: 
3598:            ENDIF3555:            ENDIF
3599:            WRITE(88,'(3G20.10)') (1.0D10, J2=1, NATOMS)3556:            WRITE(88,'(3G20.10)') (1.0D10, J2=1, NATOMS)
3600:            IF (SDT.OR.TTM3T) THEN3557:            IF (SDT.OR.TTM3T) THEN
3601:               WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,2*NATOMS)3558:               WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,2*NATOMS)
3602:            ELSEIF (BOWMANT) THEN3559:            ELSEIF (BOWMANT) THEN
3603:               WRITE(88,'(3G20.10)') (DIAG(J2)*2625.47D26,J2=1,2*NATOMS)3560:               WRITE(88,'(3G20.10)') (DIAG(J2)*2625.47D26,J2=1,2*NATOMS)
3604:            ELSE3561:            ELSE
3605:               WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,2*NATOMS)3562:               WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,2*NATOMS)
3606:            ENDIF3563:            ENDIF
3607: 3564: 
3608:         ELSE3565:         ELSE
3609:            IF (VARIABLES) THEN3566:            CALL SYMMETRY(HORDER,.FALSE.,QTS,INERTIA)
3610:               HORDER=1 
3611:               FPGRP='C1' 
3612:            ELSE 
3613:               CALL SYMMETRY(HORDER,.FALSE.,QTS,INERTIA) 
3614:            ENDIF 
3615:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP3567:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
3616:            IF (.NOT.NOFRQS) THEN3568:            IF (.NOT.NOFRQS) THEN
3617:               IF (RIGIDINIT) THEN3569:               IF (RIGIDINIT) THEN
3618: ! hk286 - TS is recorded in rigid body coordinates3570: ! hk286 - TS is recorded in rigid body coordinates
3619:                  ATOMRIGIDCOORDT = .FALSE.3571:                  ATOMRIGIDCOORDT = .FALSE.
3620:                  IF(METRICTENSOR) THEN3572:                  IF(METRICTENSOR) THEN
3621:                      CALL GENRIGID_NORMALMODES(QTS, ATMASS, DIAG, INFO)3573:                      CALL GENRIGID_NORMALMODES(QTS, ATMASS, DIAG, INFO)
3622:                  ELSE3574:                  ELSE
3623:                      CALL GENRIGID_EIGENVALUES(QTS, ATMASS, DIAG, INFO)3575:                      CALL GENRIGID_EIGENVALUES(QTS, ATMASS, DIAG, INFO)
3624:                  ENDIF3576:                  ENDIF
3635:               ELSE3587:               ELSE
3636:                  IF (ENDNUMHESS) THEN3588:                  IF (ENDNUMHESS) THEN
3637:                     CALL MAKENUMHESS(QTS,NATOMS)3589:                     CALL MAKENUMHESS(QTS,NATOMS)
3638:                  ELSE3590:                  ELSE
3639:                     CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3591:                     CALL POTENTIAL(QTS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3640:                  ENDIF3592:                  ENDIF
3641:                  CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)3593:                  CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
3642:                  IF (HESSDUMPT) THEN3594:                  IF (HESSDUMPT) THEN
3643:                     LUNIT=GETUNIT()3595:                     LUNIT=GETUNIT()
3644:                     OPEN(LUNIT,FILE='tshess',STATUS='UNKNOWN',POSITION ='APPEND')3596:                     OPEN(LUNIT,FILE='tshess',STATUS='UNKNOWN',POSITION ='APPEND')
3645:                     WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)3597:                     WRITE(LUNIT,'(6G20.10)') HESS(1:3*NATOMS,1:3*NATOMS)
3646:                     CLOSE(LUNIT)3598:                     CLOSE(LUNIT)
3647:                  ENDIF3599:                  ENDIF
3648:                  CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)3600:                  CALL DSYEV('N','U',3*NATOMS,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
3649: !                IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)3601:                  IF (DIAG(1).LT.DIAG(3*NATOMS)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,3*NATOMS,3*NATOMS)
3650:                  IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT) 
3651: ! jbr36 - writes the first input for qm rate calculations from classical rates3602: ! jbr36 - writes the first input for qm rate calculations from classical rates
3652:                  IF (INSTANTONSTARTDUMPT) THEN3603:                  IF (INSTANTONSTARTDUMPT) THEN
3653:                     LUNIT=5553604:                     LUNIT=555
3654:                     OPEN(LUNIT,file='qmrate_ts.txt', action='WRITE')3605:                     OPEN(LUNIT,file='qmrate_ts.txt', action='WRITE')
3655:                     WRITE(LUNIT,'(a)') "Energy and Hessian eigenvalues of transition state"3606:                     WRITE(LUNIT,'(a)') "Energy and Hessian eigenvalues of transition state"
3656:                     WRITE(LUNIT,*) NATOMS,NATOMS*33607:                     WRITE(LUNIT,*) NATOMS,NATOMS*3
3657:                     WRITE(LUNIT,*) DUMMY13608:                     WRITE(LUNIT,*) DUMMY1
3658:                     WRITE(LUNIT,*) "Coordinates"3609:                     WRITE(LUNIT,*) "Coordinates"
3659:                     WRITE(LUNIT,*) QTS3610:                     WRITE(LUNIT,*) QTS
3660:                     WRITE(LUNIT,*) "Hessian Eigenvalues"3611:                     WRITE(LUNIT,*) "Hessian Eigenvalues"
3661:                     WRITE(LUNIT,*) DIAG3612:                     WRITE(LUNIT,*) DIAG
3662:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"3613:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"
3663:                     WRITE(LUNIT,*) ATMASS3614:                     WRITE(LUNIT,*) ATMASS
3664:                     CLOSE(LUNIT)3615:                     CLOSE(LUNIT)
3665:                  ENDIF3616:                  ENDIF
3666:               ENDIF3617:               ENDIF
3667:               IF (SDT.OR.TTM3T) THEN3618:               IF (SDT.OR.TTM3T) THEN
3668:                  WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,NOPT)3619:                  WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
3669:               ELSEIF (BOWMANT) THEN3620:               ELSEIF (BOWMANT) THEN
3670:                  WRITE(88,'(3G20.10)') (DIAG(J2)*2625.47D26,J2=1,NOPT)3621:                  WRITE(88,'(3G20.10)') (DIAG(J2)*2625.47D26,J2=1,3*NATOMS)
3671:               ELSEIF (RIGIDINIT) THEN3622:               ELSEIF (RIGIDINIT) THEN
3672:                  IF (MACHINE) THEN3623:                  IF (MACHINE) THEN
3673: !                    WRITE(88) (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)3624: !                    WRITE(88) (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
3674:                     WRITE(88) (DIAG(J2),J2=1,DEGFREEDOMS)3625:                     WRITE(88) (DIAG(J2),J2=1,DEGFREEDOMS)
3675:                  ELSE3626:                  ELSE
3676:                     WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,DEGFREEDOMS)3627:                     WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,DEGFREEDOMS)
3677: !                    WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)3628: !                    WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
3678:                  ENDIF3629:                  ENDIF
3679:               ELSE3630:               ELSE
3680:                  WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)3631:                  WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,3*NATOMS)
3681:               ENDIF3632:               ENDIF
3682:            ENDIF3633:            ENDIF
3683:         ENDIF3634:         ENDIF
3684:      ELSE3635:      ELSE
3685:         IF (VARIABLES) THEN3636:         CALL SYMMETRY(HORDER,.FALSE.,QTS,INERTIA)
3686:            HORDER=1 
3687:            FPGRP='C1' 
3688:         ELSE 
3689:            CALL SYMMETRY(HORDER,.FALSE.,QTS,INERTIA) 
3690:         ENDIF 
3691:         WRITE(88,'(I6,1X,A4)') HORDER,FPGRP3637:         WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
3692:      ENDIF3638:      ENDIF
3693:      IF (MACHINE) THEN3639:      IF (MACHINE) THEN
3694:         IF (GTHOMSONT) THEN3640:         IF (GTHOMSONT) THEN
3695:            CALL GTHOMSONANGTOC(TMPCOORDS, QTS, NATOMS)3641:            CALL GTHOMSONANGTOC(TMPCOORDS, QTS, NATOMS)
3696:            WRITE(88) (TMPCOORDS(J2), J2=1, 3*NATOMS)3642:            WRITE(88) (TMPCOORDS(J2), J2=1, 3*NATOMS)
3697:         ELSEIF (RIGIDINIT) THEN3643:         ELSEIF (RIGIDINIT) THEN
3698:            CALL TRANSFORMRIGIDTOC (1, NRIGIDBODY, XCOORDS, QTS(1:DEGFREEDOMS))3644:            CALL TRANSFORMRIGIDTOC (1, NRIGIDBODY, XCOORDS, QTS(1:DEGFREEDOMS))
3699:            WRITE(88) (XCOORDS(J2),J2=1,NOPT)3645:            WRITE(88) (XCOORDS(J2),J2=1,NOPT)
3700:         ELSE           3646:         ELSE           
3779:               ELSE3725:               ELSE
3780:                  IF (ENDNUMHESS) THEN3726:                  IF (ENDNUMHESS) THEN
3781:                     CALL MAKENUMHESS(QMINUS,NATOMS)3727:                     CALL MAKENUMHESS(QMINUS,NATOMS)
3782:                  ELSE3728:                  ELSE
3783:                     CALL POTENTIAL(QMINUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3729:                     CALL POTENTIAL(QMINUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3784:                  ENDIF3730:                  ENDIF
3785:                  CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)3731:                  CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
3786:                  IF (HESSDUMPT) THEN3732:                  IF (HESSDUMPT) THEN
3787:                     LUNIT=GETUNIT()3733:                     LUNIT=GETUNIT()
3788:                     OPEN(LUNIT,FILE='minhess.minus',STATUS='UNKNOWN',POSITION ='APPEND')3734:                     OPEN(LUNIT,FILE='minhess.minus',STATUS='UNKNOWN',POSITION ='APPEND')
3789:                     WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)3735:                     WRITE(LUNIT,'(6G20.10)') HESS(1:3*NATOMS,1:3*NATOMS)
3790:                     CLOSE(LUNIT)3736:                     CLOSE(LUNIT)
3791:                  ENDIF3737:                  ENDIF
3792:                  CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)3738:                  CALL DSYEV('N','U',3*NATOMS,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
3793:                  IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)3739:                  IF (DIAG(1).LT.DIAG(3*NATOMS)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,3*NATOMS,3*NATOMS)
3794: ! jbr36 - writes the first input for qm rate calculations from classical rates3740: ! jbr36 - writes the first input for qm rate calculations from classical rates
3795:                  IF (INSTANTONSTARTDUMPT) THEN3741:                  IF (INSTANTONSTARTDUMPT) THEN
3796:                     LUNIT=5553742:                     LUNIT=555
3797:                     OPEN(LUNIT,file='qmrate_reactant.minus.txt', action='WRITE')3743:                     OPEN(LUNIT,file='qmrate_reactant.minus.txt', action='WRITE')
3798:                     WRITE(LUNIT,'(a)') "Energy and Hessian eigenvalues of reactant.minus"3744:                     WRITE(LUNIT,'(a)') "Energy and Hessian eigenvalues of reactant.minus"
3799:                     WRITE(LUNIT,*) NATOMS,NATOMS*33745:                     WRITE(LUNIT,*) NATOMS,NATOMS*3
3800:                     WRITE(LUNIT,*) DUMMY13746:                     WRITE(LUNIT,*) DUMMY1
3801:                     WRITE(LUNIT,*) "Coordinates"3747:                     WRITE(LUNIT,*) "Coordinates"
3802:                     WRITE(LUNIT,*) QMINUS3748:                     WRITE(LUNIT,*) QMINUS
3803:                     WRITE(LUNIT,*) "Hessian Eigenvalues"3749:                     WRITE(LUNIT,*) "Hessian Eigenvalues"
3804:                     WRITE(LUNIT,*) DIAG3750:                     WRITE(LUNIT,*) DIAG
3805:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"3751:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"
3806:                     WRITE(LUNIT,*) ATMASS3752:                     WRITE(LUNIT,*) ATMASS
3807:                     CLOSE(LUNIT)3753:                     CLOSE(LUNIT)
3808:                  ENDIF3754:                  ENDIF
3809:                  IF (MACHINE) THEN3755:                  IF (MACHINE) THEN
3810:                     WRITE(88) (DIAG(J2)*4.184D26,J2=1,NOPT)3756:                     WRITE(88) (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
3811:                  ELSE3757:                  ELSE
3812:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,NOPT)3758:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
3813:                  ENDIF3759:                  ENDIF
3814:               ENDIF3760:               ENDIF
3815:            ENDIF3761:            ENDIF
3816:         ELSEIF (AMBER12T.OR.AMBERT.OR.NABT) THEN3762:         ELSEIF (AMBER12T.OR.AMBERT.OR.NABT) THEN
3817:            IF (.NOT.MACROCYCLET) THEN3763:            IF (.NOT.MACROCYCLET) THEN
3818:               HORDER=13764:               HORDER=1
3819:               FPGRP='C1'3765:               FPGRP='C1'
3820:            ELSE3766:            ELSE
3821:               CALL SYMMETRY(HORDER,.FALSE.,QMINUS,INERTIA)3767:               CALL SYMMETRY(HORDER,.FALSE.,QMINUS,INERTIA)
3822:            ENDIF3768:            ENDIF
3839:               ELSE3785:               ELSE
3840:                  IF (ENDNUMHESS.OR.AMBERT.OR.AMBER12T) THEN3786:                  IF (ENDNUMHESS.OR.AMBERT.OR.AMBER12T) THEN
3841:                     CALL MAKENUMHESS(QMINUS,NATOMS)3787:                     CALL MAKENUMHESS(QMINUS,NATOMS)
3842:                  ELSE3788:                  ELSE
3843:                     CALL POTENTIAL(QMINUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3789:                     CALL POTENTIAL(QMINUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3844:                  ENDIF3790:                  ENDIF
3845:                  CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)3791:                  CALL MASSWT2(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
3846:                  IF (HESSDUMPT) THEN3792:                  IF (HESSDUMPT) THEN
3847:                     LUNIT=GETUNIT()3793:                     LUNIT=GETUNIT()
3848:                     OPEN(LUNIT,FILE='minhess.minus',STATUS='UNKNOWN',POSITION ='APPEND')3794:                     OPEN(LUNIT,FILE='minhess.minus',STATUS='UNKNOWN',POSITION ='APPEND')
3849:                     WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)3795:                     WRITE(LUNIT,'(6G20.10)') HESS(1:3*NATOMS,1:3*NATOMS)
3850:                     CLOSE(LUNIT)3796:                     CLOSE(LUNIT)
3851:                  ENDIF3797:                  ENDIF
3852:                  IF (FREEZE) THEN3798:                  IF (FREEZE) THEN
3853:                     CALL SWEEP_ZERO()3799:                     CALL SWEEP_ZERO()
3854:                     DIAG=0.0D03800:                     DIAG=0.0D0
3855:                     CALL DSYEV('N','U',3*NONFREEZE,NONFROZENHESS,SIZE(NONFROZENHESS,1),DIAG(1:3*NONFREEZE),TEMPA,9*NONFREEZE,INFO)3801:                     CALL DSYEV('N','U',3*NONFREEZE,NONFROZENHESS,SIZE(NONFROZENHESS,1),DIAG(1:3*NONFREEZE),TEMPA,9*NONFREEZE,INFO)
3856:                  ELSE3802:                  ELSE
3857:                     CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)3803:                     CALL DSYEV('N','U',3*NATOMS,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
3858:                  ENDIF3804:                  ENDIF
3859:                  IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)3805:                  IF (DIAG(1).LT.DIAG(3*NATOMS)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,3*NATOMS,3*NATOMS)
3860: ! jbr36 - writes the first input for qm rate calculations from classical rates3806: ! jbr36 - writes the first input for qm rate calculations from classical rates
3861:                  IF (INSTANTONSTARTDUMPT) THEN3807:                  IF (INSTANTONSTARTDUMPT) THEN
3862:                     LUNIT=5553808:                     LUNIT=555
3863:                     OPEN(LUNIT,file='qmrate_reactant.minus.txt', action='WRITE')3809:                     OPEN(LUNIT,file='qmrate_reactant.minus.txt', action='WRITE')
3864:                     WRITE(LUNIT,'(a)') "Energy and Hessian eigenvalues of reactant.minus"3810:                     WRITE(LUNIT,'(a)') "Energy and Hessian eigenvalues of reactant.minus"
3865:                     WRITE(LUNIT,*) NATOMS,NATOMS*33811:                     WRITE(LUNIT,*) NATOMS,NATOMS*3
3866:                     WRITE(LUNIT,*) DUMMY13812:                     WRITE(LUNIT,*) DUMMY1
3867:                     WRITE(LUNIT,*) "Coordinates"3813:                     WRITE(LUNIT,*) "Coordinates"
3868:                     WRITE(LUNIT,*) QMINUS3814:                     WRITE(LUNIT,*) QMINUS
3869:                     WRITE(LUNIT,*) "Hessian Eigenvalues"3815:                     WRITE(LUNIT,*) "Hessian Eigenvalues"
3870:                     WRITE(LUNIT,*) DIAG3816:                     WRITE(LUNIT,*) DIAG
3871:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"3817:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"
3872:                     WRITE(LUNIT,*) ATMASS3818:                     WRITE(LUNIT,*) ATMASS
3873:                     CLOSE(LUNIT)3819:                     CLOSE(LUNIT)
3874:                  ENDIF3820:                  ENDIF
3875:                  IF (MACHINE) THEN3821:                  IF (MACHINE) THEN
3876:                     WRITE(88) (DIAG(J2)*4.184D26,J2=1,NOPT)3822:                     WRITE(88) (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
3877:                  ELSE3823:                  ELSE
3878:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,NOPT)3824:                     WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
3879:                  ENDIF3825:                  ENDIF
3880:               ENDIF3826:               ENDIF
3881:            ENDIF3827:            ENDIF
3882:         ELSEIF (UNRST) THEN3828:         ELSEIF (UNRST) THEN
3883:            HORDER=13829:            HORDER=1
3884:            FPGRP='C1'3830:            FPGRP='C1'
3885:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP3831:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
3886:            IF (.NOT.NOFRQS) THEN3832:            IF (.NOT.NOFRQS) THEN
3887:               IF (ENDNUMHESS) THEN3833:               IF (ENDNUMHESS) THEN
3888:                  CALL MAKENUMINTHESS(NINTS,NATOMS)3834:                  CALL MAKENUMINTHESS(NINTS,NATOMS)
3889:                  CALL GETSTUFF(KD,NNZ,NINTB)3835:                  CALL GETSTUFF(KD,NNZ,NINTB)
3890:                  CALL INTSECDET(QMINUS,NOPT,KD,NNZ,NINTB,DIAG)3836:                  CALL INTSECDET(QMINUS,3*NATOMS,KD,NNZ,NINTB,DIAG)
3891:               ELSE3837:               ELSE
3892:                  CALL POTENTIAL(QMINUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3838:                  CALL POTENTIAL(QMINUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3893:               ENDIF3839:               ENDIF
3894:               WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)3840:               WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,3*NATOMS)
3895:            ENDIF3841:            ENDIF
3896:         ELSEIF (AMHT) THEN3842:         ELSEIF (AMHT) THEN
3897:            WRITE(88,'(I6,1X,A4)') 1,' C1'3843:            WRITE(88,'(I6,1X,A4)') 1,' C1'
3898:            IF (.NOT.NOFRQS) THEN3844:            IF (.NOT.NOFRQS) THEN
3899:               IF (ENDNUMHESS) THEN3845:               IF (ENDNUMHESS) THEN
3900:                  CALL MAKENUMHESS(QMINUS,NATOMS)3846:                  CALL MAKENUMHESS(QMINUS,NATOMS)
3901:               ELSE3847:               ELSE
3902:                  CALL POTENTIAL(QMINUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3848:                  CALL POTENTIAL(QMINUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3903:              ENDIF3849:              ENDIF
3904:              CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)3850:              CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
3905:                  IF (HESSDUMPT) THEN3851:                  IF (HESSDUMPT) THEN
3906:                     LUNIT=GETUNIT()3852:                     LUNIT=GETUNIT()
3907:                     OPEN(LUNIT,FILE='minhess.minus',STATUS='UNKNOWN',POSITION ='APPEND')3853:                     OPEN(LUNIT,FILE='minhess.minus',STATUS='UNKNOWN',POSITION ='APPEND')
3908:                     WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)3854:                     WRITE(LUNIT,'(6G20.10)') HESS(1:3*NATOMS,1:3*NATOMS)
3909:                     CLOSE(LUNIT)3855:                     CLOSE(LUNIT)
3910:                  ENDIF3856:                  ENDIF
3911:              CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)3857:              CALL DSYEV('N','U',3*NATOMS,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
3912:              IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)3858:              IF (DIAG(1).LT.DIAG(3*NATOMS)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,3*NATOMS,3*NATOMS)
3913:              WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)3859:              WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,3*NATOMS)
3914: ! jbr36 - writes the first input for qm rate calculations from classical rates3860: ! jbr36 - writes the first input for qm rate calculations from classical rates
3915:                     IF (INSTANTONSTARTDUMPT) THEN3861:                     IF (INSTANTONSTARTDUMPT) THEN
3916: !                      CALL POTENTIAL(QMINUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3862: !                      CALL POTENTIAL(QMINUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3917:                       LUNIT=5553863:                       LUNIT=555
3918:                       open(LUNIT,file='qmrate_reactant.minus.txt', action='write')3864:                       open(LUNIT,file='qmrate_reactant.minus.txt', action='write')
3919:                       write(LUNIT,'(a)') "Energy and Hessian eigenvalues of reactant.minus"3865:                       write(LUNIT,'(a)') "Energy and Hessian eigenvalues of reactant.minus"
3920:                       write(LUNIT,*) NATOMS,NATOMS*33866:                       write(LUNIT,*) NATOMS,NATOMS*3
3921:                       write(LUNIT,*) QMINUS3867:                       write(LUNIT,*) QMINUS
3922:                       write(LUNIT,*) "Coordinates"3868:                       write(LUNIT,*) "Coordinates"
3923:                       write(LUNIT,*) DUMQ3869:                       write(LUNIT,*) DUMQ
3937:            IF (.NOT.NOFRQS) THEN3883:            IF (.NOT.NOFRQS) THEN
3938:               IF (ENDNUMHESS) THEN3884:               IF (ENDNUMHESS) THEN
3939:                  CALL MAKENUMHESS(QMINUS,NATOMS)3885:                  CALL MAKENUMHESS(QMINUS,NATOMS)
3940:               ELSE3886:               ELSE
3941:                  CALL POTENTIAL(QMINUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3887:                  CALL POTENTIAL(QMINUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3942:               ENDIF3888:               ENDIF
3943:               CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)3889:               CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
3944:                  IF (HESSDUMPT) THEN3890:                  IF (HESSDUMPT) THEN
3945:                     LUNIT=GETUNIT()3891:                     LUNIT=GETUNIT()
3946:                     OPEN(LUNIT,FILE='minhess.minus',STATUS='UNKNOWN',POSITION ='APPEND')3892:                     OPEN(LUNIT,FILE='minhess.minus',STATUS='UNKNOWN',POSITION ='APPEND')
3947:                     WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)3893:                     WRITE(LUNIT,'(6G20.10)') HESS(1:3*NATOMS,1:3*NATOMS)
3948:                     CLOSE(LUNIT)3894:                     CLOSE(LUNIT)
3949:                  ENDIF3895:                  ENDIF
3950:               CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)3896:               CALL DSYEV('N','U',3*NATOMS,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
3951:               IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)3897:               IF (DIAG(1).LT.DIAG(3*NATOMS)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,3*NATOMS,3*NATOMS)
3952:            ENDIF3898:            ENDIF
3953:            ! hk2863899:            ! hk286
3954:            WRITE(88,'(3G20.10)') (1.0D10,J2=1,NATOMS)3900:            WRITE(88,'(3G20.10)') (1.0D10,J2=1,NATOMS)
3955:            IF (SDT.OR.TTM3T) THEN3901:            IF (SDT.OR.TTM3T) THEN
3956:               WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,2*NATOMS)3902:               WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,2*NATOMS)
3957:            ELSEIF (BOWMANT) THEN3903:            ELSEIF (BOWMANT) THEN
3958:               WRITE(88,'(3G20.10)') (DIAG(J2)*2625.47D26,J2=1,2*NATOMS)3904:               WRITE(88,'(3G20.10)') (DIAG(J2)*2625.47D26,J2=1,2*NATOMS)
3959:            ELSE3905:            ELSE
3960:               WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,2*NATOMS)3906:               WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,2*NATOMS)
3961:            ENDIF3907:            ENDIF
3962:         ELSE3908:         ELSE
3963:            IF (VARIABLES) THEN3909:            CALL SYMMETRY(HORDER,.FALSE.,QMINUS,INERTIA)
3964:               HORDER=1 
3965:               FPGRP='C1' 
3966:            ELSE 
3967:               CALL SYMMETRY(HORDER,.FALSE.,QMINUS,INERTIA) 
3968:            ENDIF 
3969:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP3910:            WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
3970:            IF (.NOT.NOFRQS) THEN3911:            IF (.NOT.NOFRQS) THEN
3971:               IF (RIGIDINIT) THEN3912:               IF (RIGIDINIT) THEN
3972:                  IF(METRICTENSOR) THEN3913:                  IF(METRICTENSOR) THEN
3973:                      CALL GENRIGID_NORMALMODES(QMINUS, ATMASS, DIAG, INFO)3914:                      CALL GENRIGID_NORMALMODES(QMINUS, ATMASS, DIAG, INFO)
3974:                  ELSE3915:                  ELSE
3975:                      CALL GENRIGID_EIGENVALUES(QMINUS, ATMASS, DIAG, INFO)3916:                      CALL GENRIGID_EIGENVALUES(QMINUS, ATMASS, DIAG, INFO)
3976:                  ENDIF3917:                  ENDIF
3977:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN3918:                  IF (DIAG(1).LT.DIAG(DEGFREEDOMS)) THEN
3978:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)3919:                     CALL EIGENSORT_VAL_ASC(DIAG(1:DEGFREEDOMS),HESS(1:DEGFREEDOMS,1:DEGFREEDOMS),DEGFREEDOMS,DEGFREEDOMS)
3986:               ELSE3927:               ELSE
3987:                  IF (ENDNUMHESS) THEN3928:                  IF (ENDNUMHESS) THEN
3988:                     CALL MAKENUMHESS(QMINUS,NATOMS)3929:                     CALL MAKENUMHESS(QMINUS,NATOMS)
3989:                  ELSE3930:                  ELSE
3990:                     CALL POTENTIAL(QMINUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)3931:                     CALL POTENTIAL(QMINUS,DUMMY1,GRAD,.TRUE.,.TRUE.,RMS,.FALSE.,.FALSE.)
3991:                  ENDIF3932:                  ENDIF
3992:                  CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)3933:                  CALL MASSWT(NATOMS,ATMASS,DUMQ,GRAD,.TRUE.)
3993:                  IF (HESSDUMPT) THEN3934:                  IF (HESSDUMPT) THEN
3994:                     LUNIT=GETUNIT()3935:                     LUNIT=GETUNIT()
3995:                     OPEN(LUNIT,FILE='minhess.minus',STATUS='UNKNOWN',POSITION ='APPEND')3936:                     OPEN(LUNIT,FILE='minhess.minus',STATUS='UNKNOWN',POSITION ='APPEND')
3996:                     WRITE(LUNIT,'(6G20.10)') HESS(1:NOPT,1:NOPT)3937:                     WRITE(LUNIT,'(6G20.10)') HESS(1:3*NATOMS,1:3*NATOMS)
3997:                     CLOSE(LUNIT)3938:                     CLOSE(LUNIT)
3998:                  ENDIF3939:                  ENDIF
3999:                  CALL DSYEV('N','U',NOPT,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)3940:                  CALL DSYEV('N','U',3*NATOMS,HESS,SIZE(HESS,1),DIAG,TEMPA,9*NATOMS,INFO)
4000:                  IF (DIAG(1).LT.DIAG(NOPT)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,NOPT,NOPT)3941:                  IF (DIAG(1).LT.DIAG(3*NATOMS)) CALL EIGENSORT_VAL_ASC(DIAG,HESS,3*NATOMS,3*NATOMS)
4001: ! jbr36 - writes the first input for qm rate calculations from classical rates3942: ! jbr36 - writes the first input for qm rate calculations from classical rates
4002:                  IF (INSTANTONSTARTDUMPT) THEN3943:                  IF (INSTANTONSTARTDUMPT) THEN
4003:                     LUNIT=5553944:                     LUNIT=555
4004:                     OPEN(LUNIT,file='qmrate_reactant.minus.txt', action='WRITE')3945:                     OPEN(LUNIT,file='qmrate_reactant.minus.txt', action='WRITE')
4005:                     WRITE(LUNIT,'(a)') "Energy and Hessian eigenvalues of reactant.minus"3946:                     WRITE(LUNIT,'(a)') "Energy and Hessian eigenvalues of reactant.minus"
4006:                     WRITE(LUNIT,*) NATOMS,NATOMS*33947:                     WRITE(LUNIT,*) NATOMS,NATOMS*3
4007:                     WRITE(LUNIT,*) DUMMY13948:                     WRITE(LUNIT,*) DUMMY1
4008:                     WRITE(LUNIT,*) "Coordinates"3949:                     WRITE(LUNIT,*) "Coordinates"
4009:                     WRITE(LUNIT,*) QMINUS3950:                     WRITE(LUNIT,*) QMINUS
4010:                     WRITE(LUNIT,*) "Hessian Eigenvalues"3951:                     WRITE(LUNIT,*) "Hessian Eigenvalues"
4011:                     WRITE(LUNIT,*) DIAG3952:                     WRITE(LUNIT,*) DIAG
4012:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"3953:                     WRITE(LUNIT,*) "Masses in amu (M(12C)=12)"
4013:                     WRITE(LUNIT,*) ATMASS3954:                     WRITE(LUNIT,*) ATMASS
4014:                     CLOSE(LUNIT)3955:                     CLOSE(LUNIT)
4015:                  ENDIF3956:                  ENDIF
4016:               ENDIF3957:               ENDIF
4017:               IF (SDT.OR.TTM3T) THEN3958:               IF (SDT.OR.TTM3T) THEN
4018:                  WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,NOPT)3959:                  WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,3*NATOMS)
4019:               ELSEIF (RIGIDINIT) THEN3960:               ELSEIF (RIGIDINIT) THEN
4020:                  IF (MACHINE) THEN3961:                  IF (MACHINE) THEN
4021: !                    WRITE(88) (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)3962: !                    WRITE(88) (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
4022:                     WRITE(88) (DIAG(J2),J2=1,DEGFREEDOMS)3963:                     WRITE(88) (DIAG(J2),J2=1,DEGFREEDOMS)
4023:                  ELSE3964:                  ELSE
4024:                     WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,DEGFREEDOMS)3965:                     WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,DEGFREEDOMS)
4025: !                    WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)3966: !                    WRITE(88,'(3G20.10)') (DIAG(J2)*4.184D26,J2=1,DEGFREEDOMS)
4026:                  ENDIF3967:                  ENDIF
4027:               ELSEIF (BOWMANT) THEN3968:               ELSEIF (BOWMANT) THEN
4028:                  WRITE(88,'(3G20.10)') (DIAG(J2)*2625.47D26,J2=1,NOPT)3969:                  WRITE(88,'(3G20.10)') (DIAG(J2)*2625.47D26,J2=1,3*NATOMS)
4029:               ELSE3970:               ELSE
4030:                  WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,NOPT)3971:                  WRITE(88,'(3G20.10)') (DIAG(J2),J2=1,3*NATOMS)
4031:               ENDIF3972:               ENDIF
4032:            ENDIF3973:            ENDIF
4033:         ENDIF3974:         ENDIF
4034:      ELSE3975:      ELSE
4035:         IF (VARIABLES) THEN3976:         CALL SYMMETRY(HORDER,.FALSE.,QMINUS,INERTIA)
4036:            HORDER=1 
4037:            FPGRP='C1' 
4038:         ELSE 
4039:            CALL SYMMETRY(HORDER,.FALSE.,QMINUS,INERTIA) 
4040:         ENDIF 
4041:         WRITE(88,'(I6,1X,A4)') HORDER,FPGRP3977:         WRITE(88,'(I6,1X,A4)') HORDER,FPGRP
4042:      ENDIF3978:      ENDIF
4043:      IF (MACHINE) THEN3979:      IF (MACHINE) THEN
4044:         IF (GTHOMSONT) THEN3980:         IF (GTHOMSONT) THEN
4045:            CALL GTHOMSONANGTOC(TMPCOORDS, QMINUS, NATOMS)           3981:            CALL GTHOMSONANGTOC(TMPCOORDS, QMINUS, NATOMS)           
4046:            WRITE(88) (TMPCOORDS, J2=1, NOPT)3982:            WRITE(88) (TMPCOORDS, J2=1, 3*NATOMS)
4047:         ELSE3983:         ELSE
4048:            WRITE(88) (QMINUS,J2=1,NOPT)3984:            WRITE(88) (QMINUS,J2=1,3*NATOMS)
4049:         ENDIF3985:         ENDIF
4050:      ELSEIF (AMHT) THEN3986:      ELSEIF (AMHT) THEN
4051: !       READ SEQUENCE3987: !       READ SEQUENCE
4052: 3988: 
4053: !  THIS IS FOR PLACE HOLDING C-BETAS FOR GLYCINE IN AMH3989: !  THIS IS FOR PLACE HOLDING C-BETAS FOR GLYCINE IN AMH
4054:         GLY_COUNT = 03990:         GLY_COUNT = 0
4055: 3991: 
4056:         DO J2=1,NRES_AMH_TEMP3992:         DO J2=1,NRES_AMH_TEMP
4057:            IF (SEQ(J2).EQ.8) THEN3993:            IF (SEQ(J2).EQ.8) THEN
4058: !             WRITE(2,*)SEQ(J2) , J23994: !             WRITE(2,*)SEQ(J2) , J2
4071:                QMINUS(9*(J2-1)+5-GLY_COUNT*3),QMINUS(9*(J2-1)+6-GLY_COUNT*3)4007:                QMINUS(9*(J2-1)+5-GLY_COUNT*3),QMINUS(9*(J2-1)+6-GLY_COUNT*3)
4072:             WRITE(88,*)QMINUS(9*(J2-1)+7-GLY_COUNT*3), &4008:             WRITE(88,*)QMINUS(9*(J2-1)+7-GLY_COUNT*3), &
4073:                QMINUS(9*(J2-1)+8-GLY_COUNT*3),QMINUS(9*(J2-1)+9-GLY_COUNT*3)4009:                QMINUS(9*(J2-1)+8-GLY_COUNT*3),QMINUS(9*(J2-1)+9-GLY_COUNT*3)
4074:            ENDIF4010:            ENDIF
4075:        ENDDO4011:        ENDDO
4076:      ELSE4012:      ELSE
4077:         IF (GTHOMSONT) THEN4013:         IF (GTHOMSONT) THEN
4078:            CALL GTHOMSONANGTOC(TMPCOORDS, QMINUS, NATOMS)4014:            CALL GTHOMSONANGTOC(TMPCOORDS, QMINUS, NATOMS)
4079:            WRITE(88,'(3F25.15)') (TMPCOORDS(J2), J2=1, 3*NATOMS)4015:            WRITE(88,'(3F25.15)') (TMPCOORDS(J2), J2=1, 3*NATOMS)
4080:         ELSE           4016:         ELSE           
4081:            WRITE(88,'(3F25.15)') (QMINUS(J2),J2=1,NOPT)4017:            WRITE(88,'(3F25.15)') (QMINUS(J2),J2=1,3*NATOMS)
4082:         ENDIF4018:         ENDIF
4083:      ENDIF4019:      ENDIF
4084: 4020: 
4085:      KNOWH = .FALSE. ! needed otherwise the next TS search will use the wrong Hessian, if one is required.4021:      KNOWH = .FALSE. ! needed otherwise the next TS search will use the wrong Hessian, if one is required.
4086:      CALL FLUSH(88)4022:      CALL FLUSH(88)
4087: 4023: 
4088:      END SUBROUTINE MAKEALLPATHINFO4024:      END SUBROUTINE MAKEALLPATHINFO
4089: 4025: 
4090: ! -------------------------------------------------------------------------------------------------------------------4026: ! -------------------------------------------------------------------------------------------------------------------
4091: 4027: 
4118:              ELSE4054:              ELSE
4119:                 IF (NCONGEOM.GE.2) THEN4055:                 IF (NCONGEOM.GE.2) THEN
4120: !4056: !
4121: ! For constraint potential framework with reference geometries4057: ! For constraint potential framework with reference geometries
4122: ! we optimise the permutational isomers on reference minimum 14058: ! we optimise the permutational isomers on reference minimum 1
4123: ! and then do the overall alignment with newmindist, fixing the4059: ! and then do the overall alignment with newmindist, fixing the
4124: ! permutational isomers. This should put the permutational isomers4060: ! permutational isomers. This should put the permutational isomers
4125: ! in register with the constraints, which were calculated for all4061: ! in register with the constraints, which were calculated for all
4126: ! the reference minima after aligning with the first.4062: ! the reference minima after aligning with the first.
4127: !4063: !
4128:                    CALL MINPERMDIST(CONGEOM(1,1:NOPT),MI(I)%DATA%X,NATOMS,DEBUG, &4064:                    CALL MINPERMDIST(CONGEOM(1,1:3*NATOMS),MI(I)%DATA%X,NATOMS,DEBUG, &
4129:   &                       PARAM1,PARAM2,PARAM3,BULKT,TWOD,D,DIST2,RIGIDBODY,RMAT)4065:   &                       PARAM1,PARAM2,PARAM3,BULKT,TWOD,D,DIST2,RIGIDBODY,RMAT)
4130:                    CALL MINPERMDIST(CONGEOM(1,1:NOPT),MI(J)%DATA%X,NATOMS,DEBUG, &4066:                    CALL MINPERMDIST(CONGEOM(1,1:3*NATOMS),MI(J)%DATA%X,NATOMS,DEBUG, &
4131:   &                       PARAM1,PARAM2,PARAM3,BULKT,TWOD,D,DIST2,RIGIDBODY,RMAT)4067:   &                       PARAM1,PARAM2,PARAM3,BULKT,TWOD,D,DIST2,RIGIDBODY,RMAT)
4132:                    CALL NEWMINDIST(MI(I)%DATA%X,MI(J)%DATA%X,NATOMS,D, &4068:                    CALL NEWMINDIST(MI(I)%DATA%X,MI(J)%DATA%X,NATOMS,D, &
4133:   &                       BULKT,TWOD,'AX   ',.FALSE.,RIGIDBODY,DEBUG,RMAT)4069:   &                       BULKT,TWOD,'AX   ',.FALSE.,RIGIDBODY,DEBUG,RMAT)
4134:                 ELSE IF (PERMDIST) THEN4070:                 ELSE IF (PERMDIST) THEN
4135:                    CALL MINPERMDIST(MI(I)%DATA%X,MI(J)%DATA%X,NATOMS, &4071:                    CALL MINPERMDIST(MI(I)%DATA%X,MI(J)%DATA%X,NATOMS, &
4136:   &                              DEBUG,PARAM1,PARAM2,PARAM3,BULKT,TWOD,D,DIST2,RIGIDBODY,RMAT)4072:   &                              DEBUG,PARAM1,PARAM2,PARAM3,BULKT,TWOD,D,DIST2,RIGIDBODY,RMAT)
4137:                 ENDIF4073:                 ENDIF
4138:              ENDIF4074:              ENDIF
4139:              IF (D < GEOMDIFFTOL .AND. PERMDIST) THEN4075:              IF (D < GEOMDIFFTOL .AND. PERMDIST) THEN
4140:                   WRITE(*,'(3(A,G20.10))') ' checkpair> Distance ',D,' is less than tolerance ',GEOMDIFFTOL, &4076:                   WRITE(*,'(3(A,G20.10))') ' checkpair> Distance ',D,' is less than tolerance ',GEOMDIFFTOL, &
4155:              ELSE4091:              ELSE
4156:                 IF (NCONGEOM.GE.2) THEN4092:                 IF (NCONGEOM.GE.2) THEN
4157: !  4093: !  
4158: ! For constraint potential framework with reference geometries4094: ! For constraint potential framework with reference geometries
4159: ! we optimise the permutational isomers on reference minimum 14095: ! we optimise the permutational isomers on reference minimum 1
4160: ! and then do the overall alignment with newmindist, fixing the4096: ! and then do the overall alignment with newmindist, fixing the
4161: ! permutational isomers. This should put the permutational isomers4097: ! permutational isomers. This should put the permutational isomers
4162: ! in register with the constraints, which were calculated for all4098: ! in register with the constraints, which were calculated for all
4163: ! the reference minima after aligning with the first.4099: ! the reference minima after aligning with the first.
4164: !  4100: !  
4165:                    CALL MINPERMDIST(CONGEOM(1,1:NOPT),MI(I)%DATA%X,NATOMS,DEBUG, &4101:                    CALL MINPERMDIST(CONGEOM(1,1:3*NATOMS),MI(I)%DATA%X,NATOMS,DEBUG, &
4166:   &                       PARAM1,PARAM2,PARAM3,BULKT,TWOD,D,DIST2,RIGIDBODY,RMAT)4102:   &                       PARAM1,PARAM2,PARAM3,BULKT,TWOD,D,DIST2,RIGIDBODY,RMAT)
4167:                    CALL MINPERMDIST(CONGEOM(1,1:NOPT),MI(J)%DATA%X,NATOMS,DEBUG, &4103:                    CALL MINPERMDIST(CONGEOM(1,1:3*NATOMS),MI(J)%DATA%X,NATOMS,DEBUG, &
4168:   &                       PARAM1,PARAM2,PARAM3,BULKT,TWOD,D,DIST2,RIGIDBODY,RMAT)4104:   &                       PARAM1,PARAM2,PARAM3,BULKT,TWOD,D,DIST2,RIGIDBODY,RMAT)
4169:                    CALL NEWMINDIST(MI(I)%DATA%X,MI(J)%DATA%X,NATOMS,DISTANCE, &4105:                    CALL NEWMINDIST(MI(I)%DATA%X,MI(J)%DATA%X,NATOMS,DISTANCE, &
4170:   &                       BULKT,TWOD,'AX   ',.FALSE.,RIGIDBODY,DEBUG,RMAT)4106:   &                       BULKT,TWOD,'AX   ',.FALSE.,RIGIDBODY,DEBUG,RMAT)
4171:                 ELSE4107:                 ELSE
4172:                    CALL MINPERMDIST(MI(I)%DATA%X,MI(J)%DATA%X,NATOMS, &4108:                    CALL MINPERMDIST(MI(I)%DATA%X,MI(J)%DATA%X,NATOMS, &
4173:   &                              DEBUG,PARAM1,PARAM2,PARAM3,BULKT,TWOD,D,DIST2,RIGIDBODY,RMAT)4109:   &                              DEBUG,PARAM1,PARAM2,PARAM3,BULKT,TWOD,D,DIST2,RIGIDBODY,RMAT)
4174:                 ENDIF4110:                 ENDIF
4175:              ENDIF4111:              ENDIF
4176:           ENDIF4112:           ENDIF
4177: 4113: 


r29791/newconnect.f90 2016-01-21 22:30:04.787272583 +0000 r29790/newconnect.f90 2016-01-21 22:30:09.371333952 +0000
 14: ! 14: !
 15: !   You should have received a copy of the GNU General Public License 15: !   You should have received a copy of the GNU General Public License
 16: !   along with this program; if not, write to the Free Software 16: !   along with this program; if not, write to the Free Software
 17: !   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA 17: !   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 18: ! 18: !
 19: MODULE NEWCONNECTMODULE 19: MODULE NEWCONNECTMODULE
 20:      IMPLICIT NONE 20:      IMPLICIT NONE
 21:      CONTAINS 21:      CONTAINS
 22:  22: 
 23: !    CALL       NEWCONNECT(NATOMS,EINITIAL,Q,EFINAL,FIN,DIST,.TRUE.,REDOPATH,REDOPATHXYZ) 23: !    CALL       NEWCONNECT(NATOMS,EINITIAL,Q,EFINAL,FIN,DIST,.TRUE.,REDOPATH,REDOPATHXYZ)
 24:      SUBROUTINE NEWCONNECT(NA,EII,QQ,EFF,FINFIN,ENDPOINTSEP,PTEST,REDOPATH,REDOPATHXYZ,LNOPT) 24:      SUBROUTINE NEWCONNECT(NA,EII,QQ,EFF,FINFIN,ENDPOINTSEP,PTEST,REDOPATH,REDOPATHXYZ)
 25:  25: 
 26:           USE CONNECTDATA 26:           USE CONNECTDATA
 27:           USE KEYCONNECT 27:           USE KEYCONNECT
 28:           USE CONNECTUTILS 28:           USE CONNECTUTILS
 29:           USE MODCHARMM 29:           USE MODCHARMM
 30:           USE DECIDEWHATTOCONNECT 30:           USE DECIDEWHATTOCONNECT
 31:           USE TRYCONNECTMODULE 31:           USE TRYCONNECTMODULE
 32:           USE IDOMODULE 32:           USE IDOMODULE
 33:           USE PORFUNCS 33:           USE PORFUNCS
 34:           USE AMHGLOBALS, ONLY : NMRES 34:           USE AMHGLOBALS, ONLY : NMRES
 35:           USE KEY,ONLY : BHDISTTHRESH, BHINTERPT, BHDEBUG, DIJKSTRALOCAL, DUMPDATAT, REOPTIMISEENDPOINTS, & 35:           USE KEY,ONLY : BHDISTTHRESH, BHINTERPT, BHDEBUG, DIJKSTRALOCAL, DUMPDATAT, REOPTIMISEENDPOINTS, &
 36:   &                      AMHT, SEQ, MIN1REDO, MIN2REDO, REDOE1, REDOE2, BULKT, TWOD, PERMDIST, RIGIDBODY, & 36:   &                      AMHT, SEQ, MIN1REDO, MIN2REDO, REDOE1, REDOE2, BULKT, TWOD, PERMDIST, RIGIDBODY, &
 37:   &                      INTCONSTRAINTT, INTLJT, INTTST, INTNTRIESMAX 37:   &                      INTCONSTRAINTT, INTLJT, INTTST, INTNTRIESMAX
 38:           USE COMMONS,ONLY : PARAM1, PARAM2, PARAM3, ZSYM 38:           USE COMMONS,ONLY : PARAM1, PARAM2, PARAM3, ZSYM
 39:           USE MODNEB,ONLY :  NEWCONNECTT 39:           USE MODNEB,ONLY :  NEWCONNECTT
 40:           USE GENRIGID 40:           USE GENRIGID
 41:           IMPLICIT NONE 41:           IMPLICIT NONE
 42:  42: 
 43:           INTEGER LNOPT 
 44:           INTEGER,INTENT(IN)              :: NA 43:           INTEGER,INTENT(IN)              :: NA
 45:           DOUBLE PRECISION           :: ENDPOINTSEP,EII,EFF 44:           DOUBLE PRECISION           :: ENDPOINTSEP,EII,EFF,QQ(3*NA),FINFIN(3*NA)
 46:           DOUBLE PRECISION           QQ(LNOPT),FINFIN(LNOPT) 
 47:           LOGICAL,INTENT(IN)              :: PTEST 45:           LOGICAL,INTENT(IN)              :: PTEST
 48:           DOUBLE PRECISION,POINTER              :: EI,EF 46:           DOUBLE PRECISION,POINTER              :: EI,EF
 49:           DOUBLE PRECISION,POINTER,DIMENSION(:) :: Q,FIN 47:           DOUBLE PRECISION,POINTER,DIMENSION(:) :: Q,FIN
 50:  48: 
 51:           INTEGER :: JS,JF,J1,J2,NSTART,POSITION,J3,NCOUNT 49:           INTEGER :: JS,JF,J1,J2,NSTART,POSITION,J3,NCOUNT
 52:           CHARACTER(LEN=132) :: STR 50:           CHARACTER(LEN=132) :: STR
 53:           LOGICAL REDOPATH, REDOPATHXYZ, YESNO, SUCCESS, MINNEW, PERMUTE, CHANGED, BIGGERGAP, NOPRINT 51:           LOGICAL REDOPATH, REDOPATHXYZ, YESNO, SUCCESS, MINNEW, PERMUTE, CHANGED, BIGGERGAP, NOPRINT
 54:           DOUBLE PRECISION TSREDO(LNOPT), DSTART, DFINISH 52:           DOUBLE PRECISION TSREDO(3*NA), DSTART, DFINISH
 55:           DOUBLE PRECISION, POINTER :: PINTERPCOORDS(:), PENERGY 53:           DOUBLE PRECISION, POINTER :: PINTERPCOORDS(:), PENERGY
 56:           DOUBLE PRECISION INTERPCOORDS(LNOPT), ENERGY, OLDDISTS, OLDDISTF 54:           DOUBLE PRECISION INTERPCOORDS(3*NA), ENERGY, OLDDISTS, OLDDISTF
 57:           DOUBLE PRECISION CSTART(3*NA), CFINISH(LNOPT), ESTART, EFINISH, RMSINITIAL, RMSFINAL, LGDUMMY(3*NA), ETS, RMSTS 55:           DOUBLE PRECISION CSTART(3*NA), CFINISH(3*NA), ESTART, EFINISH, RMSINITIAL, RMSFINAL, LGDUMMY(3*NA), ETS, RMSTS
 58:           INTEGER, ALLOCATABLE :: TEMPDIJPAIR(:,:) 56:           INTEGER, ALLOCATABLE :: TEMPDIJPAIR(:,:)
 59:           DOUBLE PRECISION, ALLOCATABLE :: TEMPDIJPAIRDIST(:) 57:           DOUBLE PRECISION, ALLOCATABLE :: TEMPDIJPAIRDIST(:)
 60:           INTEGER INVERT, INDEX(NA), IMATCH, NMINSAVE, NMINSAVE2, ISTAT, MYJS, MYJF 58:           INTEGER INVERT, INDEX(NA), IMATCH, NMINSAVE, NMINSAVE2, ISTAT, MYJS, MYJF
 61:           CHARACTER(LEN=80) FNAMEF 59:           CHARACTER(LEN=80) FNAMEF
 62:           CHARACTER(LEN=20) EFNAME 60:           CHARACTER(LEN=20) EFNAME
 63:           DOUBLE PRECISION BHENERGY 61:           DOUBLE PRECISION BHENERGY
 64:           COMMON /BHINTE/ BHENERGY 62:           COMMON /BHINTE/ BHENERGY
 65:           DOUBLE PRECISION DIST2, RMAT(3,3) 63:           DOUBLE PRECISION DIST2, RMAT(3,3)
 66:  64: 
 67:           FINISHED=.FALSE. 65:           FINISHED=.FALSE.
 68:           ALLOCATE(EI,EF,Q(LNOPT),FIN(LNOPT)) 66:           ALLOCATE(EI,EF,Q(3*NA),FIN(3*NA))
 69:           EI=EII;EF=EFF;Q=QQ;FIN=FINFIN; 67:           EI=EII;EF=EFF;Q=QQ;FIN=FINFIN;
 70:  68: 
 71:           MOREPRINTING=PTEST 69:           MOREPRINTING=PTEST
 72:           IF (MOREPRINTING) THEN 70:           IF (MOREPRINTING) THEN
 73:                CALL ALLKEYCONNECTPRINT 71:                CALL ALLKEYCONNECTPRINT
 74:                PRINT* 72:                PRINT*
 75:           ENDIF 73:           ENDIF
 76:           INQUIRE(FILE='redopoints',EXIST=YESNO) 74:           INQUIRE(FILE='redopoints',EXIST=YESNO)
 77:           IF (YESNO) THEN 75:           IF (YESNO) THEN
 78:              IF (REDOPATH.AND.(.NOT.REDOPATHXYZ)) THEN 76:              IF (REDOPATH.AND.(.NOT.REDOPATHXYZ)) THEN


r29791/newneb.f90 2016-01-21 22:30:05.871287096 +0000 r29790/newneb.f90 2016-01-21 22:30:10.479348786 +0000
 13: !   GNU General Public License for more details. 13: !   GNU General Public License for more details.
 14: ! 14: !
 15: !   You should have received a copy of the GNU General Public License 15: !   You should have received a copy of the GNU General Public License
 16: !   along with this program; if not, write to the Free Software 16: !   along with this program; if not, write to the Free Software
 17: !   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA 17: !   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 18: ! 18: !
 19: MODULE NEWNEBMODULE 19: MODULE NEWNEBMODULE
 20:      IMPLICIT NONE 20:      IMPLICIT NONE
 21:      CONTAINS 21:      CONTAINS
 22:  22: 
 23:      SUBROUTINE NEWNEB(REDOPATH,TSREDO,EINITIAL,QQ,EFINAL,FINFIN,TSRESET) 23:      SUBROUTINE NEWNEB(REDOPATH,TSREDO,EINITIAL,QQ,EFINAL,FINFIN,TSRESET,MOREP,NATOMSIN,NOPTIN,NINTSIN)
 24:           USE PORFUNCS 24:           USE PORFUNCS
 25:           USE NEBDATA 25:           USE NEBDATA
 26:           USE KEYNEB 26:           USE KEYNEB
 27:           USE MINIMISER1 27:           USE MINIMISER1
 28:           USE MINIMISER2 28:           USE MINIMISER2
 29:           USE MINIMISER3 29:           USE MINIMISER3
 30:           USE NEBOUTPUT 30:           USE NEBOUTPUT
 31:           USE NEBUTILS 31:           USE NEBUTILS
 32:           USE KEY, ONLY : UNRST, GROWSTRINGT, FREEZENODEST, DESMDEBUG, & 32:           USE KEY, ONLY : UNRST, GROWSTRINGT, FREEZENODEST, DESMDEBUG, &
 33:                & NEBMUPDATE, MUPDATE, BFGSSTEPS, NEBRESEEDT, & 33:                & NEBMUPDATE, MUPDATE, BFGSSTEPS, NEBRESEEDT, &
 34:                & INTCONMAX, ORDERI, ORDERJ, EPSALPHA, REDOBFGSSTEPS, &  34:                & INTCONMAX, ORDERI, ORDERJ, EPSALPHA, REDOBFGSSTEPS, & 
 35:                & NREPMAX, DISTREF, NEBKINITIAL, ADDREPT, REPPOW, REDOTSIM, MIN1REDO, MIN2REDO, PUSHOFF, & 35:                & NREPMAX, DISTREF, NEBKINITIAL, ADDREPT, REPPOW, REDOTSIM, MIN1REDO, MIN2REDO, PUSHOFF, &
 36:                & CONI, CONJ, AMHT, NUMGLY, REPI, REPJ, BULKT, D1INIT, D2INIT, & 36:                & CONI, CONJ, AMHT, NUMGLY, REPI, REPJ, BULKT, D1INIT, D2INIT, &
 37:                & REDOKADD, REDOPATH1, INTCONSTRAINTT, INTNEBIMAGES, & 37:                & REDOKADD, REDOPATH1, INTCONSTRAINTT, INTNEBIMAGES, &
 38:                & REDOPATH2, NREPI, NREPJ, REPCUT, NREPCUT, TWOD, RIGIDBODY, PERMDIST, WHOLEDNEB, & 38:                & REDOPATH2, NREPI, NREPJ, REPCUT, NREPCUT, TWOD, RIGIDBODY, PERMDIST, WHOLEDNEB, &
 39:                & CPPNEBT, VARIABLES 39:                & CPPNEBT
 40:           USE GROWSTRINGUTILS, ONLY: GROWSTRING, TOTSTEPS 40:           USE GROWSTRINGUTILS, ONLY: GROWSTRING, TOTSTEPS
 41:           USE GSDATA, ONLY : KEYGSPRINT 41:           USE GSDATA, ONLY : KEYGSPRINT
 42:           USE MODGUESS,ONLY: GUESSPATHT,NINTERP 42:           USE MODGUESS,ONLY: GUESSPATHT,NINTERP
 43:           USE MODMEC,ONLY: MECCANOT           43:           USE MODMEC,ONLY: MECCANOT          
 44:           USE INTCOMMONS, ONLY : DESMINT, INTINTERPT, NINTIM, NDIH, DIHINFO, ALIGNDIR, PREVDIH, NINTC 44:           USE INTCOMMONS, ONLY : DESMINT, INTINTERPT, NINTIM, NDIH, DIHINFO, ALIGNDIR, PREVDIH, NINTC
 45:           USE INTCUTILS, ONLY : INTINTERPOLATE, CART2INT 45:           USE INTCUTILS, ONLY : INTINTERPOLATE, CART2INT
 46:           USE SPFUNCTS, ONLY : DUMPCOORDS 46:           USE SPFUNCTS, ONLY : DUMPCOORDS
 47:           USE NEBTOCONNECT 47:           USE NEBTOCONNECT
 48:           USE AMHGLOBALS, ONLY : NMRES 48:           USE AMHGLOBALS, ONLY : NMRES
 49:           USE COMMONS,ONLY: PARAM1,PARAM2,PARAM3,REDOPATHNEB,ZSYM,DEBUG 49:           USE COMMONS,ONLY: PARAM1,PARAM2,PARAM3,REDOPATHNEB,ZSYM,DEBUG
 50: ! hk286 50: ! hk286
 51:           USE GENRIGID 51:           USE GENRIGID
 52:  52: 
 53:           IMPLICIT NONE 53:           IMPLICIT NONE
 54:  54: 
 55:           COMMON /OLDC/ EMAX 55:           COMMON /OLDC/ EMAX
 56:  56: 
 57:           DOUBLE PRECISION,INTENT(IN)           :: EINITIAL, EFINAL 57:           DOUBLE PRECISION,INTENT(IN)           :: EINITIAL, EFINAL
 58:           DOUBLE PRECISION,DIMENSION(:)         :: QQ,FINFIN 58:           DOUBLE PRECISION,DIMENSION(:)         :: QQ,FINFIN
  59:           LOGICAL,INTENT(IN),OPTIONAL  :: MOREP
  60:           INTEGER,INTENT(IN),OPTIONAL  :: NATOMSIN,NOPTIN,NINTSIN
 59:  61: 
 60:           INTEGER :: J1,JMAX, NPERSIST, ITDONE, K, I, J2, J5, NDONE 62:           INTEGER :: J1,JMAX, NPERSIST, ITDONE, K, I, J2, J5, NDONE
 61:           DOUBLE PRECISION :: EMAX, XDUMMY, TOTALDIST, LDTOTAL, DINCREMENT, LDIST 63:           DOUBLE PRECISION :: EMAX, XDUMMY, TOTALDIST, LDTOTAL, DINCREMENT, LDIST
 62:  64: 
 63:           DOUBLE PRECISION,ALLOCATABLE,DIMENSION(:) :: MYPTS ! JMC 65:           DOUBLE PRECISION,ALLOCATABLE,DIMENSION(:) :: MYPTS ! JMC
 64:           DOUBLE PRECISION,ALLOCATABLE,DIMENSION(:) :: VNEW, LCOORDS ! JMC 66:           DOUBLE PRECISION,ALLOCATABLE,DIMENSION(:) :: VNEW, LCOORDS ! JMC
 65:           LOGICAL PERSISTENT(NIMAGE+2), PERMDISTSAVE 67:           LOGICAL PERSISTENT(NIMAGE+2), PERMDISTSAVE
 66:           LOGICAL REDOPATH, MFLAG, PTEST, LPTEST, LRESET, TSRESET 68:           LOGICAL REDOPATH, MFLAG, PTEST, LPTEST, LRESET, TSRESET
 67:           DOUBLE PRECISION ENERGY, RMS2, EREAL, TSREDO(*), RMAT(3,3), D, DIST2 69:           DOUBLE PRECISION ENERGY, RMS2, EREAL, TSREDO(*), RMAT(3,3), D, DIST2
 68:  70: 
 79:  81: 
 80:           IF (DESMDEBUG) THEN 82:           IF (DESMDEBUG) THEN
 81:           ! output coordinates of endpoints we're trying to connect           83:           ! output coordinates of endpoints we're trying to connect          
 82:              CALL DUMPCOORDS(QQ,'tryconnect.A.xyz', .FALSE.) 84:              CALL DUMPCOORDS(QQ,'tryconnect.A.xyz', .FALSE.)
 83:              CALL DUMPCOORDS(FINFIN,'tryconnect.B.xyz', .FALSE.) 85:              CALL DUMPCOORDS(FINFIN,'tryconnect.B.xyz', .FALSE.)
 84:           ENDIF 86:           ENDIF
 85:            87:           
 86:           CALL MYCPU_TIME(STARTTIME,.TRUE.) 88:           CALL MYCPU_TIME(STARTTIME,.TRUE.)
 87:           ! setup parameters 89:           ! setup parameters
 88:           ! Natoms,Nopt,Nints,Nimage 90:           ! Natoms,Nopt,Nints,Nimage
 89: !         IF (PRESENT(NATOMSIN)) THEN 91:           IF (PRESENT(NATOMSIN)) THEN
 90: !              NATOMS=NATOMSIN 92:                NATOMS=NATOMSIN
 91: !         ELSE 93:           ELSE
 92:                NATOMS=SIZE(QQ)/3 94:                NATOMS=SIZE(QQ)/3
 93: !         ENDIF 95:           ENDIF
 94:           IF (VARIABLES) NATOMS=SIZE(QQ) 
 95:           IF (NATOMS<=0) THEN 96:           IF (NATOMS<=0) THEN
 96:                PRINT '(1x,a)', 'Number of atoms is less or equal to zero. Stop.' 97:                PRINT '(1x,a)', 'Number of atoms is less or equal to zero. Stop.'
 97:                CALL TSUMMARY 98:                CALL TSUMMARY
 98:                STOP 99:                STOP
 99:           ELSE IF (DEBUG) THEN100:           ELSE IF (DEBUG) THEN
100:                PRINT *, 'newneb> Number of atoms or variables = ',NATOMS101:                PRINT *, 'newneb> Number of atoms = ',Natoms
101:           ENDIF102:           ENDIF
102:           ALLOCATE(ORDERI(NREPMAX),ORDERJ(NREPMAX),EPSALPHA(NREPMAX),DISTREF(NREPMAX),REPPOW(NREPMAX))103:           ALLOCATE(ORDERI(NREPMAX),ORDERJ(NREPMAX),EPSALPHA(NREPMAX),DISTREF(NREPMAX),REPPOW(NREPMAX))
103:           ALLOCATE(BADIMAGE(NIMAGE+2),BADPEPTIDE(NIMAGE+2))104:           ALLOCATE(BADIMAGE(NIMAGE+2),BADPEPTIDE(NIMAGE+2))
104:           ADDREPT=.FALSE.105:           ADDREPT=.FALSE.
105: !         IF (PRESENT(NOPTIN)) THEN106:           IF (PRESENT(NOPTIN)) THEN
106: !              NOPT=NOPTIN107:                NOPT=NOPTIN
107: !         ELSE108:           ELSE
108:              IF (DESMINT) THEN109:              IF (DESMINT) THEN
109:                 NOPT = NINTC110:                 NOPT = NINTC
110:              ELSE IF (AMHT) THEN111:              ELSE IF (AMHT) THEN
111:                 NOPT = 3*(NMRES*3)-NUMGLY*3 112:                 NOPT = 3*(NMRES*3)-NUMGLY*3 
112:              ELSE113:              ELSE
113:                 NOPT=3*NATOMS114:                 NOPT=3*NATOMS
114:              ENDIF115:              ENDIF
115: !         ENDIF116:           ENDIF
116:           IF (VARIABLES) NOPT=NATOMS117:           IF (PRESENT(NINTSIN)) THEN
117: !         IF (PRESENT(NINTSIN)) THEN118:                NINTS=NINTSIN
118: !              NINTS=NINTSIN119:           ENDIF
119: !         ENDIF 
120:           IF (NIMAGE<=0) THEN120:           IF (NIMAGE<=0) THEN
121:                PRINT '(1x,a)', 'Number of images is less or equal to zero. Stop.'121:                PRINT '(1x,a)', 'Number of images is less or equal to zero. Stop.'
122:                CALL TSUMMARY122:                CALL TSUMMARY
123:                STOP123:                STOP
124:           ENDIF124:           ENDIF
125:           ! printing125:           ! printing
126:           MOREPRINTING=.FALSE.126:           IF (PRESENT(MOREP)) THEN
 127:                MOREPRINTING=MOREP
 128:           ENDIF
127:           IF (DEBUG.OR.DESMDEBUG) MOREPRINTING=.TRUE.129:           IF (DEBUG.OR.DESMDEBUG) MOREPRINTING=.TRUE.
128:           IF (MOREPRINTING) THEN130:           IF (MOREPRINTING) THEN
129:              IF (GROWSTRINGT) THEN131:              IF (GROWSTRINGT) THEN
130:                 CALL KEYGSPRINT(.FALSE.)132:                 CALL KEYGSPRINT(.FALSE.)
131:              ELSE133:              ELSE
132:                 CALL ALLKEYNEBPRINT134:                 CALL ALLKEYNEBPRINT
133:              ENDIF135:              ENDIF
134:              PRINT*136:              PRINT*
135:           ENDIF137:           ENDIF
136: 138: 
195:              ! and each endpoint.197:              ! and each endpoint.
196:              ! Fill in the first DEGFREEDOMS coordinates of each image with the198:              ! Fill in the first DEGFREEDOMS coordinates of each image with the
197:              ! rigid-body coordinates, then the remainder with 0's (they get ignored199:              ! rigid-body coordinates, then the remainder with 0's (they get ignored
198:              ! by calls to the potential anyway)200:              ! by calls to the potential anyway)
199:                 CALL TRANSFORMCTORIGID(QQ,RIGIDQ)201:                 CALL TRANSFORMCTORIGID(QQ,RIGIDQ)
200:                 CALL TRANSFORMCTORIGID(FINFIN,RIGIDFIN)202:                 CALL TRANSFORMCTORIGID(FINFIN,RIGIDFIN)
201:                 XYZ(:DEGFREEDOMS) = RIGIDQ(:)203:                 XYZ(:DEGFREEDOMS) = RIGIDQ(:)
202:                 XYZ(NOPT*(NIMAGE+1)+1:NOPT*(NIMAGE+1)+DEGFREEDOMS) = RIGIDFIN(:)204:                 XYZ(NOPT*(NIMAGE+1)+1:NOPT*(NIMAGE+1)+DEGFREEDOMS) = RIGIDFIN(:)
203:                 ATOMRIGIDCOORDT = .FALSE.205:                 ATOMRIGIDCOORDT = .FALSE.
204:              ELSE206:              ELSE
205:                 XYZ(1:NOPT)=QQ(1:NOPT)207:                 XYZ(:NOPT)=QQ
206:                 XYZ(NOPT*(NIMAGE+1)+1:NOPT*(NIMAGE+2))=FINFIN(1:NOPT)208:                 XYZ(NOPT*(NIMAGE+1)+1:)=FINFIN
207:              ENDIF209:              ENDIF
208:           ENDIF210:           ENDIF
209:           TANPTR => TANVEC211:           TANPTR => TANVEC
210:           IF (FREEZENODEST.OR.NEBRESEEDT) THEN212:           IF (FREEZENODEST.OR.NEBRESEEDT) THEN
211:              ALLOCATE(IMGFREEZE(NIMAGE))213:              ALLOCATE(IMGFREEZE(NIMAGE))
212:              IMGFREEZE(:) = .FALSE.214:              IMGFREEZE(:) = .FALSE.
213:           ENDIF215:           ENDIF
214: 216: 
215:           IF(GROWSTRINGT) THEN217:           IF(GROWSTRINGT) THEN
216:              IF((DESMINT.AND.NOPT.NE.NINTC).OR.(.NOT.DESMINT.AND.NOPT.NE.3*NATOMS)) THEN218:              IF((DESMINT.AND.NOPT.NE.NINTC).OR.(.NOT.DESMINT.AND.NOPT.NE.3*NATOMS)) THEN
508: ! hk286510: ! hk286
509:           IF (RIGIDINIT) THEN511:           IF (RIGIDINIT) THEN
510:           ! sn402: We want to stay in RB coordinates for the moment. But for some reason we set ATOMRIGIDCOORDT512:           ! sn402: We want to stay in RB coordinates for the moment. But for some reason we set ATOMRIGIDCOORDT
511:           ! to .TRUE. even though it isn't. I will investigate why we do this.513:           ! to .TRUE. even though it isn't. I will investigate why we do this.
512: !                CALL GENRIGID_IMAGE_RIGIDTOC(NIMAGE, XYZ)   ! hk286 commented this line.514: !                CALL GENRIGID_IMAGE_RIGIDTOC(NIMAGE, XYZ)   ! hk286 commented this line.
513:              ATOMRIGIDCOORDT = .TRUE.515:              ATOMRIGIDCOORDT = .TRUE.
514:           ENDIF516:           ENDIF
515: ! hk286517: ! hk286
516: 518: 
517:           NULLIFY(X,EIMAGE)519:           NULLIFY(X,EIMAGE)
518: !         IF (ALLOCATED(DVEC)) DEALLOCATE(DVEC)520:           DEALLOCATE(DVEC,NEWNEBK,XYZ,EEE,GGG,TRUEGRAD,SSS,RRR,DEVIATION,TANVEC,STEPIMAGE,ORDERI,ORDERJ,EPSALPHA,DISTREF,REPPOW)
519:           IF (ALLOCATED(NEWNEBK)) DEALLOCATE(NEWNEBK) 
520: !         IF (ALLOCATED(XYZ)) DEALLOCATE(XYZ) 
521: !         IF (ALLOCATED(EEE)) DEALLOCATE(EEE) 
522: !         IF (ALLOCATED(GGG)) DEALLOCATE(GGG) 
523:           IF (ALLOCATED(TRUEGRAD)) DEALLOCATE(TRUEGRAD) 
524: !         IF (ALLOCATED(SSS)) DEALLOCATE(SSS) 
525: !         IF (ALLOCATED(RRR)) DEALLOCATE(RRR) 
526: !         IF (ALLOCATED(DEVIATION)) DEALLOCATE(DEVIATION) 
527: !         IF (ALLOCATED(TANVEC)) DEALLOCATE(TANVEC) 
528: !         IF (ALLOCATED(STEPIMAGE)) DEALLOCATE(STEPIMAGE) 
529:           IF (ALLOCATED(ORDERI)) DEALLOCATE(ORDERI) 
530:           IF (ALLOCATED(ORDERJ)) DEALLOCATE(ORDERJ) 
531:           IF (ALLOCATED(EPSALPHA)) DEALLOCATE(EPSALPHA) 
532:           IF (ALLOCATED(DISTREF)) DEALLOCATE(DISTREF) 
533:           IF (ALLOCATED(REPPOW)) DEALLOCATE(REPPOW) 
534: !         DEALLOCATE(DVEC,NEWNEBK,XYZ,EEE,GGG,TRUEGRAD,SSS,RRR,DEVIATION,TANVEC,STEPIMAGE,ORDERI,ORDERJ,EPSALPHA,DISTREF,REPPOW) 
535:           DEALLOCATE(BADIMAGE,BADPEPTIDE)521:           DEALLOCATE(BADIMAGE,BADPEPTIDE)
536:           IF (FREEZENODEST) DEALLOCATE(IMGFREEZE)522:           IF (FREEZENODEST) DEALLOCATE(IMGFREEZE)
537:           IF (DESMINT) THEN523:           IF (DESMINT) THEN
538:              NULLIFY(XCART, GCART)524:              NULLIFY(XCART, GCART)
539:              DEALLOCATE(XYZCART,GGGCART,DIHINFO)525:              DEALLOCATE(XYZCART,GGGCART,DIHINFO)
540:           ENDIF526:           ENDIF
541: 527: 
542:      END SUBROUTINE NEWNEB528:      END SUBROUTINE NEWNEB
543: END MODULE NEWNEBMODULE529: END MODULE NEWNEBMODULE


r29791/nnutils.f90 2016-01-21 22:30:06.071289781 +0000 r29790/nnutils.f90 2016-01-21 22:30:10.703351785 +0000
1070: 1070: 
1071: !         IF (.NOT.PRESENT(UNITIN)) THEN1071: !         IF (.NOT.PRESENT(UNITIN)) THEN
1072:                CLOSE(UNIT)1072:                CLOSE(UNIT)
1073: !         ENDIF1073: !         ENDIF
1074:           PRINT *, 'writeprofile> NEB profile was saved to file "'//trim(filename)//'"'1074:           PRINT *, 'writeprofile> NEB profile was saved to file "'//trim(filename)//'"'
1075:      END SUBROUTINE WRITEPROFILE1075:      END SUBROUTINE WRITEPROFILE
1076: 1076: 
1077:      SUBROUTINE RWG(WHAT,GUESS,NITER)1077:      SUBROUTINE RWG(WHAT,GUESS,NITER)
1078:           USE PORFUNCS1078:           USE PORFUNCS
1079:           USE KEY,ONLY: FILTH,FILTHSTR,UNRST,STOCKT,AMHT,SEQ,NUMGLY,STOCKAAT, RBAAT,NTSITES, GTHOMSONT, NGTHORI, PERMGUESS, &1079:           USE KEY,ONLY: FILTH,FILTHSTR,UNRST,STOCKT,AMHT,SEQ,NUMGLY,STOCKAAT, RBAAT,NTSITES, GTHOMSONT, NGTHORI, PERMGUESS, &
1080:   &                     BULKT, NRBTRIES, NABT,TWOD, RIGIDBODY, VARIABLES1080:   &                     BULKT, NRBTRIES, NABT,TWOD, RIGIDBODY
1081:           USE COMMONS, ONLY: ZSYM, NRBSITES, PARAM1,PARAM2,PARAM3, NRBSITES, DEBUG1081:           USE COMMONS, ONLY: ZSYM, NRBSITES, PARAM1,PARAM2,PARAM3, NRBSITES, DEBUG
1082:           USE INTCOMMONS, ONLY : DESMINT1082:           USE INTCOMMONS, ONLY : DESMINT
1083:           USE NEBDATA1083:           USE NEBDATA
1084:           USE AMHGLOBALS, ONLY : NMRES1084:           USE AMHGLOBALS, ONLY : NMRES
1085:           USE KEYNEB,ONLY: NIMAGE,XYZFILE,RBXYZFILE,GUESSFILE1085:           USE KEYNEB,ONLY: NIMAGE,XYZFILE,RBXYZFILE,GUESSFILE
1086:           IMPLICIT NONE1086:           IMPLICIT NONE
1087: 1087: 
1088:           CHARACTER,INTENT(IN) :: WHAT1088:           CHARACTER,INTENT(IN) :: WHAT
1089:           LOGICAL,INTENT(IN) :: GUESS1089:           LOGICAL,INTENT(IN) :: GUESS
1090:           INTEGER,INTENT(IN) :: NITER1090:           INTEGER,INTENT(IN) :: NITER
1184: 1184: 
1185:                 ELSE1185:                 ELSE
1186:                   DO J2=1,NIMAGE+21186:                   DO J2=1,NIMAGE+2
1187: ! hk2861187: ! hk286
1188:                      IF (GTHOMSONT) THEN1188:                      IF (GTHOMSONT) THEN
1189:                         CALL GTHOMSONANGTOC(TMPCOORDS,xyz((j2-1)*NOPT+1:j2*NOPT),NGTHORI)                      1189:                         CALL GTHOMSONANGTOC(TMPCOORDS,xyz((j2-1)*NOPT+1:j2*NOPT),NGTHORI)                      
1190:                         WRITE(993,'(i4/)') NGTHORI1190:                         WRITE(993,'(i4/)') NGTHORI
1191:                         WRITE(993,'(a5,1x,3f20.10)') ("C", TMPCOORDS(3*J1-2:3*J1), J1=1,NGTHORI)1191:                         WRITE(993,'(a5,1x,3f20.10)') ("C", TMPCOORDS(3*J1-2:3*J1), J1=1,NGTHORI)
1192:                      ELSE1192:                      ELSE
1193:                         WRITE(993,'(i4/)') natoms1193:                         WRITE(993,'(i4/)') natoms
1194:                         IF (VARIABLES) THEN1194:                         WRITE(993,'(a5,1x,3f20.10)') (ZSYM((j1+2)/3),xyz( (j2-1)*Nopt+j1),&
1195:                            DO J1=1,NOPT 
1196:                               WRITE(993,'(a5,1x,f20.10)') '  ',XYZ(J1) 
1197:                            ENDDO 
1198:                         ELSE 
1199:                            WRITE(993,'(a5,1x,3f20.10)') (ZSYM((j1+2)/3),xyz( (j2-1)*Nopt+j1),& 
1200:                              & XYZ((J2-1)*NOPT+J1+1), XYZ((J2-1)*NOPT+J1+2),J1=1,NOPT,3)1195:                              & XYZ((J2-1)*NOPT+J1+1), XYZ((J2-1)*NOPT+J1+2),J1=1,NOPT,3)
1201:                         ENDIF 
1202:                      ENDIF1196:                      ENDIF
1203:                   ENDDO1197:                   ENDDO
1204:                ENDIF1198:                ENDIF
1205: 1199: 
1206:                PRINT *, 'rwg> NEB coordinates were saved to xyz file "'//trim(filename)//'"'1200:                PRINT *, 'rwg> NEB coordinates were saved to xyz file "'//trim(filename)//'"'
1207: 1201: 
1208:                IF (UNRST) THEN1202:                IF (UNRST) THEN
1209:                   OPEN(UNIT=114,FILE=FILENAME2,STATUS='unknown')1203:                   OPEN(UNIT=114,FILE=FILENAME2,STATUS='unknown')
1210:                   DO J2=1,NIMAGE+21204:                   DO J2=1,NIMAGE+2
1211:                        DO J3=1,(NATOMS/2)-11205:                        DO J3=1,(NATOMS/2)-1


r29791/oldnebgradient.f90 2016-01-21 22:30:06.295292774 +0000 r29790/oldnebgradient.f90 2016-01-21 22:30:10.935354889 +0000
 43: ! TANPTR => TANVEC 43: ! TANPTR => TANVEC
 44: ! EEE = 0.0D0 44: ! EEE = 0.0D0
 45: ! EEE(1)=EINITIAL 45: ! EEE(1)=EINITIAL
 46: ! EEE(NIMAGE+2)=EFINAL 46: ! EEE(NIMAGE+2)=EFINAL
 47: !  47: ! 
 48: ! TRUEPOTEG calculates energy and gradients for images 48: ! TRUEPOTEG calculates energy and gradients for images
 49: ! coordinates are in XYZ(1:NOPT*(NIMAGE+2)) 49: ! coordinates are in XYZ(1:NOPT*(NIMAGE+2))
 50: ! gradient is in GGG(1:NOPT*(NIMAGE+2)) and also saved in TRUEGRAD(1:NOPT*(NIMAGE+2)) 50: ! gradient is in GGG(1:NOPT*(NIMAGE+2)) and also saved in TRUEGRAD(1:NOPT*(NIMAGE+2))
 51: ! image potential energies are in EEE(1:NIMAGE+2) 51: ! image potential energies are in EEE(1:NIMAGE+2)
 52: ! 52: !
 53: CALL TRUEPOTEG 53: CALL TRUEPOTEG(.TRUE.)
 54: ! 54: !
 55: ! MEPTANGENT calculates tangent vector according to Henkelmann and Jonsson, JCP, 113, 9978, 2000 55: ! MEPTANGENT calculates tangent vector according to Henkelmann and Jonsson, JCP, 113, 9978, 2000
 56: ! and stores it in TANVEC(1:NOPT,1:NIMAGE) 56: ! and stores it in TANVEC(1:NOPT,1:NIMAGE)
 57: ! The tangent vector for image J1 is stored in TANVEC(:,J1-1) 57: ! The tangent vector for image J1 is stored in TANVEC(:,J1-1)
 58: ! 58: !
 59: CALL MEPTANGENT         59: CALL MEPTANGENT        
 60:  60: 
 61: ! 61: !
 62: !  Gradient of the potential perpendicular to the tangent vector. 62: !  Gradient of the potential perpendicular to the tangent vector.
 63: ! 63: !


r29791/OPTIM.F 2016-01-21 22:30:06.735298665 +0000 r29790/OPTIM.F 2016-01-21 22:30:11.555363218 +0000
 42: ! hk286 42: ! hk286
 43:       USE GENRIGID 43:       USE GENRIGID
 44:  44: 
 45:       IMPLICIT NONE 45:       IMPLICIT NONE
 46: ! subroutine parameters   46: ! subroutine parameters  
 47:       INTEGER F1,F2 47:       INTEGER F1,F2
 48:       CHARACTER(LEN=80) FLSTRING 48:       CHARACTER(LEN=80) FLSTRING
 49:       CHARACTER(LEN=2) DUMMYS 49:       CHARACTER(LEN=2) DUMMYS
 50:  50: 
 51:       INTEGER J1, J2, NPCALL, ECALL, FCALL, SCALL, HORDER, NATOMSSAVE, SUNIT, FUNIT 51:       INTEGER J1, J2, NPCALL, ECALL, FCALL, SCALL, HORDER, NATOMSSAVE, SUNIT, FUNIT
 52:       DOUBLE PRECISION VNEW(NOPT), ENERGY, EVALMIN, RMS, VECS(NOPT), QSAVE(NOPT), 52:       DOUBLE PRECISION VNEW(3*NATOMS), ENERGY, EVALMIN, RMS, VECS(3*NATOMS), QSAVE(3*NATOMS),
 53:      1  QPLUS(NOPT), LGDUMMY(NOPT),RMSINITIAL,RMSFINAL,E1,E2, RMAT(3,3), 53:      1  QPLUS(3*NATOMS), LGDUMMY(3*NATOMS),RMSINITIAL,RMSFINAL,E1,E2, RMAT(3,3),
 54:      2  DIST, OVEC(3), H1VEC(3), H2VEC(3), Q(NOPT), EINITIAL, EFINAL,  54:      2  DIST, OVEC(3), H1VEC(3), H2VEC(3), Q(3*NATOMS), EINITIAL, EFINAL, 
 55:      3  ETIME, FTIME, STIME, DPRAND, DCOORDS(NOPT), INTFREEZETOLSAVE, 55:      3  ETIME, FTIME, STIME, DPRAND, DCOORDS(3*NATOMS), INTFREEZETOLSAVE,
 56:      4  ETS, EPLUS, EMINUS, SLENGTH, DISP, GAMMA, NTILDE,  56:      4  ETS, EPLUS, EMINUS, SLENGTH, DISP, GAMMA, NTILDE, 
 57:      5  FRQSTS(NOPT), FRQSPLUS(NOPT), FRQSMINUS(NOPT), QMINUS(NOPT), DISTSF 57:      5  FRQSTS(3*NATOMS), FRQSPLUS(3*NATOMS), FRQSMINUS(3*NATOMS), QMINUS(3*NATOMS), DISTSF
 58:       DOUBLE PRECISION THTEMP(NOPT) 58:       DOUBLE PRECISION THTEMP(3*NATOMS)
 59:       CHARACTER ESTRING*87, GPSTRING*80, NSTRING*80, FSTRING*80, FNAME*13, FNAMEV*18,  59:       CHARACTER ESTRING*87, GPSTRING*80, NSTRING*80, FSTRING*80, FNAME*13, FNAMEV*18, 
 60:      1          ITSTRING*22, EOFSSTRING*15 60:      1          ITSTRING*22, EOFSSTRING*15
 61:       CHARACTER(LEN=80) FNAMEF 61:       CHARACTER(LEN=80) FNAMEF
 62:       CHARACTER(LEN=20) EFNAME 62:       CHARACTER(LEN=20) EFNAME
 63:       DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: QW 63:       DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: QW
 64:       LOGICAL LDUMMY, BFGSTSSAVE, MFLAG, POTCALL 64:       LOGICAL LDUMMY, BFGSTSSAVE, MFLAG, POTCALL
 65:       INTEGER FRAME 65:       INTEGER FRAME
 66:       LOGICAL PVFLAG 66:       LOGICAL PVFLAG
 67:       COMMON /PVF/ PVFLAG 67:       COMMON /PVF/ PVFLAG
 68: C     COMMON /VN/ VNEW   !  common SV was also deleted 68: C     COMMON /VN/ VNEW   !  common SV was also deleted
 77:       COMMON /CONN/ STOPFIRST, CONNECTT, NCONNECT, DUMPPATH, READPATH, CALCRATES, TEMPERATURE, HRED 77:       COMMON /CONN/ STOPFIRST, CONNECTT, NCONNECT, DUMPPATH, READPATH, CALCRATES, TEMPERATURE, HRED
 78:       LOGICAL KNOWE, KNOWG, KNOWH 78:       LOGICAL KNOWE, KNOWG, KNOWH
 79:       COMMON /KNOWN/ KNOWE, KNOWG, KNOWH 79:       COMMON /KNOWN/ KNOWE, KNOWG, KNOWH
 80:       CHARACTER(LEN=5) ZSYMSAVE 80:       CHARACTER(LEN=5) ZSYMSAVE
 81:       CHARACTER(LEN=20) PINFOSTRING 81:       CHARACTER(LEN=20) PINFOSTRING
 82:       COMMON /SYS/ ZSYMSAVE 82:       COMMON /SYS/ ZSYMSAVE
 83:       LOGICAL PATHFAILT ! JMC 83:       LOGICAL PATHFAILT ! JMC
 84: ! hk286 84: ! hk286
 85:       DOUBLE PRECISION :: XRIGIDCOORDS(3*NATOMS), XRIGIDGRAD(3*NATOMS) 85:       DOUBLE PRECISION :: XRIGIDCOORDS(3*NATOMS), XRIGIDGRAD(3*NATOMS)
 86:       INTEGER GETUNIT 86:       INTEGER GETUNIT
  87: !msb50 for test
  88: !     DOUBLE PRECISION X(3*NATOMS*60)
 87:       COMMON /OEPATH/ ETS,EPLUS,EMINUS 89:       COMMON /OEPATH/ ETS,EPLUS,EMINUS
 88: ! Print OPTIM version in the output 90: ! Print OPTIM version in the output
 89:       !VERSIONTEMP=25661 91:       !VERSIONTEMP=25661
 90:       !WRITE(*, '(A,I5)') ' OPTIM> version r',VERSIONTEMP 92:       !WRITE(*, '(A,I5)') ' OPTIM> version r',VERSIONTEMP
 91: C 93: C
 92: C  Dynamic memory allocation 94: C  Dynamic memory allocation
 93: C 95: C
 94:       ALLOCATE (FROZEN(NATOMS),ZSYM(NATOMS),NR(NATOMS)) 96: 
  97:       ALLOCATE (FROZEN(NATOMS),ZSYM(NATOMS),NR(NATOMS),STPMAX(3*NATOMS))
 95:       IF (DEBUG) PRINT *,' OPTIM> allocated ZSYM with dimension NATOMS=',NATOMS 98:       IF (DEBUG) PRINT *,' OPTIM> allocated ZSYM with dimension NATOMS=',NATOMS
 96:       ALLOCATE (FROZENRES(NATOMS)) 99:       ALLOCATE (FROZENRES(NATOMS))
 97: C      STPMAX(:)=0.0D0100: C      STPMAX(:)=0.0D0
 98: 101: 
 99:       FILTH=F1 ; FILTH2=F2 ; FILTHSTR=TRIM(ADJUSTL(FLSTRING))102:       FILTH=F1 ; FILTH2=F2 ; FILTHSTR=TRIM(ADJUSTL(FLSTRING))
100:       KNOWE=.FALSE. ; KNOWG=.FALSE. ; KNOWH=.FALSE.103:       KNOWE=.FALSE. ; KNOWG=.FALSE. ; KNOWH=.FALSE.
101:       RBATOMSMAX=10104:       RBATOMSMAX=10
102: 105: 
103:       CALL KEYWORDS(Q)106:       CALL KEYWORDS(Q)
104:       ALLOCATE (STPMAX(NOPT)) 
105: 107: 
106:       IF (UNRST.AND.(RKMIN.OR.BSMIN.OR.(INR.GT.-1))) THEN108:       IF (UNRST.AND.(RKMIN.OR.BSMIN.OR.(INR.GT.-1))) THEN
107:          PRINT '(A)','UNRES not coded for requested optimisation option'109:          PRINT '(A)','UNRES not coded for requested optimisation option'
108:          CALL FLUSH(6)110:          CALL FLUSH(6)
109:          STOP111:          STOP
110:       ENDIF112:       ENDIF
111: 113: 
112:       IF (PYGPERIODICT.OR.PYBINARYT) CALL INITIALISEPYGPERIODIC114:       IF (PYGPERIODICT.OR.PYBINARYT) CALL INITIALISEPYGPERIODIC
113:       IF (MULTISITEPYT) CALL DEFINEPYMULTISITES115:       IF (MULTISITEPYT) CALL DEFINEPYMULTISITES
114:       IF (LJGSITET) CALL DEFINELJMULTISITES116:       IF (LJGSITET) CALL DEFINELJMULTISITES
120:       IF (CHEMSHIFT) CALL CAMSHIFTREAD(20)122:       IF (CHEMSHIFT) CALL CAMSHIFTREAD(20)
121:       IF (MIEFT) CALL MIEF_INI()123:       IF (MIEFT) CALL MIEF_INI()
122: 124: 
123:       CALL CPU_TIME(TSTART)125:       CALL CPU_TIME(TSTART)
124: C     IF (CONNECTT.AND.NEWNEBT) THEN126: C     IF (CONNECTT.AND.NEWNEBT) THEN
125: C        PRINT*,'WARNING - cannot use old connect with new neb, changing to old neb'127: C        PRINT*,'WARNING - cannot use old connect with new neb, changing to old neb'
126: C        NEWNEBT=.FALSE.128: C        NEWNEBT=.FALSE.
127: C        NEBT=.TRUE.129: C        NEBT=.TRUE.
128: C     ENDIF130: C     ENDIF
129:       IF ((FILTH2.EQ.0).AND.(FILTH.NE.0)) WRITE(FILTHSTR,'(I10)') FILTH ! otherwise FILTHSTR isn;t set correctly.131:       IF ((FILTH2.EQ.0).AND.(FILTH.NE.0)) WRITE(FILTHSTR,'(I10)') FILTH ! otherwise FILTHSTR isn;t set correctly.
130:       IF (REPELTST) ALLOCATE(REPELTS(NOPT,100)) ! PREVIOUS TS GEOMETRIES TO AVOID132:       IF (REPELTST) ALLOCATE(REPELTS(3*NATOMS,100)) ! PREVIOUS TS GEOMETRIES TO AVOID
131:       IF (CHECKINDEX) ALLOCATE(VECCHK(NOPT,MAX(NUSEEV,HINDEX,1))) ! vectors to orthogonise to133:       IF (CHECKINDEX) ALLOCATE(VECCHK(3*NATOMS,MAX(NUSEEV,HINDEX,1))) ! vectors to orthogonise to
132:       ALLOCATE(ZWORK(NOPT,MAX(NUSEEV,HINDEX,1)))                  ! partial eigenvectors storage134:       ALLOCATE(ZWORK(3*NATOMS,MAX(NUSEEV,HINDEX,1)))                  ! partial eigenvectors storage
133:       IF (TWOENDS.OR.CONNECTT.OR.NEWNEBT.OR.DRAGT.OR.GUESSPATHT.OR.MECCANOT.OR.MORPHT.OR.GREATCIRCLET.OR.BHINTERPT.OR.BISECTT 135:       IF (TWOENDS.OR.CONNECTT.OR.NEWNEBT.OR.DRAGT.OR.GUESSPATHT.OR.MECCANOT.OR.MORPHT.OR.GREATCIRCLET.OR.BHINTERPT.OR.BISECTT 
134:      & .OR.CLOSESTALIGNMENT.OR.GROWSTRINGT) THEN136:      & .OR.CLOSESTALIGNMENT.OR.GROWSTRINGT) ALLOCATE(FIN(3*NATOMS),START(3*NATOMS))
135:          ALLOCATE(FIN(NOPT),START(NOPT)) 
136:       ENDIF 
137: 137: 
138:       NPCALL=0138:       NPCALL=0
139:       ECALL=0139:       ECALL=0
140:       FCALL=0140:       FCALL=0
141:       SCALL=0141:       SCALL=0
142:       ETIME=0142:       ETIME=0
143:       FTIME=0143:       FTIME=0
144:       STIME=0144:       STIME=0
145:       FRAME=1145:       FRAME=1
146:       IF (FILTH.EQ.0) THEN146:       IF (FILTH.EQ.0) THEN
648:             IF (PERMDISTINIT) PERMDIST=.FALSE.648:             IF (PERMDISTINIT) PERMDIST=.FALSE.
649:             IF (ATOMMATCHINIT) ATOMMATCHDIST=.FALSE.649:             IF (ATOMMATCHINIT) ATOMMATCHDIST=.FALSE.
650:             IF (BISECTT) THEN650:             IF (BISECTT) THEN
651:                CALL BISECT_OPT(NATOMS,EINITIAL,Q,EFINAL,FIN,DIST)651:                CALL BISECT_OPT(NATOMS,EINITIAL,Q,EFINAL,FIN,DIST)
652:             ELSE652:             ELSE
653:                IF (ALLOCATED(SAVES)) DEALLOCATE(SAVES)653:                IF (ALLOCATED(SAVES)) DEALLOCATE(SAVES)
654:                IF (ALLOCATED(SAVEF)) DEALLOCATE(SAVEF)654:                IF (ALLOCATED(SAVEF)) DEALLOCATE(SAVEF)
655:                ALLOCATE(SAVES(NOPT),SAVEF(NOPT))655:                ALLOCATE(SAVES(NOPT),SAVEF(NOPT))
656:                SAVES(1:NOPT)=Q(1:NOPT)656:                SAVES(1:NOPT)=Q(1:NOPT)
657:                SAVEF(1:NOPT)=FIN(1:NOPT)657:                SAVEF(1:NOPT)=FIN(1:NOPT)
658:                CALL NEWCONNECT(NATOMS,EINITIAL,Q,EFINAL,FIN,DIST,.TRUE.,REDOPATH,REDOPATHXYZ,NOPT)658:                CALL NEWCONNECT(NATOMS,EINITIAL,Q,EFINAL,FIN,DIST,.TRUE.,REDOPATH,REDOPATHXYZ)
659:                DEALLOCATE(SAVES,SAVEF)659:                DEALLOCATE(SAVES,SAVEF)
660:             ENDIF660:             ENDIF
661:          ELSE661:          ELSE
662:             CALL CONNECT(NCDONE,Q)662:             CALL CONNECT(NCDONE,Q)
663:          ENDIF663:          ENDIF
664:          IF (CALCRATES) CALL RATES(NATOMS,NINTS) ! JMC664:          IF (CALCRATES) CALL RATES(NATOMS,NINTS) ! JMC
665:       ELSE IF (MECCANOT) THEN665:       ELSE IF (MECCANOT) THEN
666:          IF (UNRST) THEN666:          IF (UNRST) THEN
667:             DO J1=1,NRES667:             DO J1=1,NRES
668:                C(1,J1)=Q(6*(J1-1)+1)668:                C(1,J1)=Q(6*(J1-1)+1)
786:                CALL VECNORM(VECS,NINTS)786:                CALL VECNORM(VECS,NINTS)
787:             ELSE787:             ELSE
788:                DO J1=1,NOPT788:                DO J1=1,NOPT
789:                   VECS(J1)=DPRAND()*2-1.0D0789:                   VECS(J1)=DPRAND()*2-1.0D0
790:                ENDDO790:                ENDDO
791:                CALL VECNORM(VECS,NOPT)791:                CALL VECNORM(VECS,NOPT)
792:             ENDIF792:             ENDIF
793:             POTCALL=.TRUE.793:             POTCALL=.TRUE.
794:          ENDIF794:          ENDIF
795: 795: 
796:          IF(ORDERPARAMT.OR.RINGPOLYMERT) QSAVE(1:NOPT)=Q(1:NOPT)796:          IF(ORDERPARAMT.OR.RINGPOLYMERT) QSAVE(1:3*NATOMS)=Q(1:3*NATOMS)
797:          IF (FILTH.EQ.0) THEN797:          IF (FILTH.EQ.0) THEN
798:             EOFSSTRING='EofS'798:             EOFSSTRING='EofS'
799:             ITSTRING='points.path.xyz'799:             ITSTRING='points.path.xyz'
800:          ELSE800:          ELSE
801:             WRITE(EOFSSTRING,'(A)') 'EofS.'//TRIM(ADJUSTL(FILTHSTR))801:             WRITE(EOFSSTRING,'(A)') 'EofS.'//TRIM(ADJUSTL(FILTHSTR))
802:             WRITE(ITSTRING,'(A)') 'points.path.xyz.'//TRIM(ADJUSTL(FILTHSTR))802:             WRITE(ITSTRING,'(A)') 'points.path.xyz.'//TRIM(ADJUSTL(FILTHSTR))
803:          ENDIF803:          ENDIF
804: 804: 
805:          DO J1=1,NOPT805:          DO J1=1,NOPT
806:             FRQSTS(J1)=0.0D0806:             FRQSTS(J1)=0.0D0
822:          ENDIF822:          ENDIF
823: 823: 
824:          IF (PATHFAILT) THEN824:          IF (PATHFAILT) THEN
825:             CALL FLUSH(6)825:             CALL FLUSH(6)
826:             GOTO 765826:             GOTO 765
827:          ENDIF827:          ENDIF
828: 828: 
829:          IF (CALCRATES) CALL RATES(NATOMS,NINTS) ! JMC829:          IF (CALCRATES) CALL RATES(NATOMS,NINTS) ! JMC
830: 830: 
831:          IF (ORDERPARAMT) THEN831:          IF (ORDERPARAMT) THEN
832:             Q(1:NOPT)=QSAVE(1:NOPT)832:             Q(1:3*NATOMS)=QSAVE(1:3*NATOMS)
833:             KNOWE=.FALSE.833:             KNOWE=.FALSE.
834:             KNOWG=.FALSE.834:             KNOWG=.FALSE.
835:             KNOWH=.FALSE.835:             KNOWH=.FALSE.
836: !bs360836: !bs360
837:             CALL GEOPT(FNAMEF,EFNAME,Q,VECS,MFLAG,ENERGY,EVALMIN,VNEW)837:             CALL GEOPT(FNAMEF,EFNAME,Q,VECS,MFLAG,ENERGY,EVALMIN,VNEW)
838:          ENDIF838:          ENDIF
839:          IF (RINGPOLYMERT.AND.(ENDHESS.OR.ENDNUMHESS)) THEN 839:          IF (RINGPOLYMERT.AND.(ENDHESS.OR.ENDNUMHESS)) THEN 
840:             Q(1:NOPT)=QSAVE(1:NOPT)840:             Q(1:3*NATOMS)=QSAVE(1:3*NATOMS)
841:             NSTEPS=0 ! will avoid geometry optimisation - need ENDHESS or ENDNUMHESS841:             NSTEPS=0 ! will avoid geometry optimisation - need ENDHESS or ENDNUMHESS
842:             IF (.NOT.(ENDHESS.OR.ENDNUMHESS)) THEN842:             IF (.NOT.(ENDHESS.OR.ENDNUMHESS)) THEN
843:                PRINT '(A)',' OPTIM> Neither ENDHESS nor ENDNUMHESS keywords are set - making ENDHESS true'843:                PRINT '(A)',' OPTIM> Neither ENDHESS nor ENDNUMHESS keywords are set - making ENDHESS true'
844:             ENDIF844:             ENDIF
845: ! to get the instanton rates.845: ! to get the instanton rates.
846:             CALL GEOPT(FNAMEF,EFNAME,Q,VECS,MFLAG,ENERGY,EVALMIN,VNEW) 846:             CALL GEOPT(FNAMEF,EFNAME,Q,VECS,MFLAG,ENERGY,EVALMIN,VNEW) 
847:          ENDIF847:          ENDIF
848: 848: 
849: 849: 
850: 850: 
857:             CALL CHARMMDUMP(FIN,'aligned.crd',MACHINE)857:             CALL CHARMMDUMP(FIN,'aligned.crd',MACHINE)
858:          ELSE IF (AMBERT .OR. NABT .OR. AMBER12T) THEN858:          ELSE IF (AMBERT .OR. NABT .OR. AMBER12T) THEN
859:             ! Formats used come from the AMBER routine minrit859:             ! Formats used come from the AMBER routine minrit
860:             OPEN(UNIT=3,FILE='aligned.rst', STATUS='UNKNOWN')860:             OPEN(UNIT=3,FILE='aligned.rst', STATUS='UNKNOWN')
861:             WRITE(3,'(20A4)') 'MOL'861:             WRITE(3,'(20A4)') 'MOL'
862:             IF (NATOMS.GT.100000) THEN862:             IF (NATOMS.GT.100000) THEN
863:                WRITE(3,'(I6)') NATOMS863:                WRITE(3,'(I6)') NATOMS
864:             ELSE864:             ELSE
865:                WRITE(3,'(I5)') NATOMS865:                WRITE(3,'(I5)') NATOMS
866:             ENDIF866:             ENDIF
867:             WRITE(3,'(6f12.7)') (FIN(J2),J2=1,NOPT)867:             WRITE(3,'(6f12.7)') (FIN(J2),J2=1,3*NATOMS)
868:             CLOSE(3)868:             CLOSE(3)
869:          ELSE869:          ELSE
870:             CALL DUMPIT(FIN,'aligned')870:             CALL DUMPIT(FIN,'aligned')
871:          ENDIF871:          ENDIF
872:       ELSE872:       ELSE
873: ! hk286873: ! hk286
874:          IF (RIGIDINIT) THEN874:          IF (RIGIDINIT) THEN
875:             ATOMRIGIDCOORDT = .FALSE.875:             ATOMRIGIDCOORDT = .FALSE.
876:             CALL TRANSFORMCTORIGID (Q, XRIGIDCOORDS)876:             CALL TRANSFORMCTORIGID (Q, XRIGIDCOORDS)
877:             CALL GEOPT(FNAMEF,EFNAME,XRIGIDCOORDS,VECS,MFLAG,ENERGY,EVALMIN,VNEW)877:             CALL GEOPT(FNAMEF,EFNAME,XRIGIDCOORDS,VECS,MFLAG,ENERGY,EVALMIN,VNEW)


r29791/output.f90 2016-01-21 22:30:06.511295663 +0000 r29790/output.f90 2016-01-21 22:30:11.171358052 +0000
 38:           USE COMMONS, ONLY : REDOPATH, REDOPATHNEB 38:           USE COMMONS, ONLY : REDOPATH, REDOPATHNEB
 39:           USE MODCUDABFGSTS, ONLY : CUDA_BFGSTS_WRAPPER 39:           USE MODCUDABFGSTS, ONLY : CUDA_BFGSTS_WRAPPER
 40:           USE GENRIGID, ONLY: DEGFREEDOMS, RIGIDINIT 40:           USE GENRIGID, ONLY: DEGFREEDOMS, RIGIDINIT
 41:  41: 
 42:           IMPLICIT NONE 42:           IMPLICIT NONE
 43:            43:           
 44:           INTEGER :: I,J,NT,ITDONE=0,J1,RECLEN 44:           INTEGER :: I,J,NT,ITDONE=0,J1,RECLEN
 45:           INTEGER,PARAMETER :: MAXPRINTOUT = 50, ITMAX  = 30 45:           INTEGER,PARAMETER :: MAXPRINTOUT = 50, ITMAX  = 30
 46:           DOUBLE PRECISION :: EDUMMY,EVALMIN,EVALMAX,MAXE,VECSNORM 46:           DOUBLE PRECISION :: EDUMMY,EVALMIN,EVALMAX,MAXE,VECSNORM
 47:           LOGICAL :: TSCONVERGED,T,TSRESET 47:           LOGICAL :: TSCONVERGED,T,TSRESET
 48:           DOUBLE PRECISION,DIMENSION(NOPT) :: LGDUMMY, VECS, DIAG 48:           DOUBLE PRECISION,DIMENSION(3*NATOMS) :: LGDUMMY, VECS, DIAG
 49:           INTEGER :: MLOC 49:           INTEGER :: MLOC
 50:           DOUBLE PRECISION :: TIME, TIME0 50:           DOUBLE PRECISION :: TIME, TIME0
 51:           DOUBLE PRECISION :: DPRAND 51:           DOUBLE PRECISION :: DPRAND
 52:           LOGICAL :: KNOWE, KNOWG, KNOWH ! JMC 52:           LOGICAL :: KNOWE, KNOWG, KNOWH ! JMC
 53:           COMMON /KNOWN/ KNOWE, KNOWG, KNOWH ! JMC 53:           COMMON /KNOWN/ KNOWE, KNOWG, KNOWH ! JMC
 54:           CHARACTER(LEN=256) :: FILENAME, METHSTR 54:           CHARACTER(LEN=256) :: FILENAME, METHSTR
 55:           INTEGER TSPOS(NIMAGE+2) 55:           TYPE(CHAIN),POINTER :: FIRST,DUMMY
 56:  56: 
 57:           LOGICAL :: TMPINTNEWT, FAILED 57:           LOGICAL :: TMPINTNEWT, FAILED
 58:  58: 
  59:           NULLIFY(FIRST,DUMMY)
 59:           NT = 0 60:           NT = 0
 60:           VECS(:) = 0 ! sn402: to avoid uninitialised value problems 61:           VECS(:) = 0 ! sn402: to avoid uninitialised value problems
 61:  62: 
 62:           IF (REDOPATHNEB) THEN 63:           IF (REDOPATHNEB) THEN
 63:              NT=1 64:              NT=1
 64:              MAXE=-1.0D100 65:              MAXE=-1.0D100
 65:              MLOC=REDOTSIM+1 66:              MLOC=REDOTSIM+1
 66:              PRINT '(A,F20.10)',' tslocator> transition state has energy ',EEE(REDOTSIM+1) 67:              PRINT '(A,F20.10)',' tslocator> transition state has energy ',EEE(REDOTSIM+1)
 67:              TSPOS(NT)=MLOC 68:              ALLOCATE(FIRST)
  69:              DUMMY=>FIRST 
  70:              DUMMY%I=MLOC
  71:              NULLIFY(DUMMY%NEXT)
 68:           ELSE 72:           ELSE
 69:              ! IDENTIFY TS CANDIDATES 73:              ! IDENTIFY TS CANDIDATES
 70:              SELECT CASE(CANDIDATES) ! Unless the keyword 'CANDIDATES' was used, this should 74:              SELECT CASE(CANDIDATES) ! Unless the keyword 'CANDIDATES' was used, this should
 71:              ! always be "maxim" 75:              ! always be "maxim"
 72:              CASE('high') 76:              CASE('high')
 73:                   NT=1 77:                   NT=1
 74:                   MAXE=-1.0D100 78:                   MAXE=-1.0D100
 75:                   DO J1=2,NIMAGE+1 79:                   DO J1=2,NIMAGE+1
 76:                      IF (EEE(J1).GT.MAXE) THEN 80:                      IF (EEE(J1).GT.MAXE) THEN
 77:                         MLOC=J1 81:                         MLOC=J1
 78:                         MAXE=EEE(J1) 82:                         MAXE=EEE(J1)
 79:                      ENDIF 83:                      ENDIF
 80:                   ENDDO 84:                   ENDDO
 81:                   TSPOS(1)=MLOC 85:                   ALLOCATE(FIRST)
  86:                   DUMMY=>FIRST 
  87:                   DUMMY%I=MLOC
  88:                   NULLIFY(DUMMY%NEXT)
 82:              CASE('all','maxim') 89:              CASE('all','maxim')
 83:                   DO I=2,NIMAGE+1  90:                   DO I=2,NIMAGE+1 
 84:                        T=.TRUE. 91:                        T=.TRUE.
 85:                        IF (CANDIDATES=='maxim') then 92:                        IF (CANDIDATES=='maxim') then
 86:                             IF ( EEE(I-1)+EDIFFTOL*10.0D0 < EEE(I) .AND. EEE(I) > EEE(I+1)+EDIFFTOL*10.0D0 ) THEN 93:                             IF ( EEE(I-1)+EDIFFTOL*10.0D0 < EEE(I) .AND. EEE(I) > EEE(I+1)+EDIFFTOL*10.0D0 ) THEN
 87:                                  T=.TRUE. 94:                                  T=.TRUE.
 88:                             ELSE 95:                             ELSE
 89:                                  T=.FALSE. 96:                                  T=.FALSE.
 90:                             ENDIF 97:                             ENDIF
 91:                        ENDIF 98:                        ENDIF
 92: !                      PRINT '(A,I6,3F20.10,L5)','I,EEE(I-1),EEE(I),EEE(I+1),T=',I,EEE(I-1),EEE(I),EEE(I+1),T 99: !                      PRINT '(A,I6,3F20.10,L5)','I,EEE(I-1),EEE(I),EEE(I+1),T=',I,EEE(I-1),EEE(I),EEE(I+1),T
 93:                        IF (T) THEN100:                        IF (T) THEN
 94:                             NT=NT+1101:                             NT=NT+1
 95:                             TSPOS(NT)=I ! IS A POSITION OF A MAXIMUM IN ARRAY XYZ102:                             IF (ASSOCIATED(FIRST)) THEN
 103:                                  ALLOCATE(DUMMY%NEXT)
 104:                                  DUMMY=>DUMMY%NEXT
 105:                             ELSE
 106:                                  ALLOCATE(FIRST)
 107:                                  DUMMY=>FIRST
 108:                             ENDIF
 109:                             DUMMY%I = I ! IS A POSITION OF A MAXIMUM IN ARRAY XYZ
 110:                             NULLIFY(DUMMY%NEXT)
 96:                        ENDIF111:                        ENDIF
 97:                   ENDDO112:                   ENDDO
 98:              END SELECT113:              END SELECT
 99:           ENDIF114:           ENDIF
100: 115: 
101:           NONEBMAX=.FALSE.116:           NONEBMAX=.FALSE.
102:           IF (NT.EQ.0) THEN117:           IF (ASSOCIATED(FIRST)) THEN
103: !118:                DUMMY=>FIRST
104: ! This should cope with highly asymmetric profiles, which otherwise looks monotonic119:           ELSE
105: ! until we try a huge number of images. 120:                ! This should cope with highly asymmetric profiles, which otherwise looks monotonic
106: !121:                ! until we try a huge number of images. 
107:              PRINT '(1x,a)', 'No maximum in profile - using highest image'122: !            IF (INTCONSTRAINTT) THEN
108:              NT=1123: !               NONEBMAX=.TRUE.
109:              IF (EEE(2).GT.EEE(NIMAGE+1)) THEN124: !               PRINT '(1X,A)', 'No maximum in profile - skipping single-ended searching'
110:                 TSPOS(1)=2125: !               RETURN
111:              ELSE126: !            ELSE
112:                 TSPOS(1)=NIMAGE+1127:                 PRINT '(1x,a)', 'No maximum in profile - using highest image'
113:              ENDIF128:                 ALLOCATE(FIRST)
114:           ENDIF129:                 DUMMY=>FIRST
 130:                 IF (EEE(2).GT.EEE(NIMAGE+1)) THEN
 131:                    DUMMY%I = 2
 132:                 ELSE
 133:                    DUMMY%I = NIMAGE+1
 134:                 ENDIF
 135:                 NULLIFY(DUMMY%NEXT)
 136:               ENDIF
 137: !         ENDIF
115: 138: 
116:           WRITE(*,'(1X,A,I4,A)',advance='No') 'Following ',NT,' images are candidates for TS:'139: !         write(*,'(1x,a)',advance='No') 'Following images are candidates for TS:'
117:           DO J=1,NT140: !         do j=1,NTSmax
118:              WRITE(*,'(i5)',advance='No') TSPOS(J)-1141: !              if (j<MaxPrintOut) write(*,'(i5)',advance='No') dummy%i-1
 142: !              if (.not.associated(dummy%next)) exit
 143: !              dummy=>dummy%next
 144: !         enddo
 145: !         write(*,'(a)') '.'
 146: 
 147:           ! ------ bs360 : more general printout (without MaxPrintOut) -------
 148:           WRITE(*,'(1x,a,i4,a)',advance='No') 'Following ',nt,' images are candidates for TS:'
 149:           DO J=1,NTSMAX
 150:                WRITE(*,'(i5)',advance='No') dummy%i-1
 151:                IF (.NOT.ASSOCIATED(DUMMY%NEXT)) EXIT
 152:                DUMMY=>DUMMY%NEXT
 153:                !msb50
119:           ENDDO154:           ENDDO
120:           PRINT *,' '155:           PRINT *,' '
 156:           ! ------ end bs360 ---------------------------
121:           157:           
122:           IF (OPTIMIZETS) THEN158:           IF (OPTIMIZETS) THEN
123:              IF (DEBUG) THEN159: !              WRITE(*,'(1x,a)',advance='No') 'Converged to TS (number of iterations):     '
124:                  write(*,*) "Index of first candidate is ", TSPOS(1)  ! sn402160:                DUMMY=>FIRST
125:                  write(*,*) "Image energies are", EEE(:) !sn402161:                IF(DEBUG) THEN
126:              ENDIF162:                    write(*,*) "Index of maximum image is ", DUMMY%I  ! sn402
127:              IF (TSRESET) NTSFOUND=0163:                    write(*,*) "Image energies are", EEE(:) !sn402
128:              CALL MYCPU_TIME(STARTTIME,.FALSE.)164:                ENDIF
129:              DO J=1,NT165:                IF (TSRESET) NTSFOUND=0
130:                 CALL MYCPU_TIME(TIME0,.FALSE.)166: !              PRINT '(A,L5,I6)',' output> TSRESET,NTSFOUND=',TSRESET,NTSFOUND
131:                 EDUMMY=EEE(TSPOS(J))167:                CALL MYCPU_TIME(STARTTIME,.FALSE.)
132:                 LGDUMMY(1:NOPT)=TRUEGRAD((TSPOS(J)-1)*NOPT+1:TSPOS(J)*NOPT)168:                DO J=1,NTSMAX
133:                 KNOWE=.TRUE.169:                     CALL MYCPU_TIME(TIME0,.FALSE.)
134:                 KNOWG=.TRUE.170:                     EDUMMY=EEE(DUMMY%I)
135:                 IF (REDOPATH) THEN171:                     LGDUMMY(1:3*NATOMS)=TRUEGRAD((DUMMY%I-1)*3*NATOMS+1:DUMMY%I*3*NATOMS)
136:                    KNOWG = .FALSE.172:                     KNOWE=.TRUE.
137:                    KNOWE = .FALSE.173:                     KNOWG=.TRUE.
138:                 ENDIF174:                     IF (REDOPATH) THEN
139:                 IF (BFGSTST) THEN175:                        KNOWG = .FALSE.
140:                    IF (UNRST) THEN ! JMC176:                        KNOWE = .FALSE.
141:                       KNOWG=.FALSE. ! Is this needed now that gdummy is set? DJW177:                     ENDIF
142:                       VECS(1:NINTS)=TANVEC(1:NINTS,TSPOS(J)-1)178:                     IF (BFGSTST) THEN
143:                       VECSNORM=SUM(VECS(1:NINTS)**2)179:                        IF (UNRST) THEN ! JMC
144:                       IF (VECSNORM.EQ.0.0D0) THEN  ! Just in case TANVEC is somehow not set? e.g. for redopath !180:                           KNOWG=.FALSE. ! Is this needed now that gdummy is set? DJW
145:                          IF (DEBUG) PRINT '(A)', ' output> setting random initial vector for eigenvector'181:                           VECS(1:NINTS)=TANVEC(1:NINTS,DUMMY%I-1)
146:                          DO J1=1,NINTS182:                           VECSNORM=SUM(VECS(1:NINTS)**2)
147:                             VECS(J1)=DPRAND()*2-1.0D0183:                           IF (VECSNORM.EQ.0.0D0) THEN  ! Just in case TANVEC is somehow not set? e.g. for redopath !
148:                          ENDDO184:                              IF (DEBUG) PRINT '(A)', ' output> setting random initial vector for eigenvector'
149:                          CALL VECNORM(VECS,NINTS)185:                              DO J1=1,NINTS
150:                       ENDIF186:                                 VECS(J1)=DPRAND()*2-1.0D0
151:                       CALL INTBFGSTS(NSTEPS,XYZ(NOPT*(TSPOS(J)-1)+1:NOPT*TSPOS(J)),  &187:                              ENDDO
152:                  &     EDUMMY,LGDUMMY,TSCONVERGED,RMS,EVALMIN,EVALMAX,VECS,ITDONE,.TRUE.,DEBUG)188:                              CALL VECNORM(VECS,NINTS)
153:                    ELSE189:                           ENDIF
154:                       IF (DESMINT) THEN190:                           CALL INTBFGSTS(NSTEPS,XYZ(NOPT*(DUMMY%I-1)+1:NOPT*DUMMY%I),  &
155:                          TMPINTNEWT = INTNEWT191:                    &       EDUMMY,LGDUMMY,TSCONVERGED,RMS,EVALMIN,EVALMAX,VECS,ITDONE,.TRUE.,DEBUG)
156:                          INTNEWT = .FALSE. ! linear transformation only192:                        ELSE
157:                          ! convert internal tangents to cartesians193:                           IF (DESMINT) THEN
158:                          CALL TRANSBACKDELTA(TANVEC(1:NOPT,TSPOS(J)-1),VECS,XYZCART(NOPT*(TSPOS(J)-1)+1:NOPT*TSPOS(J)), &194:                              TMPINTNEWT = INTNEWT
159:                               & NINTC,NOPT,NNZ,KD,FAILED,DEBUG,INTEPSILON)                             195:                              INTNEWT = .FALSE. ! linear transformation only
160:                          INTNEWT = TMPINTNEWT196:                              ! convert internal tangents to cartesians
161:                          VECSNORM=SUM(VECS(1:NOPT)**2)197:                              CALL TRANSBACKDELTA(TANVEC(1:NOPT,DUMMY%I-1),VECS,XYZCART(3*NATOMS*(DUMMY%I-1)+1:3*NATOMS*DUMMY%I), &
162:                          IF (VECSNORM.EQ.0.0D0) THEN  ! TANVEC ISN't set for GUESSPATH, MECCANO, UNMECCANO198:                                   & NINTC,3*NATOMS,NNZ,KD,FAILED,DEBUG,INTEPSILON)                             
163:                             IF (DEBUG) PRINT '(A)', ' output> setting random initial vector for eigenvector'199:                              INTNEWT = TMPINTNEWT
164:                             DO J1=1,NOPT200:                              VECSNORM=SUM(VECS(1:3*NATOMS)**2)
165:                                VECS(J1)=DPRAND()*2-1.0D0201:                              IF (VECSNORM.EQ.0.0D0) THEN  ! TANVEC ISN't set for GUESSPATH, MECCANO, UNMECCANO
166:                             ENDDO202:                                 IF (DEBUG) PRINT '(A)', ' output> setting random initial vector for eigenvector'
167:                             CALL VECNORM(VECS,NOPT)203:                                 DO J1=1,3*NATOMS
168:                          ENDIF 
169:                       ELSE 
170:                          VECS(1:NOPT)=TANVEC(1:NOPT,TSPOS(J)-1) 
171:                          VECSNORM=SUM(VECS(1:NOPT)**2) 
172:                          IF (VECSNORM.EQ.0.0D0) THEN  ! TANVEC ISN't set for GUESSPATH, MECCANO, UNMECCANO 
173:                             IF (DEBUG) PRINT '(A)', ' output> setting random initial vector for eigenvector' 
174:                             ! This IF block probably doesn't make any difference, but it stops complaints 
175:                             ! about coordinate transformations further down the line. 
176:                             IF (RIGIDINIT) THEN 
177:                                DO J1=1,DEGFREEDOMS 
178:                                    VECS(J1)=DPRAND()*2-1.0D0204:                                    VECS(J1)=DPRAND()*2-1.0D0
179:                                ENDDO205:                                 ENDDO
180:                                VECS(DEGFREEDOMS+1:) = 0.0D0206:                                 CALL VECNORM(VECS,3*NATOMS)
181:                             ELSE207:                              ENDIF
182:                                DO J1=1,NOPT208:                           ELSE
183:                                   VECS(J1)=DPRAND()*2-1.0D0209:                              VECS(1:NOPT)=TANVEC(1:NOPT,DUMMY%I-1)
184:                                ENDDO210:                              VECSNORM=SUM(VECS(1:NOPT)**2)
185:                             ENDIF211:                              IF (VECSNORM.EQ.0.0D0) THEN  ! TANVEC ISN't set for GUESSPATH, MECCANO, UNMECCANO
186:                             CALL VECNORM(VECS,NOPT)212:                                 IF (DEBUG) PRINT '(A)', ' output> setting random initial vector for eigenvector'
187:                          ENDIF213:                                 ! This IF block probably doesn't make any difference, but it stops complaints
188:                       ENDIF214:                                 ! about coordinate transformations further down the line.
189:                       IF (GROWSTRINGT.OR.REDOPATH) THEN215:                                 IF(RIGIDINIT) THEN
190:                          KNOWG = .FALSE.216:                                     DO J1=1,DEGFREEDOMS
191:                          KNOWE = .FALSE.217:                                         VECS(J1)=DPRAND()*2-1.0D0
192:                       ENDIF218:                                     ENDDO
 219:                                     VECS(DEGFREEDOMS+1:) = 0.0D0
 220:                                 ELSE
 221:                                     DO J1=1,NOPT
 222:                                        VECS(J1)=DPRAND()*2-1.0D0
 223:                                     ENDDO
 224:                                 ENDIF
 225:                                 CALL VECNORM(VECS,NOPT)
 226:                              ENDIF
 227:                           ENDIF
 228:                           IF (GROWSTRINGT.OR.REDOPATH) THEN
 229:                              KNOWG = .FALSE.
 230:                              KNOWE = .FALSE.
 231:                           ENDIF
 232: 
 233:                           IF (DESMINT) THEN
 234:                              CALL BFGSTS(NSTEPS,XYZCART(3*NATOMS*(DUMMY%I-1)+1:3*NATOMS*DUMMY%I),  &
 235:                                   &       EDUMMY,LGDUMMY,TSCONVERGED,RMS,EVALMIN,EVALMAX,VECS,ITDONE,.TRUE.,PRINTOPTIMIZETS)
 236:                           ELSE
 237:                              IF (CUDAT) THEN
 238:                                 CALL CUDA_BFGSTS_WRAPPER(NSTEPS,XYZ(NOPT*(DUMMY%I-1)+1:NOPT*DUMMY%I),  &
 239:                                      &       EDUMMY,TSCONVERGED,RMS,EVALMIN,VECS,ITDONE)
 240:                              ELSE
 241:                                 CALL BFGSTS(NSTEPS,XYZ(NOPT*(DUMMY%I-1)+1:NOPT*DUMMY%I),  &
 242:                                      &       EDUMMY,LGDUMMY,TSCONVERGED,RMS,EVALMIN,EVALMAX,VECS,ITDONE,.TRUE.,PRINTOPTIMIZETS)
 243:                              END IF
 244:                           ENDIF
 245:                        ENDIF
 246:                     ELSE
 247:                        IF (DESMINT) THEN
 248:                           CALL EFOL(XYZCART(3*NATOMS*(DUMMY%I-1)+1:3*NATOMS*DUMMY%I),TSCONVERGED, &
 249:                                &   NSTEPS,EDUMMY,ITDONE,EVALMIN,DEBUG,DIAG,2)
 250:                        ELSE
 251:                           CALL EFOL(XYZ(NOPT*(DUMMY%I-1)+1:NOPT*DUMMY%I),TSCONVERGED, &
 252:                                &   NSTEPS,EDUMMY,ITDONE,EVALMIN,DEBUG,DIAG,2)
 253:                        ENDIF
 254:                     ENDIF
 255:                     CALL MYCPU_TIME(TIME,.FALSE.)
 256: 
 257: !                   IF (CHRMMT) CALL CHECKTS(DUMMY,EVALMIN,TSCONVERGED) ! this is now a dummy routine!
193: 258: 
194:                       IF (DESMINT) THEN259:                     IF (TSCONVERGED) THEN
195:                          CALL BFGSTS(NSTEPS,XYZCART(NOPT*(TSPOS(J)-1)+1:NOPT*TSPOS(J)),  &260:                          NTSFOUND=NTSFOUND+1
196:                               &       EDUMMY,LGDUMMY,TSCONVERGED,RMS,EVALMIN,EVALMAX,VECS,ITDONE,.TRUE.,PRINTOPTIMIZETS)261:                          IF (DESMINT) THEN
197:                       ELSE262:                             ALLOCATE(TSFOUND(NTSFOUND)%E,TSFOUND(NTSFOUND)%COORD(3*NATOMS),&
198:                          IF (CUDAT) THEN263:                                  &TSFOUND(NTSFOUND)%EVALMIN,TSFOUND(NTSFOUND)%VECS(3*NATOMS))
199:                             CALL CUDA_BFGSTS_WRAPPER(NSTEPS,XYZ(NOPT*(TSPOS(J)-1)+1:NOPT*TSPOS(J)),  &264:                             TSFOUND(NTSFOUND)%VECS=VECS(1:3*NATOMS)
200:                                  &       EDUMMY,TSCONVERGED,RMS,EVALMIN,VECS,ITDONE)265:                             TSFOUND(NTSFOUND)%COORD=XYZCART(3*NATOMS*(DUMMY%I-1)+1:3*NATOMS*DUMMY%I)
201:                          ELSE266:                          ELSE
202:                             CALL BFGSTS(NSTEPS,XYZ(NOPT*(TSPOS(J)-1)+1:NOPT*TSPOS(J)),  &267:                             ALLOCATE(TSFOUND(NTSFOUND)%E,TSFOUND(NTSFOUND)%COORD(NOPT),&
203:                                  &       EDUMMY,LGDUMMY,TSCONVERGED,RMS,EVALMIN,EVALMAX,VECS,ITDONE,.TRUE.,PRINTOPTIMIZETS)268:                                  &TSFOUND(NTSFOUND)%EVALMIN,TSFOUND(NTSFOUND)%VECS(NOPT))
204:                          END IF269:                             TSFOUND(NTSFOUND)%VECS=VECS(1:NOPT)
 270:                             TSFOUND(NTSFOUND)%COORD=XYZ(NOPT*(DUMMY%I-1)+1:NOPT*DUMMY%I)
 271:                          ENDIF
 272:                          TSFOUND(NTSFOUND)%E=EDUMMY
 273:                          TSFOUND(NTSFOUND)%EVALMIN=EVALMIN
 274: !                        PRINT '(A,I6)',' output> DEBUG allocated storage for NTSFOUND=',NTSFOUND
205:                       ENDIF275:                       ENDIF
206:                    ENDIF276: !                   if (j<MaxPrintOut) then  ! commented by bs360
207:                 ELSE277:                          IF (TSCONVERGED) THEN
208:                    IF (DESMINT) THEN278: !                             WRITE(*,'(i5)',advance='No') itdone
209:                       CALL EFOL(XYZCART(NOPT*(TSPOS(J)-1)+1:NOPT*TSPOS(J)),TSCONVERGED, &279:                               WRITE(*,'(1X,A,I6)') 'Converged to TS (number of iterations):     ',ITDONE
210:                            &   NSTEPS,EDUMMY,ITDONE,EVALMIN,DEBUG,DIAG,2)280:                          ELSE
211:                    ELSE281: !                             WRITE(*,'(A)',advance='No') 'Failed to converge to TS'
212:                       CALL EFOL(XYZ(NOPT*(TSPOS(J)-1)+1:NOPT*TSPOS(J)),TSCONVERGED, &282:                               WRITE(*,'(1X,A,I6)') 'Failed to converge to TS (number of iterations):     ',ITDONE
213:                            &   NSTEPS,EDUMMY,ITDONE,EVALMIN,DEBUG,DIAG,2)283:                          ENDIF
214:                    ENDIF284: !                   endif
215:                 ENDIF 
216:                 CALL MYCPU_TIME(TIME,.FALSE.) 
217: 285: 
218:                 IF (TSCONVERGED) THEN286:                     IF (ASSOCIATED(DUMMY%NEXT)) THEN
219:                    NTSFOUND=NTSFOUND+1287:                          DUMMY=>DUMMY%NEXT
220:                    IF (DESMINT) THEN288:                     ELSE
221:                       ALLOCATE(TSFOUND(NTSFOUND)%E,TSFOUND(NTSFOUND)%COORD(NOPT),&289:                          EXIT
222:                            &TSFOUND(NTSFOUND)%EVALMIN,TSFOUND(NTSFOUND)%VECS(NOPT))290:                     ENDIF
223:                       TSFOUND(NTSFOUND)%VECS=VECS(1:NOPT)291:                ENDDO
224:                       TSFOUND(NTSFOUND)%COORD=XYZCART(NOPT*(TSPOS(J)-1)+1:NOPT*TSPOS(J))292:                CALL MYCPU_TIME(ENDTIME,.FALSE.)
225:                    ELSE293: 
226:                       ALLOCATE(TSFOUND(NTSFOUND)%E,TSFOUND(NTSFOUND)%COORD(NOPT),&294:                WRITE(INTSTR,'(i10)') NTSfound
227:                            &TSFOUND(NTSFOUND)%EVALMIN,TSFOUND(NTSFOUND)%VECS(NOPT))295: 
228:                       TSFOUND(NTSFOUND)%VECS=VECS(1:NOPT)296:                IF (MECCANOT) THEN                  
229:                       TSFOUND(NTSFOUND)%COORD=XYZ(NOPT*(TSPOS(J)-1)+1:NOPT*TSPOS(J))297:                   WRITE(METHSTR,'(a)') 'MECCANO'
230:                    ENDIF298:                ELSE IF (GROWSTRINGT) THEN
231:                    TSFOUND(NTSFOUND)%E=EDUMMY299:                   IF (EVOLVESTRINGT) THEN
232:                    TSFOUND(NTSFOUND)%EVALMIN=EVALMIN300:                      WRITE(METHSTR,'(a)') 'ES'
233:                 ENDIF301:                   ELSE
234:                 IF (TSCONVERGED) THEN302:                      WRITE(METHSTR,'(a)') 'GS'
235:                    WRITE(*,'(1X,A,I6)') 'Converged to TS (number of iterations):     ',ITDONE303:                   ENDIF
236:                 ELSE304:                ELSE
237:                    WRITE(*,'(1X,A,I6)') 'Failed to converge to TS (number of iterations):     ',ITDONE305:                   WRITE(METHSTR,'(a)') 'DNEB'
238:                 ENDIF306:                ENDIF              
239:              ENDDO307: 
240:              CALL MYCPU_TIME(ENDTIME,.FALSE.)308:                WRITE(*, '(1x,a,f7.2)',advance='yes') trim(METHSTR)//' run yielded '//trim(adjustl(IntStr))// &
 309:                             &' true transition state(s) time=',EndTime-StartTime
 310: !              if (NTSfound==1) then
 311: !                   write(*, '(a)') '.'
 312: !              else
 313: !                   write(*, '(a)') 's.'
 314: !              endif
 315:           ENDIF
 316:           IF (SAVECANDIDATES) THEN
 317:                IF (ASSOCIATED(FIRST)) THEN
 318:                     DUMMY=>FIRST
 319:                     IF (DESMINT) THEN
 320:                        INQUIRE(IOLENGTH=RECLEN) (XYZ(3*NATOMS*(DUMMY%I-1)+1:3*NATOMS*DUMMY%I))
 321:                     ELSE                       
 322:                        INQUIRE(IOLENGTH=RECLEN) (XYZ(NOPT*(DUMMY%I-1)+1:NOPT*DUMMY%I))
 323:                     ENDIF
 324:                     J=1
 325:                     DO
 326:                          WRITE(FILENAME,'(i10)') j
 327:                          FILENAME='points'//trim(adjustl(filename))//'.out'
 328:                          OPEN(UNIT=40,FILE=FILENAME,STATUS='unknown',form='unformatted',access='direct',recl=reclen)
241: 329: 
242:              WRITE(INTSTR,'(I10)') NTSFOUND330:                          IF (DESMINT) THEN
 331:                             WRITE(40,REC=1) ( XYZ(3*NATOMS*(DUMMY%I-1)+1:3*NATOMS*DUMMY%I) )
 332:                          ELSE
 333:                             WRITE(40,REC=1) ( XYZ(NOPT*(DUMMY%I-1)+1:NOPT*DUMMY%I) )
 334:                          ENDIF
243: 335: 
244:              IF (MECCANOT) THEN                  336:                          CLOSE(40)
245:                 WRITE(METHSTR,'(A)') 'MECCANO'337:                          IF (ASSOCIATED(DUMMY%NEXT)) THEN
246:              ELSE IF (GROWSTRINGT) THEN338:                               DUMMY=>DUMMY%NEXT
247:                 IF (EVOLVESTRINGT) THEN339:                               J=J+1
248:                    WRITE(METHSTR,'(A)') 'ES'340:                          ELSE
249:                 ELSE341:                               EXIT
250:                    WRITE(METHSTR,'(A)') 'GS'342:                          ENDIF
251:                 ENDIF343:                     ENDDO
252:              ELSE344:                ENDIF
253:                 WRITE(METHSTR,'(A)') 'DNEB'345:           ENDIF
254:              ENDIF               
255:  
256:              WRITE(*, '(1x,a,f7.2)',advance='yes') trim(METHSTR)//' run yielded '//trim(adjustl(IntStr))// & 
257:                           &' true transition state(s) time=',EndTime-StartTime 
258:         ENDIF 
259:         IF (SAVECANDIDATES) THEN 
260:            DO J=1,NTSFOUND 
261:               IF (DESMINT) THEN 
262:                  INQUIRE(IOLENGTH=RECLEN) (XYZ(NOPT*(TSPOS(J)-1)+1:NOPT*TSPOS(J))) 
263:               ELSE                        
264:                  INQUIRE(IOLENGTH=RECLEN) (XYZ(NOPT*(TSPOS(J)-1)+1:NOPT*TSPOS(J))) 
265:               ENDIF 
266:               WRITE(FILENAME,'(i10)') J 
267:               FILENAME='points'//trim(adjustl(filename))//'.out' 
268:               OPEN(UNIT=40,FILE=FILENAME,STATUS='unknown',form='unformatted',access='direct',recl=reclen) 
269:  
270:               IF (DESMINT) THEN 
271:                  WRITE(40,REC=1) ( XYZ(NOPT*(TSPOS(J)-1)+1:NOPT*TSPOS(J)) ) 
272:               ELSE 
273:                  WRITE(40,REC=1) ( XYZ(NOPT*(TSPOS(J)-1)+1:NOPT*TSPOS(J)) ) 
274:               ENDIF 
275: 346: 
276:               CLOSE(40)347:           IF (.NOT.ASSOCIATED(FIRST)) RETURN
277:            ENDDO348:           DO
278:         ENDIF349:                IF (.NOT.ASSOCIATED(FIRST%NEXT)) THEN
 350:                     NULLIFY(DUMMY)
 351:                     DEALLOCATE(FIRST)
 352:                     RETURN
 353:                ENDIF
 354:                DUMMY=>FIRST%NEXT
 355:                NULLIFY(FIRST%NEXT)
 356:                DEALLOCATE(FIRST)
 357:                FIRST=>DUMMY
 358:           ENDDO
279: 359: 
280:         RETURN 
281: 360: 
282:       END SUBROUTINE TSLOCATOR361:       END SUBROUTINE TSLOCATOR
283: 362: 
284: SUBROUTINE CONTSLOCATOR363: SUBROUTINE CONTSLOCATOR
285: USE KEY,ONLY: BFGSTST,UNRST,NSTEPS,MACHINE, GROWSTRINGT, INTEPSILON, REDOTSIM364: USE KEY,ONLY: BFGSTST,UNRST,NSTEPS,MACHINE, GROWSTRINGT, INTEPSILON, REDOTSIM
286: USE GSDATA, ONLY: EVOLVESTRINGT365: USE GSDATA, ONLY: EVOLVESTRINGT
287: USE KEYOUTPUT366: USE KEYOUTPUT
288: USE MODCHARMM367: USE MODCHARMM
289: USE NEBDATA368: USE NEBDATA
290: USE KEYNEB,ONLY:NIMAGE,DEBUG369: USE KEYNEB,ONLY:NIMAGE,DEBUG
295: USE LINKEDLIST374: USE LINKEDLIST
296: USE MODEFOL375: USE MODEFOL
297: USE INTCOMMONS, ONLY : DESMINT, NINTC, NNZ, KD, INTNEWT376: USE INTCOMMONS, ONLY : DESMINT, NINTC, NNZ, KD, INTNEWT
298: USE COMMONS, ONLY : REDOPATH, REDOPATHNEB377: USE COMMONS, ONLY : REDOPATH, REDOPATHNEB
299: IMPLICIT NONE378: IMPLICIT NONE
300:           379:           
301: INTEGER :: I,J,ITDONE=0,J1,RECLEN,J2,MYTSMAX,NTS380: INTEGER :: I,J,ITDONE=0,J1,RECLEN,J2,MYTSMAX,NTS
302: INTEGER,PARAMETER :: MAXPRINTOUT = 50, ITMAX  = 30381: INTEGER,PARAMETER :: MAXPRINTOUT = 50, ITMAX  = 30
303: DOUBLE PRECISION :: EDUMMY,EVALMIN,EVALMAX,MAXE,VECSNORM382: DOUBLE PRECISION :: EDUMMY,EVALMIN,EVALMAX,MAXE,VECSNORM
304: LOGICAL :: TSCONVERGED383: LOGICAL :: TSCONVERGED
305: DOUBLE PRECISION,DIMENSION(NOPT) :: LGDUMMY, VECS, DIAG, XLOCAL384: DOUBLE PRECISION,DIMENSION(3*NATOMS) :: LGDUMMY, VECS, DIAG, XLOCAL
306: DOUBLE PRECISION ELOCAL(NIMAGE+2)385: DOUBLE PRECISION ELOCAL(NIMAGE+2)
307: INTEGER :: MLOC386: INTEGER :: MLOC
308: DOUBLE PRECISION :: TIME, TIME0387: DOUBLE PRECISION :: TIME, TIME0
309: DOUBLE PRECISION :: DPRAND388: DOUBLE PRECISION :: DPRAND
310: LOGICAL :: KNOWE, KNOWG, KNOWH ! JMC389: LOGICAL :: KNOWE, KNOWG, KNOWH ! JMC
311: COMMON /KNOWN/ KNOWE, KNOWG, KNOWH ! JMC390: COMMON /KNOWN/ KNOWE, KNOWG, KNOWH ! JMC
312: CHARACTER(LEN=256) :: FILENAME, METHSTR391: CHARACTER(LEN=256) :: FILENAME, METHSTR
313: LOGICAL :: TMPINTNEWT, FAILED392: LOGICAL :: TMPINTNEWT, FAILED
314: DOUBLE PRECISION, ALLOCATABLE :: TSGUESS(:,:), TSTEMP(:,:), LTANVEC(:,:)393: DOUBLE PRECISION, ALLOCATABLE :: TSGUESS(:,:), TSTEMP(:,:), LTANVEC(:,:)
315: 394: 
316: MYTSMAX=10395: MYTSMAX=10
317: IF (ALLOCATED(TSGUESS)) DEALLOCATE(TSGUESS)396: IF (ALLOCATED(TSGUESS)) DEALLOCATE(TSGUESS)
318: IF (ALLOCATED(LTANVEC)) DEALLOCATE(LTANVEC)397: IF (ALLOCATED(LTANVEC)) DEALLOCATE(LTANVEC)
319: ALLOCATE(TSGUESS(MYTSMAX,NOPT),LTANVEC(MYTSMAX,NOPT))398: ALLOCATE(TSGUESS(MYTSMAX,3*NATOMS),LTANVEC(MYTSMAX,3*NATOMS))
320: NTS=0399: NTS=0
321: LGDUMMY = 0 ! sn402 added400: LGDUMMY = 0 ! sn402 added
322: IF (REDOPATHNEB) THEN401: IF (REDOPATHNEB) THEN
323:    PRINT '(A,F20.10)',' contslocator> ERROR *** REDOPATH cannot be set with NEBCONSTRAINT'402:    PRINT '(A,F20.10)',' contslocator> ERROR *** REDOPATH cannot be set with NEBCONSTRAINT'
324:    STOP403:    STOP
325: ELSE404: ELSE
326:    DO I=1,NIMAGE+1405:    DO I=1,NIMAGE+1
327:       DO J2=1,NIMAGE+2 ! extra interpolation using the same number of images406:       DO J2=1,NIMAGE+2 ! extra interpolation using the same number of images
328:          XLOCAL(1:NOPT)=( (NIMAGE+2-J2)*XYZ((I-1)*NOPT+1:I*NOPT)+(J2-1)*XYZ(I*NOPT+1:(I+1)*NOPT) )/(NIMAGE+1)407:          XLOCAL(1:NOPT)=( (NIMAGE+2-J2)*XYZ((I-1)*NOPT+1:I*NOPT)+(J2-1)*XYZ(I*NOPT+1:(I+1)*NOPT) )/(NIMAGE+1)
329:          CALL POTENTIAL(XLOCAL,ELOCAL(J2),LGDUMMY,.FALSE.,.FALSE.,RMS,.FALSE.,.FALSE.)408:          CALL POTENTIAL(XLOCAL,ELOCAL(J2),LGDUMMY,.FALSE.,.FALSE.,RMS,.FALSE.,.FALSE.)
330:          PRINT '(3(A,I6),A,G20.10)',' contslocator> energy at position ',J2,' between images ',I,' and ',I+1, &409:          PRINT '(3(A,I6),A,G20.10)',' contslocator> energy at position ',J2,' between images ',I,' and ',I+1, &
331:   &                                  ' E=',ELOCAL(J2)410:   &                                  ' E=',ELOCAL(J2)
332:       ENDDO411:       ENDDO
333:       IF (ELOCAL(2).LT.ELOCAL(1)) THEN412:       IF (ELOCAL(2).LT.ELOCAL(1)) THEN
334:          NTS=NTS+1413:          NTS=NTS+1
335:          IF (NTS.GT.MYTSMAX) THEN ! increase storage as required for TS candidates414:          IF (NTS.GT.MYTSMAX) THEN ! increase storage as required for TS candidates
336:             ALLOCATE(TSTEMP(MYTSMAX,NOPT))415:             ALLOCATE(TSTEMP(MYTSMAX,3*NATOMS))
337:             TSTEMP(1:MYTSMAX,1:NOPT)=TSGUESS(1:MYTSMAX,1:NOPT)416:             TSTEMP(1:MYTSMAX,1:3*NATOMS)=TSGUESS(1:MYTSMAX,1:3*NATOMS)
338:             DEALLOCATE(TSGUESS)417:             DEALLOCATE(TSGUESS)
339:             ALLOCATE(TSGUESS(2*MYTSMAX,NOPT))418:             ALLOCATE(TSGUESS(2*MYTSMAX,3*NATOMS))
340:             TSGUESS(1:MYTSMAX,1:NOPT)=TSTEMP(1:MYTSMAX,1:NOPT)419:             TSGUESS(1:MYTSMAX,1:3*NATOMS)=TSTEMP(1:MYTSMAX,1:3*NATOMS)
341:             TSTEMP(1:MYTSMAX,1:NOPT)=LTANVEC(1:MYTSMAX,1:NOPT)420:             TSTEMP(1:MYTSMAX,1:3*NATOMS)=LTANVEC(1:MYTSMAX,1:3*NATOMS)
342:             DEALLOCATE(LTANVEC)421:             DEALLOCATE(LTANVEC)
343:             ALLOCATE(LTANVEC(2*MYTSMAX,NOPT))422:             ALLOCATE(LTANVEC(2*MYTSMAX,3*NATOMS))
344:             LTANVEC(1:MYTSMAX,1:NOPT)=TSTEMP(1:MYTSMAX,1:NOPT)423:             LTANVEC(1:MYTSMAX,1:3*NATOMS)=TSTEMP(1:MYTSMAX,1:3*NATOMS)
345:             DEALLOCATE(TSTEMP)424:             DEALLOCATE(TSTEMP)
346:             MYTSMAX=2*MYTSMAX425:             MYTSMAX=2*MYTSMAX
347:          ENDIF426:          ENDIF
348:          PRINT '(3(A,I6),A,G20.10)',' contslocator> adding ts candidate at position ',1,' between images ',I,' and ',I+1, &427:          PRINT '(3(A,I6),A,G20.10)',' contslocator> adding ts candidate at position ',1,' between images ',I,' and ',I+1, &
349:   &                               ' E=',ELOCAL(1)428:   &                               ' E=',ELOCAL(1)
350:          TSGUESS(NTS,1:NOPT)=XYZ((I-1)*NOPT+1:I*NOPT)429:          TSGUESS(NTS,1:3*NATOMS)=XYZ((I-1)*NOPT+1:I*NOPT)
351:          LTANVEC(NTS,1:NOPT)=XYZ((I-1)*NOPT+1:I*NOPT)-XYZ(I*NOPT+1:(I+1)*NOPT)430:          LTANVEC(NTS,1:3*NATOMS)=XYZ((I-1)*NOPT+1:I*NOPT)-XYZ(I*NOPT+1:(I+1)*NOPT)
352:       ENDIF431:       ENDIF
353:       DO J2=2,NIMAGE+1 432:       DO J2=2,NIMAGE+1 
354:          IF ( (ELOCAL(J2-1).LT.ELOCAL(J2)) .AND. (ELOCAL(J2).GT.ELOCAL(J2+1)) ) THEN433:          IF ( (ELOCAL(J2-1).LT.ELOCAL(J2)) .AND. (ELOCAL(J2).GT.ELOCAL(J2+1)) ) THEN
355:             NTS=NTS+1434:             NTS=NTS+1
356:             IF (NTS.GT.MYTSMAX) THEN ! increase stor