TABLE OF CONTENTS


ABINIT/m_hdr [ Modules ]

[ Top ] [ Modules ]

NAME

 m_hdr

FUNCTION

 This module contains the definition of the abinit header (TODO) 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-2018 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.

PARENTS

CHILDREN

SOURCE

 26 #if defined HAVE_CONFIG_H
 27 #include "config.h"
 28 #endif
 29 
 30 #include "abi_common.h"
 31 
 32 !#define DEBUG_MODE
 33 
 34 ! This option enable the output of the new hdr entries in hdr%echo
 35 ! Reference files should be updated
 36 !#define DEV_NEW_HDR
 37 
 38 MODULE m_hdr
 39 
 40  use defs_basis
 41  use m_build_info
 42  use m_xmpi
 43  use m_abicore
 44  use m_errors
 45  use m_wffile
 46  use m_sort
 47 #ifdef HAVE_MPI2
 48  use mpi
 49 #endif
 50 #ifdef HAVE_NETCDF
 51  use netcdf
 52 #endif
 53  use m_nctk
 54 
 55  use m_copy,          only : alloc_copy
 56  use m_io_tools,      only : flush_unit, isncfile, file_exists, open_file
 57  use m_fstrings,      only : sjoin, itoa, ftoa, ltoa, replace_ch0, startswith, endswith, ljust
 58  use m_symtk,         only : print_symmetries
 59  use defs_wvltypes,   only : wvl_internal_type
 60  use defs_datatypes,  only : ebands_t, pseudopotential_type
 61  use defs_abitypes,   only : hdr_type, dataset_type
 62  use m_pawtab,        only : pawtab_type
 63  use m_pawrhoij,      only : pawrhoij_type, pawrhoij_alloc, pawrhoij_copy, pawrhoij_free, pawrhoij_io, pawrhoij_get_nspden
 64 
 65  implicit none
 66 
 67  private
 68 
 69 #if defined HAVE_MPI1
 70  include 'mpif.h'
 71 #endif
 72 
 73  public :: abifile_from_varname
 74  public :: abifile_from_fform
 75  public :: fform_from_ext          ! Return the value of fform to be used from the file extension.
 76  public :: varname_from_fname      ! Return the name of the netcdf variable stored in a file from the file extension.
 77 
 78  public :: hdr_init                ! Initialize the header and most of its content from dtset and psps.
 79  public :: hdr_init_lowlvl         ! Low level initialization method for Hdr (no dtset).
 80  public :: hdr_free                ! Deallocates the components of the header.
 81  public :: hdr_copy                ! Deep copy of the Header.
 82  public :: hdr_nelect_fromocc      ! Returns the number of electrons calculated from the occupation factors Hdr%occ
 83  public :: hdr_mpio_skip           ! Skip the abinit header using MPI-IO routines.
 84                                    ! Return the offset of the first Fortran record after the header.
 85  public :: hdr_bsize_frecords      ! Compute the size of the Fortran records from the header and formeig.
 86  public :: hdr_bcast               ! Broadcast the header.
 87  public :: hdr_update              ! Update the header.
 88  public :: hdr_read_from_fname     ! Read the header (requires a string with the file name).
 89  public :: hdr_write_to_fname      ! Write the header (requires a string with the file name).
 90  public :: hdr_skip                ! Skip the header.
 91  public :: hdr_io                  ! IO of the header.
 92  public :: hdr_echo                ! Echo the header.
 93  public :: hdr_fort_read           ! Reads the header from a logical unit associated to an unformatted file.
 94  public :: hdr_ncread              ! Reads the header from a Netcdf file.
 95  public :: hdr_fort_write          ! Writes the header and fform to unformatted file
 96  public :: hdr_ncwrite             ! Writes the header and fform to a Netcdf file.
 97  public :: hdr_check               ! Compare two headers.
 98  public :: hdr_vs_dtset            ! Check the compatibility of header with dtset.
 99 
100 ! Generic interface of the routines hdr_skip
101  interface hdr_skip
102    module procedure hdr_skip_int
103    module procedure hdr_skip_wfftype
104  end interface hdr_skip
105 
106 ! Generic interface of the routines hdr_io
107  interface hdr_io
108    module procedure hdr_io_int
109    module procedure hdr_io_wfftype
110  end interface hdr_io
111 
112  integer,private,parameter :: HDR_KNOWN_HEADFORMS(1) = [80]
113  ! The list of headforms used so far.
114 
115  integer,public,parameter :: HDR_LATEST_HEADFORM = HDR_KNOWN_HEADFORMS(size(HDR_KNOWN_HEADFORMS))
116  ! The latest headform to be used for writing.

hdr_check/mk_hdr_check_fmt [ Functions ]

[ Top ] [ hdr_check ] [ Functions ]

NAME

 mk_hdr_check_fmt

FUNCTION

 make a format needed in hdr_check, for arrays of nint integers each of format i3

INPUTS

  nelm=number of elements to be printed

OUTPUT

  character(len=26), typfmt= format needed

PARENTS

      m_hdr

CHILDREN

SOURCE

4682 subroutine mk_hdr_check_fmt(nelm,typfmt)
4683 
4684 
4685 !This section has been created automatically by the script Abilint (TD).
4686 !Do not modify the following lines by hand.
4687 #undef ABI_FUNC
4688 #define ABI_FUNC 'mk_hdr_check_fmt'
4689 !End of the abilint section
4690 
4691    implicit none
4692 
4693 !  Arguments ------------------------------------
4694 !  scalars
4695    integer,intent(in) :: nelm
4696    character(len=26),intent(out) :: typfmt
4697 
4698 !  Local variables-------------------------------
4699 !  scalars
4700    integer :: ii
4701    character(len=1), parameter :: number(0:10)=(/'0','1','2','3','4','5','6','7','8','9',' '/)
4702    character(len=26), parameter :: templatefmt='(2x,  i3,t41   ,a,2x,  i3)'
4703 !  *************************************************************************
4704 
4705 !  Initialize the format
4706    typfmt=templatefmt
4707 
4708 !  Generate the type format specifier
4709    ii=nelm/10
4710    if ( ii /= 0 ) then
4711      typfmt(5:5) = number(ii)
4712      typfmt(22:22) = number(ii)
4713    else
4714      typfmt(5:5) = ' '
4715      typfmt(22:22) = ' '
4716    end if
4717    ii = nelm - 10 * (nelm/10)
4718    typfmt(6:6) = number(ii)
4719    typfmt(23:23) = number(ii)
4720 
4721  end subroutine mk_hdr_check_fmt
4722 
4723 end subroutine hdr_check

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

  name=Name of the variable
  iexp= expected value.
  ifound=the actuval value

SIDE EFFECTS

  ierr=increased by one if values differ

PARENTS

      hdr_vs_dtset

CHILDREN

      wrtout

SOURCE

4967  subroutine compare_int(name,iexp,ifound,ierr)
4968 
4969 
4970 !This section has been created automatically by the script Abilint (TD).
4971 !Do not modify the following lines by hand.
4972 #undef ABI_FUNC
4973 #define ABI_FUNC 'compare_int'
4974 !End of the abilint section
4975 
4976  implicit none
4977 
4978 !Arguments ------------------------------------
4979  integer,intent(in) :: iexp,ifound
4980  integer,intent(inout) :: ierr
4981  character(len=*),intent(in) :: name
4982 
4983 !Local variables-------------------------------
4984  logical :: leq
4985  character(len=500) :: msg
4986 ! *************************************************************************
4987 
4988    leq=(iexp==ifound)
4989 
4990    if (.not.leq) then
4991      write(msg,'(4a,i6,a,i6)')ch10,&
4992      ' hdr_vs_dtset : WARNING - Mismatch in '//TRIM(name),ch10,&
4993      '  Expected = ',iexp,' Found = ',ifound
4994      call wrtout(std_out,msg,'COLL')
4995 !      Increase ierr to signal we should stop in the caller.
4996      ierr=ierr+1
4997    end if
4998 
4999  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.

PARENTS

CHILDREN

SOURCE

541 type(abifile_t) function abifile_from_fform(fform) result(afile)
542 
543 
544 !This section has been created automatically by the script Abilint (TD).
545 !Do not modify the following lines by hand.
546 #undef ABI_FUNC
547 #define ABI_FUNC 'abifile_from_fform'
548 !End of the abilint section
549 
550  implicit none
551 
552 !Arguments ---------------------------------------------
553  integer,intent(in) :: fform
554 
555 !Local variables-------------------------------
556 !scalars
557  integer :: ii
558 ! *************************************************************************
559 
560  afile = abifile_none
561  do ii=1,size(all_abifiles)
562    if (all_abifiles(ii)%fform == fform) afile = all_abifiles(ii)
563  end do
564 
565 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.

PARENTS

CHILDREN

SOURCE

496 type(abifile_t) function abifile_from_varname(varname) result(afile)
497 
498 
499 !This section has been created automatically by the script Abilint (TD).
500 !Do not modify the following lines by hand.
501 #undef ABI_FUNC
502 #define ABI_FUNC 'abifile_from_varname'
503 !End of the abilint section
504 
505  implicit none
506 
507 !Arguments ---------------------------------------------
508  character(len=*),intent(in) :: varname
509 
510 !Local variables-------------------------------
511 !scalars
512  integer :: ii
513 ! *************************************************************************
514 
515  afile = abifile_none
516  do ii=1,size(all_abifiles)
517    if (all_abifiles(ii)%varname == varname) afile = all_abifiles(ii)
518  end do
519 
520 end function abifile_from_varname

m_hdr/abifile_t [ Types ]

[ Top ] [ m_hdr ] [ 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

129  type,public :: abifile_t
130 
131    character(len=nctk_slen) :: varname
132    ! Name of the netcdf variable associated to the file.
133    ! This string is used in fftdatar_write to find the value of fform to be written to file
134 
135    integer :: fform
136    ! The value of fform associated to this file
137 
138    character(len=24) :: ext
139    ! Abinit File extension (`.nc` is not included)
140 
141    character(len=24) :: class
142    ! Each file belongs to a class e.g. wf_planewave, den, pot, data...
143 
144    logical :: has_pawrhoij=.True.
145    ! True if this file contains pawrhoij when hdr%usepaw == 1.
146 
147  end type abifile_t
148 
149  ! Notes about abifiles:
150  !
151  ! *) fform are positive integers >0 and they must be unique inside the list.
152  !    One might have used strings xxx.yyy.zzz instead of integers but there's a lot of code
153  !    around that relies on integral fforms so we have to live with it.
154  !
155  ! *) class is used in postprocessing tools e.g. cut3d when we need to know if we are dealing
156  !    with wavefunctions or density-like or potential-like data.
157  !    Possible values are: "wf_planewave" for wavefunction files, "density" for density-like,
158  !    "potential" for potential files, "data" for generic data a.k.a. internal files e.g. GKK matrix elements.
159  !
160  ! *) varname can appear multiple times, in this case the entries should be ordered chronologically
161  !    i.e. the most recent format should follow the older ones. This could be useful if we decide to
162  !    remove pawrhoij from a particular file. Let's assume, for example, that we've decided to remove
163  !    pawrhoij from the POT file. In this case, abifiles should contain:
164  !
165  !        abifile_t(varname="potential", fform=102), &                         ! old file with pawrhoij
166  !        abifile_t(varname="potential", fform=202, has_pawrhoij=.False.) &    ! new file wo pawrhoij
167  !
168  ! *) The file extensions is used in fform_from_ext and varname_from_fname.
169  !    fform_from_ext returns the most recent fform associated to a file extension.
170  !    varname_from_fname is used in post-processing tools e.g. cut3d
171  !    to read data from netcdf file without having to prompt the user for the variable name.
172  !    In principle, the extension should be unique but there are exceptions e.g. the WFK produced in bigdft mode.
173  !    Moreover the files produced by the DFPT code do not have a well-defined extension and, as a consequence,
174  !    they require a special treatment. In python I would use regexp but Fortran is not python!
175 
176  type(abifile_t),private,parameter :: all_abifiles(48) = [ &
177 
178     ! Files with wavefunctions:
179     abifile_t(varname="coefficients_of_wavefunctions", fform=2, ext="WFK", class="wf_planewave"), &
180     abifile_t(varname="real_space_wavefunctions", fform=200, ext="WFK", class="wf_wavelet"), &    ! Used by wavelets.
181     abifile_t(varname="ur_ae", fform=602, ext="PAWAVES", class="wf_rspace"), &                    ! Used in pawmkaewf.
182     abifile_t(varname="coefficients_of_wavefunctions", fform=502, ext="KSS", class="wf_planewave"), &
183 
184     ! Files with density-like data.
185     abifile_t(varname="density", fform=52, ext="DEN", class="density"), &    ! Official
186     abifile_t(varname="positron_density", fform=53, ext="POSITRON", class="density"), &
187     abifile_t(varname="first_order_density", fform=54, ext="DEN(\d+)", class="density"), &
188     abifile_t(varname="pawrhor", fform=55, ext="PAWDEN", class="density"), &
189     abifile_t(varname="pawrhor_core", fform=56, ext="ATMDEN_CORE", class="density"), &
190     abifile_t(varname="pawrhor_val", fform=57, ext="ATMDEN_VAL", class="density"), &
191     abifile_t(varname="pawrhor_full", fform=58, ext="ATMDEN_FULL", class="density"), &
192     abifile_t(varname="pawrhor_ntilde_minus_nhat", fform=59, ext="N_TILDE", class="density"), &
193     abifile_t(varname="pawrhor_n_one", fform=60, ext="N_ONE", class="density"), &
194     abifile_t(varname="pawrhor_nt_one", fform=61, ext="NT_ONE", class="density"), &
195     abifile_t(varname="qp_rhor", fform=62, ext="QP_DEN", class="density"), &
196     abifile_t(varname="qp_pawrhor", fform=63, ext="QP_PAWDEN", class="density"), &
197     abifile_t(varname="grhor_1", fform=67, ext="GDEN1", class="density"), &
198     abifile_t(varname="grhor_2", fform=68, ext="GDEN2", class="density"), &
199     abifile_t(varname="grhor_3", fform=69, ext="GDEN3", class="density"), &
200 
201     !???
202     abifile_t(varname="stm", fform=110, ext="STM", class="density"), &
203     abifile_t(varname="kinedr", fform=70, ext="KDEN", class="density"), &
204     abifile_t(varname="elfr", fform=64, ext="ELF", class="density"), &
205     abifile_t(varname="elfr_up", fform=65, ext="ELF_UP", class="density"), &
206     abifile_t(varname="elfr_down", fform=66, ext="ELF_DOWN", class="density"), &
207     abifile_t(varname="laprhor", fform=71, ext="LDEN", class="density"), &
208 
209     ! Files with potentials
210     ! Official
211     abifile_t(varname="potential", fform=102, ext="POT", class="potential"), &  ! CHECK THESE TWO FILES
212     abifile_t(varname="vtrial", fform=103, ext="POT", class="potential"), &
213     abifile_t(varname="vhartree", fform=104, ext="VHA", class="potential"), &
214     abifile_t(varname="vpsp", fform=105, ext="VPSP", class="potential"), &
215     abifile_t(varname="vhartree_vloc", fform=106, ext="VCLMB", class="potential"), &
216     abifile_t(varname="vhxc", fform=107, ext="VHXC", class="potential"), &
217     abifile_t(varname="exchange_correlation_potential", fform=108, ext="VXC", class="potential"), &
218 
219     abifile_t(varname="first_order_potential", fform=109, ext="POT(\d+)", class="potential"), &
220     ! fform 111 contains an extra record with rhog1_q(G=0) after the DFPT potential(r).
221     abifile_t(varname="first_order_potential", fform=111, ext="POT(\d+)", class="potential"), &
222 
223     abifile_t(varname="first_order_vhartree", fform=112, ext="VHA(\d+)", class="potential"), &
224     abifile_t(varname="first_order_vpsp", fform=113, ext="VPSP(\d+)", class="potential"), &
225     abifile_t(varname="first_order_vxc", fform=114, ext="VXC(\d+)", class="potential"), &
226 
227    ! Data used in conducti
228     abifile_t(varname="pawnabla", fform=610, ext="OPT1", class="data"), &
229     abifile_t(varname="pawnabla_core", fform=611, ext="OPT2", class="data"), &
230     abifile_t(varname="pawnabla_loc", fform=612, ext="OPT", class="data"), &
231 
232    ! Data used in elphon
233     abifile_t(varname="gkk_elements", fform=42, ext="GKK", class="data"), &
234 
235    ! DKK matrix elements in netcdf format (optic, eph)
236     abifile_t(varname="h1_matrix_elements", fform=43, ext="DKK", class="data"), &
237 
238     ! output files that are not supposed to be read by abinit.
239     abifile_t(varname="this_file_is_not_read_by_abinit", fform=666, ext="666", class="data"), &
240 
241    ! GW files: old 1002, 1102
242    !character(len=nctk_slen),public,parameter :: e_ncname="dielectric_function"
243    ! FIXME This one should be rewritten
244    abifile_t(varname="polarizability", fform=1003, ext="SUS", class="polariz"),  &
245    abifile_t(varname="inverse_dielectric_function", fform=1004, ext="SCR", class="epsm1"), &
246    !abifile_t(varname="dielectric_function", fform=1002, ext="EPS", class="eps"), &
247    !
248    ! BSE: TODO. see m_bse_io
249    !abifile_t(varname="bse_uresonant_q0", fform=1002, ext="BSR", class="bsreso"), &
250    !abifile_t(varname="bse_ucoupling_q0", fform=1002, ext="BSC", class="bscoup"), &
251 
252    ! Miscellaneous
253    abifile_t(varname="dos_fractions", fform=3000, ext="FATBANDS", class="data"), &
254    abifile_t(varname="spectral_weights", fform=5000, ext="FOLD2BLOCH", class="data"), &
255    abifile_t(varname="no_fftdatar_write", fform=6000, ext="ABIWAN", class="data") &
256   ]
257 
258  type(abifile_t),public,parameter :: abifile_none = abifile_t(varname="None", fform=0, ext="None", class="None")
259  ! This object is returned when we cannot find the file in abifiles.
260 
261 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.

PARENTS

      m_hdr

CHILDREN

SOURCE

583 subroutine check_fform(fform)
584 
585 
586 !This section has been created automatically by the script Abilint (TD).
587 !Do not modify the following lines by hand.
588 #undef ABI_FUNC
589 #define ABI_FUNC 'check_fform'
590 !End of the abilint section
591 
592  implicit none
593 
594 !This section has been created automatically by the script Abilint (TD).
595 !Do not modify the following lines by hand.
596 #undef ABI_FUNC
597 #define ABI_FUNC 'check_fform'
598 !End of the abilint section
599 
600 !Local variables-------------------------------
601 !scalars
602 
603 !This section has been created automatically by the script Abilint (TD).
604 !Do not modify the following lines by hand.
605 #undef ABI_FUNC
606 #define ABI_FUNC 'check_fform'
607 !End of the abilint section
608 
609  integer,intent(in) :: fform
610 #ifdef DEBUG_MODE
611  type(abifile_t) :: abifile
612  character(len=500) :: msg
613 
614 ! *********************************************************************
615  if (fform == 666) return
616  abifile = abifile_from_fform(fform)
617 
618  if (abifile%fform == 0) then
619     MSG_ERROR(sjoin("Cannot find any abifile object associated to fform:", itoa(fform)))
620  end if
621  if (abifile%fform /= fform) then
622     write(msg,"(2a,2(a,i0))") &
623       "Input fform does not agree with the one registered in abifile.",ch10,&
624       "hdr%fform= ",fform,", abifile%fform= ",abifile%fform
625     MSG_ERROR(msg)
626  end if
627 
628 #else
629  ABI_UNUSED(fform)
630 #endif
631 
632 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

276 integer function fform_from_ext(abiext) result(fform)
277 
278 
279 !This section has been created automatically by the script Abilint (TD).
280 !Do not modify the following lines by hand.
281 #undef ABI_FUNC
282 #define ABI_FUNC 'fform_from_ext'
283 !End of the abilint section
284 
285  implicit none
286 
287 !Arguments ---------------------------------------------
288  character(len=*),intent(in) :: abiext
289 
290 !Local variables-------------------------------
291 !scalars
292  integer :: ii,ind,ierr,pertcase
293  character(len=len(abiext)) :: ext
294 
295 ! *********************************************************************
296  ! Remove .nc (if any) and work with ext
297  ext = abiext
298  if (endswith(abiext, ".nc")) then
299    ind = index(abiext, ".nc", back=.True.); ext = abiext(:ind-1)
300  end if
301 
302  fform = 0
303  do ii=1,size(all_abifiles)
304    if (ext == all_abifiles(ii)%ext) fform = all_abifiles(ii)%fform
305  end do
306  if (fform /= 0) return
307  ! Here we handle special cases.
308 
309  ! Handle DEN[pertcase]
310  if (startswith(ext, "DEN")) then
311    read(ext(4:), *, iostat=ierr) pertcase
312    if (ierr == 0) then
313      do ii=1,size(all_abifiles)
314        if (all_abifiles(ii)%ext == "DEN(\d+)") fform = all_abifiles(ii)%fform
315      end do
316      return
317    end if
318  end if
319 
320  ! Handle POT[pertcase]
321  if (startswith(ext, "POT")) then
322    read(ext(4:), *, iostat=ierr) pertcase
323    if (ierr == 0) then
324      do ii=1,size(all_abifiles)
325        if (all_abifiles(ii)%ext == "POT(\d+)") fform = all_abifiles(ii)%fform
326      end do
327      return
328    end if
329  end if
330 
331 end function fform_from_ext

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.

PARENTS

      elphon,initaim,m_dvdb,m_hdr,m_io_screening,m_ioarr,m_wfk,optic,read_gkk

CHILDREN

SOURCE

