1*
2* $Id$
3*
4      subroutine dplot_iteration_init()
5      implicit none
6#include "errquit.fh"
7
8#include "bafdecls.fh"
9#include "btdb.fh"
10
11*     **** dplot_iteration_block ****
12      logical exist
13      integer iteration(2),iteration_count
14      common / dplot_iteration_Block / iteration,iteration_count,exist
15
16*     **** local variables ****
17      integer    rtdb,ma_type
18
19*     **** external functions ****
20      integer  control_rtdb
21      external control_rtdb
22
23      rtdb = control_rtdb()
24
25*     **** get dplot_iteration_lists have been imposed
26      if (rtdb_ma_get(rtdb, 'pspw_dplot:iteration_list', ma_type,
27     >        iteration_count, iteration(2))) then
28        exist = .true.
29
30         if (.not.BA_get_index(iteration(2),iteration(1)))
31     >      call errquit(
32     >       'pspw_dplot_iteration_init: ma_get_index failed',0, MA_ERR)
33      else
34        exist = .false.
35      end if
36      return
37      end
38
39
40      subroutine dplot_iteration_end()
41      implicit none
42#include "errquit.fh"
43
44#include "bafdecls.fh"
45
46*     **** dplot_iteration_block ****
47      logical exist
48      integer iteration(2),iteration_count
49      common / dplot_iteration_Block / iteration,iteration_count,exist
50
51      if (exist) then
52
53*        **** free heap ****
54         if (.not. BA_free_heap(iteration(2))) then
55            call errquit('dplot_iteration_end:freeing heap',0, MA_ERR)
56         end if
57
58      end if
59
60      return
61      end
62
63
64
65      logical function dplot_iteration_check(it)
66      implicit none
67      integer it
68
69#include "bafdecls.fh"
70
71*     **** dplot_iteration_block ****
72      logical exist
73      integer iteration(2),iteration_count
74      common / dplot_iteration_Block / iteration,iteration_count,exist
75
76*     **** local variables ****
77      logical value
78      integer ii
79
80
81      value = .false.
82
83      if (exist) then
84
85         ii=1
86         do while ((ii.le.iteration_count).and.(.not.value))
87           if (it.eq.int_mb(iteration(1)+ii-1)) value = .true.
88           ii = ii + 1
89         end do
90
91      end if
92
93      dplot_iteration_check = value
94      return
95      end
96
97      subroutine dplot_iteration(it,ispin,ne,psi,dn,psi_r)
98      implicit none
99      integer    it
100      integer    ispin,ne(2)
101      complex*16 psi(*)
102      real*8     dn(*)
103      real*8     psi_r(*)
104
105#include "bafdecls.fh"
106#include "btdb.fh"
107
108*     **** local variables ****
109      integer nfft3d,npack1,nemax,rtdb
110      character*8 tag
111
112*     **** external functions ****
113      integer  control_rtdb
114      external control_rtdb
115
116c
117      if      (it .lt. 10) then
118         write(tag,'(I1)') it
119      else if (it .lt. 100) then
120         write(tag,'(I2)') it
121      else if (it .lt. 1000) then
122         write(tag,'(I3)') it
123      else if (it .lt. 10000) then
124         write(tag,'(I4)') it
125      else if (it .lt. 100000) then
126         write(tag,'(I5)') it
127      else
128         write(tag,'(I6)') it
129      end if
130
131
132      call D3dB_nfft3d(1,nfft3d)
133      call Pack_npack(1,npack1)
134      nemax = ne(1)+ne(2)
135      rtdb  = control_rtdb()
136
137      call dplot_loop(rtdb,
138     >                ispin,ne,
139     >                npack1,nfft3d,nemax,
140     >                psi,dn,psi_r,
141     >                .true.,tag)
142
143      return
144      end
145