TABLE OF CONTENTS
ABINIT/prttagm [ Functions ]
NAME
prttagm
FUNCTION
Eventually print the content of dprarr (if typevarphys='DPR','LEN', 'ENE' and 'BFI'), or intarr (if typevarphys='INT'), arrays of effective dimensions narr and 0:ndtset_alloc For the second dimension, the 0 index relates to a default. Print the array only if the content for at least one value of the second index is different from the default. Print a generic value if the non-default values are all equal. Print the detail of all values otherwise. The input variable 'length' controls the print format, and, in the case of the real(dp) variable, the way two numbers are determined to be different or not.
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
intarr(1:marr,0:ndtset_alloc), dprarr(1:marr,0:ndtset_alloc)
integer or real(dp) arrays, respectively,
containing the data to be printed. Use these arrays even for scalars.
For the first index, only the range 1:narr is relevant.
iout=unit number for echoed output
jdtset_(0:ndtset_alloc)=list of dataset indices.
length= if 1, short format for printing, if 2, long format for printing
special formats: if 3, INT : for symrel or kptrlatt
if 4, INT : for type
if 5, INT : for mkmem, mkqmem, mk1mem
if 6, INT : for kptrlatt
if 3, DPR : for tnons
if 4, DPR : for wtk and znucl
if 5, DPR : for atvshift
if 6, DPR : very short format for printing
If the typevarphys is 'DPR', a negative value of 'length' will request that
the equality of real(dp) numbers is determined by an ABSOLUTE
difference criterion only. The absolute value of length is used
to determine the format, as above.
marr=first dimension of the intarr and dprarr arrays, as declared in the
calling subroutine.
narr=actual first dimension of intarr and dprarr.
narrm=used when the effective first dimension of intarr is variable
in this case narrm(0:ndtset_alloc)
ncid= NETCDF id
ndtset_alloc=govern second dimension of intarr and dprarr
token=character string for 'tag'. Assumed no longer than 9 characters
typevarphys=physical variable type (might indicate the physical meaning of
for dimensionality purposes)
'INT'=>integer
'DPR'=>real(dp) (no special treatment)
'LEN'=>real(dp) (output in bohr and angstrom)
'ENE'=>real(dp) (output in hartree and eV)
'BFI'=>real(dp) (output in Tesla)
use_narrm= if 0, use of scalar 'narr' instead of array 'narrm'
[firstchar]= (optional) first character of the line (default=' ')
[forceprint]= (optional) control if output is forced even if a variable is equal to its default value:
0: not printed out if equal to default value
1: output forced even if equal to default value in both TEXT and NETCDF file
2: output forced even if equal to default value in NETCDF file only
3: output forced even if equal to default value in TEXT file only
OUTPUT
(only writing)
PARENTS
outvar_a_h,outvar_i_n,outvar_o_z,pawuj_det,prttagm_images
CHILDREN
appdig,write_var_netcdf
SOURCE
81 #if defined HAVE_CONFIG_H 82 #include "config.h" 83 #endif 84 85 #include "abi_common.h" 86 87 88 subroutine prttagm(dprarr,intarr,iout,jdtset_,length,& 89 & marr,narr,narrm,ncid,ndtset_alloc,token,typevarphys,use_narrm,& 90 firstchar,forceprint) ! optional 91 92 use defs_basis 93 use m_errors 94 use m_profiling_abi 95 96 use m_nctk, only : write_var_netcdf 97 98 !This section has been created automatically by the script Abilint (TD). 99 !Do not modify the following lines by hand. 100 #undef ABI_FUNC 101 #define ABI_FUNC 'prttagm' 102 use interfaces_32_util 103 !End of the abilint section 104 105 implicit none 106 107 !Arguments ------------------------------------ 108 !scalars 109 integer,intent(in) :: iout,length,marr,narr,ndtset_alloc,ncid,use_narrm 110 integer,intent(in),optional :: forceprint 111 character(len=*),intent(in) :: token 112 character(len=3),intent(in) :: typevarphys 113 character(len=1),intent(in),optional :: firstchar 114 !arrays 115 integer,intent(in) :: intarr(marr,0:ndtset_alloc) 116 integer,intent(in) :: jdtset_(0:ndtset_alloc) 117 integer,intent(in) :: narrm(0:ndtset_alloc) 118 real(dp),intent(in) :: dprarr(marr,0:ndtset_alloc) 119 120 !Local variables------------------------------- 121 !character(len=*), parameter :: long_beg ='(a,a16,a,1x,(t22,' 122 character(len=*), parameter :: format_1 ='",a16,a,t22,' 123 character(len=*), parameter :: format_2 ='",t22,' 124 character(len=*), parameter :: short_int ='10i5)' 125 character(len=*), parameter :: long_int ='8i8)' 126 character(len=*), parameter :: veryshort_dpr='f11.5)' 127 character(len=*), parameter :: short_dpr ='es16.8)' 128 character(len=*), parameter :: long_dpr ='es18.10)' 129 character(len=*), parameter :: veryshort_dim='f11.5),a' 130 character(len=*), parameter :: short_dim ='es16.8),a' 131 character(len=*), parameter :: long_dim ='es18.10),a' 132 character(len=*), parameter :: f_symrel ='3(3i3,1x),4x,3(3i3,1x))' 133 character(len=*), parameter :: f_type ='20i3)' 134 character(len=*), parameter :: f_mem ='8i8)' 135 character(len=*), parameter :: f_tnons ='3f11.7,3x,3f11.7)' 136 character(len=*), parameter :: f_wtk ='6f11.5)' 137 character(len=*), parameter :: f_atvshift ='5f11.5)' 138 character(len=*), parameter :: f_kptrlatt ='3(3i5,2x))' 139 !scalars 140 integer :: iarr,idtset,jdtset,multi,ndtset_eff,narr_eff 141 logical :: print_netcdf,print_out 142 real(dp),parameter :: tol21=1.0d-21 143 real(dp) :: diff,scale_factor,sumtol 144 character(len=4) :: digit 145 character(len=1) :: first_column 146 character(len=4) :: appen 147 character(len=8) :: out_unit 148 character(len=50) :: format_dp,format_int,full_format 149 character(len=500) :: message 150 151 ! ************************************************************************* 152 153 !########################################################### 154 !### 01. Check consistency of input 155 156 if(len_trim(token)>16)then 157 write(message, '(3a,i0,2a)' )& 158 & 'The length of the name of the input variable ',trim(token),' is ',len_trim(token),ch10,& 159 & 'This exceeds 16 characters, the present maximum in routine prttagm.' 160 MSG_ERROR(message) 161 end if 162 163 if(ndtset_alloc<1)then 164 write(message, '(a,i0,a,a,a,a,a)' )& 165 & 'ndtset_alloc=',ndtset_alloc,', while it should be >= 1.',ch10,& 166 & 'This happened for token=',token,'.' 167 MSG_BUG(message) 168 end if 169 170 if(ndtset_alloc>9999)then 171 write(message, '(a,i0,a,a,a,a,a)' )& 172 & 'ndtset_alloc=',ndtset_alloc,', while it must be lower than 10000.',ch10,& 173 & 'This happened for token=',token,'.' 174 MSG_BUG(message) 175 end if 176 177 if(narr>99 .and. (typevarphys=='ENE'.or.typevarphys=='LEN'))then 178 write(message, '(3a,i0,a)' )' typevarphys=',typevarphys,' with narr=',narr,' is not allowed.' 179 MSG_BUG(message) 180 end if 181 182 if ((narr>0).or.(use_narrm/=0)) then 183 184 print_out=.true.;print_netcdf=.true. 185 multi=0 186 187 ! ########################################################### 188 ! ### 02. Treatment of integer 'INT' 189 190 if(typevarphys=='INT')then 191 192 ! Determine whether the different non-default occurences are all equal 193 194 if (use_narrm==0) then ! use of scalar 'narr' instead of array 'narrm' 195 if(ndtset_alloc>1)then 196 do idtset=1,ndtset_alloc 197 do iarr=1,narr 198 if(intarr(iarr,1)/=intarr(iarr,idtset))multi=1 199 end do 200 end do 201 end if 202 else 203 ! If the sizes of the arrays are different we can not compare them 204 ! So we have to assume they are different 205 multi=1 206 end if 207 208 ! If they are all equal, then determine whether they are equal to the default 209 if(multi==0)then 210 print_out=.false. 211 do iarr=1,narr 212 if (intarr(iarr,1)/=intarr(iarr,0)) print_out=.true. 213 end do 214 print_netcdf=print_out 215 end if 216 217 if (present(forceprint)) then 218 if (forceprint==1.or.forceprint==3) print_out=.true. 219 if (forceprint==1.or.forceprint==2) print_netcdf=.true. 220 end if 221 222 ! Print only if the values differ from the default 223 if (print_out.or.print_netcdf.or.(ncid<0))then 224 ndtset_eff=ndtset_alloc 225 if((multi==0).or.(ncid<0)) ndtset_eff=1 226 do idtset=1,ndtset_eff 227 228 ! Initialize the character in the first column 229 first_column=' ';if (present(firstchar)) first_column=firstchar 230 if(abs(length)==5)first_column='P' 231 ! Initialize the format 232 if(abs(length)==1)format_int=trim(short_int) 233 if(abs(length)==2)format_int=trim(long_int) 234 if(abs(length)==3)format_int=trim(f_symrel) 235 if(abs(length)==4)format_int=trim(f_type) 236 if(abs(length)==5)format_int=trim(f_mem) 237 if(abs(length)==6)format_int=trim(f_kptrlatt) 238 ! Initialize the dataset number string, and print 239 if((multi==0).or.(ncid<0))then 240 appen=' ' 241 else 242 jdtset=jdtset_(idtset) 243 call appdig(jdtset,'',appen) 244 end if 245 ! full_format=trim(long_beg)//trim(format_int) 246 full_format='("'//first_column//trim(format_1)//'("'// first_column//trim(format_2)//trim(format_int)//")" 247 248 ! narr_eff could be narr or narrm(idtset) 249 ! It depends if the size is variable for different datasets 250 if (use_narrm==0)then 251 narr_eff=narr 252 else 253 narr_eff=narrm(idtset) 254 end if 255 256 if (narr_eff/=0) then 257 258 if (print_out) write(iout,full_format) token,trim(appen),intarr(1:narr_eff,idtset) 259 #ifdef HAVE_NETCDF 260 if (print_netcdf) then 261 call write_var_netcdf(intarr(1:narr_eff,idtset),& 262 & dprarr(1:narr_eff,idtset),marr,narr_eff,abs(ncid),typevarphys,token//appen) 263 end if 264 #endif 265 end if 266 267 end do 268 end if !(print==1) 269 270 ! ########################################################### 271 ! ### 03. Treatment of real 'DPR', 'LEN', 'ENE', 'BFI' 272 273 else if (typevarphys=='DPR' .or. typevarphys=='LEN' .or. typevarphys=='ENE' .or. typevarphys=='BFI') then 274 275 if((ndtset_alloc>1).and.(use_narrm==0))then 276 do idtset=1,ndtset_alloc 277 do iarr=1,narr 278 ! The determination of effective equality is more difficult than in the 279 ! integer case : 280 ! - if length > 0, ask for a relative accuracy, and also include 281 ! the case of zero values, thanks to tol21. 282 ! - if length < 0, ask for absolute accuracy. 283 diff=abs( dprarr(iarr,1)-dprarr(iarr,idtset) ) 284 if(length>0)then 285 sumtol=abs(dprarr(iarr,1))+abs(dprarr(iarr,idtset))+10*tol21 286 if(diff>sumtol*tol11)multi=1 287 else 288 if(diff>tol14)multi=1 289 end if 290 end do 291 end do 292 elseif (use_narrm/=0) then 293 multi=1 ! Assume that values could not be compared between different datasets. 294 ! Nevertheless, checks whether not all dataset might be equal to the default, despite varying dimensions (e.g. all zeroes) 295 print_out=.false. 296 do idtset=1,ndtset_alloc 297 if(narrm(idtset)>narrm(0))then 298 print_out=.true. 299 else 300 do iarr=1,narrm(idtset) 301 diff=abs( dprarr(iarr,idtset)-dprarr(iarr,0) ) 302 if(length>0)then 303 sumtol=abs(dprarr(iarr,idtset))+abs(dprarr(iarr,0))+10*tol21 304 if(diff>sumtol*tol11)print_out=.true. 305 else 306 if(diff>tol14)print_out=.true. 307 end if 308 end do 309 end if 310 end do 311 print_netcdf=print_out 312 end if 313 314 if(multi==0)then 315 print_out=.false. 316 do iarr=1,narr 317 diff=abs( dprarr(iarr,1)-dprarr(iarr,0) ) 318 if(length>0)then 319 sumtol=abs(dprarr(iarr,1))+abs(dprarr(iarr,0))+10*tol21 320 if(diff>sumtol*tol11)print_out=.true. 321 else 322 if(diff>tol14)print_out=.true. 323 end if 324 end do 325 print_netcdf=print_out 326 end if 327 328 if (present(forceprint)) then 329 if (forceprint==1.or.forceprint==3) print_out=.true. 330 if (forceprint==1.or.forceprint==2) print_netcdf=.true. 331 end if 332 333 if(print_out.or.print_netcdf.or.(ncid<0))then 334 ! Select the proper format 335 ndtset_eff=ndtset_alloc 336 if((multi==0).or.(ncid<0))ndtset_eff=1 337 narr_eff=narr 338 if(use_narrm/=0)then 339 narr_eff=maxval(narrm(1:ndtset_eff)) 340 end if 341 if(abs(length)==1 .or. abs(length)==2 .or. abs(length)==6)then 342 if(typevarphys=='DPR')then 343 digit='3' 344 if(abs(length)==1)format_dp=digit//short_dpr 345 if(abs(length)==2)format_dp=digit//long_dpr 346 if(abs(length)==6)format_dp=digit//veryshort_dpr 347 else if(typevarphys=='ENE' .or. typevarphys=='LEN' .or. typevarphys=='BFI')then 348 if (narr<10) write(digit,'(i1)')narr_eff 349 if (narr> 9) write(digit,'(i2)')narr_eff 350 if(abs(length)==1)format_dp=digit//short_dim 351 if(abs(length)==2)format_dp=digit//long_dim 352 if(abs(length)==6)format_dp=digit//veryshort_dim 353 end if 354 else 355 if(abs(length)==3)format_dp=f_tnons 356 if(abs(length)==4)format_dp=f_wtk 357 if(abs(length)==5)format_dp=f_atvshift 358 end if 359 do idtset=1,ndtset_eff 360 361 ! narr_eff could be narr or narrm(idtset) 362 ! It depends if the size is variable for different datasets 363 if (use_narrm==0)then 364 narr_eff=narr 365 else 366 narr_eff=narrm(idtset) 367 end if 368 369 if (narr_eff/=0) then 370 371 ! Initialize the character in the first column 372 first_column=' ';if (present(firstchar)) first_column=firstchar 373 ! Define scale_factor 374 scale_factor=one !EB to what this is still usefull ??? 375 ! EB remove if(typevarphys=='BFI')scale_factor=one/BField_Tesla 376 ! Define out_unit 377 if(typevarphys=='ENE')out_unit=' Hartree' 378 if(typevarphys=='LEN')out_unit=' Bohr ' 379 if(typevarphys=='BFI')out_unit=' ' !EB remove Tesla unit 380 ! Format, according to the length of the dataset string 381 if((multi==0).or.(ncid<0))then 382 appen=' ' 383 else 384 jdtset=jdtset_(idtset) 385 call appdig(jdtset,'',appen) 386 end if 387 ! full_format=trim(long_beg)//trim(format_dp) 388 full_format='("'//first_column//trim(format_1)//'("'// first_column//trim(format_2)//trim(format_dp)//")" 389 ! DEBUG 390 ! write(ab_out,*)' trim(long_beg)=',trim(long_beg) 391 ! write(ab_out,*)' trim(format_dp)=',trim(format_dp) 392 ! write(ab_out,*)' trim(full_format)=',trim(full_format) 393 ! ENDDEBUG 394 if(typevarphys=='DPR')then 395 if (print_out) write(iout,full_format) token,trim(appen),dprarr(1:narr_eff,idtset)*scale_factor 396 else 397 if (print_out) write(iout,full_format) token,trim(appen),dprarr(1:narr_eff,idtset)*scale_factor,trim(out_unit) 398 end if 399 #ifdef HAVE_NETCDF 400 if (print_netcdf) then 401 call write_var_netcdf(intarr(1:narr_eff,idtset),dprarr(1:narr_eff,idtset),& 402 & marr,narr_eff,abs(ncid),'DPR',token//trim(appen)) 403 end if 404 #endif 405 406 end if 407 408 end do 409 end if 410 411 ! ########################################################### 412 ! ### 04. The type is neither 'INT' nor 'DPR','ENE','LEN','BFI' 413 else 414 MSG_BUG('Disallowed typevarphys = '//TRIM(typevarphys)) 415 end if 416 417 end if ! End condition of narr>0 418 419 end subroutine prttagm