2571 subroutine hdr_bcast(hdr,master,me,comm)
2572 
2573 
2574 !This section has been created automatically by the script Abilint (TD).
2575 !Do not modify the following lines by hand.
2576 #undef ABI_FUNC
2577 #define ABI_FUNC 'hdr_bcast'
2578 !End of the abilint section
2579 
2580  implicit none
2581 
2582 !Arguments ------------------------------------
2583  integer, intent(in) :: master,me,comm
2584  type(hdr_type),intent(inout) :: hdr
2585 
2586 !Local variables-------------------------------
2587 !scalars
2588  integer :: bantot,cplex,iatom,ierr,index,index2,ipsp,ispden,list_size,list_size2,natom,nkpt
2589  integer :: npsp,nsel,nspden,nsppol,nsym,nrhoij,ntypat
2590  character(len=fnlen) :: list_tmp
2591 !arrays
2592  integer,allocatable :: list_int(:)
2593  real(dp),allocatable :: list_dpr(:)
2594  character(len=fnlen),allocatable :: list_char(:)
2595 
2596 ! *************************************************************************
2597 
2598  !@hdr_type
2599  if (xmpi_comm_size(comm) == 1) return ! Nothing to do
2600 
2601  DBG_ENTER("COLL")
2602 
2603 !Transmit the integer scalars
2604  list_size = 43
2605  ABI_MALLOC(list_int,(list_size))
2606  if (master==me)then
2607    list_int(1)=hdr%bantot
2608    list_int(2)=hdr%date
2609    list_int(3)=hdr%headform
2610    list_int(4)=hdr%intxc
2611    list_int(5)=hdr%ixc
2612    list_int(6)=hdr%natom
2613    list_int(7)=hdr%nkpt
2614    list_int(8)=hdr%npsp
2615    list_int(9)=hdr%nspden
2616    list_int(10)=hdr%nspinor
2617    list_int(11)=hdr%nsppol
2618    list_int(12)=hdr%nsym
2619    list_int(13)=hdr%ntypat
2620    list_int(14)=hdr%occopt
2621    list_int(15)=hdr%pertcase
2622    list_int(16)=hdr%usepaw
2623    list_int(17:19)=hdr%ngfft(1:3)
2624    list_int(20)=hdr%usewvl
2625    list_int(21)=hdr%kptopt
2626    list_int(22)=hdr%pawcpxocc
2627    list_int(23)=hdr%nshiftk_orig
2628    list_int(24)=hdr%nshiftk
2629    list_int(25:33)=reshape(hdr%kptrlatt_orig, [3*3])
2630    list_int(34:42)=reshape(hdr%kptrlatt, [3*3])
2631    list_int(43)=hdr%icoulomb
2632  end if
2633 
2634  call xmpi_bcast(list_int,master,comm,ierr)
2635 
2636  if(master/=me)then
2637    hdr%bantot  =list_int(1)
2638    hdr%date    =list_int(2)
2639    hdr%headform=list_int(3)
2640    hdr%intxc   =list_int(4)
2641    hdr%ixc     =list_int(5)
2642    hdr%natom   =list_int(6)
2643    hdr%nkpt    =list_int(7)
2644    hdr%npsp    =list_int(8)
2645    hdr%nspden  =list_int(9)
2646    hdr%nspinor =list_int(10)
2647    hdr%nsppol  =list_int(11)
2648    hdr%nsym    =list_int(12)
2649    hdr%ntypat  =list_int(13)
2650    hdr%occopt  =list_int(14)
2651    hdr%pertcase=list_int(15)
2652    hdr%usepaw  =list_int(16)
2653    hdr%ngfft(1:3)=list_int(17:19)
2654    hdr%usewvl  =list_int(20)
2655    hdr%kptopt       = list_int(21)
2656    hdr%pawcpxocc    = list_int(22)
2657    hdr%nshiftk_orig = list_int(23)
2658    hdr%nshiftk      = list_int(24)
2659    hdr%kptrlatt_orig = reshape(list_int(25:33), [3,3])
2660    hdr%kptrlatt = reshape(list_int(34:42), [3,3])
2661    hdr%icoulomb = list_int(43)
2662  end if
2663  ABI_FREE(list_int)
2664 
2665  bantot=hdr%bantot
2666  natom =hdr%natom
2667  nkpt  =hdr%nkpt
2668  npsp  =hdr%npsp
2669  nspden=hdr%nspden
2670  nsppol=hdr%nsppol
2671  nsym  =hdr%nsym
2672  ntypat=hdr%ntypat
2673 
2674  if (master/=me) then
2675 !  Allocate all components of hdr
2676    call hdr_malloc(hdr, bantot, nkpt, nsppol, npsp, natom, ntypat,&
2677                    nsym, hdr%nshiftk_orig, hdr%nshiftk)
2678  end if
2679 
2680 !Transmit the integer arrays
2681  list_size=nkpt*(2+nsppol)+6*npsp+10*nsym+natom
2682  ABI_MALLOC(list_int,(list_size))
2683  if (master==me)then
2684    list_int(1      :nkpt             )=hdr%istwfk ; index=nkpt
2685    list_int(1+index:nkpt*nsppol+index)=hdr%nband  ; index=index+nkpt*nsppol
2686    list_int(1+index:nkpt       +index)=hdr%npwarr ; index=index+nkpt
2687    list_int(1+index:npsp       +index)=hdr%pspcod ; index=index+npsp
2688    list_int(1+index:npsp       +index)=hdr%pspdat ; index=index+npsp
2689    list_int(1+index:npsp       +index)=hdr%pspso  ; index=index+npsp
2690    list_int(1+index:npsp       +index)=hdr%pspxc  ; index=index+npsp
2691    list_int(1+index:npsp       +index)=hdr%lmn_size ; index=index+npsp
2692    list_int(1+index:npsp       +index)=hdr%so_psp ; index=index+npsp
2693    list_int(1+index:nsym       +index)=hdr%symafm ; index=index+nsym
2694    list_int(1+index:nsym*3*3   +index)=reshape(hdr%symrel,(/3*3*nsym/))
2695    index=index+nsym*3*3
2696    list_int(1+index:natom      +index)=hdr%typat   ; index=index+natom
2697  end if
2698 
2699  call xmpi_bcast(list_int,master,comm,ierr)
2700 
2701  if(master/=me)then
2702    hdr%istwfk=list_int(1      :nkpt             ) ; index=nkpt
2703    hdr%nband =list_int(1+index:nkpt*nsppol+index) ; index=index+nkpt*nsppol
2704    hdr%npwarr=list_int(1+index:nkpt       +index) ; index=index+nkpt
2705    hdr%pspcod=list_int(1+index:npsp       +index) ; index=index+npsp
2706    hdr%pspdat=list_int(1+index:npsp       +index) ; index=index+npsp
2707    hdr%pspso =list_int(1+index:npsp       +index) ; index=index+npsp
2708    hdr%pspxc =list_int(1+index:npsp       +index) ; index=index+npsp
2709    hdr%lmn_size=list_int(1+index:npsp     +index) ; index=index+npsp
2710    hdr%so_psp =list_int(1+index:npsp   +index) ; index=index+npsp
2711    hdr%symafm=list_int(1+index:nsym       +index) ; index=index+nsym
2712    hdr%symrel=reshape(list_int(1+index:nsym*3*3   +index),(/3,3,nsym/))
2713    index=index+nsym*3*3
2714    hdr%typat  =list_int(1+index:natom      +index) ; index=index+natom
2715  end if
2716  ABI_FREE(list_int)
2717 
2718 !Transmit the double precision scalars and arrays
2719  list_size = 21+ 3*nkpt+nkpt+bantot + 3*nsym + 3*natom + 2*npsp+ntypat + &
2720              2 + 3*hdr%nshiftk_orig + 3*hdr%nshiftk + hdr%ntypat
2721  ABI_MALLOC(list_dpr,(list_size))
2722 
2723  if (master==me)then
2724    list_dpr(1)=hdr%ecut_eff
2725    list_dpr(2)=hdr%etot
2726    list_dpr(3)=hdr%fermie
2727    list_dpr(4)=hdr%residm
2728    list_dpr(5:13)=reshape(hdr%rprimd(1:3,1:3),(/9/))
2729    list_dpr(14)=hdr%ecut
2730    list_dpr(15)=hdr%ecutdg
2731    list_dpr(16)=hdr%ecutsm
2732    list_dpr(17)=hdr%tphysel
2733    list_dpr(18)=hdr%tsmear
2734    list_dpr(19:21)=hdr%qptn(1:3)                                 ; index=21
2735    list_dpr(1+index:3*nkpt +index)=reshape(hdr%kptns,(/3*nkpt/)) ; index=index+3*nkpt
2736    list_dpr(1+index:nkpt   +index)=hdr%wtk                       ; index=index+nkpt
2737    list_dpr(1+index:bantot +index)=hdr%occ                       ; index=index+bantot
2738    list_dpr(1+index:3*nsym +index)=reshape(hdr%tnons,(/3*nsym/)) ; index=index+3*nsym
2739    list_dpr(1+index:3*natom+index)=reshape(hdr%xred,(/3*natom/)) ; index=index+3*natom
2740    list_dpr(1+index:npsp   +index)=hdr%zionpsp                   ; index=index+npsp
2741    list_dpr(1+index:npsp   +index)=hdr%znuclpsp                  ; index=index+npsp
2742    list_dpr(1+index:ntypat  +index)=hdr%znucltypat               ; index=index+ntypat
2743    list_dpr(1+index)=hdr%nelect; index=index+1
2744    list_dpr(1+index)=hdr%charge; index=index+1
2745    list_dpr(1+index:index+3*hdr%nshiftk_orig) = reshape(hdr%shiftk_orig, [3*hdr%nshiftk_orig])
2746    index=index+3*hdr%nshiftk_orig
2747    list_dpr(1+index:index+3*hdr%nshiftk) = reshape(hdr%shiftk, [3*hdr%nshiftk])
2748    index=index+3*hdr%nshiftk
2749    list_dpr(1+index:index+hdr%ntypat) = hdr%amu(1:hdr%ntypat)
2750  end if
2751 
2752  call xmpi_bcast(list_dpr,master,comm,ierr)
2753 
2754  if(master/=me)then
2755    hdr%ecut_eff=list_dpr(1)
2756    hdr%etot    =list_dpr(2)
2757    hdr%fermie  =list_dpr(3)
2758    hdr%residm  =list_dpr(4)
2759    hdr%rprimd  =reshape(list_dpr(5:13),(/3,3/))
2760    hdr%ecut    =list_dpr(14)
2761    hdr%ecutdg  =list_dpr(15)
2762    hdr%ecutsm  =list_dpr(16)
2763    hdr%tphysel =list_dpr(17)
2764    hdr%tsmear  =list_dpr(18)
2765    hdr%qptn(1:3)=list_dpr(19:21)                                    ; index=21
2766    hdr%kptns   =reshape(list_dpr(1+index:3*nkpt +index),(/3,nkpt/)) ; index=index+3*nkpt
2767    hdr%wtk     =list_dpr(1+index:nkpt   +index)                     ; index=index+nkpt
2768    hdr%occ     =list_dpr(1+index:bantot +index)                     ; index=index+bantot
2769    hdr%tnons   =reshape(list_dpr(1+index:3*nsym +index),(/3,nsym/)) ; index=index+3*nsym
2770    hdr%xred    =reshape(list_dpr(1+index:3*natom+index),(/3,natom/)); index=index+3*natom
2771    hdr%zionpsp =list_dpr(1+index:npsp   +index)                     ; index=index+npsp
2772    hdr%znuclpsp=list_dpr(1+index:npsp   +index)                     ; index=index+npsp
2773    hdr%znucltypat=list_dpr(1+index:ntypat  +index)                  ; index=index+ntypat
2774    hdr%nelect = list_dpr(1+index); index=index+1
2775    hdr%charge = list_dpr(1+index); index=index+1
2776    hdr%shiftk_orig = reshape(list_dpr(1+index:index+3*hdr%nshiftk_orig), [3, hdr%nshiftk_orig])
2777    index=index+3*hdr%nshiftk_orig
2778    hdr%shiftk = reshape(list_dpr(1+index:index+3*hdr%nshiftk), [3, hdr%nshiftk])
2779    index=index+3*hdr%nshiftk
2780    hdr%amu = list_dpr(1+index:index+hdr%ntypat)
2781  end if
2782  ABI_FREE(list_dpr)
2783 
2784 !Transmit the characters
2785  list_size=npsp+1 + npsp
2786  ABI_MALLOC(list_char,(list_size))
2787  if (master==me)then
2788    list_char(1)       =hdr%codvsn  ! Only 6 characters are stored in list_char(1)
2789    list_char(2:npsp+1)=hdr%title
2790    list_char(npsp+2:) =hdr%md5_pseudos
2791  end if
2792 
2793  call xmpi_bcast(list_char,master,comm,ierr)
2794 
2795  if(master/=me)then
2796    list_tmp=list_char(1)
2797    hdr%codvsn=list_tmp(1:6)
2798    do ipsp=2,npsp+1
2799      list_tmp =list_char(ipsp)
2800      hdr%title(ipsp-1) =list_tmp(1:fnlen)
2801    end do
2802    do ipsp=npsp+2,2*npsp+1
2803      hdr%md5_pseudos(ipsp-npsp-1) = list_char(ipsp)(1:md5_slen)
2804    end do
2805  end if
2806  ABI_FREE(list_char)
2807 
2808 !Transmit the structured variables in case of PAW
2809  if (hdr%usepaw==1) then
2810 
2811    nrhoij=0
2812    if (master==me)then
2813      cplex=hdr%pawrhoij(1)%cplex
2814      nspden=hdr%pawrhoij(1)%nspden
2815      do iatom=1,natom
2816        nrhoij=nrhoij+hdr%pawrhoij(iatom)%nrhoijsel
2817      end do
2818    end if
2819 
2820    call xmpi_bcast(nrhoij,master,comm,ierr)
2821    call xmpi_bcast(cplex ,master,comm,ierr)
2822    call xmpi_bcast(nspden,master,comm,ierr)
2823 
2824    list_size=natom+nrhoij;list_size2=nspden*nrhoij*cplex
2825    ABI_MALLOC(list_int,(list_size))
2826    ABI_MALLOC(list_dpr,(list_size2))
2827    if (master==me)then
2828      index=0;index2=0
2829      do iatom=1,natom
2830        nsel=hdr%pawrhoij(iatom)%nrhoijsel
2831        list_int(1+index)=nsel
2832        list_int(2+index:1+nsel+index)=hdr%pawrhoij(iatom)%rhoijselect(1:nsel)
2833        index=index+1+nsel
2834        do ispden=1,nspden
2835          list_dpr(1+index2:nsel*cplex+index2)=hdr%pawrhoij(iatom)%rhoijp(1:nsel*cplex,ispden)
2836          index2=index2+nsel*cplex
2837        end do
2838      end do
2839    end if
2840 
2841    call xmpi_bcast(list_int,master,comm,ierr)
2842    call xmpi_bcast(list_dpr,master,comm,ierr)
2843 
2844    if(master/=me)then
2845      index=0;index2=0
2846      ABI_DT_MALLOC(hdr%pawrhoij,(natom))
2847      call pawrhoij_alloc(hdr%pawrhoij,cplex,nspden,hdr%nspinor,hdr%nsppol,hdr%typat,lmnsize=hdr%lmn_size)
2848      do iatom=1,natom
2849        nsel=list_int(1+index)
2850        hdr%pawrhoij(iatom)%nrhoijsel=nsel
2851        hdr%pawrhoij(iatom)%rhoijselect(1:nsel)=list_int(2+index:1+nsel+index)
2852        index=index+1+nsel
2853        do ispden=1,nspden
2854          hdr%pawrhoij(iatom)%rhoijp(1:nsel*cplex,ispden)=list_dpr(1+index2:nsel*cplex+index2)
2855          index2=index2+nsel*cplex
2856        end do
2857      end do
2858    end if
2859    ABI_FREE(list_int)
2860    ABI_FREE(list_dpr)
2861  end if
2862 
2863  hdr%mband = maxval(hdr%nband)
2864 
2865  DBG_EXIT("COLL")
2866 
2867 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.

PARENTS

      m_wfk

CHILDREN

SOURCE

1755 subroutine hdr_bsize_frecords(Hdr,formeig,nfrec,bsize_frecords)
1756 
1757 
1758 !This section has been created automatically by the script Abilint (TD).
1759 !Do not modify the following lines by hand.
1760 #undef ABI_FUNC
1761 #define ABI_FUNC 'hdr_bsize_frecords'
1762 !End of the abilint section
1763 
1764  implicit none
1765 
1766 !Arguments ------------------------------------
1767 !scalars
1768  integer,intent(in) :: formeig
1769  integer,intent(out) :: nfrec
1770  type(hdr_type),intent(in) :: Hdr
1771 !arrays
1772  integer(XMPI_OFFSET_KIND),allocatable,intent(out) :: bsize_frecords(:)
1773 
1774 !Local variables-------------------------------
1775 !scalars
1776  integer :: max_nfrec,ik_ibz,spin,mband,nband_k,npw_k,band
1777 !arrays
1778  integer(XMPI_OFFSET_KIND),allocatable :: bsz_frec(:)
1779 
1780 !************************************************************************
1781 
1782 !@hdr_type
1783  mband = MAXVAL(Hdr%nband)
1784  max_nfrec = Hdr%nkpt*Hdr%nsppol * (3 + mband)
1785 
1786  if (formeig==1) max_nfrec = max_nfrec + Hdr%nkpt*Hdr%nsppol*mband
1787  ABI_MALLOC(bsz_frec, (max_nfrec))
1788 
1789  nfrec = 0
1790  do spin=1,Hdr%nsppol
1791    do ik_ibz=1,Hdr%nkpt
1792      nband_k = Hdr%nband(ik_ibz + (spin-1)*Hdr%nkpt)
1793      npw_k   = Hdr%npwarr(ik_ibz)
1794 
1795      ! First record: npw, nspinor, nband_disk
1796      nfrec = nfrec + 1
1797      bsz_frec(nfrec) = 3*xmpi_bsize_int
1798 
1799      ! Record with kg_k(3,npw_k) vectors
1800      nfrec = nfrec + 1
1801      bsz_frec(nfrec) = 3*npw_k*xmpi_bsize_int
1802 
1803      if (formeig==0) then
1804        ! Record with the eigenvalues
1805        ! eig_k(nband_k), occ_k(nband_k)
1806        nfrec = nfrec + 1
1807        bsz_frec(nfrec) = 2*nband_k*xmpi_bsize_dp
1808 
1809        ! cg_k record
1810        do band=1,nband_k
1811          nfrec = nfrec + 1
1812          bsz_frec(nfrec) = 2*npw_k*Hdr%nspinor*xmpi_bsize_dp
1813        end do
1814 
1815      else if (formeig==1) then
1816        do band=1,nband_k
1817          ! Record with the eigenvalues
1818          nfrec = nfrec + 1
1819          bsz_frec(nfrec) = 2*nband_k*xmpi_bsize_dp
1820 
1821          ! cg_k record
1822          nfrec = nfrec + 1
1823          bsz_frec(nfrec) = 2*npw_k*Hdr%nspinor*xmpi_bsize_dp
1824        end do
1825      else
1826        MSG_ERROR("Wrong formeig")
1827      end if
1828 
1829    end do
1830  end do
1831 
1832  ABI_MALLOC(bsize_frecords, (nfrec))
1833  bsize_frecords = bsz_frec(1:nfrec)
1834 
1835  ABI_FREE(bsz_frec)
1836 
1837 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)

PARENTS

      inwffil,m_ddk,m_io_screening,m_ioarr,m_wfk

CHILDREN

SOURCE

