hdiff output

r33421/lopermdist.f90 2017-10-27 12:31:38.455738243 +0100 r33420/lopermdist.f90 2017-10-27 12:31:38.679741179 +0100
 41: INTEGER, PARAMETER :: MAXIMUMTRIES=10 41: INTEGER, PARAMETER :: MAXIMUMTRIES=10
 42: INTEGER NATOMS, NPERM, PATOMS, NRB, OPNUM,  NORBIT1, NORBIT2, NCHOOSE2, NCHOOSE1, NTRIES, NORBITB1, NORBITB2, NMOVE 42: INTEGER NATOMS, NPERM, PATOMS, NRB, OPNUM,  NORBIT1, NORBIT2, NCHOOSE2, NCHOOSE1, NTRIES, NORBITB1, NORBITB2, NMOVE
 43: INTEGER J3, J4, NDUMMY, LPERM(NATOMS), J1, J2, NOTHER, LPERMBEST(NATOMS), NCHOOSEB1, NCHOOSEB2, & 43: INTEGER J3, J4, NDUMMY, LPERM(NATOMS), J1, J2, NOTHER, LPERMBEST(NATOMS), NCHOOSEB1, NCHOOSEB2, &
 44:         LPERMBESTATOM(NATOMS) 44:         LPERMBESTATOM(NATOMS)
 45: DOUBLE PRECISION DIST2, COORDSA(3*NATOMS), COORDSB(3*NATOMS), DISTANCE, DUMMYA(3*NATOMS), & 45: DOUBLE PRECISION DIST2, COORDSA(3*NATOMS), COORDSB(3*NATOMS), DISTANCE, DUMMYA(3*NATOMS), &
 46:   &              BESTA(3*NATOMS), DUMMYB(3*NATOMS), DUMMY(3*NATOMS), DIST, DSUM 46:   &              BESTA(3*NATOMS), DUMMYB(3*NATOMS), DUMMY(3*NATOMS), DIST, DSUM
 47: DOUBLE PRECISION BOXLX,BOXLY,BOXLZ,WORSTRAD,RMAT(3,3),ENERGY, VNEW(3*NATOMS), DX, DY, DZ, RMS, DBEST, XBEST(3*NATOMS) 47: DOUBLE PRECISION BOXLX,BOXLY,BOXLZ,WORSTRAD,RMAT(3,3),ENERGY, VNEW(3*NATOMS), DX, DY, DZ, RMS, DBEST, XBEST(3*NATOMS)
 48: DOUBLE PRECISION CMXA, CMXB, CMXC, QBEST(4), SITESA(3*NTSITES), SITESB(3*NTSITES) 48: DOUBLE PRECISION CMXA, CMXB, CMXC, QBEST(4), SITESA(3*NTSITES), SITESB(3*NTSITES)
 49: DOUBLE PRECISION ROTA(3,3), ROTINVA(3,3), ROTB(3,3), ROTINVB(3,3), RMATBEST(3,3), TMAT(3,3) 49: DOUBLE PRECISION ROTA(3,3), ROTINVA(3,3), ROTB(3,3), ROTINVB(3,3), RMATBEST(3,3), TMAT(3,3)
 50: DOUBLE PRECISION PVEC(3), RTEMP1(3,3), RTEMP2(3,3) 50: DOUBLE PRECISION PVEC(3), RTEMP1(3,3), RTEMP2(3,3)
 51: LOGICAL DEBUG, TWOD, RIGID, BULKT, PITEST, AOK, BOK, ADDED, PERMUTABLE(NATOMS), USEATOM 51: LOGICAL DEBUG, TWOD, RIGID, BULKT, PITEST, AOK, BOK, ADDED, PERMUTABLE(NATOMS)
 52: DOUBLE PRECISION PDUMMYA(3*NATOMS), PDUMMYB(3*NATOMS), LDISTANCE, DUMMYC(3*NATOMS), XDUMMY, DUMMYD(3*NATOMS), & 52: DOUBLE PRECISION PDUMMYA(3*NATOMS), PDUMMYB(3*NATOMS), LDISTANCE, DUMMYC(3*NATOMS), XDUMMY, DUMMYD(3*NATOMS), &
 53:    &             LDBEST(NPERMGROUP), LDBESTATOM 53:    &             LDBEST(NPERMGROUP), LDBESTATOM
 54: DOUBLE PRECISION SPDUMMYA(3*NATOMS), SPDUMMYB(3*NATOMS), AINIT, BINIT 54: DOUBLE PRECISION SPDUMMYA(3*NATOMS), SPDUMMYB(3*NATOMS), AINIT, BINIT
 55: INTEGER NEWPERM(NATOMS), ALLPERM(NATOMS), SAVEPERM(NATOMS) 55: INTEGER NEWPERM(NATOMS), ALLPERM(NATOMS), SAVEPERM(NATOMS)
 56: DOUBLE PRECISION TIME0, TIME1 56: DOUBLE PRECISION TIME0, TIME1
 57: DOUBLE PRECISION, ALLOCATABLE :: TEMPA(:), TEMPB(:) 57: DOUBLE PRECISION, ALLOCATABLE :: TEMPA(:), TEMPB(:)
 58: CHARACTER(LEN=5) ZSYMSAVE 58: CHARACTER(LEN=5) ZSYMSAVE
 59: COMMON /SYS/ ZSYMSAVE 59: COMMON /SYS/ ZSYMSAVE
 60: DOUBLE PRECISION XA, XB, YA, YB, ZA, ZB, DMEAN(NATOMS), DA, DB 60: DOUBLE PRECISION XA, XB, YA, YB, ZA, ZB, DMEAN(NATOMS), DA, DB
 61: INTEGER TRIED(NATOMS), DLIST(NATOMS), SORTLIST(NATOMS), NDUMMY2, INGROUP(NATOMS), NADDED, DOGROUP, NDMEAN 61: INTEGER TRIED(NATOMS), DLIST(NATOMS), SORTLIST(NATOMS), NDUMMY2, INGROUP(NATOMS), NADDED, DOGROUP
 62:  62: 
 63: IF (DEBUG.AND.(DOGROUP.EQ.0)) THEN 63: IF (DEBUG.AND.(DOGROUP.EQ.0)) THEN
 64:    IF (CHRMMT) CALL UPDATENBONDS(COORDSA) 64:    IF (CHRMMT) CALL UPDATENBONDS(COORDSA)
 65:    CALL POTENTIAL(COORDSA,AINIT,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.) 65:    CALL POTENTIAL(COORDSA,AINIT,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)
 66:    WRITE(*,'(2(A,G25.15))') ' initial energy for structure A=             ',AINIT,' RMS=',RMS 66:    WRITE(*,'(2(A,G25.15))') ' initial energy for structure A=             ',AINIT,' RMS=',RMS
 67:    IF (RMS-MAX(GMAX,CONVR).GT.1.0D-6) THEN 67:    IF (RMS-MAX(GMAX,CONVR).GT.1.0D-6) THEN
 68:       WRITE(*,'(A)') ' lopermdist> WARNING *** RMS for structure A is outside tolerance' 68:       WRITE(*,'(A)') ' lopermdist> WARNING *** RMS for structure A is outside tolerance'
 69:    ENDIF 69:    ENDIF
 70:    IF (CHRMMT) CALL UPDATENBONDS(COORDSB) 70:    IF (CHRMMT) CALL UPDATENBONDS(COORDSB)
 71:    CALL POTENTIAL(COORDSB,BINIT,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.) 71:    CALL POTENTIAL(COORDSB,BINIT,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)
