1c----------------------------------------------------------------------- 2c 3 subroutine wfn1_print_wave(wfn1_wave) 4 implicit none 5c 6#include "wfn1_wfn.fh" 7#include "global.fh" 8#include "stdio.fh" 9c 10 type(wfn1_wfn), intent(in) :: wfn1_wave ! The wavefunction 11c 12 integer iproc ! the process rank 13 integer nproc ! the number of process ranks 14c 15 nproc = ga_nnodes() 16 iproc = ga_nodeid() 17c 18 if (iproc.eq.0) then 19 write(LuOut,'(" The alpha natural orbitals")') 20 write(LuOut,'(" --------------------------")') 21 write(LuOut,*) 22 endif 23 call ga_print(wfn1_wave%g_na) 24 if (iproc.eq.0) then 25 write(LuOut,*) 26 write(LuOut,'(" The beta natural orbitals")') 27 write(LuOut,'(" -------------------------")') 28 write(LuOut,*) 29 endif 30 call ga_print(wfn1_wave%g_nb) 31 if (iproc.eq.0) then 32 write(LuOut,*) 33 write(LuOut,'(" The alpha correlation functions")') 34 write(LuOut,'(" -------------------------------")') 35 write(LuOut,*) 36 endif 37 call ga_print(wfn1_wave%g_ca) 38 if (iproc.eq.0) then 39 write(LuOut,*) 40 write(LuOut,'(" The beta correlation functions")') 41 write(LuOut,'(" ------------------------------")') 42 write(LuOut,*) 43 endif 44 call ga_print(wfn1_wave%g_cb) 45c 46 end subroutine wfn1_print_wave 47c 48c----------------------------------------------------------------------- 49c 50 subroutine wfn1_print_deriv(wfn1_deriv) 51 implicit none 52c 53#include "wfn1_drv.fh" 54#include "global.fh" 55#include "stdio.fh" 56c 57 type(wfn1_drv), intent(in) :: wfn1_deriv ! The derivative 58c 59 integer iproc ! the process rank 60 integer nproc ! the number of process ranks 61c 62 nproc = ga_nnodes() 63 iproc = ga_nodeid() 64c 65 if (iproc.eq.0) then 66 write(LuOut,'(" The alpha natural orbital derivatives")') 67 write(LuOut,'(" -------------------------------------")') 68 write(LuOut,*) 69 endif 70 call ga_print(wfn1_deriv%g_dna) 71 if (iproc.eq.0) then 72 write(LuOut,*) 73 write(LuOut,'(" The beta natural orbitals derivatives")') 74 write(LuOut,'(" -------------------------------------")') 75 write(LuOut,*) 76 endif 77 call ga_print(wfn1_deriv%g_dnb) 78 if (iproc.eq.0) then 79 write(LuOut,*) 80 write(LuOut,'(" The alpha correlation function derivatives")') 81 write(LuOut,'(" ------------------------------------------")') 82 write(LuOut,*) 83 endif 84 call ga_print(wfn1_deriv%g_dca) 85 if (iproc.eq.0) then 86 write(LuOut,*) 87 write(LuOut,'(" The beta correlation function derivatives")') 88 write(LuOut,'(" -----------------------------------------")') 89 write(LuOut,*) 90 endif 91 call ga_print(wfn1_deriv%g_dcb) 92c 93 end subroutine wfn1_print_deriv 94c 95c----------------------------------------------------------------------- 96c 97 subroutine wfn1_print_energy(wfn1_energy) 98 implicit none 99#include "wfn1_en.fh" 100#include "global.fh" 101#include "stdio.fh" 102 type(wfn1_en), intent(in) :: wfn1_energy 103 integer iproc 104 integer nproc 105c 106 iproc = ga_nodeid() 107 nproc = ga_nnodes() 108c 109 if (iproc.eq.0) then 110 write(LuOut,'(" WFN1 :")') 111 write(LuOut,'(" --------------------------")') 112 write(LuOut,'(" Total WFN1 energy = ",f22.10)')wfn1_energy%E_tot 113 write(LuOut,'(" 1-Electron energy = ",f22.10)')wfn1_energy%E_1el 114 write(LuOut,'(" 2-Electron energy = ",f22.10)')wfn1_energy%E_2el 115 write(LuOut,'(" Entropy energy = ",f22.10)')wfn1_energy%E_ent 116 write(LuOut,'(" Nuclear energy = ",f22.10)')wfn1_energy%E_nuc 117 write(LuOut,*) 118 write(LuOut,'(" conventional Hartree-Fock:")') 119 write(LuOut,'(" --------------------------")') 120 write(LuOut,'(" Total SCF energy = ",f22.10)') 121 & wfn1_energy%E_tot-wfn1_energy%E_2el+wfn1_energy%E_2el_hf 122 write(LuOut,'(" 2-Electron energy = ",f22.10)') 123 & wfn1_energy%E_2el_hf 124 endif 125c 126 end subroutine wfn1_print_energy 127c 128c----------------------------------------------------------------------- 129c 130 subroutine wfn1_print_error(wfn1_err) 131 implicit none 132#include "wfn1_error.fh" 133#include "global.fh" 134#include "stdio.fh" 135 type(wfn1_error), intent(in) :: wfn1_err 136 integer :: iproc 137 integer :: nproc 138c 139 iproc = ga_nodeid() 140 nproc = ga_nnodes() 141c 142 if (iproc.eq.0) then 143 write(LuOut,'(" Tot:",f16.6," Na:",e16.6," Nb:",e16.6, 144 & " Ca:",e16.6," Cb:",e16.6)') 145 & wfn1_err%total,wfn1_err%errna,wfn1_err%errnb,wfn1_err%errca, 146 & wfn1_err%errcb 147 endif 148c 149 end subroutine wfn1_print_error 150c 151c----------------------------------------------------------------------- 152c 153 subroutine wfn1_print_mat(dmat,nr,nc) 154 implicit none 155c 156c A simple serial matrix print routine 157c 158#include "global.fh" 159#include "stdio.fh" 160c 161 integer, intent(in) :: nr ! the number of rows 162 integer, intent(in) :: nc ! the number of columns 163c 164 double precision, intent(in) :: dmat(nr,nc) 165c 166 integer :: ir, ic, kk ! counters 167 integer :: iproc, nproc 168c 169 integer, parameter :: mxc = 8 ! the maximum number of columns 170 ! printed at a time 171c 172 iproc = ga_nodeid() 173 nproc = ga_nnodes() 174 if (iproc.eq.0) then 175c 176 do ic = 1, nc, mxc 177 write(LuOut,*) 178 write(LuOut,'(5x,$)') 179 do kk = ic, min(ic+mxc-1,nc) 180 write(LuOut,'(i12,$)')kk 181 enddo 182 write(LuOut,*) 183 write(LuOut,*) 184 do ir = 1, nr 185 write(LuOut,'(i4,$)')ir 186 do kk = ic, min(ic+mxc-1,nc) 187 write(LuOut,'(f12.6,$)')dmat(ir,kk) 188 enddo 189 write(LuOut,*) 190 enddo 191 enddo 192c 193 endif 194c 195 end subroutine wfn1_print_mat 196c 197c----------------------------------------------------------------------- 198