3865 subroutine hdr_check(fform,fform0,hdr,hdr0,mode_paral,restart,restartpaw)
3866 
3867 
3868 !This section has been created automatically by the script Abilint (TD).
3869 !Do not modify the following lines by hand.
3870 #undef ABI_FUNC
3871 #define ABI_FUNC 'hdr_check'
3872 !End of the abilint section
3873 
3874  implicit none
3875 
3876 !Arguments ------------------------------------
3877 !scalars
3878  integer,intent(in) :: fform,fform0
3879  integer,intent(out) :: restart,restartpaw
3880  character(len=4),intent(in) :: mode_paral
3881  type(hdr_type),intent(in) :: hdr,hdr0
3882 
3883 !Local variables-------------------------------
3884  character(len=1), parameter :: number(0:10)=(/'0','1','2','3','4','5','6','7','8','9',' '/)
3885  character(len=24), save :: bndfmt='(2x, i4,t41,   a,2x, i4)'
3886  character(len=28), save :: occfmt='(2x, f4.1,t41,   a,2x, f4.1)'
3887  character(len=28), save :: wtkfmt='(2x, f7.3,t41,   a,2x, f7.3)'
3888  character(len=28), save :: zatfmt='(2x, f6.2,t41,   a,2x, f6.2)'
3889 !scalars
3890  integer,parameter :: mwarning=5,nkpt_max=5
3891  integer :: bantot,bantot_eff,ii,ipsp,isppol,istart,istop,isym,itest,iwarning
3892  integer :: jj,mu,natom,nelm,nkpt,npsp,nsppol,nsym,ntypat,tatty,tband,tdg
3893  integer :: tecut,tgrid,tkpt,tlmn,tng,tpaw,tprim,tpsch,tpseu,tspinor,tsym,twfk
3894  integer :: twvl,txred
3895  real(dp) :: rms
3896  logical :: tfform2,tfform52
3897  character(len=26) :: typfmt
3898  character(len=500) :: msg
3899  type(abifile_t) :: abifile,abifile0
3900 
3901 ! *************************************************************************
3902 
3903  !@hdr_type
3904  DBG_ENTER("COLL")
3905 
3906 !We will adopt convention that if things agree between restart
3907 !and current calculation then the tflag is 0. Begin by assuming
3908 !that there is complete agreement between the files
3909 
3910  tatty = 0; tband = 0; tdg = 0 ; tecut = 0; tkpt = 0;
3911  tlmn = 0; tng = 0; tpaw = 0; tprim = 0; tpsch = 0; tpseu = 0;
3912  tspinor=0; tsym = 0; twfk = 0 ; txred = 0 ; twvl = 0 ; tgrid = 0
3913 
3914 !Write out a header
3915  write(msg,'(a1,80a,2a1,10x,a,3a1,8x,a,25x,a,a1,8x,19a,25x,12a,a1)' )&
3916 & ch10,('=',ii=1,80),ch10,ch10,&
3917 & '- hdr_check: checking restart file header for consistency -',&
3918 & (ch10,ii=1,3),'current calculation','restart file',ch10,('-',ii=1,19),('-',ii=1,12),ch10
3919  call wrtout(std_out,msg,mode_paral)
3920 
3921 !Check validity of fform, and find filetype
3922  abifile = abifile_from_fform(fform)
3923  if (abifile%fform == 0) then
3924     MSG_ERROR(sjoin("Cannot find any abifile object associated to fform:", itoa(fform)))
3925  end if
3926 
3927 !Check validity of fform0, and find filetype
3928  abifile0 = abifile_from_fform(fform0)
3929  if (abifile0%fform == 0) then
3930     MSG_ERROR(sjoin("Cannot find any abifile object associated to fform:", itoa(fform0)))
3931  end if
3932 
3933  write(msg,'(a,a13,3x,2a,a13)') &
3934 & '  calculation expects a ',ljust(abifile%class, 13),'|','  input file contains a ',ljust(abifile0%class, 13)
3935  call wrtout(std_out,msg,mode_paral)
3936 
3937  write(msg,'(a,a,11x,a,a,a)')&
3938 & '. ABINIT  code version ',hdr%codvsn,'|','  ABINIT  code version ',hdr0%codvsn
3939  call wrtout(std_out,msg,mode_paral)
3940 
3941 !Check fform from input, not from header file
3942  if ( fform /= fform0) then
3943    write(msg,'(a,i0,a,i0,a)')'input fform=',fform,' differs from disk file fform=',fform0,'.'
3944    MSG_ERROR(msg)
3945  end if
3946 
3947  write(msg, '(a,i8,a,i4,a,i4,2x,a,a,i8,a,i4,a,i4)' ) &
3948 & '. date ',hdr %date,' bantot ',hdr %bantot,' natom ',hdr %natom,'|',&
3949 & '  date ',hdr0%date,' bantot ',hdr0%bantot,' natom ',hdr0%natom
3950  call wrtout(std_out,msg,mode_paral)
3951 
3952  write(msg, '(a,i4,a,i3,3(a,i4),2x,a,a,i4,a,i3,3(a,i4))' )&
3953 & '  nkpt',hdr %nkpt,' nsym',hdr %nsym,' ngfft',hdr %ngfft(1),',',hdr %ngfft(2),',',hdr %ngfft(3),'|',&
3954 & '  nkpt',hdr0%nkpt,' nsym',hdr0%nsym,' ngfft',hdr0%ngfft(1),',',hdr0%ngfft(2),',',hdr0%ngfft(3)
3955  call wrtout(std_out,msg,mode_paral)
3956 
3957  if (hdr%usewvl == 0) then
3958 !  Note that the header actually contains ecut_eff=ecut*dilatmx**2
3959    write(msg,'(a,i3,a,f12.7,8x,a,a,i3,a,f12.7)')&
3960 &   '  ntypat',hdr %ntypat,' ecut_eff',hdr %ecut_eff,'|',&
3961 &   '  ntypat',hdr0%ntypat,' ecut_eff',hdr0%ecut_eff
3962    call wrtout(std_out,msg,mode_paral)
3963  else
3964    write(msg,'(a,i3,a,f12.7,8x,a,a,i3,a,f12.7)')&
3965 &   '  ntypat',hdr %ntypat,' hgrid   ', 2. * hdr %rprimd(1,1) / (hdr %ngfft(1) - 31),'|',&
3966 &   '  ntypat',hdr0%ntypat,' hgrid   ', 2. * hdr0%rprimd(1,1) / (hdr0%ngfft(1) - 31)
3967    call wrtout(std_out,msg,mode_paral)
3968 !  Check hgrid and rprimd values.
3969    if (hdr0%rprimd(1,2) /= zero .or. hdr0%rprimd(1,3) /= zero .or. &
3970 &   hdr0%rprimd(2,1) /= zero .or. hdr0%rprimd(2,3) /= zero .or. &
3971 &   hdr0%rprimd(3,1) /= zero .or. hdr0%rprimd(3,2) /= zero) then
3972      MSG_ERROR('disk file rprimd is not parallelepipedic.')
3973    end if
3974    if (abs(hdr0%rprimd(1,1) / hdr0%ngfft(1) - hdr %rprimd(1,1) / hdr %ngfft(1)) > tol8) then
3975      write(msg,'(a,F7.4,a,F7.4)')&
3976 &     'input wvl_hgrid=', 2. * hdr%rprimd(1,1) / hdr%ngfft(1), &
3977 &     'not equal disk file wvl_hgrid=', 2. * hdr0%rprimd(1,1) / hdr0%ngfft(1)
3978      MSG_WARNING(msg)
3979      tgrid = 1
3980    end if
3981  end if
3982 
3983  write(msg, '(a,i3,29x,a,a,i3)' )'  usepaw',hdr %usepaw,'|','  usepaw',hdr0%usepaw
3984  call wrtout(std_out,msg,mode_paral)
3985 
3986  write(msg, '(a,i3,29x,a,a,i3)' )'  usewvl',hdr %usewvl,'|','  usewvl',hdr0%usewvl
3987  call wrtout(std_out,msg,mode_paral)
3988 
3989  write(msg,'(a,31x,a,a,3(a1,2x,3f12.7,2x,a,2x,3f12.7))')&
3990 & '  rprimd:','|','  rprimd:',ch10,&
3991 & hdr%rprimd(:,1),'|',hdr0%rprimd(:,1),ch10,&
3992 & hdr%rprimd(:,2),'|',hdr0%rprimd(:,2),ch10,&
3993 & hdr%rprimd(:,3),'|',hdr0%rprimd(:,3)
3994  call wrtout(std_out,msg,mode_paral)
3995 
3996  if (hdr%bantot/=hdr0%bantot) tband=1
3997 
3998  if (hdr%intxc/=hdr0%intxc) then
3999    write(msg,'(a,i0,a,i0)')'input intxc=',hdr%intxc,' not equal disk file intxc=',hdr0%intxc
4000    MSG_WARNING(msg)
4001  end if
4002 
4003  if (hdr%ixc/=hdr0%ixc) then
4004    write(msg,'(a,i0,a,i0)')'input ixc=',hdr%ixc,' not equal disk file ixc=',hdr0%ixc
4005    MSG_WARNING(msg)
4006  end if
4007 
4008  if (hdr%natom/=hdr0%natom) then
4009    write(msg,'(a,i0,a,i0)')'input natom=',hdr%natom,' not equal disk file natom=',hdr0%natom
4010    MSG_WARNING(msg)
4011    tatty=1
4012  end if
4013 
4014  if ( ANY(hdr%ngfft/=hdr0%ngfft) ) then
4015 !  For sensible rho(r) or V(r) data, fft grid must be identical
4016 !  MG TODO one should perform an FFT interpolation when the two ngfft differ!
4017    if (abifile%class == "density" .or. abifile%class == "potential") then
4018      write(msg, '(a,a,a,a,a)' )&
4019 &     'fft grids must be the same for restart from a ',trim(abifile%class),' file.',ch10,&
4020 &     'Action: change your fft grid or your restart file.'
4021      MSG_ERROR(msg)
4022    end if
4023    tng=1
4024  end if
4025 
4026  if (hdr%nkpt/=hdr0%nkpt) then
4027    if (abifile%class == "wf_planewave") then
4028      write(msg,'(a,i0,a,i0)' )'input nkpt=',hdr%nkpt,' not equal disk file nkpt=',hdr0%nkpt
4029      MSG_WARNING(msg)
4030    end if
4031    tkpt=1; twfk=1
4032  end if
4033 
4034  if (hdr%nspinor/=hdr0%nspinor) then
4035    if (abifile%class == "wf_planewave") then
4036      write(msg,'(a,i0,a,i0)')'input nspinor=',hdr%nspinor,' not equal disk file nspinor=',hdr0%nspinor
4037      MSG_WARNING(msg)
4038    end if
4039    tspinor=1
4040  end if
4041 
4042 !No check is present for nspden
4043  if (hdr%nsppol/=hdr0%nsppol) then
4044    write(msg,'(a,i0,a,i0)')'input nsppol=',hdr%nsppol,' not equal disk file nsppol=',hdr0%nsppol
4045    MSG_WARNING(msg)
4046  end if
4047 
4048  if (hdr%nsym/=hdr0%nsym) then
4049    write(msg, '(a,i0,a,i0)' )'input nsym=',hdr%nsym,' not equal disk file nsym=',hdr0%nsym
4050    MSG_WARNING(msg)
4051    tsym=1
4052  end if
4053 
4054  if (hdr%ntypat/=hdr0%ntypat) then
4055    write(msg,'(a,i0,a,i0)')'input ntypat=',hdr%ntypat,' not equal disk file ntypat=',hdr0%ntypat
4056    call wrtout(std_out,msg,mode_paral)
4057    MSG_WARNING(msg)
4058    tatty=1
4059  end if
4060 
4061  if (hdr%usepaw/=hdr0%usepaw) then
4062    write(msg,'(a,i0,a,i0)')'input usepaw=',hdr%usepaw,' not equal disk file usepaw=',hdr0%usepaw
4063    MSG_WARNING(msg)
4064    tpaw=1
4065  end if
4066 
4067  if (hdr%usewvl/=hdr0%usewvl) then
4068    write(msg, '(a,i6,a,i6,a,a)' )&
4069 &   'input usewvl=',hdr%usewvl,' not equal disk file usewvl=',hdr0%usewvl, ch10, &
4070 &   'Action: change usewvl input variable or your restart file.'
4071    MSG_ERROR(msg)
4072  end if
4073 
4074 !Also examine agreement of floating point data
4075  if (hdr%usewvl == 0 .and. abs(hdr%ecut_eff-hdr0%ecut_eff)>tol8) then
4076    write(msg,'(a,f12.6,a,f12.6,a)')'input ecut_eff=',hdr%ecut_eff,' /= disk file ecut_eff=',hdr0%ecut_eff,'.'
4077    MSG_WARNING(msg)
4078    tecut=1
4079  end if
4080 
4081  do ii=1,3
4082    do jj=1,3
4083      if (abs(hdr%rprimd(ii,jj)-hdr0%rprimd(ii,jj))>tol6) then
4084        write(msg, '(a,i1,a,i1,a,1p,e17.9,a,i1,a,i1,a,e17.9)' )&
4085 &       'input rprimd(',ii,',',jj,')=',hdr%rprimd(ii,jj),' /= disk file rprimd(',ii,',',jj,')=',hdr0%rprimd(ii,jj)
4086        MSG_WARNING(msg)
4087        tprim=1
4088      end if
4089    end do
4090  end do
4091 
4092 !Below this point many comparisons only make sense if
4093 !certain things agree, e.g. nkpt, natom.  Also have to
4094 !accomodate different amounts of data in general.
4095 
4096  if (hdr%usepaw==1 .and. hdr0%usepaw==1) then
4097 
4098 !  Compare ecutdg (PAW)
4099    write(msg, '(a,f12.6,15x,a,a,f12.6)' )'  PAW: ecutdg',hdr %ecutdg,'|','  PAW: ecutdg',hdr0%ecutdg
4100    call wrtout(std_out,msg,mode_paral)
4101    if (hdr%ecutdg/=hdr0%ecutdg) then
4102      write(msg, '(a,f12.6,a,f12.6)' )'input ecutdg=',hdr%ecutdg,'not equal disk file ecutdg=',hdr0%ecutdg
4103      MSG_WARNING(msg)
4104      tdg=1
4105    end if
4106  end if
4107 
4108 !Compare nband(nkpt*nsppol) (cannot compare if nkpt and nsppol not same)
4109  if (hdr%nkpt==hdr0%nkpt .and. hdr%nsppol==hdr0%nsppol) then
4110    nkpt=hdr%nkpt ; nsppol=hdr%nsppol
4111    write(msg,'(a,32x,a,a)') '  nband:','|','  nband:'
4112    call wrtout(std_out,msg,mode_paral)
4113    do istart = 1,nsppol*nkpt,9
4114      istop = min(istart + 8,nsppol*nkpt)
4115      mu = istop - istart + 1
4116 !    generate a format specifier
4117      bndfmt(5:5) = number(mu)
4118      bndfmt(21:21) = number(mu)
4119      if (istart<=100) then
4120        write(msg,fmt=bndfmt) hdr%nband(istart:istop),'|',hdr0%nband(istart:istop)
4121        call wrtout(std_out,msg,mode_paral)
4122        if (istop>100) then
4123          write(msg,'(a)') '=> stop printing nband after 100 values'
4124          call wrtout(std_out,msg,mode_paral)
4125        end if
4126      end if
4127    end do
4128 
4129    do isppol=1,nsppol
4130      do ii=1,nkpt
4131        if (hdr%nband(ii)/=hdr0%nband(ii)) then
4132          tband=1
4133          if (abifile%class == "wf_planewave") then
4134            write(msg,'(a,i0,a,i0,a,i0)' )&
4135 &           'kpt num',ii,' input nband=',hdr%nband(ii),' not equal disk file nband=',hdr0%nband(ii)
4136            MSG_WARNING(msg)
4137          end if
4138        end if
4139      end do
4140    end do
4141  end if
4142 
4143 !Compare the number of wavelets in each resolution.
4144  if (hdr%usewvl == 1) then
4145    if (size(hdr%nwvlarr) /= size(hdr0%nwvlarr) .or. size(hdr%nwvlarr) /= 2) then
4146      write(msg, '(a,i0,a,i0,a,a)' )&
4147 &     'input nwvlres= ',size(hdr%nwvlarr),' not equal disk file nwvlres= ',size(hdr0%nwvlarr),' or 2',&
4148 &     ' ABINIT is not implemented for wavelet resolutions different from 2.'
4149      MSG_ERROR(msg)
4150    end if
4151  end if
4152 
4153 !Compare symmetry arrays (integers) symafm(nsym)
4154 !-- only for same number of symmetries nsym
4155  itest=0
4156  if (hdr%nsym==hdr0%nsym) then
4157    nsym=hdr%nsym
4158    write(msg,'(a,31x,a,a)') '  symafm:','|','  symafm:'
4159    call wrtout(std_out,msg,mode_paral)
4160    do istart = 1,nsym,12
4161      istop=min(istart+11,nsym)
4162      nelm = istop - istart + 1
4163      call mk_hdr_check_fmt(nelm,typfmt)
4164      write(msg,fmt=typfmt) hdr%symafm(istart:istop),'|',hdr0%symafm(istart:istop)
4165      call wrtout(std_out,msg,mode_paral)
4166    end do
4167  end if
4168 
4169  if (itest/=0) then
4170    write(msg,'(a,i0,a)' )'For symmetry number',itest,' input symafm not equal disk file symafm'
4171    MSG_WARNING(msg)
4172    tsym=1
4173  end if
4174 
4175 !Compare symmetry arrays (integers) symrel(3,3,nsym)
4176 !-- only for same number of symmetries nsym
4177  itest=0
4178  if (hdr%nsym==hdr0%nsym) then
4179    nsym=hdr%nsym
4180    write(msg,'(a,31x,a,a)') '  symrel:','|','  symrel:'
4181    call wrtout(std_out,msg,mode_paral)
4182    do isym=1,nsym
4183      write(msg,'(2x,9i3,11x,a,2x,9i3)')hdr%symrel(:,:,isym),'|',hdr0%symrel(:,:,isym)
4184      call wrtout(std_out,msg,mode_paral)
4185      if(sum(abs(hdr%symrel(:,:,isym)-hdr0%symrel(:,:,isym)))/=0)then
4186        itest=isym
4187        exit
4188      end if
4189    end do
4190  end if
4191 
4192  if (itest/=0) then
4193    write(msg,'(a,i0,a)')'For symmetry number',itest,' input symrel not equal disk file symrel'
4194    MSG_WARNING(msg)
4195    tsym=1
4196  end if
4197 
4198 !Compare typat(natom)
4199  if (hdr%natom==hdr0%natom) then
4200    natom=hdr%natom
4201    write(msg,'(a,32x,a,a)') '  typat:','|','  typat:'
4202    call wrtout(std_out,msg,mode_paral)
4203    do istart = 1,natom,12
4204      istop=min(istart+11,natom)
4205      nelm = istop - istart + 1
4206      call mk_hdr_check_fmt(nelm,typfmt)
4207      write(msg,fmt=typfmt) hdr%typat(istart:istop),'|',hdr0%typat(istart:istop)
4208      call wrtout(std_out,msg,mode_paral)
4209    end do
4210    do ii=1,natom
4211      if (hdr%typat(ii)/=hdr0%typat(ii)) then
4212        write(msg, '(a,i0,a,i0,a,i0)' )&
4213 &       'For atom number ',ii,' input typat=',hdr%typat(ii),' not equal disk file typat=',hdr0%typat(ii)
4214        MSG_WARNING(msg)
4215        tatty=1
4216      end if
4217    end do
4218  end if
4219 
4220 !Compare so_psp(npsp)
4221  if (hdr%npsp==hdr0%npsp) then
4222    npsp=hdr%npsp
4223    write(msg,'(a,29x,a,a)') '  so_psp  :','|','  so_psp  :'
4224    call wrtout(std_out,msg,mode_paral)
4225    do istart = 1,npsp  ,12
4226      istop=min(istart+11,npsp  )
4227      nelm = istop - istart + 1
4228      call mk_hdr_check_fmt(nelm,typfmt)
4229      write(msg,fmt=typfmt) hdr%so_psp  (istart:istop),'|',hdr0%so_psp  (istart:istop)
4230      call wrtout(std_out,msg,mode_paral)
4231    end do
4232    do ii=1,npsp
4233      if (hdr%so_psp  (ii)/=hdr0%so_psp  (ii)) then
4234        write(msg,'(a,i0,a,i0,a,i0)')&
4235 &       'For pseudopotential number ',ii,' input so_psp =',hdr%so_psp(ii),' not equal disk file so_psp=',hdr0%so_psp(ii)
4236        MSG_WARNING(msg)
4237      end if
4238    end do
4239  end if
4240 
4241 !Compare istwfk(nkpt)
4242  if (hdr%nkpt==hdr0%nkpt) then
4243    nkpt=hdr%nkpt
4244    write(msg,'(a,31x,a,a)') '  istwfk:','|','  istwfk:'
4245    call wrtout(std_out,msg,mode_paral)
4246    do istart = 1,nkpt,12
4247      istop=min(istart+11,nkpt)
4248      nelm = istop - istart + 1
4249      call mk_hdr_check_fmt(nelm,typfmt)
4250      if (istart<=100) then
4251        write(msg,fmt=typfmt) hdr%istwfk(istart:istop),'|',hdr0%istwfk(istart:istop)
4252        call wrtout(std_out,msg,mode_paral)
4253        if (istop>100) then
4254          write(msg,'(a)') '=> stop printing istwfk after 100 values'
4255          call wrtout(std_out,msg,mode_paral)
4256        end if
4257      end if
4258    end do
4259    do ii=1,nkpt
4260      if (hdr%istwfk(ii)/=hdr0%istwfk(ii)) then
4261        write(msg, '(a,i0,a,i0,a,i0)' )&
4262 &       'For k point number ',ii,' input istwfk=',hdr%istwfk(ii),' not equal disk file istwfk=',hdr0%istwfk(ii)
4263        MSG_WARNING(msg)
4264        twfk=1
4265      end if
4266    end do
4267  end if
4268 
4269 !NEW_HDR
4270  if (any(hdr%kptrlatt /= hdr0%kptrlatt)) then
4271     write(msg,"(2(a,9(i0,1x)))")"input kptrlatt= ",hdr%kptrlatt," /= disk file kptrlatt=",hdr0%kptrlatt
4272     MSG_WARNING(msg)
4273  end if
4274  if (hdr%kptopt /= hdr0%kptopt) then
4275     MSG_WARNING(sjoin("input kptopt=",itoa(hdr%kptopt)," /= disk file kptopt=",itoa(hdr0%kptopt)))
4276  end if
4277  if (hdr%pawcpxocc /= hdr0%pawcpxocc) then
4278     MSG_WARNING(sjoin("input pawcpxocc=",itoa(hdr%pawcpxocc)," /= disk file pawcpxocc=",itoa(hdr0%pawcpxocc)))
4279  end if
4280  if (hdr%icoulomb /= hdr0%icoulomb) then
4281     MSG_WARNING(sjoin("input icoulomb=",itoa(hdr%icoulomb)," /= disk file icoulomb=",itoa(hdr0%icoulomb)))
4282  end if
4283 
4284  if (abs(hdr%nelect - hdr0%nelect) > tol6) then
4285     MSG_WARNING(sjoin("input nelect=",ftoa(hdr%nelect)," /= disk file nelect=",ftoa(hdr0%nelect)))
4286  end if
4287  if (abs(hdr%charge - hdr0%charge) > tol6) then
4288     MSG_WARNING(sjoin("input charge=",ftoa(hdr%charge)," /= disk file charge=",ftoa(hdr0%charge)))
4289  end if
4290 
4291  if (hdr%ntypat==hdr0%ntypat) then
4292    if (any(abs(hdr%amu - hdr0%amu) > tol6)) then
4293       MSG_WARNING(sjoin("input amu=",ltoa(hdr%amu)," /= disk file amu=",ltoa(hdr0%amu)))
4294    end if
4295  end if
4296 !end NEW_HDR
4297 
4298 !Compare kpt(3,nkpt)
4299  if (hdr%nkpt==hdr0%nkpt) then
4300    nkpt=hdr%nkpt
4301    write(msg,'(a,34x,a,a)') '  kpt:','|','  kpt:'
4302    call wrtout(std_out,msg,mode_paral)
4303    do ii = 1,min(nkpt,nkpt_max)
4304      write(msg,'(2x,3f12.7,2x,a,2x,3f12.7)')&
4305 &     hdr%kptns(:,ii),'|',hdr0%kptns(:,ii)
4306      call wrtout(std_out,msg,mode_paral)
4307      if(ii>nkpt_max)then
4308        call wrtout(std_out,'The number of printed k points is sufficient... stop writing them.',mode_paral)
4309        exit
4310      end if
4311    end do
4312    iwarning=0
4313    do ii=1,nkpt
4314      itest=0
4315      do mu=1,3
4316        if(abs( hdr%kptns(mu,ii)-hdr0%kptns(mu,ii) )>tol6)itest=1
4317      end do
4318      if (itest==1) then
4319        write(msg, '(a,i5,a,3es17.7,a,a,3es17.7)' )&
4320 &       'kpt num',ii,', input kpt=',hdr%kptns(:,ii),ch10,&
4321 &       'not equal  disk file kpt=',hdr0%kptns(:,ii)
4322        MSG_WARNING(msg)
4323        tkpt=1 ; iwarning=iwarning+1
4324        if(iwarning>=mwarning)then
4325          call wrtout(std_out,'The number of warning messages is sufficient ... stop writing them.',mode_paral)
4326          exit
4327        end if
4328      end if
4329    end do
4330  end if
4331 
4332 !Compare wtk(nkpt)
4333  if (hdr%nkpt==hdr0%nkpt) then
4334    nkpt=hdr%nkpt
4335 
4336    write(msg,'(a,34x,a,a)') '  wtk:','|','  wtk:'
4337    call wrtout(std_out,msg,mode_paral)
4338    istop = min(nkpt,nkpt_max)
4339    do ii = 1, istop, 5
4340      mu = min(5, istop - ii + 1)
4341      wtkfmt(5:5) = number(mu)
4342      wtkfmt(23:23) = number(mu)
4343      write(msg, wtkfmt)hdr%wtk(ii:min(istop, ii + 5 - 1)),'|',hdr0%wtk(ii:min(istop, ii + 5 - 1))
4344      call wrtout(std_out,msg,mode_paral)
4345    end do
4346    iwarning=0
4347    do ii=1,nkpt
4348      itest=0
4349      if (abs( hdr%wtk(ii)-hdr0%wtk(ii) )>tol6) then
4350        write(msg,'(a,i5,a,es17.7,a,a,es17.7)')&
4351 &       'kpt num',ii,', input weight=',hdr%wtk(ii),ch10,&
4352 &       'not equal  disk file weight=',hdr0%wtk(ii)
4353        MSG_WARNING(msg)
4354 
4355        tkpt=1 ; iwarning=iwarning+1
4356        if(iwarning>=mwarning)then
4357          call wrtout(std_out,'The number of warning messages is sufficient ... stop writing them.',mode_paral)
4358          exit
4359        end if
4360      end if
4361    end do
4362  end if
4363 
4364 !Compare occ(bantot)
4365  if (hdr%nkpt==hdr0%nkpt.and. hdr%bantot==hdr0%bantot) then
4366    nkpt=hdr%nkpt
4367    bantot=hdr%bantot
4368 
4369    write(msg,'(a,34x,a,a)') '  occ:','|','  occ:'
4370    call wrtout(std_out,msg,mode_paral)
4371    bantot_eff=min(bantot,9*nkpt_max)
4372    do istart = 1,bantot_eff,9
4373      istop = min(istart+8,bantot_eff)
4374      mu = istop - istart + 1
4375      occfmt(5:5) = number(mu)
4376      occfmt(23:23) = number(mu)
4377      write(msg,fmt=occfmt)hdr%occ(istart:istop),'|', hdr0%occ(istart:istop)
4378      call wrtout(std_out,msg,mode_paral)
4379      if(istart>9*nkpt_max)then
4380        call wrtout(std_out,'The number of printed occupation numbers is sufficient ... stop writing them.',mode_paral)
4381        exit
4382      end if
4383    end do
4384    iwarning=0
4385    do ii=1,bantot
4386      if (abs( hdr%occ(ii)-hdr0%occ(ii) )>tol6) then
4387        write(msg,'(a,i0,a,1p,e15.7,a,e15.7)')'band,k: ',ii,', input occ=',hdr%occ(ii),' disk occ=',hdr0%occ(ii)
4388        MSG_WARNING(msg)
4389        tband=1 ; iwarning=iwarning+1
4390        if(iwarning>=mwarning)then
4391          call wrtout(std_out,'The number of warning msgs is sufficient ... stop writing them.',mode_paral)
4392          exit
4393        end if
4394      end if
4395    end do
4396  end if
4397 
4398 !Compare tnons(3,nsym)
4399  if (hdr%nsym==hdr0%nsym) then
4400    nsym=hdr%nsym
4401    itest=0
4402    write(msg,'(a,32x,a,a)') '  tnons:','|','  tnons:'
4403    call wrtout(std_out,msg,mode_paral)
4404    do isym=1,nsym
4405      write(msg,'(2x,3f12.7,2x,a,2x,3f12.7)') hdr%tnons(:,isym),'|',hdr0%tnons(:,isym)
4406      call wrtout(std_out,msg,mode_paral)
4407    end do
4408 
4409    do isym=1,nsym
4410      if( sum(abs(  hdr%tnons(:,isym)-hdr0%tnons(:,isym) )) > tol6) then
4411        itest=isym
4412        exit
4413      end if
4414    end do
4415    if (itest/=0) then
4416      write(msg, '(a,i0,a)' )'For symmetry number ',itest,' input tnons not equal disk file tnons'
4417      MSG_WARNING(msg)
4418    end if
4419  end if
4420 
4421 !Compare znucltypat(ntypat)
4422  if (hdr%ntypat==hdr0%ntypat) then
4423    ntypat=hdr%ntypat
4424 
4425    write(msg,'(a,31x,a,a)') '   znucl:','|','   znucl:'
4426    call wrtout(std_out,msg,mode_paral)
4427    do istart = 1,ntypat,6
4428      istop = min(istart+5,ntypat)
4429      mu = istop-istart+1
4430      zatfmt(5:5) = number(mu)
4431      zatfmt(23:23) = number(mu)
4432      write(msg,fmt=zatfmt) hdr%znucltypat(istart:istop),'|',hdr0%znucltypat(istart:istop)
4433      call wrtout(std_out,msg,mode_paral)
4434    end do
4435 
4436    do ii=1,ntypat
4437      if (abs(hdr%znucltypat(ii)-hdr0%znucltypat(ii))>tol6) then
4438        write(msg, '(a,i5,a,f12.6,a,f12.6)' )&
4439 &       ' For atom number ',ii,' input znucl=',hdr%znucltypat(ii),' not equal disk file znucl=',hdr0%znucltypat(ii)
4440        MSG_WARNING(msg)
4441      end if
4442    end do
4443  end if
4444 
4445 !Should perform some checks related to pertcase and qptn,
4446 !that have been introduced in the header in v4.1
4447 !Warning : a GS file might be read, while the hdr corresponds
4448 !to a RF file (to initialize k+q), and vice-versa (in nonlinear).
4449 
4450 !Now check agreement of psp headers too
4451  if (hdr%npsp==hdr0%npsp) then
4452    npsp=hdr%npsp
4453    itest=0
4454 
4455    do ipsp=1,npsp
4456 
4457      write(msg,'(a,i3,a,9x,a,a,i3,a)')&
4458 &     '  pseudopotential atom type',ipsp,':','|','  pseudopotential atom type',ipsp,':'
4459      call wrtout(std_out,msg,mode_paral)
4460 
4461      if (hdr%usepaw==1 .and. hdr0%usepaw==1) then
4462        write(msg,'(a,i3,a,i3,a,i3,5x,a,a,i3,a,i3,a,i3)')&
4463 &       '  pspso ',hdr %pspso(ipsp),' pspxc ',hdr %pspxc(ipsp),&
4464 &       '  lmn_size ',hdr%lmn_size(ipsp),'|',&
4465 &       '  pspso ',hdr0%pspso(ipsp),' pspxc ',hdr0%pspxc(ipsp),&
4466 &       '  lmn_size ',hdr0%lmn_size(ipsp)
4467        call wrtout(std_out,msg,mode_paral)
4468        if (hdr%lmn_size(ipsp)/=hdr0%lmn_size(ipsp)) then
4469          write(msg, '(a,i3,a,i3,a,i3)' )&
4470 &         'For atom type ',ipsp,' input lmn_size=',hdr%lmn_size(ipsp),&
4471 &         'not equal disk file lmn_size=',hdr0%lmn_size(ipsp)
4472          MSG_WARNING(msg)
4473          tlmn=1
4474        end if
4475      else
4476        write(msg,'(a,i3,a,i3,19x,a,a,i3,a,i3)')&
4477 &       '  pspso ',hdr %pspso(ipsp),' pspxc ',hdr %pspxc(ipsp),'|',&
4478 &       '  pspso ',hdr0%pspso(ipsp),' pspxc ',hdr0%pspxc(ipsp)
4479        call wrtout(std_out,msg,mode_paral)
4480      end if
4481      write(msg,'(a,i6,a,i4,a,f5.1,2x,a,a,i6,a,i4,a,f5.1)')&
4482 &     '  pspdat ',hdr %pspdat(ipsp),' pspcod ',hdr %pspcod(ipsp),&
4483 &     ' zion ',hdr %zionpsp(ipsp),'|',&
4484 &     '  pspdat ',hdr0%pspdat(ipsp),' pspcod ',hdr0%pspcod(ipsp),&
4485 &     ' zion ',hdr0%zionpsp(ipsp)
4486      call wrtout(std_out,msg,mode_paral)
4487 
4488      ! Check on md5 values.
4489      if (hdr%md5_pseudos(ipsp) /= hdr0%md5_pseudos(ipsp)) then
4490        write(msg, '(a,i0,6a)' )&
4491        ' Different md5 checksum for pseudo ',ipsp,ch10,&
4492        ' input md5= ',hdr%md5_pseudos(ipsp),ch10,&
4493        ' disk  md5= ',hdr0%md5_pseudos(ipsp)
4494        MSG_WARNING(msg)
4495        itest=1; tpsch=1
4496      end if
4497 
4498 !    Second, test
4499 !    NOTE, XG 000719 : should do something about pspso
4500 !    NOTE, XG 020716 : znucl and zion are not written
4501      if (abs(hdr%znuclpsp(ipsp)-hdr0%znuclpsp(ipsp))>tol6) itest=1
4502      if (abs(hdr%zionpsp(ipsp)-hdr0%zionpsp(ipsp))>tol6) then
4503        itest=1; tpsch=1
4504      end if
4505      if (hdr%pspdat(ipsp)/= hdr0%pspdat(ipsp)) itest=1
4506      if (hdr%pspcod(ipsp)/= hdr0%pspcod(ipsp)) itest=1
4507      if (hdr%pspxc(ipsp) /= hdr0%pspxc(ipsp) )  itest=1
4508    end do
4509 
4510    if (itest==1) then
4511      msg = 'input psp header does not agree perfectly with disk file psp header.'
4512      MSG_WARNING(msg)
4513      tpseu=1
4514    end if
4515  end if
4516 
4517 !Finally, read residm and etotal ("current value" not known), and check xred.
4518  if (hdr%natom==hdr0%natom) then
4519 
4520    natom=hdr%natom
4521    write(msg,'(a,33x,a,a)') '  xred:','|','  xred:'
4522    call wrtout(std_out,msg,mode_paral)
4523    do ii=1,natom
4524      write(msg,'(2x,3f12.7,2x,a,2x,3f12.7)') hdr%xred(:,ii),'|',hdr0%xred(:,ii)
4525      call wrtout(std_out,msg,mode_paral)
4526    end do
4527 
4528 !  check atom positions one atom at a time and allow possibility
4529 !  that there is a harmless translation of atoms by a cell vector.
4530    do ii=1,natom
4531      rms=0.0_dp
4532      do jj=1,3
4533        rms=rms+(hdr%xred(jj,ii)-hdr0%xred(jj,ii) - dble(nint((hdr%xred(jj,ii)-hdr0%xred(jj,ii)))) )**2
4534      end do
4535      rms=sqrt(rms/3.0_dp)
4536      if (rms>tol6) txred=1
4537    end do
4538  end if
4539 
4540 !Run tests here to establish whether this is a valid restart
4541 
4542 !tfform2 will be true if there is a problem for the wavefunctions
4543  tfform2 = (hdr%usewvl == 0 .and. &
4544 & (tprim /= 0 .or. tecut /= 0 .or. tkpt /= 0 .or. &
4545 & twfk /=0 .or. tspinor /= 0)) .or. &
4546 & (hdr%usepaw == 1 .and. &
4547 & (tpaw /= 0 .or. tlmn /= 0 .or. tdg /= 0)) .or. &
4548 & (hdr%usewvl == 1 .and. &
4549 & (tatty /= 0 .or. tband /= 0))
4550 !tfform52 will be true if there is a problem for the format 52
4551  tfform52=tprim /= 0 .or. tatty /= 0 .or. txred /= 0 .or.&
4552 & tpseu /= 0 .or. tecut /= 0 .or. tng /= 0 .or. &
4553 & (hdr%usepaw == 1 .and. &
4554 & (tpaw /= 0 .or. tlmn /= 0 .or. tdg /= 0))
4555 
4556  restart=1; restartpaw=hdr%usepaw
4557 
4558 !If there is a problem somewhere
4559  if ( (abifile%class == "wf_planewave"  .and. tfform2  ) .or.  &
4560 & (abifile%class == "density" .and. tfform52 ) .or.  &
4561 & (abifile%class == "wf_wavelet" .and. tfform2 ) ) then
4562 
4563    if (abifile%class == "wf_planewave") then
4564      restart=2
4565      msg = 'Restart of self-consistent calculation need translated wavefunctions.'
4566    else if (abifile%class == "density") then
4567      restart=0
4568      msg = 'Illegal restart of non-self-consistent calculation'
4569    end if
4570    MSG_WARNING(msg)
4571 
4572    write(msg,'(a,a1,a)') &
4573 &   '  Indeed, critical differences between current calculation and',ch10,&
4574 &   '  restart file have been detected in:'
4575    call wrtout(std_out,msg,mode_paral)
4576 
4577    if ( (abifile%class == "density" .or. abifile%class == "wf_wavelet") .and. tatty /= 0 ) then
4578      write(msg, '(8x,a)' ) '* the number of atoms of each type'
4579      call wrtout(std_out,msg,mode_paral)
4580    end if
4581    if ( abifile%class /= "wf_wavelet" .and. tecut /= 0 ) then
4582      write(msg, '(8x,a)' ) '* the plane-wave cutoff'
4583      call wrtout(std_out,msg,mode_paral)
4584    end if
4585    if ( abifile%class == "wf_wavelent" .and. tband /= 0 ) then
4586      write(msg, '(8x,a)' ) '* the band and their occupation'
4587      call wrtout(std_out,msg,mode_paral)
4588    end if
4589    if ( abifile%class == "wf_planewave" .and. tkpt /= 0 ) then
4590      write(msg, '(8x,a)' ) '* the number, position, or weight of k-points'
4591      call wrtout(std_out,msg,mode_paral)
4592    end if
4593    if ( abifile%class == "wf_planewave" .and. twfk /= 0 ) then
4594      write(msg, '(8x,a)' ) '* the format of wavefunctions (istwfk)'
4595      call wrtout(std_out,msg,mode_paral)
4596    end if
4597    if ( abifile%class == "wf_planewave"  .and. tspinor /= 0 ) then
4598      write(msg, '(8x,a)' ) '* the scalar/spinor character of the wf (nspinor)'
4599      call wrtout(std_out,msg,mode_paral)
4600    end if
4601    if ( abifile%class == "density"  .and. tng /= 0 ) then
4602      write(msg, '(8x,a)' ) '* the Fourier transform box dimensions'
4603      call wrtout(std_out,msg,mode_paral)
4604    end if
4605    if ( tprim /= 0 ) then
4606      write(msg, '(8x,a)' )'* the vectors defining the unit cell (obtained from rprim and acell)'
4607      call wrtout(std_out,msg,mode_paral)
4608    end if
4609    if ( abifile%class == "density"   .and. tpseu /= 0 ) then
4610      write(msg, '(8x,a)' )'* the pseudopotential files'
4611      call wrtout(std_out,msg,mode_paral)
4612    end if
4613    if ( abifile%class == "density"  .and. txred /= 0 ) then
4614      write(msg, '(8x,a)' ) '* the positions of the ions in the basis'
4615      call wrtout(std_out,msg,mode_paral)
4616    end if
4617 
4618 !  Tests for a restart in the framework of the PAW method
4619    if (hdr%usepaw/=0 .or. hdr0%usepaw/=0) then
4620      if (tpaw /= 0 .or. tlmn /= 0) restartpaw=0
4621      if (restartpaw == 0) then
4622        write(msg,'(8x,a)') 'Critical differences for a restart within PAW method:'
4623        call wrtout(std_out,msg,mode_paral)
4624        if ( tpaw /= 0 ) then
4625          write(msg, '(8x,a)' ) '* the use of the PAW method'
4626          call wrtout(std_out,msg,mode_paral)
4627        else
4628          if(tlmn/=0)then
4629            write(msg, '(8x,a)' ) '* the number of lmn elements for the paw basis'
4630            call wrtout(std_out,msg,mode_paral)
4631          end if
4632        end if
4633      else if (tdg/=0) then
4634        write(msg,'(a,a,a,a,a,a)') ch10,&
4635 &       ' hdr_check: WARNING -',ch10,&
4636 &       '  Restart of calculation within PAW may be inconsistent because of:"'
4637        call wrtout(std_out,msg,mode_paral)
4638        if(tdg/=0)then
4639          write(msg, '(8x,a)' )'* the cutoff energy of the paw double (fine) grid'
4640          call wrtout(std_out,msg,mode_paral)
4641        end if
4642      end if
4643    end if
4644 
4645  else
4646 
4647    if (abifile%class == "wf_planewave" .or. abifile%class == "wf_wavelet") then
4648      write(msg,'(a,a)') ' hdr_check: ',' Wavefunction file is OK for direct restart of calculation'
4649      call wrtout(std_out,msg,mode_paral)
4650    else if (abifile%class == "density") then
4651      write(msg,'(a,a)') ' hdr_check: ',' Density/Potential file is OK for restart of calculation'
4652      call wrtout(std_out,msg,mode_paral)
4653    end if
4654  end if
4655 
4656  write(msg,'(80a)') ('=',ii=1,80)
4657  call wrtout(std_out,msg,mode_paral)
4658 
4659  CONTAINS

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.

