TABLE OF CONTENTS
- ABINIT/m_hdr
- hdr_vs_dtset/compare_int
- m_hdr/abifile_from_fform
- m_hdr/abifile_from_varname
- m_hdr/abifile_t
- m_hdr/check_fform
- m_hdr/fform_from_ext
- m_hdr/hdr_backspace
- m_hdr/hdr_bcast
- m_hdr/hdr_bsize_frecords
- m_hdr/hdr_check
- m_hdr/hdr_copy
- m_hdr/hdr_echo
- m_hdr/hdr_fort_read
- m_hdr/hdr_fort_write
- m_hdr/hdr_free
- m_hdr/hdr_get_crystal
- m_hdr/hdr_get_nelect_from_occ
- m_hdr/hdr_get_occ3d
- m_hdr/hdr_init
- m_hdr/hdr_init_lowlvl
- m_hdr/hdr_io_int
- m_hdr/hdr_io_wfftype
- m_hdr/hdr_malloc
- m_hdr/hdr_mpio_skip
- m_hdr/hdr_ncread
- m_hdr/hdr_ncwrite
- m_hdr/hdr_read_from_fname
- m_hdr/hdr_set_occ
- m_hdr/hdr_skip_int
- m_hdr/hdr_skip_wfftype
- m_hdr/hdr_type
- m_hdr/hdr_update
- m_hdr/hdr_vs_dtset
- m_hdr/hdr_write_to_fname
- m_hdr/read_first_record
- m_hdr/test_abifiles
- m_hdr/varname_from_fname
- m_wfk/hdr_compare
ABINIT/m_hdr [ Modules ]
NAME
m_hdr
FUNCTION
This module contains the definition of the abinit header and its methods If you have to change the hdr, pay attention to the following subroutines: hdr_malloc, hdr_init_lowlvl, hdr_free, hdr_bcast and the IO routines hdr_mpio_skip, hdr_fort_read, hdr_fort_write, hdr_ncread, hdr_ncwrite
COPYRIGHT
Copyright (C) 2008-2024 ABINIT group (XG, MB, MT, DC, MG) 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.
SOURCE
21 #if defined HAVE_CONFIG_H 22 #include "config.h" 23 #endif 24 25 #include "abi_common.h" 26 27 !#define DEBUG_MODE 28 29 ! This option enable the output of the new hdr entries in hdr%echo 30 ! Reference files should be updated 31 !#define DEV_NEW_HDR 32 33 module m_hdr 34 35 use defs_basis 36 use m_xmpi 37 use m_abicore 38 use m_errors 39 use m_crystal 40 use m_wffile 41 use m_sort 42 #ifdef HAVE_MPI2 43 use mpi 44 #endif 45 use netcdf 46 use m_nctk 47 use m_dtset 48 49 use m_build_info, only : abinit_version 50 use m_copy, only : alloc_copy 51 use m_io_tools, only : flush_unit, isncfile, file_exists, open_file 52 use m_fstrings, only : sjoin, itoa, ftoa, ltoa, replace_ch0, startswith, endswith, ljust, strcat, atoi 53 use m_symtk, only : print_symmetries 54 !use m_kpts, only : kpts_timrev_from_kptopt 55 use defs_wvltypes, only : wvl_internal_type 56 use defs_datatypes, only : ebands_t, pseudopotential_type 57 use m_pawtab, only : pawtab_type 58 use m_pawrhoij, only : pawrhoij_type, pawrhoij_alloc, pawrhoij_copy, pawrhoij_free, & 59 pawrhoij_io, pawrhoij_inquire_dim 60 61 implicit none 62 63 private
hdr_vs_dtset/compare_int [ Functions ]
[ Top ] [ hdr_vs_dtset ] [ Functions ]
NAME
compare_int
FUNCTION
Compare two int value and may raise an exception on error.
INPUTS
vname=Name of the variable iexp= expected value. ifound=the actuval value
SIDE EFFECTS
ierr=increased by one if values differ
SOURCE
4914 subroutine compare_int(vname, iexp, ifound, ierr) 4915 4916 !Arguments ------------------------------------ 4917 integer,intent(in) :: iexp,ifound 4918 integer,intent(inout) :: ierr 4919 character(len=*),intent(in) :: vname 4920 4921 !Local variables------------------------------- 4922 character(len=500) :: msg 4923 4924 ! ************************************************************************* 4925 4926 if (.not. iexp == ifound) then 4927 write(msg,'(2a,i0,a,i0)')' Mismatch in '//trim(vname),' Expected = ', iexp, ' Found = ', ifound 4928 call wrtout(std_out, msg) 4929 ! Increase ierr to signal we should stop in the caller. 4930 ierr = ierr + 1 4931 end if 4932 4933 end subroutine compare_int
m_hdr/abifile_from_fform [ Functions ]
[ Top ] [ m_hdr ] [ Functions ]
NAME
abifile_from_fform
FUNCTION
Return the abifile_t object corresponding to the given fform Return abifile_none if not found. This function is used to find the name of the netcdf variable from the fform and detect whether the file contains pawrhoij.
SOURCE
711 type(abifile_t) function abifile_from_fform(fform) result(afile) 712 713 !Arguments --------------------------------------------- 714 integer,intent(in) :: fform 715 716 !Local variables------------------------------- 717 integer :: ii 718 ! ************************************************************************* 719 720 afile = abifile_none 721 do ii=1,size(all_abifiles) 722 if (all_abifiles(ii)%fform == fform) afile = all_abifiles(ii) 723 end do 724 725 end function abifile_from_fform
m_hdr/abifile_from_varname [ Functions ]
[ Top ] [ m_hdr ] [ Functions ]
NAME
abifile_from_varname
FUNCTION
Return the abifile_t object corresponding to the given variable varname Return abifile_none if not found. This function is used to find the last value of fform when we write data to file.
SOURCE
679 type(abifile_t) function abifile_from_varname(varname) result(afile) 680 681 !Arguments --------------------------------------------- 682 character(len=*),intent(in) :: varname 683 684 !Local variables------------------------------- 685 !scalars 686 integer :: ii 687 ! ************************************************************************* 688 689 afile = abifile_none 690 do ii=1,size(all_abifiles) 691 if (all_abifiles(ii)%varname == varname) afile = all_abifiles(ii) 692 end do 693 694 end function abifile_from_varname
m_hdr/abifile_t [ Types ]
NAME
abifile_t
FUNCTION
Gather information about a binary file with header. Every file with header must be registered in all_abifiles, see below.
SOURCE
329 type,public :: abifile_t 330 331 character(len=nctk_slen) :: varname 332 ! Name of the netcdf variable associated to the file. 333 ! This string is used in fftdatar_write to find the value of fform to be written to file 334 335 integer :: fform 336 ! The value of fform associated to this file 337 338 character(len=24) :: ext 339 ! Abinit File extension (`.nc` is not included) 340 341 character(len=24) :: class 342 ! Each file belongs to a class e.g. wf_planewave, den, pot, data... 343 344 logical :: has_pawrhoij=.True. 345 ! True if this file contains pawrhoij when hdr%usepaw == 1. 346 347 end type abifile_t 348 349 ! Notes about abifiles: 350 ! 351 ! *) fform are positive integers >0 and they must be unique inside the list. 352 ! One might have used strings xxx.yyy.zzz instead of integers but there's a lot of code 353 ! around that relies on integral fforms so we have to live with it. 354 ! 355 ! *) class is used in postprocessing tools e.g. cut3d when we need to know if we are dealing 356 ! with wavefunctions or density-like or potential-like data. 357 ! Possible values are: "wf_planewave" for wavefunction files, "density" for density-like, 358 ! "potential" for potential files, "data" for generic data a.k.a. internal files e.g. GKK matrix elements. 359 ! 360 ! *) varname can appear multiple times, in this case the entries should be ordered chronologically 361 ! i.e. the most recent format should follow the older ones. This could be useful if we decide to 362 ! remove pawrhoij from a particular file. Let's assume, for example, that we've decided to remove 363 ! pawrhoij from the POT file. In this case, abifiles should contain: 364 ! 365 ! abifile_t(varname="potential", fform=102), & ! old file with pawrhoij 366 ! abifile_t(varname="potential", fform=202, has_pawrhoij=.False.) & ! new file wo pawrhoij 367 ! 368 ! *) The file extensions is used in fform_from_ext and varname_from_fname. 369 ! fform_from_ext returns the most recent fform associated to a file extension. 370 ! varname_from_fname is used in post-processing tools e.g. cut3d 371 ! to read data from netcdf file without having to prompt the user for the variable name. 372 ! In principle, the extension should be unique but there are exceptions e.g. the WFK produced in bigdft mode. 373 ! Moreover the files produced by the DFPT code do not have a well-defined extension and, as a consequence, 374 ! they require a special treatment. In python I would use regexp but Fortran is not python! 375 376 type(abifile_t),private,parameter :: all_abifiles(51) = [ & 377 378 ! Files with wavefunctions: 379 abifile_t(varname="coefficients_of_wavefunctions", fform=2, ext="WFK", class="wf_planewave"), & 380 abifile_t(varname="real_space_wavefunctions", fform=200, ext="WFK", class="wf_wavelet"), & ! Used by wavelets. 381 abifile_t(varname="ur_ae", fform=602, ext="PAWAVES", class="wf_rspace"), & ! Used in pawmkaewf. 382 abifile_t(varname="coefficients_of_wavefunctions", fform=502, ext="KSS", class="wf_planewave"), & 383 384 ! Files with density-like data. 385 abifile_t(varname="density", fform=52, ext="DEN", class="density"), & ! Official 386 abifile_t(varname="positron_density", fform=53, ext="POSITRON", class="density"), & 387 abifile_t(varname="first_order_density", fform=54, ext="DEN(\d+)", class="density"), & 388 abifile_t(varname="pawrhor", fform=55, ext="PAWDEN", class="density"), & 389 abifile_t(varname="pawrhor_core", fform=56, ext="ATMDEN_CORE", class="density"), & 390 abifile_t(varname="pawrhor_val", fform=57, ext="ATMDEN_VAL", class="density"), & 391 abifile_t(varname="pawrhor_full", fform=58, ext="ATMDEN_FULL", class="density"), & 392 abifile_t(varname="pawrhor_ntilde_minus_nhat", fform=59, ext="N_TILDE", class="density"), & 393 abifile_t(varname="pawrhor_n_one", fform=60, ext="N_ONE", class="density"), & 394 abifile_t(varname="pawrhor_nt_one", fform=61, ext="NT_ONE", class="density"), & 395 abifile_t(varname="qp_rhor", fform=62, ext="QP_DEN", class="density"), & 396 abifile_t(varname="qp_pawrhor", fform=63, ext="QP_PAWDEN", class="density"), & 397 abifile_t(varname="grhor_1", fform=67, ext="GDEN1", class="density"), & 398 abifile_t(varname="grhor_2", fform=68, ext="GDEN2", class="density"), & 399 abifile_t(varname="grhor_3", fform=69, ext="GDEN3", class="density"), & 400 401 !??? 402 abifile_t(varname="stm", fform=110, ext="STM", class="density"), & 403 abifile_t(varname="kinedr", fform=70, ext="KDEN", class="density"), & 404 abifile_t(varname="elfr", fform=64, ext="ELF", class="density"), & 405 abifile_t(varname="elfr_up", fform=65, ext="ELF_UP", class="density"), & 406 abifile_t(varname="elfr_down", fform=66, ext="ELF_DOWN", class="density"), & 407 abifile_t(varname="laprhor", fform=71, ext="LDEN", class="density"), & 408 409 ! Files with potentials 410 ! Official 411 abifile_t(varname="potential", fform=102, ext="POT", class="potential"), & ! CHECK THESE TWO FILES 412 abifile_t(varname="vtrial", fform=103, ext="POT", class="potential"), & 413 abifile_t(varname="vhartree", fform=104, ext="VHA", class="potential"), & 414 abifile_t(varname="vpsp", fform=105, ext="VPSP", class="potential"), & 415 abifile_t(varname="vhartree_vloc", fform=106, ext="VCLMB", class="potential"), & 416 abifile_t(varname="vhxc", fform=107, ext="VHXC", class="potential"), & 417 abifile_t(varname="exchange_correlation_potential", fform=108, ext="VXC", class="potential"), & 418 419 abifile_t(varname="first_order_potential", fform=109, ext="POT(\d+)", class="potential"), & 420 ! fform 111 contains an extra record with rhog1_q(G=0) after the DFPT potential(r). 421 abifile_t(varname="first_order_potential", fform=111, ext="POT(\d+)", class="potential"), & 422 423 abifile_t(varname="first_order_vhartree", fform=112, ext="VHA(\d+)", class="potential"), & 424 abifile_t(varname="first_order_vpsp", fform=113, ext="VPSP(\d+)", class="potential"), & 425 abifile_t(varname="first_order_vxc", fform=114, ext="VXC(\d+)", class="potential"), & 426 427 ! Data used in conducti 428 abifile_t(varname="pawnabla", fform=610, ext="OPT1", class="data"), & 429 abifile_t(varname="pawnabla_core", fform=611, ext="OPT2", class="data"), & 430 abifile_t(varname="pawnabla_loc", fform=612, ext="OPT", class="data"), & 431 432 ! Data used in E-PH code 433 abifile_t(varname="gkk_elements", fform=42, ext="GKK", class="data"), & 434 435 ! DKK matrix elements in netcdf format (optic, eph) 436 abifile_t(varname="h1_matrix_elements", fform=43, ext="DKK", class="data"), & 437 438 ! output files that are not supposed to be read by abinit. 439 abifile_t(varname="this_file_is_not_read_by_abinit", fform=666, ext="666", class="data"), & 440 441 ! GW files: old 1002, 1102 442 !character(len=nctk_slen),public,parameter :: e_ncname="dielectric_function" 443 ! FIXME This one should be rewritten 444 abifile_t(varname="polarizability", fform=1003, ext="SUS", class="polariz"), & 445 abifile_t(varname="inverse_dielectric_function", fform=1004, ext="SCR", class="epsm1"), & 446 !abifile_t(varname="dielectric_function", fform=1002, ext="EPS", class="eps"), & 447 ! 448 ! BSE: TODO. see m_bse_io 449 !abifile_t(varname="bse_uresonant_q0", fform=1002, ext="BSR", class="bsreso"), & 450 !abifile_t(varname="bse_ucoupling_q0", fform=1002, ext="BSC", class="bscoup"), & 451 452 ! Miscellaneous 453 abifile_t(varname="dos_fractions", fform=3000, ext="FATBANDS", class="data"), & 454 abifile_t(varname="spectral_weights", fform=5000, ext="FOLD2BLOCH", class="data"), & 455 abifile_t(varname="no_fftdatar_write", fform=6000, ext="ABIWAN", class="data"), & 456 abifile_t(varname="None", fform=6001, ext="KERANGE", class="data"), & 457 abifile_t(varname="None", fform=6002, ext="SIGEPH", class="data"), & 458 abifile_t(varname="None", fform=6003, ext="GSTORE", class="data") & 459 ] 460 461 type(abifile_t),public,parameter :: abifile_none = abifile_t(varname="None", fform=0, ext="None", class="None") 462 ! This object is returned when we cannot find the file in abifiles. 463 464 CONTAINS !===========================================================
m_hdr/check_fform [ Functions ]
[ Top ] [ m_hdr ] [ Functions ]
NAME
check_fform
FUNCTION
This function is used ifdef DEBUG_MODE. It tests whether the value of fform is registered in all_abifiles.
SOURCE
738 subroutine check_fform(fform) 739 740 !Local variables------------------------------- 741 !scalars 742 integer,intent(in) :: fform 743 #ifdef DEBUG_MODE 744 type(abifile_t) :: abifile 745 character(len=500) :: msg 746 747 ! ********************************************************************* 748 if (fform == 666) return 749 abifile = abifile_from_fform(fform) 750 751 if (abifile%fform == 0) then 752 ABI_ERROR(sjoin("Cannot find any abifile object associated to fform:", itoa(fform))) 753 end if 754 if (abifile%fform /= fform) then 755 write(msg,"(2a,2(a,i0))") & 756 "Input fform does not agree with the one registered in abifile.",ch10,& 757 "hdr%fform= ",fform,", abifile%fform= ",abifile%fform 758 ABI_ERROR(msg) 759 end if 760 761 #else 762 ABI_UNUSED(fform) 763 #endif 764 765 end subroutine check_fform
m_hdr/fform_from_ext [ Functions ]
[ Top ] [ m_hdr ] [ Functions ]
NAME
fform_from_ext
FUNCTION
Return the value of fform to be used from the file extension. If a file has multiple fforms, the most recent one is returned. Returns 0 if the extension is not registered.
SOURCE
479 integer function fform_from_ext(abiext) result(fform) 480 481 !Arguments --------------------------------------------- 482 character(len=*),intent(in) :: abiext 483 484 !Local variables------------------------------- 485 !scalars 486 integer :: ii,ind,ierr,pertcase 487 character(len=len(abiext)) :: ext 488 489 ! ********************************************************************* 490 ! Remove .nc (if any) and work with ext 491 ext = abiext 492 if (endswith(abiext, ".nc")) then 493 ind = index(abiext, ".nc", back=.True.); ext = abiext(:ind-1) 494 end if 495 496 fform = 0 497 do ii=1,size(all_abifiles) 498 if (ext == all_abifiles(ii)%ext) fform = all_abifiles(ii)%fform 499 end do 500 if (fform /= 0) return 501 ! Here we handle special cases. 502 503 ! Handle DEN[pertcase] 504 if (startswith(ext, "DEN")) then 505 read(ext(4:), *, iostat=ierr) pertcase 506 if (ierr == 0) then 507 do ii=1,size(all_abifiles) 508 if (all_abifiles(ii)%ext == "DEN(\d+)") fform = all_abifiles(ii)%fform 509 end do 510 return 511 end if 512 end if 513 514 ! Handle POT[pertcase] 515 if (startswith(ext, "POT")) then 516 read(ext(4:), *, iostat=ierr) pertcase 517 if (ierr == 0) then 518 do ii=1,size(all_abifiles) 519 if (all_abifiles(ii)%ext == "POT(\d+)") fform = all_abifiles(ii)%fform 520 end do 521 return 522 end if 523 end if 524 525 ABI_ERROR(sjoin("Cannot find fform associated to extension:", abiext)) 526 527 end function fform_from_ext
m_hdr/hdr_backspace [ Functions ]
[ Top ] [ m_hdr ] [ Functions ]
NAME
hdr_backspace
FUNCTION
Backspace the header. Return exit status and error message The file is supposed to be open already
INPUTS
Hdr<hdr_type>=The header of the file. unit=unit number of the unformatted file
SOURCE
3272 integer function hdr_backspace(hdr, unit, msg) result(ierr) 3273 3274 !Arguments ------------------------------------ 3275 class(hdr_type),intent(in) :: hdr 3276 integer,intent(in) :: unit 3277 character(len=*),intent(out) :: msg 3278 3279 !Local variables------------------------------- 3280 integer :: irec 3281 3282 !************************************************************************* 3283 3284 ierr = 0 3285 do irec=1,5 + hdr%npsp 3286 backspace(unit=unit, err=10, iomsg=msg) 3287 end do 3288 3289 if (hdr%usepaw == 1) then 3290 do irec=1,2 3291 backspace(unit=unit, err=10, iomsg=msg) 3292 end do 3293 end if 3294 3295 return 3296 3297 ! Handle IO-error 3298 10 ierr = 1 3299 3300 end function hdr_backspace
m_hdr/hdr_bcast [ Functions ]
[ Top ] [ m_hdr ] [ Functions ]
NAME
hdr_bcast
FUNCTION
This subroutine transmits the header structured datatype initialized on one processor (or a group of processor), to the other processors. It also allocate the needed part of the header.
INPUTS
master = id of the master process me = id of the current process comm = id of the space communicator handler
OUTPUT
(no output)
SIDE EFFECTS
hdr <type(hdr_type)>=the header. For the master, it is already initialized entirely, while for the other procs, everything has to be transmitted.
NOTES
This routine is called only in the case of MPI version of the code.
SOURCE
2425 subroutine hdr_bcast(hdr, master, me, comm) 2426 2427 !Arguments ------------------------------------ 2428 integer, intent(in) :: master,me,comm 2429 class(hdr_type),intent(inout) :: hdr 2430 2431 !Local variables------------------------------- 2432 !scalars 2433 integer :: bantot,cplex_rhoij,iatom,ierr,index,index2,ipsp,iq,iq0,ispden,list_size,list_size2 2434 integer :: lmn2_size,natom,nkpt,npsp,nsel,nspden,nsppol,nsym,nrhoij,ntypat,qphase 2435 character(len=fnlen) :: list_tmp 2436 !arrays 2437 integer,allocatable :: list_int(:) 2438 real(dp),allocatable :: list_dpr(:) 2439 character(len=fnlen),allocatable :: list_char(:) 2440 2441 ! ************************************************************************* 2442 2443 !@hdr_type 2444 if (xmpi_comm_size(comm) == 1) return ! Nothing to do 2445 2446 DBG_ENTER("COLL") 2447 2448 !Transmit the integer scalars 2449 list_size = 44 2450 ABI_MALLOC(list_int,(list_size)) 2451 if (master==me)then 2452 list_int(1)=hdr%bantot 2453 list_int(2)=hdr%date 2454 list_int(3)=hdr%headform 2455 list_int(4)=hdr%intxc 2456 list_int(5)=hdr%ixc 2457 list_int(6)=hdr%natom 2458 list_int(7)=hdr%nkpt 2459 list_int(8)=hdr%npsp 2460 list_int(9)=hdr%nspden 2461 list_int(10)=hdr%nspinor 2462 list_int(11)=hdr%nsppol 2463 list_int(12)=hdr%nsym 2464 list_int(13)=hdr%ntypat 2465 list_int(14)=hdr%occopt 2466 list_int(15)=hdr%pertcase 2467 list_int(16)=hdr%usepaw 2468 list_int(17:19)=hdr%ngfft(1:3) 2469 list_int(20)=hdr%usewvl 2470 list_int(21)=hdr%kptopt 2471 list_int(22)=hdr%pawcpxocc 2472 list_int(23)=hdr%nshiftk_orig 2473 list_int(24)=hdr%nshiftk 2474 list_int(25:33)=reshape(hdr%kptrlatt_orig, [3*3]) 2475 list_int(34:42)=reshape(hdr%kptrlatt, [3*3]) 2476 list_int(43)=hdr%icoulomb 2477 list_int(44)=hdr%ivalence 2478 end if 2479 2480 call xmpi_bcast(list_int,master,comm,ierr) 2481 2482 if(master/=me)then 2483 hdr%bantot =list_int(1) 2484 hdr%date =list_int(2) 2485 hdr%headform=list_int(3) 2486 hdr%intxc =list_int(4) 2487 hdr%ixc =list_int(5) 2488 hdr%natom =list_int(6) 2489 hdr%nkpt =list_int(7) 2490 hdr%npsp =list_int(8) 2491 hdr%nspden =list_int(9) 2492 hdr%nspinor =list_int(10) 2493 hdr%nsppol =list_int(11) 2494 hdr%nsym =list_int(12) 2495 hdr%ntypat =list_int(13) 2496 hdr%occopt =list_int(14) 2497 hdr%pertcase=list_int(15) 2498 hdr%usepaw =list_int(16) 2499 hdr%ngfft(1:3)=list_int(17:19) 2500 hdr%usewvl =list_int(20) 2501 hdr%kptopt = list_int(21) 2502 hdr%pawcpxocc = list_int(22) 2503 hdr%nshiftk_orig = list_int(23) 2504 hdr%nshiftk = list_int(24) 2505 hdr%kptrlatt_orig = reshape(list_int(25:33), [3,3]) 2506 hdr%kptrlatt = reshape(list_int(34:42), [3,3]) 2507 hdr%icoulomb = list_int(43) 2508 hdr%ivalence = list_int(44) 2509 end if 2510 ABI_FREE(list_int) 2511 2512 bantot=hdr%bantot 2513 natom =hdr%natom 2514 nkpt =hdr%nkpt 2515 npsp =hdr%npsp 2516 nspden=hdr%nspden 2517 nsppol=hdr%nsppol 2518 nsym =hdr%nsym 2519 ntypat=hdr%ntypat 2520 2521 if (master/=me) then 2522 ! Allocate all components of hdr 2523 call hdr_malloc(hdr, bantot, nkpt, nsppol, npsp, natom, ntypat,& 2524 nsym, hdr%nshiftk_orig, hdr%nshiftk) 2525 end if 2526 2527 !Transmit the integer arrays 2528 list_size=nkpt*(2+nsppol)+6*npsp+10*nsym+natom 2529 ABI_MALLOC(list_int,(list_size)) 2530 if (master==me)then 2531 list_int(1 :nkpt )=hdr%istwfk ; index=nkpt 2532 list_int(1+index:nkpt*nsppol+index)=hdr%nband ; index=index+nkpt*nsppol 2533 list_int(1+index:nkpt +index)=hdr%npwarr ; index=index+nkpt 2534 list_int(1+index:npsp +index)=hdr%pspcod ; index=index+npsp 2535 list_int(1+index:npsp +index)=hdr%pspdat ; index=index+npsp 2536 list_int(1+index:npsp +index)=hdr%pspso ; index=index+npsp 2537 list_int(1+index:npsp +index)=hdr%pspxc ; index=index+npsp 2538 list_int(1+index:npsp +index)=hdr%lmn_size ; index=index+npsp 2539 list_int(1+index:npsp +index)=hdr%so_psp ; index=index+npsp 2540 list_int(1+index:nsym +index)=hdr%symafm ; index=index+nsym 2541 list_int(1+index:nsym*3*3 +index)=reshape(hdr%symrel,(/3*3*nsym/)) 2542 index=index+nsym*3*3 2543 list_int(1+index:natom +index)=hdr%typat ; index=index+natom 2544 end if 2545 2546 call xmpi_bcast(list_int,master,comm,ierr) 2547 2548 if(master/=me)then 2549 hdr%istwfk=list_int(1 :nkpt ) ; index=nkpt 2550 hdr%nband =list_int(1+index:nkpt*nsppol+index) ; index=index+nkpt*nsppol 2551 hdr%npwarr=list_int(1+index:nkpt +index) ; index=index+nkpt 2552 hdr%pspcod=list_int(1+index:npsp +index) ; index=index+npsp 2553 hdr%pspdat=list_int(1+index:npsp +index) ; index=index+npsp 2554 hdr%pspso =list_int(1+index:npsp +index) ; index=index+npsp 2555 hdr%pspxc =list_int(1+index:npsp +index) ; index=index+npsp 2556 hdr%lmn_size=list_int(1+index:npsp +index) ; index=index+npsp 2557 hdr%so_psp =list_int(1+index:npsp +index) ; index=index+npsp 2558 hdr%symafm=list_int(1+index:nsym +index) ; index=index+nsym 2559 hdr%symrel=reshape(list_int(1+index:nsym*3*3 +index),(/3,3,nsym/)) 2560 index=index+nsym*3*3 2561 hdr%typat =list_int(1+index:natom +index) ; index=index+natom 2562 end if 2563 ABI_FREE(list_int) 2564 2565 !Transmit the double precision scalars and arrays 2566 list_size = 22+ 3*nkpt+nkpt+bantot + 3*nsym + 3*natom + 2*npsp+ntypat + & 2567 4 + 3*hdr%nshiftk_orig + 3*hdr%nshiftk + hdr%ntypat 2568 ABI_MALLOC(list_dpr,(list_size)) 2569 2570 if (master==me)then 2571 list_dpr(1)=hdr%ecut_eff 2572 list_dpr(2)=hdr%etot 2573 list_dpr(3)=hdr%fermie 2574 list_dpr(4)=hdr%fermih 2575 list_dpr(5)=hdr%residm 2576 list_dpr(6:14)=reshape(hdr%rprimd(1:3,1:3),(/9/)) 2577 list_dpr(15)=hdr%ecut 2578 list_dpr(16)=hdr%ecutdg 2579 list_dpr(17)=hdr%ecutsm 2580 list_dpr(18)=hdr%tphysel 2581 list_dpr(19)=hdr%tsmear 2582 list_dpr(20:22)=hdr%qptn(1:3) ; index=22 2583 list_dpr(1+index:3*nkpt +index)=reshape(hdr%kptns,(/3*nkpt/)) ; index=index+3*nkpt 2584 list_dpr(1+index:nkpt +index)=hdr%wtk ; index=index+nkpt 2585 list_dpr(1+index:bantot +index)=hdr%occ ; index=index+bantot 2586 list_dpr(1+index:3*nsym +index)=reshape(hdr%tnons,(/3*nsym/)) ; index=index+3*nsym 2587 list_dpr(1+index:3*natom+index)=reshape(hdr%xred,(/3*natom/)) ; index=index+3*natom 2588 list_dpr(1+index:npsp +index)=hdr%zionpsp ; index=index+npsp 2589 list_dpr(1+index:npsp +index)=hdr%znuclpsp ; index=index+npsp 2590 list_dpr(1+index:ntypat +index)=hdr%znucltypat ; index=index+ntypat 2591 list_dpr(1+index)=hdr%nelect; index=index+1 2592 list_dpr(1+index)=hdr%ne_qFD; index=index+1 2593 list_dpr(1+index)=hdr%nh_qFD; index=index+1 2594 list_dpr(1+index)=hdr%cellcharge; index=index+1 2595 list_dpr(1+index:index+3*hdr%nshiftk_orig) = reshape(hdr%shiftk_orig, [3*hdr%nshiftk_orig]) 2596 index=index+3*hdr%nshiftk_orig 2597 list_dpr(1+index:index+3*hdr%nshiftk) = reshape(hdr%shiftk, [3*hdr%nshiftk]) 2598 index=index+3*hdr%nshiftk 2599 list_dpr(1+index:index+hdr%ntypat) = hdr%amu(1:hdr%ntypat) 2600 end if 2601 2602 call xmpi_bcast(list_dpr,master,comm,ierr) 2603 2604 if(master/=me)then 2605 hdr%ecut_eff=list_dpr(1) 2606 hdr%etot =list_dpr(2) 2607 hdr%fermie =list_dpr(3) 2608 hdr%fermih =list_dpr(4) 2609 hdr%residm =list_dpr(5) 2610 hdr%rprimd =reshape(list_dpr(6:14),(/3,3/)) 2611 hdr%ecut =list_dpr(15) 2612 hdr%ecutdg =list_dpr(16) 2613 hdr%ecutsm =list_dpr(17) 2614 hdr%tphysel =list_dpr(18) 2615 hdr%tsmear =list_dpr(19) 2616 hdr%qptn(1:3)=list_dpr(20:22) ; index=22 2617 hdr%kptns =reshape(list_dpr(1+index:3*nkpt +index),(/3,nkpt/)) ; index=index+3*nkpt 2618 hdr%wtk =list_dpr(1+index:nkpt +index) ; index=index+nkpt 2619 hdr%occ =list_dpr(1+index:bantot +index) ; index=index+bantot 2620 hdr%tnons =reshape(list_dpr(1+index:3*nsym +index),(/3,nsym/)) ; index=index+3*nsym 2621 hdr%xred =reshape(list_dpr(1+index:3*natom+index),(/3,natom/)); index=index+3*natom 2622 hdr%zionpsp =list_dpr(1+index:npsp +index) ; index=index+npsp 2623 hdr%znuclpsp=list_dpr(1+index:npsp +index) ; index=index+npsp 2624 hdr%znucltypat=list_dpr(1+index:ntypat +index) ; index=index+ntypat 2625 hdr%nelect = list_dpr(1+index); index=index+1 2626 hdr%ne_qFD = list_dpr(1+index); index=index+1 2627 hdr%nh_qFD = list_dpr(1+index); index=index+1 2628 hdr%cellcharge = list_dpr(1+index); index=index+1 2629 hdr%shiftk_orig = reshape(list_dpr(1+index:index+3*hdr%nshiftk_orig), [3, hdr%nshiftk_orig]) 2630 index=index+3*hdr%nshiftk_orig 2631 hdr%shiftk = reshape(list_dpr(1+index:index+3*hdr%nshiftk), [3, hdr%nshiftk]) 2632 index=index+3*hdr%nshiftk 2633 hdr%amu = list_dpr(1+index:index+hdr%ntypat) 2634 end if 2635 ABI_FREE(list_dpr) 2636 2637 !Transmit the characters 2638 list_size=npsp+1 + npsp 2639 ABI_MALLOC(list_char,(list_size)) 2640 if (master==me)then 2641 list_char(1) =hdr%codvsn ! Only 8 characters are stored in list_char(1) 2642 list_char(2:npsp+1)=hdr%title 2643 list_char(npsp+2:) =hdr%md5_pseudos 2644 end if 2645 2646 call xmpi_bcast(list_char,master,comm,ierr) 2647 2648 if(master/=me)then 2649 list_tmp=list_char(1) 2650 hdr%codvsn=list_tmp(1:8) 2651 do ipsp=2,npsp+1 2652 list_tmp =list_char(ipsp) 2653 hdr%title(ipsp-1) =list_tmp(1:min(fnlen,132)) 2654 end do 2655 do ipsp=npsp+2,2*npsp+1 2656 hdr%md5_pseudos(ipsp-npsp-1) = list_char(ipsp)(1:md5_slen) 2657 end do 2658 end if 2659 ABI_FREE(list_char) 2660 2661 !Transmit the structured variables in case of PAW 2662 if (hdr%usepaw==1) then 2663 2664 nrhoij=0 2665 if (master==me)then 2666 cplex_rhoij=hdr%pawrhoij(1)%cplex_rhoij 2667 qphase=hdr%pawrhoij(1)%qphase 2668 nspden=hdr%pawrhoij(1)%nspden 2669 do iatom=1,natom 2670 nrhoij=nrhoij+hdr%pawrhoij(iatom)%nrhoijsel 2671 end do 2672 end if 2673 2674 call xmpi_bcast(nrhoij,master,comm,ierr) 2675 call xmpi_bcast(cplex_rhoij,master,comm,ierr) 2676 call xmpi_bcast(qphase,master,comm,ierr) 2677 call xmpi_bcast(nspden,master,comm,ierr) 2678 2679 list_size=natom+nrhoij;list_size2=nspden*nrhoij*cplex_rhoij*qphase 2680 ABI_MALLOC(list_int,(list_size)) 2681 ABI_MALLOC(list_dpr,(list_size2)) 2682 if (master==me)then 2683 index=0;index2=0 2684 do iatom=1,natom 2685 nsel=hdr%pawrhoij(iatom)%nrhoijsel 2686 lmn2_size=hdr%pawrhoij(iatom)%lmn2_size 2687 list_int(1+index)=nsel 2688 list_int(2+index:1+nsel+index)=hdr%pawrhoij(iatom)%rhoijselect(1:nsel) 2689 index=index+1+nsel 2690 do ispden=1,nspden 2691 do iq=1,qphase 2692 iq0=merge(0,lmn2_size*cplex_rhoij,iq==1) 2693 list_dpr(1+index2:nsel*cplex_rhoij+index2)=hdr%pawrhoij(iatom)%rhoijp(iq0+1:iq0+nsel*cplex_rhoij,ispden) 2694 index2=index2+nsel*cplex_rhoij 2695 end do 2696 end do 2697 end do 2698 end if 2699 2700 call xmpi_bcast(list_int,master,comm,ierr) 2701 call xmpi_bcast(list_dpr,master,comm,ierr) 2702 2703 if(master/=me)then 2704 index=0;index2=0 2705 ABI_MALLOC(hdr%pawrhoij,(natom)) 2706 call pawrhoij_alloc(hdr%pawrhoij,cplex_rhoij,nspden,hdr%nspinor,hdr%nsppol,hdr%typat,& 2707 lmnsize=hdr%lmn_size,qphase=qphase) 2708 do iatom=1,natom 2709 nsel=list_int(1+index) 2710 lmn2_size=hdr%pawrhoij(iatom)%lmn2_size 2711 hdr%pawrhoij(iatom)%nrhoijsel=nsel 2712 hdr%pawrhoij(iatom)%rhoijselect(1:nsel)=list_int(2+index:1+nsel+index) 2713 index=index+1+nsel 2714 do ispden=1,nspden 2715 do iq=1,qphase 2716 iq0=merge(0,lmn2_size*cplex_rhoij,iq==1) 2717 hdr%pawrhoij(iatom)%rhoijp(iq0+1:iq0+nsel*cplex_rhoij,ispden)=list_dpr(1+index2:nsel*cplex_rhoij+index2) 2718 index2=index2+nsel*cplex_rhoij 2719 end do 2720 end do 2721 end do 2722 end if 2723 ABI_FREE(list_int) 2724 ABI_FREE(list_dpr) 2725 end if 2726 2727 hdr%mband = maxval(hdr%nband) 2728 2729 DBG_EXIT("COLL") 2730 2731 end subroutine hdr_bcast
m_hdr/hdr_bsize_frecords [ Functions ]
[ Top ] [ m_hdr ] [ Functions ]
NAME
hdr_bsize_frecords
FUNCTION
Compute the size of the Fortran records of the WFK file from the header and formeig.
INPUTS
Hdr<hdr_type>=The abinit header. formeig = 0 for GS WFK, 1 for response function WFK. OUTPUTS nfrec = Number fof Fortran records bsize_frecords(nfrec) = Byte size of each records. Allocated inside this routine.
SOURCE
1698 subroutine hdr_bsize_frecords(Hdr, formeig, nfrec, bsize_frecords) 1699 1700 !Arguments ------------------------------------ 1701 !scalars 1702 integer,intent(in) :: formeig 1703 integer,intent(out) :: nfrec 1704 class(hdr_type),intent(in) :: Hdr 1705 !arrays 1706 integer(XMPI_OFFSET_KIND),allocatable,intent(out) :: bsize_frecords(:) 1707 1708 !Local variables------------------------------- 1709 !scalars 1710 integer :: max_nfrec,ik_ibz,spin,mband,nband_k,npw_k,band 1711 !arrays 1712 integer(XMPI_OFFSET_KIND),allocatable :: bsz_frec(:) 1713 1714 !************************************************************************ 1715 1716 !@hdr_type 1717 mband = MAXVAL(Hdr%nband) 1718 max_nfrec = Hdr%nkpt*Hdr%nsppol * (3 + mband) 1719 1720 if (formeig==1) max_nfrec = max_nfrec + Hdr%nkpt*Hdr%nsppol*mband 1721 ABI_MALLOC(bsz_frec, (max_nfrec)) 1722 1723 nfrec = 0 1724 do spin=1,Hdr%nsppol 1725 do ik_ibz=1,Hdr%nkpt 1726 nband_k = Hdr%nband(ik_ibz + (spin-1)*Hdr%nkpt) 1727 npw_k = Hdr%npwarr(ik_ibz) 1728 1729 ! First record: npw, nspinor, nband_disk 1730 nfrec = nfrec + 1 1731 bsz_frec(nfrec) = 3*xmpi_bsize_int 1732 1733 ! Record with kg_k(3,npw_k) vectors 1734 nfrec = nfrec + 1 1735 bsz_frec(nfrec) = 3*npw_k*xmpi_bsize_int 1736 1737 if (formeig==0) then 1738 ! Record with the eigenvalues 1739 ! eig_k(nband_k), occ_k(nband_k) 1740 nfrec = nfrec + 1 1741 bsz_frec(nfrec) = 2*nband_k*xmpi_bsize_dp 1742 1743 ! cg_k record 1744 do band=1,nband_k 1745 nfrec = nfrec + 1 1746 bsz_frec(nfrec) = 2*npw_k*Hdr%nspinor*xmpi_bsize_dp 1747 end do 1748 1749 else if (formeig==1) then 1750 do band=1,nband_k 1751 ! Record with the eigenvalues 1752 nfrec = nfrec + 1 1753 bsz_frec(nfrec) = 2*nband_k*xmpi_bsize_dp 1754 1755 ! cg_k record 1756 nfrec = nfrec + 1 1757 bsz_frec(nfrec) = 2*npw_k*Hdr%nspinor*xmpi_bsize_dp 1758 end do 1759 else 1760 ABI_ERROR("Wrong formeig") 1761 end if 1762 1763 end do 1764 end do 1765 1766 ABI_MALLOC(bsize_frecords, (nfrec)) 1767 bsize_frecords = bsz_frec(1:nfrec) 1768 1769 ABI_FREE(bsz_frec) 1770 1771 end subroutine hdr_bsize_frecords
m_hdr/hdr_check [ Functions ]
[ Top ] [ m_hdr ] [ Functions ]
NAME
hdr_check
FUNCTION
This subroutine compare the header structured variable (hdr) from input data (mostly dtset and psps) with the one (hdr0) of an input data file (e.g. wf, density, potential). Various values are checked for agreement or near agreement in the case of floating point numbers. The program will exit or produce warning messages when unexpected values are found. A record of the comparison of the headers is written to stdout. Decisions have been taken about whether a restart is allowed. In the self-consistent case, a restart will always be allowed, but one has to distinguish between a direct restart and a restart with translation of wavefunction. In the non-self-consistent case, the conditions below must be fulfilled to allow a restart.
INPUTS
fform=integer specification of data type (expected) fform0=integer specification of data type (from disk file) mode_paral: COLL or PERS, for all wrtout calls hdr <type(hdr_type)>=the header structured variable from dtset and psps hdr0<type(hdr_type)>=the header structured variable from the disk file
OUTPUT
restart=1 if direct restart, =2 if translation is needed, =0 if no
restart is possible.
restartpaw= deals with the additional information in the PAW method
=1 if direct restart, =0 if no restart from spherical data is possible.
also 0 if no restart is possible
NOTES
In the current version of the user interface restarts are allowed from
wavefunction files for self-consistent runs and from densities for
non-self-consistent runs. The precise conditions under which we will
allow a restart in this release are as follows.
self-consistent case : direct restarts
======================================
A direct restart will be allowed provided the following quantities in
old and new calculations are the same:
(A) the primitive vectors (tprim)
(B) the plane-wave cutoff (tecut)
(C) nkpt, kpt(3,nkpt), wtk(nkpt) (tkpt)
(D) istwfk(nkpt), the format of wavefunctions (twfk)
(E) nspinor, the scalar or spinor wf characteristics (tspinor)
For PAW calculations:
(F) the use of PAW method (tpaw)
(G) the number of lmn elements for the paw basis (tlmn)
(H) the energy cutoff for the double (fine) grid (tdg)
For WVL calculations:
(I) the number of wavelets differs (twvl)
(J) the space-grid size differs (tgrid)
non-self-consistent restarts
============================
A restart will be allowed provided the following quantities in
old and new calculation are the same
(A) the primitive vectors (tprim)
(B) the number of atoms of each type (tatty)
(C) xred(3,natom) (txred)
(D) pseudopotentials (not just pseudocharges) (tpseu)
(E) the plane-wave cutoff (tecut)
(F) ngfft(1:3) (tng)
For PAW calculations:
(G) the use of PAW method (tpaw)
(H) the number of lmn elements for the paw basis (tlmn)
(I) the energy cutoff for the double (fine) grid (tdg)
SOURCE
3805 subroutine hdr_check(fform, fform0, hdr, hdr0, mode_paral, restart, restartpaw) 3806 3807 !Arguments ------------------------------------ 3808 !scalars 3809 integer,intent(in) :: fform,fform0 3810 integer,intent(out) :: restart,restartpaw 3811 character(len=4),intent(in) :: mode_paral 3812 type(hdr_type),intent(in) :: hdr,hdr0 3813 3814 !Local variables------------------------------- 3815 character(len=500) :: bndfmt, occfmt, wtkfmt, zatfmt, typfmt 3816 !scalars 3817 integer,parameter :: mwarning=5,nkpt_max=5 3818 integer :: bantot,bantot_eff,ii,ipsp,isppol,istart,istop,isym,itest,iwarning 3819 integer :: jj,mu,natom,nelm,nkpt,npsp,nsppol,nsym,ntypat,tatty,tband,tdg 3820 integer :: tecut,tgrid,tkpt,tlmn,tng,tpaw,tprim,tpsch,tpseu,tspinor,tsym,twfk 3821 integer :: twvl,txred,enough 3822 real(dp) :: rms 3823 logical :: tfform2,tfform52 3824 character(len=500) :: msg 3825 type(abifile_t) :: abifile,abifile0 3826 3827 ! ************************************************************************* 3828 3829 !@hdr_type 3830 DBG_ENTER("COLL") 3831 3832 ! We will adopt convention that if things agree between restart 3833 ! and current calculation then the tflag is 0. Begin by assuming 3834 ! that there is complete agreement between the files 3835 3836 tatty = 0; tband = 0; tdg = 0 ; tecut = 0; tkpt = 0; 3837 tlmn = 0; tng = 0; tpaw = 0; tprim = 0; tpsch = 0; tpseu = 0; 3838 tspinor=0; tsym = 0; twfk = 0 ; txred = 0 ; twvl = 0 ; tgrid = 0 3839 3840 ! Write out a header 3841 write(msg,'(a1,80a,2a1,10x,a,3a1,10x,a,27x,a,a1,10x,19a,27x,12a,a1)' )& 3842 ch10,('=',ii=1,80),ch10,ch10,& 3843 '- hdr_check: checking restart file header for consistency -',& 3844 (ch10,ii=1,3),'current calculation','restart file',ch10,('-',ii=1,19),('-',ii=1,12),ch10 3845 call wrtout(std_out,msg,mode_paral) 3846 3847 ! Check validity of fform, and find filetype 3848 abifile = abifile_from_fform(fform) 3849 if (abifile%fform == 0) then 3850 ABI_ERROR(sjoin("Cannot find any abifile object associated to fform:", itoa(fform))) 3851 end if 3852 3853 ! Check validity of fform0, and find filetype 3854 abifile0 = abifile_from_fform(fform0) 3855 if (abifile0%fform == 0) then 3856 ABI_ERROR(sjoin("Cannot find any abifile object associated to fform:", itoa(fform0))) 3857 end if 3858 3859 write(msg,'(a,a17,3x,2a,a17)') & 3860 ' calculation expects a ',ljust(abifile%class, 17),'|',' input file contains a ',ljust(abifile0%class, 17) 3861 call wrtout(std_out,msg,mode_paral) 3862 3863 write(msg,'(a,a,13x,a,a,a)')& 3864 '. ABINIT code version ',hdr%codvsn,'|',' ABINIT code version ',hdr0%codvsn 3865 call wrtout(std_out,msg,mode_paral) 3866 3867 ! Check fform from input, not from header file 3868 if ( fform /= fform0) then 3869 write(msg,'(a,i0,a,i0,a)')'input fform=',fform,' differs from disk file fform=',fform0,'.' 3870 ABI_ERROR(msg) 3871 end if 3872 3873 write(msg, '(a,i8,a,i8,a,i4,2x,a,a,i8,a,i8,a,i4)' ) & 3874 '. date ',hdr %date,' bantot ',hdr %bantot,' natom ',hdr %natom,'|',& 3875 ' date ',hdr0%date,' bantot ',hdr0%bantot,' natom ',hdr0%natom 3876 call wrtout(std_out,msg,mode_paral) 3877 3878 write(msg, '(a,i8,a,i3,3(a,i4),2x,a,a,i8,a,i3,3(a,i4))' )& 3879 ' nkpt',hdr %nkpt,' nsym',hdr %nsym,' ngfft',hdr %ngfft(1),',',hdr %ngfft(2),',',hdr %ngfft(3),'|',& 3880 ' nkpt',hdr0%nkpt,' nsym',hdr0%nsym,' ngfft',hdr0%ngfft(1),',',hdr0%ngfft(2),',',hdr0%ngfft(3) 3881 call wrtout(std_out,msg,mode_paral) 3882 3883 if (hdr%usewvl == 0) then 3884 ! Note that the header actually contains ecut_eff=ecut*dilatmx**2 3885 write(msg,'(a,i3,a,f12.7,12x,a,a,i3,a,f12.7)')& 3886 ' ntypat',hdr %ntypat,' ecut_eff',hdr %ecut_eff,'|',& 3887 ' ntypat',hdr0%ntypat,' ecut_eff',hdr0%ecut_eff 3888 call wrtout(std_out,msg,mode_paral) 3889 else 3890 write(msg,'(a,i3,a,f12.7,12x,a,a,i3,a,f12.7)')& 3891 ' ntypat',hdr %ntypat,' hgrid ', 2. * hdr %rprimd(1,1) / (hdr %ngfft(1) - 31),'|',& 3892 ' ntypat',hdr0%ntypat,' hgrid ', 2. * hdr0%rprimd(1,1) / (hdr0%ngfft(1) - 31) 3893 call wrtout(std_out,msg,mode_paral) 3894 ! Check hgrid and rprimd values. 3895 if (hdr0%rprimd(1,2) /= zero .or. hdr0%rprimd(1,3) /= zero .or. & 3896 hdr0%rprimd(2,1) /= zero .or. hdr0%rprimd(2,3) /= zero .or. & 3897 hdr0%rprimd(3,1) /= zero .or. hdr0%rprimd(3,2) /= zero) then 3898 ABI_ERROR('disk file rprimd is not parallelepipedic.') 3899 end if 3900 if (abs(hdr0%rprimd(1,1) / hdr0%ngfft(1) - hdr %rprimd(1,1) / hdr %ngfft(1)) > tol8) then 3901 write(msg,'(a,F7.4,a,F7.4)')& 3902 'input wvl_hgrid=', 2. * hdr%rprimd(1,1) / hdr%ngfft(1), & 3903 'not equal disk file wvl_hgrid=', 2. * hdr0%rprimd(1,1) / hdr0%ngfft(1) 3904 ABI_COMMENT(msg) 3905 tgrid = 1 3906 end if 3907 end if 3908 3909 write(msg, '(a,i3,33x,a,a,i3)' )' usepaw',hdr %usepaw,'|',' usepaw',hdr0%usepaw 3910 call wrtout(std_out,msg,mode_paral) 3911 3912 write(msg, '(a,i3,33x,a,a,i3)' )' usewvl',hdr %usewvl,'|',' usewvl',hdr0%usewvl 3913 call wrtout(std_out,msg,mode_paral) 3914 3915 write(msg,'(a,35x,a,a,3(a1,2x,3f12.7,6x,a,2x,3f12.7))')& 3916 ' rprimd:','|',' rprimd:',ch10,& 3917 hdr%rprimd(:,1),'|',hdr0%rprimd(:,1),ch10,& 3918 hdr%rprimd(:,2),'|',hdr0%rprimd(:,2),ch10,& 3919 hdr%rprimd(:,3),'|',hdr0%rprimd(:,3) 3920 call wrtout(std_out,msg,mode_paral) 3921 3922 if (hdr%bantot/=hdr0%bantot) tband=1 3923 3924 if (hdr%intxc/=hdr0%intxc) then 3925 write(msg,'(a,i0,a,i0)')'input intxc=',hdr%intxc,' not equal disk file intxc=',hdr0%intxc 3926 ABI_WARNING(msg) 3927 end if 3928 3929 if (hdr%ixc/=hdr0%ixc) then 3930 write(msg,'(a,i0,a,i0)')'input ixc=',hdr%ixc,' not equal disk file ixc=',hdr0%ixc 3931 ABI_WARNING(msg) 3932 end if 3933 3934 if (hdr%natom/=hdr0%natom) then 3935 write(msg,'(a,i0,a,i0)')'input natom=',hdr%natom,' not equal disk file natom=',hdr0%natom 3936 ABI_WARNING(msg) 3937 tatty=1 3938 end if 3939 3940 if ( ANY(hdr%ngfft/=hdr0%ngfft) ) then 3941 ! For sensible rho(r) or V(r) data, fft grid must be identical 3942 ! Note, however, that we allow for different FFT meshes and we interpolate the density in the 3943 ! caller when we are restarting a SCF calculation. 3944 if (abifile%class == "density" .or. abifile%class == "potential") then 3945 write(msg, '(10a)' )& 3946 'FFT grids must be the same to restart from a ',trim(abifile%class),' file.',ch10,& 3947 "ngfft from file: ", trim(ltoa(hdr0%ngfft(1:3))), ", from input: ", trim(ltoa(hdr%ngfft(1:3))), ch10, & 3948 'Action: change the FFT grid in the input via ngfft or change the restart file.' 3949 ABI_ERROR(msg) 3950 end if 3951 tng=1 3952 end if 3953 3954 if (hdr%nkpt/=hdr0%nkpt) then 3955 if (abifile%class == "wf_planewave") then 3956 write(msg,'(a,i0,a,i0)' )'input nkpt=',hdr%nkpt,' not equal disk file nkpt=',hdr0%nkpt 3957 ABI_COMMENT(msg) 3958 end if 3959 tkpt=1; twfk=1 3960 end if 3961 3962 if (hdr%nspinor/=hdr0%nspinor) then 3963 if (abifile%class == "wf_planewave") then 3964 write(msg,'(a,i0,a,i0)')'input nspinor=',hdr%nspinor,' not equal disk file nspinor=',hdr0%nspinor 3965 ABI_WARNING(msg) 3966 end if 3967 tspinor=1 3968 end if 3969 3970 ! No check is present for nspden 3971 if (hdr%nsppol/=hdr0%nsppol) then 3972 write(msg,'(a,i0,a,i0)')'input nsppol=',hdr%nsppol,' not equal disk file nsppol=',hdr0%nsppol 3973 ABI_WARNING(msg) 3974 end if 3975 3976 if (hdr%nsym/=hdr0%nsym) then 3977 write(msg, '(a,i0,a,i0)' )'input nsym=',hdr%nsym,' not equal disk file nsym=',hdr0%nsym 3978 ABI_WARNING(msg) 3979 tsym=1 3980 end if 3981 3982 if (hdr%ntypat/=hdr0%ntypat) then 3983 write(msg,'(a,i0,a,i0)')'input ntypat=',hdr%ntypat,' not equal disk file ntypat=',hdr0%ntypat 3984 call wrtout(std_out,msg,mode_paral) 3985 ABI_WARNING(msg) 3986 tatty=1 3987 end if 3988 3989 if (hdr%usepaw/=hdr0%usepaw) then 3990 write(msg,'(a,i0,a,i0)')'input usepaw=',hdr%usepaw,' not equal disk file usepaw=',hdr0%usepaw 3991 ABI_WARNING(msg) 3992 tpaw=1 3993 end if 3994 3995 if (hdr%usewvl/=hdr0%usewvl) then 3996 write(msg, '(a,i6,a,i6,a,a)' )& 3997 'input usewvl=',hdr%usewvl,' not equal disk file usewvl=',hdr0%usewvl, ch10, & 3998 'Action: change usewvl input variable or your restart file.' 3999 ABI_ERROR(msg) 4000 end if 4001 4002 ! Also examine agreement of floating point data 4003 if (hdr%usewvl == 0 .and. abs(hdr%ecut_eff-hdr0%ecut_eff)>tol8) then 4004 write(msg,'(a,f12.6,a,f12.6,a)')'input ecut_eff=',hdr%ecut_eff,' /= disk file ecut_eff=',hdr0%ecut_eff,'.' 4005 ABI_WARNING(msg) 4006 tecut=1 4007 end if 4008 4009 do ii=1,3 4010 do jj=1,3 4011 if (abs(hdr%rprimd(ii,jj)-hdr0%rprimd(ii,jj))>tol6) then 4012 write(msg, '(a,i1,a,i1,a,1p,e17.9,a,i1,a,i1,a,e17.9)' )& 4013 'input rprimd(',ii,',',jj,')=',hdr%rprimd(ii,jj),' /= disk file rprimd(',ii,',',jj,')=',hdr0%rprimd(ii,jj) 4014 ABI_WARNING(msg) 4015 tprim=1 4016 end if 4017 end do 4018 end do 4019 4020 ! Below this point many comparisons only make sense if 4021 ! certain things agree, e.g. nkpt, natom. Also have to 4022 ! accomodate different amounts of data in general. 4023 4024 if (hdr%usepaw==1 .and. hdr0%usepaw==1) then 4025 4026 ! Compare ecutdg (PAW) 4027 write(msg, '(a,f12.6,19x,a,a,f12.6)' )' PAW: ecutdg',hdr %ecutdg,'|',' PAW: ecutdg',hdr0%ecutdg 4028 call wrtout(std_out,msg,mode_paral) 4029 if (hdr%ecutdg/=hdr0%ecutdg) then 4030 write(msg, '(a,f12.6,a,f12.6)' )'input ecutdg=',hdr%ecutdg,'not equal disk file ecutdg=',hdr0%ecutdg 4031 ABI_WARNING(msg) 4032 tdg=1 4033 end if 4034 end if 4035 4036 ! Compare nband(nkpt*nsppol) (cannot compare if nkpt and nsppol not same) 4037 if (hdr%nkpt==hdr0%nkpt .and. hdr%nsppol==hdr0%nsppol) then 4038 nkpt=hdr%nkpt ; nsppol=hdr%nsppol 4039 write(msg,'(a,36x,a,a)') ' nband:','|',' nband:' 4040 call wrtout(std_out,msg,mode_paral) 4041 do istart = 1,nsppol*nkpt,9 4042 istop = min(istart + 8,nsppol*nkpt) 4043 mu = istop - istart + 1 4044 ! generate a format specifier 4045 bndfmt = strcat('(2x,',itoa(mu),'i4,t41,a,2x,',itoa(mu),'i4)') 4046 if (istart<=100) then 4047 write(msg,fmt=bndfmt) hdr%nband(istart:istop),' |',hdr0%nband(istart:istop) 4048 call wrtout(std_out,msg,mode_paral) 4049 if (istop>100) call wrtout(std_out, '=> stop printing nband after 100 values', mode_paral) 4050 end if 4051 end do 4052 4053 enough = 0 4054 do isppol=1,nsppol 4055 do ii=1,nkpt 4056 if (hdr%nband(ii)/=hdr0%nband(ii)) then 4057 tband=1 4058 enough = enough + 1 4059 if (abifile%class == "wf_planewave") then 4060 if (enough > 5) then 4061 write(std_out, "(a)")"Stop writing warnings after 5 values" 4062 exit 4063 else 4064 write(msg,'(a,i0,a,i0,a,i0)' )& 4065 'kpt num ',ii,' input nband= ',hdr%nband(ii),' not equal disk file nband=',hdr0%nband(ii) 4066 ABI_WARNING(msg) 4067 end if 4068 end if 4069 end if 4070 end do 4071 end do 4072 end if 4073 4074 ! Compare the number of wavelets in each resolution. 4075 if (hdr%usewvl == 1) then 4076 if (size(hdr%nwvlarr) /= size(hdr0%nwvlarr) .or. size(hdr%nwvlarr) /= 2) then 4077 write(msg, '(a,i0,a,i0,a,a)' )& 4078 'input nwvlres= ',size(hdr%nwvlarr),' not equal disk file nwvlres= ',size(hdr0%nwvlarr),' or 2',& 4079 ' ABINIT is not implemented for wavelet resolutions different from 2.' 4080 ABI_ERROR(msg) 4081 end if 4082 end if 4083 4084 ! Compare symmetry arrays (integers) symafm(nsym) 4085 ! only for same number of symmetries nsym 4086 itest=0 4087 if (hdr%nsym==hdr0%nsym) then 4088 nsym=hdr%nsym 4089 write(msg,'(a,35x,a,a)') ' symafm:','|',' symafm:' 4090 call wrtout(std_out,msg,mode_paral) 4091 do istart = 1,nsym,12 4092 istop=min(istart+11,nsym) 4093 nelm = istop - istart + 1 4094 typfmt = strcat('(2x,',itoa(nelm),'i3,t41,a,2x,',itoa(nelm),'i3)') 4095 write(msg,fmt=typfmt) hdr%symafm(istart:istop),' |',hdr0%symafm(istart:istop) 4096 call wrtout(std_out,msg,mode_paral) 4097 end do 4098 end if 4099 4100 if (itest/=0) then 4101 write(msg,'(a,i0,a)' )'For symmetry number',itest,' input symafm not equal disk file symafm' 4102 ABI_WARNING(msg) 4103 tsym=1 4104 end if 4105 4106 ! Compare symmetry arrays (integers) symrel(3,3,nsym) 4107 ! only for same number of symmetries nsym 4108 itest=0 4109 if (hdr%nsym==hdr0%nsym) then 4110 nsym=hdr%nsym 4111 write(msg,'(a,35x,a,a)') ' symrel:','|',' symrel:' 4112 call wrtout(std_out,msg,mode_paral) 4113 do isym=1,nsym 4114 write(msg,'(2x,9i3,15x,a,2x,9i3)')hdr%symrel(:,:,isym),'|',hdr0%symrel(:,:,isym) 4115 call wrtout(std_out,msg,mode_paral) 4116 if(sum(abs(hdr%symrel(:,:,isym)-hdr0%symrel(:,:,isym)))/=0)then 4117 itest=isym 4118 exit 4119 end if 4120 end do 4121 end if 4122 4123 if (itest/=0) then 4124 write(msg,'(a,i0,a)')'For symmetry number',itest,' input symrel not equal disk file symrel' 4125 ABI_WARNING(msg) 4126 tsym=1 4127 end if 4128 4129 ! Compare typat(natom) 4130 if (hdr%natom==hdr0%natom) then 4131 natom=hdr%natom 4132 write(msg,'(a,36x,a,a)') ' typat:','|',' typat:' 4133 call wrtout(std_out,msg,mode_paral) 4134 do istart = 1,natom,12 4135 istop=min(istart+11,natom) 4136 nelm = istop - istart + 1 4137 typfmt = strcat('(2x,',itoa(nelm),'i3,t41,a,2x,',itoa(nelm),'i3)') 4138 write(msg,fmt=typfmt) hdr%typat(istart:istop),' |',hdr0%typat(istart:istop) 4139 call wrtout(std_out,msg,mode_paral) 4140 end do 4141 do ii=1,natom 4142 if (hdr%typat(ii)/=hdr0%typat(ii)) then 4143 write(msg, '(a,i0,a,i0,a,i0)' )& 4144 'For atom number ',ii,' input typat=',hdr%typat(ii),' not equal disk file typat=',hdr0%typat(ii) 4145 ABI_WARNING(msg) 4146 tatty=1 4147 end if 4148 end do 4149 end if 4150 4151 ! Compare so_psp(npsp) 4152 if (hdr%npsp==hdr0%npsp) then 4153 npsp=hdr%npsp 4154 write(msg,'(a,33x,a,a)') ' so_psp :','|',' so_psp :' 4155 call wrtout(std_out,msg,mode_paral) 4156 do istart = 1,npsp ,12 4157 istop=min(istart+11,npsp ) 4158 nelm = istop - istart + 1 4159 typfmt = strcat('(2x,',itoa(nelm),'i3,t41,a,2x,',itoa(nelm),'i3)') 4160 write(msg,fmt=typfmt) hdr%so_psp (istart:istop),' |',hdr0%so_psp (istart:istop) 4161 call wrtout(std_out,msg,mode_paral) 4162 end do 4163 do ii=1,npsp 4164 if (hdr%so_psp (ii)/=hdr0%so_psp (ii)) then 4165 write(msg,'(a,i0,a,i0,a,i0)')& 4166 'For pseudopotential number ',ii,' input so_psp =',hdr%so_psp(ii),' not equal disk file so_psp=',hdr0%so_psp(ii) 4167 ABI_WARNING(msg) 4168 end if 4169 end do 4170 end if 4171 4172 ! Compare istwfk(nkpt) 4173 if (hdr%nkpt==hdr0%nkpt) then 4174 nkpt=hdr%nkpt 4175 write(msg,'(a,35x,a,a)') ' istwfk:','|',' istwfk:' 4176 call wrtout(std_out,msg,mode_paral) 4177 do istart = 1,nkpt,12 4178 istop=min(istart+11,nkpt) 4179 nelm = istop - istart + 1 4180 typfmt = strcat('(2x,',itoa(nelm),'i3,t41,a,2x,',itoa(nelm),'i3)') 4181 if (istart<=100) then 4182 write(msg,fmt=typfmt) hdr%istwfk(istart:istop),' |',hdr0%istwfk(istart:istop) 4183 call wrtout(std_out,msg,mode_paral) 4184 if (istop>100) then 4185 call wrtout(std_out, '=> stop printing istwfk after 100 values' ,mode_paral) 4186 end if 4187 end if 4188 end do 4189 do ii=1,nkpt 4190 if (hdr%istwfk(ii)/=hdr0%istwfk(ii)) then 4191 write(msg, '(a,i0,a,i0,a,i0)' )& 4192 'For k point number ',ii,' input istwfk=',hdr%istwfk(ii),' not equal disk file istwfk=',hdr0%istwfk(ii) 4193 ABI_COMMENT(msg) 4194 twfk=1 4195 end if 4196 end do 4197 end if 4198 4199 !NEW_HDR 4200 if (any(hdr%kptrlatt /= hdr0%kptrlatt)) then 4201 write(msg,"(2(a,9(i0,1x)))")"input kptrlatt = ",hdr%kptrlatt," /= disk file kptrlatt = ",hdr0%kptrlatt 4202 ABI_COMMENT(msg) 4203 end if 4204 if (hdr%kptopt /= hdr0%kptopt) then 4205 ABI_COMMENT(sjoin("input kptopt = ", itoa(hdr%kptopt)," /= disk file kptopt = ", itoa(hdr0%kptopt))) 4206 end if 4207 if (hdr%pawcpxocc /= hdr0%pawcpxocc) then 4208 ABI_WARNING(sjoin("input pawcpxocc = ", itoa(hdr%pawcpxocc)," /= disk file pawcpxocc = ", itoa(hdr0%pawcpxocc))) 4209 end if 4210 if (hdr%icoulomb /= hdr0%icoulomb) then 4211 ABI_WARNING(sjoin("input icoulomb = ", itoa(hdr%icoulomb)," /= disk file icoulomb = ", itoa(hdr0%icoulomb))) 4212 end if 4213 4214 if (abs(hdr%nelect - hdr0%nelect) > tol6) then 4215 ABI_WARNING(sjoin("input nelect = ", ftoa(hdr%nelect)," /= disk file nelect = ",ftoa(hdr0%nelect))) 4216 end if 4217 4218 if (abs(hdr%ne_qFD - hdr0%ne_qFD) > tol6) then 4219 ABI_WARNING(sjoin("input ne_qFD = ", ftoa(hdr%ne_qFD)," /= disk file nelect = ",ftoa(hdr0%ne_qFD))) 4220 end if 4221 if (abs(hdr%nh_qFD - hdr0%nh_qFD) > tol6) then 4222 ABI_WARNING(sjoin("input nh_qFD = ", ftoa(hdr%nh_qFD)," /= disk file nelect = ",ftoa(hdr0%nh_qFD))) 4223 end if 4224 if (hdr%ivalence/=hdr0%ivalence) then 4225 write(msg,'(a,i0,a,i0)')'input ival=',hdr%ivalence,' not equal disk file ival=',hdr0%ivalence 4226 ABI_WARNING(msg) 4227 end if 4228 4229 if (abs(hdr%cellcharge - hdr0%cellcharge) > tol6) then 4230 ABI_WARNING(sjoin("input cellcharge = ", ftoa(hdr%cellcharge)," /= disk file cellcharge = ", ftoa(hdr0%cellcharge))) 4231 end if 4232 4233 if (hdr%ntypat==hdr0%ntypat) then 4234 if (any(abs(hdr%amu - hdr0%amu) > tol6)) then 4235 ABI_WARNING(sjoin("input amu = ",ltoa(hdr%amu)," /= disk file amu = ",ltoa(hdr0%amu))) 4236 end if 4237 end if 4238 !end NEW_HDR 4239 4240 ! Compare kpt(3,nkpt) 4241 if (hdr%nkpt==hdr0%nkpt) then 4242 nkpt=hdr%nkpt 4243 write(msg,'(a,38x,a,a)') ' kpt:','|',' kpt:' 4244 call wrtout(std_out,msg,mode_paral) 4245 do ii = 1,min(nkpt,nkpt_max) 4246 write(msg,'(2x,3f12.7,2x,a,2x,3f12.7)')hdr%kptns(:,ii),' |',hdr0%kptns(:,ii) 4247 call wrtout(std_out,msg,mode_paral) 4248 if(ii>nkpt_max)then 4249 call wrtout(std_out,'The number of printed k points is sufficient... stop writing them.',mode_paral) 4250 exit 4251 end if 4252 end do 4253 iwarning=0 4254 do ii=1,nkpt 4255 itest=0 4256 do mu=1,3 4257 if(abs( hdr%kptns(mu,ii)-hdr0%kptns(mu,ii) )>tol6)itest=1 4258 end do 4259 if (itest==1) then 4260 write(msg, '(a,i5,a,3es17.7,a,a,3es17.7)' )& 4261 'kpt num',ii,', input kpt=',hdr%kptns(:,ii),ch10,& 4262 'not equal disk file kpt=',hdr0%kptns(:,ii) 4263 ABI_WARNING(msg) 4264 tkpt=1 ; iwarning=iwarning+1 4265 if(iwarning>=mwarning)then 4266 call wrtout(std_out,'The number of warning messages is sufficient ... stop writing them.',mode_paral) 4267 exit 4268 end if 4269 end if 4270 end do 4271 end if 4272 4273 ! Compare wtk(nkpt) 4274 if (hdr%nkpt==hdr0%nkpt) then 4275 nkpt=hdr%nkpt 4276 4277 write(msg,'(a,38x,a,a)') ' wtk:','|',' wtk:' 4278 call wrtout(std_out,msg,mode_paral) 4279 istop = min(nkpt,nkpt_max) 4280 do ii = 1, istop, 5 4281 mu = min(5, istop - ii + 1) 4282 wtkfmt = strcat('(2x,',itoa(mu),'f7.3,t41,a,2x,',itoa(mu),'f7.3)') 4283 write(msg, wtkfmt)hdr%wtk(ii:min(istop, ii + 5 - 1)),' |',hdr0%wtk(ii:min(istop, ii + 5 - 1)) 4284 call wrtout(std_out,msg,mode_paral) 4285 end do 4286 iwarning=0 4287 do ii=1,nkpt 4288 itest=0 4289 if (abs( hdr%wtk(ii)-hdr0%wtk(ii) )>tol6) then 4290 write(msg,'(a,i5,a,es17.7,a,a,es17.7)')& 4291 'kpt num',ii,', input weight=',hdr%wtk(ii),ch10,& 4292 'not equal to disk file weight=',hdr0%wtk(ii) 4293 ABI_WARNING(msg) 4294 4295 tkpt=1 ; iwarning=iwarning+1 4296 if(iwarning>=mwarning)then 4297 call wrtout(std_out,'The number of warning messages is sufficient ... stop writing them.',mode_paral) 4298 exit 4299 end if 4300 end if 4301 end do 4302 end if 4303 4304 ! Compare occ(bantot) 4305 if (hdr%nkpt==hdr0%nkpt.and. hdr%bantot==hdr0%bantot) then 4306 nkpt=hdr%nkpt 4307 bantot=hdr%bantot 4308 4309 write(msg,'(a,38x,a,a)') ' occ:','|',' occ:' 4310 call wrtout(std_out,msg,mode_paral) 4311 bantot_eff=min(bantot,9*nkpt_max) 4312 do istart = 1,bantot_eff,9 4313 istop = min(istart+8,bantot_eff) 4314 mu = istop - istart + 1 4315 occfmt = strcat('(2x,',itoa(mu),'f4.1,t41,a,2x,',itoa(mu),'f4.1)') 4316 write(msg,fmt=occfmt)hdr%occ(istart:istop),' |', hdr0%occ(istart:istop) 4317 call wrtout(std_out,msg,mode_paral) 4318 if(istart>9*nkpt_max)then 4319 call wrtout(std_out,'The number of printed occupation numbers is sufficient ... stop writing them.',mode_paral) 4320 exit 4321 end if 4322 end do 4323 iwarning=0 4324 do ii=1,bantot 4325 if (abs( hdr%occ(ii)-hdr0%occ(ii) )>tol6) then 4326 write(msg,'(a,i0,a,1p,e15.7,a,e15.7)')'band,k: ',ii,', input occ=',hdr%occ(ii),' disk occ=',hdr0%occ(ii) 4327 ABI_WARNING(msg) 4328 tband=1 ; iwarning=iwarning+1 4329 if(iwarning>=mwarning)then 4330 call wrtout(std_out,'The number of warning msgs is sufficient ... stop writing them.',mode_paral) 4331 exit 4332 end if 4333 end if 4334 end do 4335 end if 4336 4337 ! Compare tnons(3,nsym) 4338 if (hdr%nsym==hdr0%nsym) then 4339 nsym=hdr%nsym 4340 itest=0 4341 write(msg,'(a,36x,a,a)') ' tnons:','|',' tnons:' 4342 call wrtout(std_out,msg,mode_paral) 4343 do isym=1,nsym 4344 write(msg,'(2x,3f12.7,2x,a,2x,3f12.7)') hdr%tnons(:,isym),' |',hdr0%tnons(:,isym) 4345 call wrtout(std_out,msg,mode_paral) 4346 end do 4347 4348 do isym=1,nsym 4349 if( sum(abs( hdr%tnons(:,isym)-hdr0%tnons(:,isym) )) > tol6) then 4350 itest=isym 4351 exit 4352 end if 4353 end do 4354 if (itest/=0) then 4355 write(msg, '(a,i0,a)' )'For symmetry number ',itest,' input tnons not equal disk file tnons' 4356 ABI_WARNING(msg) 4357 end if 4358 end if 4359 4360 ! Compare znucltypat(ntypat) 4361 if (hdr%ntypat==hdr0%ntypat) then 4362 ntypat=hdr%ntypat 4363 4364 write(msg,'(a,35x,a,a)') ' znucl:','|',' znucl:' 4365 call wrtout(std_out,msg,mode_paral) 4366 do istart = 1,ntypat,6 4367 istop = min(istart+5,ntypat) 4368 mu = istop-istart+1 4369 zatfmt = strcat('(2x,',itoa(mu),'f6.2,t41,a,6x,',itoa(mu),'f6.2)') 4370 write(msg,fmt=zatfmt) hdr%znucltypat(istart:istop),' |',hdr0%znucltypat(istart:istop) 4371 call wrtout(std_out,msg,mode_paral) 4372 end do 4373 4374 do ii=1,ntypat 4375 if (abs(hdr%znucltypat(ii)-hdr0%znucltypat(ii))>tol6) then 4376 write(msg, '(a,i5,a,f12.6,a,f12.6)' )& 4377 ' For atom number ',ii,' input znucl=',hdr%znucltypat(ii),' not equal disk file znucl=',hdr0%znucltypat(ii) 4378 ABI_WARNING(msg) 4379 end if 4380 end do 4381 end if 4382 4383 ! Should perform some checks related to pertcase and qptn, 4384 ! that have been introduced in the header in v4.1 4385 ! Warning: a GS file might be read, while the hdr corresponds 4386 ! to a RF file (to initialize k+q), and vice-versa (in nonlinear). 4387 4388 ! Now check agreement of psp headers too 4389 if (hdr%npsp==hdr0%npsp) then 4390 npsp=hdr%npsp 4391 itest=0 4392 4393 do ipsp=1,npsp 4394 write(msg,'(a,i3,a,13x,a,a,i3,a)')& 4395 ' pseudopotential atom type',ipsp,':','|',' pseudopotential atom type',ipsp,':' 4396 call wrtout(std_out,msg,mode_paral) 4397 4398 if (hdr%usepaw==1 .and. hdr0%usepaw==1) then 4399 write(msg,'(a,i3,a,i7,a,i3,5x,a,a,i3,a,i7,a,i3)')& 4400 ' pspso ',hdr %pspso(ipsp),' pspxc ',hdr %pspxc(ipsp),& 4401 ' lmn_size ',hdr%lmn_size(ipsp),'|',& 4402 ' pspso ',hdr0%pspso(ipsp),' pspxc ',hdr0%pspxc(ipsp),& 4403 ' lmn_size ',hdr0%lmn_size(ipsp) 4404 call wrtout(std_out,msg,mode_paral) 4405 if (hdr%lmn_size(ipsp)/=hdr0%lmn_size(ipsp)) then 4406 write(msg, '(a,i3,a,i3,a,i3)' )& 4407 'For atom type ',ipsp,' input lmn_size=',hdr%lmn_size(ipsp),& 4408 'not equal disk file lmn_size=',hdr0%lmn_size(ipsp) 4409 ABI_WARNING(msg) 4410 tlmn=1 4411 end if 4412 else 4413 write(msg,'(a,i3,a,i3,23x,a,a,i3,a,i3)')& 4414 ' pspso ',hdr %pspso(ipsp),' pspxc ',hdr %pspxc(ipsp),'|',& 4415 ' pspso ',hdr0%pspso(ipsp),' pspxc ',hdr0%pspxc(ipsp) 4416 call wrtout(std_out,msg,mode_paral) 4417 end if 4418 write(msg,'(a,i8,a,i4,a,f5.1,4x,a,a,i8,a,i4,a,f5.1)')& 4419 ' pspdat ',hdr %pspdat(ipsp),' pspcod ',hdr %pspcod(ipsp),& 4420 ' zion ',hdr %zionpsp(ipsp),'|',& 4421 ' pspdat ',hdr0%pspdat(ipsp),' pspcod ',hdr0%pspcod(ipsp),& 4422 ' zion ',hdr0%zionpsp(ipsp) 4423 call wrtout(std_out,msg,mode_paral) 4424 4425 ! Check on md5 values. 4426 if (hdr%md5_pseudos(ipsp) /= hdr0%md5_pseudos(ipsp)) then 4427 write(msg, '(a,i0,6a)' )& 4428 ' Different md5 checksum for pseudo ',ipsp,ch10,& 4429 ' input md5= ',hdr%md5_pseudos(ipsp),ch10,& 4430 ' disk md5= ',hdr0%md5_pseudos(ipsp) 4431 ABI_WARNING(msg) 4432 itest=1; tpsch=1 4433 end if 4434 4435 ! Second, test 4436 ! NOTE, XG 000719: should do something about pspso 4437 ! NOTE, XG 020716: znucl and zion are not written 4438 if (abs(hdr%znuclpsp(ipsp)-hdr0%znuclpsp(ipsp))>tol6) itest=1 4439 if (abs(hdr%zionpsp(ipsp)-hdr0%zionpsp(ipsp))>tol6) then 4440 itest=1; tpsch=1 4441 end if 4442 if (hdr%pspdat(ipsp)/= hdr0%pspdat(ipsp)) itest=1 4443 if (hdr%pspcod(ipsp)/= hdr0%pspcod(ipsp)) itest=1 4444 if (hdr%pspxc(ipsp) /= hdr0%pspxc(ipsp) ) itest=1 4445 end do 4446 4447 if (itest==1) then 4448 ABI_WARNING('input psp header does not agree perfectly with disk file psp header.') 4449 tpseu=1 4450 end if 4451 end if 4452 4453 ! Finally, read residm and etotal ("current value" not known), and check xred. 4454 if (hdr%natom==hdr0%natom) then 4455 natom=hdr%natom 4456 write(msg,'(a,37x,a,a)') ' xred:','|',' xred:' 4457 call wrtout(std_out,msg,mode_paral) 4458 do ii=1,natom 4459 write(msg,'(2x,3f12.7,6x,a,2x,3f12.7)') hdr%xred(:,ii),'|',hdr0%xred(:,ii) 4460 call wrtout(std_out,msg,mode_paral) 4461 end do 4462 4463 ! check atom positions one atom at a time and allow possibility 4464 ! that there is a harmless translation of atoms by a cell vector. 4465 do ii=1,natom 4466 rms=0.0_dp 4467 do jj=1,3 4468 rms=rms+(hdr%xred(jj,ii)-hdr0%xred(jj,ii) - dble(nint((hdr%xred(jj,ii)-hdr0%xred(jj,ii)))) )**2 4469 end do 4470 rms=sqrt(rms/3.0_dp) 4471 if (rms>tol6) txred=1 4472 end do 4473 end if 4474 4475 ! Run tests here to establish whether this is a valid restart 4476 4477 ! tfform2 will be true if there is a problem for the wavefunctions 4478 tfform2 = (hdr%usewvl == 0 .and. & 4479 (tprim /= 0 .or. tecut /= 0 .or. tkpt /= 0 .or. & 4480 twfk /=0 .or. tspinor /= 0)) .or. & 4481 (hdr%usepaw == 1 .and. & 4482 (tpaw /= 0 .or. tlmn /= 0 .or. tdg /= 0)) .or. & 4483 (hdr%usewvl == 1 .and. & 4484 (tatty /= 0 .or. tband /= 0)) 4485 4486 ! tfform52 will be true if there is a problem for the format 52 4487 tfform52 = tprim /= 0 .or. tatty /= 0 .or. txred /= 0 .or.& 4488 tpseu /= 0 .or. tecut /= 0 .or. tng /= 0 .or. & 4489 (hdr%usepaw == 1 .and. (tpaw /= 0 .or. tlmn /= 0 .or. tdg /= 0)) 4490 4491 restart=1; restartpaw=hdr%usepaw 4492 4493 ! If there is a problem somewhere 4494 if ( (abifile%class == "wf_planewave" .and. tfform2 ) .or. & 4495 (abifile%class == "density" .and. tfform52 ) .or. & 4496 (abifile%class == "wf_wavelet" .and. tfform2 ) ) then 4497 4498 if (abifile%class == "wf_planewave") then 4499 restart=2 4500 ABI_COMMENT('Restart of self-consistent calculation need translated wavefunctions.') 4501 else if (abifile%class == "density") then 4502 restart=0 4503 ABI_WARNING('Illegal restart of non-self-consistent calculation') 4504 end if 4505 4506 write(msg,'(a,a1,a)') & 4507 ' Indeed, critical differences between current calculation and',ch10,& 4508 ' restart file have been detected in:' 4509 call wrtout(std_out,msg,mode_paral) 4510 4511 if ( (abifile%class == "density" .or. abifile%class == "wf_wavelet") .and. tatty /= 0 ) then 4512 write(msg, '(8x,a)' ) '* the number of atoms of each type' 4513 call wrtout(std_out,msg,mode_paral) 4514 end if 4515 if ( abifile%class /= "wf_wavelet" .and. tecut /= 0 ) then 4516 write(msg, '(8x,a)' ) '* the plane-wave cutoff' 4517 call wrtout(std_out,msg,mode_paral) 4518 end if 4519 if ( abifile%class == "wf_wavelent" .and. tband /= 0 ) then 4520 write(msg, '(8x,a)' ) '* the band and their occupation' 4521 call wrtout(std_out,msg,mode_paral) 4522 end if 4523 if ( abifile%class == "wf_planewave" .and. tkpt /= 0 ) then 4524 write(msg, '(8x,a)' ) '* the number, position, or weight of k-points' 4525 call wrtout(std_out,msg,mode_paral) 4526 end if 4527 if ( abifile%class == "wf_planewave" .and. twfk /= 0 ) then 4528 write(msg, '(8x,a)' ) '* the format of wavefunctions (istwfk)' 4529 call wrtout(std_out,msg,mode_paral) 4530 end if 4531 if ( abifile%class == "wf_planewave" .and. tspinor /= 0 ) then 4532 write(msg, '(8x,a)' ) '* the scalar/spinor character of the wf (nspinor)' 4533 call wrtout(std_out,msg,mode_paral) 4534 end if 4535 if ( abifile%class == "density" .and. tng /= 0 ) then 4536 write(msg, '(8x,a)' ) '* the Fourier transform box dimensions' 4537 call wrtout(std_out,msg,mode_paral) 4538 end if 4539 if ( tprim /= 0 ) then 4540 write(msg, '(8x,a)' )'* the vectors defining the unit cell (obtained from rprim and acell)' 4541 call wrtout(std_out,msg,mode_paral) 4542 end if 4543 if ( abifile%class == "density" .and. tpseu /= 0 ) then 4544 write(msg, '(8x,a)' )'* the pseudopotential files' 4545 call wrtout(std_out,msg,mode_paral) 4546 end if 4547 if ( abifile%class == "density" .and. txred /= 0 ) then 4548 write(msg, '(8x,a)' ) '* the positions of the ions in the basis' 4549 call wrtout(std_out,msg,mode_paral) 4550 end if 4551 4552 ! Tests for a restart in the framework of the PAW method 4553 if (hdr%usepaw/=0 .or. hdr0%usepaw/=0) then 4554 if (tpaw /= 0 .or. tlmn /= 0) restartpaw=0 4555 if (restartpaw == 0) then 4556 write(msg,'(8x,a)') 'Critical differences for a restart within PAW method:' 4557 call wrtout(std_out,msg,mode_paral) 4558 if ( tpaw /= 0 ) then 4559 write(msg, '(8x,a)' ) '* the use of the PAW method' 4560 call wrtout(std_out,msg,mode_paral) 4561 else 4562 if(tlmn/=0)then 4563 write(msg, '(8x,a)' ) '* the number of lmn elements for the paw basis' 4564 call wrtout(std_out,msg,mode_paral) 4565 end if 4566 end if 4567 else if (tdg/=0) then 4568 write(msg,'(a,a,a,a,a,a)') ch10,& 4569 ' hdr_check: WARNING -',ch10,& 4570 ' Restart of calculation within PAW may be inconsistent because of:"' 4571 call wrtout(std_out,msg,mode_paral) 4572 if(tdg/=0)then 4573 write(msg, '(8x,a)' )'* the cutoff energy of the paw double (fine) grid' 4574 call wrtout(std_out,msg,mode_paral) 4575 end if 4576 end if 4577 end if 4578 4579 else 4580 4581 if (abifile%class == "wf_planewave" .or. abifile%class == "wf_wavelet") then 4582 write(msg,'(a,a)') ' hdr_check: ',' Wavefunction file is OK for direct restart of calculation' 4583 call wrtout(std_out,msg,mode_paral) 4584 else if (abifile%class == "density") then 4585 write(msg,'(a,a)') ' hdr_check: ',' Density/Potential file is OK for restart of calculation' 4586 call wrtout(std_out,msg,mode_paral) 4587 end if 4588 end if 4589 4590 write(msg,'(80a)') ('=',ii=1,80) 4591 call wrtout(std_out,msg,mode_paral) 4592 4593 end subroutine hdr_check
m_hdr/hdr_copy [ Functions ]
[ Top ] [ m_hdr ] [ Functions ]
NAME
hdr_copy
FUNCTION
Deep copy of the abinit header.
INPUTS
Hdr_in=The header to be copied.
OUTPUT
Hdr_cp=The deep copy of Hdr_in.
NOTES
The present version deals with versions of the header up to 56.
SOURCE
1052 subroutine hdr_copy(Hdr_in,Hdr_cp) 1053 1054 !Arguments ------------------------------------ 1055 !scalars 1056 class(hdr_type),intent(in) :: Hdr_in 1057 type(hdr_type),intent(inout) :: Hdr_cp 1058 1059 !Local variables------------------------------- 1060 !scalars 1061 integer :: cplex_rhoij,nspden_rhoij,qphase_rhoij 1062 1063 ! ************************************************************************* 1064 1065 !@hdr_type 1066 1067 ! Integer values 1068 Hdr_cp%bantot = Hdr_in%bantot 1069 Hdr_cp%date = Hdr_in%date 1070 Hdr_cp%headform = Hdr_in%headform 1071 hdr_cp%icoulomb = hdr_in%icoulomb 1072 Hdr_cp%intxc = Hdr_in%intxc 1073 Hdr_cp%ivalence = Hdr_in%ivalence 1074 Hdr_cp%ixc = Hdr_in%ixc 1075 Hdr_cp%natom = Hdr_in%natom 1076 Hdr_cp%nkpt = Hdr_in%nkpt 1077 Hdr_cp%npsp = Hdr_in%npsp 1078 Hdr_cp%nspden = Hdr_in%nspden 1079 Hdr_cp%nspinor = Hdr_in%nspinor 1080 Hdr_cp%nsppol = Hdr_in%nsppol 1081 Hdr_cp%nsym = Hdr_in%nsym 1082 Hdr_cp%ntypat = Hdr_in%ntypat 1083 Hdr_cp%occopt = Hdr_in%occopt 1084 Hdr_cp%pertcase = Hdr_in%pertcase 1085 Hdr_cp%usepaw = Hdr_in%usepaw 1086 Hdr_cp%usewvl = Hdr_in%usewvl 1087 Hdr_cp%mband = Hdr_in%mband 1088 ABI_CHECK(hdr_in%mband == maxval(hdr_in%nband), "mband != maxval(hdr_in%nband)") 1089 hdr_cp%kptopt = hdr_in%kptopt 1090 hdr_cp%pawcpxocc = hdr_in%pawcpxocc 1091 hdr_cp%nshiftk_orig = hdr_in%nshiftk_orig 1092 hdr_cp%nshiftk = hdr_in%nshiftk 1093 1094 ! Integer arrays 1095 Hdr_cp%ngfft = Hdr_in%ngfft 1096 Hdr_cp%nwvlarr = Hdr_in%nwvlarr 1097 hdr_cp%kptrlatt = hdr_in%kptrlatt 1098 hdr_cp%kptrlatt_orig = hdr_in%kptrlatt_orig 1099 1100 ! Integer allocatable arrays 1101 call alloc_copy( Hdr_in%istwfk, Hdr_cp%istwfk ) 1102 call alloc_copy( Hdr_in%lmn_size,Hdr_cp%lmn_size ) 1103 call alloc_copy( Hdr_in%nband, Hdr_cp%nband ) 1104 call alloc_copy( Hdr_in%npwarr, Hdr_cp%npwarr ) 1105 call alloc_copy( Hdr_in%pspcod, Hdr_cp%pspcod ) 1106 call alloc_copy( Hdr_in%pspdat, Hdr_cp%pspdat ) 1107 call alloc_copy( Hdr_in%pspso , Hdr_cp%pspso ) 1108 call alloc_copy( Hdr_in%pspxc , Hdr_cp%pspxc ) 1109 call alloc_copy( Hdr_in%so_psp, Hdr_cp%so_psp ) 1110 call alloc_copy( Hdr_in%symafm, Hdr_cp%symafm ) 1111 call alloc_copy( Hdr_in%symrel, Hdr_cp%symrel ) 1112 call alloc_copy( Hdr_in%typat , Hdr_cp%typat ) 1113 1114 ! Real variables 1115 Hdr_cp%ecut = Hdr_in%ecut 1116 Hdr_cp%ecutdg = Hdr_in%ecutdg 1117 Hdr_cp%ecutsm = Hdr_in%ecutsm 1118 Hdr_cp%ecut_eff = Hdr_in%ecut_eff 1119 Hdr_cp%etot = Hdr_in%etot 1120 Hdr_cp%fermie = Hdr_in%fermie 1121 Hdr_cp%fermih = Hdr_in%fermih 1122 Hdr_cp%residm = Hdr_in%residm 1123 Hdr_cp%stmbias = Hdr_in%stmbias 1124 Hdr_cp%tphysel = Hdr_in%tphysel 1125 Hdr_cp%tsmear = Hdr_in%tsmear 1126 hdr_cp%nelect = hdr_in%nelect 1127 hdr_cp%ne_qFD = hdr_in%ne_qFD 1128 hdr_cp%nh_qFD = hdr_in%nh_qFD 1129 hdr_cp%cellcharge = hdr_in%cellcharge 1130 1131 Hdr_cp%qptn(:) = Hdr_in%qptn(:) 1132 Hdr_cp%rprimd(:,:) = Hdr_in%rprimd(:,:) 1133 1134 ! Real allocatable arrays 1135 call alloc_copy(Hdr_in%amu, Hdr_cp%amu) 1136 call alloc_copy( Hdr_in%kptns ,Hdr_cp%kptns ) 1137 call alloc_copy( Hdr_in%occ ,Hdr_cp%occ ) 1138 call alloc_copy( Hdr_in%tnons ,Hdr_cp%tnons ) 1139 call alloc_copy( Hdr_in%wtk ,Hdr_cp%wtk ) 1140 call alloc_copy( Hdr_in%xred ,Hdr_cp%xred ) 1141 call alloc_copy( Hdr_in%zionpsp ,Hdr_cp%zionpsp ) 1142 call alloc_copy( Hdr_in%znuclpsp ,Hdr_cp%znuclpsp ) 1143 call alloc_copy( Hdr_in%znucltypat,Hdr_cp%znucltypat) 1144 call alloc_copy(Hdr_in%shiftk, Hdr_cp%shiftk) 1145 call alloc_copy(Hdr_in%shiftk_orig, Hdr_cp%shiftk_orig) 1146 1147 ! Character arrays 1148 Hdr_cp%codvsn = Hdr_in%codvsn 1149 ! THIS DOES NOT WORK ON XLF: Hdr_cp%title string length becomes huge and segfaults 1150 ! call alloc_copy( Hdr_in%title,Hdr_cp%title ) 1151 ABI_MALLOC(Hdr_cp%title,(Hdr_cp%npsp)) 1152 Hdr_cp%title = Hdr_in%title 1153 1154 ABI_MALLOC(hdr_cp%md5_pseudos, (hdr_cp%npsp)) 1155 hdr_cp%md5_pseudos = hdr_in%md5_pseudos 1156 1157 ! For PAW have to copy Pawrhoij ==== 1158 ! NOTE alchemy requires a different treatment but for the moment it is not available within PAW. 1159 if (Hdr_in%usepaw==1) then 1160 cplex_rhoij = Hdr_in%Pawrhoij(1)%cplex_rhoij 1161 qphase_rhoij = Hdr_in%Pawrhoij(1)%qphase 1162 nspden_rhoij = Hdr_in%Pawrhoij(1)%nspden 1163 ABI_MALLOC(Hdr_cp%Pawrhoij,(Hdr_in%natom)) 1164 call pawrhoij_alloc(Hdr_cp%Pawrhoij,cplex_rhoij,nspden_rhoij,Hdr_in%nspinor,Hdr_in%nsppol,Hdr_in%typat,& 1165 lmnsize=Hdr_in%lmn_size(1:Hdr_in%ntypat),qphase=qphase_rhoij) 1166 call pawrhoij_copy(Hdr_in%Pawrhoij,Hdr_cp%Pawrhoij) 1167 end if 1168 1169 end subroutine hdr_copy
m_hdr/hdr_echo [ Functions ]
[ Top ] [ m_hdr ] [ Functions ]
NAME
hdr_echo
FUNCTION
Echo the header
INPUTS
hdr <type(hdr_type)>=the header structured variable rdwr= if 3, echo part of the header to formatted file (records 1 and 2) if 4, echo the header to formatted file fform=kind of the array in the file [unit]=unit number of the formatted file [DEFAULT: std_out] [header]=Optional title.
OUTPUT
Only writing
TODO
Activate new header, avoid printing tons of lines with occupations.
SOURCE
1985 subroutine hdr_echo(hdr, fform, rdwr, unit, header) 1986 1987 !Arguments ------------------------------------ 1988 integer,intent(inout) :: fform 1989 integer,intent(in) :: rdwr 1990 integer,optional,intent(in) :: unit 1991 class(hdr_type),intent(inout) :: hdr 1992 character(len=*),optional,intent(in) :: header 1993 1994 !Local variables------------------------------- 1995 integer,parameter :: max_ns=6 1996 integer :: iatom,ii,ikpt,ipsp,isym,ount !,ns 1997 !character(len=500) :: msg 1998 1999 !************************************************************************* 2000 2001 ount = std_out; if (present(unit)) ount = unit; if (ount == dev_null) return 2002 2003 write(ount,'(a)')' ===============================================================================' 2004 if (present(header)) write(ount, "(a)")ch10//' === '//trim(adjustl(header))//' === ' 2005 if (rdwr==3) write(ount, '(a)' ) ' ECHO of part of the ABINIT file header ' 2006 if (rdwr==4) write(ount, '(a)' ) ' ECHO of the ABINIT file header ' 2007 write(ount, '(a)' ) ' ' 2008 write(ount, '(a)' ) ' First record :' 2009 write(ount, '(a,a8,2i5)' ) '.codvsn,headform,fform = ',hdr%codvsn, hdr%headform, fform 2010 write(ount, '(a)' ) ' ' 2011 write(ount, '(a)' ) ' Second record :' 2012 write(ount, '(a,4i6)') ' bantot,intxc,ixc,natom =',hdr%bantot, hdr%intxc, hdr%ixc, hdr%natom 2013 write(ount, '(a,4i6)') ' ngfft(1:3),nkpt =',hdr%ngfft(1:3), hdr%nkpt 2014 write(ount, '(a,2i6)') ' nspden,nspinor =',hdr%nspden, hdr%nspinor 2015 write(ount, '(a,4i6)' ) ' nsppol,nsym,npsp,ntypat =',hdr%nsppol,hdr%nsym,hdr%npsp,hdr%ntypat 2016 write(ount, '(a,3i6)' ) ' occopt,pertcase,usepaw =',hdr%occopt,hdr%pertcase,hdr%usepaw 2017 write(ount, '(a,3es18.10)') ' ecut,ecutdg,ecutsm =',hdr%ecut, hdr%ecutdg, hdr%ecutsm 2018 write(ount, '(a, es18.10)' ) ' ecut_eff =',hdr%ecut_eff 2019 write(ount, '(a,3es18.10)') ' qptn(1:3) =',hdr%qptn(1:3) 2020 write(ount, '(a,3es18.10)' ) ' rprimd(1:3,1) =',hdr%rprimd(1:3,1) 2021 write(ount, '(a,3es18.10)' ) ' rprimd(1:3,2) =',hdr%rprimd(1:3,2) 2022 write(ount, '(a,3es18.10)' ) ' rprimd(1:3,3) =',hdr%rprimd(1:3,3) 2023 write(ount, '(a,3es18.10)') ' stmbias,tphysel,tsmear =',hdr%stmbias,hdr%tphysel, hdr%tsmear 2024 2025 #ifdef DEV_NEW_HDR 2026 write(ount, "(a,2es18.10,i0)") ' nelect,cellcharge,icoulomb =',hdr%nelect, hdr%cellcharge, hdr%icoulomb 2027 write(ount, "(a,2i6)") ' kptopt,pawcpxocc =',hdr%kptopt, hdr%pawcpxocc 2028 write(ount, '(a,9(i0,1x))') ' kptrlatt_orig = ',hdr%kptrlatt_orig 2029 write(ount, '(a,9(i0,1x))' ) ' kptrlatt = ',hdr%kptrlatt 2030 2031 ns = min(size(hdr%shiftk_orig, dim=2), max_ns) 2032 write(msg, sjoin("(a,",itoa(3*ns),"(f4.2,1x))")) ' shiftk_orig = ',hdr%shiftk_orig(:,1:ns) 2033 if (size(hdr%shiftk_orig, dim=2) > max_ns) msg = sjoin(msg, "...") 2034 write(ount,"(a)")trim(msg) 2035 2036 ns = min(size(hdr%shiftk, dim=2), max_ns) 2037 write(msg, sjoin("(a,",itoa(3*ns),"(f4.2,1x))")) ' shiftk = ',hdr%shiftk(:,1:ns) 2038 if (size(hdr%shiftk, dim=2) > max_ns) msg = sjoin(msg, "...") 2039 write(ount,"(a)")trim(msg) 2040 #endif 2041 2042 write(ount, '(a)' ) 2043 if (rdwr==3)then 2044 write(ount, '(a,i3,a)' ) ' The header contain ',hdr%npsp+2,' additional records.' 2045 else 2046 write(ount, '(a)' ) ' Third record :' 2047 write(ount, '(a,(12i5,8x))') ' istwfk=',hdr%istwfk 2048 write(ount, '(a,(12i5,8x))') ' nband =',hdr%nband 2049 write(ount, '(a,(10i5,8x))') ' npwarr=',hdr%npwarr 2050 2051 write(ount, '(a,(12i4,8x))') ' so_psp=',hdr%so_psp(:) 2052 !write(ount,'(a,(12f6.2,1x))' )' amu =',hdr%amu 2053 2054 write(ount, '(a)') ' symafm=' 2055 write(ount, '(8x,24i3,8x)') hdr%symafm 2056 2057 write(ount, '(a)' ) ' symrel=' 2058 do isym=1,hdr%nsym/2 2059 write(ount, '(a,9i4,a,9i4)' ) ' ',hdr%symrel(:,:,2*isym-1),' ',hdr%symrel(:,:,2*isym) 2060 end do 2061 if(2*(hdr%nsym/2)/=hdr%nsym)write(ount, '(a,9i4)' ) ' ',hdr%symrel(:,:,hdr%nsym) 2062 2063 write(ount, '(a,(12i4,8x))') ' type =',hdr%typat(:) 2064 write(ount, '(a)' ) ' kptns = (max 50 k-points will be written)' 2065 do ikpt=1,min(hdr%nkpt,50) 2066 write(ount, '(a,3es16.6)' ) ' ',hdr%kptns(:,ikpt) 2067 end do 2068 write(ount, '(a)' ) ' wtk =' 2069 do ikpt=1,hdr%nkpt,10 2070 write(ount, '(a,10f6.2)' ) ' ',hdr%wtk(ikpt:min(hdr%nkpt,ikpt + 10 - 1)) 2071 end do 2072 write(ount, '(a)' ) ' occ =' 2073 do ii=1,hdr%bantot,10 2074 write(ount, '(a,10f6.2)') ' ',hdr%occ(ii:min(hdr%bantot,ii+10-1)) 2075 end do 2076 write(ount, '(a)' ) ' tnons =' 2077 do isym=1,hdr%nsym/2 2078 write(ount, '(a,3f10.6,a,3f10.6)' ) ' ',hdr%tnons(:,2*isym-1),' ',hdr%tnons(:,2*isym) 2079 end do 2080 if(2*(hdr%nsym/2)/=hdr%nsym)write(ount, '(a,3f10.6)' ) ' ',hdr%tnons(:,hdr%nsym) 2081 write(ount, '(a,(10f6.2,8x))') ' znucl=',hdr%znucltypat(:) 2082 write(ount,'(a)') 2083 2084 write(ount, '(a)' ) ' Pseudopotential info :' 2085 do ipsp=1,hdr%npsp 2086 write(ount,'(a,a)' ) ' title=',trim(hdr%title(ipsp)) 2087 ! TODO: This part should always be printed. 2088 !write(ount,'(a,a)' ) ' md5=',trim(hdr%md5_pseudos(ipsp)) 2089 write(ount,'(a,f6.2,a,f6.2,a,i3,a,i6,a,i3,a,i3)' ) & 2090 ' znuclpsp=',hdr%znuclpsp(ipsp), ', zionpsp=', hdr%zionpsp(ipsp),& 2091 ', pspso=' , hdr%pspso(ipsp), ', pspdat=',hdr%pspdat(ipsp), & 2092 ', pspcod=', hdr%pspcod(ipsp), ', pspxc=', hdr%pspxc(ipsp) 2093 2094 if(hdr%usepaw==1)then 2095 write(ount,'(a,i3)' ) ' lmn_size=', hdr%lmn_size(ipsp) 2096 else 2097 write(ount,'(a,i3)' ) ' lmnmax =', hdr%lmn_size(ipsp) 2098 end if 2099 end do 2100 2101 write(ount, '(a)' ) ' ' 2102 write(ount, '(a)' ) ' Last record :' 2103 write(ount, '(a,es16.6,es22.12,es16.6)' )' residm,etot,fermie=',hdr%residm, hdr%etot, hdr%fermie 2104 write(ount, '(a)' ) ' xred =' 2105 do iatom=1,hdr%natom 2106 write(ount, '(a,3es16.6)' ) ' ',hdr%xred(:,iatom) 2107 end do 2108 2109 if (hdr%usepaw==1)then 2110 call pawrhoij_io(hdr%pawrhoij,ount,hdr%nsppol,hdr%nspinor,hdr%nspden,hdr%lmn_size,hdr%typat,hdr%headform,"Echo") 2111 end if 2112 2113 if (rdwr==3)write(ount, '(a)' ) ' End the ECHO of part of the ABINIT file header ' 2114 if (rdwr==4)write(ount, '(a)' ) ' End the ECHO of the ABINIT file header ' 2115 write(ount,'(a)')' ===============================================================================' 2116 end if ! rdwr is 3 or 4 2117 2118 call flush_unit(ount) 2119 2120 end subroutine hdr_echo
m_hdr/hdr_fort_read [ Functions ]
[ Top ] [ m_hdr ] [ Functions ]
NAME
hdr_fort_read
FUNCTION
Reads the header from a logical unit associated to a unformatted file. Note that, when reading, different records of hdr are allocated here, according to the values of the read variables. Records of hdr should be deallocated correctly by a call to hdr_free when hdr is not used anymore.
INPUTS
unit=unit number of the unformatted file [rewind]=True to rewind the file. Default: False
OUTPUT
Hdr<hdr_type>=The header of the file fully initialized (if fform /=0) fform=kind of the array in the file. if the reading fail, return fform=0
NOTES
The file is supposed to be open already
SOURCE
2816 subroutine hdr_fort_read(Hdr,unit,fform,rewind) 2817 2818 !Arguments ------------------------------------ 2819 integer,intent(out) :: fform 2820 integer,intent(in) :: unit 2821 logical,optional,intent(in) :: rewind 2822 type(hdr_type),intent(out) :: hdr 2823 2824 !Local variables------------------------------- 2825 !integer :: ierr 2826 integer :: ipsp 2827 character(len=500) :: msg,errmsg 2828 real(dp),allocatable :: occ3d(:,:,:) 2829 2830 !************************************************************************* 2831 2832 !@hdr_type 2833 DBG_ENTER("COLL") 2834 2835 if (present(rewind)) then 2836 if (rewind) rewind(unit, err=10, iomsg=errmsg) 2837 end if 2838 2839 ! Reading the first record of the file ------------------------------------ 2840 ! fform is not a record of hdr_type 2841 ABI_CHECK(read_first_record(unit, hdr%codvsn, hdr%headform, fform, errmsg) == 0, errmsg) 2842 2843 ! CP debug 2844 !write(std_out,*) 'In hdr_fort_read, l. 3032, headform, fform = ', hdr%headform, ', ', fform 2845 ! End CP debug 2846 2847 2848 if (hdr%headform < 80) then 2849 write(msg,'(3a,i0,4a)') & 2850 "ABINIT version: ",trim(abinit_version)," cannot read old files with headform: ",hdr%headform,ch10,& 2851 "produced by previous versions. Use an old ABINIT version to read this file or ",ch10,& 2852 "regenerate your files with version >= 8.0." 2853 ABI_ERROR(msg) 2854 end if 2855 2856 call check_fform(fform) 2857 2858 !Reading the second record of the file ------------------------------------ 2859 read(unit, err=10, iomsg=errmsg) & 2860 hdr%bantot, hdr%date, hdr%intxc, hdr%ixc, hdr%natom, hdr%ngfft(1:3),& 2861 hdr%nkpt, hdr%nspden, hdr%nspinor, hdr%nsppol, hdr%nsym, hdr%npsp, hdr%ntypat, hdr%occopt, hdr%pertcase,& 2862 hdr%usepaw, hdr%ecut, hdr%ecutdg, hdr%ecutsm, hdr%ecut_eff, hdr%qptn(1:3), hdr%rprimd,& 2863 hdr%stmbias, hdr%tphysel, hdr%tsmear, hdr%usewvl, hdr%nshiftk_orig, hdr%nshiftk, hdr%mband 2864 2865 !Allocate all parts of hdr that need to be -------------------------------- 2866 call hdr_malloc(hdr, hdr%bantot, hdr%nkpt, hdr%nsppol, hdr%npsp, hdr%natom, hdr%ntypat,& 2867 hdr%nsym, hdr%nshiftk_orig, hdr%nshiftk) 2868 2869 if (hdr%usepaw==1) then 2870 ABI_MALLOC(hdr%pawrhoij,(hdr%natom)) 2871 end if 2872 2873 ! Reading the third record of the file ------------------------------------ 2874 2875 ! Take into account future migration to occ(:,:,:) in the Format 2876 ! read 3d matrix with stride and transfer to (stupid) 1d hdr%occ in packed form. 2877 ABI_MALLOC(occ3d, (hdr%mband,hdr%nkpt,hdr%nsppol)) 2878 2879 read(unit, err=10, iomsg=errmsg) & 2880 hdr%istwfk(:), hdr%nband(:), hdr%npwarr(:), & 2881 hdr%so_psp(:), hdr%symafm(:), hdr%symrel(:,:,:), & 2882 hdr%typat(:), hdr%kptns(:,:), occ3d, & 2883 hdr%tnons(:,:), hdr%znucltypat(:), hdr%wtk(:) 2884 ABI_CHECK(hdr%mband == maxval(hdr%nband), "mband != max(hdr%nband). Are you reading an Abinit8 file with Abinit9?") 2885 2886 call hdr_set_occ(hdr, occ3d) 2887 ABI_FREE(occ3d) 2888 2889 ! Reading the final record of the header --------------------------------- 2890 read(unit, err=10, iomsg=errmsg) hdr%residm, hdr%xred(:,:), hdr%etot, hdr%fermie, hdr%amu(:) 2891 2892 read(unit, err=10, iomsg=errmsg)& 2893 hdr%kptopt,hdr%pawcpxocc,hdr%nelect,hdr%cellcharge,hdr%icoulomb,& 2894 hdr%kptrlatt,hdr%kptrlatt_orig, hdr%shiftk_orig,hdr%shiftk 2895 2896 hdr%ivalence = hdr%nelect / 2 ! Read in case occopt = 9 2897 hdr%ne_qFD = zero 2898 hdr%nh_qFD = zero 2899 hdr%fermih = zero 2900 if (hdr%occopt == 9) then 2901 ! This was erroneous 2902 ! write(unit,err=10, iomsg=errmsg) hdr%ivalence, hdr%ne_qFD, hdr%nh_qFD, hdr%fermie, hdr%fermih 2903 ! But this induced problems on bob_gnu_7.5_openmp 2904 read(unit,err=10, iomsg=errmsg) hdr%ivalence, hdr%ne_qFD, hdr%nh_qFD, hdr%fermie, hdr%fermih 2905 ! 2906 end if 2907 2908 ! Reading the records with psp information --------------------------------- 2909 do ipsp=1,hdr%npsp 2910 read(unit, err=10, iomsg=errmsg) & 2911 hdr%title(ipsp), hdr%znuclpsp(ipsp), hdr%zionpsp(ipsp), hdr%pspso(ipsp), hdr%pspdat(ipsp), & 2912 hdr%pspcod(ipsp), hdr%pspxc(ipsp), hdr%lmn_size(ipsp), hdr%md5_pseudos(ipsp) 2913 end do 2914 2915 if (hdr%usepaw==1) then ! Reading the Rhoij tab if the PAW method was used. 2916 call pawrhoij_io(hdr%pawrhoij,unit,hdr%nsppol,hdr%nspinor,hdr%nspden,hdr%lmn_size,hdr%typat,hdr%headform,"Read") 2917 end if 2918 2919 DBG_EXIT("COLL") 2920 return 2921 2922 ! Handle IO-error: write warning and let the caller handle the exception. 2923 10 fform=0 2924 ABI_WARNING(errmsg) 2925 2926 end subroutine hdr_fort_read
m_hdr/hdr_fort_write [ Functions ]
[ Top ] [ m_hdr ] [ Functions ]
NAME
hdr_fort_write
FUNCTION
Writes the header and fform to unformatted file
INPUTS
Hdr<hdr_type>=The header of the file. fform=kind of the array in the file unit=unit number of the unformatted file [rewind]=True to rewind the file. Default: False
OUTPUT
ierr=Exit status
NOTES
The file is supposed to be open already
SOURCE
3169 subroutine hdr_fort_write(Hdr,unit,fform,ierr,rewind) 3170 3171 !Arguments ------------------------------------ 3172 integer,intent(out) :: ierr 3173 integer,intent(in) :: unit,fform 3174 logical,optional,intent(in) :: rewind 3175 class(hdr_type),intent(inout) :: hdr 3176 3177 !Local variables------------------------------- 3178 integer :: headform,ipsp,major,ii 3179 character(len=500) :: errmsg 3180 real(dp),allocatable :: occ3d(:,:,:) 3181 3182 !************************************************************************* 3183 3184 ! TODO: Change intent to in. Change pawrhoij_io first! 3185 !@hdr_type 3186 ierr = 0 3187 3188 if (present(rewind)) then 3189 if (rewind) rewind(unit, err=10, iomsg=errmsg) 3190 end if 3191 3192 call check_fform(fform) 3193 3194 ii = index(hdr%codvsn, ".") 3195 if (ii == 0 .or. ii == 1) then 3196 ABI_WARNING(sjoin("Cannot find major.minor pattern in codvsn:", hdr%codvsn)) 3197 ierr = 1; return 3198 end if 3199 3200 major = atoi(hdr%codvsn(:ii-1)) 3201 3202 !Writing always use last format version 3203 headform = HDR_LATEST_HEADFORM 3204 !write(std_out,*) 'CP debug = ', headform 3205 3206 if (major > 8) then 3207 write(unit, err=10, iomsg=errmsg) hdr%codvsn, headform, fform 3208 else 3209 write(unit, err=10, iomsg=errmsg) hdr%codvsn(1:6), headform, fform 3210 end if 3211 3212 write(unit, err=10, iomsg=errmsg) & 3213 hdr%bantot, hdr%date, hdr%intxc, hdr%ixc, hdr%natom, hdr%ngfft(1:3), & 3214 hdr%nkpt, hdr%nspden, hdr%nspinor, hdr%nsppol, hdr%nsym, hdr%npsp, hdr%ntypat, hdr%occopt, hdr%pertcase,& 3215 hdr%usepaw, hdr%ecut, hdr%ecutdg, hdr%ecutsm, hdr%ecut_eff, hdr%qptn, hdr%rprimd, & 3216 hdr%stmbias, hdr%tphysel, hdr%tsmear, hdr%usewvl, hdr%nshiftk_orig, hdr%nshiftk, hdr%mband 3217 ABI_CHECK(hdr%mband == maxval(hdr%nband), "mband != maxval(hdr%nband)") 3218 3219 ABI_MALLOC(occ3d, (hdr%mband,hdr%nkpt,hdr%nsppol)) 3220 call hdr_get_occ3d(hdr, occ3d) 3221 write(unit,err=10, iomsg=errmsg) hdr%istwfk(:), hdr%nband(:), hdr%npwarr(:),& 3222 hdr%so_psp(:), hdr%symafm(:), hdr%symrel(:,:,:), hdr%typat(:), hdr%kptns(:,:), occ3d, & 3223 hdr%tnons(:,:), hdr%znucltypat(:), hdr%wtk(:) 3224 ABI_FREE(occ3d) 3225 3226 write(unit,err=10, iomsg=errmsg) hdr%residm, hdr%xred(:,:), hdr%etot, hdr%fermie, hdr%amu(:) 3227 write(unit,err=10, iomsg=errmsg) & 3228 hdr%kptopt, hdr%pawcpxocc, hdr%nelect, hdr%cellcharge, hdr%icoulomb,& 3229 hdr%kptrlatt,hdr%kptrlatt_orig, hdr%shiftk_orig(:,1:hdr%nshiftk_orig),hdr%shiftk(:,1:hdr%nshiftk) 3230 3231 ! Write record for occopt 9 option if needed 3232 if (hdr%occopt == 9) then 3233 write(unit,err=10, iomsg=errmsg) hdr%ivalence, hdr%ne_qFD, hdr%nh_qFD, hdr%fermie, hdr%fermih 3234 end if 3235 3236 ! Write the records with psp information --------------------------------- 3237 do ipsp=1,hdr%npsp 3238 write(unit, err=10, iomsg=errmsg) & 3239 hdr%title(ipsp), hdr%znuclpsp(ipsp), hdr%zionpsp(ipsp), hdr%pspso(ipsp), hdr%pspdat(ipsp), & 3240 hdr%pspcod(ipsp), hdr%pspxc(ipsp), hdr%lmn_size(ipsp), hdr%md5_pseudos(ipsp) 3241 end do 3242 3243 if (hdr%usepaw==1) then 3244 call pawrhoij_io(hdr%pawrhoij,unit,hdr%nsppol,hdr%nspinor,hdr%nspden,hdr%lmn_size,hdr%typat,headform,"Write") 3245 end if 3246 3247 return 3248 3249 ! Handle IO-error: write warning and let the caller handle the exception. 3250 10 ierr=1 3251 ABI_WARNING(errmsg) 3252 3253 end subroutine hdr_fort_write
m_hdr/hdr_free [ Functions ]
[ Top ] [ m_hdr ] [ Functions ]
NAME
hdr_free
FUNCTION
This subroutine deallocates the components of the header structured datatype
INPUTS
hdr <type(hdr_type)>=the header
OUTPUT
(only deallocate)
SOURCE
983 subroutine hdr_free(hdr) 984 985 !Arguments ------------------------------------ 986 !scalars 987 class(hdr_type),intent(inout) :: hdr 988 989 ! ************************************************************************* 990 991 !@hdr_type 992 993 !integer 994 ABI_SFREE(hdr%istwfk) 995 ABI_SFREE(hdr%lmn_size) 996 ABI_SFREE(hdr%nband) 997 ABI_SFREE(hdr%npwarr) 998 ABI_SFREE(hdr%pspcod) 999 ABI_SFREE(hdr%pspdat) 1000 ABI_SFREE(hdr%pspso) 1001 ABI_SFREE(hdr%pspxc) 1002 ABI_SFREE(hdr%so_psp) 1003 ABI_SFREE(hdr%symafm) 1004 ABI_SFREE(hdr%symrel) 1005 ABI_SFREE(hdr%typat) 1006 1007 !real 1008 ABI_SFREE(hdr%amu) 1009 ABI_SFREE(hdr%kptns) 1010 ABI_SFREE(hdr%occ) 1011 ABI_SFREE(hdr%tnons) 1012 ABI_SFREE(hdr%wtk) 1013 ABI_SFREE(hdr%shiftk) 1014 ABI_SFREE(hdr%shiftk_orig) 1015 ABI_SFREE(hdr%xred) 1016 ABI_SFREE(hdr%zionpsp) 1017 ABI_SFREE(hdr%znuclpsp) 1018 ABI_SFREE(hdr%znucltypat) 1019 1020 !string arrays 1021 ABI_SFREE(hdr%md5_pseudos) 1022 ABI_SFREE(hdr%title) 1023 1024 if (hdr%usepaw==1 .and. allocated(hdr%pawrhoij) ) then 1025 call pawrhoij_free(hdr%pawrhoij) 1026 ABI_FREE(hdr%pawrhoij) 1027 end if 1028 1029 end subroutine hdr_free
m_hdr/hdr_get_crystal [ Functions ]
[ Top ] [ m_hdr ] [ Functions ]
NAME
hdr_get_crystal
FUNCTION
Initializes a crystal_t data type starting from the abinit header.
INPUTS
hdr<hdr_type>=the abinit header [gw_timrev] ==2 => take advantage of time-reversal symmetry ==1 ==> do not use time-reversal symmetry Default: 2 NOTE THAT HERE WE USE THE GW CONVENTIONS I.E ABINIT_TIMREV + ! [remove_inv] = if .TRUE. the inversion symmetry is removed from the set of operations even if it is present in the header
OUTPUT
cryst<crystal_t>= the data type filled with data reported in the abinit header
TODO
Add information on the use of time-reversal in the Abinit header.
SOURCE
4963 type(crystal_t) function hdr_get_crystal(hdr, gw_timrev, remove_inv) result(cryst) 4964 4965 !Arguments ------------------------------------ 4966 class(hdr_type),intent(in) :: hdr 4967 integer,optional,intent(in) :: gw_timrev 4968 logical,optional,intent(in) :: remove_inv 4969 4970 !Local variables------------------------------- 4971 integer :: my_timrev, space_group 4972 logical :: rinv, use_antiferro 4973 ! ********************************************************************* 4974 4975 rinv=.FALSE.; if (PRESENT(remove_inv)) rinv=remove_inv 4976 use_antiferro = hdr%nspden == 2 .and. hdr%nsppol ==1 4977 4978 if (.not. present(gw_timrev)) then 4979 ! Get it from kptopt 4980 !my_timrev = kpts_timrev_from_kptopt(hdr%kptopt) + 1 4981 my_timrev = 1; if (any(hdr%kptopt == [3, 4])) my_timrev = 0 4982 my_timrev = my_timrev + 1 4983 !print *, "my_timrev", my_timrev 4984 else 4985 my_timrev = gw_timrev 4986 end if 4987 4988 ! Consistency check 4989 ABI_CHECK(any(my_timrev == [1, 2]), "timrev should be in (1|2)") 4990 if (use_antiferro) then 4991 ABI_CHECK(ANY(hdr%symafm == -1), "Wrong nspden, nsppol, symafm.") 4992 end if 4993 4994 space_group = 0 ! FIXME not known at this level. 4995 4996 call crystal_init(hdr%amu,cryst,space_group,hdr%natom,hdr%npsp,hdr%ntypat,hdr%nsym,hdr%rprimd,hdr%typat,hdr%xred,& 4997 hdr%zionpsp,hdr%znuclpsp,my_timrev,use_antiferro,rinv,hdr%title,& 4998 symrel=hdr%symrel,tnons=hdr%tnons,symafm=hdr%symafm) ! Optional 4999 5000 end function hdr_get_crystal
m_hdr/hdr_get_nelect_from_occ [ Functions ]
[ Top ] [ m_hdr ] [ Functions ]
NAME
hdr_get_nelect_from_occ
FUNCTION
Return the number of electrons from the occupation numbers This function is mainly used for debugging purposes, use hdr%nelect and hdr%cellcharge
INPUTS
Hdr<hdr_type>
OUTPUT
nelect=Number of electrons in the unit cell.
SOURCE
1190 real(dp) pure function hdr_get_nelect_from_occ(Hdr) result(nelect) 1191 1192 !Arguments --------------------------------------------- 1193 !scalars 1194 class(hdr_type),intent(in) :: Hdr 1195 1196 !Local variables --------------------------------------- 1197 !scalars 1198 integer :: idx,isppol,ikibz,nband_k 1199 ! ************************************************************************* 1200 1201 ! Cannot use znucl because we might have additional cellcharge or alchemy. 1202 nelect=zero ; idx=0 1203 do isppol=1,Hdr%nsppol 1204 do ikibz=1,Hdr%nkpt 1205 nband_k=Hdr%nband(ikibz+(isppol-1)*Hdr%nkpt) 1206 nelect = nelect + Hdr%wtk(ikibz)*SUM(Hdr%occ(idx+1:idx+nband_k)) 1207 idx=idx+nband_k 1208 end do 1209 end do 1210 1211 end function hdr_get_nelect_from_occ
m_hdr/hdr_get_occ3d [ Functions ]
[ Top ] [ m_hdr ] [ Functions ]
NAME
hdr_get_occ3d
FUNCTION
Return occupations in a 3d array with stride.
SOURCE
3700 subroutine hdr_get_occ3d(hdr, occ3d) 3701 3702 !Arguments ------------------------------------ 3703 class(hdr_type),intent(in) :: hdr 3704 real(dp),intent(out) :: occ3d(hdr%mband,hdr%nkpt,hdr%nsppol) 3705 3706 !Local variables------------------------------- 3707 !scalars 3708 integer :: ii,band,ikpt,spin 3709 3710 !************************************************************************* 3711 3712 ii = 0; occ3d = huge(one) 3713 do spin=1,hdr%nsppol 3714 do ikpt=1,hdr%nkpt 3715 do band=1,hdr%nband(ikpt + (spin-1) * hdr%nkpt) 3716 ii = ii +1 3717 occ3d(band,ikpt,spin) = hdr%occ(ii) 3718 end do 3719 end do 3720 end do 3721 3722 end subroutine hdr_get_occ3d
m_hdr/hdr_init [ Functions ]
[ Top ] [ m_hdr ] [ Functions ]
NAME
hdr_init
FUNCTION
This subroutine initializes the header structured datatype and most of its content from dtset and psps, and put default values for evolving variables.
INPUTS
ebands <type(ebands_t)>=band structure information including Brillouin zone description codvsn=code version dtset <type(dataset_type)>=all input variables for this dataset pawtab(ntypat*usepaw) <type(pawtab_type)>=paw tabulated starting data pertcase=index of the perturbation, or 0 if GS calculation psps <type(pseudopotential_type)>=all the information about psps [my_atomtab(:)]=Index of the atoms (in global numbering ) treated by current proc. [mpi_atmtab(:)]= indexes of the atoms treated by current proc [comm_atom]= MPI communicator over atoms
OUTPUT
hdr <type(hdr_type)>=the header, initialized, and for most part of it, contain its definite values, except for evolving variables
SOURCE
891 subroutine hdr_init(ebands, codvsn, dtset, hdr, pawtab, pertcase, psps, wvl, & 892 mpi_atmtab, comm_atom) ! optional arguments (parallelism) 893 894 !Arguments ------------------------------------ 895 !scalars 896 integer,intent(in) :: pertcase 897 integer,intent(in),optional :: comm_atom 898 character(len=8),intent(in) :: codvsn 899 type(ebands_t),intent(in) :: ebands 900 type(dataset_type),intent(in) :: dtset 901 type(hdr_type),intent(inout) :: hdr !vz_i 902 type(pseudopotential_type),intent(in) :: psps 903 type(wvl_internal_type),intent(in) :: wvl 904 !arrays 905 integer,optional,target,intent(in) :: mpi_atmtab(:) 906 type(pawtab_type),intent(in) :: pawtab(dtset%ntypat*psps%usepaw) 907 908 !Local variables------------------------------- 909 !scalars 910 integer,parameter :: image=1 911 character(len=500) :: msg 912 913 ! ************************************************************************* 914 915 #ifdef DEBUG_MODE 916 call test_abifiles() 917 #endif 918 919 !@hdr_type 920 921 ! More checking would be needed ... 922 if (dtset%ntypat/=psps%ntypat) then 923 write(msg,'(a,2(i0,2x))')' dtset%ntypat and psps%ntypat differs. They are: ',dtset%ntypat,psps%ntypat 924 ABI_ERROR(msg) 925 end if 926 927 if (dtset%npsp/=psps%npsp) then 928 write(msg,'(a,2(i0,2x))')' dtset%npsp and psps%npsp differs. They are: ',dtset%npsp,psps%npsp 929 ABI_ERROR(msg) 930 end if 931 932 ! Note: The structure parameters are taken from the first image, also cellcharge ! 933 if (present(comm_atom)) then 934 if (present(mpi_atmtab)) then 935 call hdr_init_lowlvl(hdr,ebands,psps,pawtab,wvl,codvsn,pertcase,& 936 dtset%natom,dtset%nsym,dtset%nspden,dtset%ecut,dtset%pawecutdg,dtset%ecutsm,dtset%dilatmx,& 937 dtset%intxc,dtset%ixc,dtset%stmbias,dtset%usewvl,dtset%pawcpxocc,dtset%pawspnorb,dtset%ngfft,dtset%ngfftdg,& 938 dtset%so_psp,dtset%qptn, dtset%rprimd_orig(:,:,image),dtset%xred_orig(:,:,image),& 939 dtset%symrel,dtset%tnons,dtset%symafm,dtset%typat,dtset%amu_orig(:,image),dtset%icoulomb,& 940 dtset%kptopt,dtset%nelect,dtset%ne_qFD,dtset%nh_qFD,dtset%ivalence,dtset%cellcharge(image),& 941 dtset%kptrlatt_orig,dtset%kptrlatt,dtset%nshiftk_orig,dtset%nshiftk,dtset%shiftk_orig,dtset%shiftk,& 942 comm_atom=comm_atom,mpi_atmtab=mpi_atmtab) 943 else 944 call hdr_init_lowlvl(hdr,ebands,psps,pawtab,wvl,codvsn,pertcase,& 945 dtset%natom,dtset%nsym,dtset%nspden,dtset%ecut,dtset%pawecutdg,dtset%ecutsm,dtset%dilatmx,& 946 dtset%intxc,dtset%ixc,dtset%stmbias,dtset%usewvl,dtset%pawcpxocc,dtset%pawspnorb,dtset%ngfft,dtset%ngfftdg,& 947 dtset%so_psp,dtset%qptn, dtset%rprimd_orig(:,:,image),dtset%xred_orig(:,:,image),& 948 dtset%symrel,dtset%tnons,dtset%symafm,dtset%typat,dtset%amu_orig(:,image),dtset%icoulomb,& 949 dtset%kptopt,dtset%nelect,dtset%ne_qFD,dtset%nh_qFD,dtset%ivalence,dtset%cellcharge(image),& 950 dtset%kptrlatt_orig,dtset%kptrlatt,dtset%nshiftk_orig,dtset%nshiftk,dtset%shiftk_orig,dtset%shiftk,& 951 comm_atom=comm_atom) 952 end if 953 else 954 call hdr_init_lowlvl(hdr,ebands,psps,pawtab,wvl,codvsn,pertcase,& 955 dtset%natom,dtset%nsym,dtset%nspden,dtset%ecut,dtset%pawecutdg,dtset%ecutsm,dtset%dilatmx,& 956 dtset%intxc,dtset%ixc,dtset%stmbias,dtset%usewvl,dtset%pawcpxocc,dtset%pawspnorb,dtset%ngfft,dtset%ngfftdg,& 957 dtset%so_psp,dtset%qptn, dtset%rprimd_orig(:,:,image),dtset%xred_orig(:,:,image),dtset%symrel,& 958 dtset%tnons,dtset%symafm,dtset%typat,dtset%amu_orig(:,image),dtset%icoulomb,& 959 dtset%kptopt,dtset%nelect,dtset%ne_qFD,dtset%nh_qFD,dtset%ivalence,dtset%cellcharge(image),& 960 dtset%kptrlatt_orig,dtset%kptrlatt,dtset%nshiftk_orig,dtset%nshiftk,dtset%shiftk_orig,dtset%shiftk) 961 end if 962 963 end subroutine hdr_init
m_hdr/hdr_init_lowlvl [ Functions ]
[ Top ] [ m_hdr ] [ Functions ]
NAME
hdr_init_lowlvl
FUNCTION
This subroutine initializes the header structured datatype and most of its content from psps and other input variables that are passed explicitly. It also use default values for evolving variables. Note that Dtset is not required thus rendering the initialization of the header much easier.
INPUTS
ebands <type(ebands_t)>=band structure information including Brillouin zone description codvsn=code version mpi_atmtab(:)=--optional-- indexes of the atoms treated by current proc comm_atom=--optional-- MPI communicator over atoms pawtab(ntypat*usepaw) <type(pawtab_type)>=paw tabulated starting data pertcase=index of the perturbation, or 0 if GS calculation psps <type(pseudopotential_type)>=all the information about psps For the meaning of the other varialble see the definition of dataset_type.
OUTPUT
hdr <type(hdr_type)>=the header, initialized, and for most part of it, contain its definite values, except for evolving variables
SOURCE
1243 subroutine hdr_init_lowlvl(hdr,ebands,psps,pawtab,wvl,& 1244 codvsn,pertcase,natom,nsym,nspden,ecut,pawecutdg,ecutsm,dilatmx,& 1245 intxc,ixc,stmbias,usewvl,pawcpxocc,pawspnorb,ngfft,ngfftdg,so_psp,qptn,& 1246 rprimd,xred,symrel,tnons,symafm,typat,amu,icoulomb,& 1247 kptopt,nelect,ne_qFD,nh_qFD,ivalence,cellcharge,kptrlatt_orig,kptrlatt,& 1248 nshiftk_orig,nshiftk,shiftk_orig,shiftk,& 1249 mpi_atmtab,comm_atom) ! optional arguments (parallelism) 1250 1251 !Arguments ------------------------------------ 1252 !scalars 1253 integer,intent(in) :: natom,nsym,nspden,intxc,ixc,usewvl,pawcpxocc,pawspnorb,pertcase 1254 integer,intent(in) :: ivalence,kptopt,nshiftk_orig,nshiftk,icoulomb 1255 integer, intent(in),optional :: comm_atom 1256 real(dp),intent(in) :: ecut,ecutsm,dilatmx,stmbias,pawecutdg,nelect,ne_qFD,nh_qFD,cellcharge 1257 character(len=8),intent(in) :: codvsn 1258 type(ebands_t),intent(in) :: ebands 1259 type(pseudopotential_type),intent(in) :: psps 1260 type(wvl_internal_type),intent(in) :: wvl 1261 type(hdr_type),intent(inout) :: hdr 1262 !arrays 1263 integer,intent(in) :: typat(natom) 1264 integer,intent(in) :: so_psp(psps%npsp) 1265 integer,intent(in) :: symrel(3,3,nsym),symafm(nsym) 1266 integer,intent(in) :: ngfft(18),ngfftdg(18),kptrlatt_orig(3,3),kptrlatt(3,3) 1267 integer,optional,target,intent(in) :: mpi_atmtab(:) 1268 real(dp),intent(in) :: tnons(3,nsym),amu(psps%ntypat) 1269 real(dp),intent(in) :: qptn(3) ! the wavevector, in case of a perturbation 1270 real(dp),intent(in) :: rprimd(3,3),xred(3,natom) 1271 real(dp),intent(in) :: shiftk_orig(3,nshiftk_orig),shiftk(3,nshiftk) 1272 type(pawtab_type),intent(in) :: pawtab(psps%ntypat*psps%usepaw) 1273 1274 !Local variables------------------------------- 1275 !scalars 1276 integer :: bantot,date,nkpt,npsp,ntypat,nsppol,nspinor 1277 integer :: cplex_rhoij,nspden_rhoij,qphase_rhoij 1278 integer :: idx,isppol,ikpt,iband,ipsp 1279 character(len=8) :: date_time 1280 1281 ! ************************************************************************* 1282 1283 !@hdr_type 1284 call date_and_time(date_time) 1285 read(date_time,'(i8)')date 1286 1287 npsp = psps%npsp 1288 ntypat = psps%ntypat 1289 nkpt = ebands%nkpt 1290 nsppol = ebands%nsppol 1291 nspinor= ebands%nspinor 1292 bantot = ebands%bantot 1293 1294 !Transfer dimensions and other scalars to hdr. 1295 hdr%intxc =intxc 1296 hdr%ixc =ixc 1297 hdr%natom =natom 1298 hdr%npsp =npsp 1299 hdr%nspden =nspden 1300 hdr%nspinor =nspinor 1301 hdr%nsym =nsym 1302 hdr%ntypat =ntypat 1303 hdr%bantot =bantot 1304 hdr%nkpt =nkpt 1305 hdr%nshiftk_orig = nshiftk_orig 1306 hdr%nshiftk = nshiftk 1307 hdr%nsppol =nsppol 1308 hdr%usepaw =psps%usepaw 1309 hdr%usewvl =usewvl !hdr%nwvlarr will be set later since the number !of wavelets have not yet been computed. 1310 hdr%occopt =ebands%occopt 1311 hdr%codvsn =codvsn 1312 hdr%date =date 1313 hdr%headform =HDR_LATEST_HEADFORM ! Initialize with the latest headform 1314 hdr%pertcase =pertcase 1315 hdr%ecut =ecut 1316 hdr%ecutsm =ecutsm 1317 hdr%ecut_eff =ecut * (dilatmx)**2 1318 hdr%stmbias =stmbias 1319 hdr%tphysel =ebands%tphysel 1320 hdr%tsmear =ebands%tsmear 1321 hdr%qptn =qptn 1322 hdr%rprimd =rprimd ! Evolving data 1323 1324 !Default for other data (all evolving data) 1325 hdr%etot =1.0d20 1326 hdr%fermie =1.0d20 1327 hdr%fermih =1.0d20 1328 hdr%residm =1.0d20 1329 1330 ! Allocate all components of hdr 1331 call hdr_malloc(hdr, hdr%bantot, hdr%nkpt, hdr%nsppol, hdr%npsp, hdr%natom, hdr%ntypat,& 1332 hdr%nsym, hdr%nshiftk_orig, hdr%nshiftk) 1333 1334 !Transfer data from ebands 1335 hdr%istwfk(1:nkpt) = ebands%istwfk(1:nkpt) 1336 hdr%kptns(:,:) = ebands%kptns(:,:) 1337 hdr%nband(1:nkpt*nsppol)=ebands%nband(1:nkpt*nsppol); hdr%mband = maxval(hdr%nband) 1338 hdr%npwarr(:) = ebands%npwarr(:) 1339 hdr%wtk(:) = ebands%wtk(:) 1340 1341 !Transfer data from psps 1342 hdr%pspcod =psps%pspcod 1343 hdr%pspdat =psps%pspdat 1344 hdr%pspso =psps%pspso 1345 hdr%pspxc =psps%pspxc 1346 hdr%znuclpsp =psps%znuclpsp 1347 hdr%znucltypat=psps%znucltypat 1348 hdr%zionpsp =psps%zionpsp 1349 do ipsp=1,psps%npsp 1350 write(hdr%title(ipsp), "(A)") psps%title(ipsp)(1:132) 1351 end do 1352 hdr%md5_pseudos = psps%md5_pseudos 1353 1354 hdr%so_psp=so_psp 1355 hdr%symafm(1:min(size(symafm),size(hdr%symafm)))=symafm(1:min(size(symafm),size(hdr%symafm))) 1356 hdr%symrel(:,:,1:min(size(symrel,3),size(hdr%symrel,3))) =symrel(:,:,1:min(size(symrel,3),size(hdr%symrel,3))) 1357 hdr%tnons(:,1:min(size(tnons,2),size(hdr%tnons,2)))=tnons(:,1:min(size(tnons,2),size(hdr%tnons,2))) 1358 1359 hdr%typat(1:natom) =typat(1:natom) ! PMA : in tests/v2/t11 size(dtset%typat) is bigger dtset%natom 1360 hdr%xred(:,1:natom)=xred(:,1:natom) ! Evolving data 1361 1362 hdr%kptopt = kptopt 1363 hdr%pawcpxocc = pawcpxocc 1364 hdr%nelect = nelect 1365 hdr%ne_qFD = ne_qFD 1366 hdr%nh_qFD = nh_qFD 1367 hdr%ivalence = ivalence 1368 hdr%cellcharge = cellcharge 1369 hdr%kptrlatt_orig = kptrlatt_orig 1370 hdr%kptrlatt = kptrlatt 1371 hdr%shiftk_orig = shiftk_orig(:, 1:hdr%nshiftk_orig) 1372 hdr%shiftk = shiftk 1373 hdr%icoulomb = icoulomb 1374 hdr%amu = amu 1375 1376 if (psps%usepaw==1)then 1377 call pawrhoij_inquire_dim(cplex_rhoij=cplex_rhoij,qphase_rhoij=qphase_rhoij,nspden_rhoij=nspden_rhoij,& 1378 nspden=nspden,spnorb=pawspnorb,cpxocc=pawcpxocc,qpt=qptn) 1379 ABI_MALLOC(hdr%pawrhoij,(natom)) 1380 ! Values of nspden/nspinor/nsppol are dummy ones; they are overwritten later (by hdr_update) 1381 if (present(comm_atom)) then 1382 if (present(mpi_atmtab)) then 1383 call pawrhoij_alloc(hdr%pawrhoij,cplex_rhoij,nspden_rhoij,nspinor,nsppol,typat,qphase=qphase_rhoij,& 1384 pawtab=pawtab,comm_atom=comm_atom,mpi_atmtab=mpi_atmtab) 1385 else 1386 call pawrhoij_alloc(hdr%pawrhoij,cplex_rhoij,nspden_rhoij,nspinor,nsppol,typat,qphase=qphase_rhoij,& 1387 pawtab=pawtab,comm_atom=comm_atom) 1388 end if 1389 else 1390 call pawrhoij_alloc(hdr%pawrhoij,cplex_rhoij,nspden_rhoij,nspinor,nsppol,typat,qphase=qphase_rhoij,& 1391 pawtab=pawtab) 1392 end if 1393 end if 1394 1395 if (psps%usepaw==1 .and. usewvl ==0 ) then 1396 hdr%ngfft(:) =ngfftdg(1:3) 1397 else if (usewvl==1) then 1398 #if defined HAVE_BIGDFT 1399 hdr%ngfft(:) = (/ wvl%Glr%d%n1i, wvl%Glr%d%n2i, wvl%Glr%d%n3i /) 1400 #else 1401 BIGDFT_NOTENABLED_ERROR() 1402 #endif 1403 else 1404 hdr%ngfft(:) =ngfft(1:3) 1405 end if 1406 1407 !Transfer paw data 1408 if(psps%usepaw==1) then 1409 hdr%ecutdg =pawecutdg 1410 hdr%lmn_size(1:npsp)=pawtab(1:npsp)%lmn_size 1411 else 1412 hdr%ecutdg=hdr%ecut 1413 hdr%lmn_size(:)=psps%lmnmax 1414 end if 1415 1416 hdr%occ(:)=zero; idx=0 1417 do isppol=1,nsppol 1418 do ikpt=1,nkpt 1419 do iband=1,hdr%nband(ikpt+(isppol-1)*nkpt) 1420 idx=idx+1 1421 hdr%occ(idx)=ebands%occ(iband,ikpt,isppol) 1422 end do 1423 end do 1424 end do 1425 1426 ABI_UNUSED(wvl%h(1)) 1427 1428 end subroutine hdr_init_lowlvl
m_hdr/hdr_io_int [ Functions ]
[ Top ] [ m_hdr ] [ Functions ]
NAME
hdr_io_int
FUNCTION
This subroutine deals with the I/O of the hdr_type structured variables (read/write/echo). According to the value of rdwr, it reads the header of a file, writes it, or echo the value of the structured variable to a file. Note that, when reading, different records of hdr are allocated here, according to the values of the read variables. Records of hdr should be deallocated correctly by a call to hdr_free when hdr is not used anymore. Two instances of the hdr_io routines are defined : hdr_io_int to which only the unit number is given hdr_io_wfftype to which a wffil datatype is given
INPUTS
rdwr= if 1, read the hdr structured variable from the header of the file,
if 2, write the header to unformatted file
if 3, echo part of the header to formatted file (records 1 and 2)
if 4, echo the header to formatted file
if 5, read the hdr without rewinding (unformatted)
if 6, write the hdr without rewinding (unformatted)
unitfi=unit number of the file (unformatted if rdwr=1, 2, 5 or 6 formatted if rdwr=3,4)
OUTPUT
(see side effects)
SIDE EFFECTS
The following variables are both input or output : fform=kind of the array in the file if rdwr=1,5 : will be output ; if the reading fail, return fform=0 if rdwr=2,3,4,6 : should be input, will be written or echo to file hdr <type(hdr_type)>=the header structured variable if rdwr=1,5 : will be output if rdwr=2,3,4,6 : should be input, will be written or echo to file
NOTES
In all cases, the file is supposed to be open already When reading (rdwr=1) or writing (rdwr=2), rewind the file When echoing (rdwr=3) does not rewind the file. When reading (rdwr=5) or writing (rdwr=6), DOES NOT rewind the file
SOURCE
1926 subroutine hdr_io_int(fform,hdr,rdwr,unitfi) 1927 1928 !Arguments ------------------------------------ 1929 integer,intent(inout) :: fform 1930 integer,intent(in) :: rdwr,unitfi 1931 type(hdr_type),intent(inout) :: hdr 1932 1933 !Local variables------------------------------- 1934 integer :: ierr 1935 1936 !************************************************************************* 1937 1938 DBG_ENTER("COLL") 1939 1940 select case(rdwr) 1941 case (1, 5) 1942 ! Reading the header of an unformatted file 1943 call hdr_fort_read(Hdr,unitfi,fform,rewind=(rdwr==1)) 1944 1945 case (2, 6) 1946 ! Writing the header of an unformatted file 1947 call hdr%fort_write(unitfi, fform, ierr, rewind=(rdwr==2)) 1948 1949 case (3, 4) 1950 ! Writing the header of a formatted file 1951 call hdr_echo(Hdr,fform,rdwr,unit=unitfi) 1952 case default 1953 ABI_ERROR(sjoin("Wrong value for rdwr: ",itoa(rdwr))) 1954 end select 1955 1956 DBG_EXIT("COLL") 1957 1958 end subroutine hdr_io_int
m_hdr/hdr_io_wfftype [ Functions ]
[ Top ] [ m_hdr ] [ Functions ]
NAME
hdr_io_wfftype
FUNCTION
This subroutine deals with the I/O of the hdr_type structured variables (read/write/echo). According to the value of rdwr, it reads the header of a file, writes it, or echo the value of the structured variable to a file. Note that, when reading, different records of hdr are allocated here, according to the values of the read variables. Records of hdr should be deallocated correctly by a call to hdr_free when hdr is not used anymore. Two instances of the hdr_io routines are defined : hdr_io_int to which only the unit number is given hdr_io_wfftype to which a wffil datatype is given
INPUTS
rdwr= if 1, read the hdr structured variable from the header of the file,
if 2, write the header to unformatted file
if 3, echo part of the header to formatted file (records 1 and 2)
if 4, echo the header to formatted file
if 5, read the hdr without rewinding (unformatted)
if 6, write the hdr without rewinding (unformatted)
unitfi=unit number of the file (unformatted if rdwr=1, 2, 5 or 6 formatted if rdwr=3,4)
OUTPUT
(see side effects)
SIDE EFFECTS
The following variables are both input or output : fform=kind of the array in the file if rdwr=1,5 : will be output ; if the reading fail, return fform=0 if rdwr=2,3,4,6 : should be input, will be written or echo to file hdr <type(hdr_type)>=the header structured variable if rdwr=1,5 : will be output if rdwr=2,3,4,6 : should be input, will be written or echo to file
NOTES
In all cases, the file is supposed to be open already When reading (rdwr=1) or writing (rdwr=2), rewind the file When echoing (rdwr=3) does not rewind the file. When reading (rdwr=5) or writing (rdwr=6), DOES NOT rewind the file
SOURCE
1823 subroutine hdr_io_wfftype(fform,hdr,rdwr,wff) 1824 1825 !Arguments ------------------------------------ 1826 integer,intent(inout) :: fform 1827 integer,intent(in) :: rdwr 1828 type(hdr_type),intent(inout) :: hdr 1829 type(wffile_type),intent(inout) :: wff 1830 1831 !Local variables------------------------------- 1832 #if defined HAVE_MPI 1833 integer :: ierr 1834 #endif 1835 1836 ! ************************************************************************* 1837 1838 DBG_ENTER("COLL") 1839 1840 if ( wff%iomode==IO_MODE_FORTRAN .or. & 1841 (wff%iomode==IO_MODE_FORTRAN_MASTER .and.wff%master==wff%me).or. & 1842 (wff%iomode==IO_MODE_MPI .and.wff%master==wff%me) ) then 1843 call hdr_io_int(fform,hdr,rdwr,wff%unwff) 1844 ! Master node **MUST** flush the output buffer so that the 1845 ! other nodes can read headform and therefore the Fortran marker length when MPI-IO is used 1846 if (rdwr == 2) call flush_unit(wff%unwff) 1847 end if 1848 1849 #if defined HAVE_MPI 1850 !In the parallel case, if the files were not local, need to bcast the data 1851 if(rdwr==1)then 1852 if (wff%iomode==IO_MODE_FORTRAN_MASTER .or. wff%iomode==IO_MODE_MPI) then 1853 if (wff%spaceComm/=MPI_COMM_SELF) then 1854 call xmpi_bcast(fform,wff%master,wff%spaceComm,ierr) 1855 call hdr%bcast(wff%master, wff%me, wff%spaceComm) 1856 end if 1857 wff%headform=hdr%headform 1858 if(wff%iomode==IO_MODE_MPI)then 1859 call hdr_skip_wfftype(wff,ierr) 1860 end if 1861 end if 1862 end if 1863 #if defined HAVE_MPI_IO 1864 if (rdwr == 2 .and. wff%iomode==IO_MODE_MPI) then 1865 if (wff%spaceComm/=MPI_COMM_SELF) then 1866 call xmpi_barrier(wff%spaceComm) 1867 end if 1868 wff%headform=hdr%headform 1869 call hdr_skip_wfftype(wff,ierr) 1870 end if 1871 #endif 1872 if (rdwr==5) wff%headform=hdr%headform 1873 #else 1874 if (rdwr==1.or.rdwr==5) wff%headform=hdr%headform 1875 #endif 1876 1877 DBG_EXIT("COLL") 1878 1879 end subroutine hdr_io_wfftype
m_hdr/hdr_malloc [ Functions ]
[ Top ] [ m_hdr ] [ Functions ]
NAME
hdr_malloc
FUNCTION
Allocate memory from dimensions with the exception of pawrhoij. This is a private routine. Client code should use hdr_init, hdr_fort_read.
SOURCE
824 subroutine hdr_malloc(hdr, bantot, nkpt, nsppol, npsp, natom, ntypat, nsym, nshiftk_orig, nshiftk) 825 826 !Arguments --------------------------------------------- 827 !scalars 828 integer,intent(in) :: bantot,nkpt,nsppol,npsp,natom,ntypat,nsym,nshiftk,nshiftk_orig 829 class(hdr_type),intent(inout) :: hdr 830 ! ************************************************************************* 831 832 !@hdt_type 833 call hdr%free() 834 835 ABI_MALLOC(hdr%istwfk, (nkpt)) 836 ABI_MALLOC(hdr%nband, (nkpt*nsppol)) 837 ABI_MALLOC(hdr%npwarr, (nkpt)) 838 ABI_MALLOC(hdr%pspcod, (npsp)) 839 ABI_MALLOC(hdr%pspdat, (npsp)) 840 ABI_MALLOC(hdr%pspso, (npsp)) 841 ABI_MALLOC(hdr%pspxc, (npsp)) 842 ABI_MALLOC(hdr%lmn_size, (npsp)) 843 ABI_MALLOC(hdr%so_psp, (npsp)) 844 ABI_MALLOC(hdr%symafm, (nsym)) 845 ABI_MALLOC(hdr%symrel, (3,3,nsym)) 846 ABI_MALLOC(hdr%typat, (natom)) 847 ABI_MALLOC(hdr%kptns, (3,nkpt)) 848 ABI_MALLOC(hdr%occ, (bantot)) 849 ABI_MALLOC(hdr%tnons, (3,nsym)) 850 ABI_MALLOC(hdr%wtk, (nkpt)) 851 ABI_MALLOC(hdr%xred, (3,natom)) 852 ABI_MALLOC(hdr%zionpsp, (npsp)) 853 ABI_MALLOC(hdr%znuclpsp, (npsp)) 854 ABI_MALLOC(hdr%znucltypat, (ntypat)) 855 ABI_MALLOC(hdr%title, (npsp)) 856 ABI_MALLOC(hdr%shiftk, (3,nshiftk)) 857 ABI_MALLOC(hdr%shiftk_orig, (3,nshiftk_orig)) 858 ABI_MALLOC(hdr%md5_pseudos, (npsp)) 859 ABI_MALLOC(hdr%amu, (ntypat)) 860 861 end subroutine hdr_malloc
m_hdr/hdr_mpio_skip [ Functions ]
[ Top ] [ m_hdr ] [ Functions ]
NAME
hdr_mio_skip
FUNCTION
Skip the abinit header in MPI-IO mode. This routine uses local MPI-IO calls hence it can be safely called by master node only. Note however that in this case the offset has to be communicated to the other nodes.
INPUTS
mpio_fh=MPI-IO file handler
TODO
We don't need to read record to skip. We just need to compute the offset from the dimensions. The algorithm is as follows: 1) master reads and broadcast the header. 2) The offset is computed from the header 3) Open the file with MPI and use the offset to point the data to be read.
OUTPUT
fform=kind of the array in the file offset=The offset of the Fortran record located immediately below the Abinit header.
SOURCE
1590 subroutine hdr_mpio_skip(mpio_fh, fform, offset) 1591 1592 !Arguments ------------------------------------ 1593 integer,intent(in) :: mpio_fh 1594 integer,intent(out) :: fform 1595 integer(kind=XMPI_OFFSET_KIND),intent(out) :: offset 1596 1597 !Local variables------------------------------- 1598 !scalars 1599 integer :: bsize_frm,mpi_type_frm 1600 #ifdef HAVE_MPI_IO 1601 integer :: headform,ierr,mu,usepaw,npsp 1602 !arrays 1603 integer(kind=MPI_OFFSET_KIND) :: fmarker,positloc 1604 integer :: iread(1),statux(MPI_STATUS_SIZE) 1605 #endif 1606 character(len=500) :: msg 1607 1608 ! ************************************************************************* 1609 1610 !@hdr_type 1611 offset = 0; fform = 0 1612 1613 bsize_frm = xmpio_bsize_frm ! bsize_frm= Byte length of the Fortran record marker. 1614 mpi_type_frm = xmpio_mpi_type_frm ! MPI type of the record marker. 1615 1616 #ifdef HAVE_MPI_IO 1617 !Reading the first record of the file ------------------------------------- 1618 !read (unitfi) codvsn,headform,.............. 1619 positloc = bsize_frm + 8*xmpi_bsize_ch 1620 call MPI_FILE_READ_AT(mpio_fh,positloc,iread,1,MPI_INTEGER,statux,ierr) 1621 fform=iread(1) 1622 1623 if (ANY(fform == [1,2,51,52,101,102] )) then 1624 ! This is the old format !read (unitfi) codvsn,fform 1625 headform=22 1626 write(msg,'(3a,i0,4a)') & 1627 "ABINIT version: ",trim(abinit_version)," cannot read old files with headform: ",headform,ch10,& 1628 "produced by previous versions. Use an old ABINIT version to read this file or ",ch10,& 1629 "regenerate your files with version >= 8.0." 1630 ABI_ERROR(msg) 1631 1632 else 1633 !read (unitfi)codvsn,headform,fform 1634 call MPI_FILE_READ_AT(mpio_fh,positloc,iread,1,MPI_INTEGER,statux,ierr) 1635 headform=iread(1) 1636 positloc = positloc + xmpi_bsize_int 1637 call MPI_FILE_READ_AT(mpio_fh,positloc,iread,1,MPI_INTEGER,statux,ierr) 1638 fform=iread(1) 1639 end if 1640 1641 if (headform < 80) then 1642 write(msg,'(3a,i0,4a)') & 1643 "ABINIT version: ",trim(abinit_version)," cannot read old files with headform: ",headform,ch10,& 1644 "produced by previous versions. Use an old ABINIT version to read this file or ",ch10,& 1645 "regenerate your files with version >= 8.0." 1646 ABI_ERROR(msg) 1647 end if 1648 1649 ! Skip first record. 1650 call xmpio_read_frm(mpio_fh,offset,xmpio_single,fmarker,ierr) 1651 1652 !Read npsp and usepaw from the second record and skip it 1653 positloc = offset + bsize_frm + xmpi_bsize_int*13 1654 call MPI_FILE_READ_AT(mpio_fh,positloc,iread,1,MPI_INTEGER,statux,ierr) 1655 npsp=iread(1) 1656 positloc = positloc + xmpi_bsize_int*4 1657 call MPI_FILE_READ_AT(mpio_fh,positloc,iread,1,MPI_INTEGER,statux,ierr) 1658 usepaw=iread(1) 1659 call xmpio_read_frm(mpio_fh,offset,xmpio_single,fmarker,ierr) 1660 1661 ! Skip the rest of the file --------------------------------------------- 1662 do mu=1,3+npsp 1663 call xmpio_read_frm(mpio_fh,offset,xmpio_single,fmarker,ierr) 1664 end do 1665 1666 if (usepaw == 1) then ! skip rhoij records. 1667 call xmpio_read_frm(mpio_fh,offset,xmpio_single,fmarker,ierr) 1668 call xmpio_read_frm(mpio_fh,offset,xmpio_single,fmarker,ierr) 1669 end if 1670 1671 #else 1672 ABI_ERROR("hdr_mpio_skip cannot be used when MPI-IO is not enabled") 1673 ABI_UNUSED(mpio_fh) 1674 #endif 1675 1676 end subroutine hdr_mpio_skip
m_hdr/hdr_ncread [ Functions ]
[ Top ] [ m_hdr ] [ Functions ]
NAME
hdr_ncread
FUNCTION
This subroutine deals with the reading of the hdr_type structured variables It handles variables according to the ETSF format, whenever possible and uses new variables when not available in the ETSF format. Note that, when reading, different records of hdr are allocated here, Records of hdr should be deallocated correctly by a call to hdr_free when hdr is not used anymore.
INPUTS
ncid=the unit of the open NetCDF file.
OUTPUT
fform=kind of the array in the file. if the reading fails, return fform=0
SOURCE
2951 subroutine hdr_ncread(Hdr, ncid, fform) 2952 2953 !Arguments ------------------------------------ 2954 !scalars 2955 integer,intent(in) :: ncid 2956 integer,intent(out) :: fform 2957 type(hdr_type),target,intent(out) :: hdr 2958 2959 !Local variables------------------------------- 2960 !scalars 2961 integer :: nresolution, itypat, ii, varid, ncerr 2962 character(len=500) :: msg 2963 !arrays 2964 integer,allocatable :: nband2d(:,:) 2965 real(dp),allocatable :: occ3d(:,:,:) 2966 2967 ! ************************************************************************* 2968 2969 !@hdr_type 2970 NCF_CHECK(nctk_set_datamode(ncid)) 2971 NCF_CHECK(nf90_get_var(ncid, vid("fform"), fform)) 2972 NCF_CHECK(nf90_get_var(ncid, vid("headform"), hdr%headform)) 2973 2974 if (hdr%headform < 80) then 2975 write(msg,'(3a,i0,4a)')& 2976 "ABINIT version: ",trim(abinit_version)," cannot read old files with headform: ",hdr%headform,ch10,& 2977 "produced by previous versions. Use an old ABINIT version to read this file or ",ch10,& 2978 "regenerate your files with version >= 8.0." 2979 ABI_ERROR(msg) 2980 end if 2981 2982 call check_fform(fform) 2983 2984 ! First, we read the declaration of code, fform ... 2985 ! pad the returned string with " " instead of "\0" 2986 ! 2987 ! Support for pre-v9 (length of codvsn was changed from 6 to 8) 2988 NCF_CHECK(nctk_get_dim(ncid, "codvsnlen", ii)) 2989 NCF_CHECK(nf90_get_var(ncid, vid("codvsn"), hdr%codvsn(1:ii))) 2990 call replace_ch0(hdr%codvsn) 2991 2992 ! Get ETSF dimensions 2993 NCF_CHECK(nctk_get_dim(ncid, "number_of_atoms", hdr%natom)) 2994 NCF_CHECK(nctk_get_dim(ncid, "number_of_kpoints", hdr%nkpt)) 2995 NCF_CHECK(nctk_get_dim(ncid, "number_of_components", hdr%nspden)) 2996 NCF_CHECK(nctk_get_dim(ncid, "number_of_spinor_components", hdr%nspinor)) 2997 NCF_CHECK(nctk_get_dim(ncid, "number_of_spins", hdr%nsppol)) 2998 NCF_CHECK(nctk_get_dim(ncid, "number_of_symmetry_operations", hdr%nsym)) 2999 NCF_CHECK(nctk_get_dim(ncid, "number_of_atom_species", hdr%ntypat)) 3000 NCF_CHECK(nctk_get_dim(ncid, "number_of_grid_points_vector1", hdr%ngfft(1))) 3001 NCF_CHECK(nctk_get_dim(ncid, "number_of_grid_points_vector2", hdr%ngfft(2))) 3002 NCF_CHECK(nctk_get_dim(ncid, "number_of_grid_points_vector3", hdr%ngfft(3))) 3003 NCF_CHECK(nctk_get_dim(ncid, "max_number_of_states", hdr%mband)) 3004 ! bantot is used to dimension %occ in hdr_malloc. Note that hdr%bantot != sum(nband) because states 3005 ! are packed in hdr%occ and therefore bantot <= hdr%mband * hdr%nkpt * hdr%nsppol 3006 NCF_CHECK(nctk_get_dim(ncid, "bantot", hdr%bantot)) 3007 3008 ! Read other dimensions, not handled by ETSF format. 3009 NCF_CHECK(nctk_get_dim(ncid, "npsp", hdr%npsp)) 3010 NCF_CHECK(nctk_get_dim(ncid, "nshiftk_orig", hdr%nshiftk_orig)) 3011 NCF_CHECK(nctk_get_dim(ncid, "nshiftk", hdr%nshiftk)) 3012 3013 ! Read other important scalar variables. 3014 NCF_CHECK(nf90_get_var(ncid, vid("usepaw"), hdr%usepaw)) 3015 NCF_CHECK(nf90_get_var(ncid, vid("usewvl"), hdr%usewvl)) 3016 3017 nresolution=0 3018 if (hdr%usewvl == 1) then 3019 ! This value must be 2... 3020 NCF_CHECK(nctk_get_dim(ncid, "number_of_wavelet_resolutions", nresolution)) 3021 ! We set the right ngfft, adding the padding space for wavelets. 3022 hdr%ngfft = hdr%ngfft + 31 3023 end if 3024 3025 ! Allocate all parts of hdr that need to be 3026 call hdr_malloc(hdr, hdr%bantot, hdr%nkpt, hdr%nsppol, hdr%npsp, hdr%natom, hdr%ntypat,& 3027 hdr%nsym, hdr%nshiftk_orig, hdr%nshiftk) 3028 3029 ABI_MALLOC(nband2d, (hdr%nkpt, hdr%nsppol)) 3030 NCF_CHECK(nf90_get_var(ncid, vid("number_of_states"), nband2d)) 3031 hdr%nband(:) = reshape(nband2d, [hdr%nkpt*hdr%nsppol]) 3032 ABI_FREE(nband2d) 3033 ABI_CHECK(hdr%mband == maxval(hdr%nband), "mband != maxval(hdr%nband)") 3034 3035 if (hdr%usepaw==1) then 3036 ABI_MALLOC(hdr%pawrhoij,(hdr%natom)) 3037 end if 3038 3039 !We get then all variables included in ETSF 3040 if (hdr%usewvl==0) then 3041 NCF_CHECK(nf90_get_var(ncid, vid("kinetic_energy_cutoff"), hdr%ecut)) 3042 NCF_CHECK(nf90_get_var(ncid, vid("number_of_coefficients"), hdr%npwarr)) 3043 else 3044 NCF_CHECK(nf90_get_var(ncid, vid("number_of_wavelets"), hdr%nwvlarr)) 3045 end if 3046 3047 ! read 3d matrix with stride and transfer to (stupid) 1d hdr%occ in packed form. 3048 ABI_CALLOC(occ3d, (hdr%mband, hdr%nkpt, hdr%nsppol)) 3049 NCF_CHECK(nf90_get_var(ncid, vid("occupations"), occ3d)) 3050 call hdr_set_occ(hdr, occ3d) 3051 ABI_FREE(occ3d) 3052 3053 NCF_CHECK(nf90_get_var(ncid, vid("fermi_energy"), hdr%fermie)) 3054 NCF_CHECK(nf90_get_var(ncid, vid("primitive_vectors"), hdr%rprimd)) 3055 NCF_CHECK(nf90_get_var(ncid, vid("reduced_symmetry_matrices"), hdr%symrel)) 3056 NCF_CHECK(nf90_get_var(ncid, vid("atom_species"), hdr%typat)) 3057 NCF_CHECK(nf90_get_var(ncid, vid("reduced_symmetry_translations"), hdr%tnons)) 3058 NCF_CHECK(nf90_get_var(ncid, vid("reduced_atom_positions"), hdr%xred)) 3059 NCF_CHECK(nf90_get_var(ncid, vid("atomic_numbers"), hdr%znucltypat)) 3060 NCF_CHECK(nf90_get_var(ncid, vid("reduced_coordinates_of_kpoints"), hdr%kptns)) 3061 NCF_CHECK(nf90_get_var(ncid, vid("kpoint_weights"), hdr%wtk)) 3062 NCF_CHECK(nf90_get_var(ncid, vid("date"), hdr%date)) 3063 NCF_CHECK(nf90_get_var(ncid, vid("ecut_eff"), hdr%ecut_eff)) 3064 NCF_CHECK(nf90_get_var(ncid, vid("ecutsm"), hdr%ecutsm)) 3065 NCF_CHECK(nf90_get_var(ncid, vid("etot"), hdr%etot)) 3066 NCF_CHECK(nf90_get_var(ncid, vid("intxc"), hdr%intxc)) 3067 NCF_CHECK(nf90_get_var(ncid, vid("ixc"), hdr%ixc)) 3068 NCF_CHECK(nf90_get_var(ncid, vid("occopt"), hdr%occopt)) 3069 NCF_CHECK(nf90_get_var(ncid, vid("pertcase"), hdr%pertcase)) 3070 NCF_CHECK(nf90_get_var(ncid, vid("qptn"), hdr%qptn)) 3071 NCF_CHECK(nf90_get_var(ncid, vid("residm"), hdr%residm)) 3072 NCF_CHECK(nf90_get_var(ncid, vid("stmbias"), hdr%stmbias)) 3073 NCF_CHECK(nf90_get_var(ncid, vid("tphysel"), hdr%tphysel)) 3074 NCF_CHECK(nf90_get_var(ncid, vid("tsmear"), hdr%tsmear)) 3075 NCF_CHECK(nf90_get_var(ncid, vid("ecutdg"), hdr%ecutdg)) 3076 3077 ! Multidimensional variables. Be careful with zionpsp if alchemical mixing! 3078 NCF_CHECK(nf90_get_var(ncid, vid("istwfk"), hdr%istwfk)) 3079 NCF_CHECK(nf90_get_var(ncid, vid("pspcod"), hdr%pspcod)) 3080 NCF_CHECK(nf90_get_var(ncid, vid("pspdat"), hdr%pspdat)) 3081 NCF_CHECK(nf90_get_var(ncid, vid("pspso"), hdr%pspso)) 3082 NCF_CHECK(nf90_get_var(ncid, vid("pspxc"), hdr%pspxc)) 3083 NCF_CHECK(nf90_get_var(ncid, vid("so_psp"), hdr%so_psp)) 3084 NCF_CHECK(nf90_get_var(ncid, vid("symafm"), hdr%symafm)) 3085 NCF_CHECK(nf90_get_var(ncid, vid("zionpsp"), hdr%zionpsp)) 3086 NCF_CHECK(nf90_get_var(ncid, vid("znuclpsp"), hdr%znuclpsp)) 3087 NCF_CHECK(nf90_get_var(ncid, vid("kptopt"), hdr%kptopt)) 3088 NCF_CHECK(nf90_get_var(ncid, vid("pawcpxocc"), hdr%pawcpxocc)) 3089 NCF_CHECK(nf90_get_var(ncid, vid("nelect"), hdr%nelect)) 3090 NCF_CHECK(nf90_get_var(ncid, vid("charge"), hdr%cellcharge)) 3091 NCF_CHECK(nf90_get_var(ncid, vid("kptrlatt_orig"), hdr%kptrlatt_orig)) 3092 NCF_CHECK(nf90_get_var(ncid, vid("kptrlatt"), hdr%kptrlatt)) 3093 NCF_CHECK(nf90_get_var(ncid, vid("shiftk_orig"), hdr%shiftk_orig)) 3094 NCF_CHECK(nf90_get_var(ncid, vid("shiftk"), hdr%shiftk)) 3095 NCF_CHECK(nf90_get_var(ncid, vid("md5_pseudos"), hdr%md5_pseudos)) 3096 NCF_CHECK(nf90_get_var(ncid, vid("amu"), hdr%amu)) 3097 NCF_CHECK(nf90_get_var(ncid, vid("icoulomb"), hdr%icoulomb)) 3098 NCF_CHECK(nf90_get_var(ncid, vid("title"), hdr%title)) 3099 3100 ! Pad the returned string with " " instead of "\0" 3101 do itypat=1,size(hdr%title) 3102 call replace_ch0(hdr%title(itypat)) 3103 end do 3104 3105 NCF_CHECK(nf90_get_var(ncid, vid("lmn_size"), hdr%lmn_size)) 3106 if (hdr%usepaw==1) then 3107 call pawrhoij_io(hdr%pawrhoij,ncid,hdr%nsppol,hdr%nspinor,hdr%nspden,hdr%lmn_size,hdr%typat,& 3108 hdr%headform,"Read",form="netcdf") 3109 end if 3110 3111 ! Reading the values of fermih, ne_qFD, nh_qFD and ivalence if occopt = 9 3112 hdr%fermih = zero 3113 hdr%ne_qFD = zero 3114 hdr%nh_qFD = zero 3115 hdr%ivalence = hdr%nelect / 2 3116 if (hdr%occopt == 9) then 3117 ncerr = nf90_inq_varid(ncid, "hole_fermi_energy", varid) 3118 if (ncerr /= nf90_noerr) then 3119 NCF_CHECK(nf90_get_var(ncid, vid("hole_fermi_energy"), hdr%fermih)) 3120 end if 3121 ncerr = nf90_inq_varid(ncid, "ne_qFD", varid) 3122 if (ncerr /= nf90_noerr) then 3123 NCF_CHECK(nf90_get_var(ncid, vid("ne_qFD"), hdr%ne_qFD)) 3124 end if 3125 ncerr = nf90_inq_varid(ncid, "nh_qFD", varid) 3126 if (ncerr /= nf90_noerr) then 3127 NCF_CHECK(nf90_get_var(ncid, vid("nh_qFD"), hdr%nh_qFD)) 3128 end if 3129 ncerr = nf90_inq_varid(ncid, "ivalence", varid) 3130 if (ncerr /= nf90_noerr) then 3131 NCF_CHECK(nf90_get_var(ncid, vid("ivalence"), hdr%ivalence)) 3132 end if 3133 3134 endif 3135 3136 contains 3137 integer function vid(vname) 3138 3139 character(len=*),intent(in) :: vname 3140 vid = nctk_idname(ncid, vname) 3141 end function vid 3142 3143 end subroutine hdr_ncread
m_hdr/hdr_ncwrite [ Functions ]
[ Top ] [ m_hdr ] [ Functions ]
NAME
hdr_ncwrite
FUNCTION
This subroutine deals with the output of the hdr_type structured variables in ETSF+NETCDF fornat. It handles variables according to the ETSF format, whenever possible and uses new variables when not available in the ETSF format.
INPUTS
fform=kind of the array in the file
ncid=the unit of the open NetCDF file.
[spinat(3, natom)]= Spinat input variable. In principle it should be stored in the hdr
as it actually affects the real space group but this requires changing hdr_type and fform and dealing
with backward compatibility issues especially in Fortran-IO.
[nc_define]=Optional flag. If True, the basic dimensions required by the ETSF specification
are written. Default: False.
OUTPUT
Only writing
SOURCE
3326 integer function hdr_ncwrite(hdr, ncid, fform, spinat, nc_define) result(ncerr) 3327 3328 !Arguments ------------------------------------ 3329 !scalars 3330 integer,intent(in) :: ncid,fform 3331 logical,optional,intent(in) :: nc_define 3332 class(hdr_type),target,intent(in) :: hdr 3333 real(dp),optional,intent(in) :: spinat(3, hdr%natom) 3334 3335 !Local variables------------------------------- 3336 !scalars 3337 logical :: my_define 3338 character(len=etsfio_charlen) :: basis_set,k_dependent,symmorphic 3339 !character(len=500) :: msg 3340 !arrays 3341 integer,allocatable :: arr2d(:,:) 3342 real(dp),allocatable :: arr3d(:,:,:) 3343 type(pawrhoij_type),pointer :: rhoij_ptr(:) 3344 3345 ! ************************************************************************* 3346 3347 call check_fform(fform) 3348 3349 !@hdr_type 3350 my_define = .False.; if (present(nc_define)) my_define = nc_define 3351 ncerr = nf90_noerr 3352 3353 k_dependent = "no"; if (any(hdr%nband(1) /= hdr%nband)) k_dependent = "yes" 3354 symmorphic = "no"; if (all(abs(hdr%tnons) < tol6)) symmorphic = "yes" 3355 3356 if (my_define) then 3357 !call wrtout(std_out, "hdr_ncwrite: defining variables") 3358 NCF_CHECK(nctk_def_basedims(ncid, defmode=.True.)) 3359 3360 ! Write ETSF-dims 3361 ncerr = nctk_def_dims(ncid, [ & 3362 nctkdim_t("max_number_of_states", hdr%mband), & 3363 nctkdim_t("number_of_atoms", hdr%natom), & 3364 nctkdim_t("number_of_atom_species", hdr%ntypat), & 3365 nctkdim_t("number_of_components", hdr%nspden), & 3366 nctkdim_t("number_of_kpoints", hdr%nkpt), & 3367 nctkdim_t("number_of_spinor_components", hdr%nspinor), & 3368 nctkdim_t("number_of_spins", hdr%nsppol), & 3369 nctkdim_t("number_of_symmetry_operations", hdr%nsym) & 3370 ]) 3371 !nctkdim_t("nshiftk_orig", ebands%nshiftk_orig), & 3372 !nctkdim_t("nshiftk", ebands%nshiftk)], & 3373 NCF_CHECK(ncerr) 3374 3375 ! Define part of geometry section contained in the header. 3376 ncerr = nctk_def_arrays(ncid, [ & 3377 ! Atomic structure and symmetry operations 3378 nctkarr_t("primitive_vectors", "dp", "number_of_cartesian_directions, number_of_vectors"), & 3379 nctkarr_t("reduced_symmetry_matrices", "int", & 3380 "number_of_reduced_dimensions, number_of_reduced_dimensions, number_of_symmetry_operations"), & 3381 nctkarr_t("reduced_symmetry_translations", "dp", "number_of_reduced_dimensions, number_of_symmetry_operations"), & 3382 nctkarr_t("atom_species", "int", "number_of_atoms"), & 3383 nctkarr_t("reduced_atom_positions", "dp", "number_of_reduced_dimensions, number_of_atoms"), & 3384 nctkarr_t("atomic_numbers", "dp", "number_of_atom_species") & 3385 !nctkarr_t("atom_species_names", "char", "character_string_length, number_of_atom_species"), & 3386 !nctkarr_t("chemical_symbols", "char", "symbol_length, number_of_atom_species"), & 3387 ! Atomic information. 3388 !nctkarr_t("valence_charges", "dp", "number_of_atom_species"), & ! NB: This variable is not written if alchemical 3389 !nctkarr_t("pseudopotential_types", "char", "character_string_length, number_of_atom_species") & 3390 ]) 3391 NCF_CHECK(ncerr) 3392 3393 ! Some variables require the "symmorphic" attribute. 3394 NCF_CHECK(nf90_put_att(ncid, vid("reduced_symmetry_matrices"), "symmorphic", symmorphic)) 3395 NCF_CHECK(nf90_put_att(ncid, vid("reduced_symmetry_translations"), "symmorphic", symmorphic)) 3396 3397 ! At this point we have an ETSF-compliant file. Add additional data for internal use in abinit. 3398 ncerr = nctk_def_arrays(ncid, nctkarr_t('symafm', "int", "number_of_symmetry_operations")) 3399 NCF_CHECK(ncerr) 3400 3401 ! TODO spinat should be added to the header 3402 if (present(spinat)) then 3403 ncerr = nctk_def_arrays(ncid, nctkarr_t("spinat", "dp", "three, number_of_atoms")) 3404 NCF_CHECK(ncerr) 3405 end if 3406 3407 ! Define k-points. Note: monkhorst_pack_folding is replaced by kptrlatt and shiftk 3408 ncerr = nctk_def_arrays(ncid, [ & 3409 nctkarr_t("reduced_coordinates_of_kpoints", "dp", "number_of_reduced_dimensions, number_of_kpoints"), & 3410 nctkarr_t("kpoint_weights", "dp", "number_of_kpoints") & 3411 !nctkarr_t("monkhorst_pack_folding", "int", "number_of_vectors") & 3412 ]) 3413 NCF_CHECK(ncerr) 3414 3415 ! Define states section. 3416 ncerr = nctk_def_arrays(ncid, [ & 3417 nctkarr_t("number_of_states", "int", "number_of_kpoints, number_of_spins"), & 3418 nctkarr_t("eigenvalues", "dp", "max_number_of_states, number_of_kpoints, number_of_spins"), & 3419 nctkarr_t("occupations", "dp", "max_number_of_states, number_of_kpoints, number_of_spins"), & 3420 nctkarr_t("smearing_scheme", "char", "character_string_length") & 3421 ]) 3422 NCF_CHECK(ncerr) 3423 3424 ncerr = nctk_def_iscalars(ncid, [character(len=nctk_slen) :: "number_of_electrons"]) 3425 NCF_CHECK(ncerr) 3426 ncerr = nctk_def_dpscalars(ncid, [character(len=nctk_slen) :: "fermi_energy", "smearing_width"]) 3427 NCF_CHECK(ncerr) 3428 NCF_CHECK(nctk_set_atomic_units(ncid, "smearing_width")) 3429 3430 ! Some variables require the specifications of units. 3431 NCF_CHECK(nctk_set_atomic_units(ncid, "eigenvalues")) 3432 NCF_CHECK(nctk_set_atomic_units(ncid, "fermi_energy")) 3433 NCF_CHECK(nf90_put_att(ncid, vid("number_of_states"), "k_dependent", k_dependent)) 3434 3435 ! Define dimensions. 3436 ncerr = nctk_def_dims(ncid, [& 3437 nctkdim_t("npsp", hdr%npsp), nctkdim_t("codvsnlen", 8), nctkdim_t("psptitlen", 132)& 3438 ]) 3439 NCF_CHECK(ncerr) 3440 3441 if (hdr%usewvl==1) then ! Add the BigDFT private dimensions. 3442 ncerr = nctk_def_dims(ncid, nctkdim_t("number_of_wavelet_resolutions", 2)) 3443 NCF_CHECK(ncerr) 3444 end if 3445 3446 ! Define scalars. 3447 ncerr = nctk_def_iscalars(ncid, [character(len=nctk_slen) :: & 3448 "date", "ixc", "intxc", "occopt", "pertcase", "headform", "fform", "usepaw", "usewvl"]) 3449 NCF_CHECK(ncerr) 3450 3451 ncerr = nctk_def_dpscalars(ncid, [character(len=nctk_slen) :: & 3452 "ecut_eff", "ecutdg", "ecutsm", "etot", "residm", "stmbias", "tphysel", "tsmear"]) 3453 NCF_CHECK(ncerr) 3454 3455 ! Multi-dimensional variables. 3456 ncerr = nctk_def_arrays(ncid, [& 3457 nctkarr_t("istwfk", "i", "number_of_kpoints"),& 3458 nctkarr_t("codvsn", "c", "codvsnlen"),& 3459 nctkarr_t("pspcod", "i", "npsp"),& 3460 nctkarr_t("pspdat", "i", "npsp"),& 3461 nctkarr_t("pspso", "i", "npsp"),& 3462 nctkarr_t("pspxc", "i", "npsp"),& 3463 nctkarr_t("qptn", "dp", "number_of_reduced_dimensions"),& 3464 nctkarr_t("so_psp", "i", "npsp"),& 3465 !nctkarr_t("symafm", "i", "number_of_symmetry_operations"),& 3466 nctkarr_t("title", "c", "psptitlen, npsp"),& 3467 nctkarr_t("zionpsp", "dp", "npsp"),& 3468 nctkarr_t("znuclpsp", "dp", "npsp"),& 3469 nctkarr_t("lmn_size", "i", "npsp")]) 3470 NCF_CHECK(ncerr) 3471 3472 ! Add the BigDFT private variables. 3473 if (hdr%usewvl == 1) then 3474 ncerr = nctk_def_arrays(ncid, nctkarr_t("number_of_wavelets", "i", "number_of_wavelet_resolutions")) 3475 NCF_CHECK(ncerr) 3476 end if 3477 3478 NCF_CHECK(nctk_def_arrays(ncid, nctkarr_t("basis_set", "char", "character_string_length"))) 3479 if (hdr%usewvl == 0) then 3480 NCF_CHECK(nctk_def_dpscalars(ncid, [character(len=nctk_slen) :: "kinetic_energy_cutoff"])) 3481 NCF_CHECK(nctk_set_atomic_units(ncid, "kinetic_energy_cutoff")) 3482 NCF_CHECK(nctk_def_arrays(ncid, nctkarr_t("number_of_coefficients", "int", "number_of_kpoints"))) 3483 end if 3484 3485 NCF_CHECK(nf90_put_att(ncid, vid("number_of_states"), "k_dependent", k_dependent)) 3486 3487 if (hdr%usewvl == 0) then 3488 ! Note that here we always use the coarse FFT mesh even if usepaw == 1 3489 ncerr = nctk_def_dims(ncid, [& 3490 nctkdim_t("number_of_grid_points_vector1", hdr%ngfft(1)),& 3491 nctkdim_t("number_of_grid_points_vector2", hdr%ngfft(2)),& 3492 nctkdim_t("number_of_grid_points_vector3", hdr%ngfft(3))], defmode=.True.) 3493 NCF_CHECK(ncerr) 3494 else 3495 ABI_WARNING("Don't know how to define grid_points for wavelets!") 3496 end if 3497 3498 !write(std_out,*)"hdr%nshiftk_orig,hdr%nshiftk",hdr%nshiftk_orig,hdr%nshiftk 3499 ncerr = nctk_def_dims(ncid, [& 3500 nctkdim_t("nshiftk_orig", hdr%nshiftk_orig),& 3501 nctkdim_t("nshiftk", hdr%nshiftk), & 3502 nctkdim_t("bantot", hdr%bantot), & 3503 nctkdim_t("md5_slen", md5_slen)], defmode=.True.) 3504 NCF_CHECK(ncerr) 3505 3506 ncerr = nctk_def_iscalars(ncid, [character(len=nctk_slen) :: "kptopt", "pawcpxocc", "icoulomb"]) 3507 NCF_CHECK(ncerr) 3508 ncerr = nctk_def_dpscalars(ncid, [character(len=nctk_slen) :: "nelect", "charge"]) 3509 NCF_CHECK(ncerr) 3510 3511 ncerr = nctk_def_arrays(ncid, [& 3512 nctkarr_t("kptrlatt_orig", "i", "number_of_reduced_dimensions, number_of_reduced_dimensions"),& 3513 nctkarr_t("kptrlatt", "i", "number_of_reduced_dimensions, number_of_reduced_dimensions"),& 3514 nctkarr_t("shiftk_orig", "dp", "number_of_reduced_dimensions, nshiftk_orig"),& 3515 nctkarr_t("shiftk", "dp", "number_of_reduced_dimensions, nshiftk"), & 3516 nctkarr_t("amu", "dp", "number_of_atom_species"), & 3517 nctkarr_t("md5_pseudos", "ch", "md5_slen, npsp") ]) 3518 NCF_CHECK(ncerr) 3519 3520 !call wrtout(std_out, "hdr_ncwrite completed define mode") 3521 end if ! my_define 3522 3523 ! Switch to write mode. 3524 NCF_CHECK(nctk_set_datamode(ncid)) 3525 3526 ! write ETSF variables. 3527 if (hdr%usewvl == 0) then 3528 ! Plane wave case. 3529 basis_set = "plane_waves" 3530 NCF_CHECK(nf90_put_var(ncid, vid("basis_set"), basis_set)) 3531 NCF_CHECK(nf90_put_var(ncid, vid("kinetic_energy_cutoff"), hdr%ecut)) 3532 NCF_CHECK(nf90_put_var(ncid, vid("number_of_coefficients"), hdr%npwarr)) 3533 else 3534 ! Wavelet case. 3535 basis_set = "daubechies_wavelets" 3536 NCF_CHECK(nf90_put_var(ncid, vid("basis_set"), basis_set)) 3537 ! Required variable than should enter the standard. 3538 NCF_CHECK(nf90_put_var(ncid, vid("number_of_wavelets"), hdr%nwvlarr)) 3539 end if 3540 3541 ! Write electrons 3542 NCF_CHECK(nf90_put_var(ncid, vid("fermi_energy"), hdr%fermie)) 3543 NCF_CHECK(nf90_put_var(ncid, vid("smearing_width"), hdr%tsmear)) 3544 NCF_CHECK(nf90_put_var(ncid, vid("smearing_scheme"), nctk_string_from_occopt(hdr%occopt))) 3545 3546 ! transfer data from (stupid) 1d hdr%nband and hdr%occ in packed form to 2d - 3d matrix with stride 3547 ! native support for array and array syntax is one of the reasons why we still use Fortran 3548 ! and we program like in C but without the power of C!o 3549 3550 ! Also, strange problem with Petrus + Nag5: had to explicitly specify nf90_put_var, 3551 ! with explicit definition of start, count and stride . 3552 ! Direct calls to NCF_CHECK, see below, were working for selected tests, but not all tests 3553 ABI_MALLOC(arr2d, (hdr%nkpt, hdr%nsppol)) 3554 arr2d(:,:) = reshape(hdr%nband, [hdr%nkpt, hdr%nsppol]) 3555 ncerr = nf90_put_var(ncid, vid("number_of_states"), arr2d, start=[1,1], count=[hdr%nkpt,hdr%nsppol], stride=[1,1]) 3556 NCF_CHECK(ncerr) 3557 ABI_FREE(arr2d) 3558 3559 ABI_MALLOC(arr3d, (hdr%mband, hdr%nkpt, hdr%nsppol)) 3560 call hdr_get_occ3d(hdr, arr3d) 3561 NCF_CHECK(nf90_put_var(ncid, vid("occupations"), arr3d)) 3562 ABI_FREE(arr3d) 3563 3564 ! Write geometry 3565 NCF_CHECK(nf90_put_var(ncid, vid("primitive_vectors"), hdr%rprimd)) 3566 NCF_CHECK(nf90_put_var(ncid, vid("reduced_symmetry_matrices"), hdr%symrel)) 3567 NCF_CHECK(nf90_put_var(ncid, vid("atom_species"), hdr%typat)) 3568 NCF_CHECK(nf90_put_var(ncid, vid("reduced_symmetry_translations"), hdr%tnons)) 3569 NCF_CHECK(nf90_put_var(ncid, vid("reduced_atom_positions"), hdr%xred)) 3570 NCF_CHECK(nf90_put_var(ncid, vid("atomic_numbers"), hdr%znucltypat)) 3571 3572 ! Write k-points. 3573 NCF_CHECK(nf90_put_var(ncid, vid("reduced_coordinates_of_kpoints"), hdr%kptns)) 3574 NCF_CHECK(nf90_put_var(ncid, vid("kpoint_weights"), hdr%wtk)) 3575 3576 ! Write non-ETSF variables. 3577 NCF_CHECK(nf90_put_var(ncid, vid("codvsn"), hdr%codvsn)) 3578 NCF_CHECK(nf90_put_var(ncid, vid("title"), hdr%title)) 3579 3580 ncerr = nctk_write_iscalars(ncid, [character(len=nctk_slen) :: & 3581 & "date", "ixc", "intxc", "occopt", "pertcase", "headform", "fform", "usepaw", "icoulomb"],& 3582 & [hdr%date, hdr%ixc ,hdr%intxc ,hdr%occopt, hdr%pertcase, HDR_LATEST_HEADFORM, fform, hdr%usepaw, hdr%icoulomb]) 3583 NCF_CHECK(ncerr) 3584 3585 ncerr = nctk_write_dpscalars(ncid, [character(len=nctk_slen) :: & 3586 & "ecut_eff", "ecutdg", "ecutsm", "etot", "residm", "stmbias", "tphysel", "tsmear"],& 3587 & [hdr%ecut_eff, hdr%ecutdg, hdr%ecutsm, hdr%etot, hdr%residm, hdr%stmbias, hdr%tphysel, hdr%tsmear]) 3588 NCF_CHECK(ncerr) 3589 3590 ! Write Abinit array variables. 3591 3592 ! FIXME Be careful with zionpsp if alchemical mixing! 3593 NCF_CHECK(nf90_put_var(ncid, vid("istwfk"), hdr%istwfk)) 3594 NCF_CHECK(nf90_put_var(ncid, vid("pspcod"), hdr%pspcod)) 3595 NCF_CHECK(nf90_put_var(ncid, vid("pspdat"), hdr%pspdat)) 3596 NCF_CHECK(nf90_put_var(ncid, vid("pspso"), hdr%pspso)) 3597 NCF_CHECK(nf90_put_var(ncid, vid("pspxc"), hdr%pspxc)) 3598 NCF_CHECK(nf90_put_var(ncid, vid("qptn"), hdr%qptn)) 3599 NCF_CHECK(nf90_put_var(ncid, vid("so_psp"), hdr%so_psp)) 3600 NCF_CHECK(nf90_put_var(ncid, vid("symafm"), hdr%symafm)) 3601 NCF_CHECK(nf90_put_var(ncid, vid("znuclpsp"), hdr%znuclpsp)) 3602 NCF_CHECK(nf90_put_var(ncid, vid("zionpsp"), hdr%zionpsp)) 3603 NCF_CHECK(nf90_put_var(ncid, vid("lmn_size"), hdr%lmn_size)) 3604 NCF_CHECK(nf90_put_var(ncid, vid("usewvl"), hdr%usewvl)) 3605 3606 if (present(spinat)) then 3607 NCF_CHECK(nf90_put_var(ncid, vid("spinat"), spinat)) 3608 end if 3609 3610 ! Write hdr%pawrhoij. 3611 if (hdr%usepaw == 1) then 3612 ! Dirty trick to bypass check on the intent, but the problem is in the intent(inout) of pawrhoij_io 3613 rhoij_ptr => hdr%pawrhoij 3614 call pawrhoij_io(rhoij_ptr,ncid,hdr%nsppol,hdr%nspinor,hdr%nspden,hdr%lmn_size,hdr%typat,& 3615 HDR_LATEST_HEADFORM,"Write",form="netcdf") 3616 end if 3617 3618 ncerr = nctk_write_iscalars(ncid, [character(len=nctk_slen) :: & 3619 "kptopt", "pawcpxocc"], [hdr%kptopt, hdr%pawcpxocc]) 3620 NCF_CHECK(ncerr) 3621 3622 ncerr = nctk_write_dpscalars(ncid, [character(len=nctk_slen) :: & 3623 "nelect", "charge"], [hdr%nelect, hdr%cellcharge]) 3624 NCF_CHECK(ncerr) 3625 3626 ! NB: In etsf_io the number of electrons is declared as integer. 3627 ! We use abinit nelect to store the value as real(dp). 3628 NCF_CHECK(nf90_put_var(ncid, vid("number_of_electrons"), nint(hdr%nelect))) 3629 NCF_CHECK(nf90_put_var(ncid, vid("kptrlatt_orig"), hdr%kptrlatt_orig)) 3630 NCF_CHECK(nf90_put_var(ncid, vid("kptrlatt"), hdr%kptrlatt)) 3631 NCF_CHECK(nf90_put_var(ncid, vid("shiftk_orig"), hdr%shiftk_orig)) 3632 NCF_CHECK(nf90_put_var(ncid, vid("shiftk"), hdr%shiftk)) 3633 NCF_CHECK(nf90_put_var(ncid, vid("md5_pseudos"), hdr%md5_pseudos)) 3634 NCF_CHECK(nf90_put_var(ncid, vid("amu"), hdr%amu)) 3635 3636 if (hdr%occopt == 9) then 3637 ncerr = nctk_def_dpscalars(ncid, [character(len=nctk_slen) :: "hole_fermi_energy", "ne_qFD", "nh_qFD"]) 3638 NCF_CHECK(ncerr) 3639 NCF_CHECK(nctk_set_atomic_units(ncid, "hole_fermi_energy")) 3640 NCF_CHECK(nf90_put_var(ncid, vid("hole_fermi_energy"), hdr%fermih)) 3641 ncerr = nctk_def_iscalars(ncid, [character(len=nctk_slen) :: "ivalence"]) 3642 NCF_CHECK(ncerr) 3643 ncerr = nctk_write_iscalars(ncid, [character(len=nctk_slen) :: "ivalence"], [hdr%ivalence]) 3644 NCF_CHECK(ncerr) 3645 ncerr = nctk_write_dpscalars(ncid, [character(len=nctk_slen) :: "ne_qFD", "nh_qFD"],[hdr%ne_qFD, hdr%nh_qFD]) 3646 end if 3647 3648 contains 3649 integer function vid(vname) 3650 character(len=*),intent(in) :: vname 3651 vid = nctk_idname(ncid, vname) 3652 end function vid 3653 3654 end function hdr_ncwrite
m_hdr/hdr_read_from_fname [ Functions ]
[ Top ] [ m_hdr ] [ Functions ]
NAME
hdr_read_from_fname
FUNCTION
Read the header from file fname. Use Fortran IO or Netcdf depending on the extension of the file Only rank0 process reads the header and then broadcast data to the other processes inside comm.
INPUTS
fname=String with the name of the file. comm = MPI communicator.
OUTPUT
Hdr<hdr_type>=The abinit header. fform=Kind of the array in the file (0 signals an error)
SOURCE
1453 subroutine hdr_read_from_fname(Hdr, fname, fform, comm) 1454 1455 !Arguments ------------------------------------ 1456 integer,intent(in) :: comm 1457 integer,intent(out) :: fform 1458 character(len=*),intent(in) :: fname 1459 type(hdr_type),intent(inout) :: Hdr 1460 1461 !Local variables------------------------------- 1462 integer,parameter :: rdwr1=1,master=0 1463 integer :: fh,my_rank,mpierr 1464 character(len=500) :: msg 1465 character(len=len(fname)) :: my_fname 1466 1467 ! ************************************************************************* 1468 1469 my_rank = xmpi_comm_rank(comm) 1470 my_fname = fname 1471 1472 if (nctk_try_fort_or_ncfile(my_fname, msg) /= 0) then 1473 ABI_ERROR(msg) 1474 end if 1475 1476 if (my_rank == master) then 1477 if (.not.isncfile(my_fname)) then 1478 ! Use Fortran IO to open the file and read the header. 1479 if (open_file(my_fname,msg,newunit=fh,form="unformatted", status="old") /= 0) then 1480 ABI_ERROR(msg) 1481 end if 1482 1483 call hdr_fort_read(Hdr,fh,fform,rewind=(rdwr1==1)) 1484 ABI_CHECK(fform /= 0, sjoin("fform == 0 while reading:", my_fname)) 1485 close(fh) 1486 1487 else 1488 ! Use Netcdf to open the file and read the header. 1489 NCF_CHECK(nctk_open_read(fh, my_fname, xmpi_comm_self)) 1490 call hdr_ncread(Hdr,fh, fform) 1491 ABI_CHECK(fform /= 0, sjoin("Error while reading:", my_fname)) 1492 NCF_CHECK(nf90_close(fh)) 1493 end if 1494 end if 1495 1496 ! Broadcast fform and the header. 1497 if (xmpi_comm_size(comm) > 1) then 1498 call hdr%bcast(master, my_rank, comm) 1499 call xmpi_bcast(fform, master, comm, mpierr) 1500 end if 1501 1502 end subroutine hdr_read_from_fname
m_hdr/hdr_set_occ [ Functions ]
[ Top ] [ m_hdr ] [ Functions ]
NAME
hdr_set_occ
FUNCTION
Set the occuations hdr%occ(:) from a 3d array with stride.
SOURCE
3666 subroutine hdr_set_occ(hdr, occ3d) 3667 3668 !Arguments ------------------------------------ 3669 class(hdr_type),intent(inout) :: hdr 3670 real(dp),intent(in) :: occ3d(hdr%mband,hdr%nkpt,hdr%nsppol) 3671 3672 !Local variables------------------------------- 3673 !scalars 3674 integer :: ii,band,ikpt,spin 3675 3676 !************************************************************************* 3677 3678 ii = 0 3679 do spin=1,hdr%nsppol 3680 do ikpt=1,hdr%nkpt 3681 do band=1,hdr%nband(ikpt + (spin-1) * hdr%nkpt) 3682 ii = ii +1 3683 hdr%occ(ii) = occ3d(band,ikpt,spin) 3684 end do 3685 end do 3686 end do 3687 3688 end subroutine hdr_set_occ
m_hdr/hdr_skip_int [ Functions ]
[ Top ] [ m_hdr ] [ Functions ]
NAME
hdr_skip_int
FUNCTION
Skip wavefunction or density file header, after having rewound the file. Two instances of the hdr_skip routines are defined: hdr_skip_int to which only the unit number is given hdr_skip_wfftype to which a wffil datatype is given
INPUTS
unit = number of unit to be read
OUTPUT
ierr = error code returned by the MPI calls
SIDE EFFECTS
NOTES
No checking performed, since hdr_skip is assumed to be used only on temporary wavefunction files. This initialize further reading and checking by rwwf
SOURCE
2150 subroutine hdr_skip_int(unitfi,ierr) 2151 2152 !Arguments ------------------------------------ 2153 integer,intent(in) :: unitfi 2154 integer,intent(out) :: ierr 2155 2156 !Local variables------------------------------- 2157 type(wffile_type) :: wff 2158 2159 ! ************************************************************************* 2160 2161 !Use default values for wff 2162 wff%unwff=unitfi; wff%iomode=IO_MODE_FORTRAN 2163 wff%me=0; wff%master=0 2164 !Then, transmit to hdr_skip_wfftype 2165 call hdr_skip_wfftype(wff,ierr) 2166 2167 end subroutine hdr_skip_int
m_hdr/hdr_skip_wfftype [ Functions ]
[ Top ] [ m_hdr ] [ Functions ]
NAME
hdr_skip_wfftype
FUNCTION
Skip wavefunction or density file header, after having rewound the file. Two instances of the hdr_skip routines are defined : hdr_skip_int to which only the unit number is given hdr_skip_wfftype to which a wffil datatype is given
INPUTS
unit = number of unit to be read
OUTPUT
ierr = error code returned by the MPI calls
NOTES
No checking performed, since hdr_skip is assumed to be used only on temporary wavefunction files. This initialize further reading and checking by rwwf
SOURCE
2195 subroutine hdr_skip_wfftype(wff,ierr) 2196 2197 !Arguments ------------------------------------ 2198 type(wffile_type),intent(inout) :: wff 2199 integer, intent(out) :: ierr 2200 2201 !Local variables------------------------------- 2202 integer :: headform,mu,npsp,unit,usepaw,fform 2203 integer :: integers(17) 2204 character(len=8) :: codvsn 2205 character(len=500) :: msg,errmsg 2206 #if defined HAVE_MPI_IO 2207 integer(kind=MPI_OFFSET_KIND) :: delim_record,posit,positloc,off(1) 2208 integer :: iread(1),statux(MPI_STATUS_SIZE) 2209 #endif 2210 2211 !************************************************************************* 2212 2213 !@hdr_type 2214 unit=wff%unwff; ierr=0 2215 2216 if( wff%iomode==IO_MODE_FORTRAN .or. (wff%iomode==IO_MODE_FORTRAN_MASTER.and.wff%master==wff%me) ) then 2217 2218 rewind(unit, err=10, iomsg=errmsg) 2219 2220 ! Pick off headform from WF file. Support for pre-v9 (length of codvsn was changed from 6 to 8) is implemented. 2221 ABI_CHECK(read_first_record(unit, codvsn, headform, fform, errmsg) == 0, errmsg) 2222 2223 if (headform==1 .or. headform==2 .or. & 2224 headform==51 .or. headform==52 .or. & 2225 headform==101 .or. headform==102 ) headform=22 2226 2227 if (headform < 80) then 2228 write(msg,'(3a,i0,4a)')& 2229 "ABINIT version: ",trim(abinit_version)," cannot read old files with headform: ",headform,ch10,& 2230 "produced by previous versions. Use an old ABINIT version to read this file or ",ch10,& 2231 "regenerate your files with version >= 8.0." 2232 ABI_ERROR(msg) 2233 end if 2234 2235 read (unit, err=10, iomsg=errmsg) integers(1:13),npsp,integers(15:17),usepaw 2236 2237 ! Skip rest of header records 2238 do mu=1,3+npsp 2239 read (unit, err=10, iomsg=errmsg) 2240 end do 2241 2242 if (usepaw==1) then 2243 read (unit, err=10, iomsg=errmsg) 2244 read (unit, err=10, iomsg=errmsg) 2245 end if 2246 2247 #if defined HAVE_MPI_IO 2248 else if(wff%iomode==IO_MODE_MPI)then 2249 2250 headform=wff%headform 2251 if (headform==1 .or. headform==2 .or. & 2252 headform==51 .or. headform==52 .or. & 2253 headform==101 .or. headform==102) headform=22 2254 2255 if (headform < 80) then 2256 write(msg,'(3a,i0,4a)')& 2257 "ABINIT version: ",trim(abinit_version)," cannot read old files with headform: ",headform,ch10,& 2258 "produced by previous versions. Use an old ABINIT version to read this file or ",ch10,& 2259 "regenerate your files with version >= 8.0." 2260 ABI_ERROR(msg) 2261 end if 2262 2263 ! Causes all previous writes to be transferred to the storage device 2264 call flush_unit(wff%unwff) 2265 call MPI_FILE_SYNC(wff%fhwff,ierr) 2266 2267 ! Check FORTRAN record marker length (only at first call) 2268 if (wff%nbOct_recMarker<=0) then 2269 call getRecordMarkerLength_wffile(wff) 2270 end if 2271 2272 if (wff%master==wff%me) then 2273 2274 ! Reading the first record of the file ------------------------------------- 2275 ! read (unitfi) codvsn,headform,.............. 2276 posit = 0 2277 call rwRecordMarker(1,posit,delim_record,wff,ierr) 2278 2279 ! Reading the second record of the file ------------------------------------ 2280 ! read(unitfi) bantot, hdr%date, hdr%intxc................. 2281 ! Pick off npsp and usepaw from WF file 2282 positloc = posit + wff%nbOct_recMarker + wff%nbOct_int*13 2283 call MPI_FILE_READ_AT(wff%fhwff,positloc,iread,1,MPI_INTEGER,statux,ierr) 2284 npsp=iread(1) 2285 2286 ! Read usepaw and skip the fortran record 2287 positloc = positloc + wff%nbOct_int*4 2288 call MPI_FILE_READ_AT(wff%fhwff,positloc,iread,1,MPI_INTEGER,statux,ierr) 2289 usepaw=iread(1) 2290 call rwRecordMarker(1,posit,delim_record,wff,ierr) 2291 2292 ! Skip the rest of the file --------------------------------------------- 2293 do mu=1,3+npsp 2294 call rwRecordMarker(1,posit,delim_record,wff,ierr) 2295 end do 2296 2297 if (usepaw==1) then 2298 call rwRecordMarker(1,posit,delim_record,wff,ierr) 2299 call rwRecordMarker(1,posit,delim_record,wff,ierr) 2300 end if 2301 2302 wff%offwff=posit 2303 end if 2304 2305 if (wff%spaceComm/=MPI_COMM_SELF) then 2306 off(1)=wff%offwff 2307 call MPI_BCAST(off,1,wff%offset_mpi_type,wff%master,wff%spaceComm,ierr) 2308 wff%offwff=off(1) 2309 end if 2310 #endif 2311 end if 2312 2313 ! Handle IO-error: write warning and let the caller handle the exception. 2314 return 2315 10 ierr=1 2316 ABI_WARNING(errmsg) 2317 2318 end subroutine hdr_skip_wfftype
m_hdr/hdr_type [ Types ]
NAME
hdr_type
FUNCTION
It contains all the information needed to write a header for a wf, den or pot file. The structure of the header is explained in the abinit_help.html and other associated html files. The datatype is considered as an object, to which are attached a whole set of "methods", actually, different subroutines. A few of these subroutines are: hdr_init, hdr_update, hdr_free, hdr_check, hdr_io, hdr_skip.
SOURCE
85 type, public :: hdr_type 86 87 ! WARNING : if you modify this datatype, please check whether there might be creation/destruction/copy routines, 88 ! declared in another part of ABINIT, that might need to take into account your modification. 89 90 integer :: bantot ! total number of bands (sum of nband on all kpts and spins) 91 integer :: date ! starting date 92 integer :: headform ! format of the header 93 integer :: intxc ! input variable 94 integer :: ivalence=1 ! occopt=9 variable 95 integer :: ixc ! input variable 96 integer :: mband ! maxval(hdr%nband) 97 integer :: natom ! input variable 98 integer :: nkpt ! input variable 99 integer :: npsp ! input variable 100 integer :: nspden ! input variable 101 integer :: nspinor ! input variable 102 integer :: nsppol ! input variable 103 integer :: nsym ! input variable 104 integer :: ntypat ! input variable 105 integer :: occopt ! input variable 106 integer :: pertcase ! the index of the perturbation, 0 if GS calculation 107 integer :: usepaw ! input variable (0=norm-conserving psps, 1=paw) 108 integer :: usewvl ! input variable (0=plane-waves, 1=wavelets) 109 110 integer :: kptopt ! input variable (defines symmetries used for k-point sampling) 111 integer :: pawcpxocc ! input variable 112 integer :: nshiftk_orig=1 ! original number of shifts given in input (changed in inkpts, the actual value is nshiftk) 113 integer :: nshiftk=1 ! number of shifts after inkpts. 114 integer :: icoulomb ! input variable. 115 116 real(dp) :: ecut ! input variable 117 real(dp) :: ecutdg ! input variable (ecut for NC psps, pawecutdg for paw) 118 real(dp) :: ecutsm ! input variable 119 real(dp) :: ecut_eff ! ecut*dilatmx**2 (dilatmx is an input variable) 120 real(dp) :: etot ! EVOLVING variable 121 real(dp) :: fermie ! EVOLVING variable 122 real(dp) :: fermih=zero ! EVOLVING variable 123 real(dp) :: residm ! EVOLVING variable 124 real(dp) :: stmbias ! input variable 125 real(dp) :: tphysel ! input variable 126 real(dp) :: tsmear ! input variable 127 real(dp) :: nelect ! number of electrons (computed from pseudos and cellcharge) 128 real(dp) :: ne_qFD=zero ! CP number of excited electrons (input variable) 129 real(dp) :: nh_qFD=zero ! CP number of excited holes (input variable) 130 real(dp) :: cellcharge ! input variable (for the first image if more than one) 131 132 ! This record is not a part of the hdr_type, although it is present in the 133 ! header of the files. This is because it depends on the kind of file 134 ! that is written, while all other information does not depend on it. 135 ! It was preferred to let it be initialized or defined outside of hdr_type. 136 ! integer :: fform ! file format 137 138 real(dp) :: qptn(3) 139 ! the wavevector, in case of a perturbation 140 141 real(dp) :: rprimd(3,3) 142 ! EVOLVING variables 143 144 integer :: ngfft(3) 145 ! input variable 146 147 integer :: nwvlarr(2) 148 ! nwvlarr(2) array holding the number of wavelets for each resolution. 149 150 integer :: kptrlatt_orig(3,3) 151 ! Original kptrlatt 152 153 integer :: kptrlatt(3,3) 154 ! kptrlatt after inkpts. 155 156 integer, allocatable :: istwfk(:) 157 ! input variable istwfk(nkpt) 158 159 integer, allocatable :: lmn_size(:) 160 ! lmn_size(npsp) from psps 161 162 integer, allocatable :: nband(:) 163 ! input variable nband(nkpt*nsppol) 164 165 integer, allocatable :: npwarr(:) 166 ! npwarr(nkpt) array holding npw for each k point 167 168 integer, allocatable :: pspcod(:) 169 ! pscod(npsp) from psps 170 171 integer, allocatable :: pspdat(:) 172 ! psdat(npsp) from psps 173 174 integer, allocatable :: pspso(:) 175 ! pspso(npsp) from psps 176 177 integer, allocatable :: pspxc(:) 178 ! pspxc(npsp) from psps 179 180 integer, allocatable :: so_psp(:) 181 ! input variable so_psp(npsp) 182 183 integer, allocatable :: symafm(:) 184 ! input variable symafm(nsym) 185 186 integer, allocatable :: symrel(:,:,:) 187 ! input variable symrel(3,3,nsym) 188 189 integer, allocatable :: typat(:) 190 ! input variable typat(natom) 191 192 real(dp), allocatable :: kptns(:,:) 193 ! input variable kptns(3,nkpt) 194 195 real(dp), allocatable :: occ(:) 196 ! EVOLVING variable occ(bantot) 197 198 real(dp), allocatable :: tnons(:,:) 199 ! input variable tnons(3,nsym) 200 201 real(dp), allocatable :: wtk(:) 202 ! weight of kpoints wtk(nkpt) 203 204 real(dp),allocatable :: shiftk_orig(:,:) 205 ! original shifts given in input (changed in inkpts). 206 207 real(dp),allocatable :: shiftk(:,:) 208 ! shiftk(3,nshiftk), shiftks after inkpts 209 210 real(dp),allocatable :: amu(:) 211 ! amu(ntypat) ! EVOLVING variable 212 213 real(dp), allocatable :: xred(:,:) 214 ! EVOLVING variable xred(3,natom) 215 216 real(dp), allocatable :: zionpsp(:) 217 ! zionpsp(npsp) from psps 218 219 real(dp), allocatable :: znuclpsp(:) 220 ! znuclpsp(npsp) from psps 221 ! Note the difference between (znucl|znucltypat) and znuclpsp ! 222 223 real(dp), allocatable :: znucltypat(:) 224 ! znucltypat(ntypat) from alchemy 225 226 character(len=8) :: codvsn 227 ! version of the code 228 229 character(len=132), allocatable :: title(:) 230 ! title(npsp) from psps 231 232 character(len=md5_slen),allocatable :: md5_pseudos(:) 233 ! md5pseudos(npsp) 234 ! md5 checksums associated to pseudos (read from file) 235 236 ! EVOLVING variable, only for paw 237 type(pawrhoij_type), allocatable :: pawrhoij(:) 238 239 contains 240 241 procedure :: free => hdr_free 242 ! Deallocates the components of the header. 243 244 procedure :: get_nelect_from_occ => hdr_get_nelect_from_occ 245 ! Returns the number of electrons calculated from the occupation factors Hdr%occ 246 247 procedure :: ncwrite => hdr_ncwrite 248 ! Writes the header and fform to a Netcdf file. 249 250 procedure :: vs_dtset => hdr_vs_dtset 251 ! Check the compatibility of header with dtset. 252 253 procedure :: get_crystal => hdr_get_crystal 254 ! Return the crystal structure stored in the header. 255 256 procedure :: bcast => hdr_bcast 257 ! Broadcast the header. 258 259 procedure :: compare => hdr_compare 260 ! Compare two headers 261 262 procedure :: update => hdr_update 263 ! Update the header. 264 265 procedure :: write_to_fname => hdr_write_to_fname 266 ! Write the header (requires a string with the file name). 267 268 procedure :: fort_write => hdr_fort_write 269 ! Writes the header and fform to unformatted file 270 271 procedure :: backspace => hdr_backspace 272 ! Backspace the header (Fortran IO). 273 274 procedure :: echo => hdr_echo 275 ! Echo the header. 276 277 end type hdr_type
m_hdr/hdr_update [ Functions ]
[ Top ] [ m_hdr ] [ Functions ]
NAME
hdr_update
FUNCTION
This subroutine update the header structured datatype. Most of its records had been initialized correctly, but some corresponds to evolving variables, or change with the context (like fform), This routine is to be called before writing the header to a file, in order to have up-to-date information.
INPUTS
bantot=total number of bands etot=total energy (Hartree) fermie=Fermi energy (Hartree) fermih=Fermi energy for holes (Hartree), useful when occopt = 9 mpi_atmtab(:)=--optional-- indexes of the atoms treated by current proc comm_atom=--optional-- MPI communicator over atoms residm=maximal residual rprimd(3,3)=dimensional primitive translations for real space (bohr) occ(bantot)=occupancies for each band and k point pawrhoij(natom*usepaw) <type(pawrhoij_type)>= -PAW only- atomic occupancies xred(3,natom)= relative coords of atoms in unit cell (dimensionless) amu(ntypat)=masses in atomic mass units for each kind of atom in cell.
OUTPUT
hdr <type(hdr_type)>=the header, initialized, and for most part of it, contain its definite values, except for evolving variables
SOURCE
2353 subroutine hdr_update(hdr,bantot,etot,fermie,fermih,residm,rprimd,occ,pawrhoij,xred,amu, & 2354 comm_atom,mpi_atmtab) ! optional arguments (parallelism) 2355 2356 !Arguments ------------------------------------ 2357 !scalars 2358 integer,intent(in) :: bantot 2359 integer,optional,intent(in) :: comm_atom 2360 real(dp),intent(in) :: etot,fermie,fermih,residm 2361 class(hdr_type),intent(inout) :: hdr 2362 !arrays 2363 integer,optional,target,intent(in) :: mpi_atmtab(:) 2364 real(dp),intent(in) :: occ(bantot),rprimd(3,3),xred(3,hdr%natom),amu(hdr%ntypat) 2365 type(pawrhoij_type),intent(inout) :: pawrhoij(:) 2366 2367 ! ************************************************************************* 2368 2369 !@hdr_type 2370 !Update of the "evolving" data 2371 hdr%etot =etot 2372 hdr%fermie =fermie 2373 hdr%fermih =fermih 2374 hdr%residm =residm 2375 hdr%rprimd(:,:)=rprimd(:,:) 2376 hdr%occ(:) =occ(:) 2377 hdr%xred(:,:)=xred(:,:) 2378 hdr%amu(:) = amu 2379 2380 if (hdr%usepaw==1) then 2381 if (present(comm_atom)) then 2382 if (present(mpi_atmtab)) then 2383 call pawrhoij_copy(pawrhoij,hdr%pawrhoij,comm_atom=comm_atom,mpi_atmtab=mpi_atmtab) 2384 else 2385 call pawrhoij_copy(pawrhoij,hdr%pawrhoij,comm_atom=comm_atom) 2386 end if 2387 else 2388 call pawrhoij_copy(pawrhoij,hdr%pawrhoij) 2389 end if 2390 end if 2391 2392 end subroutine hdr_update
m_hdr/hdr_vs_dtset [ Functions ]
[ Top ] [ m_hdr ] [ Functions ]
NAME
hdr_vs_dtset
FUNCTION
Check the compatibility of the Abinit header with respect to the input variables defined in the input file.
INPUTS
Dtset<type(dataset_type)>=all input variables for this dataset Hdr <type(hdr_type)>=the header structured variable
OUTPUT
Only check
SOURCE
4698 subroutine hdr_vs_dtset(Hdr,Dtset) 4699 4700 !Arguments ------------------------------------ 4701 class(Hdr_type),intent(in) :: Hdr 4702 type(Dataset_type),intent(in) :: Dtset 4703 4704 !Local variables------------------------------- 4705 integer :: ik, jj, ierr 4706 logical :: test, tsymrel,ttnons, tsymafm 4707 character(len=5000) :: msg 4708 ! ************************************************************************* 4709 4710 ! Check basic dimensions 4711 ierr = 0 4712 call compare_int('natom', Hdr%natom, Dtset%natom, ierr) 4713 call compare_int('nkpt', Hdr%nkpt, Dtset%nkpt, ierr) 4714 call compare_int('npsp', Hdr%npsp, Dtset%npsp, ierr) 4715 call compare_int('nspden', Hdr%nspden, Dtset%nspden, ierr) 4716 call compare_int('nspinor',Hdr%nspinor,Dtset%nspinor,ierr) 4717 call compare_int('nsppol', Hdr%nsppol, Dtset%nsppol, ierr) 4718 call compare_int('nsym', Hdr%nsym, Dtset%nsym, ierr) 4719 call compare_int('ntypat', Hdr%ntypat, Dtset%ntypat, ierr) 4720 call compare_int('usepaw', Hdr%usepaw, Dtset%usepaw, ierr) 4721 call compare_int('usewvl', Hdr%usewvl, Dtset%usewvl, ierr) 4722 call compare_int('kptopt', Hdr%kptopt, Dtset%kptopt, ierr) 4723 call compare_int('pawcpxocc', Hdr%pawcpxocc, Dtset%pawcpxocc, ierr) 4724 call compare_int('nshiftk_orig', Hdr%nshiftk_orig, Dtset%nshiftk_orig, ierr) 4725 call compare_int('nshiftk', Hdr%nshiftk, Dtset%nshiftk, ierr) 4726 4727 ! The number of fatal errors must be zero. 4728 if (ierr/=0) then 4729 write(msg,'(3a)')& 4730 'Cannot continue, basic dimensions reported in the header do not agree with input file. ',ch10,& 4731 'Check consistency between the content of the external file and the input file.' 4732 ABI_ERROR(msg) 4733 end if 4734 4735 test=ALL(ABS(Hdr%xred-Dtset%xred_orig(:,1:Dtset%natom,1)) < tol3) 4736 ABI_CHECK(test,'Mismatch in xred') 4737 4738 test=ALL(Hdr%typat==Dtset%typat(1:Dtset%natom)) 4739 ABI_CHECK(test,'Mismatch in typat') 4740 4741 ! Check if the lattice from the input file agrees with that read from the KSS file 4742 if ( (ANY(ABS(Hdr%rprimd - Dtset%rprimd_orig(1:3,1:3,1)) > tol6)) ) then 4743 write(msg,'(5a,3(3es16.6),3a,3(3es16.6),3a)')ch10,& 4744 ' real lattice vectors read from Header differ from the values specified in the input file', ch10, & 4745 ' rprimd from Hdr file = ',ch10,(Hdr%rprimd(:,jj),jj=1,3),ch10,& 4746 ' rprimd from input file = ',ch10,(Dtset%rprimd_orig(:,jj,1),jj=1,3),ch10,ch10,& 4747 ' Modify the lattice vectors in the input file ' 4748 ABI_ERROR(msg) 4749 end if 4750 4751 ! Check symmetry operations. 4752 tsymrel=(ALL(Hdr%symrel==Dtset%symrel(:,:,1:Dtset%nsym))) 4753 if (.not.tsymrel) then 4754 write(msg,'(3a)')& 4755 ' real space symmetries read from Header ',ch10,& 4756 ' differ from the values inferred from the input file' 4757 ABI_WARNING(msg) 4758 tsymrel=.FALSE. 4759 end if 4760 4761 ttnons=ALL(ABS(Hdr%tnons-Dtset%tnons(:,1:Dtset%nsym))<tol6) 4762 if (.not.ttnons) then 4763 write(msg,'(3a)')& 4764 ' fractional translations read from Header ',ch10,& 4765 ' differ from the values inferred from the input file' 4766 ABI_WARNING(msg) 4767 ttnons=.FALSE. 4768 end if 4769 4770 tsymafm=ALL(Hdr%symafm==Dtset%symafm(1:Dtset%nsym)) 4771 if (.not.tsymafm) then 4772 write(msg,'(3a)')& 4773 ' AFM symmetries read from Header ',ch10,& 4774 ' differ from the values inferred from the input file' 4775 ABI_WARNING(msg) 4776 tsymafm=.FALSE. 4777 end if 4778 4779 if (.not.(tsymrel.and.ttnons.and.tsymafm)) then 4780 write(msg,'(a)')' Header ' 4781 call wrtout(std_out,msg) 4782 call print_symmetries(Hdr%nsym,Hdr%symrel,Hdr%tnons,Hdr%symafm) 4783 write(msg,'(a)')' Dtset ' 4784 call wrtout(std_out,msg) 4785 call print_symmetries(Dtset%nsym,Dtset%symrel,Dtset%tnons,Dtset%symafm) 4786 ABI_ERROR('Check symmetry operations') 4787 end if 4788 4789 if (abs(Dtset%nelect-hdr%nelect)>tol6) then 4790 write(msg,'(2(a,f8.2))')"File contains ", hdr%nelect," electrons but nelect initialized from input is ",Dtset%nelect 4791 ABI_ERROR(msg) 4792 end if 4793 4794 if (abs(Dtset%ne_qFD-hdr%ne_qFD)>tol6) then 4795 write(msg,'(2(a,f8.2))')"File contains ", hdr%ne_qFD, & 4796 " electrons in the conduction bands but nelect initialized from input is ",Dtset%ne_qFD 4797 ABI_ERROR(msg) 4798 end if 4799 4800 if (abs(Dtset%nh_qFD-hdr%nh_qFD)>tol6) then 4801 write(msg,'(2(a,f8.2))')"File contains ", hdr%nh_qFD,& 4802 " electrons in the valence bands but nelect initialized from input is ",Dtset%nh_qFD 4803 ABI_ERROR(msg) 4804 end if 4805 4806 if (abs(Dtset%cellcharge(1)-hdr%cellcharge)>tol6) then 4807 write(msg,'(2(a,f8.2))')"File contains cellcharge ", hdr%cellcharge," but cellcharge from input is ",Dtset%cellcharge 4808 ABI_ERROR(msg) 4809 end if 4810 4811 if (any(hdr%kptrlatt_orig /= dtset%kptrlatt_orig)) then 4812 write(msg,"(5a)")& 4813 "hdr%kptrlatt_orig: ",trim(ltoa(reshape(hdr%kptrlatt_orig,[9]))),ch10,& 4814 "dtset%kptrlatt_orig: ",trim(ltoa(reshape(dtset%kptrlatt_orig, [9]))) 4815 ABI_ERROR(msg) 4816 end if 4817 4818 if (any(hdr%kptrlatt /= dtset%kptrlatt)) then 4819 write(msg,"(5a)") & 4820 "hdr%kptrlatt: ",trim(ltoa(reshape(hdr%kptrlatt, [9]))),ch10,& 4821 "dtset%kptrlatt: ",trim(ltoa(reshape(dtset%kptrlatt, [9]))) 4822 ABI_ERROR(msg) 4823 end if 4824 4825 if (any(abs(hdr%shiftk_orig - dtset%shiftk_orig(:,1:dtset%nshiftk_orig)) > tol6)) then 4826 write(msg,"(5a)")& 4827 "hdr%shiftk_orig: ",trim(ltoa(reshape(hdr%shiftk_orig, [3*hdr%nshiftk_orig]))),ch10,& 4828 "dtset%shiftk_orig: ",trim(ltoa(reshape(dtset%shiftk_orig, [3*dtset%nshiftk_orig]))) 4829 ABI_ERROR(msg) 4830 end if 4831 4832 if (any(abs(hdr%shiftk - dtset%shiftk(:,1:dtset%nshiftk)) > tol6)) then 4833 write(msg,"(5a)")& 4834 "hdr%shiftk: ",trim(ltoa(reshape(hdr%shiftk, [3*hdr%nshiftk]))),ch10,& 4835 "dtset%shiftk: ",trim(ltoa(reshape(dtset%shiftk, [3*dtset%nshiftk]))) 4836 ABI_ERROR(msg) 4837 end if 4838 4839 ! Check if the k-points from the input file agrees with that read from the WFK file 4840 ! 4841 ! Note that the EPH code frees several dtset arrays that depend on nkpt (see dtset_free_nkpt_arrays) 4842 ! in order to reduce memory when large meshes are used (e.g. 200x200x200) 4843 ! so we have to test whether the dtset array is allocated before testing. 4844 ! 4845 if (allocated (dtset%kpt)) then 4846 if ((any(abs(Hdr%kptns(:,:) - Dtset%kpt(:,1:Dtset%nkpt)) > tol6))) then 4847 write(msg,'(9a)')ch10,& 4848 ' hdr_vs_dtset: ERROR - ',ch10,& 4849 ' k-points read from Header ',ch10,& 4850 ' differ from the values specified in the input file',ch10,& 4851 ' k-points from Hdr file | k-points from input file ',ch10 4852 call wrtout(std_out,msg) 4853 do ik=1,Dtset%nkpt 4854 if (any(abs(Hdr%kptns(:,ik) - Dtset%kpt(:,ik)) > tol6)) then 4855 write(msg,'(3(3es16.6,3x))')Hdr%kptns(:,ik),Dtset%kpt(:,ik) 4856 call wrtout(std_out,msg) 4857 end if 4858 end do 4859 ABI_ERROR('Modify the k-mesh in the input file') 4860 end if 4861 end if 4862 4863 if (allocated(dtset%wtk)) then 4864 if (ANY(ABS(Hdr%wtk(:) - Dtset%wtk(1:Dtset%nkpt)) > tol6)) then 4865 write(msg,'(9a)')ch10,& 4866 ' hdr_vs_dtset : ERROR - ',ch10,& 4867 ' k-point weights read from Header ',ch10,& 4868 ' differ from the values specified in the input file',ch10,& 4869 ' Hdr file | File ',ch10 4870 call wrtout(std_out,msg) 4871 do ik=1,Dtset%nkpt 4872 if (abs(Hdr%wtk(ik) - Dtset%wtk(ik)) > tol6) then 4873 write(msg,'(2(f11.5,1x))')Hdr%wtk(ik),Dtset%wtk(ik) 4874 call wrtout(std_out,msg) 4875 end if 4876 end do 4877 ABI_ERROR('Check the k-mesh and the symmetries of the system. ') 4878 end if 4879 end if 4880 4881 ! Check istwfk storage 4882 if (allocated(dtset%istwfk)) then 4883 if ((any(Hdr%istwfk(:) /= Dtset%istwfk(1:Dtset%nkpt))) ) then 4884 ABI_COMMENT('istwfk from header differs from the values specified in the input file (not critical)') 4885 !call wrtout(std_out, " Hdr | input ") 4886 !do ik=1,Dtset%nkpt 4887 ! write(msg,'(i5,3x,i5)')Hdr%istwfk(ik),Dtset%istwfk(ik) 4888 ! call wrtout(std_out,msg) 4889 !end do 4890 !ABI_ERROR('Modify istwfk in the input file.') 4891 end if 4892 end if 4893 4894 CONTAINS
m_hdr/hdr_write_to_fname [ Functions ]
[ Top ] [ m_hdr ] [ Functions ]
NAME
hdr_write_to_fname
FUNCTION
Write the header and fform to file fname. Use Fortran IO or Netcdf depending on the extension of the file
INPUTS
fname=String with the name of the file. fform=Kind of the array in the file Hdr<hdr_type>=The abinit header.
OUTPUT
Only writing.
SOURCE
1525 subroutine hdr_write_to_fname(Hdr,fname,fform) 1526 1527 !Arguments ------------------------------------ 1528 integer,intent(in) :: fform 1529 character(len=*),intent(in) :: fname 1530 class(hdr_type),intent(inout) :: Hdr 1531 1532 !Local variables------------------------------- 1533 integer :: fh,ierr 1534 character(len=500) :: msg 1535 1536 ! ************************************************************************* 1537 1538 if (.not.isncfile(fname)) then 1539 ! Use Fortran IO to write the header. 1540 if (open_file(fname,msg,newunit=fh,form="unformatted", status="unknown") /= 0) then 1541 ABI_ERROR(msg) 1542 end if 1543 call hdr%fort_write(fh, fform, ierr) 1544 ABI_CHECK(ierr==0, sjoin("Error while writing Abinit header to file:", fname)) 1545 close(fh) 1546 1547 else 1548 ! Use Netcdf to open the file and write the header. 1549 if (file_exists(fname)) then 1550 NCF_CHECK(nctk_open_modify(fh,fname, xmpi_comm_self)) 1551 else 1552 NCF_CHECK_MSG(nctk_open_create(fh, fname, xmpi_comm_self), sjoin("Creating file:", fname)) 1553 end if 1554 1555 NCF_CHECK(hdr%ncwrite(fh, fform, nc_define=.True.)) 1556 NCF_CHECK(nf90_close(fh)) 1557 end if 1558 1559 end subroutine hdr_write_to_fname
m_hdr/read_first_record [ Functions ]
[ Top ] [ m_hdr ] [ Functions ]
NAME
read_first_record
FUNCTION
Read the first record of the header. This function is neede to support for pre-Abinitv9 headers: length of codvsn was changed from 6 to 8 in v9
SOURCE
2747 integer function read_first_record(unit, codvsn8, headform, fform, errmsg) result(ierr) 2748 2749 !Arguments ------------------------------------ 2750 integer,intent(in) :: unit 2751 integer,intent(out) :: headform, fform 2752 character(len=8),intent(out) :: codvsn8 2753 character(len=*),intent(out) :: errmsg 2754 2755 !Local variables------------------------------- 2756 integer :: major, ii 2757 character(len=6) :: codvsn6 2758 2759 !************************************************************************* 2760 2761 ! Try pre-v9 first. This read should not fail as we have enough space in the record 2762 ! Obviously headform and fform are wrong in > Abinit9. 2763 read(unit, iostat=ierr, iomsg=errmsg) codvsn6, headform, fform 2764 if (ierr /= 0) then 2765 call wrtout(std_out, "Fatal error while reading the first record of the Abinit header!") 2766 return 2767 end if 2768 2769 ii = index(codvsn6, ".") 2770 if (ii == 0 .or. ii == 1) then 2771 errmsg = sjoin("Cannot find major.minor pattern in codvsn:", codvsn6) 2772 ierr = 1; return 2773 end if 2774 2775 major = atoi(codvsn6(:ii-1)) 2776 !call wrtout(std_out, sjoin("Reading HDR file generated by major version:", itoa(major))) 2777 if (major > 8) then 2778 backspace(unit) 2779 read(unit, iostat=ierr, iomsg=errmsg) codvsn8, headform, fform 2780 if (ierr /= 0) then 2781 call wrtout(std_out, "Fatal error while reading the first record of the Abinit header version > 8!") 2782 return 2783 end if 2784 else 2785 codvsn8 = "" 2786 codvsn8(1:6) = codvsn6 2787 end if 2788 2789 end function read_first_record
m_hdr/test_abifiles [ Functions ]
[ Top ] [ m_hdr ] [ Functions ]
NAME
test_abifiles
FUNCTION
Check the consistency of the internal abifiles table.
SOURCE
779 subroutine test_abifiles() 780 781 !Arguments --------------------------------------------- 782 783 !Local variables------------------------------- 784 !scalars 785 integer :: ii,nn,ierr 786 integer :: all_fforms(size(all_abifiles)),iperm(size(all_abifiles)) 787 ! ************************************************************************* 788 789 nn = size(all_abifiles) 790 791 do ii=1,nn 792 all_fforms(ii) = all_abifiles(ii)%fform 793 end do 794 iperm = [(ii, ii=1,nn)] 795 call sort_int(nn, all_fforms, iperm) 796 797 ierr = 0 798 do ii=1,nn-1 799 if (all_fforms(ii) == all_fforms(ii+1)) then 800 ABI_WARNING(sjoin("fform: ", itoa(all_fforms(ii+1)), "is already in the abifiles list")) 801 ierr = ierr + 1 802 end if 803 end do 804 805 if (ierr /= 0) then 806 ABI_ERROR("test_abifiles gave ierr != 0. Aborting now") 807 end if 808 809 end subroutine test_abifiles
m_hdr/varname_from_fname [ Functions ]
[ Top ] [ m_hdr ] [ Functions ]
NAME
varname_from_fname
FUNCTION
Return the name of the netcdf variable stored in a file from the file extension.
NOTES
The variable names should be consistent with the ones used in outscf.F90
SOURCE
544 character(len=nctk_slen) function varname_from_fname(filename) result(varname) 545 546 !Arguments --------------------------------------------- 547 character(len=*),intent(in) :: filename 548 549 !Local variables------------------------------- 550 !scalars 551 integer :: ind,pertcase,ierr 552 logical :: found 553 character(len=len(filename)) :: ext 554 555 ! ********************************************************************* 556 557 ! TODO: This should be a recursive function because we have 558 ! to scan the string from left to right (extensions could have the same termination) 559 560 ! Find the Abinit file extension. Examples: t43_VHXC.nc 561 if (endswith(filename, ".nc")) then 562 ind = index(filename, ".nc", back=.True.) 563 else 564 !ABI_ERROR(sjoin("Don't know how to handle: ", filename)) 565 ind = len_trim(filename) + 1 566 end if 567 568 ext = filename(:ind-1) 569 ind = index(ext, "_", back=.True.) 570 ABI_CHECK(ind /= 0, "Cannot find `_` in file name!") 571 ABI_CHECK(ind /= len_trim(ext), sjoin("Wrong string: ", ext)) 572 ext = ext(ind+1:) 573 574 found = .True. 575 select case (ext) 576 case ("DEN") 577 varname = "density" 578 !case ("DEN1") 579 ! varname = "first_order_density" 580 case ("POSITRON") 581 varname = "positron_density" 582 case ("PAWDEN") 583 varname = "pawrhor" 584 ! TODO: Other paw densities 585 case ("ELF") 586 varname = "elfr" 587 case ("ELF_UP") 588 varname = "elfr_up" 589 case ("ELF_DOWN") 590 varname = "elfr_down" 591 case ("GDEN1") 592 varname = "grhor_1" 593 case ("GDEN2") 594 varname = "grhor_2" 595 case ("GDEN3") 596 varname = "grhor_3" 597 case ("KDEN") 598 varname = "kinedr" 599 case ("LDEN") 600 varname = "laprhor" 601 case ("POT") 602 varname = "vtrial" 603 case ("STM") 604 varname = "stm" 605 case ("VHA") 606 varname = "vhartree" 607 case ("VPSP") 608 varname = "vpsp" 609 case ("VHXC") 610 varname = "vhxc" 611 case ("VXC") 612 varname = "exchange_correlation_potential" 613 case ("VCLMB") 614 varname = "vhartree_vloc" 615 case default 616 found = .False. 617 end select 618 619 if (found) return 620 621 ! Handle DEN[pertcase] 622 if (startswith(ext, "DEN")) then 623 read(ext(4:), *, iostat=ierr) pertcase 624 if (ierr == 0) then 625 varname = "first_order_density"; return 626 end if 627 end if 628 629 ! Handle POT[pertcase] 630 if (startswith(ext, "POT")) then 631 read(ext(4:), *, iostat=ierr) pertcase 632 if (ierr == 0) then 633 varname = "first_order_potential"; return 634 end if 635 end if 636 637 ! Handle VXC[pertcase] 638 if (startswith(ext, "VXC")) then 639 read(ext(4:), *, iostat=ierr) pertcase 640 if (ierr == 0) then 641 varname = "first_order_vxc"; return 642 end if 643 end if 644 645 ! Handle VHA[pertcase] 646 if (startswith(ext, "VHA")) then 647 read(ext(4:), *, iostat=ierr) pertcase 648 if (ierr == 0) then 649 varname = "first_order_vhartree"; return 650 end if 651 end if 652 653 ! Handle VPSP[pertcase] 654 if (startswith(ext, "VPSP")) then 655 read(ext(4:), *, iostat=ierr) pertcase 656 if (ierr == 0) then 657 varname = "first_order_vpsp"; return 658 end if 659 end if 660 661 ABI_ERROR(sjoin("Unknown abinit extension:", ext)) 662 663 end function varname_from_fname
m_wfk/hdr_compare [ Functions ]
[ Top ] [ m_wfk ] [ Functions ]
NAME
hdr_compare
FUNCTION
Test two hdr_t objects for consistency. Return non-zero value if test fails.
INPUTS
hdr1, hdr2 <class(hdr_t)> = hdr handlers to be compared
OUTPUT
ierr
SOURCE
4614 integer function hdr_compare(hdr1, hdr2) result(ierr) 4615 4616 !Arguments ------------------------------------ 4617 !scalars 4618 class(hdr_type),intent(in) :: hdr1, hdr2 4619 4620 !Local variables------------------------------- 4621 !scalars 4622 character(len=500) :: msg 4623 4624 !************************************************************************ 4625 4626 ierr = 0 4627 4628 ! Test basic dimensions 4629 if (hdr1%nsppol /= hdr2%nsppol) then 4630 write(msg,'(a,i0,a,i0)')'Different nsppol : ',hdr1%nsppol,' and ',hdr2%nsppol 4631 ierr = ierr + 1; ABI_WARNING(msg) 4632 end if 4633 if (hdr1%nspinor /= hdr2%nspinor) then 4634 write(msg,'(a,i0,a,i0)')'Different nspinor : ',hdr1%nspinor,' and ',hdr2%nspinor 4635 ierr = ierr + 1; ABI_WARNING(msg) 4636 end if 4637 if (hdr1%nspden /= hdr2%nspden) then 4638 write(msg,'(a,i0,a,i0)')'Different nspden : ',hdr1%nspden,' and ',hdr2%nspden 4639 ierr = ierr + 1; ABI_WARNING(msg) 4640 end if 4641 if (hdr1%nkpt /= hdr2%nkpt) then 4642 write(msg,'(a,i0,a,i0)')'Different nkpt : ',hdr1%nkpt,' and ',hdr2%nkpt 4643 ierr = ierr + 1; ABI_WARNING(msg) 4644 end if 4645 if (hdr1%usepaw /= hdr2%usepaw) then 4646 write(msg,'(a,i0,a,i0)')'Different usepaw : ',hdr1%usepaw,' and ',hdr2%usepaw 4647 ierr = ierr + 1; ABI_WARNING(msg) 4648 end if 4649 if (hdr1%ntypat /= hdr2%ntypat) then 4650 write(msg,'(a,i0,a,i0)')'Different ntypat : ',hdr1%ntypat,' and ',hdr2%ntypat 4651 ierr = ierr + 1; ABI_WARNING(msg) 4652 end if 4653 if (hdr1%natom /= hdr2%natom) then 4654 write(msg,'(a,i0,a,i0)')'Different natom : ',hdr1%natom,' and ',hdr2%natom 4655 ierr = ierr + 1; ABI_WARNING(msg) 4656 end if 4657 4658 ! Return immediately if important dimensions are not equal. 4659 if (ierr /= 0) return 4660 4661 ! Test important arrays (rprimd is not tested) 4662 if (any(hdr1%typat /= hdr2%typat)) then 4663 write(msg,'(a,i0,a,i0)')'Different ntypat array : ',hdr1%typat(1),' ... and ',hdr2%typat(1) 4664 ierr = ierr + 1; ABI_WARNING(msg) 4665 end if 4666 !Should test npwarr, however taking into account differences due to istwfk ! 4667 !if (any(hdr1%npwarr /= hdr2%npwarr)) then 4668 ! write(msg,'(a,i0,a,i0)')'Different npwarr array : ',hdr1%npwarr(1),' ... and ',hdr2%npwarr(1) 4669 ! ierr = ierr + 1; ABI_WARNING(msg) 4670 !end if 4671 if (any(abs(hdr1%kptns - hdr2%kptns) > tol6)) then 4672 write(msg,'(a,i0,a,i0)')'Different kptns array ' 4673 ierr = ierr + 1; ABI_WARNING(msg) 4674 end if 4675 4676 end function hdr_compare