hdiff output

r31912/ncutils.f90 2017-02-14 14:30:12.882036693 +0000 r31911/ncutils.f90 2017-02-14 14:30:13.462044486 +0000
597: ! as atoms in the following subroutine. 597: ! as atoms in the following subroutine. 
598: ! A good solution would probably be to define an unambiguous sense for the598: ! A good solution would probably be to define an unambiguous sense for the
599: ! dipoles so that this problem doesn't arise. It could also cause problems599: ! dipoles so that this problem doesn't arise. It could also cause problems
600: ! in recognising identical minima.600: ! in recognising identical minima.
601: !601: !
602: ! Merges path output files to produce full pathway for the rearrangement;602: ! Merges path output files to produce full pathway for the rearrangement;
603: ! frames in path are reversed as needed;603: ! frames in path are reversed as needed;
604: !604: !
605:      SUBROUTINE MERGEXYZEOFS  605:      SUBROUTINE MERGEXYZEOFS  
606:           USE KEY, ONLY: FILTH,UNRST,FILTHSTR,RIGIDBODY,BULKT,TWOD,STOCKT,STOCKAAT,RBAAT,PERMDIST, MIEFT, &606:           USE KEY, ONLY: FILTH,UNRST,FILTHSTR,RIGIDBODY,BULKT,TWOD,STOCKT,STOCKAAT,RBAAT,PERMDIST, MIEFT, &
607:   &                      AMHT,SEQ,NTSITES,NENDDUP, GTHOMSONT, PAPT, NFREEZE, VARIABLES, NOTRANSROTT, PYGPERIODICT ! hk286607:   &                      AMHT,SEQ,NTSITES,NENDDUP, GTHOMSONT, PAPT, NFREEZE, VARIABLES, NOTRANSROTT ! hk286
608:           USE KEYUTILS        ! frames in bits that are glued together are rotated accordingly;608:           USE KEYUTILS        ! frames in bits that are glued together are rotated accordingly;
609:           USE KEYCONNECT,ONLY : NCNSTEPS609:           USE KEYCONNECT,ONLY : NCNSTEPS
610:           USE COMMONS,ONLY : PARAM1,PARAM2,PARAM3,DEBUG610:           USE COMMONS,ONLY : PARAM1,PARAM2,PARAM3,DEBUG
611:           USE AMHGLOBALS, ONLY : NMRES611:           USE AMHGLOBALS, ONLY : NMRES
612: 612: 
613:           IMPLICIT NONE       ! prerequisites: chain of min/ts constructed; assumes path is dumping plus side of the path613:           IMPLICIT NONE       ! prerequisites: chain of min/ts constructed; assumes path is dumping plus side of the path
614:                               ! first, and there are no blank lines after last frame (!)614:                               ! first, and there are no blank lines after last frame (!)
615:                               ! does somewhat similar with EofS.ts files as well..615:                               ! does somewhat similar with EofS.ts files as well..
616:           DOUBLE PRECISION RMAT(3,3), Q2(4)616:           DOUBLE PRECISION RMAT(3,3), Q2(4)
617:           INTEGER :: I,J,K,EOF,J1,J2,INDEXTS !,FL617:           INTEGER :: I,J,K,EOF,J1,J2,INDEXTS !,FL
962:                                  J2 = 3*J1962:                                  J2 = 3*J1
963:                                  TMP%Q(J2-2:J2) = MATMUL(RMATBEST,TMP%Q(J2-2:J2))963:                                  TMP%Q(J2-2:J2) = MATMUL(RMATBEST,TMP%Q(J2-2:J2))
964:                               ENDDO964:                               ENDDO
965:                            ELSE965:                            ELSE
966:                               CALL RBROT(TMP%Q,X,Q2,NATOMS)966:                               CALL RBROT(TMP%Q,X,Q2,NATOMS)
967:                               TMP%Q(1:NOPT) = X(1:NOPT) 967:                               TMP%Q(1:NOPT) = X(1:NOPT) 
968:                            ENDIF968:                            ENDIF
969:                         ENDIF969:                         ENDIF
970:                         IF (STOCKAAT) THEN970:                         IF (STOCKAAT) THEN
971:                            CALL STFRAME(TMP%COMMENT,XS,XV)971:                            CALL STFRAME(TMP%COMMENT,XS,XV)
972:                         ELSE IF (PYGPERIODICT) THEN 
973:                            CALL PYFRAME(TMP%COMMENT,TMP%Q,XV) 
974:                         ELSE972:                         ELSE
975:                            CALL RBFRAME(TMP%COMMENT,XS,TMP%Q,RMATBEST)973:                            CALL RBFRAME(TMP%COMMENT,XS,TMP%Q,RMATBEST)
976:                         ENDIF974:                         ENDIF
977: 975: 
978: ! hk286 - fix this (?)976: ! hk286 - fix this (?)
979:                      ELSEIF (GTHOMSONT) THEN977:                      ELSEIF (GTHOMSONT) THEN
980:                         IF ((I>1.AND.K>1).AND.(.NOT.UNRST)) THEN978:                         IF ((I>1.AND.K>1).AND.(.NOT.UNRST)) THEN
981:                            CALL GTHOMSONANGTOC(TMPCOORDS(1:3*NATOMS), TMP%Q(1:3*NATOMS), NATOMS)979:                            CALL GTHOMSONANGTOC(TMPCOORDS(1:3*NATOMS), TMP%Q(1:3*NATOMS), NATOMS)
982:                            CALL NEWROTGEOM(NATOMS, TMPCOORDS, RMAT, 0.0D0, 0.0D0, 0.0D0) 980:                            CALL NEWROTGEOM(NATOMS, TMPCOORDS, RMAT, 0.0D0, 0.0D0, 0.0D0) 
983:                            CALL GTHOMSONCTOANG(TMPCOORDS(1:3*NATOMS), TMP%Q(1:3*NATOMS), NATOMS, 0)981:                            CALL GTHOMSONCTOANG(TMPCOORDS(1:3*NATOMS), TMP%Q(1:3*NATOMS), NATOMS, 0)
1151:                                  J2 = 3*J11149:                                  J2 = 3*J1
1152:                                  TMP%Q(J2-2:J2) = MATMUL(RMATBEST,TMP%Q(J2-2:J2))1150:                                  TMP%Q(J2-2:J2) = MATMUL(RMATBEST,TMP%Q(J2-2:J2))
1153:                               ENDDO1151:                               ENDDO
1154:                            ELSE1152:                            ELSE
1155:                               CALL RBROT(TMP%Q,X,Q2,NATOMS)1153:                               CALL RBROT(TMP%Q,X,Q2,NATOMS)
1156:                               TMP%Q(1:NOPT) = X(1:NOPT) 1154:                               TMP%Q(1:NOPT) = X(1:NOPT) 
1157:                            ENDIF1155:                            ENDIF
1158:                         ENDIF1156:                         ENDIF
1159:                         IF (STOCKAAT) THEN1157:                         IF (STOCKAAT) THEN
1160:                            CALL STFRAME(TMP%COMMENT,XS,XV)1158:                            CALL STFRAME(TMP%COMMENT,XS,XV)
1161:                         ELSE IF (PYGPERIODICT) THEN 
1162:                            CALL PYFRAME(TMP%COMMENT,TMP%Q,XV) 
1163:                         ELSE1159:                         ELSE
1164:                            CALL RBFRAME(TMP%COMMENT,XS,TMP%Q,RMATBEST)1160:                            CALL RBFRAME(TMP%COMMENT,XS,TMP%Q,RMATBEST)
1165:                         ENDIF                    1161:                         ENDIF                    
1166: ! hk286 - fix this1162: ! hk286 - fix this
1167:                      ELSEIF (GTHOMSONT) THEN1163:                      ELSEIF (GTHOMSONT) THEN
1168:                         IF ((I>1.AND.K>1).AND.(.NOT.UNRST)) THEN1164:                         IF ((I>1.AND.K>1).AND.(.NOT.UNRST)) THEN
1169:                            CALL GTHOMSONANGTOC(TMPCOORDS(1:3*NATOMS), TMP%Q(1:3*NATOMS), NATOMS)1165:                            CALL GTHOMSONANGTOC(TMPCOORDS(1:3*NATOMS), TMP%Q(1:3*NATOMS), NATOMS)
1170:                            CALL NEWROTGEOM(NATOMS, TMPCOORDS, RMAT, CMXA, CMYA, CMZA) 1166:                            CALL NEWROTGEOM(NATOMS, TMPCOORDS, RMAT, CMXA, CMYA, CMZA) 
1171:                            CALL GTHOMSONCTOANG(TMPCOORDS(1:3*NATOMS), TMP%Q(1:3*NATOMS), NATOMS, 0)1167:                            CALL GTHOMSONCTOANG(TMPCOORDS(1:3*NATOMS), TMP%Q(1:3*NATOMS), NATOMS, 0)
1172:                         ENDIF1168:                         ENDIF
1293:              DUMMY=>DUMMY%NEXT1289:              DUMMY=>DUMMY%NEXT
1294:              I=I+11290:              I=I+1
1295:           ENDDO1291:           ENDDO
1296:           DEALLOCATE(LASTFRAME)1292:           DEALLOCATE(LASTFRAME)
1297:           CLOSE(50)1293:           CLOSE(50)
1298:           IF (RBAAT) CLOSE(55)1294:           IF (RBAAT) CLOSE(55)
1299:           CLOSE(41)1295:           CLOSE(41)
1300:      END SUBROUTINE MERGEXYZEOFS1296:      END SUBROUTINE MERGEXYZEOFS
1301: 1297: 
1302:      SUBROUTINE WRITEFRAME(C,S,Q)1298:      SUBROUTINE WRITEFRAME(C,S,Q)
1303:           USE KEY,ONLY : STOCKT, RBAAT, STOCKAAT, NTSITES, PAIRCOLOURT, GTHOMSONT, VARIABLES, PYA1BIN, PYGPERIODICT1299:           USE KEY,ONLY : STOCKT, RBAAT, STOCKAAT, NTSITES, PAIRCOLOURT, GTHOMSONT, VARIABLES
1304:           IMPLICIT NONE1300:           IMPLICIT NONE
1305: 1301: 
1306:           CHARACTER(LEN=132),INTENT(IN)         :: C1302:           CHARACTER(LEN=132),INTENT(IN)         :: C
1307:           CHARACTER(LEN=5),POINTER,DIMENSION(:) :: S1303:           CHARACTER(LEN=5),POINTER,DIMENSION(:) :: S
1308:           DOUBLE PRECISION,POINTER,DIMENSION(:) :: Q1304:           DOUBLE PRECISION,POINTER,DIMENSION(:) :: Q
1309:           DOUBLE PRECISION SITES(3*NTSITES), P(3), RM(3,3)1305:           DOUBLE PRECISION SITES(3*NTSITES), P(3), RM(3,3)
1310:           CHARACTER(LEN=2) ZSTRING(NATOMS)1306:           CHARACTER(LEN=2) ZSTRING(NATOMS)
1311: 1307: 
1312:           INTEGER :: J1308:           INTEGER :: J
1313:           DOUBLE PRECISION :: TMPCOORDS(9*NATOMS/2), EulerPhiDeg, EulerPsiDeg, EulerThetaDeg1309:           DOUBLE PRECISION :: TMPCOORDS(9*NATOMS/2)
1314:           IF (STOCKT) THEN1310:           IF (STOCKT) THEN
1315:              WRITE(50,'(I6)') (NATOMS/2)1311:              WRITE(50,'(I6)') (NATOMS/2)
1316:              WRITE(50,'(1X,A)') TRIM(ADJUSTL(C))1312:              WRITE(50,'(1X,A)') TRIM(ADJUSTL(C))
1317:              DO J=1,(NATOMS/2)1313:              DO J=1,(NATOMS/2)
1318:                 WRITE(50,'(A5,1X,6F20.10)') S(J),Q(3*(J-1)+1),Q(3*(J-1)+2),Q(3*(J-1)+3), &1314:                 WRITE(50,'(A5,1X,6F20.10)') S(J),Q(3*(J-1)+1),Q(3*(J-1)+2),Q(3*(J-1)+3), &
1319:   &                             Q(3*((NATOMS/2)+J-1)+1),Q(3*((NATOMS/2)+J-1)+2),Q(3*((NATOMS/2)+J-1)+3)1315:   &                             Q(3*((NATOMS/2)+J-1)+1),Q(3*((NATOMS/2)+J-1)+2),Q(3*((NATOMS/2)+J-1)+3)
1320:              ENDDO1316:              ENDDO
1321: !          ELSE IF (RBAAT) THEN1317: !          ELSE IF (RBAAT) THEN
1322: !                WRITE(50,'(I6)') (NATOMS/2)1318: !                WRITE(50,'(I6)') (NATOMS/2)
1323: !                WRITE(50,'(1X,A)') TRIM(ADJUSTL(C))1319: !                WRITE(50,'(1X,A)') TRIM(ADJUSTL(C))
1324: !                WRITE(55,'(I6)') NTSITES1320: !                WRITE(55,'(I6)') NTSITES
1325: !                WRITE(55,'(1X,A)') TRIM(ADJUSTL(C))1321: !                WRITE(55,'(1X,A)') TRIM(ADJUSTL(C))
1326: !                DO J=1,(NATOMS/2)1322: !                DO J=1,(NATOMS/2)
1327: !                   WRITE(50,'(A5,1X,6F20.10)') S(J),Q(3*(J-1)+1),Q(3*(J-1)+2),Q(3*(J-1)+3), &1323: !                   WRITE(50,'(A5,1X,6F20.10)') S(J),Q(3*(J-1)+1),Q(3*(J-1)+2),Q(3*(J-1)+3), &
1328: !  &                             Q(3*((NATOMS/2)+J-1)+1),Q(3*((NATOMS/2)+J-1)+2),Q(3*((NATOMS/2)+J-1)+3)1324: !  &                             Q(3*((NATOMS/2)+J-1)+1),Q(3*((NATOMS/2)+J-1)+2),Q(3*((NATOMS/2)+J-1)+3)
1329: !                ENDDO1325: !                ENDDO
1330: !                CALL SITEPOS(Q,SITES)1326: !                CALL SITEPOS(Q,SITES)
1331: !                DO J=1,NTSITES1327: !                DO J=1,NTSITES
1332: !                   WRITE(55,'(A5,1X,3F20.10)') 'LA ',SITES(3*(J-1)+1),SITES(3*(J-1)+2),SITES(3*(J-1)+3)1328: !                   WRITE(55,'(A5,1X,3F20.10)') 'LA ',SITES(3*(J-1)+1),SITES(3*(J-1)+2),SITES(3*(J-1)+3)
1333: !                ENDDO1329: !                ENDDO
1334:           ELSEIF (PYGPERIODICT) THEN1330: 
1335:              WRITE(50,'(I6)') (NATOMS/2) 
1336:              WRITE(50,'(1X,A)') TRIM(ADJUSTL(C)) 
1337:                  CALL AAtoEuler(Q(3*NATOMS/2+3*(J-1)+1),Q(3*NATOMS/2+3*(J-1)+2),& 
1338:                       Q(3*NATOMS/2+3*(J-1)+3),EulerPhiDeg,EulerPsiDeg,EulerThetaDeg) 
1339:              DO J = 1, NATOMS/2 
1340:                  WRITE(50,'(a5,2x,3f20.10,2x,a8,6f15.8,2x,a11,3f15.8)') 'O',Q(3*(J-1)+1),& 
1341:                       Q(3*(J-1)+2),Q(3*(J-1)+3),& 
1342:                       'ellipse ',PYA1BIN(J,1)*2.0D0,PYA1BIN(J,2)*2.0D0,PYA1BIN(J,3)*2.0D0,EulerPhiDeg,EulerPsiDeg,EulerThetaDeg,& 
1343:                       'atom_vector',Q(3*NATOMS/2+3*(J-1)+1),& 
1344:                       Q(3*NATOMS/2+3*(J-1)+2),Q(3*NATOMS/2+3*(J-1)+3) 
1345:              END DO 
1346:           ELSEIF (GTHOMSONT) THEN1331:           ELSEIF (GTHOMSONT) THEN
1347:              WRITE(50,'(I6)') (NATOMS)1332:              WRITE(50,'(I6)') (NATOMS)
1348:              WRITE(50,'(1X,A)') TRIM(ADJUSTL(C))1333:              WRITE(50,'(1X,A)') TRIM(ADJUSTL(C))
1349:              CALL GTHOMSONANGTOC(TMPCOORDS(1:3*NATOMS), Q(1:3*NATOMS), NATOMS)1334:              CALL GTHOMSONANGTOC(TMPCOORDS(1:3*NATOMS), Q(1:3*NATOMS), NATOMS)
1350:              DO J = 1, NATOMS1335:              DO J = 1, NATOMS
1351:                 WRITE(50,'(A5,1X,3F20.10)') S(1),TMPCOORDS(3*(J-1)+1),TMPCOORDS(3*(J-1)+2),TMPCOORDS(3*(J-1)+3)1336:                 WRITE(50,'(A5,1X,3F20.10)') S(1),TMPCOORDS(3*(J-1)+1),TMPCOORDS(3*(J-1)+2),TMPCOORDS(3*(J-1)+3)
1352:              ENDDO1337:              ENDDO
1353:           ELSE1338:           ELSE
1354:              WRITE(50,'(I6)') NATOMS1339:              WRITE(50,'(I6)') NATOMS
1355:              WRITE(50,'(1X,A)') TRIM(ADJUSTL(C))1340:              WRITE(50,'(1X,A)') TRIM(ADJUSTL(C))


