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