1C 2C $Id$ 3C 4 subroutine hess_tidy() 5c 6c This routine cleans up any of the memory that was used and any 7c other details that need to be taken care of. 8c 9 implicit none 10#include "errquit.fh" 11c 12#include "dra.fh" 13#include "global.fh" 14#include "hess_info.fh" 15#include "mafdecls.fh" 16#include "geom.fh" 17#include "rtdb.fh" 18#include "bas.fh" 19c 20c get rid of geometry and basis set handles and associated memory 21c 22 if (.not. geom_destroy(geom)) 23 * call errquit('hess_tidy: geom_destroy problem', 555, GEOM_ERR) 24 if (.not. bas_destroy(basis)) 25 * call errquit('hess_tidy: bas_destroy problem', 555, BASIS_ERR) 26c 27c get rid of local memory for the nuclear hessian Exy 28c 29 if (.not.ma_pop_stack(l_act)) 30 * call errquit('hess_tidy: cannot deallocate oactive',555, 31 & MA_ERR) 32 if (.not.ma_pop_stack(l_dder)) 33 * call errquit('hess_tidy: cannot deallocate hess_dder',555, 34 & MA_ERR) 35 if (.not.ma_pop_stack(l_hess_xc)) 36 * call errquit('hess_tidy: cannot deallocate hess_xc',555, 37 & MA_ERR) 38 if (.not.ma_pop_stack(l_exy)) 39 * call errquit('hess_tidy: cannot deallocate Exy',555, 40 & MA_ERR) 41c 42c Get rid of temporary DRAs and terminate DRA interface 43c 44c if (dra_delete(fx_dra_handle).ne.0) call errquit 45c * ('hess_tidy: unable to delete the fx DRA',555, UNKNOWN_ERR) 46c if (dra_delete(sx_dra_handle).ne.0) call errquit 47c * ('hess_tidy: unable to delete the sx DRA',555, UNKNOWN_ERR) 48c if (dra_terminate().ne.0) call errquit 49c * ('hess_tidy: unable to terminate DRA interface',555, 50c & UNKNOWN_ERR) 51c 52c 53 return 54 end 55c 56 subroutine hess_energytidy(rtdb) 57 implicit none 58#include "errquit.fh" 59#include "geom.fh" 60#include "hess_info.fh" 61#include "mafdecls.fh" 62#include "rtdb.fh" 63c 64c This routine sets the rtdb up the way it was before entering the 65c Hessian code. 66c 67 integer rtdb 68c 69 if (.not.geom_rtdb_store(rtdb,geomold,'geometry')) 70 $ call errquit('hess_energytidy: geom_rtdb_store failed',555, 71 & RTDB_ERR) 72 if (.not.geom_destroy(geomold)) 73 $ call errquit('hess_energytidy: geom_destroy failed',555, 74 & GEOM_ERR) 75 if (theory.eq.'scf') then 76 if (.not. rtdb_put(rtdb, 'scf:thresh', MT_DBL, 1, tthresh)) 77 $ call errquit('hess_energytidy: rtdb_put failed',tthresh, 78 & RTDB_ERR) 79 else 80 if (.not. rtdb_put(rtdb, 'dft:g_conv', MT_DBL, 1, tthresh)) 81 $ call errquit('hess_energytidy: rtdb_put failed',tthresh, 82 & RTDB_ERR) 83 endif 84c 85 return 86 end 87 88