r31912/rbperm.f90 2017-02-14 14:30:13.166040502 +0000 r31911/rbperm.f90 2017-02-14 14:30:13.746048290 +0000
1596: 1596: 
1597:       DO J1 = 1, NTSITES1597:       DO J1 = 1, NTSITES
1598:          J2 = J1*31598:          J2 = J1*3
1599:          WRITE(55,'(A5,1X,3F16.10,2X, A11,2X,3F16.10)') 'O ', XS(J2-2), XS(J2-1), XS(J2), 'atom_vector', XV(J2-2), XV(J2-1), XV(J2)1599:          WRITE(55,'(A5,1X,3F16.10,2X, A11,2X,3F16.10)') 'O ', XS(J2-2), XS(J2-1), XS(J2), 'atom_vector', XV(J2-2), XV(J2-1), XV(J2)
1600: 1600: 
1601:       ENDDO1601:       ENDDO
1602: 1602: 
1603:       END SUBROUTINE STFRAME1603:       END SUBROUTINE STFRAME
1604: 1604: 
1605: !     ----------------------------------------------------------------------------------------------1605: !     ----------------------------------------------------------------------------------------------
1606:       SUBROUTINE PYFRAME(C,XS,XV) 
1607:  
1608:       USE KEY, ONLY    : NTSITES,PYA1BIN 
1609:       USE COMMONS, ONLY : NATOMS 
1610:  
1611:       IMPLICIT NONE 
1612:        
1613:       INTEGER :: J1, J2 
1614:       CHARACTER(LEN=132),INTENT(IN) :: C 
1615:       DOUBLE PRECISION, INTENT(IN)  :: XS(3*NATOMS), XV(3*NATOMS/2) 
1616:       DOUBLE PRECISION :: EulerPhiDeg, EulerPsiDeg, EulerThetaDeg 
1617:  
1618:       WRITE(50,'(I6)') (NATOMS/2) 
1619:       WRITE(50,'(1X,A)') TRIM(ADJUSTL(C)) 
1620:  
1621:       DO J1 = 1, NATOMS/2 
1622:          J2 = J1*3 
1623:              CALL AAtoEuler(XS(J2-2), XS(J2-1), XS(J2),EulerPhiDeg,EulerPsiDeg,EulerThetaDeg) 
1624:                  WRITE(50,'(a5,2x,3f20.10,2x,a8,6f15.8,2x,a11,3f15.8)') 'O',XS(J2-2), XS(J2-1), XS(J2),  'ellipse ',& 
1625:                         PYA1BIN(J1,1)*2.0D0,PYA1BIN(J1,2)*2.0D0,PYA1BIN(J1,3)*2.0D0,EulerPhiDeg,EulerPsiDeg,EulerThetaDeg,& 
1626:                       'atom_vector',XS(3*NATOMS/2 + J2-2), XS(3*NATOMS/2 + J2-1), XS(3*NATOMS/2 + J2) 
1627:       ENDDO 
1628:  
1629:       END SUBROUTINE PYFRAME 
1630: 1606: 
1631:       SUBROUTINE RBROTMAT(T, X, ROTMAT, NTSITES)1607:       SUBROUTINE RBROTMAT(T, X, ROTMAT, NTSITES)
1632: !     takes the set of rigid-body coordinates T and returns X after rotation via the quaternion Q21608: !     takes the set of rigid-body coordinates T and returns X after rotation via the quaternion Q2
1633: !     about the origin1609: !     about the origin
1634:       USE KEY, ONLY : EFIELDT, MULTISITEPYT1610:       USE KEY, ONLY : EFIELDT, MULTISITEPYT
1635:       IMPLICIT NONE1611:       IMPLICIT NONE
1636: 1612: 
1637:       INTEGER          :: I, J, NTSITES1613:       INTEGER          :: I, J, NTSITES
1638:       DOUBLE PRECISION :: T(3*NTSITES), X(3*NTSITES), T1(1:3), ROTMAT(3,3) !jwmr2> unused, Q2(4)1614:       DOUBLE PRECISION :: T(3*NTSITES), X(3*NTSITES), T1(1:3), ROTMAT(3,3) !jwmr2> unused, Q2(4)
1639:       DOUBLE PRECISION :: CMX, CMY, CMZ1615:       DOUBLE PRECISION :: CMX, CMY, CMZ


legend
Lines Added 
Lines changed
 Lines Removed

hdiff - version: 2.1.0