1C 2C $Id$ 3C 4 subroutine hess_restart(rtdb, restr) 5c 6c Write information to the database for restart and also put the 7c hessian and fock derivatives out to disk. Before putting the 8c hessian out to disk, we will do a global summation to make sure 9c that we get all of the contributions out to disk. Dividing by 10c the number of processors will prepare the hessian for the next 11c contribution. 12c 13 implicit none 14#include "errquit.fh" 15c 16#include "global.fh" 17#include "hess_info.fh" 18#include "mafdecls.fh" 19#include "msgids.fh" 20#include "rtdb.fh" 21#include "stdio.fh" 22#include "util.fh" 23c 24 integer rtdb ! [input] Run-time database handle 25 integer restr ! [input] level of calculation completed 26 ! 1 = 1 e-; 2 = 2 e- 27c 28 integer ind, idens, irhs 29 integer ilo(3), ihi(3) 30 double precision dnrm 31c 32 logical oprint, olprint 33 logical ocphfprint, olcphfprint 34c 35 call ga_dgop(msg_hess_exy,dbl_mb(k_exy),n3xyz2,'+') 36c 37c Print out if requested 38c 39 oprint = util_print('hess_follow',print_high) 40 olprint = (oprint.and.(ga_nodeid().eq.0)) 41 ocphfprint = util_print('hess_cont',print_debug) 42 olcphfprint = (oprint.and.(ga_nodeid().eq.0)) 43c 44 if (olprint) then 45 write(LuOut,*) 46 write(LuOut,*) 'The Hessian after contributions:',restr 47 call hess_hssout(dbl_mb(k_exy),n3xyz,n3xyz,n3xyz) 48 endif 49 if (ocphfprint) then 50 if (olcphfprint) then 51 write(LuOut,*) 52 write(LuOut,*) 'The Fock derivatives :' 53 call util_flush(LuOut) 54 endif 55 ind = 0 56 do idens = 1, ndens 57 do irhs = 1, n3xyz 58 ind = ind + 1 59 ilo(1) = ind 60 ilo(2) = 1 61 ilo(3) = 1 62 ihi(1) = ind 63 ihi(2) = nocc(idens)+nvirt(idens) 64 ihi(3) = nocc(idens)+nvirt(idens) 65 call nga_print_patch(g_rhs,ilo,ihi,1) 66 enddo 67 enddo 68 endif 69 if (oprint) then 70 if (olprint) then 71 write(LuOut,*) 72 write(LuOut,*) 'The Fock derivatives :' 73 endif 74 ind = 0 75 do idens = 1, ndens 76 do irhs = 1, n3xyz 77 ind = ind + 1 78 ilo(1) = ind 79 ilo(2) = 1 80 ilo(3) = 1 81 ihi(1) = ind 82 ihi(2) = nocc(idens)+nvirt(idens) 83 ihi(3) = nocc(idens)+nvirt(idens) 84 call nga_normf_patch(g_rhs,ilo,ihi,dnrm) 85 if (olprint) then 86 write(LuOut,'(a,": dFock =",i2,i4,f24.8)') 87 + 'hess_restart', 88 + idens,irhs,dnrm 89 endif 90 enddo 91 enddo 92 endif 93c 94c Write hessian out to disk 95c 96 if(ga_nodeid().eq.0) then 97 call hess_wrt() 98 endif 99c 100c Scale for next step 101c 102 call dscal(n3xyz2,1.0d+00/ga_nnodes(),dbl_mb(k_exy),1) 103c 104c Write out fock derivatives to disk 105c 106c call sx_write(g_rhs,n3xyz*ndens,nbf,fx_dra_handle) 107c 108c Write out restr to the database 109c 110c if (.not. rtdb_put(rtdb, 'hess:restart',mt_int,1,restr)) 111c $ call errquit('hess_restart: could not save restr to rtdb', 112c $ 555, RTDB_ERR) 113c 114 return 115 end 116C 117 subroutine hess_getrestart(irestart) 118c 119c Get hessian and fock derivatives from disk. After getting the 120c hessian from disk, we will divide the hessian by the number of 121c processors to prepare for the next contribution. 122c 123 implicit none 124#include "errquit.fh" 125c 126#include "global.fh" 127#include "tcgmsg.fh" 128#include "hess_info.fh" 129#include "msgtypesf.h" 130#include "mafdecls.fh" 131#include "msgids.fh" 132#include "stdio.fh" 133#include "util.fh" 134c 135 integer irestart ! [input] restart index 136c 137 integer i, ind, idens, irhs 138 integer ilo(3), ihi(3) 139 double precision dnrm 140 logical oprint, olprint, ocphfprint, olcphfprint 141c 142 oprint = util_print('hess_follow',print_high) 143 olprint = (oprint.and.(ga_nodeid().eq.0)) 144 ocphfprint = util_print('hess_cont',print_debug) 145 olcphfprint = (oprint.and.(ga_nodeid().eq.0)) 146c 147 if (ga_nodeid().eq.0) then 148 write(LuOut,*) 149 write(LuOut,*) 'Getting restart information' 150 write(LuOut,*) 151 endif 152c 153c Read hessian and dipole derivative from disk and broadcast 154c 155 if(ga_nodeid().eq.0) then 156 call hess_read(ncent, dbl_mb(k_exy)) 157 call ddip_read(ncent, dbl_mb(k_dder)) 158 endif 159 call ga_brdcst(msg_hess_exy+MSGDBL, dbl_mb(k_exy), 160 & mdtob(n3xyz2), 0) 161 call ga_brdcst(msg_hess_ddip+MSGDBL, dbl_mb(k_dder), 162 & mdtob(3*n3xyz),0) 163c 164c Read Fock derivatives from disk 165c 166 call sx_read(g_rhs,n3xyz*ndens,nbf,fx_dra_handle) 167c 168c Print out if requested 169c 170 if (olprint) then 171 write(LuOut,*) 172 write(LuOut,*) 'The Hessian at restart:' 173 call hess_hssout(dbl_mb(k_exy),n3xyz,n3xyz,n3xyz) 174 endif 175 if (ocphfprint) then 176 if (olcphfprint) then 177 write(LuOut,*) 178 write(LuOut,*) 'The Fock derivatives :' 179 call util_flush(LuOut) 180 endif 181 ind = 0 182 do idens = 1, ndens 183 do irhs = 1, n3xyz 184 ind = ind + 1 185 ilo(1) = ind 186 ilo(2) = 1 187 ilo(3) = 1 188 ihi(1) = ind 189 ihi(2) = nocc(idens)+nvirt(idens) 190 ihi(3) = nocc(idens)+nvirt(idens) 191 call nga_print_patch(g_rhs,ilo,ihi,1) 192 enddo 193 enddo 194 endif 195 if (oprint) then 196 if (olprint) then 197 write(LuOut,*) 198 write(LuOut,*) 'The Fock derivatives :' 199 endif 200 ind = 0 201 do idens = 1, ndens 202 do irhs = 1, n3xyz 203 ind = ind + 1 204 ilo(1) = ind 205 ilo(2) = 1 206 ilo(3) = 1 207 ihi(1) = ind 208 ihi(2) = nocc(idens)+nvirt(idens) 209 ihi(3) = nocc(idens)+nvirt(idens) 210 call nga_normf_patch(g_rhs,ilo,ihi,dnrm) 211 if (olprint) then 212 write(LuOut,'(a,": dFock =",i2,i4,f24.8)') 213 + 'hess_restart', 214 + idens,irhs,dnrm 215 endif 216 enddo 217 enddo 218 endif 219c 220c Scale for next step 221c 222 call dscal(n3xyz2,1.0d+00/ga_nnodes(),dbl_mb(k_exy),1) 223 call dscal(n3xyz*3,1.0d+00/ga_nnodes(),dbl_mb(k_dder),1) 224c 225c Get rid of density allocation if we are done with the 2e- contribution 226c 227cng if (irestart.ge.2) then 228 do i = 1, ndens 229 if (.not.ga_destroy(g_dens(i))) 230 & call errquit('hess_getrestart: failed to delete density',i, 231 & GA_ERR) 232 enddo 233 if (.not.ga_destroy(g_rhs_xc)) 234 & call errquit('hess_getrestart: failed to delete g_rhs_xc', 235 & 555, GA_ERR) 236 if (.not.ga_destroy(g_wdens)) 237 & call errquit('hess_getrestart: failed to delete wdensity', 238 & 555, GA_ERR) 239 call schwarz_tidy() 240 call intdd_terminate() 241cng endif 242c 243 return 244 end 245