PARENTS

      dfpt_looppert,m_io_kss,m_io_screening,m_wfk,optic

CHILDREN

SOURCE

1041 subroutine hdr_copy(Hdr_in,Hdr_cp)
1042 
1043 
1044 !This section has been created automatically by the script Abilint (TD).
1045 !Do not modify the following lines by hand.
1046 #undef ABI_FUNC
1047 #define ABI_FUNC 'hdr_copy'
1048 !End of the abilint section
1049 
1050  implicit none
1051 
1052 !Arguments ------------------------------------
1053 !scalars
1054  type(hdr_type),intent(in) :: Hdr_in
1055  type(hdr_type),intent(inout) :: Hdr_cp
1056 
1057 !Local variables-------------------------------
1058 !scalars
1059  integer :: cplex
1060 ! *************************************************************************
1061 
1062  !@hdr_type
1063 
1064 ! Integer values
1065  Hdr_cp%bantot   = Hdr_in%bantot
1066  Hdr_cp%date     = Hdr_in%date
1067  Hdr_cp%headform = Hdr_in%headform
1068  hdr_cp%icoulomb = hdr_in%icoulomb
1069  Hdr_cp%intxc    = Hdr_in%intxc
1070  Hdr_cp%ixc      = Hdr_in%ixc
1071  Hdr_cp%natom    = Hdr_in%natom
1072  Hdr_cp%nkpt     = Hdr_in%nkpt
1073  Hdr_cp%npsp     = Hdr_in%npsp
1074  Hdr_cp%nspden   = Hdr_in%nspden
1075  Hdr_cp%nspinor  = Hdr_in%nspinor
1076  Hdr_cp%nsppol   = Hdr_in%nsppol
1077  Hdr_cp%nsym     = Hdr_in%nsym
1078  Hdr_cp%ntypat   = Hdr_in%ntypat
1079  Hdr_cp%occopt   = Hdr_in%occopt
1080  Hdr_cp%pertcase = Hdr_in%pertcase
1081  Hdr_cp%usepaw   = Hdr_in%usepaw
1082  Hdr_cp%usewvl   = Hdr_in%usewvl
1083  Hdr_cp%mband    = Hdr_in%mband
1084  ABI_CHECK(hdr_in%mband == maxval(hdr_in%nband), "mband != maxval(hdr_in%nband)")
1085  hdr_cp%kptopt = hdr_in%kptopt
1086  hdr_cp%pawcpxocc = hdr_in%pawcpxocc
1087  hdr_cp%nshiftk_orig = hdr_in%nshiftk_orig
1088  hdr_cp%nshiftk = hdr_in%nshiftk
1089 
1090  ! Integer arrays
1091  Hdr_cp%ngfft   = Hdr_in%ngfft
1092  Hdr_cp%nwvlarr = Hdr_in%nwvlarr
1093  hdr_cp%kptrlatt = hdr_in%kptrlatt
1094  hdr_cp%kptrlatt_orig = hdr_in%kptrlatt_orig
1095 
1096 ! Integer allocatable arrays
1097  call alloc_copy( Hdr_in%istwfk,  Hdr_cp%istwfk   )
1098  call alloc_copy( Hdr_in%lmn_size,Hdr_cp%lmn_size )
1099  call alloc_copy( Hdr_in%nband,   Hdr_cp%nband    )
1100  call alloc_copy( Hdr_in%npwarr,  Hdr_cp%npwarr   )
1101  call alloc_copy( Hdr_in%pspcod,  Hdr_cp%pspcod )
1102  call alloc_copy( Hdr_in%pspdat,  Hdr_cp%pspdat )
1103  call alloc_copy( Hdr_in%pspso ,  Hdr_cp%pspso  )
1104  call alloc_copy( Hdr_in%pspxc ,  Hdr_cp%pspxc  )
1105  call alloc_copy( Hdr_in%so_psp,  Hdr_cp%so_psp )
1106  call alloc_copy( Hdr_in%symafm,  Hdr_cp%symafm )
1107  call alloc_copy( Hdr_in%symrel,  Hdr_cp%symrel )
1108  call alloc_copy( Hdr_in%typat ,  Hdr_cp%typat  )
1109 
1110 ! Real variables
1111  Hdr_cp%ecut        = Hdr_in%ecut
1112  Hdr_cp%ecutdg      = Hdr_in%ecutdg
1113  Hdr_cp%ecutsm      = Hdr_in%ecutsm
1114  Hdr_cp%ecut_eff    = Hdr_in%ecut_eff
1115  Hdr_cp%etot        = Hdr_in%etot
1116  Hdr_cp%fermie      = Hdr_in%fermie
1117  Hdr_cp%residm      = Hdr_in%residm
1118  Hdr_cp%stmbias     = Hdr_in%stmbias
1119  Hdr_cp%tphysel     = Hdr_in%tphysel
1120  Hdr_cp%tsmear      = Hdr_in%tsmear
1121  hdr_cp%nelect      = hdr_in%nelect
1122  hdr_cp%charge      = hdr_in%charge
1123 
1124  Hdr_cp%qptn(:)     = Hdr_in%qptn(:)
1125  Hdr_cp%rprimd(:,:) = Hdr_in%rprimd(:,:)
1126 
1127 ! Real allocatable arrays
1128  call alloc_copy(Hdr_in%amu, Hdr_cp%amu)
1129  call alloc_copy( Hdr_in%kptns     ,Hdr_cp%kptns     )
1130  call alloc_copy( Hdr_in%occ       ,Hdr_cp%occ       )
1131  call alloc_copy( Hdr_in%tnons     ,Hdr_cp%tnons     )
1132  call alloc_copy( Hdr_in%wtk       ,Hdr_cp%wtk       )
1133  call alloc_copy( Hdr_in%xred      ,Hdr_cp%xred      )
1134  call alloc_copy( Hdr_in%zionpsp   ,Hdr_cp%zionpsp   )
1135  call alloc_copy( Hdr_in%znuclpsp  ,Hdr_cp%znuclpsp  )
1136  call alloc_copy( Hdr_in%znucltypat,Hdr_cp%znucltypat)
1137  call alloc_copy(Hdr_in%shiftk, Hdr_cp%shiftk)
1138  call alloc_copy(Hdr_in%shiftk_orig, Hdr_cp%shiftk_orig)
1139 
1140 ! Character arrays
1141  Hdr_cp%codvsn = Hdr_in%codvsn
1142 ! THIS DOES NOT WORK ON XLF: Hdr_cp%title string length becomes huge and segfaults
1143 ! call alloc_copy( Hdr_in%title,Hdr_cp%title )
1144  ABI_MALLOC(Hdr_cp%title,(Hdr_cp%npsp))
1145  Hdr_cp%title = Hdr_in%title
1146 
1147  ABI_MALLOC(hdr_cp%md5_pseudos, (hdr_cp%npsp))
1148  hdr_cp%md5_pseudos = hdr_in%md5_pseudos
1149 
1150 ! For PAW have to copy Pawrhoij ====
1151 ! NOTE alchemy requires a different treatment but for the moment it is not available within PAW.
1152  if (Hdr_in%usepaw==1) then
1153    cplex = Hdr_in%Pawrhoij(1)%cplex
1154    ABI_DT_MALLOC(Hdr_cp%Pawrhoij,(Hdr_in%natom))
1155    call pawrhoij_alloc(Hdr_cp%Pawrhoij,cplex,Hdr_in%nspden,Hdr_in%nspinor,Hdr_in%nsppol,Hdr_in%typat,&
1156 &    lmnsize=Hdr_in%lmn_size(1:Hdr_in%ntypat))
1157    call pawrhoij_copy(Hdr_in%Pawrhoij,Hdr_cp%Pawrhoij)
1158  end if
1159 
1160 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]

OUTPUT

  Only writing

PARENTS

      cut3d,initaim,ioprof,m_ddk,m_dvdb,m_hdr,m_wfd,m_wfk,mrggkk,rchkgsheader

CHILDREN

SOURCE

2081 subroutine hdr_echo(Hdr,fform,rdwr,unit)
2082 
2083 
2084 !This section has been created automatically by the script Abilint (TD).
2085 !Do not modify the following lines by hand.
2086 #undef ABI_FUNC
2087 #define ABI_FUNC 'hdr_echo'
2088 !End of the abilint section
2089 
2090  implicit none
2091 
2092 !Arguments ------------------------------------
2093  integer,intent(inout) :: fform
2094  integer,intent(in) :: rdwr
2095  integer,optional,intent(in) :: unit
2096  type(hdr_type),intent(inout) :: hdr
2097 
2098 !Local variables-------------------------------
2099  integer,parameter :: max_ns=6
2100  integer :: iatom,ii,ikpt,ipsp,isym,ount !,ns
2101  !character(len=500) :: msg
2102 
2103 !*************************************************************************
2104 
2105  ount = std_out; if (present(unit)) ount = unit; if (ount == dev_null) return
2106 
2107  write(ount,'(a)')' ==============================================================================='
2108  if (rdwr==3) write(ount, '(a)' ) ' ECHO of part of the ABINIT file header '
2109  if (rdwr==4) write(ount, '(a)' ) ' ECHO of the ABINIT file header '
2110  write(ount, '(a)' ) ' '
2111  write(ount, '(a)' ) ' First record :'
2112  write(ount, '(a,a6,2i5)' )  '.codvsn,headform,fform = ',hdr%codvsn, hdr%headform, fform
2113  write(ount, '(a)' ) ' '
2114  write(ount, '(a)' ) ' Second record :'
2115  write(ount, '(a,4i6)') ' bantot,intxc,ixc,natom  =',hdr%bantot, hdr%intxc, hdr%ixc, hdr%natom
2116  write(ount, '(a,4i6)') ' ngfft(1:3),nkpt         =',hdr%ngfft(1:3), hdr%nkpt
2117  write(ount, '(a,2i6)') ' nspden,nspinor          =',hdr%nspden, hdr%nspinor
2118  write(ount, '(a,4i6)' ) ' nsppol,nsym,npsp,ntypat =',hdr%nsppol,hdr%nsym,hdr%npsp,hdr%ntypat
2119  write(ount, '(a,3i6)' ) ' occopt,pertcase,usepaw  =',hdr%occopt,hdr%pertcase,hdr%usepaw
2120  write(ount, '(a,3es18.10)') ' ecut,ecutdg,ecutsm      =',hdr%ecut, hdr%ecutdg, hdr%ecutsm
2121  write(ount, '(a, es18.10)' ) ' ecut_eff                =',hdr%ecut_eff
2122  write(ount, '(a,3es18.10)') ' qptn(1:3)               =',hdr%qptn(1:3)
2123  write(ount, '(a,3es18.10)' ) ' rprimd(1:3,1)           =',hdr%rprimd(1:3,1)
2124  write(ount, '(a,3es18.10)' ) ' rprimd(1:3,2)           =',hdr%rprimd(1:3,2)
2125  write(ount, '(a,3es18.10)' ) ' rprimd(1:3,3)           =',hdr%rprimd(1:3,3)
2126  write(ount, '(a,3es18.10)') ' stmbias,tphysel,tsmear  =',hdr%stmbias,hdr%tphysel, hdr%tsmear
2127 
2128 #ifdef DEV_NEW_HDR
2129  write(ount, "(a,2es18.10,i0)") ' nelect,charge,icoulomb  =',hdr%nelect, hdr%charge, hdr%icoulomb
2130  write(ount, "(a,2i6)")         ' kptopt,pawcpxocc        =',hdr%kptopt, hdr%pawcpxocc
2131  write(ount, '(a,9(i0,1x))')    ' kptrlatt_orig           = ',hdr%kptrlatt_orig
2132  write(ount, '(a,9(i0,1x))' )   ' kptrlatt                = ',hdr%kptrlatt
2133 
2134  ns = min(size(hdr%shiftk_orig, dim=2), max_ns)
2135  write(msg, sjoin("(a,",itoa(3*ns),"(f4.2,1x))")) ' shiftk_orig             = ',hdr%shiftk_orig(:,1:ns)
2136  if (size(hdr%shiftk_orig, dim=2) > max_ns) msg = sjoin(msg, "...")
2137  write(ount,"(a)")trim(msg)
2138 
2139  ns = min(size(hdr%shiftk, dim=2), max_ns)
2140  write(msg, sjoin("(a,",itoa(3*ns),"(f4.2,1x))")) ' shiftk                  = ',hdr%shiftk(:,1:ns)
2141  if (size(hdr%shiftk, dim=2) > max_ns) msg = sjoin(msg, "...")
2142  write(ount,"(a)")trim(msg)
2143 #endif
2144 
2145  write(ount, '(a)' )
2146  if (rdwr==3)then
2147    write(ount, '(a,i3,a)' ) ' The header contain ',hdr%npsp+2,' additional records.'
2148  else
2149    write(ount, '(a)' ) ' Third record :'
2150    write(ount, '(a,(12i4,8x))') ' istwfk=',hdr%istwfk
2151    write(ount, '(a,(12i4,8x))') ' nband =',hdr%nband
2152    write(ount, '(a,(10i5,8x))') ' npwarr=',hdr%npwarr
2153 
2154    write(ount, '(a,(12i4,8x))') ' so_psp=',hdr%so_psp(:)
2155    !write(ount,'(a,(12f6.2,1x))' )' amu   =',hdr%amu
2156 
2157    write(ount, '(a)') ' symafm='
2158    write(ount, '(8x,24i3,8x)') hdr%symafm
2159 
2160    write(ount, '(a)' ) ' symrel='
2161    do isym=1,hdr%nsym/2
2162      write(ount, '(a,9i4,a,9i4)' ) '        ',hdr%symrel(:,:,2*isym-1),'  ',hdr%symrel(:,:,2*isym)
2163    end do
2164    if(2*(hdr%nsym/2)/=hdr%nsym)write(ount, '(a,9i4)' ) '        ',hdr%symrel(:,:,hdr%nsym)
2165 
2166    write(ount, '(a,(12i4,8x))') ' type  =',hdr%typat(:)
2167    write(ount, '(a)' ) ' kptns =                 (max 50 k-points will be written)'
2168    do ikpt=1,min(hdr%nkpt,50)
2169      write(ount, '(a,3es16.6)' ) '        ',hdr%kptns(:,ikpt)
2170    end do
2171    write(ount, '(a)' ) ' wtk ='
2172    do ikpt=1,hdr%nkpt,10
2173      write(ount, '(a,10f6.2)' ) '        ',hdr%wtk(ikpt:min(hdr%nkpt,ikpt + 10 - 1))
2174    end do
2175    write(ount, '(a)' ) '   occ ='
2176    do ii=1,hdr%bantot,10
2177      write(ount, '(a,10f6.2)') '        ',hdr%occ(ii:min(hdr%bantot,ii+10-1))
2178    end do
2179    write(ount, '(a)' ) ' tnons ='
2180    do isym=1,hdr%nsym/2
2181      write(ount, '(a,3f10.6,a,3f10.6)' ) '        ',hdr%tnons(:,2*isym-1),'  ',hdr%tnons(:,2*isym)
2182    end do
2183    if(2*(hdr%nsym/2)/=hdr%nsym)write(ount, '(a,3f10.6)' ) '        ',hdr%tnons(:,hdr%nsym)
2184    write(ount, '(a,(10f6.2,8x))') '  znucl=',hdr%znucltypat(:)
2185    write(ount,'(a)')
2186 
2187    write(ount, '(a)' ) ' Pseudopotential info :'
2188    do ipsp=1,hdr%npsp
2189      write(ount,'(a,a)' ) ' title=',trim(hdr%title(ipsp))
2190      ! TODO: This part should always be printed.
2191      !write(ount,'(a,a)' ) '   md5=',trim(hdr%md5_pseudos(ipsp))
2192      write(ount,'(a,f6.2,a,f6.2,a,i3,a,i6,a,i3,a,i3)' ) &
2193 &     '  znuclpsp=',hdr%znuclpsp(ipsp),    ', zionpsp=',  hdr%zionpsp(ipsp),&
2194 &     ', pspso=' , hdr%pspso(ipsp),  ', pspdat=',hdr%pspdat(ipsp),          &
2195 &     ', pspcod=', hdr%pspcod(ipsp), ', pspxc=', hdr%pspxc(ipsp)
2196 
2197      if(hdr%usepaw==1)then
2198        write(ount,'(a,i3)' ) '  lmn_size=', hdr%lmn_size(ipsp)
2199      else
2200        write(ount,'(a,i3)' ) '  lmnmax  =', hdr%lmn_size(ipsp)
2201      end if
2202 
2203    end do
2204 
2205    write(ount, '(a)' ) ' '
2206    write(ount, '(a)' ) ' Last record :'
2207    write(ount, '(a,es16.6,es22.12,es16.6)' )' residm,etot,fermie=',hdr%residm, hdr%etot, hdr%fermie
2208    write(ount, '(a)' ) ' xred ='
2209    do iatom=1,hdr%natom
2210      write(ount, '(a,3es16.6)' ) '        ',hdr%xred(:,iatom)
2211    end do
2212 
2213    if (hdr%usepaw==1)then
2214      call pawrhoij_io(hdr%pawrhoij,ount,hdr%nsppol,hdr%nspinor,hdr%nspden,hdr%lmn_size,hdr%typat,hdr%headform,"Echo")
2215    end if
2216 
2217    if (rdwr==3)write(ount, '(a)' ) ' End the ECHO of part of the ABINIT file header '
2218    if (rdwr==4)write(ount, '(a)' ) ' End the ECHO of the ABINIT file header '
2219    write(ount,'(a)')' ==============================================================================='
2220  end if ! rdwr is 3 or 4
2221 
2222  call flush_unit(ount)
2223 
2224 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

PARENTS

      elphon,initaim,inpgkk,m_bse_io,m_cut3d,m_dvdb,m_hdr,m_io_screening
      m_ioarr,macroave,mrggkk,rchkgsheader,read_gkk

CHILDREN

SOURCE

2900 subroutine hdr_fort_read(Hdr,unit,fform,rewind)
2901 
2902 
2903 !This section has been created automatically by the script Abilint (TD).
2904 !Do not modify the following lines by hand.
2905 #undef ABI_FUNC
2906 #define ABI_FUNC 'hdr_fort_read'
2907 !End of the abilint section
2908 
2909  implicit none
2910 
2911 !Arguments ------------------------------------
2912  integer,intent(out) :: fform
2913  integer,intent(in) :: unit
2914  logical,optional,intent(in) :: rewind
2915  type(hdr_type),intent(out) :: hdr
2916 
2917 !Local variables-------------------------------
2918  integer :: ipsp
2919  character(len=500) :: msg,errmsg
2920  real(dp),allocatable :: occ3d(:,:,:)
2921 
2922 !*************************************************************************
2923 
2924  !@hdr_type
2925  DBG_ENTER("COLL")
2926 
2927  if (present(rewind)) then
2928    if (rewind) rewind(unit, err=10, iomsg=errmsg)
2929  end if
2930 
2931  ! Reading the first record of the file ------------------------------------
2932  ! fform is not a record of hdr_type
2933  read(unit, err=10, iomsg=errmsg) hdr%codvsn,hdr%headform,fform
2934 
2935  if (hdr%headform < 80) then
2936    write(msg,'(3a,i0,4a)')&
2937      "ABINIT version: ",trim(abinit_version)," cannot read old files with headform: ",hdr%headform,ch10,&
2938      "produced by previous versions. Use an old ABINIT version to read this file or ",ch10,&
2939      "regenerate your files with version >= 8.0."
2940    MSG_ERROR(msg)
2941  end if
2942 
2943  call check_fform(fform)
2944 
2945 !Reading the second record of the file ------------------------------------
2946  read(unit, err=10, iomsg=errmsg) &
2947 &  hdr%bantot, hdr%date, hdr%intxc, hdr%ixc, hdr%natom, hdr%ngfft(1:3),&
2948 &  hdr%nkpt, hdr%nspden, hdr%nspinor, hdr%nsppol, hdr%nsym, hdr%npsp, hdr%ntypat, hdr%occopt, hdr%pertcase,&
2949 &  hdr%usepaw, hdr%ecut, hdr%ecutdg, hdr%ecutsm, hdr%ecut_eff, hdr%qptn(1:3), hdr%rprimd,&
2950 &  hdr%stmbias, hdr%tphysel, hdr%tsmear, hdr%usewvl, hdr%nshiftk_orig, hdr%nshiftk, hdr%mband
2951 
2952  !Allocate all parts of hdr that need to be --------------------------------
2953  call hdr_malloc(hdr, hdr%bantot, hdr%nkpt, hdr%nsppol, hdr%npsp, hdr%natom, hdr%ntypat,&
2954                  hdr%nsym, hdr%nshiftk_orig, hdr%nshiftk)
2955 
2956  if (hdr%usepaw==1)  then
2957    ABI_DT_MALLOC(hdr%pawrhoij,(hdr%natom))
2958  end if
2959 
2960 ! Reading the third record of the file ------------------------------------
2961 
2962 ! Take into account future migration to occ(:,:,:) in the Format
2963 ! read 3d matrix with stride and transfer to (stupid) 1d hdr%occ in packed form.
2964  ABI_MALLOC(occ3d, (hdr%mband,hdr%nkpt,hdr%nsppol))
2965 
2966  read(unit, err=10, iomsg=errmsg) &
2967 & hdr%istwfk(:), hdr%nband(:), hdr%npwarr(:), &
2968 & hdr%so_psp(:), hdr%symafm(:), hdr%symrel(:,:,:), &
2969 & hdr%typat(:), hdr%kptns(:,:), occ3d, &
2970 & hdr%tnons(:,:), hdr%znucltypat(:), hdr%wtk(:)
2971  ABI_CHECK(hdr%mband == maxval(hdr%nband), "mband != maxval(hdr_in%nband)")
2972 
2973  call hdr_set_occ(hdr, occ3d)
2974  ABI_FREE(occ3d)
2975 
2976 ! Reading the final record of the header  ---------------------------------
2977  read(unit, err=10, iomsg=errmsg) hdr%residm, hdr%xred(:,:), hdr%etot, hdr%fermie, hdr%amu(:)
2978 
2979  read(unit, err=10, iomsg=errmsg)&
2980     hdr%kptopt,hdr%pawcpxocc,hdr%nelect,hdr%charge,hdr%icoulomb,&
2981     hdr%kptrlatt,hdr%kptrlatt_orig, hdr%shiftk_orig,hdr%shiftk
2982 
2983 ! Reading the records with psp information ---------------------------------
2984  do ipsp=1,hdr%npsp
2985    read(unit, err=10, iomsg=errmsg) &
2986 &   hdr%title(ipsp), hdr%znuclpsp(ipsp), hdr%zionpsp(ipsp), hdr%pspso(ipsp), hdr%pspdat(ipsp), &
2987 &   hdr%pspcod(ipsp), hdr%pspxc(ipsp), hdr%lmn_size(ipsp), hdr%md5_pseudos(ipsp)
2988  end do
2989 
2990  if (hdr%usepaw==1) then ! Reading the Rhoij tab if the PAW method was used.
2991    call pawrhoij_io(hdr%pawrhoij,unit,hdr%nsppol,hdr%nspinor,hdr%nspden,hdr%lmn_size,hdr%typat,hdr%headform,"Read")
2992  end if
2993 
2994  DBG_EXIT("COLL")
2995  return
2996 
2997  ! Handle IO-error: write warning and let the caller handle the exception.
2998 10 fform=0
2999  MSG_WARNING(errmsg)
3000 
3001 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