153: !153: !
154: ! TRIED(J2) is 0 if atom J2 is eligible to be a neighbour, but has not154: ! TRIED(J2) is 0 if atom J2 is eligible to be a neighbour, but has not
155: ! yet been tried. It is -1 if it is ineligible, or has been tried and155: ! yet been tried. It is -1 if it is ineligible, or has been tried and
156: ! broke the alignment. It is +1 if it has been tried and did not break156: ! broke the alignment. It is +1 if it has been tried and did not break
157: ! the alignment. It is -1 for atoms already in the set of permutable157: ! the alignment. It is -1 for atoms already in the set of permutable
158: ! atoms in question. We add neighbours one at a time in order of 158: ! atoms in question. We add neighbours one at a time in order of 
159: ! increasing distance from primary permutable set159: ! increasing distance from primary permutable set
160: ! and test whether they break the alignment.160: ! and test whether they break the alignment.
161: !161: !
162:    DMEAN(1:NATOMS)=1.0D10162:    DMEAN(1:NATOMS)=1.0D10
163:    NDMEAN=0 
164: !163: !
165: ! Make a sorted list of distance from the permuting atoms.164: ! Make a sorted list of distance from the permuting atoms.
166: ! DMEAN, SORTLIST, TRIED, PERMUTABLE, and DLIST entries refer to original165: ! DMEAN, SORTLIST, TRIED, PERMUTABLE, and DLIST entries refer to original
167: ! atom labels. Use NEWPERM to find where they are in coordinate lists.166: ! atom labels. Use NEWPERM to find where they are in coordinate lists.
168: !167: !
169:    outer1: DO J2=1,NATOMS168:    outer1: DO J2=1,NATOMS
170:       USEATOM=.TRUE. 
171:       IF (DOGROUP.GT.0) THEN 
172:          IF (.NOT.ATOMACTIVE(J2)) USEATOM=.FALSE. ! must not attempt to access atomactive unless DOGROUP.GT.0 - not allocated! 
173:       ENDIF 
174: !169: !
175: ! Don't allow members of the same permutational group 170: ! Don't allow members of the same permutational group 
176: ! to appear as reference neighbours.171: ! to appear as reference neighbours.
177: !172: !
178:       IF (TRIED(J2).EQ.-1) THEN173:       IF (TRIED(J2).EQ.-1) THEN
179:          XDUMMY=1.0D9174:          XDUMMY=1.0D9
180:          CYCLE outer1 
181:       ELSE175:       ELSE
182:          IF (.NOT.USEATOM) THEN ! only use active atoms for QCI single group176:          IF ((DOGROUP.GT.0).AND.(.NOT.ATOMACTIVE(J2))) THEN ! only use active atoms for QCI single group
183:             XDUMMY=1.0D9177:             XDUMMY=1.0D9
184:             CYCLE outer1 
185:          ELSE178:          ELSE
186:             DA=(XA-DUMMYA(3*(NEWPERM(J2)-1)+1))**2 &179:             DA=(XA-DUMMYA(3*(NEWPERM(J2)-1)+1))**2 &
187:   &           +(YA-DUMMYA(3*(NEWPERM(J2)-1)+2))**2 &180:   &           +(YA-DUMMYA(3*(NEWPERM(J2)-1)+2))**2 &
188:   &           +(ZA-DUMMYA(3*(NEWPERM(J2)-1)+3))**2181:   &           +(ZA-DUMMYA(3*(NEWPERM(J2)-1)+3))**2
189: !           DB=(XB-DUMMYB(3*(NEWPERM(J2)-1)+1))**2 &182: !           DB=(XB-DUMMYB(3*(NEWPERM(J2)-1)+1))**2 &
190: ! &           +(YB-DUMMYB(3*(NEWPERM(J2)-1)+2))**2 &183: ! &           +(YB-DUMMYB(3*(NEWPERM(J2)-1)+2))**2 &
191: ! &           +(ZB-DUMMYB(3*(NEWPERM(J2)-1)+3))**2184: ! &           +(ZB-DUMMYB(3*(NEWPERM(J2)-1)+3))**2
192:             DB=(XB-DUMMYB(3*(J2-1)+1))**2 &185:             DB=(XB-DUMMYB(3*(J2-1)+1))**2 &
193:   &           +(YB-DUMMYB(3*(J2-1)+2))**2 &186:   &           +(YB-DUMMYB(3*(J2-1)+2))**2 &
194:   &           +(ZB-DUMMYB(3*(J2-1)+3))**2187:   &           +(ZB-DUMMYB(3*(J2-1)+3))**2
195:             XDUMMY=(SQRT(DA)+SQRT(DB))/2.0D0188:             XDUMMY=(SQRT(DA)+SQRT(DB))/2.0D0
196:             IF (XDUMMY.GT.LOCALPERMCUT2) CYCLE outer1 
197:          ENDIF189:          ENDIF
198:       ENDIF190:       ENDIF
199:       NDMEAN=NDMEAN+1191:       loop1: DO J3=1,J2
200:       loop1: DO J3=1,NDMEAN ! J2 
201:          IF (XDUMMY.LT.DMEAN(J3)) THEN192:          IF (XDUMMY.LT.DMEAN(J3)) THEN
202: !193: !
203: ! Move the rest down.194: ! Move the rest down.
204: !195: !
205:             DO J4=NDMEAN,J3+1,-1  !  J2,J3+1,-1196:             DO J4=J2,J3+1,-1
206:                DMEAN(J4)=DMEAN(J4-1)197:                DMEAN(J4)=DMEAN(J4-1)
207:                SORTLIST(J4)=SORTLIST(J4-1)198:                SORTLIST(J4)=SORTLIST(J4-1)
208:             ENDDO199:             ENDDO
209:             DMEAN(J3)=XDUMMY200:             DMEAN(J3)=XDUMMY
210:             SORTLIST(J3)=J2201:             SORTLIST(J3)=J2
211:             EXIT loop1202:             EXIT loop1
212:          ENDIF203:          ENDIF
213:       ENDDO loop1204:       ENDDO loop1
214:    ENDDO outer1205:    ENDDO outer1
215: 206: 
468: !  PRINT '(20I6)',NEWPERM(1:NATOMS)459: !  PRINT '(20I6)',NEWPERM(1:NATOMS)
469: 460: 
470: !461: !
471: ! Update NDUMMY, the cumulative offset for PERMGROUP462: ! Update NDUMMY, the cumulative offset for PERMGROUP
472: !463: !
473: 864   NDUMMY=NDUMMY+NPERMSIZE(J1)464: 864   NDUMMY=NDUMMY+NPERMSIZE(J1)
474: ENDDO  !  end of loop over groups of permutable atoms465: ENDDO  !  end of loop over groups of permutable atoms
475: 466: 
476: IF (DOGROUP.GT.0) THEN467: IF (DOGROUP.GT.0) THEN
477:    DISTANCE=SQRT(LDBEST(DOGROUP))468:    DISTANCE=SQRT(LDBEST(DOGROUP))
478:    IF (DEBUG) THEN469:    NMOVE=0
479:       NMOVE=0470:    DO J2=1,NATOMS
480:       DO J2=1,NATOMS471:       IF (NEWPERM(J2).NE.J2) THEN
481:          IF (NEWPERM(J2).NE.J2) THEN472: !        WRITE(*,'(A,I6,A,I6)') ' lopermdist> need to move atom ',NEWPERM(J2),' to position ',J2
482: !           WRITE(*,'(A,I6,A,I6)') ' lopermdist> need to move atom ',NEWPERM(J2),' to position ',J2473:          NMOVE=NMOVE+1
483:             NMOVE=NMOVE+1474:       ENDIF
484:          ENDIF475:    ENDDO
485:       ENDDO476: !  PRINT '(A,I6,A,I6)',' lopermdist> Total permutations (not applied!) for optimal alignment of group ',DOGROUP,' is ',NMOVE
486: !     PRINT '(A,I6,A,I6)',' lopermdist> Total permutations (not applied!) for optimal alignment of group ',DOGROUP,' is ',NMOVE 
487:    ENDIF 
488:    RETURN477:    RETURN
489: ENDIF478: ENDIF
490: NMOVE=0479: NMOVE=0
491: ! DO J2=1,NATOMS480: ! DO J2=1,NATOMS
492: !    IF (NEWPERM(J2).NE.J2) THEN481: !    IF (NEWPERM(J2).NE.J2) THEN
493: !       WRITE(*,'(A,I6,A,I6)') ' lopermdist> need to move atom ',NEWPERM(J2),' to position ',J2482: !       WRITE(*,'(A,I6,A,I6)') ' lopermdist> need to move atom ',NEWPERM(J2),' to position ',J2
494: !       NMOVE=NMOVE+1483: !       NMOVE=NMOVE+1
495: !    ENDIF484: !    ENDIF
496: ! ENDDO485: ! ENDDO
497:   IF (DEBUG) PRINT '(A,I6)',' lopermdist> Total permutations for optimal alignment (will be applied)=',NMOVE486:   IF (DEBUG) PRINT '(A,I6)',' lopermdist> Total permutations for optimal alignment (will be applied)=',NMOVE


legend
Lines Added 
Lines changed
 Lines Removed

hdiff - version: 2.1.0