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