PARENTS

      m_bse_io,m_dvdb,m_hdr,m_io_kss,m_io_screening,m_ioarr,mrggkk,outgkk

CHILDREN

SOURCE

3246 subroutine hdr_fort_write(Hdr,unit,fform,ierr,rewind)
3247 
3248 
3249 !This section has been created automatically by the script Abilint (TD).
3250 !Do not modify the following lines by hand.
3251 #undef ABI_FUNC
3252 #define ABI_FUNC 'hdr_fort_write'
3253 !End of the abilint section
3254 
3255  implicit none
3256 
3257 !Arguments ------------------------------------
3258  integer,intent(out) :: ierr
3259  integer,intent(in) :: unit,fform
3260  logical,optional,intent(in) :: rewind
3261  type(hdr_type),intent(inout) :: hdr
3262 
3263 !Local variables-------------------------------
3264  integer :: headform,ipsp
3265  character(len=500) :: errmsg
3266  real(dp),allocatable :: occ3d(:,:,:)
3267 
3268 !*************************************************************************
3269 
3270  ! TODO: Change intent to in. Change pawrhoij_io first!
3271  !@hdr_type
3272  ierr = 0
3273 
3274  if (present(rewind)) then
3275    if (rewind) rewind(unit, err=10, iomsg=errmsg)
3276  end if
3277 
3278  call check_fform(fform)
3279 
3280 !Writing always use last format version
3281  headform = HDR_LATEST_HEADFORM
3282  write(unit, err=10, iomsg=errmsg) hdr%codvsn, headform, fform
3283 
3284  write(unit, err=10, iomsg=errmsg) &
3285 & hdr%bantot, hdr%date, hdr%intxc, hdr%ixc, hdr%natom, hdr%ngfft(1:3), &
3286 & hdr%nkpt, hdr%nspden, hdr%nspinor, hdr%nsppol, hdr%nsym, hdr%npsp, hdr%ntypat, hdr%occopt, hdr%pertcase,&
3287 & hdr%usepaw, hdr%ecut, hdr%ecutdg, hdr%ecutsm, hdr%ecut_eff, hdr%qptn, hdr%rprimd, &
3288 & hdr%stmbias, hdr%tphysel, hdr%tsmear, hdr%usewvl, hdr%nshiftk_orig, hdr%nshiftk, hdr%mband
3289  ABI_CHECK(hdr%mband == maxval(hdr%nband), "mband != maxval(hdr_in%nband)")
3290 
3291  ABI_MALLOC(occ3d, (hdr%mband,hdr%nkpt,hdr%nsppol))
3292  call hdr_get_occ3d(hdr, occ3d)
3293  write(unit,err=10, iomsg=errmsg) hdr%istwfk(:), hdr%nband(:), hdr%npwarr(:),&
3294 & hdr%so_psp(:), hdr%symafm(:), hdr%symrel(:,:,:), hdr%typat(:), hdr%kptns(:,:), occ3d, &
3295 & hdr%tnons(:,:), hdr%znucltypat(:), hdr%wtk(:)
3296  ABI_FREE(occ3d)
3297 
3298  write(unit,err=10, iomsg=errmsg) hdr%residm, hdr%xred(:,:), hdr%etot, hdr%fermie, hdr%amu(:)
3299  write(unit,err=10, iomsg=errmsg) &
3300    hdr%kptopt, hdr%pawcpxocc, hdr%nelect, hdr%charge, hdr%icoulomb,&
3301    hdr%kptrlatt,hdr%kptrlatt_orig, hdr%shiftk_orig(:,1:hdr%nshiftk_orig),hdr%shiftk(:,1:hdr%nshiftk)
3302 
3303  ! Write the records with psp information ---------------------------------
3304  do ipsp=1,hdr%npsp
3305    write(unit, err=10, iomsg=errmsg) &
3306 &   hdr%title(ipsp), hdr%znuclpsp(ipsp), hdr%zionpsp(ipsp), hdr%pspso(ipsp), hdr%pspdat(ipsp), &
3307 &   hdr%pspcod(ipsp), hdr%pspxc(ipsp), hdr%lmn_size(ipsp), hdr%md5_pseudos(ipsp)
3308  end do
3309 
3310  if (hdr%usepaw==1) then
3311    call pawrhoij_io(hdr%pawrhoij,unit,hdr%nsppol,hdr%nspinor,hdr%nspden,hdr%lmn_size,hdr%typat,headform,"Write")
3312  end if
3313 
3314  return
3315 
3316  ! Handle IO-error: write warning and let the caller handle the exception.
3317 10 ierr=1
3318  MSG_WARNING(errmsg)
3319 
3320 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)

PARENTS

      bethe_salpeter,conducti_nc,conducti_paw,conducti_paw_core,cut3d
      dfpt_looppert,dfptnl_loop,elphon,emispec_paw,eph,finddistrproc,gstate
      initaim,inpgkk,inwffil,ioprof,linear_optics_paw,m_bse_io,m_cut3d,m_ddk
      m_dvdb,m_hdr,m_io_kss,m_io_screening,m_ioarr,m_wfd,m_wfk,macroave
      mrggkk,mrgscr,nonlinear,optic,read_el_veloc,read_gkk,respfn,screening
      sigma,wfk_analyze

CHILDREN

SOURCE

 903 subroutine hdr_free(hdr)
 904 
 905 
 906 !This section has been created automatically by the script Abilint (TD).
 907 !Do not modify the following lines by hand.
 908 #undef ABI_FUNC
 909 #define ABI_FUNC 'hdr_free'
 910 !End of the abilint section
 911 
 912  implicit none
 913 
 914 !Arguments ------------------------------------
 915 !scalars
 916  type(hdr_type),intent(inout) :: hdr
 917 
 918 ! *************************************************************************
 919 
 920  DBG_ENTER("COLL")
 921 
 922  !@hdr_type
 923 
 924  !integer
 925  if (allocated(hdr%istwfk)) then
 926    ABI_FREE(hdr%istwfk)
 927  end if
 928  if (allocated(hdr%lmn_size)) then
 929    ABI_FREE(hdr%lmn_size)
 930  end if
 931  if (allocated(hdr%nband)) then
 932    ABI_FREE(hdr%nband)
 933  end if
 934  if (allocated(hdr%npwarr)) then
 935    ABI_FREE(hdr%npwarr)
 936  end if
 937 
 938  if (allocated(hdr%pspcod)) then
 939    ABI_FREE(hdr%pspcod)
 940  end if
 941  if (allocated(hdr%pspdat)) then
 942    ABI_FREE(hdr%pspdat)
 943  end if
 944  if (allocated(hdr%pspso)) then
 945    ABI_FREE(hdr%pspso)
 946  end if
 947  if (allocated(hdr%pspxc)) then
 948    ABI_FREE(hdr%pspxc)
 949  end if
 950  if (allocated(hdr%so_psp)) then
 951    ABI_FREE(hdr%so_psp)
 952  end if
 953  if (allocated(hdr%symafm)) then
 954    ABI_FREE(hdr%symafm)
 955  end if
 956  if (allocated(hdr%symrel)) then
 957    ABI_FREE(hdr%symrel)
 958  end if
 959  if (allocated(hdr%typat)) then
 960    ABI_FREE(hdr%typat)
 961  end if
 962 
 963  !real
 964  if (allocated(hdr%amu)) then
 965    ABI_FREE(hdr%amu)
 966  end if
 967  if (allocated(hdr%kptns)) then
 968    ABI_FREE(hdr%kptns)
 969  end if
 970  if (allocated(hdr%occ)) then
 971    ABI_FREE(hdr%occ)
 972  end if
 973  if (allocated(hdr%tnons)) then
 974    ABI_FREE(hdr%tnons)
 975  end if
 976  if (allocated(hdr%wtk)) then
 977    ABI_FREE(hdr%wtk)
 978  end if
 979  if (allocated(hdr%shiftk)) then
 980    ABI_FREE(hdr%shiftk)
 981  end if
 982  if (allocated(hdr%shiftk_orig)) then
 983    ABI_FREE(hdr%shiftk_orig)
 984  end if
 985  if (allocated(hdr%xred)) then
 986    ABI_FREE(hdr%xred)
 987  end if
 988  if (allocated(hdr%zionpsp)) then
 989    ABI_FREE(hdr%zionpsp)
 990  end if
 991  if (allocated(hdr%znuclpsp)) then
 992    ABI_FREE(hdr%znuclpsp)
 993  end if
 994  if (allocated(hdr%znucltypat)) then
 995    ABI_FREE(hdr%znucltypat)
 996  end if
 997 
 998  !string arrays
 999  if (allocated(hdr%md5_pseudos)) then
1000    ABI_FREE(hdr%md5_pseudos)
1001  end if
1002  if(allocated(hdr%title)) then
1003    ABI_FREE(hdr%title)
1004  end if
1005 
1006  if (hdr%usepaw==1 .and. allocated(hdr%pawrhoij) ) then
1007    call pawrhoij_free(hdr%pawrhoij)
1008    ABI_DT_FREE(hdr%pawrhoij)
1009  end if
1010 
1011  DBG_EXIT("COLL")
1012 
1013 end subroutine hdr_free

m_hdr/hdr_get_occ3d [ Functions ]

[ Top ] [ m_hdr ] [ Functions ]

NAME

 hdr_get_occ3d

FUNCTION

  Return occupations in a 3d array with stride.

PARENTS

      m_hdr

CHILDREN

SOURCE

3746 subroutine hdr_get_occ3d(hdr, occ3d)
3747 
3748 
3749 !This section has been created automatically by the script Abilint (TD).
3750 !Do not modify the following lines by hand.
3751 #undef ABI_FUNC
3752 #define ABI_FUNC 'hdr_get_occ3d'
3753 !End of the abilint section
3754 
3755  implicit none
3756 
3757 !Arguments ------------------------------------
3758  type(hdr_type),intent(in) :: hdr
3759  real(dp),intent(out) :: occ3d(hdr%mband,hdr%nkpt,hdr%nsppol)
3760 
3761 !Local variables-------------------------------
3762 !scalars
3763  integer :: ii,band,ikpt,spin
3764 
3765 !*************************************************************************
3766 
3767  ii = 0; occ3d = huge(one)
3768  do spin=1,hdr%nsppol
3769    do ikpt=1,hdr%nkpt
3770      do band=1,hdr%nband(ikpt + (spin-1) * hdr%nkpt)
3771          ii = ii +1
3772          occ3d(band,ikpt,spin) = hdr%occ(ii)
3773      end do
3774    end do
3775  end do
3776 
3777 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
 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
 my_atomtab(:)=Index of the atoms (in global numbering ) treated by current proc (Optional)

OUTPUT

 hdr <type(hdr_type)>=the header, initialized, and for most part of
   it, contain its definite values, except for evolving variables

PARENTS

      dfpt_looppert,gstate,nonlinear,respfn,setup_bse,setup_screening
      setup_sigma

CHILDREN

SOURCE

792 subroutine hdr_init(ebands,codvsn,dtset,hdr,pawtab,pertcase,psps,wvl, &
793 &                   mpi_atmtab,comm_atom) ! optional arguments (parallelism)
794 
795 
796 !This section has been created automatically by the script Abilint (TD).
797 !Do not modify the following lines by hand.
798 #undef ABI_FUNC
799 #define ABI_FUNC 'hdr_init'
800 !End of the abilint section
801 
802  implicit none
803 
804 !Arguments ------------------------------------
805 !scalars
806  integer,intent(in) :: pertcase
807  integer,intent(in),optional :: comm_atom
808  character(len=6),intent(in) :: codvsn
809  type(ebands_t),intent(in) :: ebands
810  type(dataset_type),intent(in) :: dtset
811  type(hdr_type),intent(inout) :: hdr !vz_i
812  type(pseudopotential_type),intent(in) :: psps
813  type(wvl_internal_type),intent(in) :: wvl
814 !arrays
815  integer,optional,target,intent(in) :: mpi_atmtab(:)
816  type(pawtab_type),intent(in) :: pawtab(dtset%ntypat*psps%usepaw)
817 
818 !Local variables-------------------------------
819 !scalars
820  integer,parameter :: image=1
821  character(len=500) :: msg
822 
823 ! *************************************************************************
824 
825 #ifdef DEBUG_MODE
826  call test_abifiles()
827 #endif
828 
829  !@hdr_type
830 
831 ! More checking would be needed ...
832  if (dtset%ntypat/=psps%ntypat) then
833    write(msg,'(a,2(i0,2x))')' dtset%ntypat and psps%ntypat differs. They are: ',dtset%ntypat,psps%ntypat
834    MSG_ERROR(msg)
835  end if
836 
837  if (dtset%npsp/=psps%npsp) then
838    write(msg,'(a,2(i0,2x))')' dtset%npsp and psps%npsp differs. They are: ',dtset%npsp,psps%npsp
839    MSG_ERROR(msg)
840  end if
841 
842  ! Note: The structure parameters are taken from the first image!
843  if (present(comm_atom)) then
844    if (present(mpi_atmtab)) then
845      call hdr_init_lowlvl(hdr,ebands,psps,pawtab,wvl,codvsn,pertcase,&
846 &     dtset%natom,dtset%nsym,dtset%nspden,dtset%ecut,dtset%pawecutdg,dtset%ecutsm,dtset%dilatmx,&
847 &     dtset%intxc,dtset%ixc,dtset%stmbias,dtset%usewvl,dtset%pawcpxocc,dtset%pawspnorb,dtset%ngfft,dtset%ngfftdg,&
848 &     dtset%so_psp,dtset%qptn, dtset%rprimd_orig(:,:,image),dtset%xred_orig(:,:,image),&
849 &     dtset%symrel,dtset%tnons,dtset%symafm,dtset%typat,dtset%amu_orig(:,image),dtset%icoulomb,&
850 &     dtset%kptopt,dtset%nelect,dtset%charge,dtset%kptrlatt_orig,dtset%kptrlatt,&
851 &     dtset%nshiftk_orig,dtset%nshiftk,dtset%shiftk_orig,dtset%shiftk,&
852 &     comm_atom=comm_atom,mpi_atmtab=mpi_atmtab)
853    else
854      call hdr_init_lowlvl(hdr,ebands,psps,pawtab,wvl,codvsn,pertcase,&
855 &     dtset%natom,dtset%nsym,dtset%nspden,dtset%ecut,dtset%pawecutdg,dtset%ecutsm,dtset%dilatmx,&
856 &     dtset%intxc,dtset%ixc,dtset%stmbias,dtset%usewvl,dtset%pawcpxocc,dtset%pawspnorb,dtset%ngfft,dtset%ngfftdg,&
857 &     dtset%so_psp,dtset%qptn, dtset%rprimd_orig(:,:,image),dtset%xred_orig(:,:,image),&
858 &     dtset%symrel,dtset%tnons,dtset%symafm,dtset%typat,dtset%amu_orig(:,image),dtset%icoulomb,&
859 &     dtset%kptopt,dtset%nelect,dtset%charge,dtset%kptrlatt_orig,dtset%kptrlatt,&
860 &     dtset%nshiftk_orig,dtset%nshiftk,dtset%shiftk_orig,dtset%shiftk,&
861 &     comm_atom=comm_atom)
862    end if
863  else
864    call hdr_init_lowlvl(hdr,ebands,psps,pawtab,wvl,codvsn,pertcase,&
865 &   dtset%natom,dtset%nsym,dtset%nspden,dtset%ecut,dtset%pawecutdg,dtset%ecutsm,dtset%dilatmx,&
866 &   dtset%intxc,dtset%ixc,dtset%stmbias,dtset%usewvl,dtset%pawcpxocc,dtset%pawspnorb,dtset%ngfft,dtset%ngfftdg,&
867 &   dtset%so_psp,dtset%qptn, dtset%rprimd_orig(:,:,image),dtset%xred_orig(:,:,image),dtset%symrel,&
868 &   dtset%tnons,dtset%symafm,dtset%typat,dtset%amu_orig(:,image),dtset%icoulomb,&
869 &   dtset%kptopt,dtset%nelect,dtset%charge,dtset%kptrlatt_orig,dtset%kptrlatt,&
870 &   dtset%nshiftk_orig,dtset%nshiftk,dtset%shiftk_orig,dtset%shiftk)
871  end if
872 
873 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

PARENTS

      m_hdr,m_wfk

CHILDREN

SOURCE

1252 subroutine hdr_init_lowlvl(hdr,ebands,psps,pawtab,wvl,&
1253 &  codvsn,pertcase,natom,nsym,nspden,ecut,pawecutdg,ecutsm,dilatmx,&
1254 &  intxc,ixc,stmbias,usewvl,pawcpxocc,pawspnorb,ngfft,ngfftdg,so_psp,qptn,&
1255 &  rprimd,xred,symrel,tnons,symafm,typat,amu,icoulomb,&
1256 &  kptopt,nelect,charge,kptrlatt_orig,kptrlatt,&
1257 &  nshiftk_orig,nshiftk,shiftk_orig,shiftk,&
1258 &  mpi_atmtab,comm_atom) ! optional arguments (parallelism)
1259 
1260 
1261 !This section has been created automatically by the script Abilint (TD).
1262 !Do not modify the following lines by hand.
1263 #undef ABI_FUNC
1264 #define ABI_FUNC 'hdr_init_lowlvl'
1265 !End of the abilint section
1266 
1267  implicit none
1268 
1269 !Arguments ------------------------------------
1270 !scalars
1271  integer,intent(in) :: natom,nsym,nspden,intxc,ixc,usewvl,pawcpxocc,pawspnorb,pertcase
1272  integer,intent(in) :: kptopt,nshiftk_orig,nshiftk,icoulomb
1273  integer, intent(in),optional :: comm_atom
1274  real(dp),intent(in) :: ecut,ecutsm,dilatmx,stmbias,pawecutdg,nelect,charge
1275  character(len=6),intent(in) :: codvsn
1276  type(ebands_t),intent(in) :: ebands
1277  type(pseudopotential_type),intent(in) :: psps
1278  type(wvl_internal_type),intent(in) :: wvl
1279  type(hdr_type),intent(inout) :: hdr
1280 !arrays
1281  integer,intent(in) :: typat(natom)
1282  integer,intent(in) :: so_psp(psps%npsp)
1283  integer,intent(in) :: symrel(3,3,nsym),symafm(nsym)
1284  integer,intent(in) :: ngfft(18),ngfftdg(18),kptrlatt_orig(3,3),kptrlatt(3,3)
1285  integer,optional,target,intent(in) :: mpi_atmtab(:)
1286  real(dp),intent(in) :: tnons(3,nsym),amu(psps%ntypat)
1287  real(dp),intent(in) :: qptn(3) ! the wavevector, in case of a perturbation
1288  real(dp),intent(in) :: rprimd(3,3),xred(3,natom)
1289  real(dp),intent(in) :: shiftk_orig(3,nshiftk_orig),shiftk(3,nshiftk)
1290  type(pawtab_type),intent(in) :: pawtab(psps%ntypat*psps%usepaw)
1291 
1292 !Local variables-------------------------------
1293 !scalars
1294  integer :: bantot,date,nkpt,npsp,ntypat,nsppol,nspinor,nspden_rhoij
1295  integer :: idx,isppol,ikpt,iband,ipsp
1296  character(len=8) :: date_time
1297 
1298 ! *************************************************************************
1299 
1300  !@hdr_type
1301  call date_and_time(date_time)
1302  read(date_time,'(i8)')date
1303 
1304  npsp   = psps%npsp
1305  ntypat = psps%ntypat
1306  nkpt   = ebands%nkpt
1307  nsppol = ebands%nsppol
1308  nspinor= ebands%nspinor
1309  bantot = ebands%bantot
1310 
1311 !Transfer dimensions and other scalars to hdr.
1312  hdr%intxc    =intxc
1313  hdr%ixc      =ixc
1314  hdr%natom    =natom
1315  hdr%npsp     =npsp
1316  hdr%nspden   =nspden
1317  hdr%nspinor  =nspinor
1318  hdr%nsym     =nsym
1319  hdr%ntypat   =ntypat
1320  hdr%bantot   =bantot
1321  hdr%nkpt     =nkpt
1322  hdr%nshiftk_orig = nshiftk_orig
1323  hdr%nshiftk = nshiftk
1324  hdr%nsppol   =nsppol
1325  hdr%usepaw   =psps%usepaw
1326  hdr%usewvl   =usewvl !hdr%nwvlarr will be set later since the number !of wavelets have not yet been computed.
1327  hdr%occopt   =ebands%occopt
1328  hdr%codvsn   =codvsn
1329  hdr%date     =date
1330  hdr%headform =HDR_LATEST_HEADFORM ! Initialize with the latest headform
1331  hdr%pertcase =pertcase
1332  hdr%ecut     =ecut
1333  hdr%ecutsm   =ecutsm
1334  hdr%ecut_eff =ecut * (dilatmx)**2
1335  hdr%stmbias  =stmbias
1336  hdr%tphysel  =ebands%tphysel
1337  hdr%tsmear   =ebands%tsmear
1338  hdr%qptn     =qptn
1339  hdr%rprimd   =rprimd      ! Evolving data
1340 
1341 !Default for other data  (all evolving data)
1342  hdr%etot     =1.0d20
1343  hdr%fermie   =1.0d20
1344  hdr%residm   =1.0d20
1345 
1346 ! Allocate all components of hdr
1347  call hdr_malloc(hdr, hdr%bantot, hdr%nkpt, hdr%nsppol, hdr%npsp, hdr%natom, hdr%ntypat,&
1348                  hdr%nsym, hdr%nshiftk_orig, hdr%nshiftk)
1349 
1350 !Transfer data from ebands
1351  hdr%istwfk(1:nkpt) = ebands%istwfk(1:nkpt)
1352  hdr%kptns(:,:) = ebands%kptns(:,:)
1353  hdr%nband(1:nkpt*nsppol)=ebands%nband(1:nkpt*nsppol); hdr%mband = maxval(hdr%nband)
1354  hdr%npwarr(:) = ebands%npwarr(:)
1355  hdr%wtk(:) = ebands%wtk(:)
1356 
1357 !Transfer data from psps
1358  hdr%pspcod    =psps%pspcod
1359  hdr%pspdat    =psps%pspdat
1360  hdr%pspso     =psps%pspso
1361  hdr%pspxc     =psps%pspxc
1362  hdr%znuclpsp  =psps%znuclpsp
1363  hdr%znucltypat=psps%znucltypat
1364  hdr%zionpsp   =psps%zionpsp
1365  do ipsp=1,psps%npsp
1366    write(hdr%title(ipsp), "(A)") psps%title(ipsp)(1:132)
1367  end do
1368  hdr%md5_pseudos = psps%md5_pseudos
1369 
1370  hdr%so_psp=so_psp
1371  hdr%symafm(1:min(size(symafm),size(hdr%symafm)))=symafm(1:min(size(symafm),size(hdr%symafm)))
1372  hdr%symrel(:,:,1:min(size(symrel,3),size(hdr%symrel,3))) =symrel(:,:,1:min(size(symrel,3),size(hdr%symrel,3)))
1373  hdr%tnons(:,1:min(size(tnons,2),size(hdr%tnons,2)))=tnons(:,1:min(size(tnons,2),size(hdr%tnons,2)))
1374 
1375  hdr%typat(1:natom) =typat(1:natom)  ! PMA : in tests/v2/t11 size(dtset%typat) is bigger dtset%natom
1376  hdr%xred(:,1:natom)=xred(:,1:natom) ! Evolving data
1377 
1378  hdr%kptopt = kptopt
1379  hdr%pawcpxocc = pawcpxocc
1380  hdr%nelect = nelect
1381  hdr%charge = charge
1382  hdr%kptrlatt_orig = kptrlatt_orig
1383  hdr%kptrlatt = kptrlatt
1384  hdr%shiftk_orig = shiftk_orig(:, 1:hdr%nshiftk_orig)
1385  hdr%shiftk = shiftk
1386  hdr%icoulomb = icoulomb
1387  hdr%amu = amu
1388 
1389  if (psps%usepaw==1)then
1390    nspden_rhoij=pawrhoij_get_nspden(nspden,nspinor,pawspnorb)
1391    ABI_DT_MALLOC(hdr%pawrhoij,(natom))
1392    !Values of nspden/nspinor/nsppol are dummy ones; they are overwritten later (by hdr_update)
1393    if (present(comm_atom)) then
1394      if (present(mpi_atmtab)) then
1395        call pawrhoij_alloc(hdr%pawrhoij,pawcpxocc,nspden_rhoij,nspinor,nsppol,typat, &
1396 &                       pawtab=pawtab,comm_atom=comm_atom,mpi_atmtab=mpi_atmtab)
1397      else
1398        call pawrhoij_alloc(hdr%pawrhoij,pawcpxocc,nspden_rhoij,nspinor,nsppol,typat, &
1399 &                       pawtab=pawtab,comm_atom=comm_atom)
1400      end if
1401    else
1402      call pawrhoij_alloc(hdr%pawrhoij,pawcpxocc,nspden_rhoij,nspinor,nsppol,typat,pawtab=pawtab)
1403    end if
1404  end if
1405 
1406  if (psps%usepaw==1 .and. usewvl ==0 ) then
1407    hdr%ngfft(:) =ngfftdg(1:3)
1408  else if (usewvl==1) then
1409 #if defined HAVE_BIGDFT
1410    hdr%ngfft(:) = (/ wvl%Glr%d%n1i, wvl%Glr%d%n2i, wvl%Glr%d%n3i /)
1411 #else
1412  BIGDFT_NOTENABLED_ERROR()
1413 #endif
1414  else
1415    hdr%ngfft(:) =ngfft(1:3)
1416  end if
1417 
1418 !Transfer paw data
1419  if(psps%usepaw==1) then
1420    hdr%ecutdg   =pawecutdg
1421    hdr%lmn_size(1:npsp)=pawtab(1:npsp)%lmn_size
1422  else
1423    hdr%ecutdg=hdr%ecut
1424    hdr%lmn_size(:)=psps%lmnmax
1425  end if
1426 
1427  hdr%occ(:)=zero; idx=0
1428  do isppol=1,nsppol
1429    do ikpt=1,nkpt
1430      do iband=1,hdr%nband(ikpt+(isppol-1)*nkpt)
1431        idx=idx+1
1432        hdr%occ(idx)=ebands%occ(iband,ikpt,isppol)
1433      end do
1434    end do
1435  end do
1436 
1437  ABI_UNUSED(wvl%h(1))
1438 
1439 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

