stepper now converges based on gradient maximum

This commit is contained in:
Michel Dupuis 1998-04-21 06:57:32 +00:00
parent f6b5dd768a
commit adbb248cb7
12 changed files with 132 additions and 85 deletions

View file

@ -1,5 +1,5 @@
subroutine stepper_input(rtdb)
C $Id: stepper_inp.F,v 1.3 1997-02-25 23:24:22 d3e129 Exp $
C $Id: stepper_inp.F,v 1.4 1998-04-21 06:57:24 mdupuis Exp $
implicit none
#include "rtdb.fh"
#include "mafdecls.fh"
@ -33,8 +33,9 @@ c [rconvg real] convergence for reaction path
c [setmass
c int,real (number of atoms [maximum])
c endsetmass] atomic number and atomic mass
c [convgg real] gradient convergence tolerance
c [convge real] energy convergence tolerance
c [convggm real] maximum gradient convergence tolerance
c [convgg real] gradient norme convergence tolerance
c [convge real] energy convergence tolerance
c [maxiter int] maximun number of geometry steps
c [fdat] generate finite difference hessian at current
c geometry using fd basis
@ -54,7 +55,7 @@ c::local
integer hsel, ksel, hm, km, him, kim
integer nmode, nat, maxiter
double precision rconvg, rstd, trustc, trustm, trust
double precision convgg, convge
double precision convggm, convgg, convge
character*255 stpr_token
c
if (nodeid() .ne. 0) return
@ -78,7 +79,7 @@ c set defaults
c
call stpr_set_defaults(omin,ts,std,trot,trtr,mwc,seco,swfir,
& swsec,rstd,trustc,trustm,trust,nmode,track,rpath,rconvg,
& setm,convgg,convge, maxiter)
& setm,convggm,convgg,convge, maxiter)
c
1 continue
if( inp_cur_field() .lt. inp_n_field() ) then
@ -199,6 +200,10 @@ c
if(.not.MA_Pop_Stack(him))
& call errquit
& ('stepper_input: error freeing int setmass',911)
else if(inp_compare(FF,'convggm',stpr_token)) then
if(.not.inp_f(convggm))
& call errquit
& ('stepper_input: error parsing value of convggm',911)
else if(inp_compare(FF,'convgg',stpr_token)) then
if(.not.inp_f(convgg))
& call errquit
@ -217,7 +222,7 @@ c
c
call stpr_store_rtdb(rtdb,omin,ts,std,trot,trtr,mwc,seco,swfir,
& swsec,track,rpath,setm,oselect,osetmass,nmode,rconvg, rstd,
& trustc, trustm, trust, convgg, convge,maxiter)
& trustc, trustm, trust, convggm, convgg, convge,maxiter)
c
return
end

View file

