TABLE OF CONTENTS
ABINIT/prtocc [ Functions ]
NAME
prtocc
FUNCTION
Print the content of occ. Due to the need to distinguish between different k-points and different spin polarisations, prttagm.f cannot be used. So, need a dedicated routine.
COPYRIGHT
Copyright (C) 1999-2018 ABINIT group (XG) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt . For the initials of contributors, see ~abinit/doc/developers/contributors.txt .
INPUTS
dtsets(0:ndtset_alloc)=<type datafiles_type>contains all input variables iout=unit number for echoed output jdtset_(0:ndtset_alloc)=list of dataset indices. ndtset_alloc=govern second dimension of intarr and dprarr prtvol_glob= if 0, minimal output volume, if 1, no restriction. results_out(0:ndtset_alloc)=<type results_out_type>contains the results needed for outvars, including occ, an evolving variable
OUTPUT
(only writing)
PARENTS
outvar_o_z
CHILDREN
appdig
SOURCE
40 #if defined HAVE_CONFIG_H 41 #include "config.h" 42 #endif 43 44 #include "abi_common.h" 45 46 47 subroutine prtocc(dtsets,iout,jdtset_,ndtset_alloc,prtvol_glob,results_out) 48 49 use defs_basis 50 use defs_abitypes 51 use m_errors 52 use m_profiling_abi 53 use m_results_out 54 55 !This section has been created automatically by the script Abilint (TD). 56 !Do not modify the following lines by hand. 57 #undef ABI_FUNC 58 #define ABI_FUNC 'prtocc' 59 use interfaces_32_util 60 !End of the abilint section 61 62 implicit none 63 64 !Arguments ------------------------------------ 65 !scalars 66 integer,intent(in) :: iout,ndtset_alloc,prtvol_glob 67 !arrays 68 integer,intent(in) :: jdtset_(0:ndtset_alloc) 69 type(dataset_type),intent(in) :: dtsets(0:ndtset_alloc) 70 type(results_out_type),intent(in) :: results_out(0:ndtset_alloc) 71 72 !Local variables------------------------------- 73 character(len=*), parameter :: f_occ ="(1x,a16,1x,(t22,6f10.6))" 74 character(len=*), parameter :: f_occa ="(1x,a16,a,1x,(t22,6f10.6))" 75 character(len=*), parameter :: token='occ' 76 !scalars 77 integer,parameter :: nkpt_max=50 78 integer :: generic,iban,idtset,ikpsp,ikpt,isppol,jdtset,multi,multi_nband 79 integer :: multi_nkpt,multi_nsppol,multi_occopt,nban,nkpt,nkpt_eff 80 integer :: multi_tsmear 81 integer :: print,tnkpt 82 character(len=4) :: appen 83 character(len=500) :: message 84 85 ! ************************************************************************* 86 87 if(ndtset_alloc<1)then 88 write(message, '(a,i0,a)' )' ndtset_alloc=',ndtset_alloc,', while it should be >= 1.' 89 MSG_BUG(message) 90 end if 91 92 if(ndtset_alloc>9999)then 93 write(message, '(a,i0,a)' )' ndtset_alloc=',ndtset_alloc,', while it must be lower than 100.' 94 MSG_BUG(message) 95 end if 96 97 !It is important to take iscf into account, since when it is -2, occupation numbers must be ignored 98 99 multi_occopt=0 100 if(ndtset_alloc>1)then 101 do idtset=1,ndtset_alloc 102 if(dtsets(1)%occopt/=dtsets(idtset)%occopt .and. & 103 & dtsets(idtset)%iscf/=-2 )multi_occopt=1 104 end do 105 end if 106 107 multi_tsmear=0 108 if(ndtset_alloc>1)then 109 do idtset=1,ndtset_alloc 110 if(dtsets(1)%tsmear/=dtsets(idtset)%tsmear .and. & 111 & dtsets(idtset)%iscf/=-2 )multi_tsmear=1 112 end do 113 end if 114 115 multi_nkpt=0 116 if(ndtset_alloc>1)then 117 do idtset=1,ndtset_alloc 118 if(dtsets(1)%nkpt/=dtsets(idtset)%nkpt .and. dtsets(idtset)%iscf/=-2 )multi_nkpt=1 119 end do 120 end if 121 if(multi_nkpt==0)nkpt=dtsets(1)%nkpt 122 123 multi_nsppol=0 124 if(ndtset_alloc>1)then 125 do idtset=1,ndtset_alloc 126 if(dtsets(1)%nsppol/=dtsets(idtset)%nsppol .and. & 127 & dtsets(idtset)%iscf/=-2 )multi_nsppol=1 128 end do 129 end if 130 131 if(multi_nsppol==0 .and. multi_nkpt==0)then 132 multi_nband=0 133 if(ndtset_alloc>1)then 134 do idtset=1,ndtset_alloc 135 if(dtsets(idtset)%iscf/=-2)then 136 do ikpsp=1,dtsets(1)%nkpt*dtsets(1)%nsppol 137 if(dtsets(1)%nband(ikpsp)/=dtsets(idtset)%nband(ikpsp))multi_nband=1 138 end do 139 end if 140 end do 141 end if 142 else 143 multi_nband=1 144 end if 145 146 !There is a possibility of a generic occupation-number set if 147 !multi_occopt==0 and multi_nband==0 148 multi=1 149 if(multi_occopt==0 .and. multi_nband==0) then 150 nban=sum(dtsets(1)%nband(1:dtsets(1)%nsppol*dtsets(1)%nkpt)) 151 multi=0 152 if(ndtset_alloc>1)then 153 do idtset=1,ndtset_alloc 154 if(dtsets(idtset)%iscf/=-2)then 155 ! nban counts all bands and kpoints and spins: see above 156 do iban=1,nban 157 ! Use of tol8, because the format for multi=1 is f16.6, so will not 158 ! discriminate between relative values, or absolute values that 159 ! agree within more than 6 digits 160 if( abs(results_out(1)%occ(iban,1)-results_out(idtset)%occ(iban,1)) > tol8) multi=1 161 end do 162 end if 163 end do 164 end if 165 end if 166 167 !At this stage, if multi==1, the occ must be printed 168 !if multi==0, then it might be that we have the default values. 169 !Since the default is all zeros, it only happens when iscf=-2 170 !Also initialize the number of a idtset that can be used as generic 171 !(this might not be the case for idtset=1 !) 172 173 generic=0 174 print=0 175 do idtset=1,ndtset_alloc 176 if(dtsets(idtset)%iscf/=-2)then 177 print=1 178 generic=idtset 179 end if 180 end do 181 182 !Now, print in the generic occupation-number set case. 183 if(print==1 .and. multi==0)then 184 ! Might restrict the number of k points to be printed 185 tnkpt=0 186 nkpt_eff=dtsets(1)%nkpt 187 if(prtvol_glob==0 .and. nkpt_eff>nkpt_max)then 188 nkpt_eff=nkpt_max 189 tnkpt=1 190 end if 191 ! The quantity of data to be output vary with occopt 192 if(dtsets(1)%occopt>=2)then 193 iban=1 194 do isppol=1,dtsets(1)%nsppol 195 do ikpt=1,nkpt_eff 196 ikpsp=ikpt+dtsets(1)%nkpt*(isppol-1) 197 nban=dtsets(generic)%nband(ikpsp) 198 if(ikpsp==1)then 199 write(iout, '(1x,a16,1x,(t22,6f10.6))' )& 200 & token,results_out(generic)%occ(iban:iban+nban-1,1) 201 else 202 write(iout, '((t22,6f10.6))' )results_out(generic)%occ(iban:iban+nban-1,1) 203 end if 204 iban=iban+nban 205 end do 206 if(tnkpt==1) write(iout,'(23x,a)' ) & 207 & 'prtocc : prtvol=0, do not print more k-points.' 208 end do 209 else 210 ! The number of bands is identical for all k points and spin 211 nban=dtsets(generic)%nband(1) 212 write(iout, '(1x,a16,1x,(t22,6f10.6))' )& 213 & token,results_out(generic)%occ(1:nban,1) 214 ! if occopt==1, the occ might differ with the spin 215 if(dtsets(1)%nsppol/=1 .and. dtsets(1)%occopt==1)then 216 write(iout,'((t22,6f10.6))')results_out(generic)%occ(nban*dtsets(1)%nkpt+1:& 217 & nban*dtsets(1)%nkpt+nban,1) 218 end if 219 end if 220 end if 221 222 !Now, print in the other cases 223 if(print==1 .and. multi==1)then 224 do idtset=1,ndtset_alloc 225 ! Might restrict the number of k points to be printed 226 tnkpt=0 227 nkpt_eff=dtsets(idtset)%nkpt 228 if(prtvol_glob==0 .and. nkpt_eff>nkpt_max)then 229 nkpt_eff=nkpt_max 230 tnkpt=1 231 end if 232 if(dtsets(idtset)%iscf/=-2)then 233 jdtset=jdtset_(idtset) 234 call appdig(jdtset,'',appen) 235 ! The quantity of data to be output vary with occopt 236 if(dtsets(idtset)%occopt>=2)then 237 iban=1 238 do isppol=1,dtsets(idtset)%nsppol 239 do ikpt=1,nkpt_eff 240 ikpsp=ikpt+dtsets(idtset)%nkpt*(isppol-1) 241 nban=dtsets(idtset)%nband(ikpsp) 242 if(ikpsp==1)then 243 write(iout, '(1x,a16,a,1x,(t22,6f10.6))' )& 244 & token,appen,results_out(idtset)%occ(iban:iban+nban-1,1) 245 else 246 write(iout, '((t22,6f10.6))' )results_out(idtset)%occ(iban:iban+nban-1,1) 247 end if 248 iban=iban+nban 249 end do 250 if(tnkpt==1) write(iout,'(23x,a)' ) & 251 & 'prtocc : prtvol=0, do not print more k-points.' 252 end do 253 else 254 ! The number of bands is identical for all k points and spin 255 nban=dtsets(idtset)%nband(1) 256 write(iout, '(1x,a16,a,1x,(t22,6f10.6))' )& 257 & token,appen,results_out(idtset)%occ(1:nban,1) 258 ! if occopt==1, the occ might differ with the spin 259 if(dtsets(idtset)%nsppol/=1 .and. dtsets(idtset)%occopt==1)then 260 write(iout, '((t22,6f10.6))' ) & 261 & results_out(idtset)%occ(nban*dtsets(idtset)%nkpt+1:nban*dtsets(idtset)%nkpt+nban,1) 262 end if 263 end if 264 end if 265 ! Endloop on idtset 266 end do 267 end if 268 269 end subroutine prtocc