PARENTS

      m_hdr

CHILDREN

SOURCE

2012 subroutine hdr_io_int(fform,hdr,rdwr,unitfi)
2013 
2014 
2015 !This section has been created automatically by the script Abilint (TD).
2016 !Do not modify the following lines by hand.
2017 #undef ABI_FUNC
2018 #define ABI_FUNC 'hdr_io_int'
2019 !End of the abilint section
2020 
2021  implicit none
2022 
2023 !Arguments ------------------------------------
2024  integer,intent(inout) :: fform
2025  integer,intent(in) :: rdwr,unitfi
2026  type(hdr_type),intent(inout) :: hdr
2027 
2028 !Local variables-------------------------------
2029  integer :: ierr
2030 
2031 !*************************************************************************
2032 
2033  DBG_ENTER("COLL")
2034 
2035  select case(rdwr)
2036  case (1, 5)
2037    ! Reading the header of an unformatted file
2038     call hdr_fort_read(Hdr,unitfi,fform,rewind=(rdwr==1))
2039 
2040  case (2, 6)
2041    ! Writing the header of an unformatted file
2042    call hdr_fort_write(Hdr,unitfi,fform,ierr,rewind=(rdwr==2))
2043 
2044  case (3, 4)
2045    !  Writing the header of a formatted file
2046    call hdr_echo(Hdr,fform,rdwr,unit=unitfi)
2047  case default
2048    MSG_ERROR(sjoin("Wrong value for rdwr: ",itoa(rdwr)))
2049  end select
2050 
2051  DBG_EXIT("COLL")
2052 
2053 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

PARENTS

CHILDREN

SOURCE

1893 subroutine hdr_io_wfftype(fform,hdr,rdwr,wff)
1894 
1895 
1896 !This section has been created automatically by the script Abilint (TD).
1897 !Do not modify the following lines by hand.
1898 #undef ABI_FUNC
1899 #define ABI_FUNC 'hdr_io_wfftype'
1900 !End of the abilint section
1901 
1902  implicit none
1903 
1904 !Arguments ------------------------------------
1905  integer,intent(inout) :: fform
1906  integer,intent(in) :: rdwr
1907  type(hdr_type),intent(inout) :: hdr
1908  type(wffile_type),intent(inout) :: wff
1909 
1910 !Local variables-------------------------------
1911 #if defined HAVE_MPI
1912  integer :: ierr
1913 #endif
1914 
1915 ! *************************************************************************
1916 
1917  DBG_ENTER("COLL")
1918 
1919  if ( wff%iomode==IO_MODE_FORTRAN .or. &
1920 & (wff%iomode==IO_MODE_FORTRAN_MASTER .and.wff%master==wff%me).or. &
1921 & (wff%iomode==IO_MODE_MPI  .and.wff%master==wff%me)    ) then
1922    call hdr_io_int(fform,hdr,rdwr,wff%unwff)
1923    ! Master node **MUST** flush the output buffer so that the
1924    ! other nodes can read headform and therefore the Fortran marker length when MPI-IO is used
1925    if (rdwr == 2) then
1926      call flush_unit(wff%unwff)
1927    end if
1928  end if
1929 
1930 #if defined HAVE_MPI
1931 !In the parallel case, if the files were not local, need to bcast the data
1932  if(rdwr==1)then
1933    if (wff%iomode==IO_MODE_FORTRAN_MASTER .or. wff%iomode==IO_MODE_MPI) then
1934      if (wff%spaceComm/=MPI_COMM_SELF) then
1935        call MPI_BCAST(fform,1,MPI_INTEGER,wff%master,wff%spaceComm,ierr)
1936        call hdr_bcast(hdr,wff%master,wff%me,wff%spaceComm)
1937      end if
1938      wff%headform=hdr%headform
1939      if(wff%iomode==IO_MODE_MPI)then
1940        call hdr_skip_wfftype(wff,ierr)
1941      end if
1942    end if
1943  end if
1944 #if defined HAVE_MPI_IO
1945  if (rdwr == 2 .and. wff%iomode==IO_MODE_MPI) then
1946    if (wff%spaceComm/=MPI_COMM_SELF) then
1947      call xmpi_barrier(wff%spaceComm)
1948    end if
1949    wff%headform=hdr%headform
1950    call hdr_skip_wfftype(wff,ierr)
1951  end if
1952 #endif
1953  if (rdwr==5) wff%headform=hdr%headform
1954 #else
1955  if (rdwr==1.or.rdwr==5) wff%headform=hdr%headform
1956 #endif
1957 
1958  DBG_EXIT("COLL")
1959 
1960 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 used hdr_init, hdr_fort_read ...

PARENTS

      m_hdr

CHILDREN

SOURCE

710 subroutine hdr_malloc(hdr, bantot, nkpt, nsppol, npsp, natom, ntypat, nsym, nshiftk_orig, nshiftk)
711 
712 
713 !This section has been created automatically by the script Abilint (TD).
714 !Do not modify the following lines by hand.
715 #undef ABI_FUNC
716 #define ABI_FUNC 'hdr_malloc'
717 !End of the abilint section
718 
719  implicit none
720 
721 !Arguments ---------------------------------------------
722 !scalars
723  integer,intent(in) :: bantot,nkpt,nsppol,npsp,natom,ntypat,nsym,nshiftk,nshiftk_orig
724  type(hdr_type),intent(inout) :: hdr
725 ! *************************************************************************
726 
727  !@hdt_type
728  call hdr_free(hdr)
729 
730  ABI_MALLOC(hdr%istwfk, (nkpt))
731  ABI_MALLOC(hdr%nband, (nkpt*nsppol))
732  ABI_MALLOC(hdr%npwarr, (nkpt))
733  ABI_MALLOC(hdr%pspcod, (npsp))
734  ABI_MALLOC(hdr%pspdat, (npsp))
735  ABI_MALLOC(hdr%pspso, (npsp))
736  ABI_MALLOC(hdr%pspxc, (npsp))
737  ABI_MALLOC(hdr%lmn_size, (npsp))
738  ABI_MALLOC(hdr%so_psp, (npsp))
739  ABI_MALLOC(hdr%symafm, (nsym))
740  ABI_MALLOC(hdr%symrel, (3,3,nsym))
741  ABI_MALLOC(hdr%typat, (natom))
742  ABI_MALLOC(hdr%kptns, (3,nkpt))
743  ABI_MALLOC(hdr%occ, (bantot))
744  ABI_MALLOC(hdr%tnons, (3,nsym))
745  ABI_MALLOC(hdr%wtk, (nkpt))
746  ABI_MALLOC(hdr%xred, (3,natom))
747  ABI_MALLOC(hdr%zionpsp, (npsp))
748  ABI_MALLOC(hdr%znuclpsp, (npsp))
749  ABI_MALLOC(hdr%znucltypat, (ntypat))
750  ABI_MALLOC(hdr%title, (npsp))
751  ABI_MALLOC(hdr%shiftk, (3,nshiftk))
752  ABI_MALLOC(hdr%shiftk_orig, (3,nshiftk_orig))
753  ABI_MALLOC(hdr%md5_pseudos, (npsp))
754  ABI_MALLOC(hdr%amu, (ntypat))
755 
756 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

1638 subroutine hdr_mpio_skip(mpio_fh,fform,offset)
1639 
1640 
1641 !This section has been created automatically by the script Abilint (TD).
1642 !Do not modify the following lines by hand.
1643 #undef ABI_FUNC
1644 #define ABI_FUNC 'hdr_mpio_skip'
1645 !End of the abilint section
1646 
1647  implicit none
1648 
1649 !Arguments ------------------------------------
1650  integer,intent(in) :: mpio_fh
1651  integer,intent(out) :: fform
1652  integer(kind=XMPI_OFFSET_KIND),intent(out) :: offset
1653 
1654 !Local variables-------------------------------
1655 !scalars
1656  integer :: bsize_frm,mpi_type_frm
1657 #ifdef HAVE_MPI_IO
1658  integer :: headform,ierr,mu,usepaw,npsp
1659 !arrays
1660  integer(kind=MPI_OFFSET_KIND) :: fmarker,positloc
1661  integer :: statux(MPI_STATUS_SIZE)
1662 #endif
1663  character(len=500) :: msg
1664 
1665 ! *************************************************************************
1666 
1667  !@hdr_type
1668  offset = 0; fform  = 0
1669 
1670  bsize_frm    = xmpio_bsize_frm    ! bsize_frm= Byte length of the Fortran record marker.
1671  mpi_type_frm = xmpio_mpi_type_frm ! MPI type of the record marker.
1672 
1673 #ifdef HAVE_MPI_IO
1674 !Reading the first record of the file -------------------------------------
1675 !read (unitfi)   codvsn,headform,..............
1676  positloc = bsize_frm + 6*xmpi_bsize_ch
1677  call MPI_FILE_READ_AT(mpio_fh,positloc,fform,1,MPI_INTEGER,statux,ierr)
1678 
1679  if (ANY(fform == [1,2,51,52,101,102] )) then
1680    ! This is the old format !read (unitfi) codvsn,fform
1681    headform=22
1682    write(msg,'(3a,i0,4a)')&
1683      "ABINIT version: ",trim(abinit_version)," cannot read old files with headform: ",headform,ch10,&
1684      "produced by previous versions. Use an old ABINIT version to read this file or ",ch10,&
1685      "regenerate your files with version >= 8.0."
1686    MSG_ERROR(msg)
1687 
1688  else
1689    !read (unitfi)codvsn,headform,fform
1690    call MPI_FILE_READ_AT(mpio_fh,positloc,headform,1,MPI_INTEGER,statux,ierr)
1691    positloc = positloc + xmpi_bsize_int
1692    call MPI_FILE_READ_AT(mpio_fh,positloc,fform,1,MPI_INTEGER,statux,ierr)
1693  end if
1694 
1695  if (headform < 80) then
1696    write(msg,'(3a,i0,4a)')&
1697      "ABINIT version: ",trim(abinit_version)," cannot read old files with headform: ",headform,ch10,&
1698      "produced by previous versions. Use an old ABINIT version to read this file or ",ch10,&
1699      "regenerate your files with version >= 8.0."
1700    MSG_ERROR(msg)
1701  end if
1702 
1703  ! Skip first record.
1704  call xmpio_read_frm(mpio_fh,offset,xmpio_single,fmarker,ierr)
1705 
1706 !Read npsp and usepaw from the second record and skip it
1707  positloc  = offset + bsize_frm + xmpi_bsize_int*13
1708  call MPI_FILE_READ_AT(mpio_fh,positloc,npsp,1,MPI_INTEGER,statux,ierr)
1709  positloc = positloc +  xmpi_bsize_int*4
1710  call MPI_FILE_READ_AT(mpio_fh,positloc,usepaw,1,MPI_INTEGER,statux,ierr)
1711  call xmpio_read_frm(mpio_fh,offset,xmpio_single,fmarker,ierr)
1712 
1713  ! Skip the rest of the file ---------------------------------------------
1714  do mu=1,3+npsp
1715    call xmpio_read_frm(mpio_fh,offset,xmpio_single,fmarker,ierr)
1716  end do
1717 
1718  if (usepaw == 1) then ! skip rhoij records.
1719    call xmpio_read_frm(mpio_fh,offset,xmpio_single,fmarker,ierr)
1720    call xmpio_read_frm(mpio_fh,offset,xmpio_single,fmarker,ierr)
1721  end if
1722 
1723 #else
1724  MSG_ERROR("hdr_mpio_skip cannot be used when MPI-IO is not enabled")
1725  ABI_UNUSED(mpio_fh)
1726 #endif
1727 
1728 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

PARENTS

      initaim,inwffil,m_ddk,m_dvdb,m_hdr,m_io_screening,m_ioarr,macroave

CHILDREN

SOURCE

3031 subroutine hdr_ncread(Hdr,ncid,fform)
3032 
3033 
3034 !This section has been created automatically by the script Abilint (TD).
3035 !Do not modify the following lines by hand.
3036 #undef ABI_FUNC
3037 #define ABI_FUNC 'hdr_ncread'
3038 !End of the abilint section
3039 
3040  implicit none
3041 
3042 !Arguments ------------------------------------
3043 !scalars
3044  integer,intent(in) :: ncid
3045  integer,intent(out) :: fform
3046  type(hdr_type),target,intent(out) :: hdr
3047 
3048 #ifdef HAVE_NETCDF
3049 !Local variables-------------------------------
3050 !scalars
3051  integer :: nresolution,itypat
3052  character(len=500) :: msg
3053 !arrays
3054  integer,allocatable :: nband2d(:,:)
3055  real(dp),allocatable :: occ3d(:,:,:)
3056 
3057 ! *************************************************************************
3058 
3059  !@hdr_type
3060  NCF_CHECK(nctk_set_datamode(ncid))
3061  NCF_CHECK(nf90_get_var(ncid, vid("fform"), fform))
3062  NCF_CHECK(nf90_get_var(ncid, vid("headform"), hdr%headform))
3063 
3064  if (hdr%headform < 80) then
3065    write(msg,'(3a,i0,4a)')&
3066      "ABINIT version: ",trim(abinit_version)," cannot read old files with headform: ",hdr%headform,ch10,&
3067      "produced by previous versions. Use an old ABINIT version to read this file or ",ch10,&
3068      "regenerate your files with version >= 8.0."
3069    MSG_ERROR(msg)
3070  end if
3071 
3072  call check_fform(fform)
3073 
3074  ! First, we read the declaration of code, fform ...
3075  ! pad the returned string with " " instead of "\0"
3076  NCF_CHECK(nf90_get_var(ncid, vid("codvsn"), hdr%codvsn))
3077  call replace_ch0(hdr%codvsn)
3078 
3079  ! Get ETSF dimensions
3080  NCF_CHECK(nctk_get_dim(ncid, "number_of_atoms", hdr%natom))
3081  NCF_CHECK(nctk_get_dim(ncid, "number_of_kpoints", hdr%nkpt))
3082  NCF_CHECK(nctk_get_dim(ncid, "number_of_components", hdr%nspden))
3083  NCF_CHECK(nctk_get_dim(ncid, "number_of_spinor_components", hdr%nspinor))
3084  NCF_CHECK(nctk_get_dim(ncid, "number_of_spins", hdr%nsppol))
3085  NCF_CHECK(nctk_get_dim(ncid, "number_of_symmetry_operations", hdr%nsym))
3086  NCF_CHECK(nctk_get_dim(ncid, "number_of_atom_species", hdr%ntypat))
3087  NCF_CHECK(nctk_get_dim(ncid, "number_of_grid_points_vector1", hdr%ngfft(1)))
3088  NCF_CHECK(nctk_get_dim(ncid, "number_of_grid_points_vector2", hdr%ngfft(2)))
3089  NCF_CHECK(nctk_get_dim(ncid, "number_of_grid_points_vector3", hdr%ngfft(3)))
3090  NCF_CHECK(nctk_get_dim(ncid, "max_number_of_states", hdr%mband))
3091 ! bantot is used to dimension %occ in hdr_malloc. Note that hdr%bantot != sum(nband) because states
3092 ! are packed in hdr%occ and therefore bantot <= hdr%mband * hdr%nkpt * hdr%nsppol
3093  NCF_CHECK(nctk_get_dim(ncid, "bantot", hdr%bantot))
3094 
3095  ! Read other dimensions, not handled by ETSF format.
3096  NCF_CHECK(nctk_get_dim(ncid, "npsp", hdr%npsp))
3097  NCF_CHECK(nctk_get_dim(ncid, "nshiftk_orig", hdr%nshiftk_orig))
3098  NCF_CHECK(nctk_get_dim(ncid, "nshiftk", hdr%nshiftk))
3099 
3100  ! Read other important scalar variables.
3101  NCF_CHECK(nf90_get_var(ncid, vid("usepaw"), hdr%usepaw))
3102  NCF_CHECK(nf90_get_var(ncid, vid("usewvl"), hdr%usewvl))
3103 
3104  nresolution=0
3105  if (hdr%usewvl == 1) then
3106    ! This value must be 2...
3107    NCF_CHECK(nctk_get_dim(ncid, "number_of_wavelet_resolutions", nresolution))
3108    ! We set the right ngfft, adding the padding space for wavelets.
3109    hdr%ngfft = hdr%ngfft + 31
3110  end if
3111 
3112  ! Allocate all parts of hdr that need to be
3113  call hdr_malloc(hdr, hdr%bantot, hdr%nkpt, hdr%nsppol, hdr%npsp, hdr%natom, hdr%ntypat,&
3114                  hdr%nsym, hdr%nshiftk_orig, hdr%nshiftk)
3115 
3116  ABI_MALLOC(nband2d, (hdr%nkpt, hdr%nsppol))
3117  NCF_CHECK(nf90_get_var(ncid, vid("number_of_states"), nband2d))
3118  hdr%nband(:) = reshape(nband2d, [hdr%nkpt*hdr%nsppol])
3119  ABI_FREE(nband2d)
3120  ABI_CHECK(hdr%mband == maxval(hdr%nband), "mband != maxval(hdr_in%nband)")
3121 
3122  if (hdr%usepaw==1) then
3123    ABI_DT_MALLOC(hdr%pawrhoij,(hdr%natom))
3124  end if
3125 
3126 !We get then all variables included in ETSF
3127  if (hdr%usewvl==0) then
3128    NCF_CHECK(nf90_get_var(ncid, vid("kinetic_energy_cutoff"), hdr%ecut))
3129    NCF_CHECK(nf90_get_var(ncid, vid("number_of_coefficients"), hdr%npwarr))
3130  else
3131    NCF_CHECK(nf90_get_var(ncid, vid("number_of_wavelets"), hdr%nwvlarr))
3132  end if
3133 
3134 ! read 3d matrix with stride and transfer to (stupid) 1d hdr%occ in packed form.
3135  ABI_CALLOC(occ3d, (hdr%mband, hdr%nkpt, hdr%nsppol))
3136  NCF_CHECK(nf90_get_var(ncid, vid("occupations"), occ3d))
3137  call hdr_set_occ(hdr, occ3d)
3138  ABI_FREE(occ3d)
3139 
3140  NCF_CHECK(nf90_get_var(ncid, vid("fermi_energy"), hdr%fermie))
3141  NCF_CHECK(nf90_get_var(ncid, vid("primitive_vectors"), hdr%rprimd))
3142  NCF_CHECK(nf90_get_var(ncid, vid("reduced_symmetry_matrices"), hdr%symrel))
3143  NCF_CHECK(nf90_get_var(ncid, vid("atom_species"), hdr%typat))
3144  NCF_CHECK(nf90_get_var(ncid, vid("reduced_symmetry_translations"), hdr%tnons))
3145  NCF_CHECK(nf90_get_var(ncid, vid("reduced_atom_positions"), hdr%xred))
3146  NCF_CHECK(nf90_get_var(ncid, vid("atomic_numbers"), hdr%znucltypat))
3147  NCF_CHECK(nf90_get_var(ncid, vid("reduced_coordinates_of_kpoints"), hdr%kptns))
3148  NCF_CHECK(nf90_get_var(ncid, vid("kpoint_weights"), hdr%wtk))
3149  NCF_CHECK(nf90_get_var(ncid, vid("date"), hdr%date))
3150  NCF_CHECK(nf90_get_var(ncid, vid("ecut_eff"), hdr%ecut_eff))
3151  NCF_CHECK(nf90_get_var(ncid, vid("ecutsm"), hdr%ecutsm))
3152  NCF_CHECK(nf90_get_var(ncid, vid("etot"), hdr%etot))
3153  NCF_CHECK(nf90_get_var(ncid, vid("intxc"), hdr%intxc))
3154  NCF_CHECK(nf90_get_var(ncid, vid("ixc"), hdr%ixc))
3155  NCF_CHECK(nf90_get_var(ncid, vid("occopt"), hdr%occopt))
3156  NCF_CHECK(nf90_get_var(ncid, vid("pertcase"), hdr%pertcase))
3157  NCF_CHECK(nf90_get_var(ncid, vid("qptn"), hdr%qptn))
3158  NCF_CHECK(nf90_get_var(ncid, vid("residm"), hdr%residm))
3159  NCF_CHECK(nf90_get_var(ncid, vid("stmbias"), hdr%stmbias))
3160  NCF_CHECK(nf90_get_var(ncid, vid("tphysel"), hdr%tphysel))
3161  NCF_CHECK(nf90_get_var(ncid, vid("tsmear"), hdr%tsmear))
3162  NCF_CHECK(nf90_get_var(ncid, vid("ecutdg"), hdr%ecutdg))
3163 
3164 ! Multidimensional variables. Be careful with zionpsp if alchemical mixing!
3165  NCF_CHECK(nf90_get_var(ncid, vid("istwfk"), hdr%istwfk))
3166  NCF_CHECK(nf90_get_var(ncid, vid("pspcod"), hdr%pspcod))
3167  NCF_CHECK(nf90_get_var(ncid, vid("pspdat"), hdr%pspdat))
3168  NCF_CHECK(nf90_get_var(ncid, vid("pspso"), hdr%pspso))
3169  NCF_CHECK(nf90_get_var(ncid, vid("pspxc"), hdr%pspxc))
3170  NCF_CHECK(nf90_get_var(ncid, vid("so_psp"), hdr%so_psp))
3171  NCF_CHECK(nf90_get_var(ncid, vid("symafm"), hdr%symafm))
3172  NCF_CHECK(nf90_get_var(ncid, vid("zionpsp"), hdr%zionpsp))
3173  NCF_CHECK(nf90_get_var(ncid, vid("znuclpsp"), hdr%znuclpsp))
3174  NCF_CHECK(nf90_get_var(ncid, vid("kptopt"), hdr%kptopt))
3175  NCF_CHECK(nf90_get_var(ncid, vid("pawcpxocc"), hdr%pawcpxocc))
3176  NCF_CHECK(nf90_get_var(ncid, vid("nelect"), hdr%nelect))
3177  NCF_CHECK(nf90_get_var(ncid, vid("charge"), hdr%charge))
3178  NCF_CHECK(nf90_get_var(ncid, vid("kptrlatt_orig"), hdr%kptrlatt_orig))
3179  NCF_CHECK(nf90_get_var(ncid, vid("kptrlatt"), hdr%kptrlatt))
3180  NCF_CHECK(nf90_get_var(ncid, vid("shiftk_orig"), hdr%shiftk_orig))
3181  NCF_CHECK(nf90_get_var(ncid, vid("shiftk"), hdr%shiftk))
3182  NCF_CHECK(nf90_get_var(ncid, vid("md5_pseudos"), hdr%md5_pseudos))
3183  NCF_CHECK(nf90_get_var(ncid, vid("amu"), hdr%amu))
3184  NCF_CHECK(nf90_get_var(ncid, vid("icoulomb"), hdr%icoulomb))
3185  NCF_CHECK(nf90_get_var(ncid, vid("title"), hdr%title))
3186 
3187  ! Pad the returned string with " " instead of "\0"
3188  do itypat=1,size(hdr%title)
3189    call replace_ch0(hdr%title(itypat))
3190  end do
3191 
3192  NCF_CHECK(nf90_get_var(ncid, vid("lmn_size"), hdr%lmn_size))
3193  if (hdr%usepaw==1) then
3194    call pawrhoij_io(hdr%pawrhoij,ncid,hdr%nsppol,hdr%nspinor,hdr%nspden,hdr%lmn_size,hdr%typat,&
3195       hdr%headform,"Read",form="netcdf")
3196  end if
3197 
3198 #else
3199  MSG_ERROR("netcdf support not activated")
3200 #endif
3201 
3202 contains
3203  integer function vid(vname)
3204 
3205 !This section has been created automatically by the script Abilint (TD).
3206 !Do not modify the following lines by hand.
3207 #undef ABI_FUNC
3208 #define ABI_FUNC 'vid'
3209 !End of the abilint section
3210 
3211    character(len=*),intent(in) :: vname
3212    vid = nctk_idname(ncid, vname)
3213  end function vid
3214 
3215 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.
  [nc_define]=Optional flag. If True, the basic dimensions required by the ETSF specification
    are written. Default: False.

OUTPUT

  Only writing

PARENTS

      ioarr,m_hdr,m_wfk

CHILDREN

SOURCE