@ -1,14 +1,16 @@
SUBROUTINE stpr_cheker(
& ENERGY,EOLD,E2OLD,EDIFF,GLNGTH,ERATIO,
& CONVGE, CONVGG,
& ENERGY,EOLD,E2OLD,EDIFF,
& GMXMUM,GLNGTH,ERATIO,
& CONVGE, CONVGG, CONVGGM,
& TRUSTI,TRUST,TRUSTO,SOLD,NNEG,NWALK,
& BCKSTP,CNVGRD)
c $Id: stpr_cheker.F,v 1.6 1996-10-22 23:05:20 d3h449 Exp $
c $Id: stpr_cheker.F,v 1.7 1998-04-21 06:57:26 mdupuis Exp $
IMPLICIT REAL*8(A-H,O-Z), INTEGER(I-N)
LOGICAL BCKSTP,CNVGRD
#include "chow.fh"
COMMON / CFACE / IWCTR,NATOM,ICALC
COMMON / DIMS / NAT3, NAT3SQ, NAT3TR
C
IF (MWC) THEN
CONVGG=1.0D-08
ENDIF
@ -55,8 +57,14 @@ C 1. Structure of HESS (proper number of negative eigenvalues),
C 2. Energy convergence, and
C 3. Gradient convergence.
C
write(6,9875)
write(6,9876) ediff,glngth,gmxmum
write(6,9876) convge,convgg,convggm
9875 format(' e-diff ',' g-norm ',' g-max ')
9876 format(f20.10,f10.6,f10.6)
IF((NNEG.EQ.0.AND..NOT.TS).OR.(NNEG.EQ.1.AND.TS))THEN
IF(ABS(EDIFF).LT.CONVGE.AND.GLNGTH.LT.CONVGG)THEN
IF(ABS(EDIFF).LT.CONVGE.AND.GLNGTH.LT.CONVGG
& .AND.GMXMUM.LT.CONVGGM)THEN
WRITE(6,*)' ENERGY = ',ENERGY
WRITE(6,*)' The hessian exhibits the "proper" '
WRITE(6,*)' structure, and the gradient and energy '
@ -70,7 +78,8 @@ C
CNVGRD = .FALSE.
ENDIF
ELSE
IF(ABS(EDIFF).LT.CONVGE.AND.GLNGTH.LT.CONVGG)THEN
IF(ABS(EDIFF).LT.CONVGE.AND.GLNGTH.LT.CONVGG
& .AND.GMXMUM.LT.CONVGGM)THEN
WRITE(6,*)' ENERGY = ',ENERGY
WRITE(6,*)' The gradient and energy convergence '
WRITE(6,*)' criterion has been met, BUT the hessian '
@ -113,7 +122,8 @@ C
C Special Case: If on initial iteration there are no
C significant forces then stop.
C
IF(NWALK.EQ.1.AND.GLNGTH.LT.CONVGG)THEN
IF(NWALK.EQ.1.AND.GLNGTH.LT.CONVGG
& .AND.GMXMUM.LT.CONVGGM)THEN
WRITE(6,*)' >>> W A R N I N G W A R N I N G <<< '
WRITE(6,*)' >>> Negligible gradient on first',
& ' iteration. <<< '

View file

@ -4,9 +4,9 @@
& CHARGE, SELECT, SCRSYM, SCRSQ,
& VECSQ, ATMASS, P, HMP,
& CMASS, TENIN, ENERGY, E2NEW, TRUST,
& CONVGE, CONVGG,
& CONVGE, CONVGG, CONVGGM,
& NMODE, TRACK, RPATH, BCKSTP, CNVGRD, rtdb )
c $Id: stpr_driver.F,v 1.10 1998-03-13 01:28:15 d3g681 Exp $
c $Id: stpr_driver.F,v 1.11 1998-04-21 06:57:26 mdupuis Exp $
IMPLICIT REAL*8(A-H,O-Z), INTEGER(I-N)
LOGICAL TRACK,BCKSTP,CNVGRD,RPATH
#include "chow.fh"
@ -66,7 +66,7 @@ C
$ HESS, GRAD, COORD, HIEIGS, GISR, VC, SCRSYM,
& SCRSQ, VECSQ, STEP, SELECT, P, HMP,
& ATMASS, CMASS, TENIN, ENERGY,
& CONVGE, CONVGG,
& CONVGE, CONVGG, CONVGGM,
& NINTER, NMODE, RPATH, TRACK, BCKSTP)
* write(6,*)' step after partit '
* do jjjj = 1,nat3
@ -74,7 +74,7 @@ C
* enddo
IF(NINTER.NE.0)THEN
CALL stpr_mkstep(HIEIGS,GISR,VC,STEP,SELECT,SCRSQ,ATMASS,ENERGY,
& CONVGE, CONVGG,
& CONVGE, CONVGG, CONVGGM, GRAD_MAX,
& E2NEW,NINTER,NAT3,NMODE,TRUST,BCKSTP,CNVGRD,
& rtdb)
* write(6,*)' step after mkstep '
@ -86,7 +86,8 @@ C
WRITE(6,*)' ENERGY = ',ENERGY
ENDIF
IF (.NOT.CNVGRD) THEN
CALL stpr_output(STEP,COORD,BCKSTP, grad_max)
CALL stpr_output(STEP,COORD,BCKSTP, grad_max,
& CONVGGM, CONVGG, CONVGE )
ELSE
c
c Write out useful hessian info:

View file

@ -13,11 +13,12 @@ c
end
SUBROUTINE stpr_face (
& HESS, GRAD, COORD, CHARGE, SELECT, ATMASS,
& AMS, G, C, ETOT, TRUST, ENERGY, CONVGE,
& CONVGG, NATD, NMODE,
& AMS, G, C, ETOT, TRUST,
& ENERGY, CONVGE, CONVGG, CONVGGM,
& NATD, NMODE,
& TRACK, BCKSTP, RPATH , rtdb, step_number)
c
c $Id: stpr_face.F,v 1.13 1997-05-14 01:16:06 d3g681 Exp $
c $Id: stpr_face.F,v 1.14 1998-04-21 06:57:27 mdupuis Exp $
c
IMPLICIT REAL*8(A-H,O-Z), INTEGER(I-N)
#include "util.fh"
@ -69,17 +70,18 @@ C
osetmass = .false.
call stpr_set_defaults(OMIN,TS,STD,TROT,TRTR,MWC,SECO,SWFIR,
& SWSEC,RSTD,TRUSTC,TRUSTM,TRUST,NMODE,TRACK,RPATH,RCONVG,
& SETM,convgg,convge,maxiter)
& SETM,convggm,convgg,convge,maxiter)
call stpr_load_rtdb(rtdb,omin,ts,std,trot,trtr,mwc,seco, swfir,
& swsec,track,rpath,setm,oselect,osetmass,nmode,rconvg,rstd,
& trustc, trustm, trust, convgg, convge, maxiter)
& trustc, trustm, trust, convggm, convgg, convge, maxiter)
c
if (oselect) then
call stpr_select_grtdb(natom,rtdb,select)
endif
c
if(convgg.eq.0.0d0)CONVGG=1.0D-4
if(convge.eq.0.0d0)CONVGE=1.0D-8
if(convggm.eq.0.0d0) CONVGGM=8.0D-4
if(convgg .eq.0.0d0) CONVGG =1.0D-2
if(convge .eq.0.0d0) CONVGE =1.0D-4
AMUAU = (1.6605656D0/9.109534D0)*1.0D+04
if (osetmass) then
write(6,*)' atomic number and masses read '
@ -383,14 +385,14 @@ C
END
subroutine stpr_set_defaults(OMIN,TS,STD,TROT,TRTR,MWC,SECO,
& SWFIR,SWSEC,RSTD,TRUSTC,TRUSTM,TRUST,NMODE,TRACK,RPATH,
& RCONVG,SETM,CONVGG,CONVGE,maxiter)
& RCONVG,SETM,CONVGGM,CONVGG,CONVGE,maxiter)
c
implicit none
logical omin, ts, std, trot, trtr, mwc, seco, swfir, swsec
logical track, rpath, setm
integer nmode, maxiter
double precision rconvg, rstd, trustc, trustm, trust
double precision convgg, convge
double precision convggm, convgg, convge
c
OMIN = .TRUE.
TS = .FALSE.
@ -413,6 +415,7 @@ c
TRUSTC = 0.1D+00
TRUSTM = 5.0D+00
TRUST = 0.0D+00
convggm= 0.0d+00
convgg = 0.0d+00
convge = 0.0d+00
c
@ -475,7 +478,7 @@ c
subroutine stpr_store_rtdb(rtdb,omin,ts,std,trot,trtr,mwc,seco,
& swfir,
& swsec,track,rpath,setm,oselect,osetmass,nmode,rconvg, rstd,
& trustc, trustm, trust, convgg, convge, maxiter)
& trustc, trustm, trust, convggm, convgg, convge, maxiter)
implicit none
#include "mafdecls.fh"
#include "rtdb.fh"
@ -487,7 +490,7 @@ c::passed
logical rpath, setm, oselect, osetmass
integer nmode, maxiter
double precision rconvg, rstd, trustc, trustm, trust
double precision convgg, convge
double precision convggm, convgg, convge
c::local
integer hlog,klog, hdbl,kdbl, hint, kint
c
@ -529,6 +532,7 @@ c
dbl_mb((kdbl + 4)) = trust
dbl_mb((kdbl + 5)) = convgg
dbl_mb((kdbl + 6)) = convge
dbl_mb((kdbl + 7)) = convggm
c
if (.not.rtdb_put
& (rtdb,'stepper:logicalvals',MT_LOG,ns_log,log_mb(klog)))
@ -575,7 +579,7 @@ c
subroutine stpr_load_rtdb(rtdb,omin,ts,std,trot,trtr,mwc,seco,
& swfir,
& swsec,track,rpath,setm,oselect,osetmass,nmode,rconvg, rstd,
& trustc, trustm, trust, convgg, convge, maxiter)
& trustc, trustm, trust, convggm, convgg, convge, maxiter)
implicit none
#include "mafdecls.fh"
#include "rtdb.fh"
@ -587,7 +591,7 @@ c::passed
logical rpath, setm, oselect, osetmass
integer nmode, maxiter
double precision rconvg, rstd, trustc, trustm, trust
double precision convgg, convge
double precision convggm, convgg, convge
c::local
logical status
integer hlog,klog, hdbl,kdbl
@ -670,6 +674,7 @@ c
trust = dbl_mb((kdbl + 4))
convgg = dbl_mb((kdbl + 5))
convge = dbl_mb((kdbl + 6))
convggm= dbl_mb((kdbl + 7))
c
c.... free heap memory
if(.not.MA_free_heap(hdbl))

