hdiff output

r29792/commons.f90 2016-03-16 18:33:28.655010385 +0000 r29791/commons.f90 2016-03-16 18:33:31.515039794 +0000
 30:      &        lhbins, sampledbins, MYNODE, NENRPER, DUMPINT, MYUNIT, PRTFRQ, BSPTDUMPFRQ, NPERMGROUP, NMOVABLEATOMS, & 30:      &        lhbins, sampledbins, MYNODE, NENRPER, DUMPINT, MYUNIT, PRTFRQ, BSPTDUMPFRQ, NPERMGROUP, NMOVABLEATOMS, &
 31:      &        CPS, CPF, ACKLANDID, PATOM1, PATOM2, CSMGPINDEX, CSMGUIDEGPINDEX, CSMSTEPS, CSMQUENCHES, CSMMAXIT, & 31:      &        CPS, CPF, ACKLANDID, PATOM1, PATOM2, CSMGPINDEX, CSMGUIDEGPINDEX, CSMSTEPS, CSMQUENCHES, CSMMAXIT, &
 32:      &        MYEUNIT, MYMUNIT, MYBUNIT, MYRUNIT, MYPUNIT, NFREEZETYPEA, & 32:      &        MYEUNIT, MYMUNIT, MYBUNIT, MYRUNIT, MYPUNIT, NFREEZETYPEA, &
 33:      &        TBPSTEPS, TBPCI, TBPBASIN, NTSITES, NRBGROUP, NZERO, PTMCDS_FRQ, PTMCDUMPENERFRQ, MONITORINT, NBLOCKS, & 33:      &        TBPSTEPS, TBPCI, TBPBASIN, NTSITES, NRBGROUP, NZERO, PTMCDS_FRQ, PTMCDUMPENERFRQ, MONITORINT, NBLOCKS, &
 34:      &        BINARY_EXAB_FRQ, NRESMIN, USERES, EXEQ, NONEDAPBC, STRUC, CHEMSHIFTITER, GRIDSIZE, MFETRUNS, BESTINVERT, GCNATOMS, & 34:      &        BINARY_EXAB_FRQ, NRESMIN, USERES, EXEQ, NONEDAPBC, STRUC, CHEMSHIFTITER, GRIDSIZE, MFETRUNS, BESTINVERT, GCNATOMS, &
 35:      &        GCINT, GCRELAX, MTARGETS, & 35:      &        GCINT, GCRELAX, MTARGETS, &
 36:      &        INTCONSEP, INTREPSEP, NCONSTRAINTON, CPREPSEP, CPCONSEP, NCONGEOM, & 36:      &        INTCONSEP, INTREPSEP, NCONSTRAINTON, CPREPSEP, CPCONSEP, NCONGEOM, &
 37:      &        NCPREPULSIVE, NCPCONSTRAINT, MAXCONUSE, INTCONSTEPS, INTRELSTEPS, INTSTEPS1, INTLJSTEPS, & 37:      &        NCPREPULSIVE, NCPCONSTRAINT, MAXCONUSE, INTCONSTEPS, INTRELSTEPS, INTSTEPS1, INTLJSTEPS, &
 38:      &        NTRAPPOW, MAXINTIMAGE, CHECKREPINTERVAL, INTFREEZEMIN, INTNTRIESMAX, INTIMAGEINCR, & 38:      &        NTRAPPOW, MAXINTIMAGE, CHECKREPINTERVAL, INTFREEZEMIN, INTNTRIESMAX, INTIMAGEINCR, &
 39:      &        NCONSTRAINTFIX, INTIMAGECHECK, NREPULSIVEFIX, INTIMAGE, NREPULSIVE, & 39:      &        NCONSTRAINTFIX, INTIMAGECHECK, NREPULSIVEFIX, INTIMAGE, NREPULSIVE, &
 40:      &        NNREPULSIVE, NCONSTRAINT, INTMUPDATE, DUMPINTEOSFREQ, DUMPINTXYZFREQ, & 40:      &        NNREPULSIVE, NCONSTRAINT, INTMUPDATE, DUMPINTEOSFREQ, DUMPINTXYZFREQ
 41:      &        LOCALPERMNEIGH, LOCALPERMMAXSEP, MAXNACTIVE, QCIPERMCHECKINT, & 
 42:      &        MLPIN, MLPOUT, MLPHIDDEN, MLPDATA, NMLP 
 43:   41:  
 44:       DOUBLE PRECISION RHO, GAMMA, SIG, SCEPS, SCC, TOLB, T12FAC, XMOVERENORM, RESIZE, QTSALLIS, & 42:       DOUBLE PRECISION RHO, GAMMA, SIG, SCEPS, SCC, TOLB, T12FAC, XMOVERENORM, RESIZE, QTSALLIS, &
 45:      &                 CQMAX, RADIUS, BQMAX,  MAXBFGS, DECAYPARAM, SYMTOL1, SYMTOL2, SYMTOL3, SYMTOL4, SYMTOL5, PGSYMTOLS(3),& 43:      &                 CQMAX, RADIUS, BQMAX,  MAXBFGS, DECAYPARAM, SYMTOL1, SYMTOL2, SYMTOL3, SYMTOL4, SYMTOL5, PGSYMTOLS(3),&
 46:      &                 ECONV, TOLD, TOLE, SYMREM(120,3,3), GMAX, CUTOFF, PCUT, EXPFAC, EXPD, CENTX, CENTY, CENTZ, & 44:      &                 ECONV, TOLD, TOLE, SYMREM(120,3,3), GMAX, CUTOFF, PCUT, EXPFAC, EXPD, CENTX, CENTY, CENTZ, &
 47:      &                 BOXLX, BOXLY, BOXLZ, BOX3D(3), PCUTOFF, SUPSTEP, SQUEEZER, SQUEEZED, COOPCUT, STOCKMU, STOCKLAMBDA, & 45:      &                 BOXLX, BOXLY, BOXLZ, BOX3D(3), PCUTOFF, SUPSTEP, SQUEEZER, SQUEEZED, COOPCUT, STOCKMU, STOCKLAMBDA, &
 48:      &                 TFAC(3), RMS, TEMPS, SACCRAT, CEIG, PNEWJUMP, EAMP, DISTFAC, ODDCHARGE, COULQ, COULSWAP, & 46:      &                 TFAC(3), RMS, TEMPS, SACCRAT, CEIG, PNEWJUMP, EAMP, DISTFAC, ODDCHARGE, COULQ, COULSWAP, &
 49:      &                 COULTEMP, APP, AMM, APM, XQP, XQM, ALPHAP, ALPHAM, ZSTAR, K_COMP, DGUESS, GUIDECUT, EFAC,&  47:      &                 COULTEMP, APP, AMM, APM, XQP, XQM, ALPHAP, ALPHAM, ZSTAR, K_COMP, DGUESS, GUIDECUT, EFAC,& 
 50:      &                 TRENORM, HISTMIN, HISTMAX, HISTFAC, EPSSPHERE, FINALCUTOFF, SHELLPROB, RINGROTSCALE, & 48:      &                 TRENORM, HISTMIN, HISTMAX, HISTFAC, EPSSPHERE, FINALCUTOFF, SHELLPROB, RINGROTSCALE, &
 51:      &                 HISTFACMUL, HPERCENT, AVOIDDIST, MAXERISE, MAXEFALL, TSTART, MATDIFF, STICKYSIG, SDTOL, & 49:      &                 HISTFACMUL, HPERCENT, AVOIDDIST, MAXERISE, MAXEFALL, TSTART, MATDIFF, STICKYSIG, SDTOL, &
 52:      &                 MinimalTemperature, MaximalTemperature, SwapProb, hdistconstraint, COREFRAC, TSTAR, & 50:      &                 MinimalTemperature, MaximalTemperature, SwapProb, hdistconstraint, COREFRAC, TSTAR, &
 73:      &                 RHOCH10, RHOC20H, RHOCH20, ALPHACC, ALPHAHH, ALPHACH, DC6CC, DC6HH, DC6CH, KKJ, CCKJ, SYMFCTR, & 71:      &                 RHOCH10, RHOC20H, RHOCH20, ALPHACC, ALPHAHH, ALPHACH, DC6CC, DC6HH, DC6CH, KKJ, CCKJ, SYMFCTR, &
 74:      &                 GBANISOTROPYR,GBWELLDEPTHR,PARAMa1,PARAMb1,PARAMc1,PARAMa2,PARAMB2,PARAMc2,PSIGMA0(2),PEPSILON0,& 72:      &                 GBANISOTROPYR,GBWELLDEPTHR,PARAMa1,PARAMb1,PARAMc1,PARAMa2,PARAMB2,PARAMc2,PSIGMA0(2),PEPSILON0,&
 75:      &                 PEPSILON1(3),PSCALEFAC1(2),PSCALEFAC2(2),PYA11(3),PYA21(3),PYA12(3),PYA22(3), & 73:      &                 PEPSILON1(3),PSCALEFAC1(2),PSCALEFAC2(2),PYA11(3),PYA21(3),PYA12(3),PYA22(3), &
 76:      &                 PEPSILONATTR(2),PSIGMAATTR(2), PYOVERLAPTHRESH, PYCFTHRESH, LJSITECOORDS(3), & 74:      &                 PEPSILONATTR(2),PSIGMAATTR(2), PYOVERLAPTHRESH, PYCFTHRESH, LJSITECOORDS(3), &
 77:      &                 MSTART,MFINISH,MBSTART1,MBFINISH1,MBSTART2,MBFINISH2,MBHEIGHT1,MBHEIGHT2,ME1,ME2,ME3, & 75:      &                 MSTART,MFINISH,MBSTART1,MBFINISH1,MBSTART2,MBFINISH2,MBHEIGHT1,MBHEIGHT2,ME1,ME2,ME3, &
 78:      &                 BSPTQMAX, BSPTQMIN, PFORCE, CSMNORM, CSMGUIDENORM, CSMEPS, PERCCUT, & 76:      &                 BSPTQMAX, BSPTQMIN, PFORCE, CSMNORM, CSMGUIDENORM, CSMEPS, PERCCUT, &
 79:      &                 LOWESTE, PERTSTEP, GCPLUS, & 77:      &                 LOWESTE, PERTSTEP, GCPLUS, &
 80:      &                 KINT, INTFREEZETOL, IMSEPMIN, IMSEPMAX, CONCUTABS, CONCUTFRAC, & 78:      &                 KINT, INTFREEZETOL, IMSEPMIN, IMSEPMAX, CONCUTABS, CONCUTFRAC, &
 81:      &                 LPDGEOMDIFFTOL, INTCONFRAC, MAXCONE, INTRMSTOL, BFGSTSTOL, ORBITTOL, & 79:      &                 LPDGEOMDIFFTOL, INTCONFRAC, MAXCONE, INTRMSTOL, BFGSTSTOL, ORBITTOL, &
 82:      &                 INTCONSTRAINTTOL, INTCONSTRAINTDEL, RBCUTOFF, INTCONSTRAINTREP, INTCONSTRAINREPCUT, & 80:      &                 INTCONSTRAINTTOL, INTCONSTRAINTDEL, RBCUTOFF, INTCONSTRAINTREP, INTCONSTRAINREPCUT, &
 83:      &                 INTLJTOL, INTLJDEL, INTLJEPS, REPCON, INTDGUESS, CHECKREPCUTOFF, INTMINFAC, FREEZETOL, & 81:      &                 INTLJTOL, INTLJDEL, INTLJEPS, REPCON, INTDGUESS, CHECKREPCUTOFF, INTMINFAC, FREEZETOL
 84:      &                 LOCALPERMCUT, LOCALPERMCUT2, INTCONCUT, QCIRADSHIFT, MLPLAMBDA 
 85:  82: 
 86:       LOGICAL DEBUG, TARGET, MORSET, CUTT, SEEDT, CENT, TSALLIST, FREEZECORE, NEWJUMP, RENORM, CAPSID, FREEZE, & 83:       LOGICAL DEBUG, TARGET, MORSET, CUTT, SEEDT, CENT, TSALLIST, FREEZECORE, NEWJUMP, RENORM, CAPSID, FREEZE, &
 87:      &        OTPT, LJMFT, STRANDT, PAHT, SWT, MSTRANST, STOCKT, STICKYT, BLNT, MYSDT, FREEZERES, CENTXY, & 84:      &        OTPT, LJMFT, STRANDT, PAHT, SWT, MSTRANST, STOCKT, STICKYT, BLNT, MYSDT, FREEZERES, CENTXY, &
 88:      &        MSORIGT, SQUEEZET, PERIODIC, SCT, MSCT, MGUPTAT, RESIZET, TIP, RIGID, CALCQT, MPIT, JMT, LJCOULT, SETCENT, & 85:      &        MSORIGT, SQUEEZET, PERIODIC, SCT, MSCT, MGUPTAT, RESIZET, TIP, RIGID, CALCQT, MPIT, JMT, LJCOULT, SETCENT, &
 89:      &        SORTT, HIT, SAVEQ, PARALLELT, FIXD, RKMIN, BSMIN, PERMDIST, PERMOPT, BSWL, BSPT, BSPTRESTART, & 86:      &        SORTT, HIT, SAVEQ, PARALLELT, FIXD, RKMIN, BSMIN, PERMDIST, PERMOPT, BSWL, BSPT, BSPTRESTART, &
 90:      &        SYMMETRIZE, SYMMETRIZECSM, PRINT_PTGRP, DUMPT, NEON, ARGON, P46, NORESET, TABOOT, EVSTEPT, PACHECO, DL_POLY, QUCENTRE, & 87:      &        SYMMETRIZE, SYMMETRIZECSM, PRINT_PTGRP, DUMPT, NEON, ARGON, P46, NORESET, TABOOT, EVSTEPT, PACHECO, DL_POLY, QUCENTRE, &
 91:      &        STAR, PLUS, TWOPLUS, GROUND, DIPOLE, DFTBT, DFTBCT, SW, SUPERSTEP, EAMLJT, PBGLUET, TRACKDATAT, & 88:      &        STAR, PLUS, TWOPLUS, GROUND, DIPOLE, DFTBT, DFTBCT, SW, SUPERSTEP, EAMLJT, PBGLUET, TRACKDATAT, &
 92:      &        EAMALT, ALGLUET, MGGLUET, GUPTAT, LJATT, FST, DECAY, COOP, FIXBIN, GAUSST, QUENCHDOS, FIXDIHEFLAG, & 89:      &        EAMALT, ALGLUET, MGGLUET, GUPTAT, LJATT, FST, DECAY, COOP, FIXBIN, GAUSST, QUENCHDOS, FIXDIHEFLAG, &
 93:      &        FRAUSIT, ANGST, SELFT, STEPOUT, WENZEL, THRESHOLDT, THOMSONT, MULLERBROWNT, CHARMMENERGIES, & 90:      &        FRAUSIT, ANGST, SELFT, STEPOUT, WENZEL, THRESHOLDT, THOMSONT, MULLERBROWNT, CHARMMENERGIES, &
 94:      &        PROJ, RGCL2, TOSI, WELCH, AXTELL, AMBER, FIXIMAGE, BINARY, SHIFTCUT, ARNO, TUNNELT, TWOD, &  91:      &        PROJ, RGCL2, TOSI, WELCH, AXTELL, AMBER, FIXIMAGE, BINARY, SHIFTCUT, ARNO, TUNNELT, TWOD, & 
105:      &        LJSITECOORDST, VGW, ACKLANDT, G46, DF1T, PULLT, LOCALSAMPLET, CSMT, A9INTET, INTERESTORE, COLDFUSION, &102:      &        LJSITECOORDST, VGW, ACKLANDT, G46, DF1T, PULLT, LOCALSAMPLET, CSMT, A9INTET, INTERESTORE, COLDFUSION, &
106:      &        CSMGUIDET, MULTISITEPYT, CHAPERONINT, AVOIDRESEEDT, OHCELLT, UNFREEZEFINALQ, PERCOLATET, PERCT, PERCACCEPTED,&103:      &        CSMGUIDET, MULTISITEPYT, CHAPERONINT, AVOIDRESEEDT, OHCELLT, UNFREEZEFINALQ, PERCOLATET, PERCT, PERCACCEPTED,&
107:      &        GENALT, MINDENSITYT, RESTRICTREGION, RESTRICTREGIONTEST, RESTRICTCYL, ACK1, ACK2, HARMONICF,&104:      &        GENALT, MINDENSITYT, RESTRICTREGION, RESTRICTREGIONTEST, RESTRICTCYL, ACK1, ACK2, HARMONICF,&
108:      &        HARMONICDONTMOVE, DUMPUNIQUE, FREEZESAVE, TBP, RBSYMT, PTMCDUMPSTRUCT, PTMCDUMPENERT, PYCOLDFUSION, MONITORT,&105:      &        HARMONICDONTMOVE, DUMPUNIQUE, FREEZESAVE, TBP, RBSYMT, PTMCDUMPSTRUCT, PTMCDUMPENERT, PYCOLDFUSION, MONITORT,&
109:      &        CHARMMDFTBT, PERMINVOPT, BLOCKMOVET, MAXERISE_SET, PYT, BINARY_EXAB, CHIROT, SANDBOXT, &106:      &        CHARMMDFTBT, PERMINVOPT, BLOCKMOVET, MAXERISE_SET, PYT, BINARY_EXAB, CHIROT, SANDBOXT, &
110:      &        RESERVOIRT, DISTOPT, ONEDAPBCT, ONEDPBCT, TWODAPBCT, TWODPBCT, THREEDAPBCT, THREEDPBCT, RATIOT, &107:      &        RESERVOIRT, DISTOPT, ONEDAPBCT, ONEDPBCT, TWODAPBCT, TWODPBCT, THREEDAPBCT, THREEDPBCT, RATIOT, &
111:      &        PTRANDOM, PTINTERVAL, PTSINGLE, PTSETS, CHEMSHIFT, CHEMSHIFT2, CSH, DEBUGss2029, UNIFORMMOVE, RANSEEDT, &108:      &        PTRANDOM, PTINTERVAL, PTSINGLE, PTSETS, CHEMSHIFT, CHEMSHIFT2, CSH, DEBUGss2029, UNIFORMMOVE, RANSEEDT, &
112:      &        TTM3T, NOINVERSION, RIGIDCONTOURT, UPDATERIGIDREFT, HYBRIDMINT, COMPRESSRIGIDT, MWFILMT, &109:      &        TTM3T, NOINVERSION, RIGIDCONTOURT, UPDATERIGIDREFT, HYBRIDMINT, COMPRESSRIGIDT, MWFILMT, &
113:      &        SUPPRESST, MFETT, POLIRT, QUIPT, SWPOTT, MWPOTT, REPMATCHT, GLJT, MLJT, READMASST, SPECMASST, NEWTSALLIST, &110:      &        SUPPRESST, MFETT, POLIRT, QUIPT, SWPOTT, MWPOTT, REPMATCHT, GLJT, MLJT, READMASST, SPECMASST, NEWTSALLIST, &
114:      &        PHI4MODELT, CUDAT, CUDATIMET, AMBER12T, ENERGY_DECOMPT, NEWMOVEST, DUMPMINT, MBPOLT, MOLECULART, GCBHT, SEMIGRAND_MUT, USEROT, & 111:      &        PHI4MODELT, CUDAT, CUDATIMET, AMBER12T, ENERGY_DECOMPT, NEWMOVEST, DUMPMINT, MBPOLT, MOLECULART, GCBHT, SEMIGRAND_MUT, USEROT, & 
115:      &        SAVEMULTIMINONLY, GRADPROBLEMT, INTLJT, CONDATT, QCIPERMCHECK, &112:      &        SAVEMULTIMINONLY, GRADPROBLEMT, INTLJT, CONDATT, &
116:      &        INTCONSTRAINTT, INTFREEZET, CHECKCONINT, CONCUTABST, CONCUTFRACT, INTERPCOSTFUNCTION, &113:      &        INTCONSTRAINTT, INTFREEZET, CHECKCONINT, CONCUTABST, CONCUTFRACT, INTERPCOSTFUNCTION, &
117:      &        RBAAT, FREEZENODEST, DUMPINTEOS, DUMPINTXYZ, QCIPOTT, QCIPOT2T, INTSPRINGACTIVET, LPERMDIST, LOCALPERMDIST, QCIRADSHIFTT, &114:      &        RBAAT, FREEZENODEST, DUMPINTEOS, DUMPINTXYZ, QCIPOTT, QCIPOT2T, INTSPRINGACTIVET
118:      &        MLP3T 
119: !115: !
120:       DOUBLE PRECISION, ALLOCATABLE :: SEMIGRAND_MU(:) 116:       DOUBLE PRECISION, ALLOCATABLE :: SEMIGRAND_MU(:) 
121:       DOUBLE PRECISION, ALLOCATABLE:: ATMASS(:)117:       DOUBLE PRECISION, ALLOCATABLE:: ATMASS(:)
122:       DOUBLE PRECISION, ALLOCATABLE:: SPECMASS(:) 118:       DOUBLE PRECISION, ALLOCATABLE:: SPECMASS(:) 
123: 119: 
124: ! csw34> FREEZEGROUP variables120: ! csw34> FREEZEGROUP variables
125: !121: !
126:       INTEGER :: GROUPCENTRE122:       INTEGER :: GROUPCENTRE
127:       DOUBLE PRECISION :: GROUPRADIUS123:       DOUBLE PRECISION :: GROUPRADIUS
128:       CHARACTER (LEN=2) :: FREEZEGROUPTYPE124:       CHARACTER (LEN=2) :: FREEZEGROUPTYPE
606:       LOGICAL, ALLOCATABLE :: ATOMACTIVE(:)602:       LOGICAL, ALLOCATABLE :: ATOMACTIVE(:)
607:       INTEGER, ALLOCATABLE :: ORDERI(:), ORDERJ(:), REPPOW(:)603:       INTEGER, ALLOCATABLE :: ORDERI(:), ORDERJ(:), REPPOW(:)
608:       INTEGER, ALLOCATABLE :: CONI(:), CONJ(:), CONION(:), CONJON(:)604:       INTEGER, ALLOCATABLE :: CONI(:), CONJ(:), CONION(:), CONJON(:)
609:       INTEGER, ALLOCATABLE :: CONIFIX(:), CONJFIX(:), REPIFIX(:), REPJFIX(:)605:       INTEGER, ALLOCATABLE :: CONIFIX(:), CONJFIX(:), REPIFIX(:), REPJFIX(:)
610:       INTEGER, ALLOCATABLE :: REPI(:), REPJ(:)606:       INTEGER, ALLOCATABLE :: REPI(:), REPJ(:)
611:       INTEGER, ALLOCATABLE :: CPCONI(:), CPCONJ(:)607:       INTEGER, ALLOCATABLE :: CPCONI(:), CPCONJ(:)
612:       INTEGER, ALLOCATABLE :: CPREPI(:), CPREPJ(:)608:       INTEGER, ALLOCATABLE :: CPREPI(:), CPREPJ(:)
613:       DOUBLE PRECISION, ALLOCATABLE :: REPCUT(:), NREPCUT(:), CPREPCUT(:), REPCUTFIX(:)609:       DOUBLE PRECISION, ALLOCATABLE :: REPCUT(:), NREPCUT(:), CPREPCUT(:), REPCUTFIX(:)
614:       INTEGER, ALLOCATABLE :: NREPI(:), NREPJ(:)610:       INTEGER, ALLOCATABLE :: NREPI(:), NREPJ(:)
615:       LOGICAL, ALLOCATABLE, DIMENSION(:) :: INTFROZEN  !  MXATMS611:       LOGICAL, ALLOCATABLE, DIMENSION(:) :: INTFROZEN  !  MXATMS
616:       DOUBLE PRECISION, ALLOCATABLE ::  MLPDAT(:,:)612: 
617:       INTEGER, ALLOCATABLE ::  MLPOUTCOME(:) 
618: 613: 
619: END MODULE COMMONS614: END MODULE COMMONS


r29792/congrad.f90 2016-03-16 18:33:28.851012400 +0000 r29791/congrad.f90 2016-03-16 18:33:31.711041810 +0000
 95: !  DO J1=1,INTIMAGE+2 ! can change when zero energies are confirmed for end images 95: !  DO J1=1,INTIMAGE+2 ! can change when zero energies are confirmed for end images
 96:       IF (FREEZENODEST) THEN 96:       IF (FREEZENODEST) THEN
 97:          IF (J1.EQ.2) THEN 97:          IF (J1.EQ.2) THEN
 98:             IF (IMGFREEZE(1)) CYCLE 98:             IF (IMGFREEZE(1)) CYCLE
 99:          ELSE IF (J1.EQ.INTIMAGE+2) THEN 99:          ELSE IF (J1.EQ.INTIMAGE+2) THEN
100:             IF (IMGFREEZE(INTIMAGE)) CYCLE100:             IF (IMGFREEZE(INTIMAGE)) CYCLE
101:          ELSE101:          ELSE
102:             IF (IMGFREEZE(J1-2).AND.IMGFREEZE(J1-1)) CYCLE102:             IF (IMGFREEZE(J1-2).AND.IMGFREEZE(J1-1)) CYCLE
103:          ENDIF103:          ENDIF
104:       ENDIF104:       ENDIF
105:    IF (INTFROZEN(NREPI(J2)).AND.INTFROZEN(NREPJ(J2))) THEN105: !  IF (INTFROZEN(NREPI(J2)).AND.INTFROZEN(NREPJ(J2))) THEN
106:       WRITE(MYUNIT, '(A,I6,A,2I6)') ' congrad> ERROR *** repulsion ',J2,' between frozen atoms ',NREPI(J2),NREPJ(J2)106: !     PRINT '(A,I6,A,2I6)',' congrad> ERROR *** repulsion ',J2,' between frozen atoms ',NREPI(J2),NREPJ(J2)
107:       STOP107: !     STOP
108:    ENDIF 
109: !     WRITE(MYUNIT,'(A,2I8,6G20.10)') 'congrad2> B J1,J2,GGG(1:6)=',J1,J2,GGG(1:6)108: !     WRITE(MYUNIT,'(A,2I8,6G20.10)') 'congrad2> B J1,J2,GGG(1:6)=',J1,J2,GGG(1:6)
110:       NI2=(3*NATOMS)*(J1-1)+3*(NREPI(J2)-1)109:       NI2=(3*NATOMS)*(J1-1)+3*(NREPI(J2)-1)
111:       NJ2=(3*NATOMS)*(J1-1)+3*(NREPJ(J2)-1)110:       NJ2=(3*NATOMS)*(J1-1)+3*(NREPJ(J2)-1)
112:       R2AX=XYZ(NI2+1); R2AY=XYZ(NI2+2); R2AZ=XYZ(NI2+3)111:       R2AX=XYZ(NI2+1); R2AY=XYZ(NI2+2); R2AZ=XYZ(NI2+3)
113:       R2BX=XYZ(NJ2+1); R2BY=XYZ(NJ2+2); R2BZ=XYZ(NJ2+3)112:       R2BX=XYZ(NJ2+1); R2BY=XYZ(NJ2+2); R2BZ=XYZ(NJ2+3)
114:       D2=SQRT((R2AX-R2BX)**2+(R2AY-R2BY)**2+(R2AZ-R2BZ)**2)113:       D2=SQRT((R2AX-R2BX)**2+(R2AY-R2BY)**2+(R2AZ-R2BZ)**2)
115:       IF (D2.LT.NREPCUT(J2)) THEN ! term for image J1114:       IF (D2.LT.NREPCUT(J2)) THEN ! term for image J1
116: !        D12=D2**12115: !        D12=D2**12
117:          D12=D2**2116:          D12=D2**2
118: !        DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(12.0D0*D2-13.0D0*NREPCUT(J2))/INTCONST)117: !        DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(12.0D0*D2-13.0D0*NREPCUT(J2))/INTCONST)
136: ! edge 1, which is assigned to image 2, and edge INTIMAGE+1, which135: ! edge 1, which is assigned to image 2, and edge INTIMAGE+1, which
137: ! is assigned to image INTIMAGE+1. Gradients are set to zero for136: ! is assigned to image INTIMAGE+1. Gradients are set to zero for
138: ! the end images.137: ! the end images.
139: !138: !
140:       IF (J1.EQ.1) CYCLE139:       IF (J1.EQ.1) CYCLE
141:       NI1=(3*NATOMS)*(J1-2)+3*(NREPI(J2)-1)140:       NI1=(3*NATOMS)*(J1-2)+3*(NREPI(J2)-1)
142:       NJ1=(3*NATOMS)*(J1-2)+3*(NREPJ(J2)-1)141:       NJ1=(3*NATOMS)*(J1-2)+3*(NREPJ(J2)-1)
143:       R1AX=XYZ(NI1+1); R1AY=XYZ(NI1+2); R1AZ=XYZ(NI1+3)142:       R1AX=XYZ(NI1+1); R1AY=XYZ(NI1+2); R1AZ=XYZ(NI1+3)
144:       R1BX=XYZ(NJ1+1); R1BY=XYZ(NJ1+2); R1BZ=XYZ(NJ1+3)143:       R1BX=XYZ(NJ1+1); R1BY=XYZ(NJ1+2); R1BZ=XYZ(NJ1+3)
145: !     IF (r2ax**2+r2ay**2+r2az**2+r2bx**2+r2by**2+r2bz**2-2*(r2ax*r2bx+r2ay*r2by+r2az*r2bz).EQ.0.0D0) THEN144: !     IF (r2ax**2+r2ay**2+r2az**2+r2bx**2+r2by**2+r2bz**2-2*(r2ax*r2bx+r2ay*r2by+r2az*r2bz).EQ.0.0D0) THEN
146:       IF ((r1ax-r1bx-r2ax+r2bx)**2+(r1ay-r1by-r2ay+r2by)**2+(r1az-r1bz-r2az+r2bz)**2.LT.1.0D-10) THEN145: !        PRINT '(A,I6,A,2I6)','B repulsion number ',J2, ' between ',NREPI(J2),NREPJ(J2)
147: !        WRITE(MYUNIT, '(A,I6,A,2I6)') 'B repulsion number ',J2, ' between ',NREPI(J2),NREPJ(J2)146: !        PRINT '(A,I6)','image number ',J1
148: !        WRITE(MYUNIT, '(A,6F15.10)') 'R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ=',R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ147: !        PRINT '(A,6F15.10)','R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ=',R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ
149: !        WRITE(MYUNIT, '(A,6F15.10)') 'R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ=',R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ148: !        PRINT '(A,6F15.10)','R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ=',R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ
150: !        WRITE(MYUNIT,'(A,7I10)') 'congrad> J2,NI1,NJ1,NI2,NJ2,NREPI,NREPJ=',J2,NI1,NJ1,NI2,NJ2,NREPI(J2),NREPJ(J2)149: !     ENDIF
151: !        WRITE(MYUNIT,'(A,7I10)') 'frames ',J1-1,J1150:       CALL MINMAXD2R(R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ, &
152:       ELSE 
153:          CALL MINMAXD2R(R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ, & 
154:   &                 D2,D1,DINT,DSQ2,DSQ1,DSQI,G1,G2,G1INT,G2INT,NOINT,.FALSE.,NREPCUT(J2))151:   &                 D2,D1,DINT,DSQ2,DSQ1,DSQI,G1,G2,G1INT,G2INT,NOINT,.FALSE.,NREPCUT(J2))
155:          IF (.NOT.NOINT) THEN152:       IF (.NOT.NOINT) THEN
156: !           WRITE(MYUNIT,'(A,I6,A,I6,A,2I6,A,2G20.10)') 'congrad> internal minimum images ',J1-1,' and ',J1,' atoms: ',NREPI(J2),NREPJ(J2), &153: !        WRITE(MYUNIT,'(A,I6,A,I6,A,2I6,A,2G20.10)') 'congrad> internal minimum images ',J1-1,' and ',J1,' atoms: ',NREPI(J2),NREPJ(J2), &
157: ! &                        ' distance,cutoff=',DINT,NREPCUT(J2)154: ! &                     ' distance,cutoff=',DINT,NREPCUT(J2)
158:             NINTMIN=NINTMIN+1155:          NINTMIN=NINTMIN+1
159:          ENDIF 
160:       ENDIF156:       ENDIF
161:       IF ((.NOT.NOINT).AND.(DINT.LT.NREPCUT(J2))) THEN157:       IF ((.NOT.NOINT).AND.(DINT.LT.NREPCUT(J2))) THEN
162:          NINTMIN2=NINTMIN2+1158:          NINTMIN2=NINTMIN2+1
163: !        D12=DSQI**6159: !        D12=DSQI**6
164:          D12=DSQI160:          D12=DSQI
165: !        DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(12.0D0*DINT-13.0D0*NREPCUT(J2))/INTCONST)161: !        DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(12.0D0*DINT-13.0D0*NREPCUT(J2))/INTCONST)
166:          DUMMY=INTMINFAC*INTCONSTRAINTREP*(1.0D0/D12+(2.0D0*DINT-3.0D0*NREPCUT(J2))/INTCONST)162:          DUMMY=INTMINFAC*INTCONSTRAINTREP*(1.0D0/D12+(2.0D0*DINT-3.0D0*NREPCUT(J2))/INTCONST)
167:          IF (J1.EQ.2) THEN163:          IF (J1.EQ.2) THEN
168:             EEE(J1)=EEE(J1)+DUMMY164:             EEE(J1)=EEE(J1)+DUMMY
169:             REPEINT(J1)=REPEINT(J1)+DUMMY165:             REPEINT(J1)=REPEINT(J1)+DUMMY
304:    ENDIF300:    ENDIF
305: ENDDO301: ENDDO
306: IF (DEBUG) WRITE(MYUNIT, '(A,G20.10,A,2I6)') 'congrad> largest  internal energy=',MAXINT,' for image ',NMAXINT302: IF (DEBUG) WRITE(MYUNIT, '(A,G20.10,A,2I6)') 'congrad> largest  internal energy=',MAXINT,' for image ',NMAXINT
307: IF (DEBUG) WRITE(MYUNIT, '(A,G20.10,A,2I6)') 'congrad> smallest internal energy=',MININT,' for image ',NMININT303: IF (DEBUG) WRITE(MYUNIT, '(A,G20.10,A,2I6)') 'congrad> smallest internal energy=',MININT,' for image ',NMININT
308: IF (DEBUG) WRITE(MYUNIT, '(A,2I6)') 'congrad> number of internal minima=',NINTMIN,NINTMIN2304: IF (DEBUG) WRITE(MYUNIT, '(A,2I6)') 'congrad> number of internal minima=',NINTMIN,NINTMIN2
309: 305: 
310: END SUBROUTINE CONGRAD306: END SUBROUTINE CONGRAD
311: 307: 
312: SUBROUTINE MINMAXD2(R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ, &308: SUBROUTINE MINMAXD2(R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ, &
313:   &                 D2,D1,DINT,G1,G2,G1INT,G2INT,NOINT,DEBUG)309:   &                 D2,D1,DINT,G1,G2,G1INT,G2INT,NOINT,DEBUG)
314: USE COMMONS, ONLY: MYUNIT 
315: IMPLICIT NONE310: IMPLICIT NONE
316: DOUBLE PRECISION R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ,D2,D1,DINT311: DOUBLE PRECISION R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ,D2,D1,DINT
317: DOUBLE PRECISION G1(3),G2(3),G1INT(3),G2INT(3)312: DOUBLE PRECISION G1(3),G2(3),G1INT(3),G2INT(3)
318: DOUBLE PRECISION DSQ2, DSQ1, DSQI, r1apr2bmr2amr1bsq, r1amr1bsq, r2amr2bsq313: DOUBLE PRECISION DSQ2, DSQ1, DSQI, r1apr2bmr2amr1bsq, r1amr1bsq, r2amr2bsq
319: DOUBLE PRECISION r1amr1bdr2amr2b, r1amr1bdr2amr2bsq, DUMMY314: DOUBLE PRECISION r1amr1bdr2amr2b, r1amr1bdr2amr2bsq, DUMMY
320: LOGICAL NOINT, DEBUG315: LOGICAL NOINT, DEBUG
321: !316: !
322: ! Squared distance between atoms A and B for theta=0 - distance in image 2317: ! Squared distance between atoms A and B for theta=0 - distance in image 2
323: !318: !
324: DSQ2=r2ax**2 + r2ay**2 + r2az**2 + r2bx**2 + r2by**2 + r2bz**2 - 2*(r2ax*r2bx + r2ay*r2by + r2az*r2bz)319: DSQ2=r2ax**2 + r2ay**2 + r2az**2 + r2bx**2 + r2by**2 + r2bz**2 - 2*(r2ax*r2bx + r2ay*r2by + r2az*r2bz)
325: !320: !
326: ! Squared distance between atoms A and B for theta=Pi/2 - distance in image 1321: ! Squared distance between atoms A and B for theta=Pi/2 - distance in image 1
327: !322: !
328: DSQ1=r1ax**2 + r1ay**2 + r1az**2 + r1bx**2 + r1by**2 + r1bz**2 - 2*(r1ax*r1bx + r1ay*r1by + r1az*r1bz)323: DSQ1=r1ax**2 + r1ay**2 + r1az**2 + r1bx**2 + r1by**2 + r1bz**2 - 2*(r1ax*r1bx + r1ay*r1by + r1az*r1bz)
329: ! WRITE(MYUNIT,'(A,6F15.10)') 'R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ=',R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ324: ! PRINT '(A,6F15.10)','R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ=',R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ
330: ! WRITE(MYUNIT,'(A,6F15.10)') 'R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ=',R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ325: ! PRINT '(A,6F15.10)','R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ=',R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ
331: ! WRITE(MYUNIT,'(A,6F15.10)') 'DSQ2,DSQ1=',DSQ2,DSQ1 
332: !326: !
333: ! Is there an internal extremum?327: ! Is there an internal extremum?
334: !328: !
335: r1apr2bmr2amr1bsq=(r1ax-r1bx-r2ax+r2bx)**2+(r1ay-r1by-r2ay+r2by)**2+(r1az-r1bz-r2az+r2bz)**2329: r1apr2bmr2amr1bsq=(r1ax-r1bx-r2ax+r2bx)**2+(r1ay-r1by-r2ay+r2by)**2+(r1az-r1bz-r2az+r2bz)**2
336: IF (r1apr2bmr2amr1bsq.EQ.0.0D0) THEN330: IF (r1apr2bmr2amr1bsq.EQ.0.0D0) THEN
337:    DUMMY=2.0D0 ! just to skip the internal extremum part331:    DUMMY=2.0D0 ! just to skip the internal extremum part
338: ELSE332: ELSE
339:    DUMMY=((r1ax-r1bx)*(r1ax-r1bx-r2ax+r2bx)+(r1ay-r1by)*(r1ay-r1by-r2ay+r2by)+(r1az-r1bz)*(r1az-r1bz-r2az+r2bz))/r1apr2bmr2amr1bsq333:    DUMMY=((r1ax-r1bx)*(r1ax-r1bx-r2ax+r2bx)+(r1ay-r1by)*(r1ay-r1by-r2ay+r2by)+(r1az-r1bz)*(r1az-r1bz-r2az+r2bz))/r1apr2bmr2amr1bsq
340: ENDIF334: ENDIF
341: NOINT=.TRUE.335: NOINT=.TRUE.
550: ! A and B refer to atoms, 1 and 2 to images J1-1 and J1 corresponding to J1-2 and J1-1 below.544: ! A and B refer to atoms, 1 and 2 to images J1-1 and J1 corresponding to J1-2 and J1-1 below.
551: !545: !
552: ! IMGFREEZE(1:INTIMAGE) refers to the images excluding end points!546: ! IMGFREEZE(1:INTIMAGE) refers to the images excluding end points!
553: !547: !
554: DO J2=1,NCONSTRAINT548: DO J2=1,NCONSTRAINT
555:    IF (.NOT.CONACTIVE(J2)) CYCLE549:    IF (.NOT.CONACTIVE(J2)) CYCLE
556:    CCLOCAL=CONCUTLOCAL(J2)550:    CCLOCAL=CONCUTLOCAL(J2)
557:    IF (CONCUTABST) CCLOCAL=CCLOCAL+CONCUTABS551:    IF (CONCUTABST) CCLOCAL=CCLOCAL+CONCUTABS
558:    IF (CONCUTFRACT) CCLOCAL=CCLOCAL+CONCUTFRAC*CONDISTREFLOCAL(J2)552:    IF (CONCUTFRACT) CCLOCAL=CCLOCAL+CONCUTFRAC*CONDISTREFLOCAL(J2)
559: !!!!!!!!!!!!!!!!!!!!!!!!!! DEBUG553: !!!!!!!!!!!!!!!!!!!!!!!!!! DEBUG
560:    IF (INTFROZEN(CONI(J2)).AND.INTFROZEN(CONJ(J2))) THEN554: !  IF (INTFROZEN(CONI(J2)).AND.INTFROZEN(CONJ(J2))) THEN
561:       WRITE(MYUNIT, '(A,I6,A,2I6)') ' congrad2> ERROR *** constraint ',J2,' between frozen atoms ',CONI(J2),CONJ(J2)555: !     PRINT '(A,I6,A,2I6)',' congrad> ERROR *** constraint ',J2,' between frozen atoms ',CONI(J2),CONJ(J2)
562:       STOP556: !     STOP
563:    ENDIF557: !  ENDIF
564: !!!!!!!!!!!!!!!!!!!!!!!!!! DEBUG558: !!!!!!!!!!!!!!!!!!!!!!!!!! DEBUG
565:    DO J1=2,INTIMAGE+2559:    DO J1=2,INTIMAGE+2
566:       IF (FREEZENODEST) THEN ! IMGFREEZE is not allocated otherwise!560:       IF (FREEZENODEST) THEN ! IMGFREEZE is not allocated otherwise!
567:          IF (J1.EQ.2) THEN561:          IF (J1.EQ.2) THEN
568:             IF (IMGFREEZE(1)) THEN562:             IF (IMGFREEZE(1)) THEN
569: !              IF (J2.EQ.1) PRINT '(A)','J1=2 and IMGFREEZE(1)=T cycle'563: !              IF (J2.EQ.1) PRINT '(A)','J1=2 and IMGFREEZE(1)=T cycle'
570:                CYCLE564:                CYCLE
571:             ENDIF565:             ENDIF
572:          ELSE IF (J1.EQ.INTIMAGE+2) THEN566:          ELSE IF (J1.EQ.INTIMAGE+2) THEN
573:             IF (IMGFREEZE(INTIMAGE)) THEN567:             IF (IMGFREEZE(INTIMAGE)) THEN
680:    DO J1=2,INTIMAGE+2674:    DO J1=2,INTIMAGE+2
681:       IF (FREEZENODEST) THEN675:       IF (FREEZENODEST) THEN
682:          IF (J1.EQ.2) THEN676:          IF (J1.EQ.2) THEN
683:             IF (IMGFREEZE(1)) CYCLE677:             IF (IMGFREEZE(1)) CYCLE
684:          ELSE IF (J1.EQ.INTIMAGE+2) THEN678:          ELSE IF (J1.EQ.INTIMAGE+2) THEN
685:             IF (IMGFREEZE(INTIMAGE)) CYCLE679:             IF (IMGFREEZE(INTIMAGE)) CYCLE
686:          ELSE680:          ELSE
687:             IF (IMGFREEZE(J1-2).AND.IMGFREEZE(J1-1)) CYCLE681:             IF (IMGFREEZE(J1-2).AND.IMGFREEZE(J1-1)) CYCLE
688:          ENDIF682:          ENDIF
689:       ENDIF683:       ENDIF
690:       IF (INTFROZEN(NREPI(J2)).AND.INTFROZEN(NREPJ(J2))) THEN684: !     IF (INTFROZEN(NREPI(J2)).AND.INTFROZEN(NREPJ(J2))) THEN
691:          WRITE(MYUNIT, '(A,I6,A,2I6)') ' congrad2> ERROR *** repulsion ',J2,' between frozen atoms ',NREPI(J2),NREPJ(J2)685: !        PRINT '(A,I6,A,2I6)',' congrad> ERROR *** repulsion ',J2,' between frozen atoms ',NREPI(J2),NREPJ(J2)
692:          STOP686: !        STOP
693:       ENDIF687: !     ENDIF
694: !     WRITE(MYUNIT,'(A,2I8,6G20.10)') 'congrad2> B J1,J2,GGG(1:6)=',J1,J2,GGG(1:6)688: !     WRITE(MYUNIT,'(A,2I8,6G20.10)') 'congrad2> B J1,J2,GGG(1:6)=',J1,J2,GGG(1:6)
695:       NI1=(3*NATOMS)*(J1-2)+3*(NREPI(J2)-1)689:       NI1=(3*NATOMS)*(J1-2)+3*(NREPI(J2)-1)
696:       NI2=(3*NATOMS)*(J1-1)+3*(NREPI(J2)-1)690:       NI2=(3*NATOMS)*(J1-1)+3*(NREPI(J2)-1)
697:       NJ1=(3*NATOMS)*(J1-2)+3*(NREPJ(J2)-1)691:       NJ1=(3*NATOMS)*(J1-2)+3*(NREPJ(J2)-1)
698:       NJ2=(3*NATOMS)*(J1-1)+3*(NREPJ(J2)-1)692:       NJ2=(3*NATOMS)*(J1-1)+3*(NREPJ(J2)-1)
699:       R1AX=XYZ(NI1+1); R1AY=XYZ(NI1+2); R1AZ=XYZ(NI1+3)693:       R1AX=XYZ(NI1+1); R1AY=XYZ(NI1+2); R1AZ=XYZ(NI1+3)
700:       R1BX=XYZ(NJ1+1); R1BY=XYZ(NJ1+2); R1BZ=XYZ(NJ1+3)694:       R1BX=XYZ(NJ1+1); R1BY=XYZ(NJ1+2); R1BZ=XYZ(NJ1+3)
701:       R2AX=XYZ(NI2+1); R2AY=XYZ(NI2+2); R2AZ=XYZ(NI2+3)695:       R2AX=XYZ(NI2+1); R2AY=XYZ(NI2+2); R2AZ=XYZ(NI2+3)
702:       R2BX=XYZ(NJ2+1); R2BY=XYZ(NJ2+2); R2BZ=XYZ(NJ2+3)696:       R2BX=XYZ(NJ2+1); R2BY=XYZ(NJ2+2); R2BZ=XYZ(NJ2+3)
703: !     IF (r2ax**2+r2ay**2+r2az**2+r2bx**2+r2by**2+r2bz**2-2*(r2ax*r2bx+r2ay*r2by+r2az*r2bz).EQ.0.0D0) THEN697:       IF (r2ax**2+r2ay**2+r2az**2+r2bx**2+r2by**2+r2bz**2-2*(r2ax*r2bx+r2ay*r2by+r2az*r2bz).EQ.0.0D0) THEN
704:       IF ((r1ax-r1bx-r2ax+r2bx)**2+(r1ay-r1by-r2ay+r2by)**2+(r1az-r1bz-r2az+r2bz)**2.LT.1.0D-50) THEN 
705: !        WRITE(MYUNIT, '(A,I6,A,2I6)') 'A repulsion number ',J2, ' between ',NREPI(J2),NREPJ(J2)698: !        WRITE(MYUNIT, '(A,I6,A,2I6)') 'A repulsion number ',J2, ' between ',NREPI(J2),NREPJ(J2)
 699: !        WRITE(MYUNIT, '(A,I6)') 'image number ',J1
706: !        WRITE(MYUNIT, '(A,6F15.10)') 'R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ=',R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ700: !        WRITE(MYUNIT, '(A,6F15.10)') 'R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ=',R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ
707: !        WRITE(MYUNIT, '(A,6F15.10)') 'R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ=',R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ701: !        WRITE(MYUNIT, '(A,6F15.10)') 'R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ=',R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ
708: !        WRITE(MYUNIT,'(A,7I10)') 'congrad> J2,NI1,NJ1,NI2,NJ2,NREPI,NREPJ=',J2,NI1,NJ1,NI2,NJ2,NREPI(J2),NREPJ(J2) 
709: !        WRITE(MYUNIT,'(A,7I10)') 'frames ',J1-1,J1 
710:          D1=1.0D100; D2=1.0D100; NOINT=.TRUE.  ! to skip the next blocks 
711:       ELSE 
712:          CALL MINMAXD2R(R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ, & 
713:   &                    D2,D1,DINT,DSQ2,DSQ1,DSQI,G1,G2,G1INT,G2INT,NOINT,.FALSE.,NREPCUT(J2)) 
714:       ENDIF702:       ENDIF
 703:       CALL MINMAXD2R(R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ, &
 704:   &                 D2,D1,DINT,DSQ2,DSQ1,DSQI,G1,G2,G1INT,G2INT,NOINT,.FALSE.,NREPCUT(J2))
 705: !     IF ((NREPI(J2).EQ.83).AND.(NREPJ(J2).EQ.357)) THEN
 706: !        WRITE(MYUNIT, '(A,3G20.10)') ' congrad2> R1AX,R1AY,R1AZ=',R1AX,R1AY,R1AZ
 707: !        WRITE(MYUNIT, '(A,3G20.10)') ' congrad2> R1BX,R1BY,R1BZ=',R1BX,R1BY,R1BZ
 708: !        WRITE(MYUNIT, '(A,3G20.10)') ' congrad2> R2AX,R2AY,R2AZ=',R2AX,R2AY,R2AZ
 709: !        WRITE(MYUNIT, '(A,3G20.10)') ' congrad2> R2BX,R2BY,R2BZ=',R2BX,R2BY,R2BZ
 710: !        WRITE(MYUNIT, '(A,I6,A,2I6)') ' congrad2> J1=',J1,' edge between images: ',J1-1,J1
 711: !        WRITE(MYUNIT, '(A,L5,3G20.10)') ' congrad2> NOINT,D2,D1,DINT=',NOINT,D2,D1,DINT
 712: !     ENDIF
 713: !     IF (.NOT.NOINT.AND.(NREPI(J2).EQ.83).AND.(NREPJ(J2).EQ.357)) WRITE(MYUNIT, '(A,I5,3G20.10)') &
 714: ! &                                                 ' congrad2> im 83 357 D2,D1,DINT=',J1,D2,D1,DINT
 715: !     IF (.NOT.NOINT.AND.(NREPI(J2).EQ.83).AND.(NREPJ(J2).EQ.359)) WRITE(MYUNIT, '(A,I5,3G20.10)') &
 716: ! &                                                 ' congrad2> im 83 359 D2,D1,DINT=',J1,D2,D1,DINT
 717: !     IF (.NOT.NOINT.AND.(NREPI(J2).EQ.86).AND.(NREPJ(J2).EQ.357)) WRITE(MYUNIT, '(A,I5,3G20.10)') &
 718: ! &                                                 ' congrad2> im 86 357 D2,D1,DINT=',J1,D2,D1,DINT
 719: !     IF (.NOT.NOINT.AND.(NREPI(J2).EQ.86).AND.(NREPJ(J2).EQ.359)) WRITE(MYUNIT, '(A,I5,3G20.10)') &
 720: ! &                                                 ' congrad2> im 86 359 D2,D1,DINT=',J1,D2,D1,DINT
 721: !     IF (.NOT.NOINT.AND.(NREPJ(J2).EQ.83).AND.(NREPI(J2).EQ.357)) WRITE(MYUNIT, '(A,I5,3G20.10)') &
 722: ! &                                                 ' congrad2> im 83 357 D2,D1,DINT=',J1,D2,D1,DINT
 723: !     IF (.NOT.NOINT.AND.(NREPJ(J2).EQ.83).AND.(NREPI(J2).EQ.359)) WRITE(MYUNIT, '(A,I5,3G20.10)') &
 724: ! &                                                 ' congrad2> im 83 359 D2,D1,DINT=',J1,D2,D1,DINT
 725: !     IF (.NOT.NOINT.AND.(NREPJ(J2).EQ.86).AND.(NREPI(J2).EQ.357)) WRITE(MYUNIT, '(A,I5,3G20.10)') &
 726: ! &                                                 ' congrad2> im 86 357 D2,D1,DINT=',J1,D2,D1,DINT
 727: !     IF (.NOT.NOINT.AND.(NREPJ(J2).EQ.86).AND.(NREPI(J2).EQ.359)) WRITE(MYUNIT, '(A,I5,3G20.10)') &
 728: ! &                                                 ' congrad2> im 86 359 D2,D1,DINT=',J1,D2,D1,DINT
 729:       DUMMY=0.0D0 
715: !730: !
716: ! Skip image INTIMAGE+2 - no non-zero gradients on other images and no energy contributions.731: ! Skip image INTIMAGE+2 - no non-zero gradients on other images and no energy contributions.
717: !732: !
718: !     IF ((D2.LT.INTCONSTRAINREPCUT).AND.(J1.LT.INTIMAGE+2)) THEN ! terms for image J1 - non-zero derivatives only for J1733: !     IF ((D2.LT.INTCONSTRAINREPCUT).AND.(J1.LT.INTIMAGE+2)) THEN ! terms for image J1 - non-zero derivatives only for J1
719:       IF ((D2.LT.NREPCUT(J2)).AND.(J1.LT.INTIMAGE+2)) THEN ! terms for image J1 - non-zero derivatives only for J1734:       IF ((D2.LT.NREPCUT(J2)).AND.(J1.LT.INTIMAGE+2)) THEN ! terms for image J1 - non-zero derivatives only for J1
720: !        D12=DSQ2**6735: !        D12=DSQ2**6
721:          D12=DSQ2736:          D12=DSQ2
722: !        DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(12.0D0*D2-13.0D0*INTCONSTRAINREPCUT)/INTCONST)737: !        DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(12.0D0*D2-13.0D0*INTCONSTRAINREPCUT)/INTCONST)
723: !        DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(12.0D0*D2-13.0D0*NREPCUT(J2))/INTCONST)738: !        DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(12.0D0*D2-13.0D0*NREPCUT(J2))/INTCONST)
724:          DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(2.0D0*D2-3.0D0*NREPCUT(J2))/INTCONST)739:          DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(2.0D0*D2-3.0D0*NREPCUT(J2))/INTCONST)


r29792/finalio.f90 2016-03-16 18:33:29.047014415 +0000 r29791/finalio.f90 2016-03-16 18:33:31.915043908 +0000
550:             ENDDO550:             ENDDO
551: 551: 
552:         ELSE IF (GBT.OR.GBDT.OR.GBDPT.OR.MSGBT) THEN552:         ELSE IF (GBT.OR.GBDT.OR.GBDPT.OR.MSGBT) THEN
553:             DO J2 = 1, NATOMS/2553:             DO J2 = 1, NATOMS/2
554:                 WRITE(MYUNIT2,'(3f20.10)') (QMINP(J1,3*(J2-1)+J3),J3=1,3)554:                 WRITE(MYUNIT2,'(3f20.10)') (QMINP(J1,3*(J2-1)+J3),J3=1,3)
555:             ENDDO555:             ENDDO
556:             DO J2 = 1, NATOMS/2556:             DO J2 = 1, NATOMS/2
557:                 WRITE(MYUNIT2,'(3f20.10)') (QMINP(J1,3*NATOMS/2+3*(J2-1)+J3),J3=1,3)557:                 WRITE(MYUNIT2,'(3f20.10)') (QMINP(J1,3*NATOMS/2+3*(J2-1)+J3),J3=1,3)
558:             ENDDO558:             ENDDO
559: 559: 
560:          ELSE IF (MLP3T) THEN 
561:             DO J2 = 1, NATOMS 
562:                 WRITE(MYUNIT2,'(3G20.10)') QMINP(J1,J2) 
563:             ENDDO 
564:  
565:          ELSE IF (GEMT) THEN560:          ELSE IF (GEMT) THEN
566:             DO J2 = 1, NATOMS561:             DO J2 = 1, NATOMS
567:                 WRITE(MYUNIT2,'(3f20.10)') (QMINP(J1,3*(J2-1)+J3),J3=1,3)562:                 WRITE(MYUNIT2,'(3f20.10)') (QMINP(J1,3*(J2-1)+J3),J3=1,3)
568:             ENDDO563:             ENDDO
569: 564: 
570:         ELSE IF (BLNT.AND.(.NOT.P46).AND.(.NOT.G46)) THEN565:         ELSE IF (BLNT.AND.(.NOT.P46).AND.(.NOT.G46)) THEN
571: !566: !
572: ! this writes 'lowest' in xyz (Xmakemol) format567: ! this writes 'lowest' in xyz (Xmakemol) format
573: !568: !
574:             WRITE(MYUNIT,'(A,I6,A)') ' in finalio BLN block MYUNIT2=',MYUNIT2569:             WRITE(MYUNIT,'(A,I6,A)') ' in finalio BLN block MYUNIT2=',MYUNIT2


r29792/intlbfgs.f90 2016-03-16 18:33:29.243016431 +0000 r29791/intlbfgs.f90 2016-03-16 18:33:32.111045923 +0000
 20: USE COMMONS, ONLY : FREEZENODEST, FREEZETOL, MAXBFGS, CHRMMT, MYUNIT, CQMAX, & 20: USE COMMONS, ONLY : FREEZENODEST, FREEZETOL, MAXBFGS, CHRMMT, MYUNIT, CQMAX, &
 21:      & INTRMSTOL, INTIMAGE, NREPMAX, NREPULSIVE, MUPDATE, INTDGUESS, & 21:      & INTRMSTOL, INTIMAGE, NREPMAX, NREPULSIVE, MUPDATE, INTDGUESS, &
 22:      & NCONSTRAINT, CONI, CONJ, CONDISTREF, INTCONMAX, & 22:      & NCONSTRAINT, CONI, CONJ, CONDISTREF, INTCONMAX, &
 23:      & INTCONSTRAINREPCUT, REPCON, INTCONSTRAINTREP, INTREPSEP, NREPI, NREPJ, & 23:      & INTCONSTRAINREPCUT, REPCON, INTCONSTRAINTREP, INTREPSEP, NREPI, NREPJ, &
 24:      & CONDISTREFLOCAL, INTCONFRAC, CONACTIVE, REPI, & 24:      & CONDISTREFLOCAL, INTCONFRAC, CONACTIVE, REPI, &
 25:      & REPJ, NREPMAX, ATOMACTIVE, NCONSTRAINTON, CONION, CONJON, CONDISTREFLOCALON, CONDISTREFON, & 25:      & REPJ, NREPMAX, ATOMACTIVE, NCONSTRAINTON, CONION, CONJON, CONDISTREFLOCALON, CONDISTREFON, &
 26:      & NREPCUT, REPCUT, CHECKCONINT, INTCONSTEPS, INTRELSTEPS, MAXCONE, COLDFUSIONLIMIT, & 26:      & NREPCUT, REPCUT, CHECKCONINT, INTCONSTEPS, INTRELSTEPS, MAXCONE, COLDFUSIONLIMIT, &
 27:      & INTSTEPS1, DUMPINTXYZ, DUMPINTXYZFREQ, DUMPINTEOS, DUMPINTEOSFREQ, & 27:      & INTSTEPS1, DUMPINTXYZ, DUMPINTXYZFREQ, DUMPINTEOS, DUMPINTEOSFREQ, &
 28:      & IMSEPMIN, IMSEPMAX, MAXINTIMAGE, INTFREEZET, INTFREEZETOL, FREEZE, & 28:      & IMSEPMIN, IMSEPMAX, MAXINTIMAGE, INTFREEZET, INTFREEZETOL, FREEZE, &
 29:      & INTFROZEN, CHECKREPINTERVAL, NNREPULSIVE, INTFREEZEMIN, INTIMAGECHECK, & 29:      & INTFROZEN, CHECKREPINTERVAL, NNREPULSIVE, INTFREEZEMIN, INTIMAGECHECK, &
 30:      & CONCUT, CONCUTLOCAL, NATOMS, DEBUG, STEP, MCSTEPS, KINT, REPIFIX, REPJFIX, NREPULSIVEFIX, & 30:      & CONCUT, CONCUTLOCAL, NATOMS, DEBUG, STEP, MCSTEPS
 31:      & NCONSTRAINTFIX, CONIFIX, CONJFIX, QCIPERMCHECK, QCIPERMCHECKINT, PERIODIC, TWOD, RIGID, BOXLX, BOXLY, BOXLZ 
 32:  31: 
 33: IMPLICIT NONE  32: IMPLICIT NONE 
 34:  33: 
 35: DOUBLE PRECISION, INTENT(IN) :: QSTART(3*NATOMS), QFINISH(3*NATOMS)  ! The two end points 34: DOUBLE PRECISION, INTENT(IN) :: QSTART(3*NATOMS), QFINISH(3*NATOMS)  ! The two end points
 36: INTEGER D, U 35: INTEGER D, U
 37: DOUBLE PRECISION DIST, DIST2, RMAT(3,3) 36: DOUBLE PRECISION DMAX, DF, DMIN, LOCALSTEP
 38: DOUBLE PRECISION DMAX, DF, DMIN, LOCALSTEP, ADMAX, DUMMYX, DUMMYY, DUMMYZ 37: INTEGER NDECREASE, NFAIL, NMAXINT, NMININT, JMAX, JMIN, INTIMAGESAVE, NOFF, J1, J2, NQDONE
 39: INTEGER NDECREASE, NFAIL, NMAXINT, NMININT, JMAX, JMIN, INTIMAGESAVE, NOFF, J1, J2, NQDONE, JA1, JA2 38: LOGICAL KNOWE, KNOWG, KNOWH, ADDATOM, ADDREP(NATOMS)
 40: LOGICAL KNOWE, KNOWG, KNOWH, ADDATOM, ADDREP(NATOMS), LDEBUG 
 41: COMMON /KNOWN/ KNOWE, KNOWG, KNOWH 39: COMMON /KNOWN/ KNOWE, KNOWG, KNOWH
 42:  40: 
 43: DOUBLE PRECISION DUMMY, DPRAND, DUMMY2, ADUMMY 41: DOUBLE PRECISION DUMMY, DPRAND
 44: INTEGER POINT,NPT,J3,J4,NIMAGEFREEZE,NACTIVE,NBEST,NEWATOM,NBEST2 42: INTEGER POINT,NPT,J3,J4,NIMAGEFREEZE,NACTIVE,NBEST,NEWATOM
 45: INTEGER TURNONORDER(NATOMS),NBACKTRACK,NQCIFREEZE 43: INTEGER TURNONORDER(NATOMS),NBACKTRACK,NQCIFREEZE
 46: INTEGER NDUMMY, NLASTGOODE, NSTEPSMAX 44: INTEGER NDUMMY, NLASTGOODE, NSTEPSMAX
 47: INTEGER NTRIES(NATOMS), NITERDONE, EXITSTATUS, DLIST(NATOMS) 45: INTEGER NTRIES(NATOMS), NITERDONE, EXITSTATUS, DLIST(NATOMS)
 48: DOUBLE PRECISION :: DDOT,STPMIN, ETOTALTMP, RMSTMP, USEFRAC, STIME, FTIME, & 46: DOUBLE PRECISION :: DDOT,STPMIN, ETOTALTMP, RMSTMP, USEFRAC, STIME, FTIME, &
 49:   &                 ETOTAL, LASTGOODE, RMS, STEPTOT, LINTCONSTRAINTTOL, LXYZ(2*3*NATOMS), & 47:   &                 ETOTAL, LASTGOODE, RMS, STEPTOT, LINTCONSTRAINTTOL, LXYZ(2*3*NATOMS), &
 50:   &                 BESTWORST, WORST 48:   &                 BESTWORST, WORST
 51: DOUBLE PRECISION, DIMENSION(MUPDATE)     :: RHO1,ALPHA 49: DOUBLE PRECISION, DIMENSION(MUPDATE)     :: RHO1,ALPHA
 52: DOUBLE PRECISION :: EOLD, DMOVED(NATOMS) 50: DOUBLE PRECISION :: EOLD, DMOVED(NATOMS)
 53: LOGICAL SWITCHED 51: LOGICAL SWITCHED
 54: DOUBLE PRECISION, POINTER :: X(:), G(:) 52: DOUBLE PRECISION, POINTER :: X(:), G(:)
 61: ! Dimensions involving INTIMAGE 59: ! Dimensions involving INTIMAGE
 62: ! 60: !
 63: DOUBLE PRECISION, ALLOCATABLE :: TRUEEE(:), & 61: DOUBLE PRECISION, ALLOCATABLE :: TRUEEE(:), &
 64:   &              EEETMP(:), MYGTMP(:), EEE(:), STEPIMAGE(:), & 62:   &              EEETMP(:), MYGTMP(:), EEE(:), STEPIMAGE(:), &
 65:   &              GTMP(:), DIAG(:), STP(:), SEARCHSTEP(:,:), GDIF(:,:), GLAST(:), XSAVE(:) 63:   &              GTMP(:), DIAG(:), STP(:), SEARCHSTEP(:,:), GDIF(:,:), GLAST(:), XSAVE(:)
 66: DOUBLE PRECISION, ALLOCATABLE, TARGET :: XYZ(:), GGG(:), DPTMP(:), D2TMP(:,:) 64: DOUBLE PRECISION, ALLOCATABLE, TARGET :: XYZ(:), GGG(:), DPTMP(:), D2TMP(:,:)
 67: ! saved interpolation 65: ! saved interpolation
 68: DOUBLE PRECISION, ALLOCATABLE :: BESTXYZ(:), BESTEEE(:) 66: DOUBLE PRECISION, ALLOCATABLE :: BESTXYZ(:), BESTEEE(:)
 69: INTEGER BESTINTIMAGE, NSTEPS, NITERUSE 67: INTEGER BESTINTIMAGE, NSTEPS, NITERUSE
 70: LOGICAL, ALLOCATABLE :: CHECKG(:), IMGFREEZE(:) 68: LOGICAL, ALLOCATABLE :: CHECKG(:), IMGFREEZE(:)
 71: LOGICAL READIMAGET 
 72: INTEGER LUNIT, GETUNIT 
 73: CHARACTER(LEN=2) SDUMMY 
 74:  
 75: READIMAGET=.TRUE. 
 76: READIMAGET=.FALSE. 
 77: IF (READIMAGET) THEN 
 78:    LUNIT=GETUNIT() 
 79:    OPEN(UNIT=LUNIT,FILE='restart.xyz',STATUS='OLD') 
 80:    INTIMAGE=0 
 81: 653 CONTINUE 
 82:    READ(LUNIT,*,END=654) NDUMMY 
 83:    READ(LUNIT,*)  
 84:    DO J1=1,NATOMS 
 85:       READ(LUNIT,*) SDUMMY, DUMMYX, DUMMYY, DUMMYZ 
 86: !     WRITE(MYUNIT,'(A,I6,A2,3G20.10)') 'J1,sd,xd,yd,zd=',J1,SDUMMY, DUMMYX, DUMMYY, DUMMYZ 
 87:    ENDDO 
 88:    INTIMAGE=INTIMAGE+1 
 89:    GOTO 653 
 90: 654 CONTINUE 
 91:    INTIMAGE=INTIMAGE-2 
 92:    WRITE(MYUNIT,'(A,I10,A)') 'intlbfgs> Rereading ',INTIMAGE,' frames' 
 93: ENDIF 
 94:  69: 
 95: ALLOCATE(TRUEEE(INTIMAGE+2), & 70: ALLOCATE(TRUEEE(INTIMAGE+2), &
 96:   &      EEETMP(INTIMAGE+2), MYGTMP(3*NATOMS*INTIMAGE), & 71:   &      EEETMP(INTIMAGE+2), MYGTMP(3*NATOMS*INTIMAGE), &
 97:   &      GTMP(3*NATOMS*INTIMAGE), & 72:   &      GTMP(3*NATOMS*INTIMAGE), &
 98:   &      DIAG(3*NATOMS*INTIMAGE), STP(3*NATOMS*INTIMAGE), SEARCHSTEP(0:MUPDATE,(3*NATOMS)*INTIMAGE), & 73:   &      DIAG(3*NATOMS*INTIMAGE), STP(3*NATOMS*INTIMAGE), SEARCHSTEP(0:MUPDATE,(3*NATOMS)*INTIMAGE), &
 99:   &      GDIF(0:MUPDATE,(3*NATOMS)*INTIMAGE),GLAST((3*NATOMS)*INTIMAGE), XSAVE((3*NATOMS)*INTIMAGE), & 74:   &      GDIF(0:MUPDATE,(3*NATOMS)*INTIMAGE),GLAST((3*NATOMS)*INTIMAGE), XSAVE((3*NATOMS)*INTIMAGE), &
100:   &      XYZ((3*NATOMS)*(INTIMAGE+2)), GGG((3*NATOMS)*(INTIMAGE+2)), CHECKG((3*NATOMS)*INTIMAGE), IMGFREEZE(INTIMAGE), & 75:   &      XYZ((3*NATOMS)*(INTIMAGE+2)), GGG((3*NATOMS)*(INTIMAGE+2)), CHECKG((3*NATOMS)*INTIMAGE), IMGFREEZE(INTIMAGE), &
101:   &      EEE(INTIMAGE+2), STEPIMAGE(INTIMAGE)) 76:   &      EEE(INTIMAGE+2), STEPIMAGE(INTIMAGE))
102: ALLOCATE(BESTXYZ((3*NATOMS)*(INTIMAGE+2)),BESTEEE(INTIMAGE+2)) 77: ALLOCATE(BESTXYZ((3*NATOMS)*(INTIMAGE+2)),BESTEEE(INTIMAGE+2))
103:  78: 
134: !109: !
135: IF (.NOT.ALLOCATED(CONI)) THEN 110: IF (.NOT.ALLOCATED(CONI)) THEN 
136:    ALLOCATE(CONI(INTCONMAX),CONJ(INTCONMAX),CONDISTREF(INTCONMAX),CONCUT(INTCONMAX))111:    ALLOCATE(CONI(INTCONMAX),CONJ(INTCONMAX),CONDISTREF(INTCONMAX),CONCUT(INTCONMAX))
137:    ALLOCATE(REPI(NREPMAX),REPJ(NREPMAX),NREPI(NREPMAX),NREPJ(NREPMAX),REPCUT(NREPMAX),NREPCUT(NREPMAX))112:    ALLOCATE(REPI(NREPMAX),REPJ(NREPMAX),NREPI(NREPMAX),NREPJ(NREPMAX),REPCUT(NREPMAX),NREPCUT(NREPMAX))
138: ENDIF113: ENDIF
139: X=>XYZ((3*NATOMS)+1:(3*NATOMS)*(INTIMAGE+1))114: X=>XYZ((3*NATOMS)+1:(3*NATOMS)*(INTIMAGE+1))
140: G=>GGG((3*NATOMS)+1:(3*NATOMS)*(INTIMAGE+1))115: G=>GGG((3*NATOMS)+1:(3*NATOMS)*(INTIMAGE+1))
141: !116: !
142: ! Initialise XYZ117: ! Initialise XYZ
143: !118: !
144: IF (READIMAGET) THEN119: XYZ(1:(3*NATOMS))=QSTART(1:(3*NATOMS))
145:    REWIND(LUNIT)120: XYZ((3*NATOMS)*(INTIMAGE+1)+1:(3*NATOMS)*(INTIMAGE+2))=QFINISH(1:(3*NATOMS))
146:    DO J2=1,INTIMAGE+2121: DO J1=1,INTIMAGE+2
147:       READ(LUNIT,*) NDUMMY122:    XYZ((J1-1)*(3*NATOMS)+1:J1*(3*NATOMS))=((INTIMAGE+2-J1)*QSTART(1:(3*NATOMS))+(J1-1)*QFINISH(1:(3*NATOMS)))/(INTIMAGE+1)
148:       READ(LUNIT,*) 123: ENDDO
149:       DO J1=1,NATOMS124:       WRITE(MYUNIT,'(A)') 'intlbfgs> here Z'
150:          READ(LUNIT,*) SDUMMY,XYZ(3*NATOMS*(J2-1)+3*(J1-1)+1),XYZ(3*NATOMS*(J2-1)+3*(J1-1)+2),XYZ(3*NATOMS*(J2-1)+3*(J1-1)+3)125:       WRITE(MYUNIT,'(6G20.10)') XYZ(3*(398-1)+1:3*(398-1)+3), &
151:       ENDDO126:   &                             XYZ((INTIMAGE+1)*3*NATOMS+3*(398-1)+1:(INTIMAGE+1)*3*NATOMS+3*(398-1)+3)
152:    ENDDO127:       WRITE(MYUNIT,'(6G20.10)') XYZ(3*(400-1)+1:3*(400-1)+3), &
153:    CLOSE(LUNIT)128:   &                             XYZ((INTIMAGE+1)*3*NATOMS+3*(400-1)+1:(INTIMAGE+1)*3*NATOMS+3*(400-1)+3)
154: ELSE129:       WRITE(MYUNIT,'(6G20.10)') QSTART(1:6)
155:    XYZ(1:(3*NATOMS))=QSTART(1:(3*NATOMS))130:       WRITE(MYUNIT,'(6G20.10)') QFINISH(1:6)
156:    XYZ((3*NATOMS)*(INTIMAGE+1)+1:(3*NATOMS)*(INTIMAGE+2))=QFINISH(1:(3*NATOMS)) 
157:    DO J1=1,INTIMAGE+2 
158:       XYZ((J1-1)*(3*NATOMS)+1:J1*(3*NATOMS))=((INTIMAGE+2-J1)*QSTART(1:(3*NATOMS))+(J1-1)*QFINISH(1:(3*NATOMS)))/(INTIMAGE+1) 
159:    ENDDO 
160: ENDIF 
161: 131: 
162: NQCIFREEZE=0132: NQCIFREEZE=0
163: IF (FREEZE) THEN133: IF (FREEZE) THEN
164:    WRITE(MYUNIT,'(A)') ' intlbfgs> ERROR *** QCI has not been coded for frozen atoms yet'134:    WRITE(MYUNIT,'(A)') ' intlbfgs> ERROR *** QCI has not been coded for frozen atoms yet'
165:    STOP     135:    STOP     
166: ENDIF136: ENDIF
167: IF (ALLOCATED(INTFROZEN)) DEALLOCATE(INTFROZEN)137: IF (ALLOCATED(INTFROZEN)) DEALLOCATE(INTFROZEN)
168: ALLOCATE(INTFROZEN(NATOMS))138: ALLOCATE(INTFROZEN(NATOMS))
169: INTFROZEN(1:NATOMS)=.FALSE.139: INTFROZEN(1:NATOMS)=.FALSE.
170: DLIST(1:NATOMS)=-1140: DLIST(1:NATOMS)=-1
190:             ENDDO160:             ENDDO
191:             DMOVED(J2)=DF161:             DMOVED(J2)=DF
192:             DLIST(J2)=J1162:             DLIST(J2)=J1
193:             EXIT sortd163:             EXIT sortd
194:          ENDIF164:          ENDIF
195:       ENDDO sortd165:       ENDDO sortd
196:    ENDDO166:    ENDDO
197:    WRITE(MYUNIT,'(A,I6,A,F12.6,A,I6)') ' intlbfgs> Total number of atoms moving less than threshold=',NQCIFREEZE167:    WRITE(MYUNIT,'(A,I6,A,F12.6,A,I6)') ' intlbfgs> Total number of atoms moving less than threshold=',NQCIFREEZE
198: ENDIF168: ENDIF
199: 169: 
 170:       WRITE(MYUNIT,'(6G20.10)') XYZ(3*(398-1)+1:3*(398-1)+3), &
 171:   &                             XYZ((INTIMAGE+1)*3*NATOMS+3*(398-1)+1:(INTIMAGE+1)*3*NATOMS+3*(398-1)+3)
 172:       WRITE(MYUNIT,'(6G20.10)') XYZ(3*(400-1)+1:3*(400-1)+3), &
 173:   &                             XYZ((INTIMAGE+1)*3*NATOMS+3*(400-1)+1:(INTIMAGE+1)*3*NATOMS+3*(400-1)+3)
 174: 
200: IF (NATOMS-NQCIFREEZE.LT.INTFREEZEMIN) THEN175: IF (NATOMS-NQCIFREEZE.LT.INTFREEZEMIN) THEN
201:    DO J1=NATOMS,NATOMS-INTFREEZEMIN+1,-1176:    DO J1=NATOMS,NATOMS-INTFREEZEMIN+1,-1
202:       INTFROZEN(DLIST(J1))=.FALSE.177:       INTFROZEN(DLIST(J1))=.FALSE.
203:    ENDDO178:    ENDDO
204:    NQCIFREEZE=MAX(0,NATOMS-INTFREEZEMIN)179:    NQCIFREEZE=NATOMS-INTFREEZEMIN
205:    WRITE(MYUNIT,'(A,I6,A)') ' intlbfgs> Freezing ',NQCIFREEZE,' atoms'180:    WRITE(MYUNIT,'(A,I6,A)') ' intlbfgs> Freezing ',NQCIFREEZE,' atoms'
206: ENDIF181: ENDIF
207: 182: 
208: NLASTGOODE=0183: NLASTGOODE=0
209: LASTGOODE=1.0D100184: LASTGOODE=1.0D100
210: 185: 
211: !186: !
212: ! Constraints are collected in a list and activated via the CONACTIVE(J1)187: ! Constraints are collected in a list and activated via the CONACTIVE(J1)
213: ! logical array. There will generally be of order NATOMS. However, the188: ! logical array. There will generally be of order NATOMS. However, the
214: ! repulsions will scale as NATOMS**2 and are treated differently. The189: ! repulsions will scale as NATOMS**2 and are treated differently. The
234:    WRITE(MYUNIT,'(A)') ' intlbfgs> All atoms move less than threshold - skip to linear interpolation for end points'209:    WRITE(MYUNIT,'(A)') ' intlbfgs> All atoms move less than threshold - skip to linear interpolation for end points'
235:    INTIMAGE=0210:    INTIMAGE=0
236:    XYZ(1:(3*NATOMS))=QSTART(1:(3*NATOMS))211:    XYZ(1:(3*NATOMS))=QSTART(1:(3*NATOMS))
237:    XYZ((3*NATOMS)*(INTIMAGE+1)+1:(3*NATOMS)*(INTIMAGE+2))=QFINISH(1:(3*NATOMS))212:    XYZ((3*NATOMS)*(INTIMAGE+1)+1:(3*NATOMS)*(INTIMAGE+2))=QFINISH(1:(3*NATOMS))
238:    DO J1=1,INTIMAGE+2213:    DO J1=1,INTIMAGE+2
239:       XYZ((J1-1)*(3*NATOMS)+1:J1*(3*NATOMS))=((INTIMAGE+2-J1)*QSTART(1:(3*NATOMS))+(J1-1)*QFINISH(1:(3*NATOMS)))/(INTIMAGE+1)214:       XYZ((J1-1)*(3*NATOMS)+1:J1*(3*NATOMS))=((INTIMAGE+2-J1)*QSTART(1:(3*NATOMS))+(J1-1)*QFINISH(1:(3*NATOMS)))/(INTIMAGE+1)
240:    ENDDO215:    ENDDO
241:    GOTO 678216:    GOTO 678
242: ENDIF217: ENDIF
243: 218: 
244: IF (READIMAGET) THEN 
245:    NACTIVE=NATOMS 
246:    DO J1=1,NATOMS 
247:       TURNONORDER(J1)=J1 ! fake initialisation 
248:    ENDDO 
249:    ATOMACTIVE(1:NATOMS)=.TRUE. 
250:    CONACTIVE(1:NCONSTRAINT)=.TRUE. 
251:    GLAST(1:D)=G(1:D) 
252:    XSAVE(1:D)=X(1:D) 
253:    GOTO 986 
254: ENDIF 
255: NACTIVE=0219: NACTIVE=0
256: TURNONORDER(1:NATOMS)=0 
257: ATOMACTIVE(1:NATOMS)=.FALSE.220: ATOMACTIVE(1:NATOMS)=.FALSE.
258: IF (INTFREEZET) THEN221: IF (INTFREEZET) THEN
259:    DO J1=1,NATOMS222:    DO J1=1,NATOMS
260:       IF (INTFROZEN(J1)) THEN223:       IF (INTFROZEN(J1)) THEN
261: ! 224: ! 
262: ! linear interpolation 225: ! linear interpolation 
263: ! 226: ! 
264:          DO J2=2,INTIMAGE+1227:          DO J2=2,INTIMAGE+1
265:             XYZ((J2-1)*3*NATOMS+3*(J1-1)+1:(J2-1)*3*NATOMS+3*(J1-1)+3)= &228:             XYZ((J2-1)*3*NATOMS+3*(J1-1)+1:(J2-1)*3*NATOMS+3*(J1-1)+3)= &
266:   &            (INTIMAGE-J2+2)*XYZ(3*(J1-1)+1:3*(J1-1)+3)/(INTIMAGE+1) &229:   &            (INTIMAGE-J2+2)*XYZ(3*(J1-1)+1:3*(J1-1)+3)/(INTIMAGE+1) &
280: ALLOCATE(CONDISTREFLOCAL(NCONSTRAINT))243: ALLOCATE(CONDISTREFLOCAL(NCONSTRAINT))
281: ALLOCATE(CONCUTLOCAL(NCONSTRAINT))244: ALLOCATE(CONCUTLOCAL(NCONSTRAINT))
282: IF (ALLOCATED(CONDISTREFLOCALON)) DEALLOCATE(CONDISTREFLOCALON)245: IF (ALLOCATED(CONDISTREFLOCALON)) DEALLOCATE(CONDISTREFLOCALON)
283: IF (ALLOCATED(CONDISTREFON)) DEALLOCATE(CONDISTREFON)246: IF (ALLOCATED(CONDISTREFON)) DEALLOCATE(CONDISTREFON)
284: IF (ALLOCATED(CONION)) DEALLOCATE(CONION)247: IF (ALLOCATED(CONION)) DEALLOCATE(CONION)
285: IF (ALLOCATED(CONJON)) DEALLOCATE(CONJON)248: IF (ALLOCATED(CONJON)) DEALLOCATE(CONJON)
286: ALLOCATE(CONDISTREFLOCALON(NCONSTRAINT),CONDISTREFON(NCONSTRAINT),CONION(NCONSTRAINT),CONJON(NCONSTRAINT))249: ALLOCATE(CONDISTREFLOCALON(NCONSTRAINT),CONDISTREFON(NCONSTRAINT),CONION(NCONSTRAINT),CONJON(NCONSTRAINT))
287: CONDISTREFLOCAL(1:NCONSTRAINT)=CONDISTREF(1:NCONSTRAINT)250: CONDISTREFLOCAL(1:NCONSTRAINT)=CONDISTREF(1:NCONSTRAINT)
288: CONCUTLOCAL(1:NCONSTRAINT)=CONCUT(1:NCONSTRAINT)251: CONCUTLOCAL(1:NCONSTRAINT)=CONCUT(1:NCONSTRAINT)
289: DUMMY=1.0D100252: DUMMY=1.0D100
290: DUMMY2=-1.0D100 
291: IF (NCONSTRAINT.EQ.0) THEN253: IF (NCONSTRAINT.EQ.0) THEN
292:    NACTIVE=NATOMS254:    NACTIVE=NATOMS
293:    EOLD=ETOTAL255:    EOLD=ETOTAL
294:    SWITCHED=.TRUE.256:    SWITCHED=.TRUE.
295:    USEFRAC=1.0D0257:    USEFRAC=1.0D0
296:    NREPULSIVE=0258:    NREPULSIVE=0
297:    NNREPULSIVE=0259:    NNREPULSIVE=0
298:    GLAST(1:D)=G(1:D)260:    GLAST(1:D)=G(1:D)
299:    XSAVE(1:D)=X(1:D)261:    XSAVE(1:D)=X(1:D)
300:    GOTO 567262:    GOTO 567
301: ENDIF263: ENDIF
302: DO J1=1,NCONSTRAINT264: DO J1=1,NCONSTRAINT
303:    DF=SQRT((XYZ(3*(CONI(J1)-1)+1)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONI(J1)-1)+1))**2 &265:    DF=SQRT((XYZ(3*(CONI(J1)-1)+1)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONI(J1)-1)+1))**2 &
304:   &       +(XYZ(3*(CONI(J1)-1)+2)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONI(J1)-1)+2))**2 &266:   &       +(XYZ(3*(CONI(J1)-1)+2)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONI(J1)-1)+2))**2 &
305:   &       +(XYZ(3*(CONI(J1)-1)+3)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONI(J1)-1)+3))**2)&267:   &       +(XYZ(3*(CONI(J1)-1)+3)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONI(J1)-1)+3))**2)&
306:   &  +SQRT((XYZ(3*(CONJ(J1)-1)+1)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONJ(J1)-1)+1))**2 &268:   &  +SQRT((XYZ(3*(CONJ(J1)-1)+1)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONJ(J1)-1)+1))**2 &
307:   &       +(XYZ(3*(CONJ(J1)-1)+2)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONJ(J1)-1)+2))**2 &269:   &       +(XYZ(3*(CONJ(J1)-1)+2)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONJ(J1)-1)+2))**2 &
308:   &       +(XYZ(3*(CONJ(J1)-1)+3)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONJ(J1)-1)+3))**2)270:   &       +(XYZ(3*(CONJ(J1)-1)+3)-XYZ((INTIMAGE+1)*3*NATOMS+3*(CONJ(J1)-1)+3))**2)
309: !  IF (J1.EQ.3505) THEN271:    IF (J1.EQ.3505) THEN
310: !     WRITE(MYUNIT,'(A,3I10)') 'intlbfgs> J1,CONI(J1),CONJ(J1)=',J1,CONI(J1),CONJ(J1)272:       WRITE(MYUNIT,'(A,3I10)') 'intlbfgs> J1,CONI(J1),CONJ(J1)=',J1,CONI(J1),CONJ(J1)
311: !     WRITE(MYUNIT,'(6G20.10)') XYZ(3*(CONI(J1)-1)+1:3*(CONI(J1)-1)+3), &273:       WRITE(MYUNIT,'(6G20.10)') XYZ(3*(CONI(J1)-1)+1:3*(CONI(J1)-1)+3), &
312: ! &                             XYZ((INTIMAGE+1)*3*NATOMS+3*(CONI(J1)-1)+1:(INTIMAGE+1)*3*NATOMS+3*(CONI(J1)-1)+3)274:   &                             XYZ((INTIMAGE+1)*3*NATOMS+3*(CONI(J1)-1)+1:(INTIMAGE+1)*3*NATOMS+3*(CONI(J1)-1)+3)
313: !     WRITE(MYUNIT,'(6G20.10)') XYZ(3*(CONJ(J1)-1)+1:3*(CONJ(J1)-1)+3), &275:       WRITE(MYUNIT,'(6G20.10)') XYZ(3*(CONJ(J1)-1)+1:3*(CONJ(J1)-1)+3), &
314: ! &                             XYZ((INTIMAGE+1)*3*NATOMS+3*(CONJ(J1)-1)+1:(INTIMAGE+1)*3*NATOMS+3*(CONJ(J1)-1)+3)276:   &                             XYZ((INTIMAGE+1)*3*NATOMS+3*(CONJ(J1)-1)+1:(INTIMAGE+1)*3*NATOMS+3*(CONJ(J1)-1)+3)
315: !  ENDIF277:    ENDIF
316:    IF (DF.LT.DUMMY) THEN278:    IF (DF.LT.DUMMY) THEN
317:       NBEST=J1279:       NBEST=J1
318:       DUMMY=DF280:       DUMMY=DF
319:    ENDIF281:    ENDIF
320:    IF (DF.GT.DUMMY2) THEN 
321:       NBEST2=J1 
322:       DUMMY2=DF 
323:    ENDIF 
324: ENDDO282: ENDDO
325: IF (DEBUG) WRITE(MYUNIT,'(A,I6,A,2I6,A,F15.5)') ' intlbfgs> Smallest overall motion for constraint ',NBEST, ' atoms ', &283: IF (DEBUG) WRITE(MYUNIT,'(A,I6,A,2I6,A,F15.5)') ' intlbfgs> Smallest overall motion for constraint ',NBEST,' atoms ', &
326:   &                           CONI(NBEST),CONJ(NBEST),' distance=',DUMMY284:   &                           CONI(NBEST),CONJ(NBEST),' distance=',DUMMY
327: IF (DEBUG) WRITE(MYUNIT,'(A,I6,A,2I6,A,F15.5)') ' intlbfgs> Largest overall motion for constraint  ',NBEST2,' atoms ', & 
328:   &                           CONI(NBEST2),CONJ(NBEST2),' distance=',DUMMY2 
329: 285: 
330: !!! NBEST=NBEST2 !!!! DJW286: TURNONORDER(1:NATOMS)=0
331: NTRIES(1:NATOMS)=1287: NTRIES(1:NATOMS)=1
332: IF (ALLOCATED(CONACTIVE)) DEALLOCATE(CONACTIVE)288: IF (ALLOCATED(CONACTIVE)) DEALLOCATE(CONACTIVE)
333: ALLOCATE(CONACTIVE(NCONSTRAINT))289: ALLOCATE(CONACTIVE(NCONSTRAINT))
334: CONACTIVE(1:NCONSTRAINT)=.FALSE.290: CONACTIVE(1:NCONSTRAINT)=.FALSE.
335: CONACTIVE(NBEST)=.TRUE.291: CONACTIVE(NBEST)=.TRUE.
336: ATOMACTIVE(CONI(NBEST))=.TRUE.292: ATOMACTIVE(CONI(NBEST))=.TRUE.
337: ATOMACTIVE(CONJ(NBEST))=.TRUE.293: ATOMACTIVE(CONJ(NBEST))=.TRUE.
338: IF (.NOT.INTFROZEN(CONI(NBEST))) THEN294: IF (.NOT.INTFROZEN(CONI(NBEST))) THEN
339:    TURNONORDER(NACTIVE+1)=CONI(NBEST)295:    TURNONORDER(NACTIVE+1)=CONI(NBEST)
340:    NACTIVE=NACTIVE+1296:    NACTIVE=NACTIVE+1
341: ENDIF297: ENDIF
342: IF (.NOT.INTFROZEN(CONJ(NBEST))) THEN298: IF (.NOT.INTFROZEN(CONJ(NBEST))) THEN
343:    TURNONORDER(NACTIVE+1)=CONJ(NBEST)299:    TURNONORDER(NACTIVE+2)=CONJ(NBEST)
344:    NACTIVE=NACTIVE+1300:    NACTIVE=NACTIVE+1
345: ENDIF301: ENDIF
346: NTRIES(CONI(NBEST))=1302: NTRIES(CONI(NBEST))=1
347: NTRIES(CONJ(NBEST))=1303: NTRIES(CONJ(NBEST))=1
348: NREPULSIVE=0304: NREPULSIVE=0
349: NCONSTRAINTON=1305: NCONSTRAINTON=1
350: CONDISTREFLOCALON(1)=CONDISTREFLOCAL(NBEST)306: CONDISTREFLOCALON(1)=CONDISTREFLOCAL(NBEST)
351: CONDISTREFON(1)=CONDISTREF(NBEST)307: CONDISTREFON(1)=CONDISTREF(NBEST)
352: CONION(1)=CONI(NBEST)308: CONION(1)=CONI(NBEST)
353: CONJON(1)=CONJ(NBEST)309: CONJON(1)=CONJ(NBEST)
354: IF (DEBUG) WRITE(MYUNIT,'(A,I6)') ' intlbfgs> Number of active atoms is now ',NACTIVE310: IF (DEBUG) WRITE(MYUNIT,'(A,I6)') ' intlbfgs> Number of active atoms is now ',NACTIVE
355: !311: !
356: ! If INTFREEZET is true we need to add constraints and replusions to the frozen atoms.312: ! If INTFREEZET is true we need to add constraints and replusions to the frozen atoms.
357: ! ATOMACTIVE is .TRUE. for frozen atoms. 
358: !313: !
359: IF (INTFREEZET) THEN314: IF (INTFREEZET) THEN
360:    DO J1=1,NCONSTRAINT315: DO J1=1,NCONSTRAINT
361:       IF (CONACTIVE(J1)) CYCLE316:    IF (CONACTIVE(J1)) CYCLE
362:       IF ((CONI(J1).EQ.CONI(NBEST)).AND.(ATOMACTIVE(CONJ(J1))).OR.(CONJ(J1).EQ.CONI(NBEST)).AND.(ATOMACTIVE(CONI(J1)))) THEN317:    IF ((CONI(J1).EQ.CONI(NBEST)).AND.(ATOMACTIVE(CONJ(J1))).OR.(CONJ(J1).EQ.CONI(NBEST)).AND.(ATOMACTIVE(CONI(J1)))) THEN
363:          CONACTIVE(J1)=.TRUE.318:       CONACTIVE(J1)=.TRUE.
364:          IF (DEBUG) WRITE(MYUNIT,'(A,I6,A,2I6)') ' intlbfgs> Turning on constraint ',J1,' for atoms ',CONI(J1),CONJ(J1)319:       IF (DEBUG) WRITE(MYUNIT,'(A,I6,A,2I6)') ' intlbfgs> Turning on constraint ',J1,' for atoms ',CONI(J1),CONJ(J1)
365:       ENDIF320:    ENDIF
366:       IF ((CONI(J1).EQ.CONJ(NBEST)).AND.(ATOMACTIVE(CONJ(J1))).OR.(CONJ(J1).EQ.CONJ(NBEST)).AND.(ATOMACTIVE(CONI(J1)))) THEN321:    IF ((CONI(J1).EQ.CONJ(NBEST)).AND.(ATOMACTIVE(CONJ(J1))).OR.(CONJ(J1).EQ.CONJ(NBEST)).AND.(ATOMACTIVE(CONI(J1)))) THEN
367:          CONACTIVE(J1)=.TRUE.322:       CONACTIVE(J1)=.TRUE.
368:          IF (DEBUG) WRITE(MYUNIT,'(A,I6,A,2I6)') ' intlbfgs> Turning on constraint ',J1,' for atoms ',CONI(J1),CONJ(J1)323:       IF (DEBUG) WRITE(MYUNIT,'(A,I6,A,2I6)') ' intlbfgs> Turning on constraint ',J1,' for atoms ',CONI(J1),CONJ(J1)
369:       ENDIF324:    ENDIF
370:    ENDDO325: ENDDO
371: 326: 
372:    DO J1=1,NATOMS327: DO J1=1,NATOMS
373:       IF (.NOT.ATOMACTIVE(J1)) CYCLE ! identify active atoms328:    IF (.NOT.ATOMACTIVE(J1)) CYCLE ! identify active atoms
374:       IF (ABS(J1-CONI(NBEST)).LE.INTREPSEP) CYCLE ! no repulsion for atoms too close in sequence329:    IF (ABS(J1-CONI(NBEST)).LE.INTREPSEP) CYCLE ! no repulsion for atoms too close in sequence
375:       IF (INTFROZEN(J1).AND.INTFROZEN(CONI(NBEST))) CYCLE330:    IF (INTFROZEN(J1).AND.INTFROZEN(CONI(NBEST))) CYCLE
376:       DO J2=1,NCONSTRAINT331:    DO J2=1,NCONSTRAINT
377: !332: !
378: !  With MAXCONUSE set to a finite value there could be constraints for the new atom that are333: !  With MAXCONUSE set to a finite value there could be constraints for the new atom that are
379: !  not active. We don't want these to be changed to repulsion, surely?!334: !  not active. We don't want these to be changed to repulsion, surely?!
380: !  Or perhaps we do need to do something with them?335: !  Or perhaps we do need to do something with them?
381: !336: !
382:          IF (.NOT.CONACTIVE(J2)) CYCLE ! repulsions for constraints337:       IF (.NOT.CONACTIVE(J2)) CYCLE ! identify active constraints
383:          IF (((CONI(J2).EQ.J1).AND.(CONJ(J2).EQ.CONI(NBEST))).OR.((CONJ(J2).EQ.J1).AND.(CONI(J2).EQ.CONI(NBEST)))) GOTO 545338:       IF (((CONI(J2).EQ.J1).AND.(CONJ(J2).EQ.CONI(NBEST))).OR.((CONJ(J2).EQ.J1).AND.(CONI(J2).EQ.CONI(NBEST)))) GOTO 545
384:       ENDDO339:    ENDDO
385:       DMIN=1.0D100340:    DMIN=1.0D100
386:       DMAX=-1.0D0341:    DMAX=-1.0D0
387:       DO J2=1,INTIMAGE+2,INTIMAGE+1 ! only consider the end-point distances342:    DO J2=1,INTIMAGE+2,INTIMAGE+1 ! only consider the end-point distances
388:          DF=SQRT((XYZ((J2-1)*3*NATOMS+3*(CONI(NBEST)-1)+1)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+1))**2+ &343:       DF=SQRT((XYZ((J2-1)*3*NATOMS+3*(CONI(NBEST)-1)+1)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+1))**2+ &
389:   &           (XYZ((J2-1)*3*NATOMS+3*(CONI(NBEST)-1)+2)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+2))**2+ &344:   &           (XYZ((J2-1)*3*NATOMS+3*(CONI(NBEST)-1)+2)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+2))**2+ &
390:   &           (XYZ((J2-1)*3*NATOMS+3*(CONI(NBEST)-1)+3)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+3))**2)345:   &           (XYZ((J2-1)*3*NATOMS+3*(CONI(NBEST)-1)+3)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+3))**2)
391:          IF (DF.GT.DMAX) DMAX=DF346:       IF (DF.GT.DMAX) DMAX=DF
392:          IF (DF.LT.DMIN) DMIN=DF347:       IF (DF.LT.DMIN) DMIN=DF
393:       ENDDO348:    ENDDO
394: !349: !
395: ! Use the minimum of the end point distances and INTCONSTRAINREPCUT for each contact.350: ! Use the minimum of the end point distances and INTCONSTRAINREPCUT for each contact.
396: !351: !
397:       DMIN=MIN(DMIN-1.0D-3,INTCONSTRAINREPCUT)352:    DMIN=MIN(DMIN-1.0D-3,INTCONSTRAINREPCUT)
398:       NREPULSIVE=NREPULSIVE+1353:    NREPULSIVE=NREPULSIVE+1
399:       IF (NREPULSIVE.GT.NREPMAX) CALL REPDOUBLE354:    IF (NREPULSIVE.GT.NREPMAX) CALL REPDOUBLE
400:       REPI(NREPULSIVE)=J1355:    REPI(NREPULSIVE)=J1
401:       REPJ(NREPULSIVE)=CONI(NBEST)356:    REPJ(NREPULSIVE)=CONI(NBEST)
402:       REPCUT(NREPULSIVE)=DMIN357:    REPCUT(NREPULSIVE)=DMIN
403:       IF (DEBUG) WRITE(MYUNIT,'(A,I6,A,I6,A,F15.5)') ' intlbfgs> Adding repulsion for new atom ',CONI(NBEST),' with atom ',J1, &358: !  IF (DEBUG) WRITE(MYUNIT,'(A,I6,A,I6,A,F15.5)') ' intlbfgs> Adding repulsion for new atom ',CONI(NBEST),' with atom ',J1, &
404:   &                                          ' cutoff=',DMIN359: ! &                                          ' cutoff=',DMIN
405: 545   CONTINUE360: 545 CONTINUE
406:    ENDDO361: ENDDO
407: 362: 
408:    DO J1=1,NATOMS363: DO J1=1,NATOMS
409:       IF (.NOT.ATOMACTIVE(J1)) CYCLE ! identify active atoms364:    IF (ABS(J1-CONJ(NBEST)).LE.INTREPSEP) CYCLE ! no repulsion for atoms too close in sequence
410:       IF (ABS(J1-CONJ(NBEST)).LE.INTREPSEP) CYCLE ! no repulsion for atoms too close in sequence365:    IF (INTFROZEN(J1).AND.INTFROZEN(CONJ(NBEST))) CYCLE
411:       IF (INTFROZEN(J1).AND.INTFROZEN(CONJ(NBEST))) CYCLE366:    DO J2=1,NCONSTRAINT
412:       DO J2=1,NCONSTRAINT 
413: !367: !
414: !  With MAXCONUSE set to a finite value there could be constraints for the new atom that are368: !  With MAXCONUSE set to a finite value there could be constraints for the new atom that are
415: !  not active. We don't want these to be changed to repulsion, surely?!369: !  not active. We don't want these to be changed to repulsion, surely?!
416: !  Or perhaps we do need to do something with them?370: !  Or perhaps we do need to do something with them?
417: !371: !
418:          IF (.NOT.CONACTIVE(J2)) CYCLE ! identify active constraints372:       IF (.NOT.CONACTIVE(J2)) CYCLE ! identify active constraints
419:          IF (((CONI(J2).EQ.J1).AND.(CONJ(J2).EQ.CONJ(NBEST))).OR.((CONJ(J2).EQ.J1).AND.(CONI(J2).EQ.CONJ(NBEST)))) GOTO 541373:       IF (((CONI(J2).EQ.J1).AND.(CONJ(J2).EQ.CONJ(NBEST))).OR.((CONJ(J2).EQ.J1).AND.(CONI(J2).EQ.CONJ(NBEST)))) GOTO 541
420:       ENDDO374:    ENDDO
421:       DMIN=1.0D100375:    DMIN=1.0D100
422:       DMAX=-1.0D0376:    DMAX=-1.0D0
423:       DO J2=1,INTIMAGE+2,INTIMAGE+1 ! only consider the end-point distances377:    DO J2=1,INTIMAGE+2,INTIMAGE+1 ! only consider the end-point distances
424:          DF=SQRT((XYZ((J2-1)*3*NATOMS+3*(CONJ(NBEST)-1)+1)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+1))**2+ &378:       DF=SQRT((XYZ((J2-1)*3*NATOMS+3*(CONJ(NBEST)-1)+1)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+1))**2+ &
425:   &           (XYZ((J2-1)*3*NATOMS+3*(CONJ(NBEST)-1)+2)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+2))**2+ &379:   &           (XYZ((J2-1)*3*NATOMS+3*(CONJ(NBEST)-1)+2)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+2))**2+ &
426:   &           (XYZ((J2-1)*3*NATOMS+3*(CONJ(NBEST)-1)+3)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+3))**2)380:   &           (XYZ((J2-1)*3*NATOMS+3*(CONJ(NBEST)-1)+3)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+3))**2)
427:          IF (DF.GT.DMAX) DMAX=DF381:       IF (DF.GT.DMAX) DMAX=DF
428:          IF (DF.LT.DMIN) DMIN=DF382:       IF (DF.LT.DMIN) DMIN=DF
429:       ENDDO383:    ENDDO
430: !384: !
431: ! Use the minimum of the end point distances and INTCONSTRAINREPCUT for each contact.385: ! Use the minimum of the end point distances and INTCONSTRAINREPCUT for each contact.
432: !386: !
433:       DMIN=MIN(DMIN-1.0D-3,INTCONSTRAINREPCUT)387:    DMIN=MIN(DMIN-1.0D-3,INTCONSTRAINREPCUT)
434:       NREPULSIVE=NREPULSIVE+1388:    NREPULSIVE=NREPULSIVE+1
435:       IF (NREPULSIVE.GT.NREPMAX) CALL REPDOUBLE389:    IF (NREPULSIVE.GT.NREPMAX) CALL REPDOUBLE
436:       REPI(NREPULSIVE)=J1390:    REPI(NREPULSIVE)=J1
437:       REPJ(NREPULSIVE)=CONJ(NBEST)391:    REPJ(NREPULSIVE)=CONJ(NBEST)
438:       REPCUT(NREPULSIVE)=DMIN392:    REPCUT(NREPULSIVE)=DMIN
439:       IF (DEBUG) WRITE(MYUNIT,'(A,I6,A,I6,A,F15.5)') ' intlbfgs> Adding repulsion for new atom ',CONJ(NBEST),' with atom ',J1, &393: !  IF (DEBUG) WRITE(MYUNIT,'(A,I6,A,I6,A,F15.5)') ' intlbfgs> Adding repulsion for new atom ',CONJ(NBEST),' with atom ',J1, &
440:   &                                          ' cutoff=',DMIN394: ! &                                          ' cutoff=',DMIN
441: 541   CONTINUE395: 541 CONTINUE
442:    ENDDO396: ENDDO
443: ENDIF ! end of block to add constraints and repulstions for frozen atoms.397: ENDIF
444: CALL MYCPU_TIME(FTIME,.FALSE.)398: CALL MYCPU_TIME(FTIME,.FALSE.)
445: WRITE(MYUNIT,'(A,F10.1,A,I6)') ' intlbfgs> constrained potential finished, time=',FTIME-STIME,' number of repulsions=',NREPULSIVE399: WRITE(MYUNIT,'(A,F10.1)') ' intlbfgs> constrained potential finished, time=',FTIME-STIME
446: 986 CONTINUE 
447: STIME=FTIME400: STIME=FTIME
448: NSTEPSMAX=INTSTEPS1401: NSTEPSMAX=INTSTEPS1
449: !402: !
450: ! Don;t want to redistribute images before even taking a step, so don;t call CHECKSEP.403: ! Don;t want to redistribute images before even taking a step, so don;t call CHECKSEP.
451: ! Must call CHECKREP to initialise NNREULSIVE, NREPI, NREPJ, etc. SEGV otherwise on second cycle!404: ! Must call CHECKREP to initialise NNREULSIVE, NREPI, NREPJ, etc. SEGV otherwise on second cycle!
452: !405: !
453: ! To take BH-type steps in the QCI space, jump back here. Leave SWITCHED true.406: ! To take BH-type steps in the QCI space, jump back here. Leave SWITCHED true.
454: !407: !
455: BESTWORST=1.0D100408: BESTWORST=1.0D100
456: 9876 CONTINUE409: 9876 CONTINUE
483: !  Add next atom to active set if ADDATOM is true. 436: !  Add next atom to active set if ADDATOM is true. 
484: !  Constraints to atoms already in the active set are turned on437: !  Constraints to atoms already in the active set are turned on
485: !  and short-range repulsions to active atoms that are not distance constrained are turned on.438: !  and short-range repulsions to active atoms that are not distance constrained are turned on.
486: !  *** OLD Find nearest atom to active set attached by a constraint439: !  *** OLD Find nearest atom to active set attached by a constraint
487: !  *** NEW Find atom with most constraints to active set440: !  *** NEW Find atom with most constraints to active set
488: !  Turn on constraint terms for this atom with all previous members of the active set441: !  Turn on constraint terms for this atom with all previous members of the active set
489: !  Add repulsions to non-constrained atoms in this set442: !  Add repulsions to non-constrained atoms in this set
490: !  NTOADD is the number of atoms to add to the active set in each pass. 1 seems best!443: !  NTOADD is the number of atoms to add to the active set in each pass. 1 seems best!
491: !444: !
492:    IF (ADDATOM.AND.(NACTIVE.LT.NATOMS)) THEN445:    IF (ADDATOM.AND.(NACTIVE.LT.NATOMS)) THEN
493:  
494: !!!!!!!!!!!!!!!DEBUG DJW !!!!!!!!!!! 
495: !! 
496: !!               J2=0 
497: !!               DO J1=1,NREPULSIVEFIX 
498: !!!                 WRITE(MYUNIT,'(A,3I10,4L5)') 'doaddatom> J1,REPIFIX,REPJFIX,frozenI,frozenJ,activeI,activeJ=', & 
499: !!! &                 J1,REPIFIX(J1),REPJFIX(J1),INTFROZEN(REPIFIX(J1)),INTFROZEN(REPJFIX(J1)), & 
500: !!! &                 ATOMACTIVE(REPIFIX(J1)),ATOMACTIVE(REPJFIX(J1)) 
501: !!                  IF (INTFROZEN(REPIFIX(J1)).AND.INTFROZEN(REPJFIX(J1))) CYCLE 
502: !!                  IF (ATOMACTIVE(REPIFIX(J1)).AND.ATOMACTIVE(REPJFIX(J1))) THEN 
503: !!                     DO J3=1,NCONSTRAINTFIX 
504: !!!                       IF (.NOT.CONACTIVE(J3)) CYCLE ! repulsions for inactive constraints 
505: !!                        IF ((CONIFIX(J3).EQ.REPIFIX(J1)).AND.(CONJFIX(J3).EQ.REPJFIX(J1))) GOTO 963 
506: !!                        IF ((CONIFIX(J3).EQ.REPJFIX(J1)).AND.(CONJFIX(J3).EQ.REPIFIX(J1))) GOTO 963 
507: !!                     ENDDO 
508: !!                     J2=J2+1 
509: !!!                    WRITE(MYUNIT,'(A,I10,A,2I6)') 'doaddatom> repulsion ',J2,' between ',REPIFIX(J1),REPJFIX(J1) 
510: !!963                  CONTINUE 
511: !!                  ENDIF 
512: !!               ENDDO 
513: !!               WRITE(MYUNIT,'(A,I6,A)') 'doaddatom> Looks like there are ',J2,' possible repulsions before adding new atom' 
514: !! 
515: !!               NDUMMY=1 
516: !!               NREPULSIVE=0 
517: !!               DO J1=1,NATOMS 
518: !!                  IF (.NOT.ATOMACTIVE(J1)) CYCLE 
519: !!! 
520: !!! Make a list of repelling atoms here and then use it 
521: !!! CONI(J2) is always less than CONJ(J2) so we only need to 
522: !!! cycle over a given range of constraints and continue from 
523: !!! where we left off for the next atom j1 
524: !!! 
525: !!                  ADDREP(1:J1+INTREPSEP)=.FALSE. 
526: !!                  ADDREP(J1+INTREPSEP+1:NATOMS)=.TRUE. ! no repulsion for atoms too close in sequence 
527: !!                  IF (INTFROZEN(J1)) THEN 
528: !!                     DO J2=J1+INTREPSEP+1,NATOMS 
529: !!                        IF (INTFROZEN(J2)) ADDREP(J2)=.FALSE. 
530: !!                        IF (.NOT.ATOMACTIVE(J2)) ADDREP(J2)=.FALSE. 
531: !!                     ENDDO 
532: !!                  ENDIF 
533: !!                  myaddloop: DO J2=NDUMMY,NCONSTRAINTFIX 
534: !!!                    IF (.NOT.CONACTIVE(J2)) CYCLE myaddloop ! repulsions for inactive constraints 
535: !!                     IF (CONIFIX(J2).EQ.J1) THEN 
536: !!                        ADDREP(CONJFIX(J2))=.FALSE. 
537: !!! 
538: !!! The next line is different from make_conpot because we don't count the constraints 
539: !!! sequentially, due to the ATOMACTIVE(J1) test at the top. 
540: !!! 
541: !!                     ELSEIF (CONIFIX(J2).GT.J1) THEN 
542: !!                        NDUMMY=J2 ! for next atom 
543: !!                        EXIT myaddloop 
544: !!                     ENDIF 
545: !!                  ENDDO myaddloop 
546: !!                  myrep2: DO J2=J1+INTREPSEP+1,NATOMS 
547: !!                     IF (.NOT.ADDREP(J2)) CYCLE myrep2 
548: !!                     IF (.NOT.ATOMACTIVE(J2)) CYCLE myrep2 ! This line is not in make_conpot, where we want all possible repulsions. 
549: !!                     DMIN=1.0D100 
550: !!                     DO J3=1,INTIMAGE+2,INTIMAGE+1 ! only consider the end-point distances 
551: !!                        DF=SQRT((XYZ((J3-1)*3*NATOMS+3*(J2-1)+1)-XYZ((J3-1)*3*NATOMS+3*(J1-1)+1))**2+ & 
552: !!    &                     (XYZ((J3-1)*3*NATOMS+3*(J2-1)+2)-XYZ((J3-1)*3*NATOMS+3*(J1-1)+2))**2+ & 
553: !!    &                     (XYZ((J3-1)*3*NATOMS+3*(J2-1)+3)-XYZ((J3-1)*3*NATOMS+3*(J1-1)+3))**2) 
554: !!                        IF (DF.LT.DMIN) DMIN=DF 
555: !!                     ENDDO 
556: !! 
557: !!                     NREPULSIVE=NREPULSIVE+1 
558: !!                     REPI(NREPULSIVE)=J1 
559: !!                     REPJ(NREPULSIVE)=J2 
560: !!!                    WRITE(MYUNIT,'(A,I10,A,2I6)') 'doaddatom> repulsion ',NREPULSIVE,' between ',J1,J2 
561: !!! 
562: !!! Use the minimum of the end point distances and INTCONSTRAINREPCUT for each contact. 
563: !!! 
564: !!                     REPCUT(NREPULSIVE)=MIN(DMIN-1.0D-3,INTCONSTRAINREPCUT) 
565: !!                  ENDDO myrep2 
566: !!               ENDDO 
567: !!               WRITE(MYUNIT,'(A,I6,A)') ' intlbfgs> Now it looks like there are ',NREPULSIVE,' possible repulsions before adding new atom' 
568: !!!!!!!!!!!!!!!DEBUG DJW !!!!!!!!!!! 
569:  
570:       CALL DOADDATOM(NCONSTRAINT,NTRIES,NEWATOM,IMGFREEZE,INTIMAGE,XYZ,EEE,GGG,TURNONORDER,NITERDONE,NACTIVE)446:       CALL DOADDATOM(NCONSTRAINT,NTRIES,NEWATOM,IMGFREEZE,INTIMAGE,XYZ,EEE,GGG,TURNONORDER,NITERDONE,NACTIVE)
571:       NLASTGOODE=NITERDONE447:       NLASTGOODE=NITERDONE
572:       LASTGOODE=ETOTAL448:       LASTGOODE=ETOTAL
573:    ENDIF449:    ENDIF
574:    GTMP(1:D)=0.0D0450:    GTMP(1:D)=0.0D0
575:    CALL MAKESTEP(NITERUSE,POINT,DIAG,INTIMAGE,SEARCHSTEP,G,GTMP,STP,GDIF,NPT,D,RHO1,ALPHA)451:    CALL MAKESTEP(NITERUSE,POINT,DIAG,INTIMAGE,SEARCHSTEP,G,GTMP,STP,GDIF,NPT,D,RHO1,ALPHA)
576: !452: !
577: ! If the number of images has changed since G was declared then G is not the same453: ! If the number of images has changed since G was declared then G is not the same
578: ! size as Gtmp and Dot_Product cannot be used.454: ! size as Gtmp and Dot_Product cannot be used.
579: !455: !
628:    !  We now have the proposed step - update geometry and calculate new gradient504:    !  We now have the proposed step - update geometry and calculate new gradient
629:    NDECREASE=0505:    NDECREASE=0
630: 20 X(1:D) = X(1:D) + STP(1:D)*SEARCHSTEP(POINT,1:D)506: 20 X(1:D) = X(1:D) + STP(1:D)*SEARCHSTEP(POINT,1:D)
631: 507: 
632: !  IF (.NOT.SWITCHED) THEN508: !  IF (.NOT.SWITCHED) THEN
633:    IF (.TRUE.) THEN509:    IF (.TRUE.) THEN
634: !     IF ((RMS.LT.INTRMSTOL*1.0D10).AND.(MOD(NITERDONE,10).EQ.0).AND.(NSTEPSMAX-NITERDONE.GT.100)) &510: !     IF ((RMS.LT.INTRMSTOL*1.0D10).AND.(MOD(NITERDONE,10).EQ.0).AND.(NSTEPSMAX-NITERDONE.GT.100)) &
635: ! &               CALL CHECKSEP(NMAXINT,NMININT,INTIMAGE,XYZ,(3*NATOMS),NATOMS)511: ! &               CALL CHECKSEP(NMAXINT,NMININT,INTIMAGE,XYZ,(3*NATOMS),NATOMS)
636:       IF (MOD(NITERDONE,INTIMAGECHECK).EQ.0) THEN512:       IF (MOD(NITERDONE,INTIMAGECHECK).EQ.0) THEN
637: 864      CONTINUE ! for adding more than one image at a time513: 864      CONTINUE ! for adding more than one image at a time
638:          DMAX=-1.0D0514:          DMAX=0.0D0
639:          ADMAX=-1.0D0 
640:          DMIN=HUGE(1.0D0)515:          DMIN=HUGE(1.0D0)
641:          DO J1=1,INTIMAGE+1516:          DO J1=1,INTIMAGE+1
642:             DUMMY=0.0D0517:             DUMMY=0.0D0
643: !           DO J2=1,3*NATOMS518:             DO J2=1,3*NATOMS
644: !              IF (ATOMACTIVE((J2-1)/3+1)) THEN519:                IF (ATOMACTIVE((J2-1)/3+1)) THEN
645: !                 DUMMY=DUMMY+( XYZ((J1-1)*3*NATOMS+J2) - XYZ(J1*3*NATOMS+J2) )**2520:                   DUMMY=DUMMY+( XYZ((J1-1)*3*NATOMS+J2) - XYZ(J1*3*NATOMS+J2) )**2
646: !              ENDIF 
647: !           ENDDO 
648:             DO J2=1,NATOMS 
649:                IF (ATOMACTIVE(J2)) THEN 
650:                   ADUMMY=( XYZ((J1-1)*3*NATOMS+3*(J2-1)+1) - XYZ(J1*3*NATOMS+3*(J2-1)+1) )**2 & 
651:   &                     +( XYZ((J1-1)*3*NATOMS+3*(J2-1)+2) - XYZ(J1*3*NATOMS+3*(J2-1)+2) )**2 & 
652:   &                     +( XYZ((J1-1)*3*NATOMS+3*(J2-1)+3) - XYZ(J1*3*NATOMS+3*(J2-1)+3) )**2  
653:                   DUMMY=DUMMY+ADUMMY 
654:                   IF (ADUMMY.GT.ADMAX) THEN 
655:                      ADMAX=ADUMMY 
656:                      JA1=J1 
657:                      JA2=J2 
658:                   ENDIF 
659:                ENDIF521:                ENDIF
660:             ENDDO522:             ENDDO
661:             DUMMY=SQRT(DUMMY)523:             DUMMY=SQRT(DUMMY)
662:             IF (DUMMY.GT.DMAX) THEN524:             IF (DUMMY.GT.DMAX) THEN
663:                DMAX=DUMMY525:                DMAX=DUMMY
664:                JMAX=J1526:                JMAX=J1
665:             ENDIF527:             ENDIF
666:             IF (DUMMY.LT.DMIN) THEN528:             IF (DUMMY.LT.DMIN) THEN
667:                DMIN=DUMMY529:                DMIN=DUMMY
668:                JMIN=J1530:                JMIN=J1
669:             ENDIF531:             ENDIF
670: !            IF (DEBUG) WRITE(MYUNIT,'(A,I6,A,I6,A,G20.10)')' intlbfgs> distance between images ', &532:             IF (DEBUG) WRITE(MYUNIT,'(A,I6,A,I6,A,G20.10)')' intlbfgs> distance between images ', &
671: !  &                                                  J1,' and ',J1+1,' is ',DUMMY533:   &                                                  J1,' and ',J1+1,' is ',DUMMY
672: !!           IF (DEBUG) WRITE(MYUNIT,'(A,G20.10,A,I6,A,2I6)')' intlbfgs> largest atomic distance between images so far is ', & 
673: !! &                                                  SQRT(ADMAX),' for atom ',JA2,' and images ',JA1,JA1+1 
674:          ENDDO534:          ENDDO
675:          IF (DEBUG) WRITE(MYUNIT,'(A,G20.10,A,I6,A,2I6,A,I6)')' intlbfgs> largest atomic distance between images is ', &535:          IF ((DMAX.GT.IMSEPMAX).AND.(INTIMAGE.LT.MAXINTIMAGE)) THEN
676:   &                                                  SQRT(ADMAX),' for atom ',JA2,' and images ',JA1,JA1+1,' total images=',INTIMAGE 
677:          IF (DEBUG) WRITE(MYUNIT,'(A,G20.10,A,2I6)')' intlbfgs> largest image separation is ', & 
678:   &                                                  DMAX,' for images ',JMAX,JMAX+1 
679:          IF (DEBUG) WRITE(MYUNIT,'(A,G20.10,A,2I6)')' intlbfgs> smallest image separation is ', & 
680:   &                                                  DMIN,' for images ',JMIN,JMIN+1 
681:          IF (DEBUG) WRITE(MYUNIT,'(A,G20.10,A,G20.10)') 'intlbfgs> Mean image separation=',DUMMY2/(INTIMAGE+1),' per active atom=',DUMMY2/((INTIMAGE+1)*NACTIVE) 
682: !        IF ((DMAX.GT.IMSEPMAX).AND.(INTIMAGE.LT.MAXINTIMAGE)) THEN 
683:          IF ((SQRT(ADMAX).GT.IMSEPMAX).AND.(INTIMAGE.LT.MAXINTIMAGE)) THEN 
684:             JMAX=JA1 
685:             WRITE(MYUNIT,'(A,I6,A,I6,A,I6)') ' intlbfgs> Add an image between ',JMAX,' and ',JMAX+1,' INTIMAGE=',INTIMAGE536:             WRITE(MYUNIT,'(A,I6,A,I6,A,I6)') ' intlbfgs> Add an image between ',JMAX,' and ',JMAX+1,' INTIMAGE=',INTIMAGE
686:             NITERUSE=0537:             NITERUSE=0
687:             ALLOCATE(DPTMP(3*NATOMS*(INTIMAGE+2)))538:             ALLOCATE(DPTMP(3*NATOMS*(INTIMAGE+2)))
688:             DPTMP(1:3*NATOMS*(INTIMAGE+2))=XYZ(1:3*NATOMS*(INTIMAGE+2))539:             DPTMP(1:3*NATOMS*(INTIMAGE+2))=XYZ(1:3*NATOMS*(INTIMAGE+2))
689:             DEALLOCATE(XYZ)540:             DEALLOCATE(XYZ)
690:             ALLOCATE(XYZ(3*NATOMS*(INTIMAGE+3)))541:             ALLOCATE(XYZ(3*NATOMS*(INTIMAGE+3)))
691:             XYZ(1:3*NATOMS*JMAX)=DPTMP(1:3*NATOMS*JMAX)542:             XYZ(1:3*NATOMS*JMAX)=DPTMP(1:3*NATOMS*JMAX)
692:             XYZ(3*NATOMS*JMAX+1:3*NATOMS*(JMAX+1))=(DPTMP(3*NATOMS*(JMAX-1)+1:3*NATOMS*JMAX) &543:             XYZ(3*NATOMS*JMAX+1:3*NATOMS*(JMAX+1))=(DPTMP(3*NATOMS*(JMAX-1)+1:3*NATOMS*JMAX) &
693:   &                                               + DPTMP(3*NATOMS*JMAX+1:3*NATOMS*(JMAX+1)))/2.0D0544:   &                                               + DPTMP(3*NATOMS*JMAX+1:3*NATOMS*(JMAX+1)))/2.0D0
694:             XYZ(3*NATOMS*(JMAX+1)+1:3*NATOMS*(INTIMAGE+3))=DPTMP(3*NATOMS*JMAX+1:3*NATOMS*(INTIMAGE+2))545:             XYZ(3*NATOMS*(JMAX+1)+1:3*NATOMS*(INTIMAGE+3))=DPTMP(3*NATOMS*JMAX+1:3*NATOMS*(INTIMAGE+2))
754:             G=>GGG((3*NATOMS)+1:(3*NATOMS)*(INTIMAGE+2))605:             G=>GGG((3*NATOMS)+1:(3*NATOMS)*(INTIMAGE+2))
755:             INTIMAGE=INTIMAGE+1606:             INTIMAGE=INTIMAGE+1
756:             D=(3*NATOMS)*INTIMAGE607:             D=(3*NATOMS)*INTIMAGE
757:             CALL CHECKREP(INTIMAGE,XYZ,(3*NATOMS),0,1)608:             CALL CHECKREP(INTIMAGE,XYZ,(3*NATOMS),0,1)
758:             IF (CHECKCONINT) THEN609:             IF (CHECKCONINT) THEN
759:                CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)610:                CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
760:             ELSE611:             ELSE
761:                CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)612:                CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
762:             ENDIF613:             ENDIF
763: !           GOTO 864614: !           GOTO 864
764:          ENDIF615:          ELSEIF ((DMIN.LT.IMSEPMIN).AND.(INTIMAGE.GT.1)) THEN
765:          IF ((DMIN.LT.IMSEPMIN).AND.(INTIMAGE.GT.1)) THEN 
766:             IF (JMIN.EQ.1) JMIN=2616:             IF (JMIN.EQ.1) JMIN=2
767:             WRITE(MYUNIT,'(A,I6,A,I6)') ' intlbfgs> Remove image ',JMIN617:             WRITE(MYUNIT,'(A,I6,A,I6)') ' intlbfgs> Remove image ',JMIN
768:             NITERUSE=0618:             NITERUSE=0
769:             ALLOCATE(DPTMP(3*NATOMS*(INTIMAGE+2)))619:             ALLOCATE(DPTMP(3*NATOMS*(INTIMAGE+2)))
770:             DPTMP(1:3*NATOMS*(INTIMAGE+2))=XYZ(1:3*NATOMS*(INTIMAGE+2))620:             DPTMP(1:3*NATOMS*(INTIMAGE+2))=XYZ(1:3*NATOMS*(INTIMAGE+2))
771:             DEALLOCATE(XYZ)621:             DEALLOCATE(XYZ)
772:             ALLOCATE(XYZ(3*NATOMS*(INTIMAGE+1)))622:             ALLOCATE(XYZ(3*NATOMS*(INTIMAGE+1)))
773:             XYZ(1:3*NATOMS*(JMIN-1))=DPTMP(1:3*NATOMS*(JMIN-1))623:             XYZ(1:3*NATOMS*(JMIN-1))=DPTMP(1:3*NATOMS*(JMIN-1))
774:             XYZ(3*NATOMS*(JMIN-1)+1:3*NATOMS*(INTIMAGE+1))=DPTMP(3*NATOMS*JMIN+1:3*NATOMS*(INTIMAGE+2))624:             XYZ(3*NATOMS*(JMIN-1)+1:3*NATOMS*(INTIMAGE+1))=DPTMP(3*NATOMS*JMIN+1:3*NATOMS*(INTIMAGE+2))
775: 625: 
832:             INTIMAGE=INTIMAGE-1682:             INTIMAGE=INTIMAGE-1
833:             D=(3*NATOMS)*INTIMAGE683:             D=(3*NATOMS)*INTIMAGE
834:             CALL CHECKREP(INTIMAGE,XYZ,(3*NATOMS),0,1)684:             CALL CHECKREP(INTIMAGE,XYZ,(3*NATOMS),0,1)
835:             IF (CHECKCONINT) THEN685:             IF (CHECKCONINT) THEN
836:                CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)686:                CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
837:             ELSE687:             ELSE
838:                CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)688:                CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
839:             ENDIF689:             ENDIF
840: !           GOTO 864690: !           GOTO 864
841:          ENDIF691:          ENDIF
842:       ELSE 
843:          DMAX=-1.0D0 
844:          ADMAX=-1.0D0 
845:          DMIN=HUGE(1.0D0) 
846:          DUMMY2=0.0D0 
847:          DO J1=1,INTIMAGE+1 
848:             DUMMY=0.0D0 
849: !           DO J2=1,3*NATOMS 
850: !              IF (ATOMACTIVE((J2-1)/3+1)) THEN 
851: !                 DUMMY=DUMMY+( XYZ((J1-1)*3*NATOMS+J2) - XYZ(J1*3*NATOMS+J2) )**2 
852: !              ENDIF 
853: !           ENDDO 
854:             DO J2=1,NATOMS 
855:                IF (ATOMACTIVE(J2)) THEN 
856:                   ADUMMY=( XYZ((J1-1)*3*NATOMS+3*(J2-1)+1) - XYZ(J1*3*NATOMS+3*(J2-1)+1) )**2 & 
857:   &                     +( XYZ((J1-1)*3*NATOMS+3*(J2-1)+2) - XYZ(J1*3*NATOMS+3*(J2-1)+2) )**2 & 
858:   &                     +( XYZ((J1-1)*3*NATOMS+3*(J2-1)+3) - XYZ(J1*3*NATOMS+3*(J2-1)+3) )**2  
859:                   DUMMY=DUMMY+ADUMMY 
860:                   IF (ADUMMY.GT.ADMAX) THEN 
861:                      ADMAX=ADUMMY 
862:                      JA1=J1 
863:                      JA2=J2 
864:                   ENDIF 
865:                ENDIF 
866:             ENDDO 
867:             DUMMY=SQRT(DUMMY) 
868:             DUMMY2=DUMMY2+DUMMY 
869:             IF (DUMMY.GT.DMAX) THEN 
870:                DMAX=DUMMY 
871:                JMAX=J1 
872:             ENDIF 
873:             IF (DUMMY.LT.DMIN) THEN 
874:                DMIN=DUMMY 
875:                JMIN=J1 
876:             ENDIF 
877: !            IF (DEBUG) WRITE(MYUNIT,'(A,I6,A,I6,A,G20.10)')' intlbfgs> distance between images ', & 
878: !  &                                                  J1,' and ',J1+1,' is ',DUMMY 
879: !!           IF (DEBUG) WRITE(MYUNIT,'(A,G20.10,A,I6,A,2I6)')' intlbfgs> largest atomic distance between images so far is ', & 
880: !! &                                                  SQRT(ADMAX),' for atom ',JA2,' and images ',JA1,JA1+1 
881:          ENDDO 
882:          IF (DEBUG) WRITE(MYUNIT,'(A,G20.10,A,I6,A,2I6,A,I6)')' intlbfgs> largest atomic distance between images is ', & 
883:   &                                                  SQRT(ADMAX),' for atom ',JA2,' and images ',JA1,JA1+1,' total images=',INTIMAGE 
884:          IF (DEBUG) WRITE(MYUNIT,'(A,G20.10,A,2I6)')' intlbfgs> largest image separation is ', & 
885:   &                                                  DMAX,' for images ',JMAX,JMAX+1 
886:          IF (DEBUG) WRITE(MYUNIT,'(A,G20.10,A,G20.10)') 'intlbfgs> Mean image separation=',DUMMY2/(INTIMAGE+1),' per active atom=',DUMMY2/((INTIMAGE+1)*NACTIVE) 
887:          IF (SQRT(ADMAX).GT.IMSEPMAX) THEN 
888:             KINT=MIN(1.0D6,KINT*1.1D0) 
889:          ELSE 
890:             KINT=MAX(1.0D-6,KINT/1.1D0) 
891:          ENDIF 
892:          WRITE(MYUNIT,'(A,G20.10)') 'intlbfgs> Spring constant is now ',KINT 
893:       ENDIF692:       ENDIF
894:    ENDIF693:    ENDIF
895: !694: !
896: ! End of add/subtract images block.695: ! End of add/subtract images block.
897: !696: !
898:    IF (QCIPERMCHECK.AND.(MOD(NITERDONE,QCIPERMCHECKINT).EQ.0)) THEN 
899:       LDEBUG=.FALSE. 
900:       DO J2=2,INTIMAGE+2 
901:          CALL MINPERMDIST(XYZ((J2-2)*3*NATOMS+1:(J2-1)*3*NATOMS),XYZ((J2-1)*3*NATOMS+1:J2*3*NATOMS),NATOMS,LDEBUG, & 
902:   &                    BOXLX,BOXLY,BOXLZ,PERIODIC,TWOD,DIST,DIST2,RIGID,RMAT) 
903:       ENDDO 
904:    ENDIF 
905:  
906:    IF (.NOT.SWITCHED) THEN697:    IF (.NOT.SWITCHED) THEN
907:       IF (MOD(NITERDONE,CHECKREPINTERVAL).EQ.0) CALL CHECKREP(INTIMAGE,XYZ,(3*NATOMS),0,1)698:       IF (MOD(NITERDONE,CHECKREPINTERVAL).EQ.0) CALL CHECKREP(INTIMAGE,XYZ,(3*NATOMS),0,1)
908: !     IF (INTIMAGE.GT.300) THEN 
909: !        WRITE(MYUNIT,'(A,2L5)') 'atom 375 intfrozen and atomactive: ',INTFROZEN(375),ATOMACTIVE(375) 
910: !        WRITE(MYUNIT,'(A,2L5)') 'atom 384 intfrozen and atomactive: ',INTFROZEN(384),ATOMACTIVE(384) 
911: !        WRITE(MYUNIT,'(A,3G20.10)') 'atom 375 in image 284:',XYZ(3*400*283+3*374+1:3*400*283+3*374+3) 
912: !        WRITE(MYUNIT,'(A,3G20.10)') 'atom 375 in image 285:',XYZ(3*400*284+3*374+1:3*400*284+3*374+3) 
913: !        WRITE(MYUNIT,'(A,3G20.10)') 'atom 375 in image 286:',XYZ(3*400*285+3*374+1:3*400*285+3*374+3) 
914: !        WRITE(MYUNIT,'(A,3G20.10)') 'atom 384 in image 284:',XYZ(3*400*283+3*383+1:3*400*283+3*383+3) 
915: !        WRITE(MYUNIT,'(A,3G20.10)') 'atom 384 in image 285:',XYZ(3*400*284+3*383+1:3*400*284+3*383+3) 
916: !        WRITE(MYUNIT,'(A,3G20.10)') 'atom 384 in image 286:',XYZ(3*400*285+3*383+1:3*400*285+3*383+3) 
917: !     ENDIF 
918:       IF (CHECKCONINT) THEN699:       IF (CHECKCONINT) THEN
919:          CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)700:          CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
920:       ELSE701:       ELSE
921:          CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)702:          CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
922:       ENDIF703:       ENDIF
923: !     IF (INTIMAGE.GT.300) THEN 
924: !        WRITE(MYUNIT,'(A,3G20.10)') 'atom 375 in image 284 GGG:',GGG(3*400*283+3*374+1:3*400*283+3*374+3) 
925: !        WRITE(MYUNIT,'(A,3G20.10)') 'atom 375 in image 285 GGG:',GGG(3*400*284+3*374+1:3*400*284+3*374+3) 
926: !        WRITE(MYUNIT,'(A,3G20.10)') 'atom 375 in image 286 GGG:',GGG(3*400*285+3*374+1:3*400*285+3*374+3) 
927: !        WRITE(MYUNIT,'(A,3G20.10)') 'atom 384 in image 284 GGG:',GGG(3*400*283+3*383+1:3*400*283+3*383+3) 
928: !        WRITE(MYUNIT,'(A,3G20.10)') 'atom 384 in image 285 GGG:',GGG(3*400*284+3*383+1:3*400*284+3*383+3) 
929: !        WRITE(MYUNIT,'(A,3G20.10)') 'atom 384 in image 286 GGG:',GGG(3*400*285+3*383+1:3*400*285+3*383+3) 
930: !     ENDIF 
931:  
932:       IF ((ETOTAL-EOLD.LT.1.0D100).OR.ADDATOM) THEN ! MAXERISE effectively set to 1.0D100 here704:       IF ((ETOTAL-EOLD.LT.1.0D100).OR.ADDATOM) THEN ! MAXERISE effectively set to 1.0D100 here
933:          EOLD=ETOTAL705:          EOLD=ETOTAL
934:          GLAST(1:D)=G(1:D)706:          GLAST(1:D)=G(1:D)
935:          XSAVE(1:D)=X(1:D)707:          XSAVE(1:D)=X(1:D)
936:       ELSE708:       ELSE
937:          NDECREASE=NDECREASE+1709:          NDECREASE=NDECREASE+1
938:          IF (NDECREASE.GT.5) THEN710:          IF (NDECREASE.GT.5) THEN
939:             NFAIL=NFAIL+1711:             NFAIL=NFAIL+1
940:             WRITE(*,'(A,I6)') ' intlbfgs> WARNING *** in lbfgs cannot find a lower energy, NFAIL=',NFAIL712:             WRITE(*,'(A,I6)') ' intlbfgs> WARNING *** in lbfgs cannot find a lower energy, NFAIL=',NFAIL
941:             X(1:D)=XSAVE(1:D)713:             X(1:D)=XSAVE(1:D)
1049:                IF (CONI(J2).EQ.J1) THEN821:                IF (CONI(J2).EQ.J1) THEN
1050:                   ADDREP(CONJ(J2))=.FALSE.822:                   ADDREP(CONJ(J2))=.FALSE.
1051:                ELSE823:                ELSE
1052:                   NDUMMY=J2 ! for next atom824:                   NDUMMY=J2 ! for next atom
1053:                   EXIT addloop825:                   EXIT addloop
1054:                ENDIF826:                ENDIF
1055:             ENDDO addloop827:             ENDDO addloop
1056:             rep2: DO J2=J1+INTREPSEP+1,NATOMS828:             rep2: DO J2=J1+INTREPSEP+1,NATOMS
1057: 829: 
1058:                IF (.NOT.ADDREP(J2)) CYCLE830:                IF (.NOT.ADDREP(J2)) CYCLE
1059: ! 
1060: ! Don't we need to check atomactive here for backtracking? 
1061: ! 
1062: !              IF (.NOT.ATOMACTIVE(J2)) CYCLE  
1063: 831: 
1064:                DMIN=1.0D100832:                DMIN=1.0D100
1065:                DO J3=1,INTIMAGE+2,INTIMAGE+1 ! only consider the end-point distances833:                DO J3=1,INTIMAGE+2,INTIMAGE+1 ! only consider the end-point distances
1066:                   DF=SQRT((XYZ((J3-1)*3*NATOMS+3*(J2-1)+1)-XYZ((J3-1)*3*NATOMS+3*(J1-1)+1))**2+ &834:                   DF=SQRT((XYZ((J3-1)*3*NATOMS+3*(J2-1)+1)-XYZ((J3-1)*3*NATOMS+3*(J1-1)+1))**2+ &
1067:     &                     (XYZ((J3-1)*3*NATOMS+3*(J2-1)+2)-XYZ((J3-1)*3*NATOMS+3*(J1-1)+2))**2+ &835:     &                     (XYZ((J3-1)*3*NATOMS+3*(J2-1)+2)-XYZ((J3-1)*3*NATOMS+3*(J1-1)+2))**2+ &
1068:     &                     (XYZ((J3-1)*3*NATOMS+3*(J2-1)+3)-XYZ((J3-1)*3*NATOMS+3*(J1-1)+3))**2)836:     &                     (XYZ((J3-1)*3*NATOMS+3*(J2-1)+3)-XYZ((J3-1)*3*NATOMS+3*(J1-1)+3))**2)
1069:                   IF (DF.LT.DMIN) DMIN=DF837:                   IF (DF.LT.DMIN) DMIN=DF
1070:                ENDDO838:                ENDDO
1071: 839: 
1072:                NREPULSIVE=NREPULSIVE+1840:                NREPULSIVE=NREPULSIVE+1
1103:             CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)871:             CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
1104:          ENDIF872:          ENDIF
1105:       ENDIF873:       ENDIF
1106:       LASTGOODE=ETOTAL874:       LASTGOODE=ETOTAL
1107:    ENDIF875:    ENDIF
1108:    EXITSTATUS=0876:    EXITSTATUS=0
1109:    INTDGUESS=DIAG(1) ! should be ok for subsequent runs of the same system DJW877:    INTDGUESS=DIAG(1) ! should be ok for subsequent runs of the same system DJW
1110:    IF ((.NOT.SWITCHED).AND.(RMS<=INTRMSTOL).AND.NITERDONE>1) EXITSTATUS=1 878:    IF ((.NOT.SWITCHED).AND.(RMS<=INTRMSTOL).AND.NITERDONE>1) EXITSTATUS=1 
1111:    IF (SWITCHED.AND.(RMS<=CQMAX).AND.NITERDONE>1) EXITSTATUS=1 879:    IF (SWITCHED.AND.(RMS<=CQMAX).AND.NITERDONE>1) EXITSTATUS=1 
1112:    IF (NITERDONE==NSTEPSMAX) EXITSTATUS=2880:    IF (NITERDONE==NSTEPSMAX) EXITSTATUS=2
1113: !  IF (SQRT(ADMAX).GT.IMSEPMAX) EXITSTATUS=0 ! prevent converge if largest atomic displacement is too big 
1114:    IF ((.NOT.SWITCHED).AND.(MOD(NITERDONE,INTRELSTEPS).EQ.0)) EXITSTATUS=1 ! Add an atom every INTRELSTEPS !!! DJW 
1115: 881: 
1116:    IF (EXITSTATUS > 0) THEN  882:    IF (EXITSTATUS > 0) THEN  
1117:       IF ((.NOT.SWITCHED).AND.(EXITSTATUS.EQ.1)) THEN ! add active atom or restart with true potential on883:       IF ((.NOT.SWITCHED).AND.(EXITSTATUS.EQ.1)) THEN ! add active atom or restart with true potential on
1118:          IF (ETOTAL/INTIMAGE.GT.MAXCONE) GOTO 777884:          IF (ETOTAL/INTIMAGE.GT.MAXCONE) GOTO 777
1119:          IF (NACTIVE.LT.NATOMS) THEN 885:          IF (NACTIVE.LT.NATOMS) THEN 
1120:             ADDATOM=.TRUE.886:             ADDATOM=.TRUE.
1121:             GOTO 777887:             GOTO 777
1122:          ENDIF888:          ENDIF
1123:          CALL MYCPU_TIME(FTIME,.FALSE.)889:          CALL MYCPU_TIME(FTIME,.FALSE.)
1124:          WRITE(MYUNIT,'(A,I6,A,F12.6,A,I6,A,F10.1)') ' intlbfgs> switch on true potential at step ',NITERDONE, &890:          WRITE(MYUNIT,'(A,I6,A,F12.6,A,I6,A,F10.1)') ' intlbfgs> switch on true potential at step ',NITERDONE, &
1125:   &                                     ' fraction=',INTCONFRAC,' images=',INTIMAGE,' time=',FTIME-STIME891:   &                                     ' fraction=',INTCONFRAC,' images=',INTIMAGE,' time=',FTIME-STIME
1126:          IF (DEBUG) CALL INTRWG(NACTIVE,NITERDONE,INTIMAGE,XYZ)892:          IF (DEBUG) CALL RWG(NITERDONE,INTIMAGE,XYZ)
1127:          IF (DEBUG) CALL WRITEPROFILE(NITERDONE,EEE,INTIMAGE,MYUNIT)893:          IF (DEBUG) CALL WRITEPROFILE(NITERDONE,EEE,INTIMAGE,MYUNIT)
1128:          WRITE(MYUNIT,'(A,I6,A,F15.6)') ' intlbfgs> Allowing ',INTCONSTEPS,' further optimization steps'894:          WRITE(MYUNIT,'(A,I6,A,F15.6)') ' intlbfgs> Allowing ',INTCONSTEPS,' further optimization steps'
1129:          DO J1=1,NATOMS895:          DO J1=1,NATOMS
1130:             IF (.NOT.ATOMACTIVE(J1)) THEN896:             IF (.NOT.ATOMACTIVE(J1)) THEN
1131:                WRITE(MYUNIT,'(A,I6,A,I6,A)') ' intlbfgs> ERROR *** number of active atoms=',NACTIVE,' but atom ',J1,' is not active'897:                WRITE(MYUNIT,'(A,I6,A,I6,A)') ' intlbfgs> ERROR *** number of active atoms=',NACTIVE,' but atom ',J1,' is not active'
1132:             ENDIF898:             ENDIF
1133:          ENDDO899:          ENDDO
1134:          NSTEPSMAX=NITERDONE+INTCONSTEPS900:          NSTEPSMAX=NITERDONE+INTCONSTEPS
1135:          SWITCHED=.TRUE.901:          SWITCHED=.TRUE.
1136:          RMS=INTRMSTOL*10.0D0 ! to prevent premature convergence902:          RMS=INTRMSTOL*10.0D0 ! to prevent premature convergence
1150:    777 CONTINUE916:    777 CONTINUE
1151: !917: !
1152: ! Compute the new step and gradient change918: ! Compute the new step and gradient change
1153: !919: !
1154:    NPT=POINT*D920:    NPT=POINT*D
1155:    SEARCHSTEP(POINT,:) = STP*SEARCHSTEP(POINT,:)921:    SEARCHSTEP(POINT,:) = STP*SEARCHSTEP(POINT,:)
1156:    GDIF(POINT,:)=G-GTMP922:    GDIF(POINT,:)=G-GTMP
1157:    923:    
1158:    POINT=POINT+1; IF (POINT==MUPDATE) POINT=0924:    POINT=POINT+1; IF (POINT==MUPDATE) POINT=0
1159: 925: 
1160:    IF (DUMPINTXYZ.AND.MOD(NITERDONE,DUMPINTXYZFREQ)==0) CALL INTRWG(NACTIVE,NITERDONE,INTIMAGE,XYZ)926:    IF (DUMPINTXYZ.AND.MOD(NITERDONE,DUMPINTXYZFREQ)==0) CALL RWG(NITERDONE,INTIMAGE,XYZ)
1161:    IF (DUMPINTEOS.AND.MOD(NITERDONE,DUMPINTEOSFREQ)==0) CALL WRITEPROFILE(NITERDONE,EEE,INTIMAGE,MYUNIT)927:    IF (DUMPINTEOS.AND.MOD(NITERDONE,DUMPINTEOSFREQ)==0) CALL WRITEPROFILE(NITERDONE,EEE,INTIMAGE,MYUNIT)
1162: 928: 
1163:    NITERDONE=NITERDONE+1929:    NITERDONE=NITERDONE+1
1164:    NITERUSE=NITERUSE+1930:    NITERUSE=NITERUSE+1
1165: 931: 
1166:    IF (NITERDONE.GT.NSTEPSMAX) EXIT932:    IF (NITERDONE.GT.NSTEPSMAX) EXIT
1167:    IF (NACTIVE.EQ.NATOMS) THEN933:    IF (NACTIVE.EQ.NATOMS) THEN
1168:       IF (.NOT.SWITCHED) THEN934:       IF (.NOT.SWITCHED) THEN
1169:          CALL MYCPU_TIME(FTIME,.FALSE.)935:          CALL MYCPU_TIME(FTIME,.FALSE.)
1170:          WRITE(MYUNIT,'(A,I6,A,F12.6,A,I6,A,F10.1)') ' intlbfgs> switch on true potential at step ',NITERDONE, &936:          WRITE(MYUNIT,'(A,I6,A,F12.6,A,I6,A,F10.1)') ' intlbfgs> switch on true potential at step ',NITERDONE, &
1200:    WRITE(MYUNIT,'(A,I6,A,G20.10,A,G15.8,A,I4)') ' intlbfgs> After ',NITERDONE,' steps, energy/image=',ETOTAL/INTIMAGE, &966:    WRITE(MYUNIT,'(A,I6,A,G20.10,A,G15.8,A,I4)') ' intlbfgs> After ',NITERDONE,' steps, energy/image=',ETOTAL/INTIMAGE, &
1201:   &                               ' RMS=',RMS,' images=',INTIMAGE967:   &                               ' RMS=',RMS,' images=',INTIMAGE
1202: ENDIF968: ENDIF
1203: !969: !
1204: ! Linear interpolation for constraint potential and real potential separately.970: ! Linear interpolation for constraint potential and real potential separately.
1205: ! Constraint potential need not be flat if we have done some steps with both971: ! Constraint potential need not be flat if we have done some steps with both
1206: ! potentials turned on.972: ! potentials turned on.
1207: !973: !
1208: 678 CONTINUE974: 678 CONTINUE
1209: 975: 
1210: CALL INTRWG(NACTIVE,NITERDONE,INTIMAGE,XYZ)976: CALL RWG(NITERDONE,INTIMAGE,XYZ)
1211: CALL WRITEPROFILE(NITERDONE,EEE,INTIMAGE,MYUNIT)977: CALL WRITEPROFILE(NITERDONE,EEE,INTIMAGE,MYUNIT)
1212: NQDONE=NQDONE+1978: NQDONE=NQDONE+1
1213: 979: 
1214: WRITE(MYUNIT,'(A,G20.10)') 'intlbfgs> WORST=',WORST980: WRITE(MYUNIT,'(A,G20.10)') 'intlbfgs> WORST=',WORST
1215: WRITE(MYUNIT,'(A,2I8)') 'intlbfgs> NQDONE,MCSTEPS=',NQDONE,MCSTEPS(1)981: WRITE(MYUNIT,'(A,2I8)') 'intlbfgs> NQDONE,MCSTEPS=',NQDONE,MCSTEPS(1)
1216: IF (WORST.EQ.0.0D0) GOTO 8765982: IF (WORST.EQ.0.0D0) GOTO 8765
1217: IF (NQDONE.EQ.MCSTEPS(1)) GOTO 8765983: IF (NQDONE.EQ.MCSTEPS(1)) GOTO 8765
1218: 984: 
1219: !985: !
1220: ! Accept/reject this QCI set until BH steps exceeded, or worst energy is zero.986: ! Accept/reject this QCI set until BH steps exceeded, or worst energy is zero.
1266:          XYZ(J2)=  XYZ(J2)+  LOCALSTEP*(DPRAND()-0.5D0)*2.0D01032:          XYZ(J2)=  XYZ(J2)+  LOCALSTEP*(DPRAND()-0.5D0)*2.0D0
1267:       ENDDO1033:       ENDDO
1268:    ELSE1034:    ELSE
1269:       IF (DEBUG) WRITE(MYUNIT,'(A,I8,A,G20.10)') 'intlbfgs> Not perturbing image ',J4,' energy=',EEE(J4)1035:       IF (DEBUG) WRITE(MYUNIT,'(A,I8,A,G20.10)') 'intlbfgs> Not perturbing image ',J4,' energy=',EEE(J4)
1270:    ENDIF1036:    ENDIF
1271: ENDDO1037: ENDDO
1272: GOTO 98761038: GOTO 9876
1273: 1039: 
1274: 8765 CONTINUE ! jump here if all images have zero energy1040: 8765 CONTINUE ! jump here if all images have zero energy
1275: 1041: 
1276: CALL INTRWG(NACTIVE,0,INTIMAGE,XYZ)1042: CALL RWG(0,INTIMAGE,XYZ)
1277: CALL WRITEPROFILE(0,EEE,INTIMAGE,MYUNIT)1043: CALL WRITEPROFILE(0,EEE,INTIMAGE,MYUNIT)
1278: 1044: 
1279: DEALLOCATE(CONI,CONJ,CONDISTREF,REPI,REPJ,NREPI,NREPJ,REPCUT,NREPCUT,CONCUT)1045: DEALLOCATE(CONI,CONJ,CONDISTREF,REPI,REPJ,NREPI,NREPJ,REPCUT,NREPCUT,CONCUT)
1280: DEALLOCATE(TRUEEE, EEETMP, MYGTMP, GTMP, &1046: DEALLOCATE(TRUEEE, EEETMP, MYGTMP, GTMP, &
1281:   &      DIAG, STP, SEARCHSTEP, GDIF,GLAST, XSAVE, XYZ, GGG, CHECKG, IMGFREEZE, EEE, STEPIMAGE)1047:   &      DIAG, STP, SEARCHSTEP, GDIF,GLAST, XSAVE, XYZ, GGG, CHECKG, IMGFREEZE, EEE, STEPIMAGE)
1282: INTIMAGE=INTIMAGESAVE1048: INTIMAGE=INTIMAGESAVE
1283: 1049: 
1284: STOP1050: STOP
1285: 1051: 
1286: END SUBROUTINE INTLBFGS1052: END SUBROUTINE INTLBFGS
1287: !1053: !
1288: ! Neighbour list for repulsions to reduce cost of constraint potential.1054: ! Neighbour list for repulsions to reduce cost of constraint potential.
1289: !1055: !
1290: SUBROUTINE CHECKREP(INTIMAGE,XYZ,NOPT,NNSTART,NSTART)1056: SUBROUTINE CHECKREP(INTIMAGE,XYZ,NOPT,NNSTART,NSTART)
1291: USE COMMONS,ONLY : NREPI, NREPJ, NREPCUT, NNREPULSIVE, NREPULSIVE, REPI, REPJ, REPCUT, CHECKREPCUTOFF, DEBUG, MYUNIT, INTFROZEN1057: USE COMMONS,ONLY : NREPI, NREPJ, NREPCUT, NNREPULSIVE, NREPULSIVE, REPI, REPJ, REPCUT, CHECKREPCUTOFF, DEBUG, MYUNIT 
1292: USE PORFUNCS1058: USE PORFUNCS
1293: IMPLICIT NONE1059: IMPLICIT NONE
1294: INTEGER JJ, KK, NI1, NJ1, NI2, NJ2, INTIMAGE, NOPT, NI, NJ, NNSTART, NSTART1060: INTEGER JJ, KK, NI1, NJ1, NI2, NJ2, INTIMAGE, NOPT, NI, NJ, NNSTART, NSTART
1295: DOUBLE PRECISION LDIST, XYZ(NOPT*(INTIMAGE+2)),COMPARE1061: DOUBLE PRECISION LDIST, XYZ(NOPT*(INTIMAGE+2)),COMPARE
1296: DOUBLE PRECISION R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ,DMIN1062: DOUBLE PRECISION R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ,DMIN
1297: LOGICAL NOINT1063: LOGICAL NOINT
1298: 1064: 
1299: NNREPULSIVE=NNSTART1065: NNREPULSIVE=NNSTART
1300: DO JJ=NSTART,NREPULSIVE1066: DO JJ=NSTART,NREPULSIVE
1301:    COMPARE=(CHECKREPCUTOFF*REPCUT(JJ))**21067:    COMPARE=(CHECKREPCUTOFF*REPCUT(JJ))**2
1334:          NREPCUT(NNREPULSIVE)=REPCUT(JJ)1100:          NREPCUT(NNREPULSIVE)=REPCUT(JJ)
1335:          GOTO 2461101:          GOTO 246
1336:       ENDIF1102:       ENDIF
1337:    ENDDO 1103:    ENDDO 
1338: 246 CONTINUE1104: 246 CONTINUE
1339: ENDDO1105: ENDDO
1340: IF (DEBUG) WRITE(MYUNIT,'(A,2I8)') ' checkrep> number of active repulsions and total=',NNREPULSIVE,NREPULSIVE1106: IF (DEBUG) WRITE(MYUNIT,'(A,2I8)') ' checkrep> number of active repulsions and total=',NNREPULSIVE,NREPULSIVE
1341: 1107: 
1342: END SUBROUTINE CHECKREP1108: END SUBROUTINE CHECKREP
1343: 1109: 
1344: SUBROUTINE INTRWG(NACTIVE,NITER,INTIMAGE,XYZ)1110: SUBROUTINE RWG(NITER,INTIMAGE,XYZ)
1345: USE PORFUNCS1111: USE PORFUNCS
1346: USE COMMONS,ONLY: STOCKT,STOCKAAT, RBAAT, ZSYM, NATOMS, MYUNIT, ATOMACTIVE1112: USE COMMONS,ONLY: STOCKT,STOCKAAT, RBAAT, ZSYM, NATOMS, MYUNIT
1347: IMPLICIT NONE1113: IMPLICIT NONE
1348: CHARACTER(LEN=10) :: XYZFILE   = 'int.xyz   '1114: CHARACTER(LEN=10) :: XYZFILE   = 'int.xyz   '
1349: INTEGER,INTENT(IN) :: NITER1115: INTEGER,INTENT(IN) :: NITER
1350: INTEGER :: J1,J2,INTIMAGE,J3,NACTIVE1116: INTEGER :: J1,J2,INTIMAGE
1351: CHARACTER(LEN=80) :: FILENAME,DUMMYS1117: CHARACTER(LEN=80) :: FILENAME,DUMMYS
1352: DOUBLE PRECISION XYZ((3*NATOMS)*(INTIMAGE+2))1118: DOUBLE PRECISION XYZ((3*NATOMS)*(INTIMAGE+2))
1353: 1119: 
1354: FILENAME=XYZFILE1120: FILENAME=XYZFILE
1355: 1121: 
1356: IF (NITER.GT.0) THEN1122: IF (NITER.GT.0) THEN
1357:    WRITE(DUMMYS,'(I8)') NITER1123:    WRITE(DUMMYS,'(I8)') NITER
1358:    FILENAME='int.' // TRIM(ADJUSTL(DUMMYS)) // '.xyz' ! so that vmd recognises the file type!1124:    FILENAME='int.' // TRIM(ADJUSTL(DUMMYS)) // '.xyz' ! so that vmd recognises the file type!
1359: ENDIF1125: ENDIF
1360: OPEN(UNIT=993,FILE=FILENAME,STATUS='replace')1126: OPEN(UNIT=993,FILE=FILENAME,STATUS='replace')
1361: DO J2=1,INTIMAGE+21127: DO J2=1,INTIMAGE+2
1362: !  WRITE(993,'(i4/)') NACTIVE1128:    WRITE(993,'(I4/)') NATOMS
1363:    WRITE(993,'(i4/)') NATOMS1129: !  WRITE(993,'(A5,1X,3F20.10)') (ZSYM((J1+2)/3),xyz( (j2-1)*(3*NATOMS)+j1),&
1364:    DO J3=1,NATOMS1130:    WRITE(993,'(A5,1X,3F20.10)') ('LA ',XYZ( (j2-1)*(3*NATOMS)+J1), &
1365:       IF (ATOMACTIVE(J3)) THEN1131:  &     XYZ((J2-1)*(3*NATOMS)+J1+1), XYZ((J2-1)*(3*NATOMS)+J1+2),J1=1,(3*NATOMS),3)
1366:          WRITE(993,'(A5,1X,3F20.10)') 'LA   ',XYZ((J2-1)*3*NATOMS+3*(J3-1)+1),XYZ((J2-1)*3*NATOMS+3*(J3-1)+2), &   
1367:   &                                                                   XYZ((J2-1)*3*NATOMS+3*(J3-1)+3)   
1368:       ELSE 
1369:          WRITE(993,'(A5,1X,3F20.10)') 'DU   ',XYZ((J2-1)*3*NATOMS+3*(J3-1)+1),XYZ((J2-1)*3*NATOMS+3*(J3-1)+2), &   
1370:   &                                                                   XYZ((J2-1)*3*NATOMS+3*(J3-1)+3)   
1371:       ENDIF 
1372:    ENDDO 
1373: ENDDO1132: ENDDO
1374: 1133: 
1375: WRITE(MYUNIT,*) 'rwg> Interpolated image coordinates were saved to xyz file "'//TRIM(FILENAME)//'"'1134: WRITE(MYUNIT,*) 'rwg> Interpolated image coordinates were saved to xyz file "'//TRIM(FILENAME)//'"'
1376: 1135: 
1377: CLOSE(UNIT=993)1136: CLOSE(UNIT=993)
1378: END SUBROUTINE INTRWG1137: END SUBROUTINE RWG
1379: 1138: 
1380: SUBROUTINE WRITEPROFILE(NITER,EEE,INTIMAGE,MYUNIT)1139: SUBROUTINE WRITEPROFILE(NITER,EEE,INTIMAGE,MYUNIT)
1381: IMPLICIT NONE 1140: IMPLICIT NONE 
1382: INTEGER,INTENT(IN) :: NITER, INTIMAGE1141: INTEGER,INTENT(IN) :: NITER, INTIMAGE
1383: INTEGER :: I,UNIT,MYUNIT1142: INTEGER :: I,UNIT,MYUNIT
1384: DOUBLE PRECISION :: EEE(INTIMAGE+2)1143: DOUBLE PRECISION :: EEE(INTIMAGE+2)
1385: CHARACTER(LEN=20) :: FILENAME1144: CHARACTER(LEN=20) :: FILENAME
1386: 1145: 
1387: UNIT=9921146: UNIT=992
1388: IF (NITER.GT.0) THEN1147: IF (NITER.GT.0) THEN
1400: WRITE(UNIT=UNIT,FMT='(2G24.13)') EEE(INTIMAGE+2)1159: WRITE(UNIT=UNIT,FMT='(2G24.13)') EEE(INTIMAGE+2)
1401: 1160: 
1402: CLOSE(UNIT)1161: CLOSE(UNIT)
1403: WRITE(MYUNIT,'(A)') ' writeprofile> Interpolated energy profile was saved to file "'//trim(filename)//'"'1162: WRITE(MYUNIT,'(A)') ' writeprofile> Interpolated energy profile was saved to file "'//trim(filename)//'"'
1404: 1163: 
1405: END SUBROUTINE WRITEPROFILE1164: END SUBROUTINE WRITEPROFILE
1406: 1165: 
1407: SUBROUTINE DOADDATOM(NCONSTRAINT,NTRIES,NEWATOM,IMGFREEZE,INTIMAGE,XYZ,EEE,GGG,TURNONORDER,NITERDONE,NACTIVE)1166: SUBROUTINE DOADDATOM(NCONSTRAINT,NTRIES,NEWATOM,IMGFREEZE,INTIMAGE,XYZ,EEE,GGG,TURNONORDER,NITERDONE,NACTIVE)
1408: USE COMMONS, ONLY : CONACTIVE, CONI, CONJ, ATOMACTIVE, CONDISTREF, REPI, REPJ, REPCUT, INTREPSEP,  &1167: USE COMMONS, ONLY : CONACTIVE, CONI, CONJ, ATOMACTIVE, CONDISTREF, REPI, REPJ, REPCUT, INTREPSEP,  &
1409:   &             INTCONSTRAINREPCUT, NREPULSIVE, NREPMAX, MAXCONUSE, CHECKCONINT, &1168:   &             INTCONSTRAINREPCUT, NREPULSIVE, NREPMAX, MAXCONUSE, CHECKCONINT, &
1410:   &             FREEZENODEST, NNREPULSIVE, NATOMS, DEBUG, MYUNIT, INTFROZEN, &1169:   &             FREEZENODEST, NNREPULSIVE, NATOMS, DEBUG, MYUNIT
1411:   &             NREPULSIVEFIX, REPIFIX, REPJFIX, REPCUTFIX, NREPI, NREPJ, NREPCUT, MAXNACTIVE, & 
1412:   &             NCONSTRAINTFIX, CONIFIX, CONJFIX, INTCONCUT, INTCONSEP, QCIRADSHIFTT, QCIRADSHIFT 
1413: IMPLICIT NONE1170: IMPLICIT NONE
1414: INTEGER INTIMAGE1171: INTEGER INTIMAGE
1415: INTEGER NBEST, NCONTOACTIVE(NATOMS),  NCONSTRAINT, J2, NTRIES(NATOMS), NEWATOM,  CONLIST(NATOMS), N1, N2, N3, &1172: INTEGER NBEST, NCONTOACTIVE(NATOMS),  NCONSTRAINT, J2, NTRIES(NATOMS), NEWATOM,  CONLIST(NATOMS), N1, N2, N3, &
1416:   &     NTOADD, NADDED, NMININT, NMAXINT, TURNONORDER(NATOMS), NDUMMY, J1, J3, NITERDONE, NCONFORNEWATOM, NACTIVE1173:   &     NTOADD, NADDED, NMININT, NMAXINT, TURNONORDER(NATOMS), NDUMMY, J1, J3, NITERDONE, NCONFORNEWATOM, NACTIVE
1417: DOUBLE PRECISION DUMMY, DUMMY2, DPRAND, RANDOM, CONDIST(NATOMS), DMIN1174: DOUBLE PRECISION DUMMY, DUMMY2, DPRAND, RANDOM, CONDIST(NATOMS), DMIN
1418: INTEGER NDFORNEWATOM, BESTPRESERVEDN(NATOMS)1175: INTEGER NDFORNEWATOM, BESTPRESERVEDN(NATOMS)
1419: DOUBLE PRECISION BESTPRESERVEDD(NATOMS), BESTCLOSESTD(NATOMS), INVDTOACTIVE(NATOMS)1176: DOUBLE PRECISION BESTPRESERVEDD(NATOMS), BESTCLOSESTD(NATOMS), INVDTOACTIVE(NATOMS)
1420: LOGICAL IMGFREEZE(INTIMAGE), ADDREP(NATOMS)1177: LOGICAL IMGFREEZE(INTIMAGE)
1421: DOUBLE PRECISION C1, C2, C3, VEC1(3), VEC2(3), VEC3(3), ESAVED, ESAVEC, ESAVE01178: DOUBLE PRECISION C1, C2, C3, VEC1(3), VEC2(3), VEC3(3), ESAVED, ESAVEC, ESAVE0
1422: INTEGER NCFORNEWATOM, BESTCLOSESTN(NATOMS), NNREPSAVE, NREPSAVE1179: INTEGER NCFORNEWATOM, BESTCLOSESTN(NATOMS), NNREPSAVE, NREPSAVE
1423: DOUBLE PRECISION XYZ((3*NATOMS)*(INTIMAGE+2)), XSAVED(3,INTIMAGE+2), XSAVEC(3,INTIMAGE+2), XSAVE0(3,INTIMAGE+2),FRAC,RAN1, &1180: DOUBLE PRECISION XYZ((3*NATOMS)*(INTIMAGE+2)), XSAVED(3,INTIMAGE+2), XSAVEC(3,INTIMAGE+2), XSAVE0(3,INTIMAGE+2),FRAC,RAN1, &
1424:   &              RMS,EEE(INTIMAGE+2),GGG((3*NATOMS)*(INTIMAGE+2)),ETOTAL,DS,DF,DNORM1181:   &              RMS,EEE(INTIMAGE+2),GGG((3*NATOMS)*(INTIMAGE+2)),ETOTAL,DS,DF
1425: 1182: 
1426: NTOADD=11183: NTOADD=1
 1184: !  NTOADD=NATOMS-2  !!!! DJW
1427: NADDED=01185: NADDED=0
1428: 1186: 
1429: !1187: !
1430: ! Save current number of repulsions and number that are active to speed up the1188: ! Save current number of repulsions and number that are active to speed up the
1431: ! calls to CHECKREP1189: ! calls to CHECKREP
1432: !1190: !
1433: NNREPSAVE=NNREPULSIVE1191: NNREPSAVE=NNREPULSIVE
1434: NREPSAVE=NREPULSIVE1192: NREPSAVE=NREPULSIVE
1435: 542   CONTINUE1193: 542   CONTINUE
1436: !     DUMMY=1.0D1001194: !     DUMMY=1.0D100
1437:       NBEST=01195:       NBEST=0
1438:       NCONTOACTIVE(1:NATOMS)=01196:       NCONTOACTIVE(1:NATOMS)=0
1439:       INVDTOACTIVE(1:NATOMS)=0.0D01197:       INVDTOACTIVE(1:NATOMS)=0.0D0
1440:       DO J2=1,NCONSTRAINT1198:       DO J2=1,NCONSTRAINT
1441:          IF (CONACTIVE(J2)) CYCLE   ! count new, inactive constraints1199:          IF (CONACTIVE(J2)) CYCLE   ! count new, inactive constraints
1442:          IF (ATOMACTIVE(CONI(J2))) THEN1200:          IF (ATOMACTIVE(CONI(J2))) THEN
1443:             IF (.NOT.ATOMACTIVE(CONJ(J2))) THEN1201:             IF (.NOT.ATOMACTIVE(CONJ(J2))) THEN
1444:                NCONTOACTIVE(CONJ(J2))=NCONTOACTIVE(CONJ(J2))+11202:                NCONTOACTIVE(CONJ(J2))=NCONTOACTIVE(CONJ(J2))+1
1445:                IF (1.0D0/CONDISTREF(J2).GT.INVDTOACTIVE(CONJ(J2))) INVDTOACTIVE(CONJ(J2))=1.0D0/CONDISTREF(J2)1203:                INVDTOACTIVE(CONJ(J2))=INVDTOACTIVE(CONJ(J2))+1.0D0/CONDISTREF(J2)
1446: !              INVDTOACTIVE(CONJ(J2))=INVDTOACTIVE(CONJ(J2))+1.0D0/CONDISTREF(J2) 
1447:             ENDIF1204:             ENDIF
1448:          ENDIF1205:          ENDIF
1449:          IF (ATOMACTIVE(CONJ(J2))) THEN1206:          IF (ATOMACTIVE(CONJ(J2))) THEN
1450:             IF (.NOT.ATOMACTIVE(CONI(J2))) THEN1207:             IF (.NOT.ATOMACTIVE(CONI(J2))) THEN
1451:                NCONTOACTIVE(CONI(J2))=NCONTOACTIVE(CONI(J2))+11208:                NCONTOACTIVE(CONI(J2))=NCONTOACTIVE(CONI(J2))+1
1452: !              INVDTOACTIVE(CONI(J2))=INVDTOACTIVE(CONI(J2))+1.0D0/CONDISTREF(J2)1209:                INVDTOACTIVE(CONI(J2))=INVDTOACTIVE(CONI(J2))+1.0D0/CONDISTREF(J2)
1453:                IF (1.0D0/CONDISTREF(J2).GT.INVDTOACTIVE(CONI(J2))) INVDTOACTIVE(CONI(J2))=1.0D0/CONDISTREF(J2) 
1454:             ENDIF1210:             ENDIF
1455:          ENDIF1211:          ENDIF
1456:          IF (NCONTOACTIVE(CONI(J2)).GT.NBEST) THEN1212:          IF (NCONTOACTIVE(CONI(J2)).GT.NBEST) THEN
1457:             NBEST=NCONTOACTIVE(CONI(J2))1213:             NBEST=NCONTOACTIVE(CONI(J2))
1458:          ENDIF1214:          ENDIF
1459:          IF (NCONTOACTIVE(CONJ(J2)).GT.NBEST) THEN1215:          IF (NCONTOACTIVE(CONJ(J2)).GT.NBEST) THEN
1460:             NBEST=NCONTOACTIVE(CONJ(J2))1216:             NBEST=NCONTOACTIVE(CONJ(J2))
1461:          ENDIF1217:          ENDIF
1462: !        IF ((CONI(J2).EQ.115).OR.(CONJ(J2).EQ.115)) THEN1218: !        WRITE(MYUNIT,'(A,7I6)') 'J2,NCONTOACTIVEI,NCONTOACTOVEJ,CONI,CONJ,NEWATOM,NBEST=', &
1463: !          WRITE(MYUNIT,'(A,5I6,2G20.10)') 'J2,NCONTOACTIVEI,NCONTOACTOVEJ,CONI,CONJ,NEWATOM,NBEST,IDI,IDJ=', &1219: ! &                             J2,NCONTOACTIVE(CONI(J2)),NCONTOACTIVE(CONJ(J2)),CONI(J2),CONJ(J2),NEWATOM,NBEST
1464: !   &                             J2,NCONTOACTIVE(CONI(J2)),NCONTOACTIVE(CONJ(J2)),CONI(J2),CONJ(J2), & 
1465: !   &                             INVDTOACTIVE(CONI(J2)),INVDTOACTIVE(CONJ(J2)) 
1466: !        ENDIF 
1467: 1220: 
1468:       ENDDO1221:       ENDDO
1469: !1222: !
1470: !  Choose NEWATOM stochastically. Bias towards atoms with the maximum constraints.1223: !  Choose NEWATOM stochastically. Bias towards atoms with the maximum constraints.
1471: !  Use a normalised probability and generate a random number between 0 and 1.1224: !  Use a normalised probability and generate a random number between 0 and 1.
1472: !1225: !
1473: !       DUMMY2=0.0D01226:       DUMMY2=0.0D0
1474: !       DO J2=1,NATOMS1227:       DO J2=1,NATOMS
1475: !          IF (NCONTOACTIVE(J2).EQ.0) CYCLE1228:          IF (NCONTOACTIVE(J2).EQ.0) CYCLE
1476: !          IF (ATOMACTIVE(J2)) CYCLE1229:          IF (ATOMACTIVE(J2)) CYCLE
1477: ! !        DUMMY2=DUMMY2+((1.0D0*NCONTOACTIVE(J2))/(1.0D0*CONDISTREF(J2)*NTRIES(J2)))**4 1230: !        DUMMY2=DUMMY2+((1.0D0*NCONTOACTIVE(J2))/(1.0D0*CONDISTREF(J2)*NTRIES(J2)))**4 
1478: ! !        DUMMY2=DUMMY2+((1.0D0*INVDTOACTIVE(J2))/(1.0D0*NCONTOACTIVE(J2)*NTRIES(J2)))**4 1231:          DUMMY2=DUMMY2+((1.0D0*INVDTOACTIVE(J2))/(1.0D0*NTRIES(J2)))**4 
1479: !          DUMMY2=DUMMY2+((1.0D0*INVDTOACTIVE(J2))/(1.0D0*NTRIES(J2)))**10 1232: !        WRITE(MYUNIT,'(A,I6,A,G20.10)') ' intlbfgs> Unnormalised probability for choosing atom ',J2,' is ', &
1480: ! !        WRITE(MYUNIT,'(A,I6,A,G20.10)') ' intlbfgs> Unnormalised probability for choosing atom ',J2,' is ', &1233: ! &                ((1.0D0*INVDTOACTIVE(J2))/(1.0D0*NTRIES(J2)))**4
1481: ! ! &                ((1.0D0*INVDTOACTIVE(J2))/(1.0D0*NTRIES(J2)))**10 
1482: !       ENDDO 
1483: !  
1484: !       RANDOM=DUMMY2*DPRAND() 
1485: !       DNORM=DUMMY2 
1486: !       DUMMY2=0.0D0 
1487: !       choosenew: DO J2=1,NATOMS 
1488: !          IF (NCONTOACTIVE(J2).EQ.0) CYCLE 
1489: !          IF (ATOMACTIVE(J2)) CYCLE 
1490: ! !        DUMMY2=DUMMY2+((1.0D0*NCONTOACTIVE(J2))/(1.0D0*CONDISTREF(J2)*NTRIES(J2)))**4  
1491: ! !        DUMMY2=DUMMY2+((1.0D0*INVDTOACTIVE(J2))/(1.0D0*NCONTOACTIVE(J2)*NTRIES(J2)))**4  
1492: !          DUMMY2=DUMMY2+((1.0D0*INVDTOACTIVE(J2))/(1.0D0*NTRIES(J2)))**10  
1493: !          WRITE(MYUNIT,'(A,I6,G20.10,I6,4G20.10)') 'J2,invd,ntries,prob,rand,D2,D2/norm=',J2,INVDTOACTIVE(J2),NTRIES(J2), & 
1494: !   &                ((1.0D0*INVDTOACTIVE(J2))/(1.0D0*NTRIES(J2)))**10/DNORM,RANDOM/DNORM,DUMMY2,DUMMY2/DNORM 
1495: !          IF (DUMMY2.GE.RANDOM) THEN 
1496: !             NEWATOM=J2 
1497: !             IF (DEBUG) WRITE(MYUNIT,'(3(A,I6))') ' intlbfgs> Choosing new active atom ',NEWATOM,' new constraints=', & 
1498: !   &                                       NCONTOACTIVE(J2),' maximum=',NBEST 
1499: !             EXIT choosenew 
1500: !          ENDIF 
1501: !       ENDDO choosenew 
1502:  
1503: ! 
1504: !  Choose NEWATOM deterministically. Take the inactive atom with the shortest constrained distance. 
1505: ! 
1506:       DUMMY2=1.0D100 
1507:       DO J1=1,NCONSTRAINT 
1508:          IF (CONACTIVE(J1)) CYCLE 
1509:          IF (ATOMACTIVE(CONJ(J1))) THEN 
1510:             IF (.NOT.ATOMACTIVE(CONI(J1))) THEN 
1511:                IF (CONDISTREF(J1).LT.DUMMY2) THEN 
1512:                   DUMMY2=CONDISTREF(J1) 
1513:                   NEWATOM=CONI(J1) 
1514:                ENDIF 
1515:             ENDIF 
1516:          ELSEIF (ATOMACTIVE(CONI(J1))) THEN 
1517:             IF (.NOT.ATOMACTIVE(CONJ(J1))) THEN 
1518:                IF (CONDISTREF(J1).LT.DUMMY2) THEN 
1519:                   DUMMY2=CONDISTREF(J1) 
1520:                   NEWATOM=CONJ(J1) 
1521:                ENDIF 
1522:             ENDIF 
1523:          ENDIF 
1524:       ENDDO1234:       ENDDO
1525:       IF (DEBUG) WRITE(MYUNIT,'(3(A,I6),A,F15.5)') ' intlbfgs> Choosing new active atom ',NEWATOM,' new constraints=', &1235: 
1526:   &                                       NCONTOACTIVE(NEWATOM),' maximum=',NBEST,' shortest constraint=',DUMMY21236:       RANDOM=DUMMY2*DPRAND()
 1237:       DUMMY2=0.0D0
 1238:       choosenew: DO J2=1,NATOMS
 1239:          IF (NCONTOACTIVE(J2).EQ.0) CYCLE
 1240:          IF (ATOMACTIVE(J2)) CYCLE
 1241: !        DUMMY2=DUMMY2+((1.0D0*NCONTOACTIVE(J2))/(1.0D0*CONDISTREF(J2)*NTRIES(J2)))**4 
 1242:          DUMMY2=DUMMY2+((1.0D0*INVDTOACTIVE(J2))/(1.0D0*NTRIES(J2)))**4 
 1243:          IF (DUMMY2.GE.RANDOM) THEN
 1244:             NEWATOM=J2
 1245:             IF (DEBUG) WRITE(MYUNIT,'(3(A,I6))') ' intlbfgs> Choosing new active atom ',NEWATOM,' new constraints=', &
 1246:   &                                       NCONTOACTIVE(J2),' maximum=',NBEST
 1247:             EXIT choosenew
 1248:          ENDIF
 1249:       ENDDO choosenew
1527:           1250:           
1528:       IF (NEWATOM*NBEST.EQ.0) THEN ! sanity check1251:       IF (NEWATOM*NBEST.EQ.0) THEN ! sanity check
1529:          WRITE(MYUNIT,'(A,I6,A,2I6)') ' intlbfgs> ERROR *** new active atom not set'1252:          WRITE(MYUNIT,'(A,I6,A,2I6)') ' intlbfgs> ERROR *** new active atom not set'
1530:          STOP1253:          STOP
1531:       ELSE1254:       ELSE
1532: !1255: !
1533: !  We need a sorted list of up to 3 active atoms, sorted according to how well the1256: !  We need a sorted list of up to 3 active atoms, sorted according to how well the
1534: !  end point distance is preserved, even if they don't satisfy the constraint 1257: !  end point distance is preserved, even if they don't satisfy the constraint 
1535: !  condition. We want three atoms to use for a local axis system in the interpolation.1258: !  condition. We want three atoms to use for a local axis system in the interpolation.
1536: !1259: !
1537: !  Try sorting on the shortest average distances in the endpoint structures instead, to avoid1260: !  Try sorting on the shortest average distances in the endpoint structures instead, to avoid
1538: !  problems with distant atoms acidentally having a well-preserved distance.1261: !  problems with distant atoms acidentally having a well-preserved distance.
1539: !1262: !
1540:          NDFORNEWATOM=01263:          NDFORNEWATOM=0
1541:          BESTPRESERVEDD(1:NATOMS)=1.0D1001264:          BESTPRESERVEDD(1:NATOMS)=1.0D100
1542:          DO J1=1,NATOMS1265:          DO J1=1,NATOMS
1543:             IF (ABS(J1-NEWATOM).GT.INTCONSEP) CYCLE 
1544:             IF (.NOT.ATOMACTIVE(J1)) CYCLE1266:             IF (.NOT.ATOMACTIVE(J1)) CYCLE
1545:             DS=SQRT((XYZ(3*(NEWATOM-1)+1)-XYZ(3*(J1-1)+1))**2 &1267:             DS=SQRT((XYZ(3*(NEWATOM-1)+1)-XYZ(3*(J1-1)+1))**2 &
1546:   &                +(XYZ(3*(NEWATOM-1)+2)-XYZ(3*(J1-1)+2))**2 &1268:   &                +(XYZ(3*(NEWATOM-1)+2)-XYZ(3*(J1-1)+2))**2 &
1547:   &                +(XYZ(3*(NEWATOM-1)+3)-XYZ(3*(J1-1)+3))**2) 1269:   &                +(XYZ(3*(NEWATOM-1)+3)-XYZ(3*(J1-1)+3))**2) 
1548:             DF=SQRT((XYZ((INTIMAGE+1)*3*NATOMS+3*(NEWATOM-1)+1)-XYZ((INTIMAGE+1)*3*NATOMS+3*(J1-1)+1))**2 &1270:             DF=SQRT((XYZ((INTIMAGE+1)*3*NATOMS+3*(NEWATOM-1)+1)-XYZ((INTIMAGE+1)*3*NATOMS+3*(J1-1)+1))**2 &
1549:   &                +(XYZ((INTIMAGE+1)*3*NATOMS+3*(NEWATOM-1)+2)-XYZ((INTIMAGE+1)*3*NATOMS+3*(J1-1)+2))**2 &1271:   &                +(XYZ((INTIMAGE+1)*3*NATOMS+3*(NEWATOM-1)+2)-XYZ((INTIMAGE+1)*3*NATOMS+3*(J1-1)+2))**2 &
1550:   &                +(XYZ((INTIMAGE+1)*3*NATOMS+3*(NEWATOM-1)+3)-XYZ((INTIMAGE+1)*3*NATOMS+3*(J1-1)+3))**2) 1272:   &                +(XYZ((INTIMAGE+1)*3*NATOMS+3*(NEWATOM-1)+3)-XYZ((INTIMAGE+1)*3*NATOMS+3*(J1-1)+3))**2) 
1551:             IF (DS.GT.INTCONCUT) CYCLE 
1552:             IF (DF.GT.INTCONCUT) CYCLE 
1553:             DUMMY=ABS(DS-DF)1273:             DUMMY=ABS(DS-DF)
1554:             NDFORNEWATOM=NDFORNEWATOM+11274:             NDFORNEWATOM=NDFORNEWATOM+1
1555:             DO J2=1,NDFORNEWATOM 1275:             DO J2=1,NDFORNEWATOM 
1556:                IF (DUMMY.LT.BESTPRESERVEDD(J2)) THEN1276:                IF (DUMMY.LT.BESTPRESERVEDD(J2)) THEN
1557: !                 WRITE(MYUNIT,'(A,I6,G12.4,I6,G12.4)') 'J1,DUMMY < J2,BESTPRESERVEDD: ',J1,DUMMY,J2,BESTPRESERVEDD(J2)1277: !                 WRITE(MYUNIT,'(A,I6,G12.4,I6,G12.4)') 'J1,DUMMY < J2,BESTPRESERVEDD: ',J1,DUMMY,J2,BESTPRESERVEDD(J2)
1558:                   DO J3=NDFORNEWATOM,J2+1,-1 1278:                   DO J3=NDFORNEWATOM,J2+1,-1 
1559: !                    WRITE(MYUNIT,'(A,I6,A,I6,A,G12.4)') ' moving diff and list from ',J3-1,' to ',J3, &1279: !                    WRITE(MYUNIT,'(A,I6,A,I6,A,G12.4)') ' moving diff and list from ',J3-1,' to ',J3, &
1560: !&                                               ' DIFF=',BESTPRESERVEDD(J3-1)1280: !&                                               ' DIFF=',BESTPRESERVEDD(J3-1)
1561:                      BESTPRESERVEDD(J3)=BESTPRESERVEDD(J3-1)1281:                      BESTPRESERVEDD(J3)=BESTPRESERVEDD(J3-1)
1562:                      BESTPRESERVEDN(J3)=BESTPRESERVEDN(J3-1)1282:                      BESTPRESERVEDN(J3)=BESTPRESERVEDN(J3-1)
1574:             WRITE(MYUNIT,'(A,I6,A,I6,A)') ' intlbfgs> New active atom ',NEWATOM,' best preserved distances:'1294:             WRITE(MYUNIT,'(A,I6,A,I6,A)') ' intlbfgs> New active atom ',NEWATOM,' best preserved distances:'
1575:             WRITE(MYUNIT,'(20I6)') BESTPRESERVEDN(1:MIN(10,NDFORNEWATOM))1295:             WRITE(MYUNIT,'(20I6)') BESTPRESERVEDN(1:MIN(10,NDFORNEWATOM))
1576:             WRITE(MYUNIT,'(A,I6,A,I6,A)') ' intlbfgs> sorted differences:'1296:             WRITE(MYUNIT,'(A,I6,A,I6,A)') ' intlbfgs> sorted differences:'
1577:             WRITE(MYUNIT,'(10G12.4)') BESTPRESERVEDD(1:MIN(10,NDFORNEWATOM))1297:             WRITE(MYUNIT,'(10G12.4)') BESTPRESERVEDD(1:MIN(10,NDFORNEWATOM))
1578:          ENDIF1298:          ENDIF
1579:          IF (FREEZENODEST) IMGFREEZE(1:INTIMAGE)=.FALSE.1299:          IF (FREEZENODEST) IMGFREEZE(1:INTIMAGE)=.FALSE.
1580: 1300: 
1581:          NCFORNEWATOM=01301:          NCFORNEWATOM=0
1582:          BESTCLOSESTD(1:NATOMS)=1.0D1001302:          BESTCLOSESTD(1:NATOMS)=1.0D100
1583:          DO J1=1,NATOMS1303:          DO J1=1,NATOMS
1584:             IF (ABS(J1-NEWATOM).GT.INTCONSEP) CYCLE 
1585:             IF (.NOT.ATOMACTIVE(J1)) CYCLE1304:             IF (.NOT.ATOMACTIVE(J1)) CYCLE
1586:             DS=SQRT((XYZ(3*(NEWATOM-1)+1)-XYZ(3*(J1-1)+1))**2 &1305:             DS=SQRT((XYZ(3*(NEWATOM-1)+1)-XYZ(3*(J1-1)+1))**2 &
1587:   &                +(XYZ(3*(NEWATOM-1)+2)-XYZ(3*(J1-1)+2))**2 &1306:   &                +(XYZ(3*(NEWATOM-1)+2)-XYZ(3*(J1-1)+2))**2 &
1588:   &                +(XYZ(3*(NEWATOM-1)+3)-XYZ(3*(J1-1)+3))**2) 1307:   &                +(XYZ(3*(NEWATOM-1)+3)-XYZ(3*(J1-1)+3))**2) 
1589:             DF=SQRT((XYZ((INTIMAGE+1)*3*NATOMS+3*(NEWATOM-1)+1)-XYZ((INTIMAGE+1)*3*NATOMS+3*(J1-1)+1))**2 &1308:             DF=SQRT((XYZ((INTIMAGE+1)*3*NATOMS+3*(NEWATOM-1)+1)-XYZ((INTIMAGE+1)*3*NATOMS+3*(J1-1)+1))**2 &
1590:   &                +(XYZ((INTIMAGE+1)*3*NATOMS+3*(NEWATOM-1)+2)-XYZ((INTIMAGE+1)*3*NATOMS+3*(J1-1)+2))**2 &1309:   &                +(XYZ((INTIMAGE+1)*3*NATOMS+3*(NEWATOM-1)+2)-XYZ((INTIMAGE+1)*3*NATOMS+3*(J1-1)+2))**2 &
1591:   &                +(XYZ((INTIMAGE+1)*3*NATOMS+3*(NEWATOM-1)+3)-XYZ((INTIMAGE+1)*3*NATOMS+3*(J1-1)+3))**2) 1310:   &                +(XYZ((INTIMAGE+1)*3*NATOMS+3*(NEWATOM-1)+3)-XYZ((INTIMAGE+1)*3*NATOMS+3*(J1-1)+3))**2) 
1592:             IF (DS.GT.INTCONCUT) CYCLE 
1593:             IF (DF.GT.INTCONCUT) CYCLE 
1594:             DUMMY=(DS+DF)/2.0D01311:             DUMMY=(DS+DF)/2.0D0
1595:             NCFORNEWATOM=NCFORNEWATOM+11312:             NCFORNEWATOM=NCFORNEWATOM+1
1596:             DO J2=1,NCFORNEWATOM1313:             DO J2=1,NCFORNEWATOM
1597:                IF (DUMMY.LT.BESTCLOSESTD(J2)) THEN1314:                IF (DUMMY.LT.BESTCLOSESTD(J2)) THEN
1598: !                 WRITE(MYUNIT,'(A,I6,G12.4,I6,G12.4)') 'J1,DUMMY < J2,BESTCLOSESTD: ',J1,DUMMY,J2,BESTCLOSESTD(J2)1315: !                 WRITE(MYUNIT,'(A,I6,G12.4,I6,G12.4)') 'J1,DUMMY < J2,BESTCLOSESTD: ',J1,DUMMY,J2,BESTCLOSESTD(J2)
1599:                   DO J3=NCFORNEWATOM,J2+1,-11316:                   DO J3=NCFORNEWATOM,J2+1,-1
1600: !                    WRITE(MYUNIT,'(A,I6,A,I6,A,G12.4)') ' moving diff and list from ',J3-1,' to ',J3, &1317: !                    WRITE(MYUNIT,'(A,I6,A,I6,A,G12.4)') ' moving diff and list from ',J3-1,' to ',J3, &
1601: !&                                               ' DIFF=',BESTCLOSESTD(J3-1)1318: !&                                               ' DIFF=',BESTCLOSESTD(J3-1)
1602:                      BESTCLOSESTD(J3)=BESTCLOSESTD(J3-1)1319:                      BESTCLOSESTD(J3)=BESTCLOSESTD(J3-1)
1603:                      BESTCLOSESTN(J3)=BESTCLOSESTN(J3-1)1320:                      BESTCLOSESTN(J3)=BESTCLOSESTN(J3-1)
1604:                   ENDDO1321:                   ENDDO
1605:                   BESTCLOSESTD(J2)=DUMMY1322:                   BESTCLOSESTD(J2)=DUMMY
1606: !                 WRITE(MYUNIT,'(A,I6,A,G12.4)') ' setting BESTCLOSESTD element ',J2,' to ',DUMMY1323: !                 WRITE(MYUNIT,'(A,I6,A,G12.4)') ' setting BESTCLOSESTD element ',J2,' to ',DUMMY
1607:                   BESTCLOSESTN(J2)=J11324:                   BESTCLOSESTN(J2)=J1
1608: !                 WRITE(MYUNIT,'(A,I6,A,G12.4)') ' setting BESTCLOSESTN element ',J2,' to ',J11325: !                 PRINT '(A,I6,A,G12.4)',' setting BESTCLOSESTN element ',J2,' to ',J1
1609:                   GOTO 6591326:                   GOTO 659
1610:                ENDIF1327:                ENDIF
1611:             ENDDO1328:             ENDDO
1612: 659         CONTINUE1329: 659         CONTINUE
1613:          ENDDO1330:          ENDDO
1614:          IF (DEBUG) THEN1331:          IF (DEBUG) THEN
1615:             WRITE(MYUNIT,'(A,I6,A,I6,A)') ' intlbfgs> New active atom ',NEWATOM,' shortest average distances in endpoints:'1332:             WRITE(MYUNIT,'(A,I6,A,I6,A)') ' intlbfgs> New active atom ',NEWATOM,' shortest average distances in endpoints:'
1616:             WRITE(MYUNIT,'(20I6)') BESTCLOSESTN(1:MIN(10,NCFORNEWATOM))1333:             WRITE(MYUNIT,'(20I6)') BESTCLOSESTN(1:MIN(10,NCFORNEWATOM))
1617:             WRITE(MYUNIT,'(A,I6,A,I6,A)') ' intlbfgs> sorted differences:'1334:             WRITE(MYUNIT,'(A,I6,A,I6,A)') ' intlbfgs> sorted differences:'
1618:             WRITE(MYUNIT,'(10G12.4)') BESTCLOSESTD(1:MIN(10,NCFORNEWATOM))1335:             WRITE(MYUNIT,'(10G12.4)') BESTCLOSESTN(1:MIN(10,NCFORNEWATOM))
1619:          ENDIF1336:          ENDIF
1620: !1337: !
1621: !  Maintain a sorted list of active atoms that are constrained to the new atom, sorted1338: !  Maintain a sorted list of active atoms that are constrained to the new atom, sorted
1622: !  according to their distance.1339: !  according to their distance.
1623: !1340: !
1624:          NCONFORNEWATOM=01341:          NCONFORNEWATOM=0
1625:          CONDIST(1:NATOMS)=1.0D1001342:          CONDIST(1:NATOMS)=1.0D100
1626:          IF (DEBUG) WRITE(MYUNIT,'(3(A,I6))') ' intlbfgs> New active atom is number ',NEWATOM,' total=',NACTIVE+1, &1343:          IF (DEBUG) WRITE(MYUNIT,'(3(A,I6))') ' intlbfgs> New active atom is number ',NEWATOM,' total=',NACTIVE+1, &
1627:  &                        ' steps=',NITERDONE1344:  &                        ' steps=',NITERDONE
1628:          DO J1=1,NCONSTRAINT1345:          DO J1=1,NCONSTRAINT
1681:             DO J2=1,NCONSTRAINT1398:             DO J2=1,NCONSTRAINT
1682:                IF ((CONI(J2).EQ.NEWATOM).AND.(CONJ(J2).EQ.CONLIST(J1))) THEN1399:                IF ((CONI(J2).EQ.NEWATOM).AND.(CONJ(J2).EQ.CONLIST(J1))) THEN
1683:                      CONACTIVE(J2)=.TRUE.1400:                      CONACTIVE(J2)=.TRUE.
1684:                      IF (DEBUG) WRITE(MYUNIT,'(A,I6,A,2I6)') ' intlbfgs> Turning on constraint ',J2,' for atoms ',CONI(J2),CONJ(J2)1401:                      IF (DEBUG) WRITE(MYUNIT,'(A,I6,A,2I6)') ' intlbfgs> Turning on constraint ',J2,' for atoms ',CONI(J2),CONJ(J2)
1685:                ELSE IF ((CONJ(J2).EQ.NEWATOM).AND.(CONI(J2).EQ.CONLIST(J1))) THEN1402:                ELSE IF ((CONJ(J2).EQ.NEWATOM).AND.(CONI(J2).EQ.CONLIST(J1))) THEN
1686:                      CONACTIVE(J2)=.TRUE.1403:                      CONACTIVE(J2)=.TRUE.
1687:                      IF (DEBUG) WRITE(MYUNIT,'(A,I6,A,2I6)') ' intlbfgs> Turning on constraint ',J2,' for atoms ',CONI(J2),CONJ(J2)1404:                      IF (DEBUG) WRITE(MYUNIT,'(A,I6,A,2I6)') ' intlbfgs> Turning on constraint ',J2,' for atoms ',CONI(J2),CONJ(J2)
1688:                ENDIF1405:                ENDIF
1689:             ENDDO1406:             ENDDO
1690:          ENDDO1407:          ENDDO
1691:  
1692:          DO J1=1,NATOMS1408:          DO J1=1,NATOMS
1693:             IF (.NOT.ATOMACTIVE(J1)) CYCLE ! identify active atoms1409:             IF (.NOT.ATOMACTIVE(J1)) CYCLE ! identify active atoms
1694:             IF (ABS(J1-NEWATOM).LE.INTREPSEP) CYCLE ! no repulsion for atoms too close in sequence1410:             IF (ABS(J1-NEWATOM).LE.INTREPSEP) CYCLE ! no repulsion for atoms too close in sequence
1695:             DO J2=1,NCONSTRAINT1411:             DO J2=1,NCONSTRAINT
1696: !1412: !
1697: !  With MAXCONUSE set to a finite value there could be constraints for the new atom that are1413: !  With MAXCONUSE set to a finite value there could be constraints for the new atom that are
1698: !  not active. We don't want these to be changed to repulsion, surely?!1414: !  not active. We don't want these to be changed to repulsion, surely?!
1699: !  Or perhaps we do need to do something with them?1415: !  Or perhaps we do need to do something with them?
1700: !1416: !
1701: !              IF (.NOT.CONACTIVE(J2)) CYCLE ! repulsions for inactive constraints 1417:                IF (.NOT.CONACTIVE(J2)) CYCLE ! identify active constraints 
1702:                IF (((CONI(J2).EQ.J1).AND.(CONJ(J2).EQ.NEWATOM)).OR.((CONJ(J2).EQ.J1).AND.(CONI(J2).EQ.NEWATOM))) GOTO 5431418:                IF (((CONI(J2).EQ.J1).AND.(CONJ(J2).EQ.NEWATOM)).OR.((CONJ(J2).EQ.J1).AND.(CONI(J2).EQ.NEWATOM))) GOTO 543
1703:             ENDDO1419:             ENDDO
1704:             DMIN=1.0D1001420:             DMIN=1.0D100
1705:             DO J2=1,INTIMAGE+2,INTIMAGE+1 ! only consider the end-point distances1421:             DO J2=1,INTIMAGE+2,INTIMAGE+1 ! only consider the end-point distances
1706:                DF=SQRT((XYZ((J2-1)*3*NATOMS+3*(NEWATOM-1)+1)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+1))**2+ &1422:                DF=SQRT((XYZ((J2-1)*3*NATOMS+3*(NEWATOM-1)+1)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+1))**2+ &
1707:   &                    (XYZ((J2-1)*3*NATOMS+3*(NEWATOM-1)+2)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+2))**2+ &1423:   &                    (XYZ((J2-1)*3*NATOMS+3*(NEWATOM-1)+2)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+2))**2+ &
1708:   &                    (XYZ((J2-1)*3*NATOMS+3*(NEWATOM-1)+3)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+3))**2)1424:   &                    (XYZ((J2-1)*3*NATOMS+3*(NEWATOM-1)+3)-XYZ((J2-1)*3*NATOMS+3*(J1-1)+3))**2)
1709:                IF (DF.LT.DMIN) DMIN=DF1425:                IF (DF.LT.DMIN) DMIN=DF
1710:             ENDDO1426:             ENDDO
1711: !1427: !
1717:             REPI(NREPULSIVE)=J11433:             REPI(NREPULSIVE)=J1
1718:             REPJ(NREPULSIVE)=NEWATOM1434:             REPJ(NREPULSIVE)=NEWATOM
1719:             REPCUT(NREPULSIVE)=DMIN1435:             REPCUT(NREPULSIVE)=DMIN
1720: !           IF (DEBUG) WRITE(MYUNIT,'(A,I6,A,I6,A,F15.5)') ' intlbfgs> Adding repulsion for new atom ',NEWATOM,' with atom ',J1, &1436: !           IF (DEBUG) WRITE(MYUNIT,'(A,I6,A,I6,A,F15.5)') ' intlbfgs> Adding repulsion for new atom ',NEWATOM,' with atom ',J1, &
1721: ! &                                                   ' cutoff=',DMIN1437: ! &                                                   ' cutoff=',DMIN
1722: 543         CONTINUE1438: 543         CONTINUE
1723:          ENDDO1439:          ENDDO
1724:          ATOMACTIVE(NEWATOM)=.TRUE.1440:          ATOMACTIVE(NEWATOM)=.TRUE.
1725:          NACTIVE=NACTIVE+11441:          NACTIVE=NACTIVE+1
1726: 1442: 
1727: ! 
1728: ! Freeze atoms that became active more than NACTIVE-MAXNACTIVE events ago. 
1729: ! For example, with MAXNACTIVE=5 and 40 active atoms, we would freeze those  
1730: ! turned on first, second, up to the 35th in the TURNONORDER list. 
1731: ! 
1732:          WRITE(MYUNIT,'(A,I6)') 'doaddatom> Number of active atoms is now ',NACTIVE 
1733:          IF (NACTIVE.GT.MAXNACTIVE) THEN 
1734:             WRITE(MYUNIT,'(A)') 'doaddatom> TURNONORDER:' 
1735:             WRITE(MYUNIT,'(5I6)') TURNONORDER(1:NACTIVE-1) 
1736:             NDUMMY=TURNONORDER(NACTIVE-MAXNACTIVE) 
1737:             IF (INTFROZEN(NDUMMY)) THEN 
1738:                IF (DEBUG) WRITE(MYUNIT,'(A,I6,A,2I6)') ' doaddatom> Not turning off frozen active atom ',NDUMMY,' already frozen' 
1739:             ELSE 
1740:                IF (DEBUG) WRITE(MYUNIT,'(A,I6,A,2I6)') ' doaddatom> Freezing active atom ',NDUMMY 
1741:                INTFROZEN(NDUMMY)=.TRUE. 
1742: ! 
1743: ! Turn off constraints and repulsions between frozen atoms. 
1744: ! 
1745:                DO J2=1,NCONSTRAINT 
1746:                   IF (.NOT.CONACTIVE(J2)) CYCLE 
1747:                   IF (INTFROZEN(CONI(J2)).AND.INTFROZEN(CONJ(J2))) THEN 
1748:                      CONACTIVE(J2)=.FALSE. 
1749:                      WRITE(MYUNIT,'(A,I6,A,2I6)') 'doaddatom> turning off constraint ',J2,' between atoms ',CONI(J2),CONJ(J2) 
1750:                   ENDIF 
1751:                ENDDO 
1752:  
1753:                J2=0 
1754:                DO J1=1,NREPULSIVEFIX 
1755:                   IF (INTFROZEN(REPIFIX(J1)).AND.INTFROZEN(REPJFIX(J1))) CYCLE 
1756:                   IF (ATOMACTIVE(REPIFIX(J1)).AND.ATOMACTIVE(REPJFIX(J1))) THEN 
1757:                      DO J3=1,NCONSTRAINTFIX 
1758: !                       IF (.NOT.CONACTIVE(J3)) CYCLE ! no repulsions for any constraints 
1759:                         IF ((CONIFIX(J3).EQ.REPIFIX(J1)).AND.(CONJFIX(J3).EQ.REPJFIX(J1))) GOTO 962 
1760:                         IF ((CONIFIX(J3).EQ.REPJFIX(J1)).AND.(CONJFIX(J3).EQ.REPIFIX(J1))) GOTO 962 
1761:                      ENDDO 
1762:                      J2=J2+1 
1763:                      REPI(J2)=REPIFIX(J1) 
1764:                      REPJ(J2)=REPJFIX(J1) 
1765:                      REPCUT(J2)=REPCUTFIX(J1) 
1766: 962                  CONTINUE 
1767:                   ENDIF 
1768:                ENDDO 
1769:                NREPULSIVE=J2 
1770:                WRITE(MYUNIT,'(A,I6,A)') ' doaddatom> After allowing for frozen atoms there are ',NREPULSIVE,' possible repulsions' 
1771:                NREPI(1:NREPULSIVE)=REPI(1:NREPULSIVE) 
1772:                NREPJ(1:NREPULSIVE)=REPJ(1:NREPULSIVE) 
1773:                NNREPULSIVE=NREPULSIVE 
1774:                NREPCUT(1:NREPULSIVE)=REPCUT(1:NREPULSIVE) 
1775:             ENDIF 
1776:          ENDIF 
1777:  
1778:          NDUMMY=01443:          NDUMMY=0
1779:          DO J1=1,NATOMS1444:          DO J1=1,NATOMS
1780:             IF (ATOMACTIVE(J1)) NDUMMY=NDUMMY+11445:             IF (ATOMACTIVE(J1)) NDUMMY=NDUMMY+1
1781:          ENDDO1446:          ENDDO
1782:          IF (NDUMMY.NE.NACTIVE) THEN1447:          IF (NDUMMY.NE.NACTIVE) THEN
1783:             WRITE(MYUNIT,'(A,I6)') ' doaddatom> ERROR *** inconsistency in number of active atoms. ',NDUMMY,' should be ',NACTIVE1448:             WRITE(MYUNIT,'(A,I6)') ' intlbfgs> ERROR *** inconsistency in number of active atoms. ',NDUMMY,' should be ',NACTIVE
1784:             DO J1=1,NATOMS1449:             DO J1=1,NATOMS
1785:                IF (ATOMACTIVE(J1)) WRITE(MYUNIT,'(A,I6)') ' active atom ',J11450:                IF (ATOMACTIVE(J1)) WRITE(MYUNIT,'(A,I6)') ' active atom ',J1
1786:             ENDDO1451:             ENDDO
1787:             STOP1452:             STOP
1788:          ENDIF1453:          ENDIF
1789: 1454: 
1790:          TURNONORDER(NACTIVE)=NEWATOM1455:          TURNONORDER(NACTIVE)=NEWATOM
1791: !1456: !
1792: ! Initial guess for new active atom position. This is crucial for success in INTCONSTRAINT schemes!1457: ! Initial guess for new active atom position. This is crucial for success in INTCONSTRAINT schemes!
1793: !1458: !
1794:          ESAVED=1.0D1001459:          ESAVED=1.0D100
1795:          ESAVE0=1.0D1001460:          ESAVE0=1.0D100
1796:          ESAVEC=1.0D1001461:          ESAVEC=1.0D100
1797:          IF (NCONFORNEWATOM.GE.3) THEN1462:          IF (NCONFORNEWATOM.GE.3) THEN
1798: !1463: !
1799: ! Move the new atom consistently in the local environment of its three nearest actively constrained atoms.1464: ! Move the new atom consistently in the local environment of its three nearest actively constrained atoms.
1800: ! Make a local orthogonal coordinate system and use constant components in this basis.1465: ! Make a local orthogonal coordinate system and use constant components in this basis.
1801: !1466: !
1802:             IF (DEBUG) WRITE(MYUNIT,'(A,3I6)') ' intlbfgs> initial guess from closest three constrained active atoms, ',CONLIST(1:3)1467:             IF (DEBUG) WRITE(MYUNIT,'(A)') ' intlbfgs> initial guess from closest three constrained active atoms'
1803:             VEC1(1:3)=XYZ(3*(CONLIST(2)-1)+1:3*(CONLIST(2)-1)+3)-XYZ(3*(CONLIST(1)-1)+1:3*(CONLIST(1)-1)+3)1468:             VEC1(1:3)=XYZ(3*(CONLIST(2)-1)+1:3*(CONLIST(2)-1)+3)-XYZ(3*(CONLIST(1)-1)+1:3*(CONLIST(1)-1)+3)
1804:             DUMMY=SQRT(VEC1(1)**2+VEC1(2)**2+VEC1(3)**2)1469:             DUMMY=SQRT(VEC1(1)**2+VEC1(2)**2+VEC1(3)**2)
1805:             IF (DUMMY.NE.0.0D0) VEC1(1:3)=VEC1(1:3)/DUMMY1470:             IF (DUMMY.NE.0.0D0) VEC1(1:3)=VEC1(1:3)/DUMMY
1806:             VEC2(1:3)=XYZ(3*(CONLIST(3)-1)+1:3*(CONLIST(3)-1)+3)-XYZ(3*(CONLIST(1)-1)+1:3*(CONLIST(1)-1)+3)1471:             VEC2(1:3)=XYZ(3*(CONLIST(3)-1)+1:3*(CONLIST(3)-1)+3)-XYZ(3*(CONLIST(1)-1)+1:3*(CONLIST(1)-1)+3)
1807:             DUMMY=VEC1(1)*VEC2(1)+VEC1(2)*VEC2(2)+VEC1(3)*VEC2(3)1472:             DUMMY=VEC1(1)*VEC2(1)+VEC1(2)*VEC2(2)+VEC1(3)*VEC2(3)
1808:             VEC2(1:3)=VEC2(1:3)-DUMMY*VEC1(1:3)1473:             VEC2(1:3)=VEC2(1:3)-DUMMY*VEC1(1:3)
1809:             DUMMY=SQRT(VEC2(1)**2+VEC2(2)**2+VEC2(3)**2)1474:             DUMMY=SQRT(VEC2(1)**2+VEC2(2)**2+VEC2(3)**2)
1810:             IF (DUMMY.NE.0.0D0) VEC2(1:3)=VEC2(1:3)/DUMMY1475:             IF (DUMMY.NE.0.0D0) VEC2(1:3)=VEC2(1:3)/DUMMY
1811:             VEC3(1)= VEC1(2)*VEC2(3)-VEC1(3)*VEC2(2)1476:             VEC3(1)= VEC1(2)*VEC2(3)-VEC1(3)*VEC2(2)
1812:             VEC3(2)=-VEC1(1)*VEC2(3)+VEC1(3)*VEC2(1)1477:             VEC3(2)=-VEC1(1)*VEC2(3)+VEC1(3)*VEC2(1)
1926:   &                     -XYZ((J1-1)*3*NATOMS+3*(BESTPRESERVEDN(N1)-1)+1:(J1-1)*3*NATOMS+3*(BESTPRESERVEDN(N1)-1)+3)1591:   &                     -XYZ((J1-1)*3*NATOMS+3*(BESTPRESERVEDN(N1)-1)+1:(J1-1)*3*NATOMS+3*(BESTPRESERVEDN(N1)-1)+3)
1927:                DUMMY=VEC1(1)*VEC2(1)+VEC1(2)*VEC2(2)+VEC1(3)*VEC2(3)1592:                DUMMY=VEC1(1)*VEC2(1)+VEC1(2)*VEC2(2)+VEC1(3)*VEC2(3)
1928:                VEC2(1:3)=VEC2(1:3)-DUMMY*VEC1(1:3)1593:                VEC2(1:3)=VEC2(1:3)-DUMMY*VEC1(1:3)
1929:                DUMMY=SQRT(VEC2(1)**2+VEC2(2)**2+VEC2(3)**2)1594:                DUMMY=SQRT(VEC2(1)**2+VEC2(2)**2+VEC2(3)**2)
1930:                IF (DUMMY.NE.0.0D0) VEC2(1:3)=VEC2(1:3)/DUMMY1595:                IF (DUMMY.NE.0.0D0) VEC2(1:3)=VEC2(1:3)/DUMMY
1931:                VEC3(1)= VEC1(2)*VEC2(3)-VEC1(3)*VEC2(2)1596:                VEC3(1)= VEC1(2)*VEC2(3)-VEC1(3)*VEC2(2)
1932:                VEC3(2)=-VEC1(1)*VEC2(3)+VEC1(3)*VEC2(1)1597:                VEC3(2)=-VEC1(1)*VEC2(3)+VEC1(3)*VEC2(1)
1933:                VEC3(3)= VEC1(1)*VEC2(2)-VEC1(2)*VEC2(1)1598:                VEC3(3)= VEC1(1)*VEC2(2)-VEC1(2)*VEC2(1)
1934:                XYZ((J1-1)*3*NATOMS+3*(NEWATOM-1)+1:(J1-1)*3*NATOMS+3*(NEWATOM-1)+3)= &1599:                XYZ((J1-1)*3*NATOMS+3*(NEWATOM-1)+1:(J1-1)*3*NATOMS+3*(NEWATOM-1)+3)= &
1935:   &            XYZ((J1-1)*3*NATOMS+3*(BESTPRESERVEDN(N1)-1)+1:(J1-1)*3*NATOMS+3*(BESTPRESERVEDN(N1)-1)+3)+ &1600:   &            XYZ((J1-1)*3*NATOMS+3*(BESTPRESERVEDN(N1)-1)+1:(J1-1)*3*NATOMS+3*(BESTPRESERVEDN(N1)-1)+3)+ &
1936:   &                   C1*VEC1(1:3)+C2*VEC2(1:3)+C3*VEC3(1:3)+0.01D0*(DPRAND()-0.5D0)*2.0D01601:   &                   C1*VEC1(1:3)+C2*VEC2(1:3)+C3*VEC3(1:3)
1937: !              WRITE(MYUNIT,'(A,I6,3G20.10)') 'intlbfgs> J1,C1,C2,C3=',J1,C1,C2,C3 
1938: !              WRITE(MYUNIT,'(A,9G20.10)') 'intlbfgs> VEC1,2,3=',VEC1(1:3),VEC2(1:3),VEC3(1:3) 
1939: !              WRITE(MYUNIT,'(A,6I6)') 'intlbfgs> N1,N2,N3,Bestpreserved N1,N2,N3=',N1,N2,N3, & 
1940: ! &                 BESTPRESERVEDN(N1),BESTPRESERVEDN(N2),BESTPRESERVEDN(N3) 
1941:             ENDDO1602:             ENDDO
1942: 1603: 
1943:             CALL CHECKREP(INTIMAGE,XYZ,(3*NATOMS),NNREPSAVE,NREPSAVE+1) ! set up repulsive neighbour list1604:             CALL CHECKREP(INTIMAGE,XYZ,(3*NATOMS),NNREPSAVE,NREPSAVE+1) ! set up repulsive neighbour list
1944:             IF (CHECKCONINT) THEN1605:             IF (CHECKCONINT) THEN
1945:                CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)1606:                CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
1946:             ELSE1607:             ELSE
1947:                CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)1608:                CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
1948:             ENDIF1609:             ENDIF
1949:             ESAVED=ETOTAL1610:             ESAVED=ETOTAL
1950:             DO J1=2,INTIMAGE+11611:             DO J1=2,INTIMAGE+1
2082:          ELSE 1743:          ELSE 
2083:             IF (DEBUG) WRITE(MYUNIT,'(A,2G20.10)') ' intlbfgs> lowest energy from interpolation using closest constraints'1744:             IF (DEBUG) WRITE(MYUNIT,'(A,2G20.10)') ' intlbfgs> lowest energy from interpolation using closest constraints'
2084:             DO J1=2,INTIMAGE+11745:             DO J1=2,INTIMAGE+1
2085:                XYZ((J1-1)*3*NATOMS+3*(NEWATOM-1)+1:(J1-1)*3*NATOMS+3*(NEWATOM-1)+3)=XSAVE0(1:3,J1)1746:                XYZ((J1-1)*3*NATOMS+3*(NEWATOM-1)+1:(J1-1)*3*NATOMS+3*(NEWATOM-1)+3)=XSAVE0(1:3,J1)
2086:             ENDDO1747:             ENDDO
2087:             ETOTAL=ESAVE01748:             ETOTAL=ESAVE0
2088:          ENDIF1749:          ENDIF
2089:       ENDIF1750:       ENDIF
2090:       NADDED=NADDED+11751:       NADDED=NADDED+1
2091:       IF (NADDED.LT.NTOADD) GOTO 5421752:       IF (NADDED.LT.NTOADD) GOTO 542
2092:  
2093:       IF (QCIRADSHIFTT) THEN 
2094:          WRITE(MYUNIT,'(A,F15.5)') ' intlbfgs> Applying radial shift for unconstrained atoms of ',QCIRADSHIFT 
2095:          WRITE(MYUNIT,'(20I6)') CONLIST(1:NCONFORNEWATOM) 
2096:          DO J1=2,INTIMAGE+1 
2097:             scaleloop: DO J2=1,NATOMS 
2098:                IF (.NOT.ATOMACTIVE(J2)) CYCLE scaleloop 
2099:                IF (J2.EQ.NEWATOM) CYCLE scaleloop 
2100:                DO J3=1,NCONFORNEWATOM 
2101:                   IF (CONLIST(J3).EQ.J2) CYCLE scaleloop 
2102:                ENDDO 
2103:                VEC1(1:3)=XYZ((J1-1)*3*NATOMS+3*(J2-1)+1:(J1-1)*3*NATOMS+3*(J2-1)+3)- & 
2104:    &                     XYZ((J1-1)*3*NATOMS+3*(NEWATOM-1)+1:(J1-1)*3*NATOMS+3*(NEWATOM-1)+3) 
2105:                DUMMY=SQRT(VEC1(1)**2+VEC1(2)**2+VEC1(3)**2) 
2106:                IF (DUMMY.NE.0.0D0) VEC1(1:3)=VEC1(1:3)*QCIRADSHIFT/DUMMY 
2107:                XYZ((J1-1)*3*NATOMS+3*(J2-1)+1:(J1-1)*3*NATOMS+3*(J2-1)+3)= & 
2108:    &           XYZ((J1-1)*3*NATOMS+3*(J2-1)+1:(J1-1)*3*NATOMS+3*(J2-1)+3)+VEC1(1:3) 
2109: !!!!!!!!!!! debug DJW !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
2110: !              VEC1(1:3)=XYZ((J1-1)*3*NATOMS+3*(J2-1)+1:(J1-1)*3*NATOMS+3*(J2-1)+3)- & 
2111: !  &                     XYZ((J1-1)*3*NATOMS+3*(NEWATOM-1)+1:(J1-1)*3*NATOMS+3*(NEWATOM-1)+3) 
2112: !              DUMMY2=SQRT(VEC1(1)**2+VEC1(2)**2+VEC1(3)**2) 
2113: !              PRINT '(A,I6,A,2I6,A,2F15.5)','image ',J1,' atoms ',NEWATOM,J2,' initial and final distance=',DUMMY,DUMMY2 
2114: !!!!!!!!!!! debug DJW !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
2115:             ENDDO scaleloop 
2116:          ENDDO 
2117:       ENDIF 
2118: !1753: !
2119: ! Turn frozen images off for new added atom.1754: ! Turn frozen images off for new added atom.
2120: !1755: !
2121: !     IF (DEBUG) WRITE(MYUNIT,'(A)') ' intlbfgs> turning off frozen images'1756: !     IF (DEBUG) WRITE(MYUNIT,'(A)') ' intlbfgs> turning off frozen images'
2122: !     IF (FREEZENODEST) IMGFREEZE(1:INTIMAGE)=.FALSE.1757: !     IF (FREEZENODEST) IMGFREEZE(1:INTIMAGE)=.FALSE.
2123:       CALL CHECKREP(INTIMAGE,XYZ,(3*NATOMS),NNREPSAVE,NREPSAVE+1) ! set up repulsive neighbour list1758:       CALL CHECKREP(INTIMAGE,XYZ,(3*NATOMS),NNREPSAVE,NREPSAVE+1) ! set up repulsive neighbour list
2124: !1759: !
2125: ! need a new gradient since the active atom has changed !1760: ! need a new gradient since the active atom has changed !
2126: !1761: !
2127:       IF (CHECKCONINT) THEN1762:       IF (CHECKCONINT) THEN
2128:          CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)1763:          CALL CONGRAD2(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
2129:       ELSE1764:       ELSE
2130:          CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)1765:          CALL CONGRAD(NMAXINT,NMININT,ETOTAL,XYZ,GGG,EEE,IMGFREEZE,RMS)
2131:       ENDIF1766:       ENDIF
2132: 1767: 
2133: END SUBROUTINE DOADDATOM1768: END SUBROUTINE DOADDATOM
2134: 1769: 
2135: SUBROUTINE CHECKPERC(LXYZ,LINTCONSTRAINTTOL,NQCIFREEZE,NCPFIT)1770: SUBROUTINE CHECKPERC(LXYZ,LINTCONSTRAINTTOL,NQCIFREEZE,NCPFIT)
2136: USE COMMONS, ONLY : ATOMACTIVE, NCONSTRAINT, INTFROZEN, CONI, CONJ, CONDISTREF, INTCONMAX, INTCONSTRAINTTOL, &1771: USE COMMONS, ONLY : ATOMACTIVE, NCONSTRAINT, INTFROZEN, CONI, CONJ, CONDISTREF, INTCONMAX, INTCONSTRAINTTOL, &
2137:   &             INTCONSEP, NCONGEOM, CONGEOM, CONIFIX, CONJFIX, CONDISTREFFIX, MYUNIT, INTCONCUT, &1772:   &             INTCONSEP, NCONGEOM, CONGEOM, CONIFIX, CONJFIX, CONDISTREFFIX, MYUNIT, &
2138:   &             NCONSTRAINTFIX, PERIODIC, TWOD, RIGID, CONDATT, CONCUT, CONCUTFIX, NATOMS, DEBUG, BOXLX, BOXLY, BOXLZ1773:   &             NCONSTRAINTFIX, PERIODIC, TWOD, RIGID, CONDATT, CONCUT, CONCUTFIX, NATOMS, DEBUG, BOXLX, BOXLY, BOXLZ
2139: IMPLICIT NONE1774: IMPLICIT NONE
2140: INTEGER NDIST1(NATOMS), NCYCLE, DMIN1, DMAX1, NUNCON1, J1, J2, J3, NQCIFREEZE, J4, NCPFIT1775: INTEGER NDIST1(NATOMS), NCYCLE, DMIN1, DMAX1, NUNCON1, J1, J2, J3, NQCIFREEZE, J4, NCPFIT
2141: DOUBLE PRECISION LINTCONSTRAINTTOL, MAXCONDIST, MINCONDIST, DS, DF, LXYZ((3*NATOMS)*2)1776: DOUBLE PRECISION LINTCONSTRAINTTOL, MAXCONDIST, MINCONDIST, DS, DF, LXYZ((3*NATOMS)*2)
2142: DOUBLE PRECISION DSMIN, DSMAX, DSMEAN, D, DIST2, RMAT(3,3)1777: DOUBLE PRECISION DSMIN, DSMAX, DSMEAN, D, DIST2, RMAT(3,3)
2143: LOGICAL CHANGED, LDEBUG1778: LOGICAL CHANGED
2144: LOGICAL :: CALLED=.FALSE.1779: LOGICAL :: CALLED=.FALSE.
2145: SAVE CALLED1780: SAVE CALLED
2146: 1781: 
2147: LINTCONSTRAINTTOL=INTCONSTRAINTTOL1782: LINTCONSTRAINTTOL=INTCONSTRAINTTOL
2148: 1783: 
2149: IF (.NOT.ALLOCATED(ATOMACTIVE)) ALLOCATE(ATOMACTIVE(NATOMS))1784: IF (.NOT.ALLOCATED(ATOMACTIVE)) ALLOCATE(ATOMACTIVE(NATOMS))
2150: !1785: !
2151: ! Fixed constraints based on congeom file entries1786: ! Fixed constraints based on congeom file entries
2152: ! Just need to adjust the list based on any frozen atoms. We1787: ! Just need to adjust the list based on any frozen atoms. We
2153: ! want to exclude any constraints between two frozen atoms 1788: ! want to exclude any constraints between two frozen atoms 
2186:          CONCUT(J2)=CONCUTFIX(J1)1821:          CONCUT(J2)=CONCUTFIX(J1)
2187:       ENDDO1822:       ENDDO
2188:       NCONSTRAINT=J21823:       NCONSTRAINT=J2
2189:       WRITE(MYUNIT,'(A,I6,A)') ' checkperc> After allowing for frozen atoms there are ',NCONSTRAINT,' constraints'1824:       WRITE(MYUNIT,'(A,I6,A)') ' checkperc> After allowing for frozen atoms there are ',NCONSTRAINT,' constraints'
2190:       RETURN 1825:       RETURN 
2191:    ELSE1826:    ELSE
2192: !1827: !
2193: ! Put reference minima in optimal permutational alignment with reference minimum one.1828: ! Put reference minima in optimal permutational alignment with reference minimum one.
2194: !1829: !
2195:       DO J2=2,NCONGEOM1830:       DO J2=2,NCONGEOM
2196:          LDEBUG=.FALSE.1831:          CALL MINPERMDIST(CONGEOM(1,1:3*NATOMS),CONGEOM(J2,1:3*NATOMS),NATOMS,DEBUG, &
2197:          CALL MINPERMDIST(CONGEOM(1,1:3*NATOMS),CONGEOM(J2,1:3*NATOMS),NATOMS,LDEBUG, & 
2198:   &                       BOXLX,BOXLY,BOXLZ,PERIODIC,TWOD,D,DIST2,RIGID,RMAT)1832:   &                       BOXLX,BOXLY,BOXLZ,PERIODIC,TWOD,D,DIST2,RIGID,RMAT)
2199:       ENDDO1833:       ENDDO
2200:    ENDIF1834:    ENDIF
2201:    ALLOCATE(CONIFIX(INTCONMAX),CONJFIX(INTCONMAX),CONCUTFIX(INTCONMAX),CONDISTREFFIX(INTCONMAX))1835:    ALLOCATE(CONIFIX(INTCONMAX),CONJFIX(INTCONMAX),CONCUTFIX(INTCONMAX),CONDISTREFFIX(INTCONMAX))
2202: ENDIF1836: ENDIF
2203: 1837: 
2204: 51   NCONSTRAINT=0 1838: 51   NCONSTRAINT=0 
2205: MAXCONDIST=-1.0D01839: MAXCONDIST=-1.0D0
2206: MINCONDIST=1.0D1001840: MINCONDIST=1.0D100
2207: IF (NCONGEOM.LT.2) THEN 1841: IF (NCONGEOM.LT.2) THEN 
2208:    DO J2=1,NATOMS1842:    DO J2=1,NATOMS
2209:       DO J3=J2+1,NATOMS1843:       DO J3=J2+1,NATOMS
2210: 1844: 
2211:          IF (J3-J2.GT.INTCONSEP) CYCLE ! forbid constraints corresponding to atoms distant in sequence1845:          IF (J3-J2.GT.INTCONSEP) CYCLE ! forbid constraints corresponding to atoms distant in sequence
2212:          IF (INTFROZEN(J2).AND.INTFROZEN(J3)) CYCLE ! no constraints between intfrozen atoms1846:          IF (INTFROZEN(J2).AND.INTFROZEN(J3)) CYCLE ! no constraints between intfrozen atoms
2213:          DS=SQRT((LXYZ(3*(J2-1)+1)-LXYZ(3*(J3-1)+1))**2 &1847:          DS=SQRT((LXYZ(3*(J2-1)+1)-LXYZ(3*(J3-1)+1))**2 &
2214:   &             +(LXYZ(3*(J2-1)+2)-LXYZ(3*(J3-1)+2))**2 &1848:   &             +(LXYZ(3*(J2-1)+2)-LXYZ(3*(J3-1)+2))**2 &
2215:   &             +(LXYZ(3*(J2-1)+3)-LXYZ(3*(J3-1)+3))**2) 1849:   &             +(LXYZ(3*(J2-1)+3)-LXYZ(3*(J3-1)+3))**2) 
2216:          IF (DS.GT.INTCONCUT) CYCLE ! don't allow constraints if either endpoint separation is too large DJW1850:          IF (DS.GT.5.0D0) CYCLE ! don't allow constraints if either endpoint separation is too large DJW
 1851: !        IF (DS.GT.15.0D0) CYCLE ! don't allow constraints if either endpoint separation is too large DJW
2217:          DF=SQRT((LXYZ(3*NATOMS+3*(J2-1)+1)-LXYZ(3*NATOMS+3*(J3-1)+1))**2 &1852:          DF=SQRT((LXYZ(3*NATOMS+3*(J2-1)+1)-LXYZ(3*NATOMS+3*(J3-1)+1))**2 &
2218:   &             +(LXYZ(3*NATOMS+3*(J2-1)+2)-LXYZ(3*NATOMS+3*(J3-1)+2))**2 &1853:   &             +(LXYZ(3*NATOMS+3*(J2-1)+2)-LXYZ(3*NATOMS+3*(J3-1)+2))**2 &
2219:   &             +(LXYZ(3*NATOMS+3*(J2-1)+3)-LXYZ(3*NATOMS+3*(J3-1)+3))**2) 1854:   &             +(LXYZ(3*NATOMS+3*(J2-1)+3)-LXYZ(3*NATOMS+3*(J3-1)+3))**2) 
2220:          IF (DF.GT.INTCONCUT) CYCLE ! don't allow constraints if either endpoint separation is too large DJW1855:          IF (DF.GT.5.0D0) CYCLE ! don't allow constraints if either endpoint separation is too large DJW
 1856: !        IF (DF.GT.15.0D0) CYCLE ! don't allow constraints if either endpoint separation is too large DJW
2221: !        IF (2.0D0*ABS(DS-DF)/(DS+DF).LT.LINTCONSTRAINTTOL) THEN1857: !        IF (2.0D0*ABS(DS-DF)/(DS+DF).LT.LINTCONSTRAINTTOL) THEN
2222:          WRITE(MYUNIT,'(A,2I6,2G20.10)') 'intlbfgs> J2,J3,DS,DF=', J2,J3,DS,DF 
2223:          IF (ABS(DS-DF).LT.LINTCONSTRAINTTOL) THEN1858:          IF (ABS(DS-DF).LT.LINTCONSTRAINTTOL) THEN
2224: !1859: !
2225: !  Add constraint for this distance to the list.1860: !  Add constraint for this distance to the list.
2226: !1861: !
2227:             NCONSTRAINT=NCONSTRAINT+11862:             NCONSTRAINT=NCONSTRAINT+1
2228:             WRITE(MYUNIT,'(A,2I6,A,I6)') 'intlbfgs> Adding constraint for atoms ',J2,J3,'  total=',NCONSTRAINT1863: !           PRINT '(A,2I6,A,I6)','checkperc> Adding constraint for atoms ',J2,J3,'  total=',NCONSTRAINT
2229:             IF (NCONSTRAINT.GT.INTCONMAX) CALL CONDOUBLE1864:             IF (NCONSTRAINT.GT.INTCONMAX) CALL CONDOUBLE
2230:             CONI(NCONSTRAINT)=J21865:             CONI(NCONSTRAINT)=J2
2231:             CONJ(NCONSTRAINT)=J31866:             CONJ(NCONSTRAINT)=J3
2232:             CONDISTREF(NCONSTRAINT)=(DF+DS)/2.0D01867:             CONDISTREF(NCONSTRAINT)=(DF+DS)/2.0D0
2233:             CONCUT(NCONSTRAINT)=ABS(DF-DS)/2.0D01868:             CONCUT(NCONSTRAINT)=ABS(DF-DS)/2.0D0
2234:             IF (CONDISTREF(NCONSTRAINT).GT.MAXCONDIST) MAXCONDIST=CONDISTREF(NCONSTRAINT)1869:             IF (CONDISTREF(NCONSTRAINT).GT.MAXCONDIST) MAXCONDIST=CONDISTREF(NCONSTRAINT)
2235:             IF (CONDISTREF(NCONSTRAINT).LT.MINCONDIST) MINCONDIST=CONDISTREF(NCONSTRAINT)1870:             IF (CONDISTREF(NCONSTRAINT).LT.MINCONDIST) MINCONDIST=CONDISTREF(NCONSTRAINT)
2236: !           IF (DEBUG) PRINT '(A,2I6,A,2F12.2,A,F12.4,A,I8)',' intlbfgs> constrain distance for atoms ',CONI(NCONSTRAINT), &1871: !           IF (DEBUG) PRINT '(A,2I6,A,2F12.2,A,F12.4,A,I8)',' checkperc> constrain distance for atoms ',CONI(NCONSTRAINT), &
2237: ! &                 CONJ(NCONSTRAINT),' values are ',DS,DF,' fraction=',2*ABS(DS-DF)/(DS+DF), &1872: ! &                 CONJ(NCONSTRAINT),' values are ',DS,DF,' fraction=',2*ABS(DS-DF)/(DS+DF), &
2238: ! &                ' # constraints=',NCONSTRAINT1873: ! &                ' # constraints=',NCONSTRAINT
2239:          ENDIF1874:          ENDIF
2240:       ENDDO1875:       ENDDO
2241:    ENDDO1876:    ENDDO
2242:    IF (DEBUG) WRITE(MYUNIT,'(A,I6,2(A,F15.5))') ' intlbfgs> Total distance constraints=',NCONSTRAINT, &1877:    IF (DEBUG) WRITE(MYUNIT,'(A,I6,2(A,F15.5))') ' checkperc> Total distance constraints=',NCONSTRAINT, &
2243:   &                                     ' shortest=',MINCONDIST,' longest=',MAXCONDIST1878:   &                                     ' shortest=',MINCONDIST,' longest=',MAXCONDIST
2244: ELSE1879: ELSE
2245:    DO J2=1,NATOMS1880:    DO J2=1,NATOMS
2246:       DO J3=J2+1,NATOMS1881:       DO J3=J2+1,NATOMS
2247:          IF (J3-J2.GT.INTCONSEP) CYCLE ! forbid constraints corresponding to atoms distant in sequence1882:          IF (J3-J2.GT.INTCONSEP) CYCLE ! forbid constraints corresponding to atoms distant in sequence
2248:          DSMIN=1.0D1001883:          DSMIN=1.0D100
2249:          DSMAX=-1.0D1001884:          DSMAX=-1.0D100
2250:          DSMEAN=0.0D01885:          DSMEAN=0.0D0
2251:          DO J4=1,NCONGEOM1886:          DO J4=1,NCONGEOM
2252:             DS=SQRT((CONGEOM(J4,3*(J2-1)+1)-CONGEOM(J4,3*(J3-1)+1))**2 &1887:             DS=SQRT((CONGEOM(J4,3*(J2-1)+1)-CONGEOM(J4,3*(J3-1)+1))**2 &
2253:   &                +(CONGEOM(J4,3*(J2-1)+2)-CONGEOM(J4,3*(J3-1)+2))**2 &1888:   &                +(CONGEOM(J4,3*(J2-1)+2)-CONGEOM(J4,3*(J3-1)+2))**2 &
2254:   &                +(CONGEOM(J4,3*(J2-1)+3)-CONGEOM(J4,3*(J3-1)+3))**2) 1889:   &                +(CONGEOM(J4,3*(J2-1)+3)-CONGEOM(J4,3*(J3-1)+3))**2) 
2255:             IF (DS.GT.DSMAX) DSMAX=DS1890:             IF (DS.GT.DSMAX) DSMAX=DS
2256:             IF (DS.LT.DSMIN) DSMIN=DS1891:             IF (DS.LT.DSMIN) DSMIN=DS
2257:             IF ((J4.GT.1).AND.(ABS(DSMIN-DSMAX).GT.LINTCONSTRAINTTOL)) GOTO 753 ! unconstrained1892:             IF ((J4.GT.1).AND.(ABS(DSMIN-DSMAX).GT.LINTCONSTRAINTTOL)) GOTO 753 ! unconstrained
2258:             IF (DS.GT.INTCONCUT) GOTO 753 ! don't allow constraints if any image separation is too large DJW 
2259:             DSMEAN=DSMEAN+DS1893:             DSMEAN=DSMEAN+DS
2260:          ENDDO1894:          ENDDO
2261: !1895: !
2262: !  Add constraint for this distance to the list if we make it to here.1896: !  Add constraint for this distance to the list if we make it to here.
2263: !1897: !
2264:          NCONSTRAINT=NCONSTRAINT+11898:          NCONSTRAINT=NCONSTRAINT+1
2265:          WRITE(MYUNIT,'(A,2I6,A,I6)') 'checkperc> Adding constraint for atoms ',J2,J3,'  total=',NCONSTRAINT1899: !        PRINT '(A,2I6,A,I6)','checkperc> Adding constraint for atoms ',J2,J3,'  total=',NCONSTRAINT
2266:          IF (NCONSTRAINT.GT.INTCONMAX) CALL CONDOUBLE1900:          IF (NCONSTRAINT.GT.INTCONMAX) CALL CONDOUBLE
2267:          CONI(NCONSTRAINT)=J21901:          CONI(NCONSTRAINT)=J2
2268:          CONJ(NCONSTRAINT)=J31902:          CONJ(NCONSTRAINT)=J3
2269:          CONDISTREF(NCONSTRAINT)=(DSMAX+DSMIN)/2.0D0 1903:          CONDISTREF(NCONSTRAINT)=(DSMAX+DSMIN)/2.0D0 
2270:          CONCUT(NCONSTRAINT)=(DSMAX-DSMIN)/2.0D01904:          CONCUT(NCONSTRAINT)=(DSMAX-DSMIN)/2.0D0
2271:          IF (CONDISTREF(NCONSTRAINT).GT.MAXCONDIST) MAXCONDIST=CONDISTREF(NCONSTRAINT)1905:          IF (CONDISTREF(NCONSTRAINT).GT.MAXCONDIST) MAXCONDIST=CONDISTREF(NCONSTRAINT)
2272:          IF (CONDISTREF(NCONSTRAINT).LT.MINCONDIST) MINCONDIST=CONDISTREF(NCONSTRAINT)1906:          IF (CONDISTREF(NCONSTRAINT).LT.MINCONDIST) MINCONDIST=CONDISTREF(NCONSTRAINT)
2273:          IF (DEBUG) WRITE(MYUNIT,'(A,2I5,A,2F10.4,A,F12.4,A,I8)') &1907:          IF (DEBUG) WRITE(MYUNIT,'(A,2I5,A,2F10.4,A,F12.4,A,I8)') &
2274:   &                       ' checkperc> constrain atoms ',CONI(NCONSTRAINT), &1908:   &                       ' checkperc> constrain atoms ',CONI(NCONSTRAINT), &
2275:   &                       CONJ(NCONSTRAINT),' max, min ',DSMAX,DSMIN, &1909:   &                       CONJ(NCONSTRAINT),' max, min ',DSMAX,DSMIN, &


r29792/io1.f 2016-03-16 18:33:29.439018446 +0000 r29791/io1.f 2016-03-16 18:33:32.311047979 +0000
101:                   IF (ZSYM(J1).EQ.'C ') IATNUM(J1+1)=6101:                   IF (ZSYM(J1).EQ.'C ') IATNUM(J1+1)=6
102:                   IF (ZSYM(J1).EQ.'N ') IATNUM(J1+1)=7102:                   IF (ZSYM(J1).EQ.'N ') IATNUM(J1+1)=7
103:                   IF (ZSYM(J1).EQ.'O ') IATNUM(J1+1)=8103:                   IF (ZSYM(J1).EQ.'O ') IATNUM(J1+1)=8
104:                   IF (ZSYM(J1).EQ.'F ') IATNUM(J1+1)=9104:                   IF (ZSYM(J1).EQ.'F ') IATNUM(J1+1)=9
105:                   IF (ZSYM(J1).EQ.'S ') IATNUM(J1+1)=18105:                   IF (ZSYM(J1).EQ.'S ') IATNUM(J1+1)=18
106:                   CALL READF(COORDS(J2+1,JP))106:                   CALL READF(COORDS(J2+1,JP))
107:                   CALL READF(COORDS(J2+2,JP))107:                   CALL READF(COORDS(J2+2,JP))
108:                   CALL READF(COORDS(J2+3,JP))108:                   CALL READF(COORDS(J2+3,JP))
109:                ENDDO109:                ENDDO
110:             ENDDO110:             ENDDO
111:          ELSEIF (MLP3T) THEN ! for this neural net it is one variable per line 
112:             REWIND(COORDS_UNIT) 
113:             DO JP=1,NPAR 
114:                DO J1=1,NATOMS 
115:                    READ(COORDS_UNIT,*) COORDS(J1,JP) 
116:                ENDDO 
117:             ENDDO 
118:          ELSE111:          ELSE
119:             REWIND(COORDS_UNIT)112:             rewind(COORDS_UNIT)
120:             DO JP=1,NPAR113:             DO JP=1,NPAR
121:                DO J1=1,NATOMS114:                DO J1=1,NATOMS
122:                   J2=3*(J1-1)115:                   J2=3*(J1-1)
123:                    READ(COORDS_UNIT,*) COORDS(J2+1,JP), COORDS(J2+2,JP), COORDS(J2+3,JP)116:                    READ(COORDS_UNIT,*) COORDS(J2+1,JP), COORDS(J2+2,JP), COORDS(J2+3,JP)
124:                ENDDO117:                ENDDO
125:             ENDDO118:             ENDDO
126:          ENDIF119:          ENDIF
127:          CLOSE(COORDS_UNIT)120:          CLOSE(COORDS_UNIT)
128: !      ELSE IF (AMBERT) THEN121: !      ELSE IF (AMBERT) THEN
129: !         DO JP=1,NPAR122: !         DO JP=1,NPAR
184:                COORDS(J1,JP)=COORDS(J1,JP)*RESIZE177:                COORDS(J1,JP)=COORDS(J1,JP)*RESIZE
185:             ENDDO178:             ENDDO
186:          ENDDO179:          ENDDO
187:       ENDIF180:       ENDIF
188: 181: 
189:       IF (.NOT.SEEDT.AND..NOT.AMHT.AND..NOT.SUPPRESST) THEN182:       IF (.NOT.SEEDT.AND..NOT.AMHT.AND..NOT.SUPPRESST) THEN
190:          WRITE(MYUNIT,20) 183:          WRITE(MYUNIT,20) 
191: 20       FORMAT('Initial coordinates:')184: 20       FORMAT('Initial coordinates:')
192:          IF (MPIT) THEN185:          IF (MPIT) THEN
193:             WRITE(MYUNIT,30) (COORDS(J1,MYNODE+1),J1=1,3*NATOMS)186:             WRITE(MYUNIT,30) (COORDS(J1,MYNODE+1),J1=1,3*NATOMS)
194:          ELSEIF (MLP3T) THEN  
195:             WRITE(MYUNIT,'(G20.10)') (COORDS(J1,MYNODE+1),J1=1,NATOMS) 
196:          ELSE 187:          ELSE 
197:            DO JP=1,NPAR188:            DO JP=1,NPAR
198:                WRITE(MYUNIT,30) (COORDS(J1,JP),J1=1,3*NATOMS)189:                WRITE(MYUNIT,30) (COORDS(J1,JP),J1=1,3*NATOMS)
199: 30             FORMAT(3F20.10)190: 30             FORMAT(3F20.10)
200:             ENDDO191:             ENDDO
201:          ENDIF192:          ENDIF
202:       ENDIF193:       ENDIF
203: 194: 
204:       IF (MSORIGT) THEN195:       IF (MSORIGT) THEN
205:          WRITE(MYUNIT,'(I4,A)') NATOMS,' M and S silicon atoms'196:          WRITE(MYUNIT,'(I4,A)') NATOMS,' M and S silicon atoms'
690:           SELECT CASE(CUDAPOT)681:           SELECT CASE(CUDAPOT)
691:               CASE('L')682:               CASE('L')
692:                   WRITE(MYUNIT,'(A,I4,A)') 'LBFGS minimisation on the GPU with ', NATOMS,' LJ atoms'683:                   WRITE(MYUNIT,'(A,I4,A)') 'LBFGS minimisation on the GPU with ', NATOMS,' LJ atoms'
693:               CASE('A')684:               CASE('A')
694:                   WRITE(MYUNIT,'(A,I4,A)') 'LBFGS minimisation on the GPU with ', NATOMS,' AMBER12 atoms'685:                   WRITE(MYUNIT,'(A,I4,A)') 'LBFGS minimisation on the GPU with ', NATOMS,' AMBER12 atoms'
695:               CASE DEFAULT686:               CASE DEFAULT
696:                   WRITE(MYUNIT,'(A,I4,A)') 'LBFGS minimisation on the GPU with ', NATOMS,' atoms. Potential not recognised. '687:                   WRITE(MYUNIT,'(A,I4,A)') 'LBFGS minimisation on the GPU with ', NATOMS,' atoms. Potential not recognised. '
697:           END SELECT688:           END SELECT
698:       ELSEIF (QCIPOTT.OR.INTCONSTRAINTT) THEN689:       ELSEIF (QCIPOTT.OR.INTCONSTRAINTT) THEN
699:          WRITE(MYUNIT,'(I4,A)') NATOMS,' QCI atoms'690:          WRITE(MYUNIT,'(I4,A)') NATOMS,' QCI atoms'
700:       ELSEIF (MLP3T) THEN 
701:          WRITE(MYUNIT,'(I4,A)') NATOMS,' link weights for MLP3' 
702:       ELSE691:       ELSE
703:          WRITE(MYUNIT,'(I4,A)') NATOMS,' LJ atoms'692:          WRITE(MYUNIT,'(I4,A)') NATOMS,' LJ atoms'
704:       ENDIF693:       ENDIF
705:       IF (PYGPERIODICT.OR.PYBINARYT) CALL INITIALISEPYGPERIODIC694:       IF (PYGPERIODICT.OR.PYBINARYT) CALL INITIALISEPYGPERIODIC
706:       IF (LJCAPSIDT) CALL INITIALISELJCAPSIDMODEL695:       IF (LJCAPSIDT) CALL INITIALISELJCAPSIDMODEL
707:       IF (PYT) call py_input696:       IF (PYT) call py_input
708:       IF (INTMINT)  WRITE(MYUNIT,'(A)') 'Internal coordinate transformation will be used'697:       IF (INTMINT)  WRITE(MYUNIT,'(A)') 'Internal coordinate transformation will be used'
709:       IF (STAR) THEN698:       IF (STAR) THEN
710:          WRITE(MYUNIT,'(A)') 'Excited state'699:          WRITE(MYUNIT,'(A)') 'Excited state'
711:       ELSE IF (PLUS) THEN700:       ELSE IF (PLUS) THEN
860: !           ENDDO849: !           ENDDO
861: !            WRITE(MYUNIT, '(A,G15.5,A,G15.5)') 'Maximum step size scaled by estimated nearest neighbour distance of ',850: !            WRITE(MYUNIT, '(A,G15.5,A,G15.5)') 'Maximum step size scaled by estimated nearest neighbour distance of ',
862: !    &                    0.677441D0-0.0037582*NATOMS+9.40318D-6*NATOMS**2-6.21931D-9*NATOMS**3,' to give ',STEP(1)851: !    &                    0.677441D0-0.0037582*NATOMS+9.40318D-6*NATOMS**2-6.21931D-9*NATOMS**3,' to give ',STEP(1)
863:          ELSEIF (MULLERBROWNT) THEN 852:          ELSEIF (MULLERBROWNT) THEN 
864:             RADIUS=100.0D0853:             RADIUS=100.0D0
865:          ELSE 854:          ELSE 
866:             RADIUS=RADIUS*2.0D0**(1.0D0/6.0D0)855:             RADIUS=RADIUS*2.0D0**(1.0D0/6.0D0)
867:          ENDIF856:          ENDIF
868:       ENDIF857:       ENDIF
869:       IF ((.NOT.PERIODIC).AND.(.NOT.AMBER).AND.(.NOT.BLNT).AND.(.NOT.MULLERBROWNT).AND.(.NOT.MODEL1T).AND.(.NOT.PERCOLATET) 858:       IF ((.NOT.PERIODIC).AND.(.NOT.AMBER).AND.(.NOT.BLNT).AND.(.NOT.MULLERBROWNT).AND.(.NOT.MODEL1T).AND.(.NOT.PERCOLATET) 
870:      &                    .AND.(.NOT.QCIPOTT).AND.(.NOT.INTCONSTRAINTT).AND.(.NOT.MLP3T)) 859:      &                    .AND.(.NOT.QCIPOTT).AND.(.NOT.INTCONSTRAINTT)) 
871:      1                    WRITE(MYUNIT,'(A,F20.10)') 'Container radius=',RADIUS860:      1                    WRITE(MYUNIT,'(A,F20.10)') 'Container radius=',RADIUS
872:       RADIUS=RADIUS**2861:       RADIUS=RADIUS**2
873:       IF (PERCOLATET) WRITE(MYUNIT,'(A,F20.10)') 'Checking for percolated structure, cutoff=',PERCCUT862:       IF (PERCOLATET) WRITE(MYUNIT,'(A,F20.10)') 'Checking for percolated structure, cutoff=',PERCCUT
874:       PERCCUT=PERCCUT**2863:       PERCCUT=PERCCUT**2
875:       IF (NPAR.GT.1) THEN864:       IF (NPAR.GT.1) THEN
876:          WRITE(MYUNIT,'(I2,A)') NPAR,' parallel runs'865:          WRITE(MYUNIT,'(I2,A)') NPAR,' parallel runs'
877:          IF (TABOOT) WRITE(MYUNIT,'(A,I4,A)') 'Taboo lists contain the lowest ',NTAB,' minima'866:          IF (TABOOT) WRITE(MYUNIT,'(A,I4,A)') 'Taboo lists contain the lowest ',NTAB,' minima'
878:       ELSE IF (TABOOT) THEN867:       ELSE IF (TABOOT) THEN
879:          WRITE(MYUNIT,'(A,I4,A)') 'Taboo list contains the lowest ',NTAB,' minima'868:          WRITE(MYUNIT,'(A,I4,A)') 'Taboo list contains the lowest ',NTAB,' minima'
880:       ENDIF869:       ENDIF


r29792/keywords.f 2016-03-16 18:33:29.639020503 +0000 r29791/keywords.f 2016-03-16 18:33:32.511050036 +0000
159:       CHFREQBB=1159:       CHFREQBB=1
160:       FTRANS=1160:       FTRANS=1
161:       FROT=1161:       FROT=1
162: 162: 
163: !163: !
164: ! QCI parameters164: ! QCI parameters
165: !165: !
166:          CONDATT=.FALSE.166:          CONDATT=.FALSE.
167:          QCIPOTT=.FALSE.167:          QCIPOTT=.FALSE.
168:          QCIPOT2T=.FALSE.168:          QCIPOT2T=.FALSE.
169:          MAXNACTIVE=0 
170:          FREEZETOL=1.0D-3169:          FREEZETOL=1.0D-3
171:          QCIPERMCHECK=.FALSE. 
172:          QCIPERMCHECKINT=100 
173:          INTCONSTRAINTT=.FALSE.170:          INTCONSTRAINTT=.FALSE.
174:          INTCONSTRAINTTOL=0.1D0171:          INTCONSTRAINTTOL=0.1D0
175:          INTCONSTRAINTDEL=10.0D0172:          INTCONSTRAINTDEL=10.0D0
176:          INTCONSTRAINTREP=100.0D0173:          INTCONSTRAINTREP=100.0D0
177:          INTCONSTRAINREPCUT=1.7D0174:          INTCONSTRAINREPCUT=1.7D0
178:          INTFREEZET=.FALSE.175:          INTFREEZET=.FALSE.
179:          INTFREEZETOL=1.0D-3176:          INTFREEZETOL=1.0D-3
180:          INTFREEZEMIN=10177:          INTFREEZEMIN=10
181:          INTCONFRAC=0.9D0178:          INTCONFRAC=0.9D0
182:          INTCONSEP=15179:          INTCONSEP=15
183:          INTCONCUT=5.0D0 
184:          INTREPSEP=0180:          INTREPSEP=0
185:          INTSTEPS1=300001181:          INTSTEPS1=300001
186:          INTCONSTEPS=100182:          INTCONSTEPS=100
187:          INTRELSTEPS=200183:          INTRELSTEPS=200
188:          MAXCONUSE=4184:          MAXCONUSE=4
189:          MAXCONE=0.01D0185:          MAXCONE=0.01D0
190:          INTRMSTOL=0.01D0186:          INTRMSTOL=0.01D0
 187:          IMSEPMIN=0.2D0
 188:          IMSEPMAX=10.0D0
191:          INTIMAGE=3189:          INTIMAGE=3
192:          MAXINTIMAGE=75190:          MAXINTIMAGE=75
193:          INTNTRIESMAX=2191:          INTNTRIESMAX=2
194:          INTIMAGEINCR=6192:          INTIMAGEINCR=6
195:          INTIMAGECHECK=25193:          INTIMAGECHECK=25
196:          IMSEPMIN=0.0D0194:          IMSEPMIN=0.0D0
197:          IMSEPMAX=HUGE(1.0D0)195:          IMSEPMAX=HUGE(1.0D0)
198: 196: 
199:          CHECKCONINT=.FALSE.197:          CHECKCONINT=.FALSE.
200:          CONCUTABS=0.15D0198:          CONCUTABS=0.15D0
535:       CHNMIN=0.D0533:       CHNMIN=0.D0
536:       CHNMAX=HUGE(1.0D0)534:       CHNMAX=HUGE(1.0D0)
537:       CHMDT=.FALSE.535:       CHMDT=.FALSE.
538:       CHMDFREQ=HUGE(1)536:       CHMDFREQ=HUGE(1)
539:       CURRENTIMP=0537:       CURRENTIMP=0
540:       BOXT=.FALSE.538:       BOXT=.FALSE.
541:       SPHERET=.FALSE.539:       SPHERET=.FALSE.
542:       RMST=.FALSE.540:       RMST=.FALSE.
543:       NEWCONFT=.FALSE.541:       NEWCONFT=.FALSE.
544:       INTMINT=.FALSE.542:       INTMINT=.FALSE.
545:       INTSPRINGACTIVET=.TRUE.543:       INTSPRINGACTIVET=.FALSE.
546:       INTMINFAC=1.0D0544:       INTMINFAC=1.0D0
547:       QCIRADSHIFTT=.FALSE. 
548:       QCIRADSHIFT=1.0D0 
549:       DAESTAT=.FALSE.545:       DAESTAT=.FALSE.
550:       MAKEOLIGOT=.FALSE.546:       MAKEOLIGOT=.FALSE.
551:       MAKEOLIGOSTART=.FALSE.547:       MAKEOLIGOSTART=.FALSE.
552:       TRANSXYT=.FALSE.548:       TRANSXYT=.FALSE.
553:       ROTZT=.FALSE.549:       ROTZT=.FALSE.
554:       NREPEAT=0550:       NREPEAT=0
555:       NFIXSEG=0551:       NFIXSEG=0
556:       OHCELLT=.FALSE.552:       OHCELLT=.FALSE.
557: 553: 
558: ! khs26> AMBER12 stuff554: ! khs26> AMBER12 stuff
693:       RPRO=1.4D0689:       RPRO=1.4D0
694:       ODIHET=.FALSE.690:       ODIHET=.FALSE.
695:       ORGYT=.FALSE.691:       ORGYT=.FALSE.
696:       OEINTT=.FALSE.692:       OEINTT=.FALSE.
697:       MON1(1:2)=1693:       MON1(1:2)=1
698:       MON2(1:2)=1694:       MON2(1:2)=1
699: 695: 
700:       BSMIN=.FALSE.696:       BSMIN=.FALSE.
701:       RKMIN=.FALSE.697:       RKMIN=.FALSE.
702:       PERMDIST=.FALSE.698:       PERMDIST=.FALSE.
703:       LOCALPERMDIST=.FALSE. 
704:       LOCALPERMNEIGH=4 
705:       LOCALPERMCUT=0.2D0 
706:       LOCALPERMMAXSEP=3 
707:       LOCALPERMCUT2=10.0D0 
708:       LPERMDIST=.FALSE. 
709:       LPDGEOMDIFFTOL=0.3D0 
710:       PERMOPT=.FALSE.699:       PERMOPT=.FALSE.
711:       DISTOPT=.FALSE.700:       DISTOPT=.FALSE.
712:       PERMINVOPT=.FALSE.701:       PERMINVOPT=.FALSE.
713: 702: 
714:       GAMMA=1.0D0703:       GAMMA=1.0D0
715:       TUNNELT=.FALSE.704:       TUNNELT=.FALSE.
716:       705:       
717:       TWOD=.FALSE.706:       TWOD=.FALSE.
718:       COMPRESST=.FALSE.707:       COMPRESST=.FALSE.
719: 708: 
1082:       CUDAPOT=' '1071:       CUDAPOT=' '
1083:       CUDATIMET=.FALSE.1072:       CUDATIMET=.FALSE.
1084:       GCBHT=.FALSE.1073:       GCBHT=.FALSE.
1085:       SEMIGRAND_MUT=.FALSE.1074:       SEMIGRAND_MUT=.FALSE.
1086:       USEROT=.FALSE.1075:       USEROT=.FALSE.
1087:       GCMU=0.0D01076:       GCMU=0.0D0
1088:       GCNATOMS=11077:       GCNATOMS=1
1089:       GCINT=1001078:       GCINT=100
1090:       GCRELAX=10*GCINT1079:       GCRELAX=10*GCINT
1091:       GCPLUS=0.5D01080:       GCPLUS=0.5D0
1092:  
1093: ! 
1094: ! Neural network potential 
1095: ! 
1096:       MLP3T=.FALSE. 
1097:       MLPLAMBDA=0.0D0 
1098:       1081:       
1099:       CALL FILE_OPEN('data', DATA_UNIT, .FALSE.)1082:       CALL FILE_OPEN('data', DATA_UNIT, .FALSE.)
1100:       1083:       
1101: !      OPEN (5,FILE='data',STATUS='OLD')1084: !      OPEN (5,FILE='data',STATUS='OLD')
1102: 1085: 
1103: !190   CALL INPUT(END,5)1086: !190   CALL INPUT(END,5)
1104: 190   CALL INPUT(END, DATA_UNIT)1087: 190   CALL INPUT(END, DATA_UNIT)
1105:       IF (.NOT. END) THEN1088:       IF (.NOT. END) THEN
1106:         CALL READU(WORD)1089:         CALL READU(WORD)
1107:       ENDIF1090:       ENDIF
1944:         CALL AMBER12_GET_COORDS(NATOMS, COORDS(:,1))1927:         CALL AMBER12_GET_COORDS(NATOMS, COORDS(:,1))
1945:       ELSE IF (WORD.EQ.'AMBER9') THEN1928:       ELSE IF (WORD.EQ.'AMBER9') THEN
1946:         AMBERT=.TRUE.1929:         AMBERT=.TRUE.
1947:         WRITE(MYUNIT,'(A)') 'keyword> RADIUS set to 999 for AMBER9 run'1930:         WRITE(MYUNIT,'(A)') 'keyword> RADIUS set to 999 for AMBER9 run'
1948:         RADIUS=9991931:         RADIUS=999
1949:         1932:         
1950: !1933: !
1951: ! csw34> if residues are frozen with FREEZERES, call the amber routine1934: ! csw34> if residues are frozen with FREEZERES, call the amber routine
1952: ! to fill the FROZEN array correctly (in amberinterface.f) 1935: ! to fill the FROZEN array correctly (in amberinterface.f) 
1953: !1936: !
1954:         IF (PERMDIST.OR.LOCALPERMDIST.OR.LPERMDIST) THEN1937:         IF (PERMDIST) THEN
1955:           IF(NPERMSIZE(1).EQ.NATOMS) THEN1938:           IF(NPERMSIZE(1).EQ.NATOMS) THEN
1956:            PRINT '(A)','keyword> ERROR - PERMDIST is specified for AMBER, but there is no perm.allow file present'1939:            PRINT '(A)','keyword> ERROR - PERMDIST is specified for AMBER, but there is no perm.allow file present'
1957:            STOP1940:            STOP
1958:           ENDIF1941:           ENDIF
1959:         ENDIF1942:         ENDIF
1960: 1943: 
1961: ! sf344> file open unit used to conflict with AMBER's IO units (mdin opened with unit = 5),1944: ! sf344> file open unit used to conflict with AMBER's IO units (mdin opened with unit = 5),
1962: 1945: 
1963: !               call amberinterface(natom,1,trim(adjustl(inpcrd)),MYUNIT)1946: !               call amberinterface(natom,1,trim(adjustl(inpcrd)),MYUNIT)
1964: 1947: 
2026:         ELSE2009:         ELSE
2027:             CALL MMEINITWRAPPER(TRIM(ADJUSTL(PRMTOP))//C_NULL_CHAR, IGB, SALTCON, RGBMAX, CUT)2010:             CALL MMEINITWRAPPER(TRIM(ADJUSTL(PRMTOP))//C_NULL_CHAR, IGB, SALTCON, RGBMAX, CUT)
2028:         END IF2011:         END IF
2029: 2012: 
2030: !2013: !
2031: ! The maximum number of constraints to use in the constrained potential.2014: ! The maximum number of constraints to use in the constrained potential.
2032: ! The deafult is 4.2015: ! The deafult is 4.
2033: !2016: !
2034:       ELSE IF (WORD.EQ.'MAXCON') THEN2017:       ELSE IF (WORD.EQ.'MAXCON') THEN
2035:          CALL READI(MAXCONUSE)2018:          CALL READI(MAXCONUSE)
2036: !2019: 
2037: ! Three layer neural network (multilayer perceptron) with 
2038: ! MLPIN inputs (columns per data item) 
2039: ! MLPOUT outputs 
2040: ! MLPHIDDEN hidden nodes 
2041: ! MLPDATA data lines in MLPdata file (last column MLPIN+1 for correct outputs, numbered one to MLPOUT) 
2042: ! MLPLAMBDA coefficient for regularisation 
2043: ! 
2044:       ELSE IF (WORD.EQ.'MLP3') THEN 
2045:          MLP3T=.TRUE. 
2046:          CALL READI(MLPIN) 
2047:          CALL READI(MLPHIDDEN) 
2048:          CALL READI(MLPOUT) 
2049:          CALL READI(MLPDATA) 
2050:          IF (NITEMS.GT.5) CALL READF(MLPLAMBDA) 
2051:          WRITE(MYUNIT,'(A,4I8,G20.10)') 'MLP3 potential with Nin, Nhidden, Nout, Ndata, lambda=', 
2052:      &                                   MLPIN,MLPHIDDEN,MLPOUT,MLPDATA,MLPLAMBDA   
2053:          NMLP=MLPHIDDEN*(MLPIN+MLPOUT) 
2054:          IF (NMLP.NE.NATOMS) THEN 
2055:             PRINT '(A,2I8)', 'keywords> ERROR *** NATOMS,NMLP=',NATOMS,NMLP 
2056:             STOP 
2057:          ENDIF 
2058:          LUNIT=GETUNIT() 
2059:          OPEN(LUNIT,FILE='MLPdata',STATUS='OLD') 
2060:          ALLOCATE(MLPDAT(MLPDATA,MLPIN),MLPOUTCOME(MLPDATA)) 
2061:          DO J1=1,MLPDATA 
2062:             READ(LUNIT,*) MLPDAT(J1,1:MLPIN),MLPOUTCOME(J1) 
2063:             MLPOUTCOME(J1)=MLPOUTCOME(J1)+1 ! to shift the range to 1 to 4 
2064:             WRITE(MYUNIT,'(9G20.10,I8)') MLPDAT(J1,1:MLPIN),MLPOUTCOME(J1) 
2065:          ENDDO 
2066:       ELSE IF(WORD.EQ.'MODEL1') THEN2020:       ELSE IF(WORD.EQ.'MODEL1') THEN
2067:          MODEL1T=.TRUE.2021:          MODEL1T=.TRUE.
2068:          CALL READF(ME1)2022:          CALL READF(ME1)
2069:          CALL READF(ME2)2023:          CALL READF(ME2)
2070:          CALL READF(ME3)2024:          CALL READF(ME3)
2071:          CALL READF(MSTART)2025:          CALL READF(MSTART)
2072:          CALL READF(MFINISH)2026:          CALL READF(MFINISH)
2073:          CALL READF(MBSTART1)2027:          CALL READF(MBSTART1)
2074:          CALL READF(MBFINISH1)2028:          CALL READF(MBFINISH1)
2075:          CALL READF(MBSTART2)2029:          CALL READF(MBSTART2)
2341: ! Start of CHARMM-related keywords, including options for MC moves and order parameter specifications.2295: ! Start of CHARMM-related keywords, including options for MC moves and order parameter specifications.
2342: !2296: !
2343:       ELSE IF (WORD.EQ.'CHARMM') THEN2297:       ELSE IF (WORD.EQ.'CHARMM') THEN
2344:          CHRMMT=.TRUE.2298:          CHRMMT=.TRUE.
2345:          IF (MXATMS.EQ.0) THEN2299:          IF (MXATMS.EQ.0) THEN
2346:             WRITE(MYUNIT,'(A)') 'keyword> ERROR *** MXATMS is zero'2300:             WRITE(MYUNIT,'(A)') 'keyword> ERROR *** MXATMS is zero'
2347:             STOP2301:             STOP
2348:          ENDIF2302:          ENDIF
2349:          CALL FLUSH(MYUNIT)2303:          CALL FLUSH(MYUNIT)
2350: 2304: 
2351:          IF (PERMDIST.OR.LOCALPERMDIST.OR.LPERMDIST) THEN2305:          IF (PERMDIST) THEN
2352:             IF(NPERMSIZE(1).EQ.NATOMS) THEN2306:             IF(NPERMSIZE(1).EQ.NATOMS) THEN
2353:             WRITE(MYUNIT,'(A)') 'keyword> ERROR - PERMDIST is specfied for CHARMM, but there is no perm.allow file present'2307:             WRITE(MYUNIT,'(A)') 'keyword> ERROR - PERMDIST is specfied for CHARMM, but there is no perm.allow file present'
2354:             STOP2308:             STOP
2355:             ENDIF2309:             ENDIF
2356:          ENDIF2310:          ENDIF
2357: 2311: 
2358:          ALLOCATE(CHX(MXATMS),CHY(MXATMS),CHZ(MXATMS),CHMASS(MXATMS))2312:          ALLOCATE(CHX(MXATMS),CHY(MXATMS),CHZ(MXATMS),CHMASS(MXATMS))
2359: 2313: 
2360:          CHX(1)=13.13d13 ! this way we will tell CHARMM to save it's coords into CH. arrays; otherwise it will2314:          CHX(1)=13.13d13 ! this way we will tell CHARMM to save it's coords into CH. arrays; otherwise it will
2361:                          ! use input.crd only which is the default now2315:                          ! use input.crd only which is the default now
2544:          IF (TRIM(ADJUSTL(UNSTRING)).EQ.'BOX') BOXT=.TRUE.2498:          IF (TRIM(ADJUSTL(UNSTRING)).EQ.'BOX') BOXT=.TRUE.
2545:          IF (TRIM(ADJUSTL(UNSTRING)).EQ.'SPHERE') SPHERET=.TRUE.2499:          IF (TRIM(ADJUSTL(UNSTRING)).EQ.'SPHERE') SPHERET=.TRUE.
2546:          IF (BOXT.AND.NITEMS.GT.5) CALL READF(BOXSIZE)2500:          IF (BOXT.AND.NITEMS.GT.5) CALL READF(BOXSIZE)
2547:          IF (SPHERET.AND.NITEMS.GT.5) CALL READF(SPHERERAD)2501:          IF (SPHERET.AND.NITEMS.GT.5) CALL READF(SPHERERAD)
2548: 2502: 
2549:       ELSE IF (WORD.EQ.'CHRIGIDROT') THEN2503:       ELSE IF (WORD.EQ.'CHRIGIDROT') THEN
2550:          CHRIGIDROTT=.TRUE.2504:          CHRIGIDROTT=.TRUE.
2551:          CALL READF(PROT)2505:          CALL READF(PROT)
2552:          CALL READF(ROTMAX)2506:          CALL READF(ROTMAX)
2553:          CALL READI(FROT)2507:          CALL READI(FROT)
2554: !2508: 
2555: ! Radial shift to make space for new atoms. 
2556: ! 
2557:          ELSE IF (WORD.EQ.'QCIRADSHIFT') THEN 
2558:             QCIRADSHIFTT=.TRUE. 
2559:             IF (NITEMS.GT.1) CALL READF(QCIRADSHIFT) 
2560:             WRITE(MYUNIT,'(A,G20.10)') ' keyword> Shifting unconstrained atoms away from added atoms by ',QCIRADSHIFT 
2561: !2509: !
2562: ! Check for internal minimum in constraint terms for INTCONSTRAINT2510: ! Check for internal minimum in constraint terms for INTCONSTRAINT
2563: !2511: !
2564:          ELSE IF ((WORD.EQ.'CONINT').OR.(WORD.EQ.'QCIINT')) THEN2512:          ELSE IF ((WORD.EQ.'CONINT').OR.(WORD.EQ.'QCIINT')) THEN
2565:             CHECKCONINT=.TRUE.2513:             CHECKCONINT=.TRUE.
2566:             IF (NITEMS.GT.1) CALL READF(INTMINFAC)2514:             IF (NITEMS.GT.1) CALL READF(INTMINFAC)
2567:             WRITE(MYUNIT,'(A,G20.10)') ' keyword> Internal minima terms will be scaled by a factor of ',INTMINFAC 2515:             WRITE(MYUNIT,'(A,G20.10)') ' keyword> Internal minima terms will be scaled by a factor of ',INTMINFAC 
2568: !2516: !
2569: ! Absolute distance to allow before turning on constraint potential.2517: ! Absolute distance to allow before turning on constraint potential.
2570: !2518: !
2601:          OEINTT=.TRUE.2549:          OEINTT=.TRUE.
2602:          CALL READI(MON1(1))2550:          CALL READI(MON1(1))
2603:          CALL READI(MON1(2))2551:          CALL READI(MON1(2))
2604:          CALL READI(MON2(1))2552:          CALL READI(MON2(1))
2605:          CALL READI(MON2(2))2553:          CALL READI(MON2(2))
2606:          WRITE(MYUNIT,'(A)') 'OEINTT set: interaction energy between 2 peptides will be used as an order parameter'2554:          WRITE(MYUNIT,'(A)') 'OEINTT set: interaction energy between 2 peptides will be used as an order parameter'
2607: 2555: 
2608:       ELSE IF (WORD.EQ.'ORGYR') THEN2556:       ELSE IF (WORD.EQ.'ORGYR') THEN
2609:          ORGYT=.TRUE.2557:          ORGYT=.TRUE.
2610:          WRITE(MYUNIT,'(A)') 'ORGYT set: radius of gyration will be calculated as an order parameter'2558:          WRITE(MYUNIT,'(A)') 'ORGYT set: radius of gyration will be calculated as an order parameter'
2611: ! 
2612: ! Distance cutoff for distinguishing atoms in the same orbit for LPERMDIST and LOCALPERMDIST 
2613: ! 
2614:          ELSE IF (WORD.EQ.'ORBITGEOMTOL') THEN 
2615:             CALL READF(LPDGEOMDIFFTOL) 
2616: 2559: 
2617: !     ELSE IF (WORD.EQ.'NORANDOM') THEN2560: !     ELSE IF (WORD.EQ.'NORANDOM') THEN
2618: !        NORANDOM=.TRUE.2561: !        NORANDOM=.TRUE.
2619: !        IF (NITEMS.GT.1) CALL READF(RANDOMCUTOFF)2562: !        IF (NITEMS.GT.1) CALL READF(RANDOMCUTOFF)
2620: 2563: 
2621: !     ELSE IF (WORD.EQ.'PERMDIHE') THEN2564: !     ELSE IF (WORD.EQ.'PERMDIHE') THEN
2622: !        PERMDIHET=.TRUE.2565: !        PERMDIHET=.TRUE.
2623: !        DO J1=1,NITEMS-12566: !        DO J1=1,NITEMS-1
2624: !           CALL READI(NDUM)2567: !           CALL READI(NDUM)
2625: !           PERMDIHE(J1)=NDUM2568: !           PERMDIHE(J1)=NDUM
3973:          CALL READF(XX)3916:          CALL READF(XX)
3974:          FIH=XX3917:          FIH=XX
3975:          IF (NITEMS.GT.2) THEN3918:          IF (NITEMS.GT.2) THEN
3976:             CALL READF(XX)3919:             CALL READF(XX)
3977:             EXPFAC=XX3920:             EXPFAC=XX
3978:          ENDIF3921:          ENDIF
3979:          IF (NITEMS.GT.3) THEN3922:          IF (NITEMS.GT.3) THEN
3980:             CALL READF(XX)3923:             CALL READF(XX)
3981:             EXPD=XX3924:             EXPD=XX
3982:          ENDIF3925:          ENDIF
3983: !  
3984: ! Maximum active atoms in QCI procedure. 
3985: !         
3986:       ELSE IF (WORD.EQ.'QCIMAXACTIVE') THEN 
3987:          CALL READI(MAXNACTIVE) 
3988: 3926: 
3989:       ELSE IF (WORD.EQ.'INTMIN') THEN3927:       ELSE IF (WORD.EQ.'INTMIN') THEN
3990:          INTMINT=.TRUE.3928:          INTMINT=.TRUE.
3991:       ELSE IF (WORD.EQ.'QCIPERMCHECK') THEN 
3992:          QCIPERMCHECK=.TRUE. 
3993:          CALL READI(QCIPERMCHECKINT) 
3994: !3929: !
3995: ! Images for INTCONSTRAINT3930: ! Images for INTCONSTRAINT
3996: !3931: !
3997:          ELSE IF ((WORD.EQ.'INTIMAGE').OR.(WORD.EQ.'QCIIMAGE')) THEN3932:          ELSE IF ((WORD.EQ.'INTIMAGE').OR.(WORD.EQ.'QCIIMAGE')) THEN
3998:             IF (NITEMS.GT.1) CALL READF(IMSEPMIN)3933:             IF (NITEMS.GT.1) CALL READF(IMSEPMIN)
3999:             IF (NITEMS.GT.2) CALL READF(IMSEPMAX)3934:             IF (NITEMS.GT.2) CALL READF(IMSEPMAX)
4000:             IF (NITEMS.GT.3) CALL READI(INTIMAGE)3935:             IF (NITEMS.GT.3) CALL READI(INTIMAGE)
4001:             IF (NITEMS.GT.4) CALL READI(MAXINTIMAGE)3936:             IF (NITEMS.GT.4) CALL READI(MAXINTIMAGE)
4002:             IF (NITEMS.GT.5) CALL READI(INTNTRIESMAX)3937:             IF (NITEMS.GT.5) CALL READI(INTNTRIESMAX)
4003:             IF (NITEMS.GT.6) CALL READI(INTIMAGEINCR)3938:             IF (NITEMS.GT.6) CALL READI(INTIMAGEINCR)
4004:             IF (NITEMS.GT.7) CALL READI(INTIMAGECHECK)3939:             IF (NITEMS.GT.7) CALL READI(INTIMAGECHECK)
4005: !3940: !
4006: ! Maximum distance for constrained atoms 
4007: ! 
4008:          ELSE IF ((WORD.EQ.'INTCONCUT').OR.(WORD.EQ.'QCICONCUT')) THEN 
4009:             CALL READF(INTCONCUT) 
4010: ! 
4011: ! Use constraint potential for initial interpolation in each cycle.3941: ! Use constraint potential for initial interpolation in each cycle.
4012: !3942: !
4013:          ELSE IF ((WORD.EQ.'INTCONSTRAINT').OR.(WORD.EQ.'QCI')) THEN3943:          ELSE IF ((WORD.EQ.'INTCONSTRAINT').OR.(WORD.EQ.'QCI')) THEN
4014:             INTCONSTRAINTT=.TRUE.3944:             INTCONSTRAINTT=.TRUE.
4015:             IF (NITEMS.GT.1) CALL READF(INTCONSTRAINTTOL)3945:             IF (NITEMS.GT.1) CALL READF(INTCONSTRAINTTOL)
4016:             IF (NITEMS.GT.2) CALL READF(INTCONSTRAINTDEL)3946:             IF (NITEMS.GT.2) CALL READF(INTCONSTRAINTDEL)
4017:             IF (NITEMS.GT.3) CALL READF(INTCONSTRAINTREP)3947:             IF (NITEMS.GT.3) CALL READF(INTCONSTRAINTREP)
4018:             IF (NITEMS.GT.4) CALL READF(INTCONSTRAINREPCUT)3948:             IF (NITEMS.GT.4) CALL READF(INTCONSTRAINREPCUT)
4019:             IF (NITEMS.GT.5) CALL READF(INTCONFRAC)3949:             IF (NITEMS.GT.5) CALL READF(INTCONFRAC)
4020:             IF (NITEMS.GT.6) CALL READI(INTCONSEP)3950:             IF (NITEMS.GT.6) CALL READI(INTCONSEP)
4068:                CLOSE(LUNIT)3998:                CLOSE(LUNIT)
4069:                WRITE(MYUNIT,'(A)') ' keyword> Constraint potential parameters read from file congeom.dat'3999:                WRITE(MYUNIT,'(A)') ' keyword> Constraint potential parameters read from file congeom.dat'
4070:                INTCONMAX=NCONSTRAINTFIX4000:                INTCONMAX=NCONSTRAINTFIX
4071:                NREPMAX=NREPULSIVEFIX4001:                NREPMAX=NREPULSIVEFIX
4072:                ALLOCATE(CONI(INTCONMAX),CONJ(INTCONMAX),CONDISTREF(INTCONMAX),CONCUT(INTCONMAX))4002:                ALLOCATE(CONI(INTCONMAX),CONJ(INTCONMAX),CONDISTREF(INTCONMAX),CONCUT(INTCONMAX))
4073:                ALLOCATE(REPI(NREPMAX),REPJ(NREPMAX),NREPI(NREPMAX),NREPJ(NREPMAX),REPCUT(NREPMAX),NREPCUT(NREPMAX))4003:                ALLOCATE(REPI(NREPMAX),REPJ(NREPMAX),NREPI(NREPMAX),NREPJ(NREPMAX),REPCUT(NREPMAX),NREPCUT(NREPMAX))
4074:                ALLOCATE(CONACTIVE(NCONSTRAINTFIX))4004:                ALLOCATE(CONACTIVE(NCONSTRAINTFIX))
4075:             ELSE4005:             ELSE
4076:                INQUIRE(FILE='congeom',EXIST=CONFILE)4006:                INQUIRE(FILE='congeom',EXIST=CONFILE)
4077:                NCONGEOM=04007:                NCONGEOM=0
 4008:                NCONGEOM=0
4078:                IF (.NOT.CONFILE) THEN4009:                IF (.NOT.CONFILE) THEN
4079:                   WRITE(MYUNIT,'(A)') ' keyword> WARNING *** no congeom file found. Will use end point minima only.'4010:                   WRITE(MYUNIT,'(A)') ' keyword> WARNING *** no congeom file found. Will use end point minima only.'
4080:                ELSE4011:                ELSE
4081:                   LUNIT=GETUNIT()4012:                   LUNIT=GETUNIT()
4082:                   OPEN(LUNIT,FILE='congeom',STATUS='OLD')4013:                   OPEN(LUNIT,FILE='congeom',STATUS='OLD')
4083:                   DO4014:                   DO
4084:                      READ(LUNIT,*,END=864) DUMMY1(1)4015:                      READ(LUNIT,*,END=864) DUMMY1(1)
4085:                      NCONGEOM=NCONGEOM+14016:                      NCONGEOM=NCONGEOM+1
4086:                   ENDDO4017:                   ENDDO
4087: 864               CONTINUE4018: 864               CONTINUE
4781: !4712: !
4782: ! If permdist is set then distance calculations are performed with minpermdist instead4713: ! If permdist is set then distance calculations are performed with minpermdist instead
4783: ! of newmindist in procedures such as AVOID and CSM. This keyword is now independent4714: ! of newmindist in procedures such as AVOID and CSM. This keyword is now independent
4784: ! from PERMOPT4715: ! from PERMOPT
4785: !4716: !
4786:       ELSE IF (WORD.EQ.'PERMDIST'.AND.PERMOPT) THEN4717:       ELSE IF (WORD.EQ.'PERMDIST'.AND.PERMOPT) THEN
4787:          WRITE(MYUNIT,'(A)') 'keywords> PERMDIST has already been set by PERMOPT keyword'4718:          WRITE(MYUNIT,'(A)') 'keywords> PERMDIST has already been set by PERMOPT keyword'
4788:          IF (NITEMS.GT.1) CALL READF(ORBITTOL)4719:          IF (NITEMS.GT.1) CALL READF(ORBITTOL)
4789:          WRITE(MYUNIT,'(A,F15.5)') ' keyword> Distance tolerance for distinguising atoms in the same orbit=',ORBITTOL4720:          WRITE(MYUNIT,'(A,F15.5)') ' keyword> Distance tolerance for distinguising atoms in the same orbit=',ORBITTOL
4790: 4721: 
4791:       ELSE IF (((WORD.EQ.'PERMDIST').OR.(WORD.EQ.'LOCALPERMDIST').OR.(WORD.EQ.'LPERMDIST')).AND.(.NOT.PERMOPT)) THEN4722:       ELSE IF (WORD.EQ.'PERMDIST'.AND.(.NOT.PERMOPT)) THEN
4792:          PERMDIST=.TRUE.4723:          PERMDIST=.TRUE.
4793:          IF (WORD.EQ.'LPERMDIST') THEN4724:          IF (NITEMS.GT.1) CALL READF(ORBITTOL)
4794:             LPERMDIST=.TRUE.4725:          WRITE(MYUNIT,'(A,F15.5)') ' keyword> Distance tolerance for distinguising atoms in the same orbit=',ORBITTOL
4795:             IF (NITEMS.GT.1) CALL READI(LOCALPERMNEIGH) 
4796:             IF (NITEMS.GT.2) CALL READF(LOCALPERMCUT) 
4797:             IF (NITEMS.GT.3) CALL READF(LOCALPERMCUT2) 
4798:             ! IF (NITEMS.GT.3) CALL READI(LOCALPERMMAXSEP) 
4799:             WRITE(MYUNIT,'(A,F15.5)') ' keyword> Local permutational alignment: alignment threshold=',LOCALPERMCUT 
4800:             WRITE(MYUNIT,'(A,F15.5)') ' keyword> Local permutational alignment: alignment cutoff=   ',LOCALPERMCUT2 
4801:          ELSEIF (WORD.EQ.'PERMDIST') THEN 
4802:             IF (NITEMS.GT.1) CALL READF(ORBITTOL) 
4803:             PRINT '(A,F15.5)',' keyword> Distance tolerance for distinguising atoms in the same orbit=',ORBITTOL 
4804:          ENDIF 
4805:  
4806:          INQUIRE(FILE='perm.allow',EXIST=PERMFILE)4726:          INQUIRE(FILE='perm.allow',EXIST=PERMFILE)
4807:          IF (.NOT.ALLOCATED(NPERMSIZE)) THEN4727:          IF (.NOT.ALLOCATED(NPERMSIZE)) THEN
4808:             ALLOCATE(NPERMSIZE(NATOMSALLOC),PERMGROUP(NATOMSALLOC),NSETS(NATOMSALLOC),SETS(NATOMSALLOC,70))4728:             ALLOCATE(NPERMSIZE(NATOMSALLOC),PERMGROUP(NATOMSALLOC),NSETS(NATOMSALLOC),SETS(NATOMSALLOC,70))
4809:          ENDIF4729:          ENDIF
4810:          IF (PERMFILE) THEN4730:          IF (PERMFILE) THEN
4811:             OPEN(UNIT=1,FILE='perm.allow',STATUS='OLD')4731:             OPEN(UNIT=1,FILE='perm.allow',STATUS='OLD')
4812:             READ(1,*) NPERMGROUP4732:             READ(1,*) NPERMGROUP
4813:             NDUMMY=14733:             NDUMMY=1
4814:             DO J1=1,NPERMGROUP4734:             DO J1=1,NPERMGROUP
4815:                READ(1,*) NPERMSIZE(J1),NSETS(J1)4735:                READ(1,*) NPERMSIZE(J1),NSETS(J1)
5878: 5798: 
5879:              SITE(3,1) = 0.D05799:              SITE(3,1) = 0.D0
5880:              SITE(3,2) = -SIN(0.5D0*WTHETA)*ROH5800:              SITE(3,2) = -SIN(0.5D0*WTHETA)*ROH
5881:              SITE(3,3) = COS(0.5D0*WTHETA)*ROH5801:              SITE(3,3) = COS(0.5D0*WTHETA)*ROH
5882: 5802: 
5883:              SITE(4,1) = 0.D05803:              SITE(4,1) = 0.D0
5884:              SITE(4,2) = 0.D05804:              SITE(4,2) = 0.D0
5885:              SITE(4,3) = ROM5805:              SITE(4,3) = ROM
5886: 5806: 
5887:          ENDIF5807:          ENDIF
5888:          IF (PERMDIST.OR. LOCALPERMDIST .OR. LPERMDIST) THEN ! correct all permutations allowed if perm.allow is not given explicitly5808:          IF (PERMDIST) THEN ! correct all permutations allowed if perm.allow is not given explicitly
5889:             IF (NPERMSIZE(1).EQ.NATOMSALLOC) NPERMSIZE(1)=NATOMSALLOC/25809:             IF (NPERMSIZE(1).EQ.NATOMSALLOC) NPERMSIZE(1)=NATOMSALLOC/2
5890:          ENDIF5810:          ENDIF
5891: 5811: 
5892: 5812: 
5893: !|gd351>5813: !|gd351>
5894: 5814: 
5895:       ELSE IF (WORD .EQ. 'PATCHY') THEN5815:       ELSE IF (WORD .EQ. 'PATCHY') THEN
5896:  5816:  
5897:          PATCHY =.TRUE.5817:          PATCHY =.TRUE.
5898:          RIGID =.TRUE.5818:          RIGID =.TRUE.


r29792/lopermdist.f90 2016-03-16 18:33:29.835022518 +0000 r29791/lopermdist.f90 2016-03-16 18:33:32.699051970 +0000
  1: !     Copyright (C) 1999-2008 David J. Wales  1: svn: E195012: Unable to find repository location for 'svn+ssh://svn.ch.private.cam.ac.uk/groups/wales/trunk/GMIN/source/lopermdist.f90' in revision 29791
  2: !  This file is part of GMIN. 
  3: ! 
  4: !  GMIN is free software; you can redistribute it and/or modify 
  5: !  it under the terms of the GNU General Public License as published by 
  6: !  the Free Software Foundation; either version 2 of the License, or 
  7: !  (at your option) any later version. 
  8: ! 
  9: !  GMIN is distributed in the hope that it will be useful, 
 10: !  but WITHOUT ANY WARRANTY; without even the implied warranty of 
 11: !  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
 12: !  GNU General Public License for more details. 
 13: ! 
 14: !  You should have received a copy of the GNU General Public License 
 15: !  along with this program; if not, write to the Free Software 
 16: !  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA 
 17: ! 
 18: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
 19: ! 
 20: !  This routine uses local optimal alignment for each group of permutable atoms. 
 21: !  It is intended for use with CHARMM and AMBER. 
 22: !  Overall alignment is based on the transformation for the best preserved local group. 
 23: ! 
 24: !  COORDSA becomes the optimal alignment of the optimal permutation 
 25: !  isomer, WITH the permutations. DISTANCE is the residual square distance 
 26: !  for the best alignment with respect to permutation as well as 
 27: !  orientation and centre of mass. 
 28: ! 
 29: !  The centres of coordinates for COORDSA and COORDSB can be anywhere. On return, the 
 30: !  centre of coordinates of COORDSA will be the same as for COORDSB. 
 31: ! 
 32: SUBROUTINE LOPERMDIST(COORDSB,COORDSA,NATOMS,DEBUG,BOXLX,BOXLY,BOXLZ,BULKT,TWOD,DISTANCE,DIST2,RIGID,RMATBEST) 
 33:  
 34: USE COMMONS,ONLY : NPERMGROUP, NPERMSIZE, PERMGROUP, NSETS, SETS, GEOMDIFFTOL, & 
 35:   &            NFREEZE, RBAAT, BESTPERM, LOCALPERMDIST, NTSITES, & 
 36:   &            LOCALPERMCUT, STOCKT, GMAX, INTCONSTRAINTT, & 
 37:   &            LOCALPERMNEIGH, LOCALPERMCUT2, CHRMMT, MYUNIT 
 38: IMPLICIT NONE 
 39:  
 40: INTEGER, PARAMETER :: MAXIMUMTRIES=10 
 41: INTEGER NATOMS, NPERM, PATOMS, NRB, OPNUM,  NORBIT1, NORBIT2, NCHOOSE2, NCHOOSE1, NTRIES, NORBITB1, NORBITB2 
 42: INTEGER J3, J4, NDUMMY, LPERM(NATOMS), J1, J2, NOTHER, LPERMBEST(NATOMS), NCHOOSEB1, NCHOOSEB2, & 
 43:         LPERMBESTATOM(NATOMS) 
 44: DOUBLE PRECISION DIST2, COORDSA(3*NATOMS), COORDSB(3*NATOMS), DISTANCE, DUMMYA(3*NATOMS), & 
 45:   &              BESTA(3*NATOMS), DUMMYB(3*NATOMS), DUMMY(3*NATOMS), DIST, DSUM 
 46: DOUBLE PRECISION BOXLX,BOXLY,BOXLZ,WORSTRAD,RMAT(3,3),ENERGY, VNEW(3*NATOMS), DX, DY, DZ, RMS, DBEST, XBEST(3*NATOMS) 
 47: DOUBLE PRECISION CMXA, CMXB, CMXC, QBEST(4), SITESA(3*NTSITES), SITESB(3*NTSITES) 
 48: DOUBLE PRECISION ROTA(3,3), ROTINVA(3,3), ROTB(3,3), ROTINVB(3,3), RMATBEST(3,3), TMAT(3,3), LPC2, LPC22 
 49: DOUBLE PRECISION PVEC(3), RTEMP1(3,3), RTEMP2(3,3) 
 50: LOGICAL DEBUG, TWOD, RIGID, BULKT, PITEST, AOK, BOK, ADDED, PERMUTABLE(NATOMS) 
 51: DOUBLE PRECISION PDUMMYA(3*NATOMS), PDUMMYB(3*NATOMS), LDISTANCE, DUMMYC(3*NATOMS), XDUMMY, DUMMYD(3*NATOMS), & 
 52:    &             LDBEST(NPERMGROUP), LDBESTATOM 
 53: DOUBLE PRECISION SPDUMMYA(3*NATOMS), SPDUMMYB(3*NATOMS), AINIT, BINIT 
 54: INTEGER NEWPERM(NATOMS), ALLPERM(NATOMS), SAVEPERM(NATOMS) 
 55: DOUBLE PRECISION TIME0, TIME1 
 56: DOUBLE PRECISION, ALLOCATABLE :: TEMPA(:), TEMPB(:) 
 57: CHARACTER(LEN=5) ZSYMSAVE 
 58: COMMON /SYS/ ZSYMSAVE 
 59: DOUBLE PRECISION XA, XB, YA, YB, ZA, ZB, DMEAN(NATOMS), DA, DB 
 60: INTEGER TRIED(NATOMS), DLIST(NATOMS), SORTLIST(NATOMS), NDUMMY2, INGROUP(NATOMS), NADDED 
 61:  
 62: LPC2=LOCALPERMCUT**2 
 63: LPC22=LOCALPERMCUT2**2 
 64: DBEST=1.0D100 
 65: PERMUTABLE(1:NATOMS)=.FALSE. 
 66: NDUMMY=1 
 67: DO J1=1,NPERMGROUP 
 68:    DO J2=1,NPERMSIZE(J1) 
 69:       PERMUTABLE(PERMGROUP(NDUMMY+J2-1))=.TRUE. 
 70:       INGROUP(PERMGROUP(NDUMMY+J2-1))=J1 
 71:    ENDDO 
 72:    NDUMMY=NDUMMY+NPERMSIZE(J1) 
 73: ENDDO 
 74:  
 75: DUMMYB(1:3*NATOMS)=COORDSB(1:3*NATOMS) 
 76: DUMMYA(1:3*NATOMS)=COORDSA(1:3*NATOMS) 
 77: ! 
 78: !  Bipartite matching routine for permutations. Coordinates in DUMMYB do not change 
 79: !  but the coordinates in DUMMYA do. DISTANCE is the distance^2 in this case, 
 80: !  and is evaluated as a sum of local distances squared for permutable groups. 
 81: !  We return to label 10 after every round of permutational/orientational alignment 
 82: !  unless we have converged to the identity permutation. 
 83: ! 
 84: !  The maximum number of pair exchanges associated with a group is two. 
 85: !  
 86: DO J1=1,NATOMS 
 87:    NEWPERM(J1)=J1 
 88: ENDDO 
 89: DSUM=0.0D0 
 90:  
 91: NDUMMY=1 
 92: DO J1=1,NPERMGROUP 
 93:    PATOMS=NPERMSIZE(J1) 
 94:    LDBEST(J1)=1.0D100 
 95:    TRIED(1:NATOMS)=0 
 96:    DO J2=1,PATOMS 
 97:       LPERMBEST(J2)=J2 
 98:    ENDDO 
 99:    XA=0.0D0; YA=0.0D0; ZA=0.0D0 
100:    XB=0.0D0; YB=0.0D0; ZB=0.0D0 
101:    DMEAN(1:LOCALPERMNEIGH)=1.0D100 
102:    DO J2=1,PATOMS 
103:       TRIED(NEWPERM(PERMGROUP(NDUMMY+J2-1)))=-1 
104:       PDUMMYA(3*(J2-1)+1)=DUMMYA(3*(NEWPERM(PERMGROUP(NDUMMY+J2-1))-1)+1) 
105:       PDUMMYA(3*(J2-1)+2)=DUMMYA(3*(NEWPERM(PERMGROUP(NDUMMY+J2-1))-1)+2) 
106:       PDUMMYA(3*(J2-1)+3)=DUMMYA(3*(NEWPERM(PERMGROUP(NDUMMY+J2-1))-1)+3) 
107:       PDUMMYB(3*(J2-1)+1)=DUMMYB(3*(NEWPERM(PERMGROUP(NDUMMY+J2-1))-1)+1) 
108:       PDUMMYB(3*(J2-1)+2)=DUMMYB(3*(NEWPERM(PERMGROUP(NDUMMY+J2-1))-1)+2) 
109:       PDUMMYB(3*(J2-1)+3)=DUMMYB(3*(NEWPERM(PERMGROUP(NDUMMY+J2-1))-1)+3) 
110:       XA=XA+PDUMMYA(3*(J2-1)+1) 
111:       YA=YA+PDUMMYA(3*(J2-1)+2) 
112:       ZA=ZA+PDUMMYA(3*(J2-1)+3) 
113:       XB=XB+PDUMMYB(3*(J2-1)+1) 
114:       YB=YB+PDUMMYB(3*(J2-1)+2) 
115:       ZB=ZB+PDUMMYB(3*(J2-1)+3) 
116:    ENDDO 
117:    XA=XA/PATOMS; YA=YA/PATOMS; ZA=ZA/PATOMS 
118:    XB=XB/PATOMS; YB=YB/PATOMS; ZB=ZB/PATOMS 
119:    SPDUMMYA(1:3*PATOMS)=PDUMMYA(1:3*PATOMS) 
120:    SPDUMMYB(1:3*PATOMS)=PDUMMYB(1:3*PATOMS) 
121: ! 
122: ! TRIED(J2) is 0 if atom J2 is eligible to be a neighbour, but has not 
123: ! yet been tried. It is -1 if it is ineligible, or has been tried and 
124: ! broke the alignment. It is +1 if it has been tried and did not break 
125: ! the alignment. It is -1 for atoms already in the set of permutable 
126: ! atoms in question. We add neighbours one at a time in order of  
127: ! increasing distance from primary permutable set 
128: ! and test whether they break the alignment. 
129: ! 
130:    DMEAN(1:NATOMS)=1.0D10 
131: ! 
132: ! Make a sorted list of distance from the permuting atoms. 
133: ! DMEAN, SORTLIST, TRIED, PERMUTABLE, and DLIST entries refer to original 
134: ! atom labels. Use NEWPERM to find where they are in coordinate lists. 
135: ! 
136:    outer1: DO J2=1,NATOMS 
137: ! 
138: ! Don't allow members of the same permutational group  
139: ! to appear as reference neighbours. 
140: ! 
141:       IF (TRIED(J2).EQ.-1) THEN 
142:          XDUMMY=1.0D9 
143:       ELSE 
144:          DA=(XA-DUMMYA(3*(NEWPERM(J2)-1)+1))**2 & 
145:   &        +(YA-DUMMYA(3*(NEWPERM(J2)-1)+2))**2 & 
146:   &        +(ZA-DUMMYA(3*(NEWPERM(J2)-1)+3))**2 
147:          DB=(XB-DUMMYB(3*(NEWPERM(J2)-1)+1))**2 & 
148:   &        +(YB-DUMMYB(3*(NEWPERM(J2)-1)+2))**2 & 
149:   &        +(ZB-DUMMYB(3*(NEWPERM(J2)-1)+3))**2 
150:          XDUMMY=(SQRT(DA)+SQRT(DB))/2.0D0 
151:       ENDIF 
152:       loop1: DO J3=1,J2 
153:          IF (XDUMMY.LT.DMEAN(J3)) THEN 
154: ! 
155: ! Move the rest down. 
156: ! 
157:             DO J4=J2,J3+1,-1 
158:                DMEAN(J4)=DMEAN(J4-1) 
159:                SORTLIST(J4)=SORTLIST(J4-1) 
160:             ENDDO 
161:             DMEAN(J3)=XDUMMY 
162:             SORTLIST(J3)=J2 
163:             EXIT loop1 
164:          ENDIF 
165:       ENDDO loop1 
166:    ENDDO outer1 
167: !  IF (J1.EQ.16) THEN 
168: !     WRITE(MYUNIT,'(A)') 'SORTLIST:' 
169: !     WRITE(MYUNIT,'(20I5)') SORTLIST(1:NATOMS) 
170: !     WRITE(MYUNIT,'(A)') 'DMEAN:' 
171: !     WRITE(MYUNIT,'(10G10.4)') DMEAN(1:NATOMS) 
172: !  ENDIF 
173:  
174: 71 CONTINUE 
175:    PDUMMYA(1:3*PATOMS)=SPDUMMYA(1:3*PATOMS) 
176:    PDUMMYB(1:3*PATOMS)=SPDUMMYB(1:3*PATOMS) 
177:  
178:    LDBESTATOM=1.0D100 
179:    NOTHER=0 
180:    DO J2=1,NATOMS 
181:       IF (TRIED(J2).EQ.1) THEN 
182:          NOTHER=NOTHER+1 
183:          DLIST(NOTHER)=J2 
184:       ENDIF 
185:    ENDDO 
186:    ADDED=.FALSE. 
187:    outer2: DO J2=1,NATOMS 
188:       IF (DMEAN(J2).GT.LPC22) THEN 
189: !        WRITE(MYUNIT,'(A)') ' lopermdist> No more atoms within cutoff' 
190:          GOTO 91 
191:       ENDIF 
192:       IF (TRIED(SORTLIST(J2)).EQ.0) THEN 
193:          ADDED=.TRUE. 
194:          NOTHER=NOTHER+1 
195:          IF (NOTHER+PATOMS.GT.NATOMS) THEN 
196:             WRITE(MYUNIT, '(A,I6)') & 
197:   & ' lopermdist> ERROR *** number of neighbours plus number of permutable atoms exceeds total for group ',J1 
198:             STOP 
199:          ENDIF 
200:          DLIST(NOTHER)=SORTLIST(J2) 
201:          EXIT outer2 
202:       ENDIF 
203:    ENDDO outer2 
204:  
205:    NADDED=1 
206:    IF (PERMUTABLE(DLIST(NOTHER))) THEN 
207: !     IF (DEBUG) WRITE(MYUNIT,'(2(A,I6))') ' lopermdist> Atom ',DLIST(NOTHER),' belongs to permutable set ', & 
208: !  &                                INGROUP(DLIST(NOTHER)) 
209:       NDUMMY2=1 
210:       DO J2=1,INGROUP(DLIST(NOTHER))-1 
211:          NDUMMY2=NDUMMY2+NPERMSIZE(J2) 
212:       ENDDO 
213:       DO J2=1,NPERMSIZE(INGROUP(DLIST(NOTHER))) 
214:          IF (PERMGROUP(NDUMMY2+J2-1).EQ.DLIST(NOTHER-NADDED+1)) CYCLE 
215:          IF (TRIED(PERMGROUP(NDUMMY2+J2-1)).EQ.0) THEN 
216:             NOTHER=NOTHER+1 
217:             NADDED=NADDED+1 
218:             IF (NOTHER+PATOMS.GT.NATOMS) THEN 
219:                WRITE(MYUNIT,'(A,I6)') & 
220:      ' lopermdist> ERROR *** number of neighbours plus number of permutable atoms exceeds total for group ',J1 
221:                STOP 
222:             ENDIF 
223:             DLIST(NOTHER)=PERMGROUP(NDUMMY2+J2-1) 
224: !           IF (DEBUG) WRITE(MYUNIT,'(A,I6)') ' lopermdist> Adding partner atom ',DLIST(NOTHER) 
225:          ELSE 
226:             WRITE(MYUNIT,'(A,I6,A)') ' lopermdist> ERROR *** Partner atom ',DLIST(NOTHER),' has already been tried' 
227:             STOP 
228:          ENDIF 
229:       ENDDO 
230:    ENDIF 
231:     
232:    DO J2=1,NOTHER 
233:       PDUMMYA(3*(PATOMS+J2-1)+1)=DUMMYA(3*(NEWPERM(DLIST(J2))-1)+1) 
234:       PDUMMYA(3*(PATOMS+J2-1)+2)=DUMMYA(3*(NEWPERM(DLIST(J2))-1)+2) 
235:       PDUMMYA(3*(PATOMS+J2-1)+3)=DUMMYA(3*(NEWPERM(DLIST(J2))-1)+3) 
236:       PDUMMYB(3*(PATOMS+J2-1)+1)=DUMMYB(3*(NEWPERM(DLIST(J2))-1)+1) 
237:       PDUMMYB(3*(PATOMS+J2-1)+2)=DUMMYB(3*(NEWPERM(DLIST(J2))-1)+2) 
238:       PDUMMYB(3*(PATOMS+J2-1)+3)=DUMMYB(3*(NEWPERM(DLIST(J2))-1)+3) 
239:    ENDDO 
240: !  IF ((J1.EQ.16).OR.(J1.EQ.12)) THEN 
241: !  WRITE(MYUNIT,'(4(A,I6))') ' lopermdist> For group ',J1,' size ',PATOMS,' aligning with ',NOTHER,' other atoms' 
242: !  WRITE(MYUNIT,'(A)') ' DLIST:' 
243: !  WRITE(MYUNIT,'(20I6)') DLIST(1:NOTHER) 
244: !  ENDIF 
245: ! 
246: ! Save PDUMMYA and PDUMMYB for cycling over possible orbits in MYORIENT alignment. 
247: ! 
248:    SPDUMMYA(3*PATOMS+1:3*(PATOMS+NOTHER))=PDUMMYA(3*PATOMS+1:3*(PATOMS+NOTHER)) 
249:    SPDUMMYB(3*PATOMS+1:3*(PATOMS+NOTHER))=PDUMMYB(3*PATOMS+1:3*(PATOMS+NOTHER)) 
250:    NCHOOSEB1=0 
251: 66 NCHOOSEB1=NCHOOSEB1+1 
252:    NCHOOSEB2=0 
253: 31 NCHOOSEB2=NCHOOSEB2+1 
254:    NCHOOSE1=0 
255: 65 NCHOOSE1=NCHOOSE1+1 
256:    NCHOOSE2=0 
257: 30 NCHOOSE2=NCHOOSE2+1 
258: ! 
259: ! Reset the coordinates of the PATOMS+NOTHER atoms in PDUMMYA and PDUMMYB 
260: ! to the subset of atoms from COORDSA and COORDSB. 
261: ! 
262:    PDUMMYA(1:3*(PATOMS+NOTHER))=SPDUMMYA(1:3*(PATOMS+NOTHER)) 
263:    PDUMMYB(1:3*(PATOMS+NOTHER))=SPDUMMYB(1:3*(PATOMS+NOTHER)) 
264:  
265:    CALL MYORIENT(PDUMMYA,DUMMY,NORBIT1,NCHOOSE1,NORBIT2,NCHOOSE2,PATOMS+NOTHER,DEBUG,ROTA,ROTINVA,STOCKT) 
266:    PDUMMYA(1:3*(PATOMS+NOTHER))=DUMMY(1:3*(PATOMS+NOTHER)) 
267:    CALL MYORIENT(PDUMMYB,DUMMY,NORBITB1,NCHOOSEB1,NORBITB2,NCHOOSEB2,PATOMS+NOTHER,DEBUG,ROTB,ROTINVB,STOCKT) 
268:    PDUMMYB(1:3*(PATOMS+NOTHER))=DUMMY(1:3*(PATOMS+NOTHER)) 
269: ! 
270: ! Optimimise permutational isomer for the standard orientation for the 
271: ! current choice of atoms from the possible orbits. 
272: ! 
273: ! MINPERM does not change PDUMMYB and PDUMMYA. 
274: ! 
275: ! Note that LDISTANCE is actually the distance squared. LDBEST also has dimensions of 
276: ! length squared. 
277: ! 
278:    LDISTANCE=0.0D0 
279:    CALL MINPERM(PATOMS+NOTHER, PDUMMYB, PDUMMYA, BOXLX, BOXLY, BOXLZ, BULKT, LPERM, LDISTANCE, DIST2, WORSTRAD)  
280: !  WRITE(MYUNIT,'(A,I6,3G20.10)') 'J1,LDBEST(J1),LDISTANCE=',J1,LDBEST(J1),LDISTANCE 
281:  
282:    LDISTANCE=LDISTANCE 
283:    DO J2=1,PATOMS 
284:       IF (LPERM(J2).GT.PATOMS) THEN 
285:          LDISTANCE=1.0D300 
286: !        IF (DEBUG) WRITE(MYUINT,'(A,I6,A,I6,A)') ' lopermdist> For group ',J1,' with ',NOTHER,' neighbours - neighbours mix in'  
287:          EXIT 
288:       ENDIF 
289:    ENDDO 
290:  
291: !  IF (J1.EQ.16) THEN 
292: !  PRINT '(I6)',PATOMS+NOTHER 
293: !  PRINT '(A,8I6,G20.10)',' PDUMMYB for NO1,NO2,NC1,NC2,NOB1,NOB2,NCB1,NCB2,distance ', & 
294: ! &                                     NORBIT1,NORBIT2,NCHOOSE1,NCHOOSE2,NORBITB1,NORBITB2,NCHOOSEB1,NCHOOSEB2,SQRT(LDISTANCE) 
295: !  PRINT '(A,3G20.10)',('LA ',PDUMMYB(3*(J2-1)+1:3*(J2-1)+3),J2=1,PATOMS+NOTHER) 
296: !  PRINT '(I6)',PATOMS+NOTHER 
297: !  PRINT '(A,8I6,G20.10)',' PDUMMYA for NO1,NO2,NC1,NC2,NOB1,NOB2,NCB1,NCB2,distance ', & 
298: ! &                                     NORBIT1,NORBIT2,NCHOOSE1,NCHOOSE2,NORBITB1,NORBITB2,NCHOOSEB1,NCHOOSEB2,SQRT(LDISTANCE) 
299: !  PRINT '(A,3G20.10)',('LA ',PDUMMYA(3*(J2-1)+1:3*(J2-1)+3),J2=1,PATOMS+NOTHER) 
300: !  ENDIF 
301:  
302:    DO J2=1,NOTHER 
303:       IF (LPERM(PATOMS+J2).NE.PATOMS+J2) THEN 
304: !        IF (DEBUG) PRINT '(A,I6,A)',' lopermdist> Atom ',DLIST(J2),' also needs to permute' 
305:          IF (PERMUTABLE(DLIST(J2))) THEN 
306: !           IF (DEBUG) PRINT '(2(A,I6))',' lopermdist> Atom ',DLIST(J2),' belongs to permutable set ', & 
307: !  &                                INGROUP(DLIST(J2)) 
308:          ELSE 
309: !           IF (DEBUG) PRINT '(2(A,I6))',' lopermdist> Atom ',DLIST(J2),' is NOT permutable!' 
310:             LDISTANCE=1.0D300 
311:          ENDIF 
312:       ENDIF 
313:    ENDDO 
314: ! 
315: ! Save the best permutation and local distance for this subset of atoms. 
316: ! NEWPERM and coordinates are only reset after all the cycles over orbits and NEWMINDIST. 
317: ! Hence we need to track a cumulative permutation and save the best current values. 
318: ! 
319:    IF (LDISTANCE.LT.LDBESTATOM) THEN 
320:       LDBESTATOM=LDISTANCE 
321:       LPERMBESTATOM(1:PATOMS)=LPERM(1:PATOMS) 
322:    ENDIF 
323: !  PRINT '(A,2G20.10)','LDISTANCE,LDBESTATOM=',LDISTANCE,LDBESTATOM 
324:  
325: !  PRINT '(A,4I6,2G20.10)','NORBIT1,NORBIT2,NCHOOSE1,NCHOOSE2,LDISTANCE,LDBEST=', & 
326: ! &                         NORBIT1,NORBIT2,NCHOOSE1,NCHOOSE2,LDISTANCE,LDBEST(J1) 
327:  
328:    IF (NCHOOSE2.LT.NORBIT2) GOTO 30 
329:    IF (NCHOOSE1.LT.NORBIT1) GOTO 65 
330:    IF (NCHOOSEB2.LT.NORBITB2) GOTO 31 
331:    IF (NCHOOSEB1.LT.NORBITB1) GOTO 66 
332:  
333: !  PRINT '(A,2G20.10)','LDBESTATOM,LOCALPERMCUT=',LDBESTATOM,LOCALPERMCUT 
334:    IF (SQRT(LDBESTATOM).GT.LOCALPERMCUT) THEN 
335: !     IF (DEBUG) THEN 
336: !        PRINT '(A,G15.5,A,I6)',' lopermdist> Best distance ',SQRT(LDBESTATOM), & 
337: ! &                                     ' is too large for atom ',DLIST(NOTHER) 
338: !     ENDIF 
339:       TRIED(DLIST(NOTHER))=-1 
340:       IF (NADDED.GT.1) THEN 
341: !        IF (DEBUG) THEN 
342: !           PRINT '(A)',' lopermdist> and partner atoms:' 
343: !           PRINT '(20I5)',DLIST(NOTHER-NADDED+1:NOTHER-1) 
344: !        ENDIF 
345:          TRIED(DLIST(NOTHER-NADDED+1:NOTHER-1))=-1 
346:       ENDIF 
347:       GOTO 71 
348:    ELSE 
349: !     IF (DEBUG) PRINT '(A,F12.2,3(A,I6))',' lopermdist> Best distance ',SQRT(LDBESTATOM), & 
350: ! &                    ' is OK for myorient with atom ',DLIST(NOTHER),' and ',NOTHER,' neighbours'  
351:       TRIED(DLIST(NOTHER))=1 
352:       IF (NADDED.GT.1) THEN 
353: !        IF (DEBUG) THEN 
354: !           PRINT '(A)',' lopermdist> and partner atoms:' 
355: !           PRINT '(20I5)',DLIST(NOTHER-NADDED+1:NOTHER-1) 
356: !        ENDIF 
357:          TRIED(DLIST(NOTHER-NADDED+1:NOTHER-1))=1 
358:       ENDIF 
359:       LDBEST(J1)=LDBESTATOM 
360:       LPERMBEST(1:PATOMS)=LPERMBESTATOM(1:PATOMS) 
361: !     PRINT '(A,2G20.10)','Updating permutation: sqrt(LDBEST)=',SQRT(LDBEST(J1)) 
362: !     PRINT '(A,10I6)','LPERMBEST: ',LPERMBEST(1:PATOMS) 
363:    ENDIF 
364: ! 
365: ! Add the next eligible atom and try alignment again. 
366: ! Stop if we already have LOCALPERMNEIGH neighbours. 
367: ! 
368:    IF (NOTHER.LT.LOCALPERMNEIGH) GOTO 71 
369:  
370: 91 CONTINUE ! jump here when there are no atoms left to try. 
371:  
372:    IF (DEBUG) WRITE(MYUNIT,'(2(A,I6),A,G15.5)') ' lopermdist> For group ',J1,' maximum neighbours=', & 
373:   &                                      NOTHER,' distance=',SQRT(LDBEST(J1)) 
374: ! 
375: ! We now have the best permutation for group J1 and standard orientations 
376: ! based upon all atoms belonging to the two possible orbits that appear 
377: ! for the standard alignment. 
378: ! 
379:    LPERM(1:PATOMS)=LPERMBEST(1:PATOMS) 
380: ! 
381: ! Fill SAVEPERM with NEWPERM, which contains the current best permutation 
382: ! after the previous pass through J1 
383: ! 
384:    SAVEPERM(1:NATOMS)=NEWPERM(1:NATOMS) 
385: ! 
386: ! Update best permutation for atoms in subset J1, specified by PERMGROUP 
387: ! with offset NDUMMY (updated below after each pass through J1) 
388: ! 
389:    DO J2=1,PATOMS 
390:       SAVEPERM(PERMGROUP(NDUMMY+J2-1))=NEWPERM(PERMGROUP(NDUMMY+LPERMBEST(J2)-1)) 
391: !     WRITE(MYUNIT,'(2(A,I6))') ' lopermdist> Atom ',NEWPERM(PERMGROUP(NDUMMY+LPERMBEST(J2)-1)), & 
392: ! &                     ' moves to position ',PERMGROUP(NDUMMY+LPERMBEST(J2)-1) 
393:    ENDDO 
394: !   
395: ! Update permutation of associated atoms, if any. 
396: ! We must do this as we go along, because these atoms could move in more than 
397: ! one permutational group now. 
398: !  
399:    IF (NSETS(J1).GT.0) THEN 
400:       DO J2=1,PATOMS 
401:          DO J3=1,NSETS(J1) 
402:             SAVEPERM(SETS(PERMGROUP(NDUMMY+J2-1),J3))=SETS(NEWPERM(PERMGROUP(NDUMMY+LPERM(J2)-1)),J3) 
403:          ENDDO 
404:       ENDDO 
405:    ENDIF 
406: ! 
407: ! Save current optimal permutation in NEWPERM 
408: ! 
409:    NEWPERM(1:NATOMS)=SAVEPERM(1:NATOMS) 
410:    DSUM=DSUM+SQRT(LDBEST(J1)) 
411: !  PRINT '(A,I6,2(A,F20.10))',' lopermdist> For group ',J1,' after myorient distance=',SQRT(LDBEST(J1)),' total=',DSUM 
412:  
413: ! 
414: ! Update NDUMMY, the cumulative offset for PERMGROUP 
415: ! 
416:    NDUMMY=NDUMMY+NPERMSIZE(J1) 
417: ENDDO  !  end of loop over groups of permutable atoms 
418: ! 
419: ! NEWPERM(J1) is the atom that moves to position J1 to map COORDSA 
420: ! to the current best alignment.  
421: ! This loop just appears to set SAVEPERM and ALLPERM equal to the current 
422: ! NEWPERM. 
423: ! 
424: ! 
425: ! Putting the ALLPERM(J1)=J1 into the second loop causes pgf90 to miscompile!! 
426: ! 
427: DO J1=1,NATOMS 
428:    ALLPERM(J1)=J1 
429: ENDDO 
430: DO J1=1,NATOMS 
431:    SAVEPERM(J1)=ALLPERM(NEWPERM(J1)) 
432: ENDDO 
433: ALLPERM(1:NATOMS)=SAVEPERM(1:NATOMS) 
434: ! 
435: ! At this point DUMMYA should not have changed from COORDSA, so we are 
436: ! putting COORDSA in DUMMY 
437: ! 
438: DUMMY(1:3*NATOMS)=DUMMYA(1:3*NATOMS) 
439: NPERM=0 
440: ! 
441: ! Update coordinates in DUMMYA to current best overall permutation using NEWPERM. 
442: ! We are doing this to operate with NEWPERMDIST in the next block. 
443: ! 
444: DO J3=1,NATOMS 
445:    DUMMYA(3*(J3-1)+1)=DUMMY(3*(NEWPERM(J3)-1)+1) 
446:    DUMMYA(3*(J3-1)+2)=DUMMY(3*(NEWPERM(J3)-1)+2) 
447:    DUMMYA(3*(J3-1)+3)=DUMMY(3*(NEWPERM(J3)-1)+3) 
448:  
449: !  IF (DEBUG) WRITE(*,'(A,I5,A,I5)') ' lopermdist> Overall permutations after MYORIENT alignment:' 
450:    IF (J3.NE.NEWPERM(J3)) THEN 
451: !     IF (DEBUG) WRITE(*,'(A,I5,A,I5)') ' lopermdist> Moving position ',NEWPERM(J3),' to ',J3 
452:       NPERM=NPERM+1 
453:    ENDIF 
454: ENDDO 
455:  
456: DISTANCE=DSUM 
457: IF (DEBUG) WRITE(MYUNIT,'(A,G20.10)') ' lopermdist> After myorient block sum of distances=',DISTANCE 
458: ! 
459: ! Save current best overall distance, permuted version of COORDSA, and permutation. 
460: ! 
461: DBEST=DISTANCE 
462: XBEST(1:3*NATOMS)=DUMMYA(1:3*NATOMS) 
463: BESTPERM(1:NATOMS)=ALLPERM(1:NATOMS) 
464: ! 
465: ! At this point NEWPERM, ALLPERM, SAVEPERM, BESTPERM 
466: ! are all the same! 
467: ! 
468: ! PRINT '(A)',' lopermdist> NEWPERM, ALLPERM, SAVEPERM, BESTPERM:' 
469: ! PRINT '(4I6)',(NEWPERM(J1),ALLPERM(J1),SAVEPERM(J1),BESTPERM(J1),J1=1,NATOMS) 
470:  
471: !!!!!!!!!!!!!!!!!!!!!!! DEBUG 
472: ! 
473: ! Test distance for COORDSA with permutation applied in BESTPERM 
474: ! 
475: !  DO J1=1,NATOMS 
476: !     DUMMYA(3*(J1-1)+1)=COORDSA(3*(BESTPERM(J1)-1)+1) 
477: !     DUMMYA(3*(J1-1)+2)=COORDSA(3*(BESTPERM(J1)-1)+2) 
478: !     DUMMYA(3*(J1-1)+3)=COORDSA(3*(BESTPERM(J1)-1)+3) 
479: !  ENDDO 
480:  
481: !  CALL NEWMINDIST(COORDSB,DUMMYA,NATOMS,DISTANCE,BULKT,TWOD,'AX    ',.FALSE.,RIGID,DEBUG,RMAT) 
482: !  CALL NEWMINDIST(COORDSB,XBEST,NATOMS,XDUMMY,BULKT,TWOD,'AX    ',.FALSE.,RIGID,DEBUG,RMAT) 
483: !  IF (DEBUG) WRITE(MYUNIT,'(A,2G20.10)') &  
484: ! &   ' lopermdist> distance check for permuted COORDSA and original COORDSB=',XDUMMY,DISTANCE 
485: !!!!!!!!!!!!!!!!!!!!!!! DEBUG 
486: ! 
487: ! Now align and reorient the permuted coordinates in COORDSA  
488: ! Try using the best locally aligned group of atoms 
489: ! 
490: CALL NEWMINDIST(DUMMYB,XBEST,NATOMS,DISTANCE,BULKT,TWOD,'AX    ',.FALSE.,RIGID,DEBUG,RMAT) 
491: IF (DEBUG) WRITE(MYUNIT,'(A,G20.10)') ' lopermdist> after overall alignment distance=',DISTANCE 
492: RMATBEST(1:3,1:3)=RMAT(1:3,1:3) 
493:  
494: COORDSA(1:3*NATOMS)=XBEST(1:3*NATOMS) ! finally, best COORDSA should include permutations for DNEB input! 
495:  
496: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
497: ! IF (DEBUG) PRINT '(A)',' lopermdist> Overall permutation for COORDSA (second argument):' 
498: ! IF (DEBUG) PRINT '(20I6)',BESTPERM(1:NATOMS) 
499:  
500: RETURN 
501: END SUBROUTINE LOPERMDIST 


r29792/main.F 2016-03-16 18:33:30.027024493 +0000 r29791/main.F 2016-03-16 18:33:32.899054026 +0000
111: !      END IF111: !      END IF
112: 112: 
113: ! Add the GMIN version to the output - helps bug hunting :)113: ! Add the GMIN version to the output - helps bug hunting :)
114:       !WRITE(MYUNIT, '(A,I5)') 'GMIN version r',VERSIONTEMP114:       !WRITE(MYUNIT, '(A,I5)') 'GMIN version r',VERSIONTEMP
115: !     CALL DISPLAY_VERSION(MYUNIT)115: !     CALL DISPLAY_VERSION(MYUNIT)
116:       CALL COUNTATOMS(MYUNIT, NPAR, GCBHT, GCMU, GCNATOMS)116:       CALL COUNTATOMS(MYUNIT, NPAR, GCBHT, GCMU, GCNATOMS)
117:       IF (CHRMMT) WRITE(MYUNIT,'(A,I8)') 'main> MAXAIM parameter for CHARMM MXATMS=',MXATMS117:       IF (CHRMMT) WRITE(MYUNIT,'(A,I8)') 'main> MAXAIM parameter for CHARMM MXATMS=',MXATMS
118: !118: !
119: ! NATOMS is set to NUMBER_OF_ATOMS in modcommonunit119: ! NATOMS is set to NUMBER_OF_ATOMS in modcommonunit
120: !120: !
121:       IF (MLP3T) THEN 
122:          IF (NUMBER_OF_ATOMS.NE.MLPHIDDEN*(MLPIN+MLPOUT)) THEN 
123:             WRITE(MYUNIT,'(A,I8,A,I8)') 'main> ERROR *** number of coordinates in coords is ',NUMBER_OF_ATOMS, 
124:      &                         ' should be ',MLPHIDDEN*(MLPIN+MLPOUT)  
125:             STOP 
126:          ENDIF 
127:       ENDIF 
128:       NATOMSALLOC=NUMBER_OF_ATOMS121:       NATOMSALLOC=NUMBER_OF_ATOMS
129:       NATOMS=NUMBER_OF_ATOMS122:       NATOMS=NUMBER_OF_ATOMS
130:       IF (GCBHT) THEN123:       IF (GCBHT) THEN
131:          NATOMSALLOC=GCNATOMS124:          NATOMSALLOC=GCNATOMS
132:          IF (GCNATOMS.LT.NUMBER_OF_ATOMS) THEN125:          IF (GCNATOMS.LT.NUMBER_OF_ATOMS) THEN
133:             WRITE(MYUNIT,'(A)') 'main> *** ERROR - number of atoms exceeds maximum allowed by GCBH keyword'126:             WRITE(MYUNIT,'(A)') 'main> *** ERROR - number of atoms exceeds maximum allowed by GCBH keyword'
134:             STOP127:             STOP
135:          ENDIF128:          ENDIF
136:          ALLOCATE(QENERGIES(GCNATOMS),QCOORDINATES(GCNATOMS,3*GCNATOMS),QPE(GCNATOMS))129:          ALLOCATE(QENERGIES(GCNATOMS),QCOORDINATES(GCNATOMS,3*GCNATOMS),QPE(GCNATOMS))
137:          QENERGIES(1:GCNATOMS)=HUGE(1.0D0)/1.0D2130:          QENERGIES(1:GCNATOMS)=HUGE(1.0D0)/1.0D2
138:          QPE(1:GCNATOMS)=HUGE(1.0D0)/1.0D2131:          QPE(1:GCNATOMS)=HUGE(1.0D0)/1.0D2
139:          QCOORDINATES(1:GCNATOMS,1:3*GCNATOMS)=0.0D0132:          QCOORDINATES(1:GCNATOMS,1:3*GCNATOMS)=0.0D0
140:       ENDIF133:       ENDIF
141: 134: 
142: ! DMACRYS things135: ! DMACRYS things
143: ! Moved from commons.f90, since they forced commons to depend on countatoms.f90136: ! Moved from commons.f90, since they forced commons to depend on countatoms.f90
144:       ALLOCATE(ANV(NATOMSALLOC,NATOMSALLOC,3))137:       allocate( ANV(NATOMSALLOC,NATOMSALLOC,3))
145: 138: 
146: ! vr274> DMACRYS is used139: ! vr274> DMACRYS is used
147:       DMACRYST = .false.140:       DMACRYST = .false.
148:       DMACRYS_RANDOMSTART=.false.141:       DMACRYS_RANDOMSTART=.false.
149:       DMACRYS_EXPAND = 1.0D0142:       DMACRYS_EXPAND = 1.0D0
150:       DMACRYS_LATTICE_STEP = 0.0D0143:       DMACRYS_LATTICE_STEP = 0.0D0
151: ! END DMACRYS things144: ! END DMACRYS things
152:  145:  
153:       ALLOCATE(FIN(3*NATOMSALLOC))146:       ALLOCATE(FIN(3*NATOMSALLOC))
154:       ALLOCATE(XICOM(3*NATOMSALLOC),PCOM(3*NATOMSALLOC))147:       ALLOCATE(XICOM(3*NATOMSALLOC),PCOM(3*NATOMSALLOC))
465: !        WRITE(MYUNIT, *) NATOMSALLOC458: !        WRITE(MYUNIT, *) NATOMSALLOC
466: !        WRITE(MYUNIT, *) 'A tmpcoords after'459: !        WRITE(MYUNIT, *) 'A tmpcoords after'
467: !        DO J1=1,NATOMSALLOC460: !        DO J1=1,NATOMSALLOC
468: !           WRITE(MYUNIT,'(A,3G20.10)') 'O ',TMPCOORDS(3*(J1-1)+1:3*(J1-1)+3)461: !           WRITE(MYUNIT,'(A,3G20.10)') 'O ',TMPCOORDS(3*(J1-1)+1:3*(J1-1)+3)
469: !        ENDDO462: !        ENDDO
470:          DEALLOCATE(TMPCOORDS)463:          DEALLOCATE(TMPCOORDS)
471:       ENDIF464:       ENDIF
472: !465: !
473: ! Allocations for QCI466: ! Allocations for QCI
474: !467: !
475:       IF (INTCONSTRAINTT) THEN468:       IF (INTCONSTRAINTT.AND.(NCONGEOM.GE.2)) THEN
476:          IF (MAXNACTIVE.LE.0) MAXNACTIVE=NATOMSALLOC 
477:          WRITE(MYUNIT,'(A,I10)') 'main> Maximum number of active atoms in QCI procedure=',MAXNACTIVE 
478: !469: !
479: ! Set up all the constraints and repulsions for zero frozen atoms.470: ! Set up all the constraints and repulsions for zero frozen atoms.
480: !471: !
481:          IF (NCONGEOM.GE.2) THEN472:          IF (.NOT.ALLOCATED(CONI)) THEN
482:             IF (.NOT.ALLOCATED(CONI)) THEN473:             ALLOCATE(CONI(INTCONMAX),CONJ(INTCONMAX),CONDISTREF(INTCONMAX),CONCUT(INTCONMAX))
483:                ALLOCATE(CONI(INTCONMAX),CONJ(INTCONMAX),CONDISTREF(INTCONMAX),CONCUT(INTCONMAX))474:             ALLOCATE(REPI(NREPMAX),REPJ(NREPMAX),NREPI(NREPMAX),NREPJ(NREPMAX),REPCUT(NREPMAX),NREPCUT(NREPMAX))
484:                ALLOCATE(REPI(NREPMAX),REPJ(NREPMAX),NREPI(NREPMAX),NREPJ(NREPMAX),REPCUT(NREPMAX),NREPCUT(NREPMAX))475:          ENDIF
485:             ENDIF 
486: 476: 
487:             ALLOCATE(TMPCOORDS(3*NATOMSALLOC))477:          ALLOCATE(TMPCOORDS(3*NATOMSALLOC))
488:             TMPCOORDS(1:3*NATOMSALLOC)=COORDS(1:3*NATOMSALLOC,1)478:          TMPCOORDS(1:3*NATOMSALLOC)=COORDS(1:3*NATOMSALLOC,1)
489:             DEALLOCATE(TMPCOORDS)479:          DEALLOCATE(TMPCOORDS)
490:             INTFREEZETOLSAVE=INTFREEZETOL480:          INTFREEZETOLSAVE=INTFREEZETOL
491:             INTFREEZETOL=-1.0D0481:          INTFREEZETOL=-1.0D0
492:             CALL MAKE_CONPOT(NCONGEOM,CONGEOM)482:          CALL MAKE_CONPOT(NCONGEOM,CONGEOM)
493:             INTFREEZETOL=INTFREEZETOLSAVE483:          INTFREEZETOL=INTFREEZETOLSAVE
494: !484: !
495: ! Now align the two endpoints to the first reference minimum.485: ! Now align the two endpoints to the first reference minimum.
496: !486: !
497:          487:          
498:             ALLOCATE(ENDCOORDS(2,3*NATOMSALLOC))488:          ALLOCATE(ENDCOORDS(2,3*NATOMSALLOC))
499:             ENDCOORDS(1,1:3*NATOMSALLOC)=COORDS(1:3*NATOMSALLOC,1)489:          ENDCOORDS(1,1:3*NATOMSALLOC)=COORDS(1:3*NATOMSALLOC,1)
500:             ENDCOORDS(2,1:3*NATOMSALLOC)=FINISH(1:3*NATOMSALLOC)490:          ENDCOORDS(2,1:3*NATOMSALLOC)=FINISH(1:3*NATOMSALLOC)
501:             CALL MAKE_CONPOT(2,ENDCOORDS)491:          CALL MAKE_CONPOT(2,ENDCOORDS)
502:             COORDS(1:3*NATOMSALLOC,1)=ENDCOORDS(1,1:3*NATOMSALLOC)492:          COORDS(1:3*NATOMSALLOC,1)=ENDCOORDS(1,1:3*NATOMSALLOC)
503:             FINISH(1:3*NATOMSALLOC)=ENDCOORDS(2,1:3*NATOMSALLOC)493:          FINISH(1:3*NATOMSALLOC)=ENDCOORDS(2,1:3*NATOMSALLOC)
504:             DEALLOCATE(ENDCOORDS)494:          DEALLOCATE(ENDCOORDS)
505:          ELSE 
506: ! 
507: ! align the two endpoints  
508: ! 
509:             ALLOCATE(ENDCOORDS(2,3*NATOMSALLOC)) 
510:             ENDCOORDS(1,1:3*NATOMSALLOC)=COORDS(1:3*NATOMSALLOC,1) 
511:             ENDCOORDS(2,1:3*NATOMSALLOC)=FINISH(1:3*NATOMSALLOC) 
512:             CALL MINPERMDIST(ENDCOORDS(1,1:3*NATOMSALLOC),ENDCOORDS(2,1:3*NATOMSALLOC),NATOMS,DEBUG,  
513:      &                       BOXLX,BOXLY,BOXLZ,PERIODIC,TWOD,D,DIST2,RIGID,RMAT) 
514:             COORDS(1:3*NATOMSALLOC,1)=ENDCOORDS(1,1:3*NATOMSALLOC) 
515:             FINISH(1:3*NATOMSALLOC)=ENDCOORDS(2,1:3*NATOMSALLOC) 
516:             DEALLOCATE(ENDCOORDS) 
517:          ENDIF 
518:       ENDIF495:       ENDIF
519: !496: !
520: ! If this is a CSM optimisation we now have to multiply the number of atoms by the number of497: ! If this is a CSM optimisation we now have to multiply the number of atoms by the number of
521: ! group operations and replicate some coordinates and allowed permutations.498: ! group operations and replicate some coordinates and allowed permutations.
522: !499: !
523:       IF (CSMT) THEN500:       IF (CSMT) THEN
524:          CALL CSMINIT501:          CALL CSMINIT
525:          IF (SYMMETRIZECSM) THEN502:          IF (SYMMETRIZECSM) THEN
526:             IF (CSMMAXIT.EQ.0) CSMMAXIT=MAXIT503:             IF (CSMMAXIT.EQ.0) CSMMAXIT=MAXIT
527:          ELSE504:          ELSE


r29792/make_conpot.f90 2016-03-16 18:33:30.219026468 +0000 r29791/make_conpot.f90 2016-03-16 18:33:33.095056042 +0000
 64: ALLOCATE(INTFROZEN(NATOMS)) 64: ALLOCATE(INTFROZEN(NATOMS))
 65: INTFROZEN(1:NATOMS)=.FALSE. 65: INTFROZEN(1:NATOMS)=.FALSE.
 66: DLIST(1:NATOMS)=-1 66: DLIST(1:NATOMS)=-1
 67: DMOVED(1:NATOMS)=1.0D100 67: DMOVED(1:NATOMS)=1.0D100
 68: IF (INTFREEZET) THEN 68: IF (INTFREEZET) THEN
 69:    IF (NCPFIT.GT.1) THEN 69:    IF (NCPFIT.GT.1) THEN
 70:       DO J1=1,NATOMS 70:       DO J1=1,NATOMS
 71:          DF=SQRT((MINCOORDS(1,3*(J1-1)+1)-MINCOORDS(2,3*(J1-1)+1))**2 & 71:          DF=SQRT((MINCOORDS(1,3*(J1-1)+1)-MINCOORDS(2,3*(J1-1)+1))**2 &
 72:   &             +(MINCOORDS(1,3*(J1-1)+2)-MINCOORDS(2,3*(J1-1)+2))**2 & 72:   &             +(MINCOORDS(1,3*(J1-1)+2)-MINCOORDS(2,3*(J1-1)+2))**2 &
 73:   &             +(MINCOORDS(1,3*(J1-1)+3)-MINCOORDS(2,3*(J1-1)+3))**2) 73:   &             +(MINCOORDS(1,3*(J1-1)+3)-MINCOORDS(2,3*(J1-1)+3))**2)
 74: !        IF (J1.EQ.NATOMS) THEN 74:          IF (J1.EQ.NATOMS) THEN
 75: !           WRITE(MYUNIT,'(A,6G20.10)') 'mincoords atom 400: ',MINCOORDS(1,1198:1200),MINCOORDS(2,1198:1200) 75:             WRITE(MYUNIT,'(A,6G20.10)') 'mincoords atom 400: ',MINCOORDS(1,1198:1200),MINCOORDS(2,1198:1200)
 76: !           WRITE(MYUNIT,'(A,I6,6G20.10)') 'J1,DF,INTFREEZETOL=',J1,DF,INTFREEZETOL 76:             WRITE(MYUNIT,'(A,6G20.10)') 'DF,INTFREEZETOL=',DF,INTFREEZETOL
 77: !        ENDIF 77:          ENDIF
 78:  78: 
 79:          IF (DF.LT.INTFREEZETOL) THEN 79:          IF (DF.LT.INTFREEZETOL) THEN
 80:             NQCIFREEZE=NQCIFREEZE+1 80:             NQCIFREEZE=NQCIFREEZE+1
 81:             INTFROZEN(J1)=.TRUE. 81:             INTFROZEN(J1)=.TRUE.
 82:             IF (DEBUG) WRITE(MYUNIT, '(A,I6,A,F12.6,A,I6)') ' make_conpot> atom ',J1, & 82:             IF (DEBUG) WRITE(MYUNIT, '(A,I6,A,F12.6,A,I6)') ' make_conpot> atom ',J1, &
 83:   &                          ' moves less than threshold: distance=',DF,' total=',NQCIFREEZE 83:   &                          ' moves less than threshold: distance=',DF,' total=',NQCIFREEZE
 84:          ENDIF 84:          ENDIF
 85:          sortd: DO J2=1,J1 85:          sortd: DO J2=1,J1
 86:             IF (DF.LT.DMOVED(J2)) THEN 86:             IF (DF.LT.DMOVED(J2)) THEN
 87:                DO J3=J1,J2+1,-1 87:                DO J3=J1,J2+1,-1
 95:          ENDDO sortd 95:          ENDDO sortd
 96:       ENDDO 96:       ENDDO
 97:    ENDIF 97:    ENDIF
 98:    WRITE(MYUNIT, '(A,I6,A,F12.6,A,I6)') ' make_conpot> Total number of atoms moving less than threshold=',NQCIFREEZE 98:    WRITE(MYUNIT, '(A,I6,A,F12.6,A,I6)') ' make_conpot> Total number of atoms moving less than threshold=',NQCIFREEZE
 99: ENDIF 99: ENDIF
100: 100: 
101: IF (NATOMS-NQCIFREEZE.LT.INTFREEZEMIN) THEN101: IF (NATOMS-NQCIFREEZE.LT.INTFREEZEMIN) THEN
102:    DO J1=NATOMS,NATOMS-INTFREEZEMIN+1,-1102:    DO J1=NATOMS,NATOMS-INTFREEZEMIN+1,-1
103:       INTFROZEN(DLIST(J1))=.FALSE.103:       INTFROZEN(DLIST(J1))=.FALSE.
104:    ENDDO104:    ENDDO
105:    NQCIFREEZE=MAX(0,NATOMS-INTFREEZEMIN)105:    NQCIFREEZE=NATOMS-INTFREEZEMIN
106:    IF (DEBUG) WRITE(MYUNIT, '(A,I6,A)') ' make_conpot> Freezing ',NQCIFREEZE,' atoms'106:    IF (DEBUG) WRITE(MYUNIT, '(A,I6,A)') ' make_conpot> Freezing ',NQCIFREEZE,' atoms'
107: ENDIF107: ENDIF
108: 108: 
109: IF (.NOT.ALLOCATED(CONI)) THEN 109: IF (.NOT.ALLOCATED(CONI)) THEN 
110:    ALLOCATE(CONI(INTCONMAX),CONJ(INTCONMAX),CONDISTREF(INTCONMAX),CONCUT(INTCONMAX))110:    ALLOCATE(CONI(INTCONMAX),CONJ(INTCONMAX),CONDISTREF(INTCONMAX),CONCUT(INTCONMAX))
111:    ALLOCATE(REPI(NREPMAX),REPJ(NREPMAX),NREPI(NREPMAX),NREPJ(NREPMAX),REPCUT(NREPMAX),NREPCUT(NREPMAX))111:    ALLOCATE(REPI(NREPMAX),REPJ(NREPMAX),NREPI(NREPMAX),NREPJ(NREPMAX),REPCUT(NREPMAX),NREPCUT(NREPMAX))
112: ENDIF112: ENDIF
113: 113: 
114: IF (NQCIFREEZE.EQ.NATOMS) THEN114: IF (NQCIFREEZE.EQ.NATOMS) THEN
115:    NREPULSIVE=0115:    NREPULSIVE=0
219: !219: !
220:    ADDREP(1:MIN(J1+INTREPSEP,NATOMS))=.FALSE.220:    ADDREP(1:MIN(J1+INTREPSEP,NATOMS))=.FALSE.
221:    IF (J1+INTREPSEP+1.LT.NATOMS) THEN221:    IF (J1+INTREPSEP+1.LT.NATOMS) THEN
222:       ADDREP(J1+INTREPSEP+1:NATOMS)=.TRUE. ! no repulsion for atoms too close in sequence222:       ADDREP(J1+INTREPSEP+1:NATOMS)=.TRUE. ! no repulsion for atoms too close in sequence
223:    ENDIF223:    ENDIF
224:    IF (INTFROZEN(J1)) THEN224:    IF (INTFROZEN(J1)) THEN
225:       DO J2=J1+INTREPSEP+1,NATOMS225:       DO J2=J1+INTREPSEP+1,NATOMS
226:          IF (INTFROZEN(J2)) ADDREP(J2)=.FALSE.226:          IF (INTFROZEN(J2)) ADDREP(J2)=.FALSE.
227:       ENDDO227:       ENDDO
228:    ENDIF228:    ENDIF
229: !229:    addloop: DO J2=NDUMMY,NCONSTRAINT
230: ! Do we allow repulsions between constrained atoms?230:       IF (CONI(J2).EQ.J1) THEN
231: ! If commented below then yes.231:          ADDREP(CONJ(J2))=.FALSE.
232: !232:       ELSE
233: !  addloop: DO J2=NDUMMY,NCONSTRAINT233:          NDUMMY=J2 ! for next atom
234: !     IF (CONI(J2).EQ.J1) THEN234:          EXIT addloop
235: !        ADDREP(CONJ(J2))=.FALSE.235:       ENDIF
236: !     ELSE236:    ENDDO addloop
237: !        NDUMMY=J2 ! for next atom 
238: !        EXIT addloop 
239: !     ENDIF 
240: !  ENDDO addloop 
241:    rep2: DO J2=J1+INTREPSEP+1,NATOMS237:    rep2: DO J2=J1+INTREPSEP+1,NATOMS
242: 238: 
243:       IF (.NOT.ADDREP(J2)) CYCLE239:       IF (.NOT.ADDREP(J2)) CYCLE
244: 240: 
245:       DMIN=1.0D100241:       DMIN=1.0D100
246:       DO J3=1,NCPFIT242:       DO J3=1,NCPFIT
247:          DF=SQRT((MINCOORDS(J3,3*(J1-1)+1)-MINCOORDS(J3,3*(J2-1)+1))**2+ &243:          DF=SQRT((MINCOORDS(J3,3*(J1-1)+1)-MINCOORDS(J3,3*(J2-1)+1))**2+ &
248:   &              (MINCOORDS(J3,3*(J1-1)+2)-MINCOORDS(J3,3*(J2-1)+2))**2+ &244:   &              (MINCOORDS(J3,3*(J1-1)+2)-MINCOORDS(J3,3*(J2-1)+2))**2+ &
249:   &              (MINCOORDS(J3,3*(J1-1)+3)-MINCOORDS(J3,3*(J2-1)+3))**2)245:   &              (MINCOORDS(J3,3*(J1-1)+3)-MINCOORDS(J3,3*(J2-1)+3))**2)
250:          IF (DF.LT.DMIN) DMIN=DF246:          IF (DF.LT.DMIN) DMIN=DF
256:          REPIFIX(NREPULSIVEFIX)=J1252:          REPIFIX(NREPULSIVEFIX)=J1
257:          REPJFIX(NREPULSIVEFIX)=J2253:          REPJFIX(NREPULSIVEFIX)=J2
258:          REPCUTFIX(NREPULSIVEFIX)=MIN(DMIN-1.0D-3,INTCONSTRAINREPCUT)254:          REPCUTFIX(NREPULSIVEFIX)=MIN(DMIN-1.0D-3,INTCONSTRAINREPCUT)
259:       ENDIF255:       ENDIF
260:       REPI(NREPULSIVEFIX)=J1256:       REPI(NREPULSIVEFIX)=J1
261:       REPJ(NREPULSIVEFIX)=J2257:       REPJ(NREPULSIVEFIX)=J2
262: !258: !
263: ! Use the minimum of the end point distances and INTCONSTRAINREPCUT for each contact.259: ! Use the minimum of the end point distances and INTCONSTRAINREPCUT for each contact.
264: !260: !
265:       REPCUT(NREPULSIVEFIX)=MIN(DMIN-1.0D-3,INTCONSTRAINREPCUT)261:       REPCUT(NREPULSIVEFIX)=MIN(DMIN-1.0D-3,INTCONSTRAINREPCUT)
266:       IF (DEBUG) WRITE(MYUNIT, '(A,I6,A,I6,A,F15.5,A,I10)') ' make_conpot> Adding repulsion for atom ',J1, &262: !     IF (DEBUG) WRITE(MYUNIT, '(A,I6,A,I6,A,F15.5,A,I10)') ' make_conpot> Adding repulsion for atom ',J1, &
267:   &              ' with atom ',J2,' cutoff=',DMIN,' # repulsions ',NREPULSIVEFIX263: ! &              ' with atom ',J2,' cutoff=',DMIN,' # repulsions ',NREPULSIVEFIX
268:    ENDDO rep2264:    ENDDO rep2
269: ENDDO265: ENDDO
270: NREPULSIVE=NREPULSIVEFIX266: NREPULSIVE=NREPULSIVEFIX
271: 267: 
272: WRITE(MYUNIT, '(A,2I10,A,G20.10)') ' make_conpot> Total number of constraints and repulsions=', &268: WRITE(MYUNIT, '(A,2I10,A,G20.10)') ' make_conpot> Total number of constraints and repulsions=', &
273:   &   NCONSTRAINT,NREPULSIVE,' for tolerance parameter ',LINTCONSTRAINTTOL269:   &   NCONSTRAINT,NREPULSIVE,' for tolerance parameter ',LINTCONSTRAINTTOL
274: 270: 
275: IF (ALLOCATED(CONACTIVE)) DEALLOCATE(CONACTIVE)271: IF (ALLOCATED(CONACTIVE)) DEALLOCATE(CONACTIVE)
276: ALLOCATE(CONACTIVE(NCONSTRAINT))272: ALLOCATE(CONACTIVE(NCONSTRAINT))
277: CONACTIVE(1:NCONSTRAINT)=.TRUE. 273: CONACTIVE(1:NCONSTRAINT)=.TRUE. 
303: 299: 
304: CALLED=.TRUE.300: CALLED=.TRUE.
305: 301: 
306: RETURN302: RETURN
307: END SUBROUTINE MAKE_CONPOT303: END SUBROUTINE MAKE_CONPOT
308: 304: 
309: SUBROUTINE CONPOT(COORDS1,COORDS2,ETOTAL)305: SUBROUTINE CONPOT(COORDS1,COORDS2,ETOTAL)
310: USE COMMONS, ONLY : NREPMAX, NREPULSIVE, CONDISTREF, INTCONSTRAINTDEL, CONCUT, CONCUTLOCAL, &306: USE COMMONS, ONLY : NREPMAX, NREPULSIVE, CONDISTREF, INTCONSTRAINTDEL, CONCUT, CONCUTLOCAL, &
311:   & REPCUT, NCONSTRAINT, CONI, CONJ, INTCONMAX, INTCONSTRAINTREP, &307:   & REPCUT, NCONSTRAINT, CONI, CONJ, INTCONMAX, INTCONSTRAINTREP, &
312:   & INTCONSTRAINREPCUT, REPI, REPJ, REPCUT, CONDISTREFLOCAL, NNREPULSIVE, NREPCUT, NREPI, NREPJ, &308:   & INTCONSTRAINREPCUT, REPI, REPJ, REPCUT, CONDISTREFLOCAL, NNREPULSIVE, NREPCUT, NREPI, NREPJ, &
313:   & CONCUTABST, CONCUTABS, CONCUTFRAC, CONCUTFRACT, MYUNIT309:   & CONCUTABST, CONCUTABS, CONCUTFRAC, CONCUTFRACT
314: USE COMMONS, ONLY : NATOMS, DEBUG310: USE COMMONS, ONLY : NATOMS, DEBUG
315: IMPLICIT NONE311: IMPLICIT NONE
316:            312:            
317: INTEGER :: J1,J2,NI,NJ313: INTEGER :: J1,J2,NI,NJ
318: DOUBLE PRECISION :: ECON, EREP, ETOTAL314: DOUBLE PRECISION :: ECON, EREP, ETOTAL
319: DOUBLE PRECISION R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ,DMIN,DMAX315: DOUBLE PRECISION R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ,DMIN,DMAX
320: DOUBLE PRECISION G1MAX(3),G2MIN(3),DINT,G1INT(3),G2INT(3),CCLOCAL316: DOUBLE PRECISION G1MAX(3),G2MIN(3),DINT,G1INT(3),G2INT(3),CCLOCAL
321: DOUBLE PRECISION DUMMY, REPGRAD(3), INtCONST, D12, DSQ0, DSQP, DSQI, COORDS1(3*NATOMS), COORDS2(3*NATOMS)317: DOUBLE PRECISION DUMMY, REPGRAD(3), INtCONST, D12, DSQ0, DSQP, DSQI, COORDS1(3*NATOMS), COORDS2(3*NATOMS)
322: DOUBLE PRECISION, PARAMETER :: MINCONPOT=1.0D-2318: DOUBLE PRECISION, PARAMETER :: MINCONPOT=1.0D-2
323: LOGICAL NOINT319: LOGICAL NOINT
367: 363: 
368: DO J2=1,NNREPULSIVE364: DO J2=1,NNREPULSIVE
369: !  INTCONST=NREPCUT(J2)**13365: !  INTCONST=NREPCUT(J2)**13
370:    INTCONST=NREPCUT(J2)**3366:    INTCONST=NREPCUT(J2)**3
371:    NI=3*(NREPI(J2)-1)367:    NI=3*(NREPI(J2)-1)
372:    NJ=3*(NREPJ(J2)-1)368:    NJ=3*(NREPJ(J2)-1)
373:    R1AX=COORDS1(NI+1); R1AY=COORDS1(NI+2); R1AZ=COORDS1(NI+3)369:    R1AX=COORDS1(NI+1); R1AY=COORDS1(NI+2); R1AZ=COORDS1(NI+3)
374:    R1BX=COORDS1(NJ+1); R1BY=COORDS1(NJ+2); R1BZ=COORDS1(NJ+3)370:    R1BX=COORDS1(NJ+1); R1BY=COORDS1(NJ+2); R1BZ=COORDS1(NJ+3)
375:    R2AX=COORDS2(NI+1); R2AY=COORDS2(NI+2); R2AZ=COORDS2(NI+3)371:    R2AX=COORDS2(NI+1); R2AY=COORDS2(NI+2); R2AZ=COORDS2(NI+3)
376:    R2BX=COORDS2(NJ+1); R2BY=COORDS2(NJ+2); R2BZ=COORDS2(NJ+3)372:    R2BX=COORDS2(NJ+1); R2BY=COORDS2(NJ+2); R2BZ=COORDS2(NJ+3)
377:    WRITE(MYUNIT,'(A,5I6)') 'make_conpot> J2,NI,NJ,NREPI,NREPJ=',J2,NI,NJ,NREPI(J2),NREPJ(J2) 
378:    CALL MINMAXD2R(R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ, &373:    CALL MINMAXD2R(R1AX,R1AY,R1AZ,R2AX,R2AY,R2AZ,R1BX,R1BY,R1BZ,R2BX,R2BY,R2BZ, &
379:   &                 DMIN,DMAX,DINT,DSQ0,DSQP,DSQI,G1MAX,G2MIN,G1INT,G2INT,NOINT,.FALSE.,NREPCUT(J2))374:   &                 DMIN,DMAX,DINT,DSQ0,DSQP,DSQI,G1MAX,G2MIN,G1INT,G2INT,NOINT,.FALSE.,NREPCUT(J2))
380:    DUMMY=0.0D0 375:    DUMMY=0.0D0 
381:    IF (DMIN.LT.NREPCUT(J2)) THEN ! terms for image J1 - non-zero derivatives only for J1376:    IF (DMIN.LT.NREPCUT(J2)) THEN ! terms for image J1 - non-zero derivatives only for J1
382: !     D12=DSQ0**6377: !     D12=DSQ0**6
383:       D12=DSQ0 ! this is a squared distance378:       D12=DSQ0 ! this is a squared distance
384: !     DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(12.0D0*DMIN-13.0D0*NREPCUT(J2))/INTCONST)379: !     DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(12.0D0*DMIN-13.0D0*NREPCUT(J2))/INTCONST)
385:       DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(2.0D0*DMIN-3.0D0*NREPCUT(J2))/INTCONST)380:       DUMMY=INTCONSTRAINTREP*(1.0D0/D12+(2.0D0*DMIN-3.0D0*NREPCUT(J2))/INTCONST)
386:       EREP=EREP+DUMMY381:       EREP=EREP+DUMMY
387:    ENDIF382:    ENDIF


r29792/minpermdist.f90 2016-03-16 18:33:30.543029812 +0000 r29791/minpermdist.f90 2016-03-16 18:33:33.299058138 +0000
 49: !  where +/- is given by the value of INVERT. 49: !  where +/- is given by the value of INVERT.
 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. 51: !  centre of coordinates of COORDSA will be the same as for COORDSB.
 52: ! 52: !
 53: !     ---------------------------------------------------------------------------------------------- 53: !     ----------------------------------------------------------------------------------------------
 54: ! jdf43>        Modified for generalised angle-axis 30/01/12 54: ! jdf43>        Modified for generalised angle-axis 30/01/12
 55: !     ---------------------------------------------------------------------------------------------- 55: !     ----------------------------------------------------------------------------------------------
 56:  56: 
 57: SUBROUTINE MINPERMDIST(COORDSB,COORDSA,NATOMS,DEBUG,BOXLX,BOXLY,BOXLZ,BULKT,TWOD,DISTANCE,DIST2,RIGID,RMATBEST) 57: SUBROUTINE MINPERMDIST(COORDSB,COORDSA,NATOMS,DEBUG,BOXLX,BOXLY,BOXLZ,BULKT,TWOD,DISTANCE,DIST2,RIGID,RMATBEST)
 58: USE COMMONS,ONLY : NPERMGROUP, NPERMSIZE, PERMGROUP, NSETS, SETS, CHRMMT, MYUNIT, STOCKT, NFREEZE, & 58: USE COMMONS,ONLY : NPERMGROUP, NPERMSIZE, PERMGROUP, NSETS, SETS, CHRMMT, MYUNIT, STOCKT, NFREEZE, &
 59:   & AMBERT, CSMT, PERMDIST, PULLT, EFIELDT, OHCELLT, NTSITES, GEOMDIFFTOL, QCIPERMCHECK, & 59:   & AMBERT, CSMT, PERMDIST, PULLT, EFIELDT, OHCELLT, NTSITES, GEOMDIFFTOL, &
 60:   & PERMOPT, PERMINVOPT, NOINVERSION, BESTPERM, BESTINVERT, GTHOMSONT, LOCALPERMDIST,  LPERMDIST 60:   & PERMOPT, PERMINVOPT, NOINVERSION, BESTPERM, BESTINVERT, GTHOMSONT
 61: USE PORFUNCS 61: USE PORFUNCS
 62: USE GENRIGID 62: USE GENRIGID
 63: IMPLICIT NONE 63: IMPLICIT NONE
 64:  64: 
 65: INTEGER, PARAMETER :: MAXIMUMTRIES=20 65: INTEGER, PARAMETER :: MAXIMUMTRIES=20
 66: INTEGER NATOMS, NPERM, PATOMS, NTRIES, ISTAT, OPNUM, NCHOOSEB1, NCHOOSEB2, NORBITB1, NORBITB2, I 66: INTEGER NATOMS, NPERM, PATOMS, NTRIES, ISTAT, OPNUM, NCHOOSEB1, NCHOOSEB2, NORBITB1, NORBITB2, I
 67: INTEGER J3, INVERT, NORBIT1, NORBIT2, NCHOOSE2, NDUMMY, LPERM(NATOMS), J1, J2, NCHOOSE1 67: INTEGER J3, INVERT, NORBIT1, NORBIT2, NCHOOSE2, NDUMMY, LPERM(NATOMS), J1, J2, NCHOOSE1
 68: DOUBLE PRECISION DIST2, COORDSA(3*NATOMS), COORDSB(3*NATOMS), DISTANCE, DUMMYA(3*NATOMS), DUMMYB(3*NATOMS), DUMMY(3*NATOMS) 68: DOUBLE PRECISION DIST2, COORDSA(3*NATOMS), COORDSB(3*NATOMS), DISTANCE, DUMMYA(3*NATOMS), DUMMYB(3*NATOMS), DUMMY(3*NATOMS)
 69: DOUBLE PRECISION BOXLX,BOXLY,BOXLZ,WORSTRAD,RMAT(3,3),ENERGY, VNEW(3*NATOMS), DX, DY, DZ, RMS, DBEST, XBEST(3*NATOMS) 69: DOUBLE PRECISION BOXLX,BOXLY,BOXLZ,WORSTRAD,RMAT(3,3),ENERGY, VNEW(3*NATOMS), DX, DY, DZ, RMS, DBEST, XBEST(3*NATOMS)
 70: DOUBLE PRECISION CMXA, CMXB, CMXC, PDISTANCE, CMX, CMY, CMZ 70: DOUBLE PRECISION CMXA, CMXB, CMXC, PDISTANCE, CMX, CMY, CMZ
 71: DOUBLE PRECISION ROTA(3,3), ROTINVA(3,3), ROTB(3,3), ROTINVB(3,3), ROTINVBBEST(3,3), ROTABEST(3,3), RMATBEST(3,3), TMAT(3,3) 71: DOUBLE PRECISION ROTA(3,3), ROTINVA(3,3), ROTB(3,3), ROTINVB(3,3), ROTINVBBEST(3,3), ROTABEST(3,3), RMATBEST(3,3), TMAT(3,3)
 72: DOUBLE PRECISION CMAX, CMAY, CMAZ, CMBX, CMBY, CMBZ, RMATCUMUL(3,3) 72: DOUBLE PRECISION CMAX, CMAY, CMAZ, CMBX, CMBY, CMBZ, RMATCUMUL(3,3)
 73: DOUBLE PRECISION REFXZ(3,3) 73: DOUBLE PRECISION REFXZ(3,3)
 74: LOGICAL DEBUG, TWOD, RIGID, BULKT, PITEST, LDEBUG 74: LOGICAL DEBUG, TWOD, RIGID, BULKT, PITEST
 75: DOUBLE PRECISION PDUMMYA(3*NATOMS), PDUMMYB(3*NATOMS), LDISTANCE, DUMMYC(3*NATOMS), XDUMMY 75: DOUBLE PRECISION PDUMMYA(3*NATOMS), PDUMMYB(3*NATOMS), LDISTANCE, DUMMYC(3*NATOMS), XDUMMY
 76: DOUBLE PRECISION TEMPCOORDSA(DEGFREEDOMS), TEMPCOORDSB(DEGFREEDOMS) 76: DOUBLE PRECISION TEMPCOORDSA(DEGFREEDOMS), TEMPCOORDSB(DEGFREEDOMS)
 77: DOUBLE PRECISION QBEST(4), SITESA(3*NTSITES), SITESB(3*NTSITES) 77: DOUBLE PRECISION QBEST(4), SITESA(3*NTSITES), SITESB(3*NTSITES)
 78: SAVE NORBIT1, NORBIT2 78: SAVE NORBIT1, NORBIT2
 79: INTEGER NEWPERM(NATOMS), ALLPERM(NATOMS), SAVEPERM(NATOMS) 79: INTEGER NEWPERM(NATOMS), ALLPERM(NATOMS), SAVEPERM(NATOMS)
 80: CHARACTER(LEN=5) ZSYMSAVE 80: CHARACTER(LEN=5) ZSYMSAVE
 81: COMMON /SYS/ ZSYMSAVE 81: COMMON /SYS/ ZSYMSAVE
 82:  82: 
 83: DOUBLE PRECISION :: DINV 83: DOUBLE PRECISION :: DINV
 84:  84: 
128: 128: 
129: IF (.NOT.PERMDIST) THEN129: IF (.NOT.PERMDIST) THEN
130:    IF (RIGID) THEN130:    IF (RIGID) THEN
131:       CALL RBMINDIST(COORDSB,COORDSA,NATOMS,DISTANCE,QBEST,DEBUG)131:       CALL RBMINDIST(COORDSB,COORDSA,NATOMS,DISTANCE,QBEST,DEBUG)
132:       CALL QROTMAT(QBEST,RMATBEST)132:       CALL QROTMAT(QBEST,RMATBEST)
133:    ELSE133:    ELSE
134:       CALL NEWMINDIST(COORDSB,COORDSA,NATOMS,DISTANCE,BULKT,TWOD,ZSYMSAVE,.FALSE.,RIGID,DEBUG,RMAT)134:       CALL NEWMINDIST(COORDSB,COORDSA,NATOMS,DISTANCE,BULKT,TWOD,ZSYMSAVE,.FALSE.,RIGID,DEBUG,RMAT)
135:       RMATBEST = RMAT135:       RMATBEST = RMAT
136:    ENDIF136:    ENDIF
137:    RETURN137:    RETURN
138: ELSEIF (LPERMDIST) THEN 
139:    LDEBUG=DEBUG 
140:    IF (QCIPERMCHECK) LDEBUG=.FALSE. 
141:    CALL LOPERMDIST(COORDSB,COORDSA,NATOMS,LDEBUG,BOXLX,BOXLY,BOXLZ,BULKT,TWOD,DISTANCE,DIST2,RIGID,RMATBEST) 
142:    RETURN 
143: ENDIF138: ENDIF
144: 139: 
145: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!140: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
146: ! CALL OCHARMM(DUMMYA,VNEW,ENERGY,.FALSE.,.FALSE.)141: ! CALL OCHARMM(DUMMYA,VNEW,ENERGY,.FALSE.,.FALSE.)
147: ! CALL POTENTIAL(DUMMYA,ENERGY,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)142: ! CALL POTENTIAL(DUMMYA,ENERGY,VNEW,.TRUE.,.FALSE.,RMS,.FALSE.,.FALSE.)
148: ! PRINT '(2(A,F25.15))',' Initial energy=',ENERGY,' RMS=',RMS143: ! PRINT '(2(A,F25.15))',' Initial energy=',ENERGY,' RMS=',RMS
149: ! PRINT '(2(A,F25.15))',' for coordinates:'144: ! PRINT '(2(A,F25.15))',' for coordinates:'
150: ! PRINT '(3F25.15)',DUMMYA(1:3*NATOMS)145: ! PRINT '(3F25.15)',DUMMYA(1:3*NATOMS)
151: ! PRINT '(A,F25.15,A)',' Initial energy=',ENERGY,' kcal/mol'146: ! PRINT '(A,F25.15,A)',' Initial energy=',ENERGY,' kcal/mol'
152: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!147: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!


r29792/MLP3.f90 2016-03-16 18:33:28.463008410 +0000 r29791/MLP3.f90 2016-03-16 18:33:31.319037778 +0000
  1: SUBROUTINE MLP3(X,V,ENERGY,GTEST,SECT)  1: svn: E195012: Unable to find repository location for 'svn+ssh://svn.ch.private.cam.ac.uk/groups/wales/trunk/GMIN/source/MLP3.f90' in revision 29791
  2: USE COMMONS 
  3: USE MODHESS 
  4: IMPLICIT NONE 
  5: LOGICAL GTEST,SECT 
  6: DOUBLE PRECISION X(NMLP), V(NMLP), ENERGY, DUMMY1, DUMMY2, DUMMY3, DUMMY4 
  7: DOUBLE PRECISION Y(MLPOUT), PROB(MLPOUT), PMLPOUTJ1 
  8: DOUBLE PRECISION DYW1G(MLPHIDDEN), DPCW1BG(MLPOUT,MLPHIDDEN) 
  9: DOUBLE PRECISION DYW2G(MLPOUT,MLPHIDDEN,MLPIN), DPCW2BG(MLPHIDDEN,MLPIN), TANHSUM(MLPHIDDEN), SECH2(MLPHIDDEN) 
 10: INTEGER MLPOUTJ1, MLPOFFSET 
 11: INTEGER GETUNIT, LUNIT, J1, J2, J3, J4, K4, K2, K3, J5 
 12:  
 13: ! 
 14: ! Variables are ordered  
 15: ! w^2_{jk} at (j-1)*MLPIN+k 
 16: !   up to MLPHIDDEN*MLPIN, then 
 17: ! w^1_{ij} at MLPHIDDEN*MLPIN + (i-1)*MLPHIDDEN+j 
 18: !   up to MLPHIDDEN*MLPIN + MLPOUT*MLPHIDDEN 
 19: ! 
 20:  
 21: MLPOFFSET=MLPHIDDEN*MLPIN 
 22: ENERGY=0.0D0 
 23: V(1:NMLP)=0.0D0 
 24: ! HESS(1:NMLP,1:NMLP)=0.0D0 
 25: DO J1=1,MLPDATA 
 26:    MLPOUTJ1=MLPOUTCOME(J1) 
 27:    DO J2=1,MLPHIDDEN 
 28:       DUMMY1=0.0D0 
 29:       DO J3=1,MLPIN 
 30:          DUMMY1=DUMMY1+X((J2-1)*MLPIN+J3)*MLPDAT(J1,J3) 
 31:       ENDDO 
 32:       TANHSUM(J2)=TANH(DUMMY1)  
 33:       DYW1G(J2)=TANHSUM(J2) 
 34:       SECH2(J2)=1.0D0/COSH(DUMMY1)**2  
 35:    ENDDO 
 36:    DUMMY3=0.0D0 
 37:    DO J4=1,MLPOUT 
 38:       DUMMY2=0.0D0 
 39:       DO J2=1,MLPHIDDEN 
 40:          DO J3=1,MLPIN 
 41:             DYW2G(J4,J2,J3)=X( MLPOFFSET + (J4-1)*MLPHIDDEN + J2 ) * MLPDAT(J1,J3)*SECH2(J2) 
 42:          ENDDO 
 43:          DUMMY2=DUMMY2+X(MLPOFFSET+(J4-1)*MLPHIDDEN+J2)*TANHSUM(J2) 
 44:       ENDDO 
 45:       Y(J4)=DUMMY2 
 46:       DUMMY3=DUMMY3+EXP(DUMMY2) 
 47:    ENDDO   
 48:    DO J4=1,MLPOUT 
 49:       PROB(J4)=EXP(Y(J4))/DUMMY3 
 50:    ENDDO 
 51:    PMLPOUTJ1=PROB(MLPOUTJ1) 
 52: !  IF (DEBUG) THEN 
 53: !     WRITE(MYUNIT,'(A,I8,A)') 'MLP3> data point ',J1,' outputs and probabilities:' 
 54: !     WRITE(MYUNIT,'(8G15.5)') Y(1:MLPOUT),PROB(1:MLPOUT) 
 55: !  ENDIF 
 56:    ENERGY=ENERGY-LOG(PMLPOUTJ1) 
 57:    IF (GTEST) THEN 
 58: ! 
 59: ! We only need the probability derivative for the probability corresponding to the correct outcome for this data point 
 60: ! 
 61:       DPCW1BG(1:MLPOUT,1:MLPHIDDEN)=0.0D0 
 62:       DO J2=1,MLPHIDDEN 
 63:          DO J4=1,MLPOUT 
 64:             DPCW1BG(J4,J2)=DPCW1BG(J4,J2)-PMLPOUTJ1*PROB(J4)*DYW1G(J2) 
 65:          ENDDO 
 66:          DPCW1BG(MLPOUTJ1,J2)=DPCW1BG(MLPOUTJ1,J2)+PMLPOUTJ1*DYW1G(J2) 
 67:       ENDDO 
 68:  
 69:       DO J3=1,MLPIN 
 70:          DO J2=1,MLPHIDDEN 
 71:             DUMMY3=0.0D0 
 72:             DO J4=1,MLPOUT 
 73:                DUMMY3=DUMMY3+PROB(J4)*DYW2G(J4,J2,J3) 
 74:             ENDDO 
 75:             DPCW2BG(J2,J3)=PMLPOUTJ1*(DYW2G(MLPOUTJ1,J2,J3)-DUMMY3) 
 76:          ENDDO 
 77:       ENDDO 
 78:  
 79:       DO J4=1,MLPOUT 
 80:          DO J2=1,MLPHIDDEN 
 81:             V(MLPOFFSET+(J4-1)*MLPHIDDEN+J2)=V(MLPOFFSET+(J4-1)*MLPHIDDEN+J2)-DPCW1BG(J4,J2)/PMLPOUTJ1 
 82:          ENDDO 
 83:       ENDDO 
 84:  
 85:       DO J3=1,MLPIN 
 86:          DO J2=1,MLPHIDDEN 
 87:             V((J2-1)*MLPIN+J3)=V((J2-1)*MLPIN+J3)-DPCW2BG(J2,J3)/PMLPOUTJ1 
 88:          ENDDO 
 89:       ENDDO 
 90:    ENDIF 
 91:    IF (SECT) THEN 
 92: ! 
 93: ! This block w^1 with w^1 is locally symmetric 
 94: ! 
 95:       DO J4=1,MLPOUT ! J4 is beta  
 96:          DO J2=1,MLPHIDDEN ! J2 is gamma 
 97:             DO K4=1,J4 ! K4 is alpha 
 98:                DO K2=1,MLPHIDDEN ! K2 is epsilon 
 99:                   DUMMY1=0.0D0 
100:                   IF ((J4.EQ.MLPOUTJ1).AND.(K4.EQ.MLPOUTJ1)) DUMMY1=1.0D0 
101:                   IF (J4.EQ.MLPOUTJ1) DUMMY1=DUMMY1-PROB(K4) 
102:                   IF (K4.EQ.MLPOUTJ1) DUMMY1=DUMMY1-PROB(J4) 
103:                   IF (K4.EQ.J4) DUMMY1=DUMMY1-PROB(J4) 
104:                   DUMMY1=DUMMY1+2.0D0*PROB(J4)*PROB(K4) 
105:                   HESS(MLPOFFSET+(J4-1)*MLPHIDDEN+J2,MLPOFFSET+(K4-1)*MLPHIDDEN+K2)= & 
106:   &               HESS(MLPOFFSET+(J4-1)*MLPHIDDEN+J2,MLPOFFSET+(K4-1)*MLPHIDDEN+K2) & ! sum over data points 
107:   &               +DPCW1BG(J4,J2)*DPCW1BG(K4,K2)/PMLPOUTJ1**2 & 
108:   &               -DUMMY1*TANHSUM(J2)*TANHSUM(K2) 
109:                ENDDO 
110:             ENDDO 
111:          ENDDO 
112:       ENDDO 
113:       DO J4=1,MLPOUT ! J4 is beta  
114:          DO J2=1,MLPHIDDEN ! J2 is gamma 
115:             DO K4=1,MLPOUT ! K4 is alpha 
116:                DO K2=1,MLPHIDDEN ! K2 is epsilon 
117:                ENDDO 
118:             ENDDO 
119:          ENDDO 
120:       ENDDO 
121: ! 
122: ! Off-diagonal w^1 with w^2 blocks 
123: ! 
124:       DO J3=1,MLPOUT ! J3 is beta for w^1 outputs 
125:          DO J2=1,MLPHIDDEN ! J2 is gamma for w^1 hidden 
126:             DO K4=1,MLPHIDDEN ! K4 is alpha for w^2 hidden 
127:                DUMMY3=0.0D0 
128:                DO J5=1,MLPOUT 
129:                   DUMMY3=DUMMY3+PROB(J5)*X(MLPOFFSET + (J5-1)*MLPHIDDEN + K4)  
130:                ENDDO 
131:                DO K2=1,MLPIN ! K2 is epsilon for w^2 inputs 
132:                   DUMMY1=0.0D0 
133:                   IF (K4.EQ.J2) DUMMY1=DUMMY1-PMLPOUTJ1*PROB(J3)*MLPDAT(J1,K2)*SECH2(J2) 
134:                   IF ((K4.EQ.J2).AND.(J3.EQ.MLPOUTJ1)) DUMMY1=DUMMY1+PMLPOUTJ1*MLPDAT(J1,K2)*SECH2(J2) 
135:  
136:                   DUMMY2=TANHSUM(J2)*PMLPOUTJ1*MLPDAT(J1,K2)*SECH2(K4) & 
137:   &                      *(X(MLPOFFSET+(MLPOUTJ1-1)*MLPHIDDEN+K4)-DUMMY3) 
138:                   DUMMY1=DUMMY1-PROB(J3)*DUMMY2 
139:                   IF (MLPOUTJ1.EQ.J3) DUMMY1=DUMMY1+DUMMY2 
140:                   DUMMY1=DUMMY1-PMLPOUTJ1*PROB(J3)*MLPDAT(J1,K2)*SECH2(K4)*TANHSUM(J2) & 
141:   &                             *(X(MLPOFFSET + (J3-1)*MLPHIDDEN + K4)-DUMMY3) 
142:                   HESS(MLPOFFSET+(J3-1)*MLPHIDDEN+J2,(K4-1)*MLPIN+K2)= & 
143:   &               HESS(MLPOFFSET+(J3-1)*MLPHIDDEN+J2,(K4-1)*MLPIN+K2) & ! sum over data points 
144:   &               +DPCW1BG(J3,J2)*DPCW2BG(K4,K2)/PMLPOUTJ1**2 & 
145:   &               -DUMMY1/PMLPOUTJ1 
146:                ENDDO 
147:             ENDDO 
148:          ENDDO 
149:       ENDDO 
150: ! 
151: ! diagonal w^2 with w^2  
152: ! 
153:       DO J3=1,MLPIN ! J3 is gamma for w^2 inputs 
154:          DO J2=1,MLPHIDDEN ! J2 is beta for w^2 hidden 
155:             DUMMY2=0.0D0 
156:             DO J5=1,MLPOUT 
157:                DUMMY2=DUMMY2+PROB(J5)*X(MLPOFFSET + (J5-1)*MLPHIDDEN + J2)  
158:             ENDDO 
159:             DO K4=1,MLPIN ! K4 is epsilon for w^2 inputs 
160:                DO K2=1,J2 ! K2 is alpha for w^2 hidden 
161:                   DUMMY3=0.0D0 
162:                   DO J5=1,MLPOUT 
163:                      DUMMY3=DUMMY3+PROB(J5)*X(MLPOFFSET + (J5-1)*MLPHIDDEN + K2)  
164:                   ENDDO 
165:                   DUMMY4=0.0D0 
166:                   DO J5=1,MLPOUT 
167:                      DUMMY4=DUMMY4+PROB(J5)*X(MLPOFFSET + (J5-1)*MLPHIDDEN + K2)  & ! take out of loops 
168:   &                                        *X(MLPOFFSET + (J5-1)*MLPHIDDEN + J2) 
169:                   ENDDO 
170:                   DUMMY1=DPCW2BG(K2,K4)*MLPDAT(J1,J3)*SECH2(J2) & 
171:   &                      *(X(MLPOFFSET+(MLPOUTJ1-1)*MLPHIDDEN+J2)-DUMMY2) & 
172:   &                      -PMLPOUTJ1*MLPDAT(J1,J3)*SECH2(J2)*MLPDAT(J1,K4)*SECH2(K2) & 
173:   &                      *(DUMMY4-DUMMY2*DUMMY3) 
174:                   IF (K2.EQ.J2) DUMMY1=DUMMY1-2.0D0*PMLPOUTJ1*MLPDAT(J1,K4)*MLPDAT(J1,J3) & 
175:   &                                     *SECH2(J2)*TANHSUM(J2)*(X(MLPOFFSET + (MLPOUTJ1-1)*MLPHIDDEN + J2)-DUMMY2)  
176:  
177:                   HESS((J2-1)*MLPIN+J3,(K2-1)*MLPIN+K4)= & 
178:   &               HESS((J2-1)*MLPIN+J3,(K2-1)*MLPIN+K4) & ! sum over data points 
179:   &               +DPCW2BG(J2,J3)*DPCW2BG(K2,K4)/PMLPOUTJ1**2 - DUMMY1/PMLPOUTJ1 
180:                ENDDO 
181:             ENDDO 
182:          ENDDO 
183:       ENDDO 
184:    ENDIF 
185: ENDDO 
186:  
187: DUMMY1=0.0D0 
188: DO J1=1,NMLP 
189:    DUMMY1=DUMMY1+X(J1)**2 
190: ENDDO 
191:  
192: ENERGY=ENERGY/MLPDATA + MLPLAMBDA*DUMMY1 
193: ! IF (DEBUG) WRITE(MYUNIT,'(A,G20.10)') 'MLP3> objective function=',ENERGY 
194:  
195: IF (GTEST) V(1:NMLP)=V(1:NMLP)/MLPDATA + 2.0D0*MLPLAMBDA*X(1:NMLP) 
196: ! 
197: ! Symmetrise Hessian here 
198: ! 
199: IF (SECT) HESS(1:NMLP,1:NMLP)=HESS(1:NMLP,1:NMLP)/MLPDATA 
200: IF (SECT) THEN 
201:    DO J1=1,NMLP 
202:       HESS(J1,J1)=HESS(J1,J1)+2*MLPLAMBDA 
203:       DO J2=1,J1-1 
204:          HESS(J2,J1)=HESS(J1,J2) 
205:       ENDDO 
206:    ENDDO 
207: ENDIF 
208:  
209: END SUBROUTINE MLP3 


r29792/potential.f90 2016-03-16 18:33:30.739031814 +0000 r29791/potential.f90 2016-03-16 18:33:33.515060360 +0000
285:       CALL MSC(X, GRAD, EREAL, GRADT)285:       CALL MSC(X, GRAD, EREAL, GRADT)
286: 286: 
287:    ELSE IF (ACKLANDT) THEN287:    ELSE IF (ACKLANDT) THEN
288:       CALL RAD(X, GRAD, EREAL, GRADT)288:       CALL RAD(X, GRAD, EREAL, GRADT)
289:       CALL ACK(X, GRAD, EREAL, GRADT)289:       CALL ACK(X, GRAD, EREAL, GRADT)
290: 290: 
291:    ELSE IF (FAL.OR.FNI) THEN291:    ELSE IF (FAL.OR.FNI) THEN
292:       CALL RAD(X, GRAD, EREAL, GRADT)292:       CALL RAD(X, GRAD, EREAL, GRADT)
293:       CALL FARKAS(X, GRAD, EREAL, GRADT, NATOMS)293:       CALL FARKAS(X, GRAD, EREAL, GRADT, NATOMS)
294: 294: 
295:    ELSE IF (MLP3T) THEN 
296:       CALL MLP3(X, GRAD, EREAL, GRADT, SECT) 
297: !       DIFF=1.0D-4 
298: !       WRITE(MYUNIT, *) 'analytic and numerical gradients:' 
299: !       DO J1=1, NATOMS 
300: !          X(J1)=X(J1)+DIFF 
301: !          CALL MLP3(X, GPLUS, EPLUS,.FALSE.,.FALSE.) 
302: !             WRITE(MYUNIT,'(A,I5, 2F20.10)') 'EPLUS=',J1,EPLUS 
303: !          X(J1)=X(J1)-2.0D0*DIFF 
304: !          CALL MLP3(X, GMINUS, EMINUS,.FALSE.,.FALSE.) 
305: !             WRITE(MYUNIT,'(A,I5, 2F20.10)') 'EMINUS=',J1,EMINUS 
306: !          X(J1)=X(J1)+DIFF 
307: ! !        IF ((ABS(GRAD(J1)).NE.0.0D0).AND.(100.0D0*(GRAD(J1)-(EPLUS-EMINUS)/(2.0D0*DIFF))/GRAD(J1).GT.1.0D0)) THEN 
308: !             WRITE(MYUNIT,'(A,I5, 2F20.10)') 'gtest ', J1, GRAD(J1),(EPLUS-EMINUS)/(2.0D0*DIFF) 
309: ! !        ENDIF 
310: !       ENDDO 
311:  
312:    ELSE IF (LJATT) THEN295:    ELSE IF (LJATT) THEN
313:       CALL LJ(X, GRAD, EREAL, GRADT, SECT)296:       CALL LJ(X, GRAD, EREAL, GRADT, SECT)
314:       CALL AXT(NATOMS, X, GRAD, EREAL, GRADT, ZSTAR)297:       CALL AXT(NATOMS, X, GRAD, EREAL, GRADT, ZSTAR)
315: 298: 
316:    ELSE IF (DFTBCT) THEN299:    ELSE IF (DFTBCT) THEN
317:       IF (.NOT.PERCOLATET) CALL RAD(X, GRAD, EREAL, GRADT)300:       IF (.NOT.PERCOLATET) CALL RAD(X, GRAD, EREAL, GRADT)
318:       CALL DFTBC(NATOMS, X, GRAD, EREAL, GRADT)301:       CALL DFTBC(NATOMS, X, GRAD, EREAL, GRADT)
319:       IF (FTEST) THEN302:       IF (FTEST) THEN
320:          RETURN303:          RETURN
321:       END IF304:       END IF
1263: 1246: 
1264:       IF (CSMT .AND. (.NOT.SYMMETRIZECSM)) THEN1247:       IF (CSMT .AND. (.NOT.SYMMETRIZECSM)) THEN
1265:          DUMMY2=0.0D01248:          DUMMY2=0.0D0
1266:          RMS=0.0D01249:          RMS=0.0D0
1267:       ELSE IF (AACONVERGENCET .AND. (ATOMRIGIDCOORDT)) THEN1250:       ELSE IF (AACONVERGENCET .AND. (ATOMRIGIDCOORDT)) THEN
1268:          DUMMY2=SUM(GRAD(1:DEGFREEDOMS)**2)1251:          DUMMY2=SUM(GRAD(1:DEGFREEDOMS)**2)
1269:          RMS=MAX(SQRT(DUMMY2/DEGFREEDOMS), 1.0D-100)1252:          RMS=MAX(SQRT(DUMMY2/DEGFREEDOMS), 1.0D-100)
1270:          IF (RMS < 5.0D0 * BQMAX) THEN1253:          IF (RMS < 5.0D0 * BQMAX) THEN
1271:             CALL AACONVERGENCE (GRADATOMS, XRIGIDCOORDS, XRIGIDGRAD, RMS)           1254:             CALL AACONVERGENCE (GRADATOMS, XRIGIDCOORDS, XRIGIDGRAD, RMS)           
1272:          END IF1255:          END IF
1273:       ELSE IF (MLP3T) THEN 
1274:          DUMMY2=SUM(GRAD(1:NATOMS)**2) 
1275:          RMS=MAX(DSQRT(DUMMY2/(NATOMS)), 1.0D-100) 
1276:       ELSE IF (.NOT.THOMSONT) THEN1256:       ELSE IF (.NOT.THOMSONT) THEN
1277:          DUMMY2=SUM(GRAD(1:3*NATOMS)**2)1257:          DUMMY2=SUM(GRAD(1:3*NATOMS)**2)
1278:          RMS=MAX(DSQRT(DUMMY2/(3*NATOMS)), 1.0D-100)1258:          RMS=MAX(DSQRT(DUMMY2/(3*NATOMS)), 1.0D-100)
1279:       ELSE1259:       ELSE
1280:          DUMMY2=SUM(GRAD(1:2*NATOMS)**2)1260:          DUMMY2=SUM(GRAD(1:2*NATOMS)**2)
1281:          RMS=MAX(DSQRT(DUMMY2/(2*NATOMS)), 1.0D-100)1261:          RMS=MAX(DSQRT(DUMMY2/(2*NATOMS)), 1.0D-100)
1282:       END IF1262:       END IF
1283:       IF(DEBUG.AND.(RMS.NE.RMS)) THEN1263:       IF(DEBUG.AND.(RMS.NE.RMS)) THEN
1284:          WRITE(MYUNIT,'(A)' ) 'potential> WARNING - RMS force is NaN - if using AMBER igb=1, can be due to negative Born radii'1264:          WRITE(MYUNIT,'(A)' ) 'potential> WARNING - RMS force is NaN - if using AMBER igb=1, can be due to negative Born radii'
1285:       END IF1265:       END IF


r29792/quench.F 2016-03-16 18:33:30.935033830 +0000 r29791/quench.F 2016-03-16 18:33:33.711062375 +0000
 21: !  CFLAG convergence test 21: !  CFLAG convergence test
 22: !  CTEST checks for changes in chirality for AMBER runs 22: !  CTEST checks for changes in chirality for AMBER runs
 23: ! 23: !
 24:       SUBROUTINE QUENCH(QTEST,NP,ITER,TIME,BRUN,QDONE,P) 24:       SUBROUTINE QUENCH(QTEST,NP,ITER,TIME,BRUN,QDONE,P)
 25:       USE MODHESS   25:       USE MODHESS  
 26: #ifdef __SPARSE 26: #ifdef __SPARSE
 27:       USE MODSPARSEHESS 27:       USE MODSPARSEHESS
 28:       USE SHIFT_HESS 28:       USE SHIFT_HESS
 29:       USE INERTIA_MOD 29:       USE INERTIA_MOD
 30: #endif /* __SPARSE */ 30: #endif /* __SPARSE */
 31:       USE COMMONS 31:       use COMMONS
 32:       USE MODAMBER9, ONLY : cisarray1, cisarray2, chiarray1, chiarray2, dihedralsave, atomindex, exclude, 32:       USE MODAMBER9, ONLY : cisarray1, cisarray2, chiarray1, chiarray2, dihedralsave, atomindex, exclude,
 33:      &                      setchiral, setchiralgeneric, nocistransdna, nocistransrna 33:      &                      setchiral, setchiralgeneric, nocistransdna, nocistransrna
 34:       USE QMODULE 34:       USE QMODULE
 35:       use porfuncs 35:       use porfuncs
 36:       USE CHIRALITY, ONLY: CIS_TRANS_CHECK, CHIRALITY_CHECK 36:       USE CHIRALITY, ONLY: CIS_TRANS_CHECK, CHIRALITY_CHECK
 37:       IMPLICIT NONE 37:       IMPLICIT NONE
 38:  38: 
 39:       INTEGER I, J1, NSQSTEPS, NP, IFLAG, ITER, NOPT, J2, NDUMMY, CSMIT, J5, NUM_ZERO_EVS, HORDER, NMOL 39:       INTEGER I, J1, NSQSTEPS, NP, IFLAG, ITER, NOPT, J2, NDUMMY, CSMIT, J5, NUM_ZERO_EVS, HORDER, NMOL
 40:       DOUBLE PRECISION P(3*NATOMS),POTEL,TIME,EREAL,RBCOORDS(18),TMPCOORDS(3*NATOMS), DIST, QE, QX, AVVAL, CSMRMS 40:       DOUBLE PRECISION P(3*NATOMS),POTEL,TIME,EREAL,RBCOORDS(18),TMPCOORDS(3*NATOMS), DIST, QE, QX, AVVAL, CSMRMS
 41:       LOGICAL QTEST, CFLAG, RES, COMPON, EVAPREJECT, EVAP, PASS, FAIL 41:       LOGICAL QTEST, CFLAG, RES, COMPON, EVAPREJECT, EVAP, PASS, FAIL
108:       IF (DFTBCT.AND.LJATT) GUIDET=.TRUE.108:       IF (DFTBCT.AND.LJATT) GUIDET=.TRUE.
109:       IF (DFTBCT.AND.GUIDET) THEN109:       IF (DFTBCT.AND.GUIDET) THEN
110:          LJATT=.TRUE.110:          LJATT=.TRUE.
111:          IF (DEBUG) WRITE(MYUNIT,'(A)') 'quench> Turning on LJAT guiding potential and rescaling coordinates'111:          IF (DEBUG) WRITE(MYUNIT,'(A)') 'quench> Turning on LJAT guiding potential and rescaling coordinates'
112:          COORDS(1:3*NATOMS,NP)=COORDS(1:3*NATOMS,NP)/LJATTOC112:          COORDS(1:3*NATOMS,NP)=COORDS(1:3*NATOMS,NP)/LJATTOC
113:       ENDIF113:       ENDIF
114:       IF (CSMGUIDET) CSMDOGUIDET=.TRUE.114:       IF (CSMGUIDET) CSMDOGUIDET=.TRUE.
115:       NOPT=3*NATOMS115:       NOPT=3*NATOMS
116:       IF (WENZEL) NOPT=2116:       IF (WENZEL) NOPT=2
117:       IF (MULLERBROWNT) NOPT=2117:       IF (MULLERBROWNT) NOPT=2
118:       IF (MLP3T) NOPT=NMLP 
119: !118: !
120: !  QTEST is set for the final quenches with tighter convergence criteria.119: !  QTEST is set for the final quenches with tighter convergence criteria.
121: !120: !
122:       IF (QTEST) THEN121:       IF (QTEST) THEN
123:          GMAX=CQMAX122:          GMAX=CQMAX
124:       ELSE123:       ELSE
125:          GMAX=BQMAX124:          GMAX=BQMAX
126:       ENDIF125:       ENDIF
127: 126: 
128:       QDONE=0127:       QDONE=0


r29792/takestep.f 2016-03-16 18:33:31.127035805 +0000 r29791/takestep.f 2016-03-16 18:33:33.919064514 +0000
 62: ! 62: !
 63: !  Calling CENTRE if NORESET is .TRUE. can lead to problems with COORDSO containing an atom 63: !  Calling CENTRE if NORESET is .TRUE. can lead to problems with COORDSO containing an atom
 64: !  outside the permitted radius. Then it may be impossible to take a step that keeps all the 64: !  outside the permitted radius. Then it may be impossible to take a step that keeps all the
 65: !  atoms inside. 65: !  atoms inside.
 66: ! 66: !
 67:       PISQ = PI*PI 67:       PISQ = PI*PI
 68:       NTRIESMAX=100 68:       NTRIESMAX=100
 69:  69: 
 70: !     IF (CENT.AND.(.NOT.SEEDT)) CALL CENTRE2(COORDS(1:3*NATOMS,NP)) ! COORDS might have been shifted by symmetry 70: !     IF (CENT.AND.(.NOT.SEEDT)) CALL CENTRE2(COORDS(1:3*NATOMS,NP)) ! COORDS might have been shifted by symmetry
 71:       IF ((.NOT.NORESET).AND.(.NOT.PERMOPT).AND.(.NOT.DIFFRACTT).AND.(.NOT.BLNT).AND.(.NOT.PERIODIC)  71:       IF ((.NOT.NORESET).AND.(.NOT.PERMOPT).AND.(.NOT.DIFFRACTT).AND.(.NOT.BLNT).AND.(.NOT.PERIODIC) 
 72:      &                  .AND.(.NOT.PERMINVOPT).AND.(.NOT.QCIPOTT).AND.(.NOT.MLP3T) 72:      &                  .AND.(.NOT.PERMINVOPT).AND.(.NOT.QCIPOTT)
 73:      &     .AND.(.NOT.GAUSST).AND.(.NOT.(CSMT.AND.(.NOT.SYMMETRIZECSM))).AND.(.NOT.PERCOLATET)) THEN 73:      &     .AND.(.NOT.GAUSST).AND.(.NOT.(CSMT.AND.(.NOT.SYMMETRIZECSM))).AND.(.NOT.PERCOLATET)) THEN
 74: ! 74: !
 75: !        csw34> CHECK NOTHING HAS MOVED OUTSIDE THE CONTAINER RADIUS  75: !        csw34> CHECK NOTHING HAS MOVED OUTSIDE THE CONTAINER RADIUS 
 76: ! 76: !
 77:          DO J1=1,NATOMS 77:          DO J1=1,NATOMS
 78:             IF ((.NOT.RIGID).OR.(J1.LE.NATOMS/2)) THEN 78:             IF ((.NOT.RIGID).OR.(J1.LE.NATOMS/2)) THEN
 79:                J2=3*J1 79:                J2=3*J1
 80:                DUMMY2=COORDS(J2-2,NP)**2+COORDS(J2-1,NP)**2+COORDS(J2,NP)**2 80:                DUMMY2=COORDS(J2-2,NP)**2+COORDS(J2-1,NP)**2+COORDS(J2,NP)**2
 81:                IF (DUMMY2.GT.RADIUS) THEN 81:                IF (DUMMY2.GT.RADIUS) THEN
 82:                   IF (AMBERT) THEN ! jmc49 We don't really want a container at all in amber9, but this bit of code is being used  82:                   IF (AMBERT) THEN ! jmc49 We don't really want a container at all in amber9, but this bit of code is being used 
397:          ENDIF397:          ENDIF
398: !398: !
399: !  Angular move block.399: !  Angular move block.
400: !  If NORESET is .TRUE. then VAT won;t be set, so we should skip this block.400: !  If NORESET is .TRUE. then VAT won;t be set, so we should skip this block.
401: !401: !
402: !        IF (J1.EQ.JMAX) WRITE(MYUNIT,'(A,I6,4F15.5)') 'JMAX,VAT,ASTEP(NP),VMIN,prod=',JMAX,VAT(J1,NP), 402: !        IF (J1.EQ.JMAX) WRITE(MYUNIT,'(A,I6,4F15.5)') 'JMAX,VAT,ASTEP(NP),VMIN,prod=',JMAX,VAT(J1,NP), 
403: !    &                                    ASTEP(NP),VMIN,ASTEP(NP)*VMIN403: !    &                                    ASTEP(NP),VMIN,ASTEP(NP)*VMIN
404:          IF (((VAT(J1,NP).GT.ASTEP(NP)*VMIN).AND.(J1.EQ.JMAX)).AND.(.NOT.BLNT).AND.!(.NOT.RIGID).AND.404:          IF (((VAT(J1,NP).GT.ASTEP(NP)*VMIN).AND.(J1.EQ.JMAX)).AND.(.NOT.BLNT).AND.!(.NOT.RIGID).AND.
405:      &         (.NOT.DIFFRACTT).AND.(.NOT.GAUSST).AND.(.NOT.PERCOLATET) 405:      &         (.NOT.DIFFRACTT).AND.(.NOT.GAUSST).AND.(.NOT.PERCOLATET) 
406:      &        .AND.(.NOT.NORESET).AND.(.NOT.PERIODIC).AND.(.NOT.THOMSONT).AND.(.NOT.ONEDAPBCT).AND.(.NOT.ONEDPBCT)406:      &        .AND.(.NOT.NORESET).AND.(.NOT.PERIODIC).AND.(.NOT.THOMSONT).AND.(.NOT.ONEDAPBCT).AND.(.NOT.ONEDPBCT)
407:      &        .AND.(.NOT.TWODPBCT).AND.(.NOT.THREEDAPBCT).AND.(.NOT.THREEDPBCT).AND.(.NOT.QCIPOTT).AND.(.NOT.MLP3T)407:      &        .AND.(.NOT.TWODPBCT).AND.(.NOT.THREEDAPBCT).AND.(.NOT.THREEDPBCT).AND.(.NOT.QCIPOTT)
408:      &        .AND.(.NOT.TWODAPBCT).AND.(.NOT.((NCORE(NP).GT.0).AND.(J1.GT.NATOMS-NCORE(NP))))) THEN408:      &        .AND.(.NOT.TWODAPBCT).AND.(.NOT.((NCORE(NP).GT.0).AND.(J1.GT.NATOMS-NCORE(NP))))) THEN
409: 409: 
410:             IF (DEBUG) WRITE(MYUNIT,'(A,I4,A,F12.4,A,F12.4,A,I4,A,F12.4)') 'angular move for atom ',J1, 410:             IF (DEBUG) WRITE(MYUNIT,'(A,I4,A,F12.4,A,F12.4,A,I4,A,F12.4)') 'angular move for atom ',J1, 
411:      &           ' V=',VMAX,' Vmin=',VMIN,' next most weakly bound atom is ',JMAX2,' V=',VMAX2411:      &           ' V=',VMAX,' Vmin=',VMIN,' next most weakly bound atom is ',JMAX2,' V=',VMAX2
412: 412: 
413:            THETA=DPRAND()*PI413:            THETA=DPRAND()*PI
414:            PHI=DPRAND()*PI*2.0D0414:            PHI=DPRAND()*PI*2.0D0
415: !415: !
416: !  Evaporation is judged from the origin, not the centre of mass. We don't want the416: !  Evaporation is judged from the origin, not the centre of mass. We don't want the
417: !  angular move to cause evaporation. Obviously this will cause problems if we have a cluster that drifts417: !  angular move to cause evaporation. Obviously this will cause problems if we have a cluster that drifts
588:               RANDOM=(DPRAND()-0.5D0)*2.0D0588:               RANDOM=(DPRAND()-0.5D0)*2.0D0
589: !             COORDS(J2-1,NP)=COORDS(J2-1,NP)+LOCALSTEP*RANDOM*CMDIST(J1)/CMMAX589: !             COORDS(J2-1,NP)=COORDS(J2-1,NP)+LOCALSTEP*RANDOM*CMDIST(J1)/CMMAX
590:               COORDS(J2-1,NP)=COORDS(J2-1,NP)+LOCALSTEP*RANDOM*DUMMY590:               COORDS(J2-1,NP)=COORDS(J2-1,NP)+LOCALSTEP*RANDOM*DUMMY
591:               RANDOM=(DPRAND()-0.5D0)*2.0D0591:               RANDOM=(DPRAND()-0.5D0)*2.0D0
592: !             COORDS(J2,NP)=COORDS(J2,NP)+LOCALSTEP*RANDOM*CMDIST(J1)/CMMAX592: !             COORDS(J2,NP)=COORDS(J2,NP)+LOCALSTEP*RANDOM*CMDIST(J1)/CMMAX
593:               IF (.NOT.TWOD) COORDS(J2,NP)=COORDS(J2,NP)+LOCALSTEP*RANDOM*DUMMY593:               IF (.NOT.TWOD) COORDS(J2,NP)=COORDS(J2,NP)+LOCALSTEP*RANDOM*DUMMY
594:            ENDIF594:            ENDIF
595: !595: !
596: ! Stop atoms leaving the container in this step596: ! Stop atoms leaving the container in this step
597: !597: !
598:            IF ((.NOT.PERIODIC).AND.(.NOT.AMBERT).AND.(.NOT.(RIGID.AND.((J1.GT.NATOMS/2)))).AND.(.NOT.BLNT).AND.(.NOT.MLP3T)598:            IF ((.NOT.PERIODIC).AND.(.NOT.AMBERT).AND.(.NOT.(RIGID.AND.((J1.GT.NATOMS/2)))).AND.(.NOT.BLNT)
599:      1     .AND.(.NOT.PERCOLATET).AND.(.NOT.DIFFRACTT).AND.(.NOT.THOMSONT).AND.(.NOT.GAUSST).AND.(.NOT.QCIPOTT)) THEN599:      1     .AND.(.NOT.PERCOLATET).AND.(.NOT.DIFFRACTT).AND.(.NOT.THOMSONT).AND.(.NOT.GAUSST).AND.(.NOT.QCIPOTT)) THEN
600: !          IF ((.NOT.PERIODIC).AND.(.NOT.AMBER).AND.(.NOT.(RIGID.AND.(LOCALSTEP.EQ.0.0D0))).AND.(.NOT.BLNT)) THEN600: !          IF ((.NOT.PERIODIC).AND.(.NOT.AMBER).AND.(.NOT.(RIGID.AND.(LOCALSTEP.EQ.0.0D0))).AND.(.NOT.BLNT)) THEN
601:               DUMMY=COORDS(J2-2,NP)**2+COORDS(J2-1,NP)**2+COORDS(J2,NP)**2601:               DUMMY=COORDS(J2-2,NP)**2+COORDS(J2-1,NP)**2+COORDS(J2,NP)**2
602: !602: !
603: !  Simply rescaling the radius of an atom that leaves the container will bias the sampling603: !  Simply rescaling the radius of an atom that leaves the container will bias the sampling
604: !  of configuration space. However, we are not using takestep for bspt thermodynamic sampling!604: !  of configuration space. However, we are not using takestep for bspt thermodynamic sampling!
605: !  So, put the atom back in the container on the other side!605: !  So, put the atom back in the container on the other side!
606: !606: !
607: !              IF (DUMMY.GT.RADIUS) THEN607: !              IF (DUMMY.GT.RADIUS) THEN
608: !                 COORDS(J2-2,NP)=(SQRT(RADIUS)-0.5D0)*COORDS(J2-2,NP)/SQRT(DUMMY)608: !                 COORDS(J2-2,NP)=(SQRT(RADIUS)-0.5D0)*COORDS(J2-2,NP)/SQRT(DUMMY)


legend
Lines Added 
Lines changed
 Lines Removed

hdiff - version: 2.1.0