3350 integer function hdr_ncwrite(hdr, ncid, fform, nc_define) result(ncerr)
3351 
3352 
3353 !This section has been created automatically by the script Abilint (TD).
3354 !Do not modify the following lines by hand.
3355 #undef ABI_FUNC
3356 #define ABI_FUNC 'hdr_ncwrite'
3357 !End of the abilint section
3358 
3359  implicit none
3360 
3361 !Arguments ------------------------------------
3362 !scalars
3363  integer,intent(in) :: ncid,fform
3364  logical,optional,intent(in) :: nc_define
3365  type(hdr_type),target,intent(in) :: hdr
3366 
3367 #ifdef HAVE_NETCDF
3368 !Local variables-------------------------------
3369 !scalars
3370  logical :: my_define
3371  character(len=etsfio_charlen) :: basis_set,k_dependent,symmorphic
3372  !character(len=500) :: msg
3373 !arrays
3374  integer,allocatable :: arr2d(:,:)
3375  real(dp),allocatable :: arr3d(:,:,:)
3376  type(pawrhoij_type),pointer :: rhoij_ptr(:)
3377 
3378 ! *************************************************************************
3379 
3380  call check_fform(fform)
3381 
3382  !@hdr_type
3383  my_define = .False.; if (present(nc_define)) my_define = nc_define
3384  ncerr = nf90_noerr
3385 
3386  k_dependent = "no"; if (any(hdr%nband(1) /= hdr%nband)) k_dependent = "yes"
3387  symmorphic = "no"; if (all(abs(hdr%tnons) < tol6)) symmorphic = "yes"
3388 
3389  if (my_define) then
3390    !call wrtout(std_out, "hdr_ncwrite: defining variables")
3391    NCF_CHECK(nctk_def_basedims(ncid, defmode=.True.))
3392 
3393    ncerr = nctk_def_dims(ncid, [ &
3394      nctkdim_t("max_number_of_states", hdr%mband), &
3395      nctkdim_t("number_of_atoms", hdr%natom), &
3396      nctkdim_t("number_of_atom_species", hdr%ntypat), &
3397      nctkdim_t("number_of_components", hdr%nspden), &
3398      nctkdim_t("number_of_kpoints", hdr%nkpt), &
3399      nctkdim_t("number_of_spinor_components", hdr%nspinor), &
3400      nctkdim_t("number_of_spins", hdr%nsppol), &
3401      nctkdim_t("number_of_symmetry_operations", hdr%nsym) &
3402    ])
3403      !nctkdim_t("nshiftk_orig", ebands%nshiftk_orig), &
3404      !nctkdim_t("nshiftk", ebands%nshiftk)], &
3405    NCF_CHECK(ncerr)
3406 
3407    ! Define part of geometry section contained in the header.
3408    ncerr = nctk_def_arrays(ncid, [ &
3409     ! Atomic structure and symmetry operations
3410     nctkarr_t("primitive_vectors", "dp", "number_of_cartesian_directions, number_of_vectors"), &
3411     nctkarr_t("reduced_symmetry_matrices", "int", &
3412       "number_of_reduced_dimensions, number_of_reduced_dimensions, number_of_symmetry_operations"), &
3413     nctkarr_t("reduced_symmetry_translations", "dp", "number_of_reduced_dimensions, number_of_symmetry_operations"), &
3414     nctkarr_t("atom_species", "int", "number_of_atoms"), &
3415     nctkarr_t("reduced_atom_positions", "dp", "number_of_reduced_dimensions, number_of_atoms"), &
3416     nctkarr_t("atomic_numbers", "dp", "number_of_atom_species") &
3417     !nctkarr_t("atom_species_names", "char", "character_string_length, number_of_atom_species"), &
3418     !nctkarr_t("chemical_symbols", "char", "symbol_length, number_of_atom_species"), &
3419     ! Atomic information.
3420     !nctkarr_t("valence_charges", "dp", "number_of_atom_species"), &  ! NB: This variable is not written if alchemical
3421     !nctkarr_t("pseudopotential_types", "char", "character_string_length, number_of_atom_species") &
3422    ])
3423    NCF_CHECK(ncerr)
3424 
3425    ! Some variables require the "symmorphic" attribute.
3426    NCF_CHECK(nf90_put_att(ncid, vid("reduced_symmetry_matrices"), "symmorphic", symmorphic))
3427    NCF_CHECK(nf90_put_att(ncid, vid("reduced_symmetry_translations"), "symmorphic", symmorphic))
3428 
3429    ! At this point we have an ETSF-compliant file. Add additional data for internal use in abinit.
3430    ! TODO add spinat.
3431    ncerr = nctk_def_arrays(ncid, nctkarr_t('symafm', "int", "number_of_symmetry_operations"))
3432    NCF_CHECK(ncerr)
3433 
3434    ! Define k-points. Note: monkhorst_pack_folding is replaced by kptrlatt and shiftk
3435    ncerr = nctk_def_arrays(ncid, [&
3436      nctkarr_t("reduced_coordinates_of_kpoints", "dp", "number_of_reduced_dimensions, number_of_kpoints"), &
3437      nctkarr_t("kpoint_weights", "dp", "number_of_kpoints") &
3438      !nctkarr_t("monkhorst_pack_folding", "int", "number_of_vectors") &
3439    ])
3440    NCF_CHECK(ncerr)
3441 
3442    ! Define states section. TODO: write smearing_scheme
3443    ncerr = nctk_def_arrays(ncid, [ &
3444      nctkarr_t("number_of_states", "int", "number_of_kpoints, number_of_spins"), &
3445      nctkarr_t("eigenvalues", "dp", "max_number_of_states, number_of_kpoints, number_of_spins"), &
3446      nctkarr_t("occupations", "dp", "max_number_of_states, number_of_kpoints, number_of_spins"), &
3447      nctkarr_t("smearing_scheme", "char", "character_string_length")  &
3448    ])
3449    NCF_CHECK(ncerr)
3450 
3451    ncerr = nctk_def_iscalars(ncid, [character(len=nctk_slen) :: "number_of_electrons"])
3452    NCF_CHECK(ncerr)
3453    ncerr = nctk_def_dpscalars(ncid, [character(len=nctk_slen) :: "fermi_energy", "smearing_width"])
3454    NCF_CHECK(ncerr)
3455    NCF_CHECK(nctk_set_atomic_units(ncid, "smearing_width"))
3456 
3457    ! Some variables require the specifications of units.
3458    NCF_CHECK(nctk_set_atomic_units(ncid, "eigenvalues"))
3459    NCF_CHECK(nctk_set_atomic_units(ncid, "fermi_energy"))
3460    NCF_CHECK(nf90_put_att(ncid, vid("number_of_states"), "k_dependent", k_dependent))
3461 
3462    ! Define dimensions.
3463    ncerr = nctk_def_dims(ncid, [&
3464      nctkdim_t("npsp", hdr%npsp), nctkdim_t("codvsnlen", 6), nctkdim_t("psptitlen", 132)&
3465    ])
3466    NCF_CHECK(ncerr)
3467 
3468    if (hdr%usewvl==1) then ! Add the BigDFT private dimensions.
3469      ncerr = nctk_def_dims(ncid, nctkdim_t("number_of_wavelet_resolutions", 2))
3470      NCF_CHECK(ncerr)
3471    end if
3472 
3473    ! Define scalars.
3474    ncerr = nctk_def_iscalars(ncid, [character(len=nctk_slen) :: &
3475      "date", "ixc", "intxc", "occopt", "pertcase", "headform", "fform", "usepaw", "usewvl"])
3476    NCF_CHECK(ncerr)
3477 
3478    ncerr = nctk_def_dpscalars(ncid, [character(len=nctk_slen) :: &
3479     "ecut_eff", "ecutdg", "ecutsm", "etot", "residm", "stmbias", "tphysel", "tsmear"])
3480    NCF_CHECK(ncerr)
3481 
3482    ! Multi-dimensional variables.
3483    ncerr = nctk_def_arrays(ncid, [&
3484      nctkarr_t("istwfk", "i", "number_of_kpoints"),&
3485      nctkarr_t("codvsn", "c", "codvsnlen"),&
3486      nctkarr_t("pspcod", "i", "npsp"),&
3487      nctkarr_t("pspdat", "i", "npsp"),&
3488      nctkarr_t("pspso", "i", "npsp"),&
3489      nctkarr_t("pspxc", "i", "npsp"),&
3490      nctkarr_t("qptn", "dp", "number_of_reduced_dimensions"),&
3491      nctkarr_t("so_psp", "i", "npsp"),&
3492      nctkarr_t("symafm", "i", "number_of_symmetry_operations"),&
3493      nctkarr_t("title", "c", "psptitlen, npsp"),&
3494      nctkarr_t("zionpsp", "dp", "npsp"),&
3495      nctkarr_t("znuclpsp", "dp", "npsp"),&
3496      nctkarr_t("lmn_size", "i", "npsp")])
3497    NCF_CHECK(ncerr)
3498 
3499    ! Add the BigDFT private variables.
3500    if (hdr%usewvl == 1) then
3501      ncerr = nctk_def_arrays(ncid, nctkarr_t("number_of_wavelets", "i", "number_of_wavelet_resolutions"))
3502      NCF_CHECK(ncerr)
3503    end if
3504 
3505    NCF_CHECK(nctk_def_arrays(ncid, nctkarr_t("basis_set", "char", "character_string_length")))
3506    if (hdr%usewvl == 0) then
3507      NCF_CHECK(nctk_def_dpscalars(ncid, [character(len=nctk_slen) :: "kinetic_energy_cutoff"]))
3508      NCF_CHECK(nctk_set_atomic_units(ncid, "kinetic_energy_cutoff"))
3509      NCF_CHECK(nctk_def_arrays(ncid, nctkarr_t("number_of_coefficients", "int", "number_of_kpoints")))
3510    end if
3511 
3512    NCF_CHECK(nf90_put_att(ncid, vid("number_of_states"), "k_dependent", k_dependent))
3513 
3514    if (hdr%usewvl == 0) then
3515      ! Note that here we always use the coarse FFT mesh even if usepaw == 1
3516      ncerr = nctk_def_dims(ncid, [&
3517        nctkdim_t("number_of_grid_points_vector1", hdr%ngfft(1)),&
3518        nctkdim_t("number_of_grid_points_vector2", hdr%ngfft(2)),&
3519        nctkdim_t("number_of_grid_points_vector3", hdr%ngfft(3))], defmode=.True.)
3520      NCF_CHECK(ncerr)
3521    else
3522      MSG_WARNING("Don't know how to define grid_points for wavelets!")
3523    end if
3524 
3525    !write(std_out,*)"hdr%nshiftk_orig,hdr%nshiftk",hdr%nshiftk_orig,hdr%nshiftk
3526    ncerr = nctk_def_dims(ncid, [&
3527      nctkdim_t("nshiftk_orig", hdr%nshiftk_orig),&
3528      nctkdim_t("nshiftk", hdr%nshiftk), &
3529      nctkdim_t("bantot", hdr%bantot), &
3530      nctkdim_t("md5_slen", md5_slen)], defmode=.True.)
3531    NCF_CHECK(ncerr)
3532 
3533    ncerr = nctk_def_iscalars(ncid, [character(len=nctk_slen) :: "kptopt", "pawcpxocc", "icoulomb"])
3534    NCF_CHECK(ncerr)
3535    ncerr = nctk_def_dpscalars(ncid, [character(len=nctk_slen) :: "nelect", "charge"])
3536    NCF_CHECK(ncerr)
3537 
3538    ncerr = nctk_def_arrays(ncid, [&
3539      nctkarr_t("kptrlatt_orig", "i", "number_of_reduced_dimensions, number_of_reduced_dimensions"),&
3540      nctkarr_t("kptrlatt", "i", "number_of_reduced_dimensions, number_of_reduced_dimensions"),&
3541      nctkarr_t("shiftk_orig", "dp", "number_of_reduced_dimensions, nshiftk_orig"),&
3542      nctkarr_t("shiftk", "dp", "number_of_reduced_dimensions, nshiftk"), &
3543      nctkarr_t("amu", "dp", "number_of_atom_species"), &
3544      nctkarr_t("md5_pseudos", "ch", "md5_slen, npsp") ])
3545    NCF_CHECK(ncerr)
3546 
3547    !call wrtout(std_out, "hdr_ncwrite completed define mode")
3548  end if ! my_define
3549 
3550  ! Switch to write mode.
3551  NCF_CHECK(nctk_set_datamode(ncid))
3552 
3553  ! Associate and write values to ETSF groups.
3554  if (hdr%usewvl == 0) then
3555    ! Plane wave case.
3556    basis_set = "plane_waves"
3557    NCF_CHECK(nf90_put_var(ncid, vid("basis_set"), basis_set))
3558    NCF_CHECK(nf90_put_var(ncid, vid("kinetic_energy_cutoff"), hdr%ecut))
3559    NCF_CHECK(nf90_put_var(ncid, vid("number_of_coefficients"), hdr%npwarr))
3560  else
3561    ! Wavelet case.
3562    basis_set = "daubechies_wavelets"
3563    NCF_CHECK(nf90_put_var(ncid, vid("basis_set"), basis_set))
3564    ! Required variable than should enter the standard.
3565    NCF_CHECK(nf90_put_var(ncid, vid("number_of_wavelets"), hdr%nwvlarr))
3566  end if
3567 
3568  ! Write electrons
3569  NCF_CHECK(nf90_put_var(ncid, vid("fermi_energy"), hdr%fermie))
3570  NCF_CHECK(nf90_put_var(ncid, vid("smearing_width"), hdr%tsmear))
3571  NCF_CHECK(nf90_put_var(ncid, vid("smearing_scheme"), nctk_string_from_occopt(hdr%occopt)))
3572 
3573  ! transfer data from (stupid) 1d hdr%nband and hdr%occ in packed form to 2d - 3d matrix with stride
3574  ! native support for array and array syntax is one of the reasons why we still use Fortran
3575  ! and we program like in C but without the power of C!o
3576 
3577 ! Also, strange problem with Petrus + Nag5 : had to explicitly specify nf90_put_var,
3578 ! with explicit definition of start, count and stride .
3579 ! Direct calls to NCF_CHECK, see below, were working for selected tests, but not all tests
3580  ABI_MALLOC(arr2d, (hdr%nkpt, hdr%nsppol))
3581  arr2d(:,:) = reshape(hdr%nband, [hdr%nkpt, hdr%nsppol])
3582  ncerr = nf90_put_var(ncid, vid("number_of_states"), arr2d, start=[1,1], count=[hdr%nkpt,hdr%nsppol], stride=[1,1])
3583  NCF_CHECK(ncerr)
3584 
3585  !NCF_CHECK(nf90_put_var(ncid, vid("number_of_states"), arr2d))
3586 !NCF_CHECK(nf90_put_var(ncid, vid("number_of_states"), reshape(hdr%nband, [hdr%nkpt, hdr%nsppol])))
3587 ! XG 20160329  was working for v2#30-32 , tutorial tbs#1-4 and tutorespfn temp_3 , but not v7#68-69
3588 !NCF_CHECK(nf90_put_var(ncid, vid("number_of_states"), arr2d))
3589 ! XG 20160329  was working for v7#68-69, but not v2#30-32 , tutorial tbs#1-4 and tutorespfn temp_3
3590  ABI_FREE(arr2d)
3591 
3592  ABI_MALLOC(arr3d, (hdr%mband, hdr%nkpt, hdr%nsppol))
3593  call hdr_get_occ3d(hdr, arr3d)
3594  NCF_CHECK(nf90_put_var(ncid, vid("occupations"), arr3d))
3595  ABI_FREE(arr3d)
3596 
3597  ! Write geometry
3598  NCF_CHECK(nf90_put_var(ncid, vid("primitive_vectors"), hdr%rprimd))
3599  NCF_CHECK(nf90_put_var(ncid, vid("reduced_symmetry_matrices"), hdr%symrel))
3600  NCF_CHECK(nf90_put_var(ncid, vid("atom_species"), hdr%typat))
3601  NCF_CHECK(nf90_put_var(ncid, vid("reduced_symmetry_translations"), hdr%tnons))
3602  NCF_CHECK(nf90_put_var(ncid, vid("reduced_atom_positions"), hdr%xred))
3603  NCF_CHECK(nf90_put_var(ncid, vid("atomic_numbers"), hdr%znucltypat))
3604 
3605  ! Write k-points.
3606  NCF_CHECK(nf90_put_var(ncid, vid("reduced_coordinates_of_kpoints"), hdr%kptns))
3607  NCF_CHECK(nf90_put_var(ncid, vid("kpoint_weights"), hdr%wtk))
3608 
3609  ! Write non-ETSF variables.
3610  NCF_CHECK(nf90_put_var(ncid, vid("codvsn"), hdr%codvsn))
3611  NCF_CHECK(nf90_put_var(ncid, vid("title"), hdr%title))
3612 
3613  ncerr = nctk_write_iscalars(ncid, [character(len=nctk_slen) :: &
3614 &  "date", "ixc", "intxc", "occopt", "pertcase", "headform", "fform", "usepaw", "icoulomb"],&
3615 &  [hdr%date, hdr%ixc ,hdr%intxc ,hdr%occopt, hdr%pertcase, HDR_LATEST_HEADFORM, fform, hdr%usepaw, hdr%icoulomb])
3616  NCF_CHECK(ncerr)
3617 
3618  ncerr = nctk_write_dpscalars(ncid, [character(len=nctk_slen) :: &
3619 &  "ecut_eff", "ecutdg", "ecutsm", "etot", "residm", "stmbias", "tphysel", "tsmear"],&
3620 &  [hdr%ecut_eff, hdr%ecutdg, hdr%ecutsm, hdr%etot, hdr%residm, hdr%stmbias, hdr%tphysel, hdr%tsmear])
3621  NCF_CHECK(ncerr)
3622 
3623 !Array variables.
3624 
3625 ! FIXME Be careful with zionpsp if alchemical mixing!
3626  NCF_CHECK(nf90_put_var(ncid, vid("istwfk"), hdr%istwfk))
3627  NCF_CHECK(nf90_put_var(ncid, vid("pspcod"), hdr%pspcod))
3628  NCF_CHECK(nf90_put_var(ncid, vid("pspdat"), hdr%pspdat))
3629  NCF_CHECK(nf90_put_var(ncid, vid("pspso"), hdr%pspso))
3630  NCF_CHECK(nf90_put_var(ncid, vid("pspxc"), hdr%pspxc))
3631  NCF_CHECK(nf90_put_var(ncid, vid("qptn"), hdr%qptn))
3632  NCF_CHECK(nf90_put_var(ncid, vid("so_psp"), hdr%so_psp))
3633  NCF_CHECK(nf90_put_var(ncid, vid("symafm"), hdr%symafm))
3634  NCF_CHECK(nf90_put_var(ncid, vid("znuclpsp"), hdr%znuclpsp))
3635  NCF_CHECK(nf90_put_var(ncid, vid("zionpsp"), hdr%zionpsp))
3636  NCF_CHECK(nf90_put_var(ncid, vid("lmn_size"), hdr%lmn_size))
3637  NCF_CHECK(nf90_put_var(ncid, vid("usewvl"), hdr%usewvl))
3638 
3639  ! Write hdr%pawrhoij.
3640  if (hdr%usepaw == 1) then
3641    ! Dirty trick to bypass check on the intent, but the problem is in the intent(inout) of pawrhoij_io
3642    rhoij_ptr => hdr%pawrhoij
3643    call pawrhoij_io(rhoij_ptr,ncid,hdr%nsppol,hdr%nspinor,hdr%nspden,hdr%lmn_size,hdr%typat,&
3644                     HDR_LATEST_HEADFORM,"Write",form="netcdf")
3645  end if
3646 
3647  ncerr = nctk_write_iscalars(ncid, [character(len=nctk_slen) :: &
3648    "kptopt", "pawcpxocc"],[hdr%kptopt, hdr%pawcpxocc])
3649  NCF_CHECK(ncerr)
3650 
3651  ncerr = nctk_write_dpscalars(ncid, [character(len=nctk_slen) :: &
3652    "nelect", "charge"],[hdr%nelect, hdr%charge])
3653  NCF_CHECK(ncerr)
3654 
3655  ! FIXME: in etsf_io the number of electrons is declared as integer!!!
3656  NCF_CHECK(nf90_put_var(ncid, vid("number_of_electrons"), nint(hdr%nelect)))
3657  NCF_CHECK(nf90_put_var(ncid, vid("kptrlatt_orig"), hdr%kptrlatt_orig))
3658  NCF_CHECK(nf90_put_var(ncid, vid("kptrlatt"), hdr%kptrlatt))
3659  NCF_CHECK(nf90_put_var(ncid, vid("shiftk_orig"), hdr%shiftk_orig))
3660  NCF_CHECK(nf90_put_var(ncid, vid("shiftk"), hdr%shiftk))
3661  NCF_CHECK(nf90_put_var(ncid, vid("md5_pseudos"), hdr%md5_pseudos))
3662  NCF_CHECK(nf90_put_var(ncid, vid("amu"), hdr%amu))
3663 
3664 #else
3665  MSG_ERROR("netcdf support support not activated")
3666 #endif
3667 
3668 contains
3669  integer function vid(vname)
3670 
3671 !This section has been created automatically by the script Abilint (TD).
3672 !Do not modify the following lines by hand.
3673 #undef ABI_FUNC
3674 #define ABI_FUNC 'vid'
3675 !End of the abilint section
3676 
3677    character(len=*),intent(in) :: vname
3678    vid = nctk_idname(ncid, vname)
3679  end function vid
3680 
3681 end function hdr_ncwrite

m_hdr/hdr_nelect_fromocc [ Functions ]

[ Top ] [ m_hdr ] [ Functions ]

NAME

 hdr_nelect_fromocc

FUNCTION

  Return the number of electrons from the occupation numbers
  This function is mainly used for debugging purposes, use hdr%nelect and hdr%charge

INPUTS

  Hdr<hdr_type>

OUTPUT

  nelect=Number of electrons in the unit cell.

PARENTS

CHILDREN

SOURCE

1185 real(dp) pure function hdr_nelect_fromocc(Hdr) result(nelect)
1186 
1187 
1188 !This section has been created automatically by the script Abilint (TD).
1189 !Do not modify the following lines by hand.
1190 #undef ABI_FUNC
1191 #define ABI_FUNC 'hdr_nelect_fromocc'
1192 !End of the abilint section
1193 
1194  implicit none
1195 
1196 !Arguments ---------------------------------------------
1197 !scalars
1198  type(hdr_type),intent(in) :: Hdr
1199 
1200 !Local variables ---------------------------------------
1201 !scalars
1202  integer :: idx,isppol,ikibz,nband_k
1203 ! *************************************************************************
1204 
1205  ! Cannot use znucl because we might have additional charge or alchemy.
1206  nelect=zero ; idx=0
1207  do isppol=1,Hdr%nsppol
1208    do ikibz=1,Hdr%nkpt
1209      nband_k=Hdr%nband(ikibz+(isppol-1)*Hdr%nkpt)
1210      nelect = nelect + Hdr%wtk(ikibz)*SUM(Hdr%occ(idx+1:idx+nband_k))
1211      idx=idx+nband_k
1212    end do
1213  end do
1214 
1215 end function hdr_nelect_fromocc

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)

PARENTS

      conducti_paw,conducti_paw_core,cut3d,emispec_paw,finddistrproc,ioprof
      linear_optics_paw,m_ddk,m_ioarr,m_wfd,m_wfk

CHILDREN

SOURCE

1470 subroutine hdr_read_from_fname(Hdr,fname,fform,comm)
1471 
1472 
1473 !This section has been created automatically by the script Abilint (TD).
1474 !Do not modify the following lines by hand.
1475 #undef ABI_FUNC
1476 #define ABI_FUNC 'hdr_read_from_fname'
1477 !End of the abilint section
1478 
1479  implicit none
1480 
1481 !Arguments ------------------------------------
1482  integer,intent(in) :: comm
1483  integer,intent(out) :: fform
1484  character(len=*),intent(in) :: fname
1485  type(hdr_type),intent(inout) :: Hdr
1486 
1487 !Local variables-------------------------------
1488  integer,parameter :: rdwr1=1,master=0
1489  integer :: fh,my_rank,mpierr
1490  character(len=500) :: msg
1491  character(len=len(fname)) :: my_fname
1492 
1493 ! *************************************************************************
1494 
1495  my_rank = xmpi_comm_rank(comm)
1496  my_fname = fname
1497 
1498  if (nctk_try_fort_or_ncfile(my_fname, msg) /= 0) then
1499    MSG_ERROR(msg)
1500  end if
1501 
1502  if (my_rank == master) then
1503    if (.not.isncfile(my_fname)) then
1504      ! Use Fortran IO to open the file and read the header.
1505      if (open_file(my_fname,msg,newunit=fh,form="unformatted", status="old") /= 0) then
1506        MSG_ERROR(msg)
1507      end if
1508 
1509      call hdr_fort_read(Hdr,fh,fform,rewind=(rdwr1==1))
1510      ABI_CHECK(fform /= 0, sjoin("fform == 0 while reading:", my_fname))
1511      close(fh)
1512 
1513    else
1514      ! Use Netcdf to open the file and read the header.
1515 #ifdef HAVE_NETCDF
1516      NCF_CHECK(nctk_open_read(fh, my_fname, xmpi_comm_self))
1517      call hdr_ncread(Hdr,fh, fform)
1518      ABI_CHECK(fform /= 0, sjoin("Error while reading:", my_fname))
1519      NCF_CHECK(nf90_close(fh))
1520 #else
1521      MSG_ERROR("netcdf support not enabled")
1522 #endif
1523    end if
1524  end if
1525 
1526  ! Broadcast fform and the header.
1527  if (xmpi_comm_size(comm) > 1) then
1528    call hdr_bcast(Hdr,master,my_rank,comm)
1529    call xmpi_bcast(fform,master,comm,mpierr)
1530  end if
1531 
1532 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.

PARENTS

      m_hdr

CHILDREN

SOURCE

3698 subroutine hdr_set_occ(hdr, occ3d)
3699 
3700 
3701 !This section has been created automatically by the script Abilint (TD).
3702 !Do not modify the following lines by hand.
3703 #undef ABI_FUNC
3704 #define ABI_FUNC 'hdr_set_occ'
3705 !End of the abilint section
3706 
3707  implicit none
3708 
3709 !Arguments ------------------------------------
3710  type(hdr_type),intent(inout) :: hdr
3711  real(dp),intent(in) :: occ3d(hdr%mband,hdr%nkpt,hdr%nsppol)
3712 
3713 !Local variables-------------------------------
3714 !scalars
3715  integer :: ii,band,ikpt,spin
3716 
3717 !*************************************************************************
3718 
3719  ii = 0
3720  do spin=1,hdr%nsppol
3721    do ikpt=1,hdr%nkpt
3722      do band=1,hdr%nband(ikpt + (spin-1) * hdr%nkpt)
3723          ii = ii +1
3724          hdr%occ(ii) = occ3d(band,ikpt,spin)
3725      end do
3726    end do
3727  end do
3728 
3729 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

PARENTS

CHILDREN

SOURCE

2258 subroutine hdr_skip_int(unitfi,ierr)
2259 
2260 
2261 !This section has been created automatically by the script Abilint (TD).
2262 !Do not modify the following lines by hand.
2263 #undef ABI_FUNC
2264 #define ABI_FUNC 'hdr_skip_int'
2265 !End of the abilint section
2266 
2267  implicit none
2268 
2269 !Arguments ------------------------------------
2270  integer,intent(in) :: unitfi
2271  integer,intent(out) :: ierr
2272 
2273 !Local variables-------------------------------
2274  type(wffile_type) :: wff
2275 
2276 ! *************************************************************************
2277 
2278 !Use default values for wff
2279  wff%unwff=unitfi; wff%iomode=IO_MODE_FORTRAN
2280  wff%me=0; wff%master=0
2281 !Then, transmit to hdr_skip_wfftype
2282  call hdr_skip_wfftype(wff,ierr)
2283 
2284 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

PARENTS

      m_hdr

CHILDREN