View file

@ -1,7 +1,7 @@
c
integer ns_log, ns_int, ns_dbl
C$Id: stpr_inP.fh,v 1.3 1995-02-02 23:23:03 d3g681 Exp $
C$Id: stpr_inP.fh,v 1.4 1998-04-21 06:57:28 mdupuis Exp $
parameter (ns_log = 14)
parameter (ns_int = 2)
parameter (ns_dbl = 7)
parameter (ns_dbl = 8)
c

View file

@ -1,9 +1,9 @@
SUBROUTINE stpr_mkstep(
& HIEIGS,GISR,VC,STEP,SELECT,SCRVEC,ATMASS,
& ENERGY, CONVGE, CONVGG,
& ENERGY, CONVGE, CONVGG, CONVGGM, GRAD_MAX,
& E2NEW,NINTER,NAT3,NMODE,TRUSTI,BCKSTP,
& CNVGRD,rtdb)
c $Id: stpr_mkstep.F,v 1.6 1998-03-13 01:28:16 d3g681 Exp $
c $Id: stpr_mkstep.F,v 1.7 1998-04-21 06:57:28 mdupuis Exp $
IMPLICIT REAL*8(A-H,O-Z), INTEGER(I-N)
LOGICAL BCKSTP,CNVGRD,LPRINT, oprint, oprint_step
#include "chow.fh"
@ -52,6 +52,10 @@ C
10 CONTINUE
GLNGTH = SQRT(GLNGTH)
C
C gradient maximum
C
GMXMUM = GRAD_MAX
C
C Count the number of negative eigenvalues.
C
NNEG = 0
@ -64,10 +68,11 @@ C
C Check whether convergence has been reached.
C Also set any TRUST info.
C
CALL stpr_cheker(ENERGY,EOLD,E2OLD,EDIFF,GLNGTH,ERATIO,
& CONVGE, CONVGG,
& TRUSTI,TRUST,TRUSTO,SOLD,NNEG,NWALK,
& BCKSTP,CNVGRD)
CALL stpr_cheker(ENERGY,EOLD,E2OLD,EDIFF,
& GMXMUM,GLNGTH,ERATIO,
& CONVGE, CONVGG, CONVGGM,
& TRUSTI,TRUST,TRUSTO,SOLD,NNEG,NWALK,
& BCKSTP,CNVGRD)
C
C Make the steepest descent step if appropriate
C
@ -394,7 +399,7 @@ c
C
C Put step parameters to save common and write them to tape 41.
C
CALL stpr_putp(GLNGTH,SLNGTH,EOLD,ENERGY,
CALL stpr_putp(GMXMUM,GLNGTH,SLNGTH,EOLD,ENERGY,
& EDIFF,E2OLD,ERATIO,TRUSTO,TRUST,TRUSTN,
& E2NEW,NWALK,NNEG)
RETURN

View file

@ -1,5 +1,6 @@
SUBROUTINE stpr_output(STEP,COORD,BCKSTP, mxgrad)
c $Id: stpr_output.F,v 1.9 1998-01-09 15:25:37 d3e129 Exp $
SUBROUTINE stpr_output(STEP,COORD,BCKSTP, mxgrad,
& convggm, convgg, convge )
c $Id: stpr_output.F,v 1.10 1998-04-21 06:57:29 mdupuis Exp $
IMPLICIT REAL*8(A-H,O-Z), INTEGER(I-N)
#include "util.fh"
#include "mafdecls.fh"
@ -9,12 +10,13 @@ c $Id: stpr_output.F,v 1.9 1998-01-09 15:25:37 d3e129 Exp $
COMMON / DIMS / NAT3, NAT3SQ, NAT3TR
COMMON / SWITCH / SECO, SWSEC, SWFIR
double precision mxgrad, grad_max, grad_norm, stepmax, stepnorm
double precision convggm, convgg, convge
DIMENSION STEP(NAT3),
& COORD(3,NATOM)
c
oprint_info = util_print('information',print_default)
c
CALL stpr_getp(GLNGTH,SLNGTH,EOLD,ENERGY,
CALL stpr_getp(GMXMUM,GLNGTH,SLNGTH,EOLD,ENERGY,
& EDIFF,E2OLD,ERATIO,TRUSTO,TRUST,TRUSTN,
& E2NEW,NWALK,NNEG)
c
@ -44,7 +46,7 @@ C initial geometry
WRITE(6,1000)iwctr
WRITE(6,1006)EOLD
WRITE(6,1007)ENERGY
WRITE(6,1008)EDIFF
WRITE(6,1008)EDIFF,CONVGE
WRITE(6,1009)E2OLD
WRITE(6,1010)ERATIO
IF(BCKSTP)THEN
@ -53,8 +55,8 @@ C initial geometry
WRITE(6,1011)TRUSTO
ENDIF
WRITE(6,1001)NNEG
write(6,1032)mxgrad
WRITE(6,1002)GLNGTH
write(6,1032)mxgrad,convggm
WRITE(6,1002)GLNGTH,convgg
endif
GLNGTH = GLNGTH/SQRT(DBLE(NATOM))
if (oprint_info) then
@ -87,15 +89,18 @@ C
RETURN
1000 FORMAT(' Walk statistics for step: ',I3)
1001 FORMAT(' Number of negative eigenvalues: ',I3)
1002 FORMAT(' Gradient norm: ',D20.12)
1002 FORMAT(' Gradient norm: ',D20.12,
& ' threshold: ',d20.6)
1022 FORMAT(' RMS Gradient norm: ',D20.12)
1032 FORMAT(' Max absolute value of Gradient: ',D20.12)
1032 FORMAT(' Max absolute value of Gradient: ',D20.12,
& ' threshold: ',d20.6)
1003 FORMAT(' Value of lambda: ',D20.12)
1004 FORMAT(' Value of scale factor A: ',D20.12)
1005 FORMAT(' Largest component of step v-tor: ',D20.12)
1006 FORMAT(' Previous actual total energy: ',D20.12)
1007 FORMAT(' Current actual total energy: ',D20.12)
1008 FORMAT(' Actual energy difference: ',D20.12)
1008 FORMAT(' Actual energy difference: ',D20.12,
& ' threshold: ',d20.6)
1009 FORMAT(' Second order energy predicted: ',D20.12)
1010 FORMAT(' Ratio of differences: ',D20.12)
1011 FORMAT(' Fixed trust radius: ',D20.12)

View file

@ -2,9 +2,9 @@
& HESS, GRAD, COORD, HIEIGS, GISR, VC, SCRSYM,
& SCRSQ, VECSQ, STEP, SELECT, P, HMP,
& ATMASS, CMASS, TENIN, ENERGY,
& CONVGE, CONVGG,
& CONVGE, CONVGG, CONVGGM,
& NINTER, NMODE, RPATH, TRACK, BCKSTP)
c $Id: stpr_partit.F,v 1.7 1998-03-13 01:28:16 d3g681 Exp $
c $Id: stpr_partit.F,v 1.8 1998-04-21 06:57:29 mdupuis Exp $
c
IMPLICIT REAL*8(A-H,O-Z), INTEGER(I-N)
LOGICAL TRACK, BCKSTP, RPATH, TROUB
@ -423,8 +423,10 @@ C
C Form the internal gradient in the spectral representation.
C
GLNGTH = 0.0D0
GMXMUM = 0.0D0
DO 320 I = 1,NINTER
GLNGTH = GLNGTH + GRAD(I)**2
IF(ABS(GRAD(I)).GT.GMXMUM) GMXMUM=ABS(GRAD(I))
GISR(I) = 0.0D0
DO 310 J = 1,NINTER
GISR(I) = GISR(I) + SCRSQ(J,I)*GRAD(J)

View file

@ -1,5 +1,5 @@
SUBROUTINE stpr_SAVE(HESS,GRAD,COORD,ENERGY,IERR)
c $Id: stpr_save.F,v 1.4 1997-03-04 06:07:53 d3e129 Exp $
c $Id: stpr_save.F,v 1.5 1998-04-21 06:57:30 mdupuis Exp $
IMPLICIT REAL*8(A-H,O-Z), INTEGER(I-N)
LOGICAL SECO, SWSEC, SWFIR
COMMON / STAPES / ITAP05, ITAP06, ITAP41,
@ -115,7 +115,7 @@ C
IERR = 1
RETURN
end
subroutine stpr_PUTP(GLNGTH,SLNGTH,EOLD,ENERGY,
subroutine stpr_PUTP(GMXMUM,GLNGTH,SLNGTH,EOLD,ENERGY,
& EDIFF,E2OLD,ERATIO,TRUSTO,TRUST,TRUSTN,
& E2NEW,NWALK,NNEG)
* ENTRY stpr_PUTP(GLNGTH,SLNGTH,EOLD,ENERGY,
@ -127,15 +127,16 @@ C
COMMON / PARAM / PSTEPP(20)
#include "cstprfiles.fh"
C
C PSTEPP(2) and PSTEPP(3) currently not used.
C PSTEPP(3) currently not used.
C
PSTEPP(1) = GLNGTH
PSTEPP(4) = SLNGTH
PSTEPP(5) = EOLD
PSTEPP(6) = ENERGY
PSTEPP(7) = EDIFF
PSTEPP(8) = E2OLD
PSTEPP(9) = ERATIO
PSTEPP(1) = GLNGTH
PSTEPP(2) = GMXMUM
PSTEPP(4) = SLNGTH
PSTEPP(5) = EOLD
PSTEPP(6) = ENERGY
PSTEPP(7) = EDIFF
PSTEPP(8) = E2OLD
PSTEPP(9) = ERATIO
PSTEPP(10) = TRUSTO
PSTEPP(11) = TRUST
PSTEPP(12) = TRUSTN
@ -161,10 +162,10 @@ C
#endif
RETURN
end
subroutine stpr_GETP(GLNGTH,SLNGTH,EOLD,ENERGY,
subroutine stpr_GETP(GMXMUM,GLNGTH,SLNGTH,EOLD,ENERGY,
& EDIFF,E2OLD,ERATIO,TRUSTO,TRUST,TRUSTN,
& E2NEW,NWALK,NNEG)
* ENTRY stpr_GETP(GLNGTH,SLNGTH,EOLD,ENERGY,
* ENTRY stpr_GETP(GMXMUM,GLNGTH,SLNGTH,EOLD,ENERGY,
* & EDIFF,E2OLD,ERATIO,TRUSTO,TRUST,TRUSTN,
* & E2NEW,NWALK,NNEG)
IMPLICIT REAL*8(A-H,O-Z), INTEGER(I-N)
@ -189,22 +190,23 @@ C
#endif
ENDIF
C
C PSTEPP(2) and PSTEPP(3) currently not used.
C PSTEPP(3) currently not used.
C
GLNGTH = PSTEPP(1)
GMXMUM = PSTEPP(2)
SLNGTH = PSTEPP(4)
EOLD = PSTEPP(5)
EOLD = PSTEPP(5)
ENERGY = PSTEPP(6)
EDIFF = PSTEPP(7)
E2OLD = PSTEPP(8)
EDIFF = PSTEPP(7)
E2OLD = PSTEPP(8)
ERATIO = PSTEPP(9)
TRUSTO = PSTEPP(10)
TRUST = PSTEPP(11)
TRUST = PSTEPP(11)
TRUSTN = PSTEPP(12)
E2NEW = PSTEPP(13)
E2NEW = PSTEPP(13)
#if defined(CRAY) || defined(KSR)
NWALK = NINT(PSTEPP(14))
NNEG = NINT(PSTEPP(15))
NWALK = NINT(PSTEPP(14))
NNEG = NINT(PSTEPP(15))
#else
NWALK = IDNINT(PSTEPP(14))
NNEG = IDNINT(PSTEPP(15))

View file

@ -1,11 +1,13 @@
SUBROUTINE stpr_stepcor(A,INEED,G,C,ETOT,NATD,CONVGE,CONVGG,
SUBROUTINE stpr_stepcor(A,INEED,G,C,ETOT,NATD,
& CONVGE,CONVGG,CONVGGM,
& cnvgrd, rtdb, step_number)
c $Id: stpr_stepcor.F,v 1.5 1996-07-17 16:36:49 d3g681 Exp $
c $Id: stpr_stepcor.F,v 1.6 1998-04-21 06:57:31 mdupuis Exp $
IMPLICIT REAL*8(A-H,O-Z), INTEGER(I-N)
#include "util.fh"
#include "cstprfiles.fh"
integer rtdb
integer step_number
logical dbug
LOGICAL TRACK,RPATH,BCKSTP,CNVGRD
LOGICAL SECO, SWSEC, SWFIR
COMMON / STAPES / ITAP05, ITAP06, ITAP41,
@ -20,6 +22,8 @@ c $Id: stpr_stepcor.F,v 1.5 1996-07-17 16:36:49 d3g681 Exp $
DIMENSION C(3,NATD)
DIMENSION A(INEED)
DIMENSION IPT(25)
C
dbug=.false.
C
C Open input/output files.
C
@ -79,13 +83,19 @@ C Get user input: TRUST,NMODE,TRACK,
C SELECT, RPATH, STD, etc, and equivalence data coming
C in from NWCHEM to data locations required by STEPPER.
C
* grad_max = dabsmax(natd*3,g)
* write(6,*)' grad max in stepcor ',grad_max
if(dbug) then
grad_max = dabsmax(natd*3,g)
write(6,*)' grad max in stepcor ',grad_max
endif
CALL stpr_face
& ( A(IPT( 1)), A(IPT( 2)), A(IPT( 5)), A(IPT( 9)),
& A(IPT(11)), A(IPT(15)), A(IPT(16)),
& G, C, ETOT, TRUST, ENERGY, CONVGE, CONVGG,
& G, C, ETOT, TRUST, ENERGY, CONVGE, CONVGG, CONVGGM,
& NATD, NMODE, TRACK, BCKSTP, RPATH , rtdb, step_number)
if(dbug) then
grad_max = dabsmax(natd*3,g)
write(6,*)' grad max in stepcor ',grad_max
endif
C
C If analytical hessian is unavailable form update hessian.
C
@ -103,7 +113,7 @@ C
& A(IPT( 9)), A(IPT(10)), A(IPT(11)), A(IPT(12)),
& A(IPT(13)), A(IPT(14)), A(IPT(16)), A(IPT(17)),
& A(IPT(18)), A(IPT(19)), ENERGY, E2NEW, TRUST,
& CONVGE, CONVGG,
& CONVGE, CONVGG, CONVGGM,
& NMODE, TRACK, RPATH, BCKSTP, CNVGRD, rtdb )
C
C Switch between first and second derivatives.

View file

@ -1,6 +1,7 @@
SUBROUTINE stpr_stepper(A,ILEFT,G,C,ETOT,NATD,CONVGE,CONVGG,
SUBROUTINE stpr_stepper(A,ILEFT,G,C,ETOT,NATD,
& CONVGE,CONVGG,CONVGGM,
& converged, rtdb, step_number)
c $Id: stpr_stepper.f,v 1.4 1995-03-31 01:45:42 d3g681 Exp $
c $Id: stpr_stepper.f,v 1.5 1998-04-21 06:57:31 mdupuis Exp $
IMPLICIT REAL*8(A-H,O-Z), INTEGER(I-N)
integer rtdb
integer step_number
@ -20,8 +21,8 @@ C
* ' MORE WORDS!'
stop
ELSE
CALL stpr_stepcor(A,INEED,G,C,ETOT,NATD,CONVGE,CONVGG,converged,
& rtdb, step_number)
CALL stpr_stepcor(A,INEED,G,C,ETOT,NATD,CONVGE,CONVGG,CONVGGM,
& converged,rtdb, step_number)
ENDIF
RETURN
END

View file

@ -1,5 +1,5 @@
integer function stpr_walk(rtdb)
c $Id: stpr_walk.F,v 1.32 1998-01-09 15:25:38 d3e129 Exp $
c $Id: stpr_walk.F,v 1.33 1998-04-21 06:57:32 mdupuis Exp $
implicit none
c
#include "mafdecls.fh"
@ -37,7 +37,7 @@ c
logical o_timewalk, okeepgeom
logical status
logical lstpr_walk
double precision convgg, convge
double precision convggm, convgg, convge
#include "cstprfiles.fh"
integer first_call, step_number, astep_number
data first_call /0/
@ -139,14 +139,15 @@ c.....get coordinates
c
c... take a step
c
convgg = 1.0d-04
convge = 1.0d-07
convggm= 8.0d-04
convgg = 1.0d-02
convge = 1.0d-04
call stpr_stepper(
& dbl_mb(k_core),
& needed,
& dbl_mb(k_grad),
& dbl_mb(k_coord),
& energy,nat,convge,convgg,lstpr_walk,
& energy,nat,convge,convgg,convggm,lstpr_walk,
& rtdb,step_number)
c.....set coordinates
if (.not. geom_cart_set(geom,nat,