SOURCE

2317 subroutine hdr_skip_wfftype(wff,ierr)
2318 
2319 
2320 !This section has been created automatically by the script Abilint (TD).
2321 !Do not modify the following lines by hand.
2322 #undef ABI_FUNC
2323 #define ABI_FUNC 'hdr_skip_wfftype'
2324 !End of the abilint section
2325 
2326  implicit none
2327 
2328 !Arguments ------------------------------------
2329  type(wffile_type),intent(inout) :: wff
2330  integer, intent(out) :: ierr
2331 
2332 !Local variables-------------------------------
2333  integer :: headform,mu,npsp,unit,usepaw !,fform
2334  integer :: integers(17)
2335  character(len=6) :: codvsn
2336  character(len=500) :: msg,errmsg
2337 #if defined HAVE_MPI_IO
2338  integer(kind=MPI_OFFSET_KIND) :: delim_record,posit,positloc
2339  integer :: statux(MPI_STATUS_SIZE)
2340 #endif
2341 
2342 !*************************************************************************
2343 
2344  !@hdr_type
2345  unit=wff%unwff; ierr=0
2346 
2347  if( wff%iomode==IO_MODE_FORTRAN .or. (wff%iomode==IO_MODE_FORTRAN_MASTER.and.wff%master==wff%me) ) then
2348 
2349    rewind(unit, err=10, iomsg=errmsg)
2350 
2351 !  Pick off headform from WF file
2352    read(unit, err=10, iomsg=errmsg) codvsn,headform ! fform
2353 
2354    if (headform==1   .or. headform==2   .or. &
2355 &   headform==51  .or. headform==52  .or.   &
2356 &   headform==101 .or. headform==102 ) headform=22
2357 
2358    if (headform < 80) then
2359      write(msg,'(3a,i0,4a)')&
2360        "ABINIT version: ",trim(abinit_version)," cannot read old files with headform: ",headform,ch10,&
2361        "produced by previous versions. Use an old ABINIT version to read this file or ",ch10,&
2362        "regenerate your files with version >= 8.0."
2363      MSG_ERROR(msg)
2364    end if
2365 
2366    read (unit, err=10, iomsg=errmsg) integers(1:13),npsp,integers(15:17),usepaw
2367 
2368 !  Skip rest of header records
2369    do mu=1,3+npsp
2370      read (unit, err=10, iomsg=errmsg)
2371    end do
2372 
2373    if (usepaw==1) then
2374      read (unit, err=10, iomsg=errmsg)
2375      read (unit, err=10, iomsg=errmsg)
2376    end if
2377 
2378 #if defined HAVE_MPI_IO
2379  else if(wff%iomode==IO_MODE_MPI)then
2380 
2381    headform=wff%headform
2382    if(headform==1   .or. headform==2   .or. &
2383 &   headform==51  .or. headform==52  .or. &
2384 &   headform==101 .or. headform==102) headform=22
2385 
2386    if (headform < 80) then
2387      write(msg,'(3a,i0,4a)')&
2388        "ABINIT version: ",trim(abinit_version)," cannot read old files with headform: ",headform,ch10,&
2389        "produced by previous versions. Use an old ABINIT version to read this file or ",ch10,&
2390        "regenerate your files with version >= 8.0."
2391      MSG_ERROR(msg)
2392    end if
2393 
2394 !  Causes all previous writes to be transferred to the storage device
2395    call flush_unit(wff%unwff)
2396    call MPI_FILE_SYNC(wff%fhwff,ierr)
2397 
2398 !  Check FORTRAN record marker length (only at first call)
2399    if (wff%nbOct_recMarker<=0) then
2400      call getRecordMarkerLength_wffile(wff)
2401    end if
2402 
2403    if (wff%master==wff%me) then
2404 
2405 !    Reading the first record of the file -------------------------------------
2406 !    read (unitfi)   codvsn,headform,..............
2407      posit = 0
2408      call rwRecordMarker(1,posit,delim_record,wff,ierr)
2409 
2410 !    Reading the second record of the file ------------------------------------
2411 !    read(unitfi) bantot, hdr%date, hdr%intxc.................
2412 !    Pick off npsp and usepaw from WF file
2413      positloc  = posit + wff%nbOct_recMarker + wff%nbOct_int*13
2414      call MPI_FILE_READ_AT(wff%fhwff,positloc,npsp,1,MPI_INTEGER,statux,ierr)
2415 
2416      ! Read usepaw and skip the fortran record
2417      positloc = positloc +  wff%nbOct_int*4
2418      call MPI_FILE_READ_AT(wff%fhwff,positloc,usepaw,1,MPI_INTEGER,statux,ierr)
2419      call rwRecordMarker(1,posit,delim_record,wff,ierr)
2420 
2421      ! Skip the rest of the file ---------------------------------------------
2422      do mu=1,3+npsp
2423        call rwRecordMarker(1,posit,delim_record,wff,ierr)
2424      end do
2425 
2426      if (usepaw==1) then
2427        call rwRecordMarker(1,posit,delim_record,wff,ierr)
2428        call rwRecordMarker(1,posit,delim_record,wff,ierr)
2429      end if
2430 
2431      wff%offwff=posit
2432    end if
2433 
2434    if (wff%spaceComm/=MPI_COMM_SELF) then
2435      call MPI_BCAST(wff%offwff,1,wff%offset_mpi_type,wff%master,wff%spaceComm,ierr)
2436    end if
2437 #endif
2438  end if
2439 
2440  ! Handle IO-error: write warning and let the caller handle the exception.
2441  return
2442 10 ierr=1
2443  MSG_WARNING(errmsg)
2444 
2445 end subroutine hdr_skip_wfftype

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)
 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

PARENTS

      afterscfloop,dfpt_looppert,dfpt_scfcv,gstate,nonlinear,respfn,scfcv
      setup_bse,setup_screening,setup_sigma

CHILDREN

SOURCE

2486 subroutine hdr_update(hdr,bantot,etot,fermie,residm,rprimd,occ,pawrhoij,xred,amu, &
2487 &                     comm_atom,mpi_atmtab) ! optional arguments (parallelism)
2488 
2489 
2490 !This section has been created automatically by the script Abilint (TD).
2491 !Do not modify the following lines by hand.
2492 #undef ABI_FUNC
2493 #define ABI_FUNC 'hdr_update'
2494 !End of the abilint section
2495 
2496  implicit none
2497 
2498 !Arguments ------------------------------------
2499 !scalars
2500  integer,intent(in) :: bantot
2501  integer,optional,intent(in) :: comm_atom
2502  real(dp),intent(in) :: etot,fermie,residm
2503  type(hdr_type),intent(inout) :: hdr
2504 !arrays
2505  integer,optional,target,intent(in) :: mpi_atmtab(:)
2506  real(dp),intent(in) :: occ(bantot),rprimd(3,3),xred(3,hdr%natom),amu(hdr%ntypat)
2507  type(pawrhoij_type),intent(inout) :: pawrhoij(:)
2508 
2509 ! *************************************************************************
2510 
2511  !@hdr_type
2512 !Update of the "evolving" data
2513  hdr%etot     =etot
2514  hdr%fermie   =fermie
2515  hdr%residm   =residm
2516  hdr%rprimd(:,:)=rprimd(:,:)
2517  hdr%occ(:)   =occ(:)
2518  hdr%xred(:,:)=xred(:,:)
2519  hdr%amu(:) = amu
2520 
2521  if (hdr%usepaw==1) then
2522    if (present(comm_atom)) then
2523      if (present(mpi_atmtab)) then
2524        call pawrhoij_copy(pawrhoij,hdr%pawrhoij,comm_atom=comm_atom,mpi_atmtab=mpi_atmtab)
2525      else
2526        call pawrhoij_copy(pawrhoij,hdr%pawrhoij,comm_atom=comm_atom)
2527      end if
2528    else
2529      call pawrhoij_copy(pawrhoij,hdr%pawrhoij)
2530    end if
2531  end if
2532 
2533 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

PARENTS

      eph,setup_bse,setup_screening,setup_sigma,wfk_analyze

CHILDREN

      wrtout

SOURCE

4749 subroutine hdr_vs_dtset(Hdr,Dtset)
4750 
4751 
4752 !This section has been created automatically by the script Abilint (TD).
4753 !Do not modify the following lines by hand.
4754 #undef ABI_FUNC
4755 #define ABI_FUNC 'hdr_vs_dtset'
4756 !End of the abilint section
4757 
4758  implicit none
4759 
4760 !Arguments ------------------------------------
4761  type(Hdr_type),intent(in) :: Hdr
4762  type(Dataset_type),intent(in) :: Dtset
4763 
4764 !Local variables-------------------------------
4765  integer :: ik,jj,ierr
4766  logical :: test
4767  logical :: tsymrel,ttnons,tsymafm
4768  character(len=500) :: msg
4769 ! *************************************************************************
4770 
4771 !=== Check basic dimensions ===
4772  ierr=0
4773  call compare_int('natom',  Hdr%natom,  Dtset%natom,  ierr)
4774  call compare_int('nkpt',   Hdr%nkpt,   Dtset%nkpt,   ierr)
4775  call compare_int('npsp',   Hdr%npsp,   Dtset%npsp,   ierr)
4776  call compare_int('nspden', Hdr%nspden, Dtset%nspden, ierr)
4777  call compare_int('nspinor',Hdr%nspinor,Dtset%nspinor,ierr)
4778  call compare_int('nsppol', Hdr%nsppol, Dtset%nsppol, ierr)
4779  call compare_int('nsym',   Hdr%nsym,   Dtset%nsym,   ierr)
4780  call compare_int('ntypat', Hdr%ntypat, Dtset%ntypat, ierr)
4781  call compare_int('usepaw', Hdr%usepaw, Dtset%usepaw, ierr)
4782  call compare_int('usewvl', Hdr%usewvl, Dtset%usewvl, ierr)
4783  call compare_int('kptopt', Hdr%kptopt, Dtset%kptopt, ierr)
4784  call compare_int('pawcpxocc', Hdr%pawcpxocc, Dtset%pawcpxocc, ierr)
4785  call compare_int('nshiftk_orig', Hdr%nshiftk_orig, Dtset%nshiftk_orig, ierr)
4786  call compare_int('nshiftk', Hdr%nshiftk, Dtset%nshiftk, ierr)
4787 
4788 !=== The number of fatal errors must be zero ===
4789  if (ierr/=0) then
4790    write(msg,'(3a)')&
4791 &   'Cannot continue, basic dimensions reported in the header do not agree with input file. ',ch10,&
4792 &   'Check consistency between the content of the external file and the input file. '
4793    MSG_ERROR(msg)
4794  end if
4795 
4796  test=ALL(ABS(Hdr%xred-Dtset%xred_orig(:,1:Dtset%natom,1))<tol6)
4797  ABI_CHECK(test,'Mismatch in xred')
4798 
4799  test=ALL(Hdr%typat==Dtset%typat(1:Dtset%natom))
4800  ABI_CHECK(test,'Mismatch in typat')
4801 !
4802 !* Check if the lattice from the input file agrees with that read from the KSS file
4803  if ( (ANY(ABS(Hdr%rprimd-Dtset%rprimd_orig(1:3,1:3,1))>tol6)) ) then
4804    write(msg,'(6a)')ch10,&
4805 &   ' hdr_vs_dtset : ERROR - ',ch10,&
4806 &   ' real lattice vectors read from Header ',ch10,&
4807 &   ' differ from the values specified in the input file'
4808    call wrtout(std_out,msg,'COLL')
4809    write(msg,'(3a,3(3es16.6),3a,3(3es16.6),3a)')ch10,&
4810 &   ' rprimd from Hdr file   = ',ch10,(Hdr%rprimd(:,jj),jj=1,3),ch10,&
4811 &   ' rprimd from input file = ',ch10,(Dtset%rprimd_orig(:,jj,1),jj=1,3),ch10,ch10,&
4812 &   '  Modify the lattice vectors in the input file '
4813    call wrtout(std_out,msg,'COLL')
4814    MSG_ERROR("")
4815  end if
4816 
4817 !=== Check symmetry operations ===
4818  tsymrel=(ALL(Hdr%symrel==Dtset%symrel(:,:,1:Dtset%nsym)))
4819  if (.not.tsymrel) then
4820    write(msg,'(6a)')ch10,&
4821 &   ' hdr_vs_dtset : ERROR - ',ch10,&
4822 &   ' real space symmetries read from Header ',ch10,&
4823 &   ' differ from the values inferred from the input file'
4824    call wrtout(std_out,msg,'COLL')
4825    tsymrel=.FALSE.
4826  end if
4827 
4828  ttnons=ALL(ABS(Hdr%tnons-Dtset%tnons(:,1:Dtset%nsym))<tol6)
4829  if (.not.ttnons) then
4830    write(msg,'(6a)')ch10,&
4831 &   ' hdr_vs_dtset : ERROR - ',ch10,&
4832 &   ' fractional translations read from Header ',ch10,&
4833 &   ' differ from the values inferred from the input file'
4834    call wrtout(std_out,msg,'COLL')
4835    ttnons=.FALSE.
4836  end if
4837 
4838  tsymafm=ALL(Hdr%symafm==Dtset%symafm(1:Dtset%nsym))
4839  if (.not.tsymafm) then
4840    write(msg,'(6a)')ch10,&
4841 &   ' hdr_vs_dtset : ERROR - ',ch10,&
4842 &   ' AFM symmetries read from Header ',ch10,&
4843 &   ' differ from the values inferred from the input file'
4844    call wrtout(std_out,msg,'COLL')
4845    tsymafm=.FALSE.
4846  end if
4847 
4848  if (.not.(tsymrel.and.ttnons.and.tsymafm)) then
4849    write(msg,'(a)')' Header '
4850    call wrtout(std_out,msg,'COLL')
4851    call print_symmetries(Hdr%nsym,Hdr%symrel,Hdr%tnons,Hdr%symafm)
4852    write(msg,'(a)')' Dtset  '
4853    call wrtout(std_out,msg,'COLL')
4854    call print_symmetries(Dtset%nsym,Dtset%symrel,Dtset%tnons,Dtset%symafm)
4855    MSG_ERROR('Check symmetry operations')
4856  end if
4857 
4858  if (abs(Dtset%nelect-hdr%nelect)>tol6) then
4859    write(msg,'(2(a,f8.2))')&
4860 &   "File contains ", hdr%nelect," electrons but nelect initialized from input is ",Dtset%nelect
4861    MSG_ERROR(msg)
4862  end if
4863  if (abs(Dtset%charge-hdr%charge)>tol6) then
4864    write(msg,'(2(a,f8.2))')&
4865 &   "File contains charge ", hdr%charge," but charge from input is ",Dtset%charge
4866    MSG_ERROR(msg)
4867  end if
4868 
4869  if (any(hdr%kptrlatt_orig /= dtset%kptrlatt_orig)) then
4870    write(msg,"(5a)")&
4871    "hdr%kptrlatt_orig: ",trim(ltoa(reshape(hdr%kptrlatt_orig,[9]))),ch10,&
4872    "dtset%kptrlatt_orig: ",trim(ltoa(reshape(dtset%kptrlatt_orig, [9])))
4873    MSG_ERROR(msg)
4874  end if
4875 
4876  if (any(hdr%kptrlatt /= dtset%kptrlatt)) then
4877    write(msg,"(5a)")&
4878    "hdr%kptrlatt: ",trim(ltoa(reshape(hdr%kptrlatt, [9]))),ch10,&
4879    "dtset%kptrlatt: ",trim(ltoa(reshape(dtset%kptrlatt, [9])))
4880    MSG_ERROR(msg)
4881  end if
4882 
4883  if (any(abs(hdr%shiftk_orig - dtset%shiftk_orig(:,1:dtset%nshiftk_orig)) > tol6)) then
4884    write(msg,"(5a)")&
4885    "hdr%shiftk_orig: ",trim(ltoa(reshape(hdr%shiftk_orig, [3*hdr%nshiftk_orig]))),ch10,&
4886    "dtset%shiftk_orig: ",trim(ltoa(reshape(dtset%shiftk_orig, [3*dtset%nshiftk_orig])))
4887    MSG_ERROR(msg)
4888  end if
4889 
4890  if (any(abs(hdr%shiftk - dtset%shiftk(:,1:dtset%nshiftk)) > tol6)) then
4891    write(msg,"(5a)")&
4892    "hdr%shiftk: ",trim(ltoa(reshape(hdr%shiftk, [3*hdr%nshiftk]))),ch10,&
4893    "dtset%shiftk: ",trim(ltoa(reshape(dtset%shiftk, [3*dtset%nshiftk])))
4894    MSG_ERROR(msg)
4895  end if
4896 
4897 !* Check if the k-points from the input file agrees with that read from the WFK file
4898  if ( (ANY(ABS(Hdr%kptns(:,:)-Dtset%kpt(:,1:Dtset%nkpt))>tol6)) ) then
4899    write(msg,'(9a)')ch10,&
4900 &   ' hdr_vs_dtset : ERROR - ',ch10,&
4901 &   '  k-points read from Header ',ch10,&
4902 &   '  differ from the values specified in the input file',ch10,&
4903 &   '  k-points from Hdr file                        | k-points from input file ',ch10
4904    call wrtout(std_out,msg,'COLL')
4905    do ik=1,Dtset%nkpt
4906      write(msg,'(3(3es16.6,3x))')Hdr%kptns(:,ik),Dtset%kpt(:,ik)
4907      call wrtout(std_out,msg,'COLL')
4908    end do
4909    MSG_ERROR('Modify the k-mesh in the input file')
4910  end if
4911 
4912  if (ANY(ABS(Hdr%wtk(:)-Dtset%wtk(1:Dtset%nkpt))>tol6)) then
4913    write(msg,'(9a)')ch10,&
4914 &   ' hdr_vs_dtset : ERROR - ',ch10,&
4915 &   '  k-point weights read from Header ',ch10,&
4916 &   '  differ from the values specified in the input file',ch10,&
4917 &   '  Hdr file  |  File ',ch10
4918    call wrtout(std_out,msg,'COLL')
4919    do ik=1,Dtset%nkpt
4920      write(msg,'(2(f11.5,1x))')Hdr%wtk(ik),Dtset%wtk(ik)
4921      call wrtout(std_out,msg,'COLL')
4922    end do
4923    MSG_ERROR('Check the k-mesh and the symmetries of the system. ')
4924  end if
4925 
4926 !Check istwfk storage
4927  if ( (ANY(Hdr%istwfk(:)/=Dtset%istwfk(1:Dtset%nkpt))) ) then
4928    write(msg,'(9a)')ch10,&
4929 &   ' hdr_vs_dtset : ERROR - ',ch10,&
4930 &   '  istwfk read from Header ',ch10,&
4931 &   '  differ from the values specified in the input file',ch10,&
4932 &   '  Hdr | input ',ch10
4933    call wrtout(std_out,msg,'COLL')
4934    do ik=1,Dtset%nkpt
4935      write(msg,'(i5,3x,i5)')Hdr%istwfk(ik),Dtset%istwfk(ik)
4936      call wrtout(std_out,msg,'COLL')
4937    end do
4938    MSG_ERROR('Modify istwfk in the input file')
4939  end if
4940 
4941  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.

PARENTS

      m_ioarr,m_wfk

CHILDREN

SOURCE

1560 subroutine hdr_write_to_fname(Hdr,fname,fform)
1561 
1562 
1563 !This section has been created automatically by the script Abilint (TD).
1564 !Do not modify the following lines by hand.
1565 #undef ABI_FUNC
1566 #define ABI_FUNC 'hdr_write_to_fname'
1567 !End of the abilint section
1568 
1569  implicit none
1570 
1571 !Arguments ------------------------------------
1572  integer,intent(in) :: fform
1573  character(len=*),intent(in) :: fname
1574  type(hdr_type),intent(inout) :: Hdr
1575 
1576 !Local variables-------------------------------
1577  integer :: fh,ierr
1578  character(len=500) :: msg
1579 
1580 ! *************************************************************************
1581 
1582  if (.not.isncfile(fname)) then
1583    ! Use Fortran IO to write the header.
1584    if (open_file(fname,msg,newunit=fh,form="unformatted", status="unknown") /= 0) then
1585      MSG_ERROR(msg)
1586    end if
1587    call hdr_fort_write(Hdr,fh,fform,ierr)
1588    ABI_CHECK(ierr==0, sjoin("Error while writing Abinit header to file:", fname))
1589    close(fh)
1590 
1591  else
1592    ! Use Netcdf to open the file and write the header.
1593 #ifdef HAVE_NETCDF
1594    if (file_exists(fname)) then
1595      NCF_CHECK(nctk_open_modify(fh,fname, xmpi_comm_self))
1596    else
1597      NCF_CHECK_MSG(nctk_open_create(fh, fname, xmpi_comm_self), sjoin("Creating file:",  fname))
1598    end if
1599 
1600    NCF_CHECK(hdr_ncwrite(Hdr, fh, fform, nc_define=.True.))
1601    NCF_CHECK(nf90_close(fh))
1602 #else
1603    MSG_ERROR("netcdf support not enabled")
1604 #endif
1605  end if
1606 
1607 end subroutine hdr_write_to_fname

m_hdr/test_abifiles [ Functions ]

[ Top ] [ m_hdr ] [ Functions ]

NAME

  test_abifiles

FUNCTION

  Check the consistency of the internal abifiles table.

PARENTS

      m_hdr

CHILDREN

SOURCE

651 subroutine test_abifiles()
652 
653 
654 !This section has been created automatically by the script Abilint (TD).
655 !Do not modify the following lines by hand.
656 #undef ABI_FUNC
657 #define ABI_FUNC 'test_abifiles'
658 !End of the abilint section
659 
660  implicit none
661 
662 !Arguments ---------------------------------------------
663 
664 !Local variables-------------------------------
665 !scalars
666  integer :: ii,nn,ierr
667  integer :: all_fforms(size(all_abifiles)),iperm(size(all_abifiles))
668 ! *************************************************************************
669 
670  nn = size(all_abifiles)
671 
672  do ii=1,nn
673    all_fforms(ii) = all_abifiles(ii)%fform
674  end do
675  iperm = [(ii, ii=1,nn)]
676  call sort_int(nn, all_fforms, iperm)
677 
678  ierr = 0
679  do ii=1,nn-1
680    if (all_fforms(ii) == all_fforms(ii+1)) then
681      MSG_WARNING(sjoin("fform: ", itoa(all_fforms(ii+1)), "is already in the abifiles list"))
682      ierr = ierr + 1
683    end if
684  end do
685 
686  if (ierr /= 0) then
687    MSG_ERROR("test_abifiles gave ierr != 0. Aborting now")
688  end if
689 
690 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

348 character(len=nctk_slen) function varname_from_fname(filename) result(varname)
349 
350 
351 !This section has been created automatically by the script Abilint (TD).
352 !Do not modify the following lines by hand.
353 #undef ABI_FUNC
354 #define ABI_FUNC 'varname_from_fname'
355 !End of the abilint section
356 
357  implicit none
358 
359 !Arguments ---------------------------------------------
360  character(len=*),intent(in) :: filename
361 
362 !Local variables-------------------------------
363 !scalars
364  integer :: ind,pertcase,ierr
365  logical :: found
366  character(len=len(filename)) :: ext
367 
368 ! *********************************************************************
369 
370  ! TODO: This should be a recursive function because we have
371  ! to scan the string from left to right (extensions could have the same termination)
372 
373  ! Find the Abinit file extension. Examples: t43_VHXC.nc
374  if (endswith(filename, ".nc")) then
375    ind = index(filename, ".nc", back=.True.)
376  else
377    !MSG_ERROR(sjoin("Don't know how to handle: ", filename))
378    ind = len_trim(filename) + 1
379  end if
380 
381  ext = filename(:ind-1)
382  ind = index(ext, "_", back=.True.)
383  ABI_CHECK(ind /= 0, "Cannot find `_` in file name!")
384  ABI_CHECK(ind /= len_trim(ext), sjoin("Wrong string: ", ext))
385  ext = ext(ind+1:)
386 
387  found = .True.
388  select case (ext)
389  case ("DEN")
390    varname = "density"
391  !case ("DEN1")
392  !  varname = "first_order_density"
393  case ("POSITRON")
394    varname = "positron_density"
395  case ("PAWDEN")
396    varname = "pawrhor"
397    ! TODO: Other paw densities
398  case ("ELF")
399    varname = "elfr"
400  case ("ELF_UP")
401    varname = "elfr_up"
402  case ("ELF_DOWN")
403    varname = "elfr_down"
404  case ("GDEN1")
405    varname = "grhor_1"
406  case ("GDEN2")
407    varname = "grhor_2"
408  case ("GDEN3")
409    varname = "grhor_3"
410  case ("KDEN")
411    varname = "kinedr"
412  case ("LDEN")
413    varname = "laprhor"
414  case ("POT")
415    varname = "vtrial"
416  case ("STM")
417    varname = "stm"
418  case ("VHA")
419    varname = "vhartree"
420  case ("VPSP")
421    varname = "vpsp"
422  case ("VHXC")
423    varname = "vhxc"
424  case ("VXC")
425    varname = "exchange_correlation_potential"
426  case ("VCLMB")
427    varname = "vhartree_vloc"
428  case default
429    found = .False.
430  end select
431 
432  if (found) return
433 
434  ! Handle DEN[pertcase]
435  if (startswith(ext, "DEN")) then
436    read(ext(4:), *, iostat=ierr) pertcase
437    if (ierr == 0) then
438      varname = "first_order_density"; return
439    end if
440  end if
441 
442  ! Handle POT[pertcase]
443  if (startswith(ext, "POT")) then
444    read(ext(4:), *, iostat=ierr) pertcase
445    if (ierr == 0) then
446       varname = "first_order_potential"; return
447    end if
448  end if
449 
450  ! Handle VXC[pertcase]
451  if (startswith(ext, "VXC")) then
452    read(ext(4:), *, iostat=ierr) pertcase
453    if (ierr == 0) then
454       varname = "first_order_vxc"; return
455    end if
456  end if
457 
458  ! Handle VHA[pertcase]
459  if (startswith(ext, "VHA")) then
460    read(ext(4:), *, iostat=ierr) pertcase
461    if (ierr == 0) then
462       varname = "first_order_vhartree"; return
463    end if
464  end if
465 
466  ! Handle VPSP[pertcase]
467  if (startswith(ext, "VPSP")) then
468    read(ext(4:), *, iostat=ierr) pertcase
469    if (ierr == 0) then
470       varname = "first_order_vpsp"; return
471    end if
472  end if
473 
474  MSG_ERROR(sjoin("Unknown abinit extension:", ext))
475 
476 end function varname_from_fname