!
! Copyright (C) 2006 WanT Group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
! TB
! included gate related variables in qexml_write_efield and qexml_read_efield
!
!----------------------------------------------------------------------------
MODULE oldxml_qexml_module
  !----------------------------------------------------------------------------
  !
  ! This module contains some common subroutines used to read and write
  ! in XML format the data produced by Quantum ESPRESSO package.
  !
  ! Written by Andrea Ferretti (2006).
  ! Modified by Simone Ziraldo (2013).
  !
  ! Important parts of the implementation are taken from xml_io_base.f90
  ! (written by Carlo Sbraccia) in the Quantum ESPRESSO distribution,
  ! under the GNU-GPL licensing:
  !
  ! Copyright (C) 2005 Quantum ESPRESSO group
  ! This file is distributed under the terms of the
  ! GNU General Public License. See the file `License'
  ! in the root directory of the present distribution,
  ! or http://www.gnu.org/copyleft/gpl.txt .
  !
#if defined(__OLDXML)
  !
  USE iotk_module
  USE kinds, ONLY : DP
  IMPLICIT NONE
  !
  PRIVATE
  SAVE
  !
  ! definitions for the fmt
  !
  CHARACTER(5), PARAMETER :: fmt_name = "QEXML"
  CHARACTER(5), PARAMETER :: fmt_version = "1.4.0"
  !
  ! some default for kinds
  !
  !INTEGER,   PARAMETER :: dbl = selected_real_kind( 14, 200 )
  !
  ! internal data to be set
  !
  CHARACTER(256)   :: datadir_in, datadir_out
  INTEGER          :: iunit, ounit
  !
  ! vars to manage back compatibility
  !
  CHARACTER(10)    :: qexml_current_version = " "
  CHARACTER(10)    :: qexml_default_version = trim( fmt_version  )
  LOGICAL          :: qexml_current_version_init = .false.
  LOGICAL          :: qexml_version_before_1_4_0 = .false.
  !
  CHARACTER(iotk_attlenx) :: attr
  !
  !
  ! end of declarations
  !
  PUBLIC :: qexml_current_version, qexml_default_version
  PUBLIC :: qexml_current_version_init
  !
  PUBLIC :: qexml_init,  qexml_openfile, qexml_closefile
  !
  PUBLIC :: qexml_write_header, qexml_write_control, qexml_write_status_cp, qexml_write_cell,  &
            qexml_write_moving_cell, qexml_write_ions, qexml_write_symmetry, qexml_write_efield, &
            qexml_write_planewaves, qexml_write_spin, qexml_write_magnetization, &
            qexml_write_xc, qexml_write_exx, qexml_write_occ, qexml_write_bz, qexml_write_para, &
            qexml_write_bands_pw,qexml_write_bands_cp, qexml_write_bands_info, qexml_write_eig, &
            qexml_write_gk, qexml_write_wfc, qexml_write_rho, qexml_write_esm
  !
  PUBLIC :: qexml_read_header, qexml_read_status_cp, qexml_read_cell, qexml_read_moving_cell, qexml_read_ions,      &
            qexml_read_symmetry, qexml_read_efield,                   &
            qexml_read_planewaves, qexml_read_spin, qexml_read_xc,    &
            qexml_read_occ, qexml_read_bz, qexml_read_phonon,         &
            qexml_read_bands_pw, qexml_read_bands_cp, qexml_read_bands_info,                  &
            qexml_read_gk, qexml_read_wfc, qexml_read_rho, qexml_read_magnetization, &
            qexml_read_exx, qexml_read_para, qexml_read_esm
  
  !
  PUBLIC :: qexml_wfc_filename, qexml_create_directory, &
            qexml_kpoint_dirname, qexml_restart_dirname
  !
CONTAINS
!
!-------------------------------------------
! ... basic (public) subroutines
!-------------------------------------------
!
    !------------------------------------------------------------------------
    SUBROUTINE qexml_init( unit_in, unit_out, dir, dir_in, dir_out, &
                           datafile, datafile_in, datafile_out )
      !------------------------------------------------------------------------
      !
      ! just init module data
      !
      IMPLICIT NONE
      INTEGER,                INTENT(in) :: unit_in
      INTEGER,      OPTIONAL, INTENT(in) :: unit_out
      CHARACTER(*), OPTIONAL, INTENT(in) :: dir
      CHARACTER(*), OPTIONAL, INTENT(in) :: dir_in, dir_out
      CHARACTER(*), OPTIONAL, INTENT(in) :: datafile
      CHARACTER(*), OPTIONAL, INTENT(in) :: datafile_in, datafile_out
      !
      iunit       = unit_in
      ounit       = unit_in
      IF ( present( unit_out ) ) ounit  = unit_out
      !
      !
      datadir_in  = "./"
      datadir_out = "./"
      !
      ! first check whether datafile is given
      !
      IF ( present( datafile ) ) THEN
          !
          datadir_in = datafile
          CALL qexml_basename ( datadir_in,  "data-file.xml")
          !
          datadir_out = datadir_in
          !
      ENDIF
      !
      IF ( present( datafile_in ) ) THEN
          !
          datadir_in = datafile_in
          CALL qexml_basename ( datadir_in,  "data-file.xml")
          !
      ENDIF
      !
      IF ( present( datafile_out ) ) THEN
          !
          datadir_out = datafile_out
          CALL qexml_basename ( datadir_out,  "data-file.xml")
          !
      ENDIF
      !
      ! the presence of directories overwrites any info
      ! about datafiles
      !
      IF ( present( dir ) ) THEN
          datadir_in  = trim(dir)
          datadir_out = trim(dir)
      ENDIF
      !
      IF ( present( dir_in ) ) THEN
          datadir_in  = trim(dir_in)
      ENDIF
      !
      IF ( present( dir_out ) ) THEN
          datadir_out  = trim(dir_out)
      ENDIF
      !
    END SUBROUTINE qexml_init
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_openfile( filename, action, binary, ierr)
      !------------------------------------------------------------------------
      !
      ! open data file
      !
      IMPLICIT NONE
      !
      CHARACTER(*),       INTENT(in)  :: filename
      CHARACTER(*),       INTENT(in)  :: action      ! ("read"|"write")
      LOGICAL, OPTIONAL,  INTENT(in)  :: binary
      INTEGER,            INTENT(out) :: ierr
      !
      LOGICAL :: binary_

      ierr = 0
      binary_ = .false.
      IF ( present(binary) ) binary_ = binary
      !
      SELECT CASE ( trim(action) )
      !
      CASE ( "read", "READ" )
          !
          CALL iotk_open_read ( iunit, FILE = trim(filename), IERR=ierr )
          IF ( ierr/=0 ) RETURN
          !
          CALL qexml_read_header( FORMAT_VERSION=qexml_current_version, IERR=ierr )
          IF ( ierr/=0 ) qexml_current_version = trim( qexml_default_version )
          !
          !
      CASE ( "write", "WRITE" )
          !
          CALL iotk_open_write( iunit, FILE = trim(filename), BINARY=binary_, IERR=ierr )
          IF ( ierr/=0 ) RETURN
          !
          qexml_current_version = trim( qexml_default_version )
          !
      CASE DEFAULT
          ierr = 1
      END SELECT
      !
      ! init logical variables for versioning
      !
      qexml_version_before_1_4_0 = .false.
      !
      IF ( trim( qexml_version_compare( qexml_current_version, "1.4.0" )) == "older" ) &
         qexml_version_before_1_4_0 = .true.
      !
      qexml_current_version_init = .true.
      !
      !
    END SUBROUTINE qexml_openfile
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_closefile( action, ierr)
      !------------------------------------------------------------------------
      !
      ! close data file
      !
      IMPLICIT NONE
      !
      CHARACTER(*),  INTENT(in)  :: action      ! ("read"|"write")
      INTEGER,       INTENT(out) :: ierr
      !
      ierr = 0
      !
      SELECT CASE ( trim(action) )
      CASE ( "read", "READ" )
          !
          CALL iotk_close_read( iunit, IERR=ierr )
          !
      CASE ( "write", "WRITE" )
          !
          CALL iotk_close_write( iunit, IERR=ierr )
          !
      CASE DEFAULT
          ierr = 2
      END SELECT
      !
    END SUBROUTINE qexml_closefile
!
!-------------------------------------------
! ... basic (private) subroutines
!-------------------------------------------
!
    !------------------------------------------------------------------------
    FUNCTION int_to_char( i )
      !------------------------------------------------------------------------
      !
      IMPLICIT NONE
      !
      INTEGER, INTENT(in) :: i
      CHARACTER (len=6)   :: int_to_char
      !
      !
      IF ( i < 10 ) THEN
         !
         WRITE( UNIT = int_to_char , FMT = "(I1)" ) i
         !
      ELSEIF ( i < 100 ) THEN
         !
         WRITE( UNIT = int_to_char , FMT = "(I2)" ) i
         !
       ELSEIF ( i < 1000 ) THEN
         !
         WRITE( UNIT = int_to_char , FMT = "(I3)" ) i
         !
       ELSEIF ( i < 10000 ) THEN
         !
         WRITE( UNIT = int_to_char , FMT = "(I4)" ) i
         !
       ELSE
         !
       WRITE( UNIT = int_to_char , FMT = "(I5)" ) i
       !
      ENDIF
      !
    END FUNCTION int_to_char
    !
    !
    !--------------------------------------------------------------------------
    SUBROUTINE qexml_basename( str, extension )
      !--------------------------------------------------------------------------
      !
      ! perform the basename operation on the string str, eliminating
      ! any ending (rightmost) occurrence of extension
      !
      CHARACTER(*),  INTENT(inout) :: str
      CHARACTER(*),  INTENT(in)    :: extension
      !
      INTEGER :: ind, strlen, extlen, i
      !
      IF( len_trim(extension) == 0  .or. len_trim(str) == 0 ) RETURN
      !
      strlen = len_trim( str )
      extlen = len_trim( extension )
      ind    = index( str, trim(extension), BACK=.true. )
      !
      IF ( ind <= 0 .or. ind > strlen ) RETURN
      !
      ! we want to cut only the last part of the name
      ! any intermediate matching is rejected
      !
      IF ( strlen -ind +1 /= extlen ) RETURN
      !
      DO i = ind, strlen
         str(i:i) = ' '
      ENDDO
      !
    END SUBROUTINE qexml_basename
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_version_parse(str, major, minor, patch, ierr)
      !--------------------------------------------------------------------------
      !
      ! Determine the major, minor and patch numbers from
      ! a version string with the fmt "i.j.k"
      !
      ! The ierr variable assumes the following values
      !
      ! ierr < 0     emtpy string
      ! ierr = 0     no problem
      ! ierr > 0     fatal error
      !
      IMPLICIT NONE
      CHARACTER(*),     INTENT(in)    :: str
      INTEGER,          INTENT(out)   :: major, minor, patch, ierr
      !
      INTEGER       :: i1, i2, length
      INTEGER       :: ierrtot
      CHARACTER(10) :: num(3)

      !
      major = 0
      minor = 0
      patch = 0

      length = len_trim( str )
      !
      IF ( length == 0 ) THEN
         !
         ierr = -1
         RETURN
         !
      ENDIF

      i1 = scan( str, ".")
      i2 = scan( str, ".", BACK=.true.)
      !
      IF ( i1 == 0 .or. i2 == 0 .or. i1 == i2 ) THEN
         !
         ierr = 1
         RETURN
         !
      ENDIF
      !
      num(1) = str(    1 : i1-1 )
      num(2) = str( i1+1 : i2-1 )
      num(3) = str( i2+1 : )
      !
      ierrtot = 0
      !
      READ( num(1), *, IOSTAT=ierr ) major
      IF (ierr/=0) RETURN
      !
      READ( num(2), *, IOSTAT=ierr ) minor
      IF (ierr/=0) RETURN
      !
      READ( num(3), *, IOSTAT=ierr ) patch
      IF (ierr/=0) RETURN
      !
    END SUBROUTINE qexml_version_parse
    !
    !--------------------------------------------------------------------------
    FUNCTION qexml_version_compare(str1, str2)
      !--------------------------------------------------------------------------
      !
      ! Compare two version strings; the result is
      !
      ! "newer":   str1 is newer that str2
      ! "equal":   str1 is equal   to str2
      ! "older":   str1 is older than str2
      ! " ":       str1 or str2 has a wrong format
      !
      IMPLICIT NONE
      CHARACTER(*)  :: str1, str2
      CHARACTER(10) :: qexml_version_compare
      !
      INTEGER   :: version1(3), version2(3)
      INTEGER   :: basis, icheck1, icheck2
      INTEGER   :: ierr
      !

      qexml_version_compare = " "
      !
      CALL qexml_version_parse( str1, version1(1), version1(2), version1(3), ierr)
      IF ( ierr/=0 ) RETURN
      !
      CALL qexml_version_parse( str2, version2(1), version2(2), version2(3), ierr)
      IF ( ierr/=0 ) RETURN
      !
      !
      basis = 1000
      !
      icheck1 = version1(1) * basis**2 + version1(2)* basis + version1(3)
      icheck2 = version2(1) * basis**2 + version2(2)* basis + version2(3)
      !
      IF ( icheck1 > icheck2 ) THEN
         !
         qexml_version_compare = 'newer'
         !
      ELSEIF( icheck1 == icheck2 ) THEN
         !
         qexml_version_compare = 'equal'
         !
      ELSE
         !
         qexml_version_compare = 'older'
         !
      ENDIF
      !
    END FUNCTION qexml_version_compare
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_create_directory( dirname, ierr )
      !------------------------------------------------------------------------
      !
      USE wrappers,      ONLY : f_mkdir_safe
      !
      CHARACTER(len=*), INTENT(in)  :: dirname
      INTEGER,          INTENT(out) :: ierr
      !
      INTEGER  :: iunaux
      !
      ierr = 0
      CALL iotk_free_unit( iunaux )
      !
      ierr = f_mkdir_safe( TRIM(dirname) )
      !
      IF ( ierr/=0 ) RETURN
      !
      ! ... check whether the scratch directory is writable
      !
      OPEN( iunaux , FILE = trim( dirname ) // '/test', IOSTAT = ierr )
      IF ( ierr/=0 ) RETURN
      !
      CLOSE( iunaux , STATUS = 'DELETE' )
      !
      RETURN
      !
    END SUBROUTINE qexml_create_directory
    !
    !
    !------------------------------------------------------------------------
    FUNCTION qexml_kpoint_dirname( basedir, ik )
      !------------------------------------------------------------------------
      !
      CHARACTER(LEN=256)           :: qexml_kpoint_dirname
      CHARACTER(LEN=*), INTENT(IN) :: basedir
      INTEGER,          INTENT(IN) :: ik
      !
      CHARACTER(LEN=256) :: kdirname
      CHARACTER(LEN=5)   :: kindex
      CHARACTER(LEN=6)   :: kindex1
      !
      IF (ik<99999) THEN
         WRITE( kindex, FMT = '( I5.5 )' ) ik     
         kdirname = TRIM( basedir ) // '/K' // kindex
      ELSEIF (ik<999999) THEN
         WRITE( kindex1, FMT = '( I6.6 )' ) ik     
         kdirname = TRIM( basedir ) // '/K' // kindex1
      ELSE
         call errore('qexml_kpoint_dirname','ik too large, increase format',1)
      ENDIF
      !
      qexml_kpoint_dirname = TRIM( kdirname )
      !
      RETURN
      !
    END FUNCTION qexml_kpoint_dirname
    !
    !
    !------------------------------------------------------------------------
    FUNCTION qexml_wfc_filename( basedir, name, ik, ipol, tag, extension, dir )
      !------------------------------------------------------------------------
      !
      CHARACTER(len=256)                 :: qexml_wfc_filename
      CHARACTER(len=*),       INTENT(in) :: basedir
      CHARACTER(len=*),       INTENT(in) :: name
      INTEGER,                INTENT(in) :: ik
      INTEGER,      OPTIONAL, INTENT(in) :: ipol
      CHARACTER(*), OPTIONAL, INTENT(in) :: tag
      CHARACTER(*), OPTIONAL, INTENT(in) :: extension
      LOGICAL,      OPTIONAL, INTENT(in) :: dir
      !
      CHARACTER(len=256) :: filename, tag_, ext_
      LOGICAL :: dir_true
      !
      !
      filename = ' '
      tag_     = ' '
      ext_     = '.dat'
      dir_true = .true.
      !
      IF ( present( tag ) )         tag_ = '_'//trim(tag)
      IF ( present( extension ) )   ext_ = '.'//trim(extension)
      !
      IF ( present( ipol ) ) THEN
         !
         WRITE( filename, FMT = '( I1 )' ) ipol
         !
      ENDIF
      IF (PRESENT(dir)) dir_true=dir
      !
      IF (dir_true) THEN
         filename = TRIM( qexml_kpoint_dirname( basedir, ik ) ) // '/' // &
                 & TRIM( name ) // TRIM( filename ) // TRIM( tag_ ) // TRIM( ext_)
      ELSE
         filename = TRIM( qexml_kpoint_dirname( basedir, ik ) ) // '_' // &
                 & TRIM( name ) // TRIM( filename ) // TRIM( tag_ ) // TRIM( ext_)
      ENDIF
      !
      !
      qexml_wfc_filename = trim( filename )
      !
      RETURN
      !
    END FUNCTION qexml_wfc_filename
    !
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_copy_file( file_in, file_out, ierr )
      !------------------------------------------------------------------------
      !
      CHARACTER(len=*),  INTENT(in) :: file_in, file_out
      INTEGER,           INTENT(out):: ierr
      !
      CHARACTER(len=256) :: string
      INTEGER            :: iun_in, iun_out, ios
      !
      !
      ierr = 0
      !
      CALL iotk_free_unit( iun_in,  ierr )
      IF ( ierr /= 0) RETURN
      CALL iotk_free_unit( iun_out, ierr )
      IF ( ierr /= 0) RETURN
      !
      OPEN( UNIT = iun_in,  FILE = file_in,  STATUS = "OLD", IOSTAT=ierr )
      IF ( ierr /= 0) RETURN
      OPEN( UNIT = iun_out, FILE = file_out, STATUS = "UNKNOWN", IOSTAT=ierr )
      IF ( ierr /= 0) RETURN
      !
      copy_loop: DO
         !
         READ( UNIT = iun_in, FMT = '(A256)', IOSTAT = ios ) string
         !
         IF ( ios < 0 ) exit copy_loop
         !
         WRITE( UNIT = iun_out, FMT = '(A)' ) trim( string )
         !
      ENDDO copy_loop
      !
      CLOSE( UNIT = iun_in )
      CLOSE( UNIT = iun_out )
      !
      RETURN
      !
    END SUBROUTINE qexml_copy_file
    !
    !
    !------------------------------------------------------------------------
    FUNCTION check_file_exst( filename )
      !------------------------------------------------------------------------
      !
      IMPLICIT NONE
      !
      LOGICAL          :: check_file_exst
      CHARACTER(len=*) :: filename
      !
      LOGICAL :: lexists
      !
      INQUIRE( FILE = trim( filename ), EXIST = lexists )
      !
      check_file_exst = lexists
      RETURN
      !
    END FUNCTION check_file_exst
    !
    !
    !------------------------------------------------------------------------
    FUNCTION qexml_restart_dirname( outdir, prefix, runit )
      !------------------------------------------------------------------------
      !
      CHARACTER(len=256)           :: qexml_restart_dirname
      CHARACTER(len=*), INTENT(in) :: outdir, prefix
      INTEGER,          INTENT(IN) :: runit
      !
      CHARACTER(len=256)         :: dirname
      INTEGER                    :: strlen
      CHARACTER(LEN=6), EXTERNAL :: int_to_char
      !
      ! ... main restart directory
      !
      dirname = TRIM( prefix ) // '_' // TRIM( int_to_char( runit ) )// '.save/'
      !
      IF ( len( outdir ) > 1 ) THEN
         !
         strlen = len_trim( outdir )
         IF ( outdir(strlen:strlen) == '/' ) strlen = strlen -1
         !
         dirname = outdir(1:strlen) // '/' // dirname
         !
      ENDIF
      !
      qexml_restart_dirname = trim( dirname )
      !
      RETURN
      !
    END FUNCTION qexml_restart_dirname
!
!-------------------------------------------
! ... write subroutines
!-------------------------------------------
!
    !------------------------------------------------------------------------
    SUBROUTINE qexml_write_header( creator_name, creator_version )
      !------------------------------------------------------------------------
      !
      IMPLICIT NONE
      CHARACTER(len=*), INTENT(in) :: creator_name, creator_version
      CHARACTER(iotk_attlenx)  :: attr
      !
      CALL iotk_write_begin( ounit, "HEADER" )
      !
      CALL iotk_write_attr(attr, "NAME",trim(fmt_name), FIRST=.true.)
      CALL iotk_write_attr(attr, "VERSION",trim(fmt_version) )
      CALL iotk_write_empty( ounit, "FORMAT", ATTR=attr )
      !
      CALL iotk_write_attr(attr, "NAME",trim(creator_name), FIRST=.true.)
      CALL iotk_write_attr(attr, "VERSION",trim(creator_version) )
      CALL iotk_write_empty( ounit, "CREATOR", ATTR=attr )
      !
      CALL iotk_write_end( ounit, "HEADER" )
      !
    END SUBROUTINE qexml_write_header
    !
    !
    !------------------------------------------------------------------------  
    SUBROUTINE qexml_write_control( pp_check_flag, lkpoint_dir, q_real_space, tq_smoothing, tbeta_smoothing, beta_real_space)
      !------------------------------------------------------------------------
      !
      IMPLICIT NONE
      LOGICAL, OPTIONAL, INTENT(IN) :: pp_check_flag, lkpoint_dir, q_real_space, tq_smoothing, tbeta_smoothing, beta_real_space


      CALL iotk_write_begin( ounit, "CONTROL" )
      !
      !  This flag is used to check if the file can be used for post-processing
      IF ( PRESENT( pp_check_flag ) ) &
         CALL iotk_write_dat( ounit, "PP_CHECK_FLAG", pp_check_flag )
      !
      !  This flag says how eigenvalues are saved
      IF ( PRESENT( lkpoint_dir ) ) &
         CALL iotk_write_dat( ounit, "LKPOINT_DIR", lkpoint_dir )
      !
      !  This flag says if Q in real space has to be used
      IF ( PRESENT( q_real_space ) ) &
         CALL iotk_write_dat( ounit, "Q_REAL_SPACE", q_real_space )
      ! This flag says if Beta functions were treated in real space
      IF ( PRESENT( beta_real_space ) ) &
         CALL iotk_write_dat( ounit, "BETA_REAL_SPACE", beta_real_space )
      ! This flag says if the Q are being smoothed 
      IF ( PRESENT( tq_smoothing ) ) &
         CALL iotk_write_dat( ounit, "TQ_SMOOTHING", tq_smoothing )
      ! This flag says if the beta are being smoothed 
      IF ( PRESENT( tbeta_smoothing ) ) &
         CALL iotk_write_dat( ounit, "TBETA_SMOOTHING", tbeta_smoothing )
      !
      CALL iotk_write_end( ounit, "CONTROL" )
      !
    END SUBROUTINE qexml_write_control
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_write_status_cp( nfi,simtime,time_units,title, &
                                  ekin, eht, esr, eself, epseu, enl, exc, vave, enthal, &
                                  energy_units)
      !------------------------------------------------------------------------
      !
      INTEGER, INTENT(in) :: nfi
      REAL(DP), INTENT(in) :: simtime, ekin,eht,esr,eself,epseu,enl,exc,vave,enthal
      CHARACTER(len=*), INTENT(in) :: time_units, title, energy_units
      
      CALL iotk_write_begin( ounit, "STATUS" )
      !
      CALL iotk_write_attr( attr, "ITERATION", nfi, FIRST = .TRUE. )
      CALL iotk_write_empty( ounit, "STEP", attr )
      !
      CALL iotk_write_attr( attr, "UNITS", time_units, FIRST = .TRUE. )
      CALL iotk_write_dat( ounit, "TIME", simtime, ATTR = attr )
      !
      CALL iotk_write_dat( ounit, "TITLE", title )
      !
      CALL iotk_write_attr( attr, "UNITS", energy_units, FIRST = .TRUE. )
      CALL iotk_write_dat( ounit, "KINETIC_ENERGY", ekin,   ATTR = attr )
      CALL iotk_write_dat( ounit, "HARTREE_ENERGY", eht,    ATTR = attr )
      CALL iotk_write_dat( ounit, "EWALD_TERM",     esr,    ATTR = attr )
      CALL iotk_write_dat( ounit, "GAUSS_SELFINT",  eself,  ATTR = attr )
      CALL iotk_write_dat( ounit, "LPSP_ENERGY",    epseu,  ATTR = attr )
      CALL iotk_write_dat( ounit, "NLPSP_ENERGY",   enl,    ATTR = attr )
      CALL iotk_write_dat( ounit, "EXC_ENERGY",     exc,    ATTR = attr )
      CALL iotk_write_dat( ounit, "AVERAGE_POT",    vave,   ATTR = attr )
      CALL iotk_write_dat( ounit, "ENTHALPY",       enthal, ATTR = attr )
      !
      CALL iotk_write_end( ounit, "STATUS" )
      !
    END SUBROUTINE qexml_write_status_cp
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_write_cell( ibravais_latt, celldm, alat, &
                                 a1, a2, a3, b1, b2, b3, alat_units, a_units, b_units, &
                                 do_mp, do_mt, do_esm, do_cutoff_2D) 
      !------------------------------------------------------------------------
      !
      INTEGER,          INTENT(in) :: ibravais_latt
      REAL(DP),        INTENT(in) :: celldm(6), alat
      REAL(DP),        INTENT(in) :: a1(3), a2(3), a3(3)
      REAL(DP),        INTENT(in) :: b1(3), b2(3), b3(3)
      CHARACTER(len=*), INTENT(in) :: alat_units, a_units, b_units
      LOGICAL,          INTENT(in) :: do_mp, do_mt, do_esm , do_cutoff_2D
      !
      CHARACTER(len=256) :: bravais_lattice, es_corr
      !
      CALL iotk_write_begin( ounit, "CELL" )
      !
      SELECT CASE ( ibravais_latt )
        CASE(  0 )
           bravais_lattice = "free"
        CASE(  1 )
           bravais_lattice = "cubic P (sc)"
        CASE(  2 )
           bravais_lattice = "cubic F (fcc)"
        CASE(  3 )
           bravais_lattice = "cubic I (bcc)"
        CASE(  4 )
           bravais_lattice = "Hexagonal and Trigonal P"
        CASE(  5 )
           bravais_lattice = "Trigonal R"
        CASE(  6 )
           bravais_lattice = "Tetragonal P (st)"
        CASE(  7 )
           bravais_lattice = "Tetragonal I (bct)"
        CASE(  8 )
           bravais_lattice = "Orthorhombic P"
        CASE(  9 )
           bravais_lattice = "Orthorhombic base-centered(bco)"
        CASE( 10 )
           bravais_lattice = "Orthorhombic face-centered"
        CASE( 11 )
           bravais_lattice = "Orthorhombic body-centered"
        CASE( 12 )
           bravais_lattice = "Monoclinic P"
        CASE( 13 )
           bravais_lattice = "Monoclinic base-centered"
        CASE( 14 )
           bravais_lattice = "Triclinic P"
      END SELECT
      !
      IF(do_mp)THEN
        es_corr = "Makov-Payne"
      ELSE IF(do_mt) THEN
        es_corr = "Martyna-Tuckerman"
      ELSE IF(do_esm) THEN
        es_corr = "ESM"
      ELSE IF(do_cutoff_2D) THEN
        es_corr = "2D"
      ELSE
        es_corr = "None"
      ENDIF
      !
      CALL iotk_write_dat( ounit, &
                           "NON-PERIODIC_CELL_CORRECTION", TRIM( es_corr ) )
      !
      CALL iotk_write_dat( ounit, &
                           "BRAVAIS_LATTICE", trim( bravais_lattice ) )
      !
      !
      CALL iotk_write_attr( attr, "UNITS", trim(alat_units), FIRST = .true. )
      CALL iotk_write_dat( ounit, "LATTICE_PARAMETER", alat, ATTR = attr )
      !
      CALL iotk_write_dat( ounit, "CELL_DIMENSIONS", celldm(1:6) )
      !
      CALL iotk_write_attr ( attr,   "UNITS", trim(a_units), FIRST = .true. )
      CALL iotk_write_begin( ounit, "DIRECT_LATTICE_VECTORS" )
      CALL iotk_write_empty( ounit, "UNITS_FOR_DIRECT_LATTICE_VECTORS", &
                                     ATTR=attr )
      CALL iotk_write_dat(   ounit, "a1", a1(:) * alat, COLUMNS=3 )
      CALL iotk_write_dat(   ounit, "a2", a2(:) * alat, COLUMNS=3 )
      CALL iotk_write_dat(   ounit, "a3", a3(:) * alat, COLUMNS=3 )
      CALL iotk_write_end(   ounit, "DIRECT_LATTICE_VECTORS" )
      !
      CALL iotk_write_attr ( attr,   "UNITS", trim(b_units), FIRST = .true. )
      CALL iotk_write_begin( ounit, "RECIPROCAL_LATTICE_VECTORS" )
      CALL iotk_write_empty( ounit, "UNITS_FOR_RECIPROCAL_LATTICE_VECTORS", &
                                     ATTR=attr )
      CALL iotk_write_dat(   ounit, "b1", b1(:), COLUMNS=3 )
      CALL iotk_write_dat(   ounit, "b2", b2(:), COLUMNS=3 )
      CALL iotk_write_dat(   ounit, "b3", b3(:), COLUMNS=3 )
      CALL iotk_write_end(   ounit, "RECIPROCAL_LATTICE_VECTORS" )
      !
      CALL iotk_write_end( ounit, "CELL" )
      !
    END SUBROUTINE qexml_write_cell
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_write_moving_cell(lmovecell, cell_factor)
      !------------------------------------------------------------------------
      !
      LOGICAL, INTENT(IN) :: lmovecell
      REAL(DP), INTENT(IN) :: cell_factor
      !
      CALL iotk_write_begin( ounit, "MOVING_CELL" )
      CALL iotk_write_dat( ounit, "CELL_FACTOR", cell_factor)
      CALL iotk_write_end( ounit, "MOVING_CELL"  )
      !
    END SUBROUTINE qexml_write_moving_cell
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_write_ions( nsp, nat, atm, ityp, psfile, pseudo_dir,  &
                                 amass, amass_units, tau, tau_units, &
                                 if_pos, dirname, pos_unit )
      !------------------------------------------------------------------------
      !
      USE wrappers, ONLY: f_copy
      !
      INTEGER,          INTENT(in) :: nsp, nat
      INTEGER,          INTENT(in) :: ityp(:)
      CHARACTER(len=*), INTENT(in) :: atm(:)
      CHARACTER(len=*), INTENT(in) :: psfile(:)
      CHARACTER(len=*), INTENT(in) :: pseudo_dir
      CHARACTER(len=*), INTENT(in) :: dirname
      REAL(DP),        INTENT(in) :: amass(:)
      CHARACTER(len=*), INTENT(in) :: amass_units
      REAL(DP),        INTENT(in) :: tau(:,:)
      CHARACTER(len=*), INTENT(in) :: tau_units
      INTEGER,          INTENT(in) :: if_pos(:,:)
      REAL(DP),         INTENT(in) :: pos_unit
      !
      INTEGER            :: i, flen, flen2, ierrl
      CHARACTER(len=256) :: file_pseudo_in, file_pseudo_out
      LOGICAL            :: pseudo_exists
      !
      !
      CALL iotk_write_begin( ounit, "IONS" )
      !
      CALL iotk_write_dat( ounit, "NUMBER_OF_ATOMS", nat )
      !
      CALL iotk_write_dat( ounit, "NUMBER_OF_SPECIES", nsp )
      !
      flen = len_trim( pseudo_dir )
      flen2 = len_trim( dirname )
      !
      CALL iotk_write_attr ( attr, "UNITS", trim(amass_units), FIRST = .true. )
      CALL iotk_write_empty( ounit, "UNITS_FOR_ATOMIC_MASSES", ATTR = attr )
      !
      DO i = 1, nsp
         !
         CALL iotk_write_begin( ounit, "SPECIE"//trim(iotk_index(i)) )
         !
         CALL iotk_write_dat( ounit, "ATOM_TYPE", atm(i) )
         !
         CALL iotk_write_dat( ounit, "MASS", amass(i) )
         !
         CALL iotk_write_dat( ounit, "PSEUDO", trim( psfile(i) ) )
         !
         CALL iotk_write_end( ounit, "SPECIE"//trim(iotk_index(i)) )
         !
         ! copy pseudopotential file into data directory
         !
         IF ( pseudo_dir(flen:flen) /= '/' ) THEN
            file_pseudo_in = pseudo_dir(1:flen) // '/' // TRIM(psfile(i))
         ELSE
            file_pseudo_in = pseudo_dir(1:flen) // TRIM(psfile(i))
         ENDIF
         !
         IF ( dirname(flen2:flen2) /= '/' ) THEN
            file_pseudo_out = dirname(1:flen2) // '/' // TRIM(psfile(i))
         ELSE
            file_pseudo_out = dirname(1:flen2) // TRIM(psfile(i))
         END IF
         !
         IF ( file_pseudo_in .ne. file_pseudo_out ) THEN
            !
            INQUIRE ( FILE=file_pseudo_in, EXIST = pseudo_exists )
            IF ( pseudo_exists ) THEN
               ierrl = f_copy( file_pseudo_in, file_pseudo_out )
            ELSE
               CALL infomsg( 'write_ions', &
                   'file ' // TRIM( file_pseudo_in) // ' not present' )
            END IF
            !
         END IF
         !
      ENDDO
      !
      !
      CALL iotk_write_dat( ounit, "PSEUDO_DIR", trim( pseudo_dir) )
      !
      CALL iotk_write_attr( attr, "UNITS", trim(tau_units), FIRST = .true. )
      CALL iotk_write_empty( ounit, "UNITS_FOR_ATOMIC_POSITIONS", ATTR = attr )
      !
      DO i = 1, nat
         !
         CALL iotk_write_attr( attr, "SPECIES", atm( ityp(i) ), FIRST = .true. )
         CALL iotk_write_attr( attr, "INDEX",  ityp(i) )
         CALL iotk_write_attr( attr, "tau",    tau(:,i)*pos_unit )
         CALL iotk_write_attr( attr, "if_pos", if_pos(:,i) )
         CALL iotk_write_empty( ounit, "ATOM" // trim( iotk_index( i ) ), attr )
         !
      ENDDO
      !
      CALL iotk_write_end( ounit, "IONS" )
      !
    END SUBROUTINE qexml_write_ions
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_write_symmetry( ibrav, nrot, nsym, invsym, noinv, &
                               time_reversal, no_t_rev, ft, &
                               s, sname, s_units, irt, nat, t_rev )
      !------------------------------------------------------------------------
      !
      INTEGER,          INTENT(in) :: ibrav, nrot, nsym
      LOGICAL,          INTENT(in) :: invsym, noinv, time_reversal, no_t_rev
      INTEGER,          INTENT(in) :: s(:,:,:), irt(:,:), nat, t_rev(:)
      REAL(DP),         INTENT(in) :: ft(:,:)
      CHARACTER(LEN=*), INTENT(in) :: sname(:),s_units
      !
      INTEGER  :: i
      !
      !
      CALL iotk_write_begin( ounit, "SYMMETRIES" )
      !
      CALL iotk_write_dat( ounit, "NUMBER_OF_SYMMETRIES", nsym )
      CALL iotk_write_dat( ounit, "NUMBER_OF_BRAVAIS_SYMMETRIES", nrot )
      !
      CALL iotk_write_dat( ounit, "INVERSION_SYMMETRY", invsym )
      !
      CALL iotk_write_dat( ounit, "DO_NOT_USE_TIME_REVERSAL", noinv )
      !
      CALL iotk_write_dat( ounit, "TIME_REVERSAL_FLAG", time_reversal )
      !
      CALL iotk_write_dat( ounit, "NO_TIME_REV_OPERATIONS", no_t_rev )
      !
      CALL iotk_write_dat( ounit, "NUMBER_OF_ATOMS", nat )
      !
      CALL iotk_write_attr( attr, "UNITS", TRIM(s_units), FIRST = .TRUE. )
      CALL iotk_write_empty( ounit, "UNITS_FOR_SYMMETRIES", ATTR = attr )
      !
      DO i = 1, nsym
         !
         CALL iotk_write_begin( ounit, "SYMM" // TRIM( iotk_index( i ) ) )
         !
         CALL iotk_write_attr ( attr, "NAME", TRIM( sname(i) ), FIRST=.TRUE. )
         CALL iotk_write_attr ( attr, "T_REV", t_rev(i) )
         CALL iotk_write_empty( ounit, "INFO", ATTR = attr )
         !
         CALL iotk_write_dat( ounit, "ROTATION", s(:,:,i), COLUMNS=3 )
         CALL iotk_write_dat( ounit, "FRACTIONAL_TRANSLATION", ft(:,i), COLUMNS=3 )
         !
         IF ( nat > 0 ) &
            CALL iotk_write_dat( ounit, "EQUIVALENT_IONS", irt(i,1:nat), COLUMNS=8 )
         !
         CALL iotk_write_end( ounit, "SYMM" // TRIM( iotk_index( i ) ) )
         !
      ENDDO
      !
      ! ... the following are the symmetries of the Bravais lattice alone
      ! ... (they may be more than crystal, i.e. basis+lattice, symmetries)
      !
      DO i = nsym+1, nrot
         !
         CALL iotk_write_begin( ounit, "SYMM" // TRIM( iotk_index( i ) ) )
         !
         CALL iotk_write_attr ( attr, "NAME", TRIM( sname(i) ), FIRST=.TRUE. )
         CALL iotk_write_empty( ounit, "INFO", ATTR = attr )
         CALL iotk_write_dat( ounit, "ROTATION", s(:,:,i), COLUMNS=3 )
         !
         CALL iotk_write_end( ounit, "SYMM" // TRIM( iotk_index( i ) ) )
         !
      ENDDO
      !
      CALL iotk_write_end( ounit, "SYMMETRIES" )
      !
    END SUBROUTINE qexml_write_symmetry
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_write_efield( tefield, dipfield, edir, emaxpos, eopreg, eamp, &
                                   gate, zgate, relaxz, block, block_1, block_2,&
                                   block_height)
     !------------------------------------------------------------------------
     !
      LOGICAL, INTENT(in)   :: tefield        ! if .TRUE. a finite electric field
                                              ! is added to the local potential
      LOGICAL, INTENT(in)   :: dipfield       ! if .TRUE. the dipole field is subtracted
      LOGICAL, INTENT(in)   :: gate           ! if .TRUE. counter charge is represented by charged plate
      LOGICAL, INTENT(in)   :: block          ! add potential barrier
      LOGICAL, INTENT(in)   :: relaxz         ! relax in z direction  
      INTEGER, INTENT(in)   :: edir           ! direction of the field
      REAL(DP), INTENT(in) :: emaxpos        ! position of the maximum of the field (0<emaxpos<1)
      REAL(DP), INTENT(in) :: eopreg         ! amplitude of the inverse region (0<eopreg<1)
      REAL(DP), INTENT(in) :: eamp           ! field amplitude (in a.u.) (1 a.u. = 51.44 10^11 V/m)
      REAL(DP), INTENT(in) :: zgate          ! position of charged plate in units of cell vector in z direction
      REAL(DP), INTENT(in) :: block_1        ! potential barrier
      REAL(DP), INTENT(in) :: block_2
      REAL(DP), INTENT(in) :: block_height
      !
      !
      CALL iotk_write_begin( ounit, "ELECTRIC_FIELD" )
      !
      CALL iotk_write_dat( ounit, "HAS_ELECTRIC_FIELD", tefield )
      !
      CALL iotk_write_dat( ounit, "HAS_DIPOLE_CORRECTION", dipfield )
      !
      CALL iotk_write_dat( ounit, "FIELD_DIRECTION", edir )
      !
      CALL iotk_write_dat( ounit, "MAXIMUM_POSITION", emaxpos )
      !
      CALL iotk_write_dat( ounit, "INVERSE_REGION", eopreg )
      !
      CALL iotk_write_dat( ounit, "FIELD_AMPLITUDE", eamp )
      !
      CALL iotk_write_dat( ounit, "CHARGED_PLATE", gate )
      !
      CALL iotk_write_dat( ounit, "GATE_POS", zgate )
      !
      CALL iotk_write_dat( ounit, "RELAX_Z", relaxz )
      !
      CALL iotk_write_dat( ounit, "BLOCK", block )
      !
      CALL iotk_write_dat( ounit, "BLOCK_1", block_1 )
      !
      CALL iotk_write_dat( ounit, "BLOCK_2", block_2 )
      !
      CALL iotk_write_dat( ounit, "BLOCK_HEIGHT", block_height )
      !
      CALL iotk_write_end( ounit, "ELECTRIC_FIELD" )
      !
    END SUBROUTINE qexml_write_efield
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_write_planewaves( ecutwfc, ecutrho, npwx, gamma_only, &
                                       nr1, nr2, nr3,  ngm,  nr1s, nr2s, nr3s, ngms, &
                                       nr1b, nr2b, nr3b, igv, lgvec, cutoff_units )
      !------------------------------------------------------------------------
#if defined __HDF5
      USE hdf5_qe
      USE mp_pools,  ONLY : inter_pool_comm
      USE io_files,  ONLY : tmp_dir
      USE mp_world,  ONLY : mpime
#endif

      !
      INTEGER,       INTENT(in) :: npwx, nr1, nr2, nr3, ngm, &
                                   nr1s, nr2s, nr3s, ngms, nr1b, nr2b, nr3b
      INTEGER,       INTENT(in) :: igv(:,:)
      REAL(DP),     INTENT(in) :: ecutwfc, ecutrho
      LOGICAL,       INTENT(in) :: gamma_only, lgvec
      CHARACTER(*),  INTENT(in) :: cutoff_units
#if defined __HDF5
      CHARACTER(LEN=256) :: filename_hdf5
      integer           :: ierr
#endif

      !
      !
#if defined __HDF5
      filename_hdf5=trim(tmp_dir) //"g.hdf5"
      CALL prepare_for_writing_final(g_hdf5_write,inter_pool_comm,filename_hdf5)
      CALL add_attributes_hdf5(g_hdf5_write,ecutwfc,"WFC_CUTOFF")
      CALL add_attributes_hdf5(g_hdf5_write,ecutrho,"RHO_CUTOFF")
      CALL add_attributes_hdf5(g_hdf5_write,npwx,"MAX_NUMBER_OF_GK-VECTORS")
      CALL add_attributes_hdf5(g_hdf5_write,gamma_only,"GAMMA_ONLY")
      CALL add_attributes_hdf5(g_hdf5_write,trim(cutoff_units),"UNITS_FOR_CUTOFF")
      CALL add_attributes_hdf5(g_hdf5_write,nr1,"nr1")
      CALL add_attributes_hdf5(g_hdf5_write,nr2,"nr2")
      CALL add_attributes_hdf5(g_hdf5_write,nr3,"nr3")
      CALL add_attributes_hdf5(g_hdf5_write,ngm,"GVECT_NUMBER")
      CALL add_attributes_hdf5(g_hdf5_write,nr1s,"nr1s")
      CALL add_attributes_hdf5(g_hdf5_write,nr2s,"nr2s")
      CALL add_attributes_hdf5(g_hdf5_write,nr3s,"nr3s")
      CALL add_attributes_hdf5(g_hdf5_write,ngms,"SMOOTH_GVECT_NUMBER")
      CALL add_attributes_hdf5(g_hdf5_write,nr1s,"nr1b")
      CALL add_attributes_hdf5(g_hdf5_write,nr2s,"nr2b")
      CALL add_attributes_hdf5(g_hdf5_write,nr3s,"nr3b")
#endif

      CALL iotk_write_begin( ounit, "PLANE_WAVES" )
      !
      CALL iotk_write_attr ( attr, "UNITS", trim(cutoff_units), FIRST = .true. )
      CALL iotk_write_empty( ounit, "UNITS_FOR_CUTOFF", ATTR = attr )
      !
      CALL iotk_write_dat( ounit, "WFC_CUTOFF", ecutwfc )
      !
      CALL iotk_write_dat( ounit, "RHO_CUTOFF", ecutrho )
      !
      CALL iotk_write_dat( ounit, "MAX_NUMBER_OF_GK-VECTORS", npwx )
      !
      CALL iotk_write_dat( ounit, "GAMMA_ONLY", gamma_only )
      !
      CALL iotk_write_attr( attr, "nr1", nr1, FIRST = .true. )
      CALL iotk_write_attr( attr, "nr2", nr2 )
      CALL iotk_write_attr( attr, "nr3", nr3 )
      CALL iotk_write_empty( ounit, "FFT_GRID", ATTR = attr )
      !
      CALL iotk_write_dat( ounit, "GVECT_NUMBER", ngm )
      !
      CALL iotk_write_attr( attr, "nr1s", nr1s, FIRST = .true. )
      CALL iotk_write_attr( attr, "nr2s", nr2s )
      CALL iotk_write_attr( attr, "nr3s", nr3s )
      CALL iotk_write_empty( ounit, "SMOOTH_FFT_GRID", ATTR = attr )
      !
      CALL iotk_write_dat( ounit, "SMOOTH_GVECT_NUMBER", ngms )
      !
      IF ( lgvec ) THEN
         !
         ! ... write the G-vectors
         !
#if defined __HDF5
         CALL write_g(g_hdf5_write,igv(1:3,1:ngm))
#else
         CALL iotk_link( ounit, "G-VECTORS", "./gvectors.dat", &
                         CREATE = .true., BINARY = .true. )
         !
         CALL iotk_write_begin( ounit, "G-VECTORS" )
         !
         CALL iotk_write_attr( attr, "nr1s", nr1s, FIRST = .true. )
         CALL iotk_write_attr( attr, "nr2s", nr2s )
         CALL iotk_write_attr( attr, "nr3s", nr3s )
         CALL iotk_write_attr( attr, "gvect_number", ngm )
         CALL iotk_write_attr( attr, "gamma_only", gamma_only )
         CALL iotk_write_attr( attr, "units", "crystal" )
         CALL iotk_write_empty( ounit, "INFO", ATTR = attr )
         !

         CALL iotk_write_dat  ( ounit, "g", igv(1:3,1:ngm), COLUMNS = 3 )
         CALL iotk_write_end  ( ounit, "G-VECTORS" )
#endif
      ENDIF
      !
      CALL iotk_write_attr( attr, "nr1b", nr1b , FIRST = .true. )
      CALL iotk_write_attr( attr, "nr2b", nr2b )
      CALL iotk_write_attr( attr, "nr3b", nr3b )
      CALL iotk_write_empty( ounit, "SMALLBOX_FFT_GRID", ATTR = attr )
      !
      CALL iotk_write_end( ounit, "PLANE_WAVES" )
#if defined __HDF5
      CALL h5fclose_f(g_hdf5_write%file_id,ierr)
#endif
      !
    END SUBROUTINE qexml_write_planewaves
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_write_gk( ik, npwk, npwkx, gamma_only, xk, k_units, index, igk )
      !------------------------------------------------------------------------
      !
      INTEGER,      INTENT(in) :: ik
      INTEGER,      INTENT(in) :: npwk, npwkx
      LOGICAL,      INTENT(in) :: gamma_only
      REAL(DP),    INTENT(in) :: xk(3)
      CHARACTER(*), INTENT(in) :: k_units
      LOGICAL,      INTENT(in) :: index(:), igk(:,:)
      !
      INTEGER        :: iunaux
      CHARACTER(256) :: filename

      CALL iotk_free_unit( iunaux )
      filename = qexml_wfc_filename( datadir_out, 'gkvectors', ik )
      !
      CALL iotk_open_write( iunaux, FILE = trim( filename ), &
                            ROOT="GK-VECTORS", BINARY = .true. )
      !
      CALL iotk_write_dat( iunaux, "NUMBER_OF_GK-VECTORS", npwk )
      CALL iotk_write_dat( iunaux, "MAX_NUMBER_OF_GK-VECTORS", npwkx )
      CALL iotk_write_dat( iunaux, "GAMMA_ONLY", gamma_only )
      !
      CALL iotk_write_attr ( attr, "UNITS", trim(k_units), FIRST = .true. )
      CALL iotk_write_dat( iunaux, "K-POINT_COORDS", xk, ATTR = attr )
      !
      CALL iotk_write_dat( iunaux, "INDEX", index(1:npwk) )
      CALL iotk_write_dat( iunaux, "GRID", igk(1:npwk,ik), COLUMNS = 3 )
      !
      CALL iotk_close_write( iunaux )
      !
    END SUBROUTINE qexml_write_gk
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_write_spin( lsda, noncolin, npol, lspinorb, domag )
      !------------------------------------------------------------------------
      !
      LOGICAL, INTENT(in) :: lsda, noncolin, lspinorb, domag
      INTEGER, INTENT(in) :: npol
      !
      !
      CALL iotk_write_begin( ounit, "SPIN" )
      !
      CALL iotk_write_dat( ounit, "LSDA", lsda )
      !
      CALL iotk_write_dat( ounit, "NON-COLINEAR_CALCULATION", noncolin )
      !
      IF ( noncolin ) &
         CALL iotk_write_dat( ounit, "SPINOR_DIM", npol )
      !
      CALL iotk_write_dat( ounit, "SPIN-ORBIT_CALCULATION", lspinorb )
      CALL iotk_write_dat( ounit, "SPIN-ORBIT_DOMAG", domag )
      !
      CALL iotk_write_end( ounit, "SPIN" )
      !
    END SUBROUTINE qexml_write_spin
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_write_magnetization(starting_magnetization, angle1, angle2, &
                                   nsp, two_fermi_energies, i_cons, mcons, bfield, &
                                   ef_up, ef_dw, nelup, neldw, lambda, energy_units)
      !------------------------------------------------------------------------
      !
      !
      IMPLICIT NONE
      INTEGER,  INTENT(IN) :: nsp, i_cons
      REAL(DP), INTENT(IN) :: starting_magnetization(nsp), &
                              angle1(nsp), angle2(nsp), mcons(3,nsp), &
                              bfield(3), ef_up, ef_dw, nelup, neldw, lambda
      LOGICAL,  INTENT(IN) :: two_fermi_energies
      CHARACTER(*),       INTENT(IN) :: energy_units
      !
      INTEGER :: i
      !
      CALL iotk_write_begin( ounit, "MAGNETIZATION_INIT" )

      CALL iotk_write_dat( ounit,"CONSTRAINT_MAG", i_cons)

      CALL iotk_write_dat( ounit, "NUMBER_OF_SPECIES", nsp ) 

      DO i = 1, nsp
         !
         CALL iotk_write_begin( ounit, "SPECIE"//TRIM(iotk_index(i)) )
         !
         CALL iotk_write_dat( ounit, "STARTING_MAGNETIZATION",  &
                                       starting_magnetization(i) )
         CALL iotk_write_dat( ounit, "ANGLE1", &
                                       angle1(i) )
         CALL iotk_write_dat( ounit, "ANGLE2", &
                                       angle2(i) )
         IF (i_cons==1.OR.i_cons==2) THEN
            CALL iotk_write_dat( ounit, "CONSTRANT_1", mcons(1,i) )
            CALL iotk_write_dat( ounit, "CONSTRANT_2", mcons(2,i) )
            CALL iotk_write_dat( ounit, "CONSTRANT_3", mcons(3,i) )
         ENDIF
         !
         CALL iotk_write_end( ounit, "SPECIE"//TRIM(iotk_index(i)) )
         !
      ENDDO
      !
      IF (i_cons==3) THEN
         !
         CALL iotk_write_dat( ounit, "FIXED_MAGNETIZATION_1", mcons(1,1) )
         CALL iotk_write_dat( ounit, "FIXED_MAGNETIZATION_2", mcons(2,1) )
         CALL iotk_write_dat( ounit, "FIXED_MAGNETIZATION_3", mcons(3,1) )
         !
      ELSE IF (i_cons==4) THEN
         !
         CALL iotk_write_dat( ounit, "MAGNETIC_FIELD_1", bfield(1) )
         CALL iotk_write_dat( ounit, "MAGNETIC_FIELD_2", bfield(2) )
         CALL iotk_write_dat( ounit, "MAGNETIC_FIELD_3", bfield(3) )
         !
      ENDIF
      !
      CALL iotk_write_dat(ounit,"TWO_FERMI_ENERGIES",two_fermi_energies)
      !
      IF (two_fermi_energies) THEN
         !
         CALL iotk_write_attr ( attr, "UNITS", trim(energy_units), FIRST = .TRUE. )
         CALL iotk_write_empty( ounit, "UNITS_FOR_ENERGIES", ATTR = attr )
         !
         CALL iotk_write_dat( ounit, "FIXED_MAGNETIZATION", mcons(3,1) )
         CALL iotk_write_dat( ounit, "ELECTRONS_UP", nelup )
         CALL iotk_write_dat( ounit, "ELECTRONS_DOWN", neldw )
         CALL iotk_write_dat( ounit, "FERMI_ENERGY_UP", ef_up )
         CALL iotk_write_dat( ounit, "FERMI_ENERGY_DOWN", ef_dw )
         !
      ENDIF
      !
      IF (i_cons>0) CALL iotk_write_dat(ounit,"LAMBDA",lambda)
      !
      CALL iotk_write_end( ounit, "MAGNETIZATION_INIT" )
      !
    RETURN
    !
    END SUBROUTINE qexml_write_magnetization
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_write_xc( dft, nsp, lda_plus_u, lda_plus_u_kind, U_projection, &
                         Hubbard_lmax, Hubbard_l, Hubbard_U, Hubbard_J, Hubbard_J0, &
                         Hubbard_beta, Hubbard_alpha,                               &
                         inlc, vdw_table_name, pseudo_dir, acfdt_in_pw, dirname, & 
                         llondon, london_s6, london_rcut, london_c6, london_rvdw, &
                         lxdm, ts_vdw, vdw_isolated )
      !------------------------------------------------------------------------
      !
      CHARACTER(LEN=*),   INTENT(IN) :: dft
      LOGICAL,            INTENT(IN) :: lda_plus_u
      INTEGER,  OPTIONAL, INTENT(IN) :: lda_plus_u_kind
      INTEGER,  OPTIONAL, INTENT(IN) :: nsp
      CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: U_projection
      INTEGER,  OPTIONAL, INTENT(IN) :: Hubbard_lmax
      INTEGER,  OPTIONAL, INTENT(IN) :: Hubbard_l(:)
      REAL(DP), OPTIONAL, INTENT(IN) :: Hubbard_U(:), Hubbard_J(:,:), Hubbard_alpha(:), &
                                        Hubbard_J0(:), Hubbard_beta(:)
      INTEGER,  OPTIONAL, INTENT(IN) :: inlc
      CHARACTER(LEN=*), OPTIONAL,   INTENT(IN) :: vdw_table_name, pseudo_dir, dirname
      LOGICAL, OPTIONAL,  INTENT(IN) :: acfdt_in_pw
      !
      LOGICAL,  OPTIONAL, INTENT(IN) :: llondon, lxdm, ts_vdw, vdw_isolated
      REAL(DP), OPTIONAL, INTENT(IN) :: london_s6, london_rcut, london_c6(:), london_rvdw(:)

      INTEGER            :: i, flen, ierrl
      CHARACTER(LEN=256) :: file_table
      !
      CALL iotk_write_begin( ounit, "EXCHANGE_CORRELATION" )
      !
      CALL iotk_write_dat( ounit, "DFT", dft )
      !
      IF ( lda_plus_u .OR. (PRESENT(llondon) .AND. llondon) ) THEN         
         ! N.B.: nsp is needed for LDA+U and DFT-D2
         IF ( .NOT. PRESENT( nsp ) ) &
              CALL errore( 'write_xc', ' variable nsp not present', 1 )
         CALL iotk_write_dat( ounit, "NUMBER_OF_SPECIES", nsp )
      ENDIF
      !
      IF ( lda_plus_u ) THEN
         !
         IF ( .NOT. PRESENT( Hubbard_lmax ) .OR. &
              .NOT. PRESENT( Hubbard_l )    .OR. & 
              .NOT. PRESENT( Hubbard_U )    ) &
            CALL errore( 'write_xc', &
                         ' variables for LDA+U not present', 1 )
         !
         CALL iotk_write_dat( ounit, "LDA_PLUS_U_CALCULATION", lda_plus_u )
         CALL iotk_write_dat( ounit, "HUBBARD_LMAX", Hubbard_lmax )
         CALL iotk_write_dat( ounit, "HUBBARD_L", Hubbard_l(1:nsp) )
         CALL iotk_write_dat( ounit, "HUBBARD_U", Hubbard_U(1:nsp) )
         !
         IF ( PRESENT( lda_plus_u_kind ) ) THEN
            CALL iotk_write_dat( ounit, "LDA_PLUS_U_KIND", lda_plus_u_kind )
            CALL iotk_write_dat( ounit, "U_PROJECTION_TYPE", trim(U_projection) )
         END IF
         !
         IF ( PRESENT( Hubbard_J ) ) &
              CALL iotk_write_dat( ounit, "HUBBARD_J", Hubbard_J(1:3,1:nsp), COLUMNS = 3)
         !
         IF ( PRESENT( Hubbard_J0 ) ) &
         CALL iotk_write_dat( ounit, "HUBBARD_J0", Hubbard_J0(1:nsp) )
         !
         IF ( PRESENT( Hubbard_alpha ) ) &
         CALL iotk_write_dat( ounit, "HUBBARD_ALPHA", Hubbard_alpha(1:nsp) )
         !
         IF ( PRESENT( Hubbard_beta ) ) &
         CALL iotk_write_dat( ounit, "HUBBARD_BETA", Hubbard_beta(1:nsp) )
         !
      END IF
      !
      ! Vdw kernel table
      !
      IF ( present(inlc) ) THEN
         IF ( inlc > 0 ) THEN
            IF ( .NOT. PRESENT( vdw_table_name ) .OR. &
                 .NOT. PRESENT( pseudo_dir )     .OR. &
                 .NOT. PRESENT( dirname ))            &
                 CALL errore( 'write_xc', ' variable vdw_table_name not present', 1 )
        
            CALL iotk_write_dat( ounit, "NON_LOCAL_DF", inlc )
            CALL iotk_write_dat( ounit, "VDW_KERNEL_NAME", TRIM(vdw_table_name))
            !
            ! Copy the file in .save directory
            !
            flen = LEN_TRIM( pseudo_dir )
            IF ( pseudo_dir(flen:flen) /= '/' ) THEN
               file_table = pseudo_dir(1:flen) // '/' // vdw_table_name
            ELSE
               file_table = pseudo_dir(1:flen) // vdw_table_name
            END IF
            !
            CALL qexml_copy_file( TRIM( file_table ), TRIM( dirname ) // "/" // TRIM( vdw_table_name ),ierrl )
            !
         ENDIF
      ENDIF
      !
      IF ( PRESENT (llondon) ) THEN
         IF ( llondon ) THEN
            IF ( .NOT. PRESENT( london_s6 )  .OR. &
                 .NOT. PRESENT( london_rcut ).OR. &
                 .NOT. PRESENT( london_c6 )  .OR. &
                 .NOT. PRESENT( london_rvdw ) ) & 
                 CALL errore( 'write_xc', &
                              ' variables for DFT+D not present', 1 )
            CALL iotk_write_begin( ounit, "DFT_D2" )
            !
            CALL iotk_write_dat( ounit, "SCALING_FACTOR", london_s6 )
            CALL iotk_write_dat( ounit, "CUTOFF_RADIUS",  london_rcut )
            CALL iotk_write_dat( ounit, "C6",             london_c6(1:nsp) )
            CALL iotk_write_dat( ounit, "RADIUS_VDW",     london_rvdw(1:nsp) )
            !
            CALL iotk_write_end  ( ounit, "DFT_D2" )
         ENDIF
      ENDIF
      !
      IF ( PRESENT (lxdm) ) THEN
         IF ( lxdm) CALL iotk_write_dat( ounit, "XDM", lxdm )
      ENDIF
      !
      IF ( PRESENT (ts_vdw) ) THEN
         IF ( ts_vdw) THEN
            IF ( .NOT. PRESENT (vdw_isolated) ) &
               CALL errore( 'write_xc', &
                            ' variables for TS not present', 1 )
            CALL iotk_write_begin( ounit, "TKATCHENKO-SCHEFFLER" )
            CALL iotk_write_dat( ounit, "ISOLATED_SYSTEM", vdw_isolated )
            CALL iotk_write_end( ounit, "TKATCHENKO-SCHEFFLER" )
         END IF
      END IF
      !
      IF ( PRESENT (acfdt_in_pw) ) THEN
         CALL iotk_write_dat( ounit, "ACFDT_IN_PW", acfdt_in_pw )
      ENDIF
      !
      IF ( PRESENT (acfdt_in_pw) ) THEN
         CALL iotk_write_dat( ounit, "ACFDT_IN_PW", acfdt_in_pw )
      ENDIF
      !
      CALL iotk_write_end( ounit, "EXCHANGE_CORRELATION" )
      !
 END SUBROUTINE qexml_write_xc
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_write_exx( x_gamma_extrapolation, nqx1, nqx2, nqx3, &
                          exxdiv_treatment, yukawa, ecutvcut, exx_fraction, &
                          gau_parameter, screening_parameter, exx_is_active, ecutfock )
      !------------------------------------------------------------------------
      !
      LOGICAL,            INTENT(IN) :: x_gamma_extrapolation, exx_is_active
      INTEGER,            INTENT(IN) :: nqx1, nqx2, nqx3
      CHARACTER(LEN=*),   INTENT(IN) :: exxdiv_treatment
      REAL(DP),           INTENT(IN) :: yukawa, ecutvcut, exx_fraction, ecutfock
      REAL(DP),           INTENT(IN) :: screening_parameter
      REAL(DP),           INTENT(IN) :: gau_parameter
      !
      CALL iotk_write_begin(ounit, "EXACT_EXCHANGE" )
      call iotk_write_dat(ounit, "x_gamma_extrapolation", x_gamma_extrapolation)
      call iotk_write_dat(ounit, "nqx1", nqx1)
      call iotk_write_dat(ounit, "nqx2", nqx2)
      call iotk_write_dat(ounit, "nqx3", nqx3)
      call iotk_write_dat(ounit, "exxdiv_treatment", exxdiv_treatment)
      call iotk_write_dat(ounit, "yukawa", yukawa)
      call iotk_write_dat(ounit, "ecutvcut", ecutvcut)
      call iotk_write_dat(ounit, "exx_fraction", exx_fraction)
      call iotk_write_dat(ounit, "screening_parameter", screening_parameter)
      call iotk_write_dat(ounit, "gau_parameter", gau_parameter)
      call iotk_write_dat(ounit, "exx_is_active", exx_is_active)
      call iotk_write_dat(ounit, "ecutfock", ecutfock)
      CALL iotk_write_end(ounit, "EXACT_EXCHANGE" )
      !
    END SUBROUTINE qexml_write_exx
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_write_esm( esm_nfit, esm_efield, esm_w, esm_a, esm_bc )
      !------------------------------------------------------------------------
      !
      INTEGER,            INTENT(IN) :: esm_nfit
      REAL(DP),           INTENT(IN) :: esm_efield, esm_w, esm_a
      CHARACTER(LEN=*),   INTENT(IN) :: esm_bc
      !
      CALL iotk_write_begin(ounit, "ESM" )
      call iotk_write_dat(ounit, "esm_nfit", esm_nfit)
      call iotk_write_dat(ounit, "esm_efield", esm_efield)
      call iotk_write_dat(ounit, "esm_w", esm_w)
      call iotk_write_dat(ounit, "esm_a", esm_a)
      call iotk_write_dat(ounit, "esm_bc", esm_bc)
      CALL iotk_write_end(ounit, "ESM" )
      !
    END SUBROUTINE qexml_write_esm
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_write_occ( lgauss, ngauss, degauss, degauss_units, &
         ltetra, tetra_type, ntetra, tetra, tfixed_occ, &
         lsda, nstates_up, nstates_dw, input_occ )
      !------------------------------------------------------------------------
      !
      LOGICAL,                INTENT(in) :: lgauss, ltetra, tfixed_occ, lsda
      INTEGER,      OPTIONAL, INTENT(in) :: ngauss, ntetra, tetra_type, &
           nstates_up, nstates_dw
      INTEGER,      OPTIONAL, INTENT(in) :: tetra(:,:)
      REAL(DP),    OPTIONAL, INTENT(in) :: degauss, input_occ(:,:)
      CHARACTER(*), OPTIONAL, INTENT(in) :: degauss_units
      !
      INTEGER :: i
      !
      !
      CALL iotk_write_begin( ounit, "OCCUPATIONS" )
      !
      CALL iotk_write_dat( ounit, "SMEARING_METHOD", lgauss )
      !
      IF ( lgauss ) THEN
         !
         CALL iotk_write_dat( ounit, "SMEARING_TYPE", ngauss )
         !
         CALL iotk_write_attr( attr, "UNITS", trim(degauss_units), FIRST = .true. )
         !
         CALL iotk_write_dat( ounit, "SMEARING_PARAMETER", degauss , ATTR = attr )
         !
      ENDIF
      !
      CALL iotk_write_dat( ounit, "TETRAHEDRON_METHOD", ltetra )
      !
      IF ( ltetra ) THEN
         !
         CALL iotk_write_dat( ounit, "NUMBER_OF_TETRAHEDRA", ntetra )
         !
         CALL iotk_write_dat( ounit, "TETRAHEDRON_TYPE", tetra_type)
         !
         IF(tetra_type == 0) then
            !
            DO i = 1, ntetra
               !
               CALL iotk_write_dat( ounit, "TETRAHEDRON" // &
                                  & iotk_index( i ), tetra(1:4,i) )
               !
            ENDDO
            !
         END IF
         !
      ENDIF
      !
      CALL iotk_write_dat( ounit, "FIXED_OCCUPATIONS", tfixed_occ )
      !
      IF ( tfixed_occ ) THEN
         !
         CALL iotk_write_attr( attr, "lsda" , lsda, FIRST = .true. )
         CALL iotk_write_attr( attr, "nstates_up", nstates_up )
         CALL iotk_write_attr( attr, "nstates_down", nstates_dw )
         !
         CALL iotk_write_empty( ounit, 'INFO', ATTR = attr )
         !
         CALL iotk_write_dat( ounit, "INPUT_OCC_UP", input_occ(1:nstates_up,1) )
         !
         IF ( lsda ) &
            CALL iotk_write_dat( ounit, "INPUT_OCC_DOWN", input_occ(1:nstates_dw,2) )
         !
      ENDIF
      !
      CALL iotk_write_end( ounit, "OCCUPATIONS" )
      !
    END SUBROUTINE qexml_write_occ
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_write_bz( num_k_points, xk, wk, k1, k2, k3, &
                               nk1, nk2, nk3, k_units, qnorm, &
                               nks_start, xk_start, wk_start )
      !------------------------------------------------------------------------
      !
      INTEGER,      INTENT(in) :: num_k_points, k1, k2, k3, nk1, nk2, nk3
      REAL(DP),    INTENT(in) :: xk(:,:), wk(:)
      CHARACTER(*), INTENT(in) :: k_units
      REAL(DP), INTENT(IN) :: qnorm
      INTEGER,  INTENT(IN), OPTIONAL ::  nks_start
      REAL(DP), INTENT(IN), OPTIONAL :: xk_start(:,:), wk_start(:)
      !
      INTEGER :: ik
      !
      !
      CALL iotk_write_begin( ounit, "BRILLOUIN_ZONE" )
      !
      CALL iotk_write_dat( ounit, "NUMBER_OF_K-POINTS", num_k_points )
      !
      CALL iotk_write_attr( attr, "UNITS", trim(k_units), FIRST = .true. )
      CALL iotk_write_empty( ounit, "UNITS_FOR_K-POINTS", attr )
      !
      CALL iotk_write_attr( attr, "nk1", nk1, FIRST = .true. )
      CALL iotk_write_attr( attr, "nk2", nk2 )
      CALL iotk_write_attr( attr, "nk3", nk3 )
      CALL iotk_write_empty( ounit, "MONKHORST_PACK_GRID", attr )
      CALL iotk_write_attr( attr, "k1", k1, FIRST = .true. )
      CALL iotk_write_attr( attr, "k2", k2 )
      CALL iotk_write_attr( attr, "k3", k3 )
      CALL iotk_write_empty( ounit, "MONKHORST_PACK_OFFSET", attr )
      !
      DO ik = 1, num_k_points
         !
         CALL iotk_write_attr( attr, "XYZ", xk(:,ik), FIRST = .true. )
         !
         CALL iotk_write_attr( attr, "WEIGHT", wk(ik) )
         !
         CALL iotk_write_empty( ounit, "K-POINT" // &
                              & trim( iotk_index(ik) ), attr )
         !
      ENDDO
      !
      ! ... these are k-points and weights in the Irreducible BZ
      !
      IF (present(nks_start).and.present(xk_start).and.present(wk_start)) THEN
         !
         CALL iotk_write_dat( ounit, "STARTING_K-POINTS", nks_start )
         !
         DO ik = 1, nks_start
            !
            CALL iotk_write_attr( attr, "XYZ", xk_start(:,ik), FIRST = .TRUE. )
            !
            CALL iotk_write_attr( attr, "WEIGHT", wk_start(ik) )
            !
            CALL iotk_write_empty( ounit, "K-POINT_START" // &
                              & TRIM( iotk_index(ik) ), attr )
            !
         END DO
      ENDIF
      !
      CALL iotk_write_dat( ounit, "NORM-OF-Q", qnorm )
      !
      CALL iotk_write_end( ounit, "BRILLOUIN_ZONE" )
      !
    END SUBROUTINE qexml_write_bz
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_write_para( kunit, nproc, nproc_pool, nproc_image, &
                                 ntask_groups, nproc_bgrp, nproc_ortho ) 
      !------------------------------------------------------------------------
      !
      INTEGER,  INTENT(IN) :: kunit, nproc, nproc_pool, nproc_image, &
                              ntask_groups, nproc_bgrp, nproc_ortho 
      !
      !
      CALL iotk_write_begin( ounit, "PARALLELISM" )
      CALL iotk_write_dat( ounit, &
                              "GRANULARITY_OF_K-POINTS_DISTRIBUTION", kunit )
      CALL iotk_write_dat( ounit, "NUMBER_OF_PROCESSORS", nproc )
      CALL iotk_write_dat( ounit, &
                              "NUMBER_OF_PROCESSORS_PER_POOL", nproc_pool )
      CALL iotk_write_dat( ounit, &
                              "NUMBER_OF_PROCESSORS_PER_IMAGE", nproc_image )
      CALL iotk_write_dat( ounit, "NUMBER_OF_PROCESSORS_PER_TASKGROUP", &
                                              ntask_groups )
      CALL iotk_write_dat( ounit, "NUMBER_OF_PROCESSORS_PER_BAND_GROUP", &
                                              nproc_bgrp )
      CALL iotk_write_dat( ounit, "NUMBER_OF_PROCESSORS_PER_DIAGONALIZATION", &
                                              nproc_ortho )
      CALL iotk_write_end( ounit, "PARALLELISM" )
      !
      !
    END SUBROUTINE qexml_write_para
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_write_bands_info( num_k_points, natomwfc, &
                                       nbnd, nbnd_up, nbnd_down, &
                                       nspin, nelec, nel_up, nel_down, &
                                       energy_units, k_units, &
                                       ef, two_fermi_energies ,&
                                       ef_up, ef_down, noncolin )
      !------------------------------------------------------------------------
      !
      INTEGER,       INTENT(in) ::  num_k_points, natomwfc, nbnd, nbnd_up, nbnd_down, &
                                    nspin, nel_up, nel_down
      REAL(DP),     INTENT(in) ::   nelec
      CHARACTER(*),  INTENT(in) :: energy_units, k_units
      LOGICAL,       INTENT(in), OPTIONAL :: noncolin,two_fermi_energies
      REAL(DP),     INTENT(in), OPTIONAL :: ef,ef_up,ef_down
      !
      !
      CALL iotk_write_begin( ounit, "BAND_STRUCTURE_INFO" )
      !
      CALL iotk_write_dat  ( ounit, "NUMBER_OF_K-POINTS", num_k_points )
      !
      CALL iotk_write_dat  ( ounit, "NUMBER_OF_SPIN_COMPONENTS", nspin )
      !
      IF (present(noncolin)) CALL iotk_write_dat  ( ounit, "NON-COLINEAR_CALCULATION", noncolin )
      !
      CALL iotk_write_dat  ( ounit, "NUMBER_OF_ATOMIC_WFC", natomwfc )
      !
      IF ( nspin == 2 ) THEN
         !
         CALL iotk_write_attr( attr, "UP", nbnd_up, FIRST = .TRUE. )
         CALL iotk_write_attr( attr, "DW", nbnd_down )
         CALL iotk_write_dat( ounit, &
                              "NUMBER_OF_BANDS", nbnd, ATTR = attr )
         CALL iotk_write_attr( attr, "UP", nel_up, FIRST = .TRUE. )
         CALL iotk_write_attr( attr, "DW", nel_down )
         CALL iotk_write_dat( ounit, &
                              "NUMBER_OF_ELECTRONS", nelec, ATTR = attr )
      ELSE
         !
         CALL iotk_write_dat  ( ounit, "NUMBER_OF_BANDS", nbnd )
         CALL iotk_write_dat  ( ounit, "NUMBER_OF_ELECTRONS", nelec )
         !
      END IF
      !
      CALL iotk_write_attr ( attr, "UNITS", trim(k_units), FIRST = .TRUE. )
      CALL iotk_write_empty( ounit, "UNITS_FOR_K-POINTS", ATTR = attr )
      !
      CALL iotk_write_attr ( attr, "UNITS", trim(energy_units), FIRST = .TRUE. )
      CALL iotk_write_empty( ounit, "UNITS_FOR_ENERGIES", ATTR = attr )
      !
      !
      !
      IF (present(two_fermi_energies) ) THEN
         IF (two_fermi_energies) THEN
            !
            CALL iotk_write_dat( ounit,"TWO_FERMI_ENERGIES",two_fermi_energies)
            CALL iotk_write_dat( ounit, "ELECTRONS_UP", nel_up )
            CALL iotk_write_dat( ounit, "ELECTRONS_DOWN", nel_down )
            CALL iotk_write_dat( ounit, "FERMI_ENERGY_UP", ef_up )
            CALL iotk_write_dat( ounit, "FERMI_ENERGY_DOWN", ef_down )
            !
         ELSE
            !
            IF (present(ef)) CALL iotk_write_dat( ounit, "FERMI_ENERGY", ef )
            !
         ENDIF
      ELSE
         !
         IF (present(ef)) CALL iotk_write_dat( ounit, "FERMI_ENERGY", ef )
         !
      ENDIF
      !
      CALL iotk_write_end  ( ounit, "BAND_STRUCTURE_INFO" )
      !
      !
    END SUBROUTINE qexml_write_bands_info
    !
    !
    !------------------------------------------------------------------------  
    SUBROUTINE qexml_write_bands_pw( nbnd, num_k_points, nspin, xk, wk, wg , et, energy_units,  lkpoint_dir ,auxunit, dirname )
      !------------------------------------------------------------------------
      !
      INTEGER, INTENT(in) :: nbnd,num_k_points,nspin,auxunit
      REAL(DP), INTENT(in) :: xk(:,:),wk(:),wg(:,:),et(:,:)
      CHARACTER(len=*), INTENT(IN) :: energy_units
      LOGICAL, INTENT(in) :: lkpoint_dir
      CHARACTER(len=*), INTENT(in) :: dirname
      
      !
      REAL(DP), ALLOCATABLE :: raux(:)
      INTEGER :: ik,ispin,ik_eff
      CHARACTER(LEN=256)    :: filename
      !
      !
      CALL iotk_write_begin( ounit, "EIGENVALUES" )
      !
      ALLOCATE( raux( nbnd) )
      !
      DO ik = 1, num_k_points
         !
         !
         CALL iotk_write_begin( ounit, "K-POINT" // TRIM( iotk_index( ik ) ) )
         !
         CALL iotk_write_dat( ounit, "K-POINT_COORDS", xk(:,ik), COLUMNS=3 )
         !
         CALL iotk_write_dat( ounit, "WEIGHT", wk(ik) )
         !
         !
         IF ( nspin == 2 ) THEN
            !
            ispin = 1
            !
            IF (lkpoint_dir) THEN
               !
               filename = qexml_wfc_filename(".",'eigenval1', ik, EXTENSION='xml',&
                                     DIR=lkpoint_dir )
               !
               CALL iotk_link( ounit, "DATAFILE.1", &
                               filename, CREATE = .FALSE., BINARY = .FALSE. )
            ELSE
               CALL iotk_write_begin( auxunit, &
                             "DATA_EIG"//TRIM( iotk_index( ik ) )//"_SPIN_UP" )
            ENDIF
            !
            IF ( wk(ik) == 0.D0 ) THEN
               !
               raux = wg(:,ik)
               !
            ELSE
               !
               raux = wg(:,ik) / wk(ik)
               !
            END IF
            !
            !
            IF (lkpoint_dir) THEN
               filename = qexml_wfc_filename( dirname, 'eigenval1', ik, &
                    EXTENSION='xml',  DIR=lkpoint_dir )
               !
               CALL qexml_write_eig( auxunit, filename, nbnd, et(:, ik), &
                     trim(energy_units), OCC = raux(:), IK=ik, ISPIN=ispin )
            ELSE
               filename=' '
               CALL qexml_write_eig( auxunit, filename, nbnd, et(:, ik), &
                     trim(energy_units), OCC = raux(:), IK=ik, ISPIN=ispin,  &
                                LKPOINT_DIR=.FALSE. )
            ENDIF
            !
            ispin = 2
            !
            ik_eff = ik + num_k_points
            !
            IF (lkpoint_dir) THEN
               filename = qexml_wfc_filename( ".", 'eigenval2', ik, &
                          EXTENSION='xml',  DIR=lkpoint_dir )
               !
               CALL iotk_link( ounit, "DATAFILE.2", &
                    filename, CREATE = .FALSE., BINARY = .FALSE. )
            ELSE
               CALL iotk_write_end( auxunit, &
                    "DATA_EIG"//TRIM( iotk_index( ik ) )//"_SPIN_UP" )
               CALL iotk_write_begin( auxunit, &
                    "DATA_EIG"//TRIM( iotk_index( ik ) )//"_SPIN_DW" )
            ENDIF
            !
            IF ( wk(ik_eff) == 0.D0 ) THEN
               !
               raux = wg(:,ik_eff)
               !
            ELSE
               !
               raux = wg(:,ik_eff) / wk(ik_eff)
               !
            END IF
            !
            IF (lkpoint_dir) THEN
               filename = qexml_wfc_filename( dirname, 'eigenval2', ik, &
                    EXTENSION = 'xml',  DIR=lkpoint_dir )
               !
               CALL qexml_write_eig( auxunit, filename, nbnd, et(:, ik_eff) , &
                    trim(energy_units), OCC = raux(:), IK = ik, ISPIN = ispin)
            ELSE
               filename=' '
               CALL qexml_write_eig( auxunit, filename, nbnd, et(:, ik_eff) , &
                    trim(energy_units), OCC = raux(:), IK = ik, &
                    ISPIN = ispin, LKPOINT_DIR=.false.)
               CALL iotk_write_end( auxunit, &
                    "DATA_EIG"//TRIM( iotk_index( ik ) )//"_SPIN_DW" )
            ENDIF
               !
         ELSE
            !
            IF (lkpoint_dir) THEN
               filename = qexml_wfc_filename( ".", 'eigenval', ik, &
                    EXTENSION='xml',  DIR=lkpoint_dir )
               !
               CALL iotk_link( ounit, "DATAFILE", &
                    filename, CREATE = .FALSE., BINARY = .FALSE. )
            ELSE
               CALL iotk_write_begin( auxunit, &
                    "DATA_EIG"//TRIM( iotk_index( ik ) ) )
            ENDIF
            !
            IF ( wk(ik) == 0.D0 ) THEN
               !
               raux(:) = wg(:,ik)
               !
            ELSE
               !
               raux(:) = wg(:,ik) / wk(ik)
               !
            END IF
            !
            IF (lkpoint_dir) THEN
               filename = qexml_wfc_filename( dirname, 'eigenval', ik, &
                    EXTENSION='xml',  DIR=lkpoint_dir )
               !
               CALL qexml_write_eig( auxunit, filename, nbnd, et(:, ik), &
                               trim(energy_units), OCC = raux(:), IK = ik )
            ELSE
               filename=' '
               CALL qexml_write_eig( auxunit, filename, nbnd, et(:, ik), &
                    trim(energy_units), OCC = raux(:), IK = ik, &
                    LKPOINT_DIR=.false. )
               CALL iotk_write_end( auxunit, &
                    "DATA_EIG"//TRIM( iotk_index( ik ) ) )
            ENDIF
            !
         END IF
         !
         CALL iotk_write_end( ounit, "K-POINT" // TRIM( iotk_index( ik ) ) )
         !
      ENDDO
      !
      !
      DEALLOCATE ( raux )
      !
      !
      CALL iotk_write_end( ounit, "EIGENVALUES" )
      !
    END SUBROUTINE qexml_write_bands_pw
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_write_bands_cp( nbnd, num_k_points, nspin, iupdwn, nupdwn, xk, wk, et, tksw, &
         occ0, occm, energy_units, k_units, auxunit ,dirname )
      !------------------------------------------------------------------------
      !
      !
      INTEGER, INTENT(in) :: nbnd,num_k_points,nspin, iupdwn(2),nupdwn(2),auxunit
      REAL(DP), INTENT(in) :: xk(:,:),wk(:),et(:,:)
      CHARACTER(len=*), INTENT(in) :: dirname,k_units,energy_units
      LOGICAL, INTENT(in) :: tksw
      REAL(DP), INTENT(in) :: occ0(:)
      REAL(DP), INTENT(in) :: occm(:)
      !
      !
      REAL(DP), ALLOCATABLE :: dtmp(:)
      INTEGER :: iss, ik
      CHARACTER(LEN=4)     :: cspin
      CHARACTER(LEN=256)    :: filename
      !
      !
      CALL iotk_write_begin( ounit, "EIGENVALUES" )
      !
      DO ik = 1, num_k_points
         !
         CALL iotk_write_begin( ounit, "K-POINT" // TRIM( iotk_index(ik) ) )
         !
         CALL iotk_write_attr( attr, "UNITS", "2 pi / a", FIRST = .TRUE. )
         CALL iotk_write_dat( ounit, "K-POINT_COORDS", xk(:,ik), ATTR = attr )
         !
         CALL iotk_write_dat( ounit, "WEIGHT", wk(ik) )
         !
         ALLOCATE( dtmp ( nbnd ) )
         !
         DO iss = 1, nspin
            !
            cspin = iotk_index( iss )
            !
            dtmp = 0.0d0
            !
            IF( tksw ) THEN
               !
               !
               IF( nspin == 2 ) THEN
                  IF( iss == 1 ) filename = qexml_wfc_filename( ".", 'eigenval1', ik, EXTENSION='xml' )
                  IF( iss == 2 ) filename = qexml_wfc_filename( ".", 'eigenval2', ik, EXTENSION='xml' )
                  !
                  IF( iss == 1 ) CALL iotk_link( ounit, "DATAFILE.1", &
                       filename, CREATE = .FALSE., BINARY = .FALSE. )
                  IF( iss == 2 ) CALL iotk_link( ounit, "DATAFILE.2", &
                       filename, CREATE = .FALSE., BINARY = .FALSE. )
                  
                  IF( iss == 1 ) filename = qexml_wfc_filename( dirname, 'eigenval1', ik, EXTENSION='xml' )
                  IF( iss == 2 ) filename = qexml_wfc_filename( dirname, 'eigenval2', ik, EXTENSION='xml' )
               ELSE
                  filename = qexml_wfc_filename( ".", 'eigenval', ik, EXTENSION='xml' )
                  CALL iotk_link( ounit, "DATAFILE", filename, CREATE = .FALSE., BINARY = .FALSE. )
                  filename = qexml_wfc_filename( dirname, 'eigenval', ik, EXTENSION='xml' )
               END IF
               
               dtmp ( 1:nupdwn( iss ) ) = occ0( iupdwn( iss ) : iupdwn( iss ) + nupdwn( iss ) - 1 ) / wk(ik)
               !
               CALL qexml_write_eig( auxunit, filename, nbnd, et( 1:nbnd, iss) , energy_units, &
                    OCC = dtmp(:), IK=ik, ISPIN=iss )
            END IF
               !
            CALL iotk_write_dat( ounit, "OCC0"  // TRIM( cspin ), &
                                    occ0( iupdwn( iss ) : iupdwn( iss ) + nupdwn( iss ) - 1 ) )
            !
            CALL iotk_write_dat( ounit, "OCCM" // TRIM( cspin ), &
                 occm( iupdwn( iss ) : iupdwn( iss ) + nupdwn( iss ) - 1 ) )
            !
         END DO
         !
         DEALLOCATE( dtmp )
         !
         CALL iotk_write_end( ounit, "K-POINT" // TRIM( iotk_index(ik) ) )
         !
      END DO
      !
      CALL iotk_write_end( ounit, "EIGENVALUES" )
      !
      !
    END SUBROUTINE qexml_write_bands_cp
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_write_eig( iuni, filename, nbnd, eig, energy_units, &
                          occ, ik, ispin, lkpoint_dir )
      !------------------------------------------------------------------------
      !
      IMPLICIT NONE
      !
      INTEGER,            INTENT(IN) :: iuni
      INTEGER,            INTENT(IN) :: nbnd
      REAL(DP),           INTENT(IN) :: eig(:)
      CHARACTER(*),       INTENT(IN) :: energy_units
      REAL(DP), OPTIONAL, INTENT(IN) :: occ(:)
      INTEGER,  OPTIONAL, INTENT(IN) :: ik, ispin
      LOGICAL,  OPTIONAL, INTENT(IN) :: lkpoint_dir
      CHARACTER(LEN=256), INTENT(IN) :: filename
      LOGICAL :: lkpoint_dir0
      !
      lkpoint_dir0=.TRUE.
      IF (present(lkpoint_dir)) lkpoint_dir0=lkpoint_dir
      !
      !
      IF (lkpoint_dir0) CALL iotk_open_write ( iuni, &
                           FILE = TRIM( filename ), BINARY = .FALSE. )
      !
      CALL iotk_write_attr ( attr, "nbnd", nbnd, FIRST=.TRUE. )
      IF ( PRESENT( ik) )    CALL iotk_write_attr ( attr, "ik", ik )
      IF ( PRESENT( ispin) ) CALL iotk_write_attr ( attr, "ispin", ispin )
      CALL iotk_write_empty( iuni, "INFO", ATTR = attr )
      !
      CALL iotk_write_attr ( attr, "UNITS", TRIM(energy_units), FIRST = .TRUE. )
      CALL iotk_write_empty( iuni, "UNITS_FOR_ENERGIES", ATTR=attr)
      !
      CALL iotk_write_dat( iuni, "EIGENVALUES", eig(:) )
      !
      IF ( PRESENT( occ ) ) THEN
         !
         CALL iotk_write_dat( iuni, "OCCUPATIONS", occ(:) )
         !
      ENDIF
      !
      IF (lkpoint_dir0) CALL iotk_close_write ( iuni )
      !
      !
    END SUBROUTINE qexml_write_eig
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_write_wfc( nbnd, nkpts, nspin, ik, ispin, ipol, igk, ngw, igwx, &
                                gamma_only, wf, wf_kindip, scale_factor )
      !------------------------------------------------------------------------
      !
      IMPLICIT NONE
      !
      INTEGER,                INTENT(in) :: nbnd, nkpts, nspin
      INTEGER,                INTENT(in) :: ik
      INTEGER,      OPTIONAL, INTENT(in) :: ispin, ipol
      INTEGER,                INTENT(in) :: ngw, igwx
      LOGICAL,                INTENT(in) :: gamma_only
      INTEGER,      OPTIONAL, INTENT(in) :: igk(:)
      COMPLEX(DP), OPTIONAL, INTENT(in) :: wf(:,:)
      COMPLEX(DP), OPTIONAL, INTENT(in) :: wf_kindip(:,:)
      REAL(DP),    OPTIONAL, INTENT(in) :: scale_factor
      !
      INTEGER         :: iunaux, ierr
      INTEGER         :: ig, ib
      CHARACTER(256)  :: filename
      COMPLEX(DP),  ALLOCATABLE :: wtmp(:)

      ierr = 0
      !
      IF ( present( ispin ) .and. present( ipol )  ) THEN
         !
         ierr = 1
         RETURN
         !
      ENDIF
      !
      ! open the file to write
      !
      CALL iotk_free_unit( iunaux )
      !
      IF ( present( ispin ) ) THEN
         !
         filename = trim( qexml_wfc_filename( datadir_out, 'evc', ik, ispin ) )
         !
      ELSEIF ( present( ipol )  ) THEN
         !
         filename = trim( qexml_wfc_filename( datadir_out, 'evc', ik, ipol ) )
         !
      ELSE
         !
         filename = trim( qexml_wfc_filename( datadir_out, 'evc', ik ) )
         !
      ENDIF
      !
      CALL iotk_open_write ( iunaux, FILE = trim(filename), ROOT="WFC", BINARY=.true., IERR=ierr )
      IF (ierr/=0)  RETURN
      !
      !
      CALL iotk_write_attr( attr, "ngw",          ngw, FIRST = .true. )
      CALL iotk_write_attr( attr, "igwx",         igwx )
      CALL iotk_write_attr( attr, "gamma_only",   gamma_only )
      CALL iotk_write_attr( attr, "nbnd",         nbnd )
      CALL iotk_write_attr( attr, "ik",           ik )
      CALL iotk_write_attr( attr, "nk",           nkpts )
      CALL iotk_write_attr( attr, "ispin",        ispin )
      CALL iotk_write_attr( attr, "nspin",        nspin )
      IF ( present( scale_factor) ) CALL iotk_write_attr( attr, "scale_factor", scale_factor )
      !
      CALL iotk_write_empty( iunaux, "INFO", attr )
      !
      !
      IF ( present( wf ) ) THEN
         !
         ! write wfcs without any G-reordering
         !
         DO ib = 1, nbnd
            !
            CALL iotk_write_dat( iunaux, "evc" // trim(iotk_index( ib )), wf( 1: ngw, ib) )
            !
         ENDDO
         !
      ENDIF
      !
      !
      IF ( present( wf_kindip ) ) THEN
         !
         ! we need to reorder wfcs in terms of G-vectors
         ! we need the igk map
         !
         IF ( .not. present( igk ) ) THEN
            ierr = 71
            RETURN
         ENDIF
         !
         ALLOCATE( wtmp( ngw ) )
         !
         DO ib = 1, nbnd
            !
            DO ig = 1, ngw
               !
               wtmp( ig ) = wf_kindip( igk(ig), ib)
               !
            ENDDO
            !
            CALL iotk_write_dat( iunaux, "evc" // trim(iotk_index( ib )), wtmp( 1: ngw) )
            !
         ENDDO
         !
         DEALLOCATE( wtmp )
         !
      ENDIF
      !
      !
      CALL iotk_close_write( iunaux )
      !
    END SUBROUTINE qexml_write_wfc
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_write_rho( nr1, nr2, nr3, rho, nr1x, nr2x, rhov, binary )
      !------------------------------------------------------------------------
      !
      ! Writes charge density rho, one plane at a time.
      !
      IMPLICIT NONE
      !
      INTEGER,             INTENT(in) :: nr1, nr2, nr3
      INTEGER,   OPTIONAL, INTENT(in) :: nr1x, nr2x
      REAL(DP), OPTIONAL, INTENT(in) :: rho(:,:,:), rhov(:)
      LOGICAL,   OPTIONAL, INTENT(in) :: binary
      !
      INTEGER        :: iunaux, nr1x_, nr2x_, ip, i1, i2, i
      LOGICAL        :: binary_
      CHARACTER(256) :: filename
      REAL(DP), ALLOCATABLE :: plane(:,:)
      !
      !
      CALL iotk_free_unit( iunaux )
      !
      binary_ = .true.
      IF ( present (binary) ) binary_ = binary
      !
      IF ( binary_ ) THEN
         !
         filename = trim( datadir_out ) // '/' //'charge-density.dat'
         !
      ELSE
         !
         filename = trim( datadir_out ) // '/' //'charge-density.xml'
         !
      ENDIF
      !
      CALL iotk_open_write( iunaux, FILE = trim(filename), BINARY=binary_ )
      !
      !
      CALL iotk_write_begin( iunaux, "CHARGE-DENSITY" )
      !
      CALL iotk_write_attr( attr, "nr1", nr1, FIRST = .true. )
      CALL iotk_write_attr( attr, "nr2", nr2 )
      CALL iotk_write_attr( attr, "nr3", nr3 )
      !
      CALL iotk_write_empty( iunaux, "INFO", attr )
      !
      !
      IF ( present( rho ) ) THEN
         !
         DO ip = 1, nr3
            !
            CALL iotk_write_dat( iunaux, "z"//trim(iotk_index(ip)), rho(1:nr1,1:nr2,ip) )
            !
         ENDDO
         !
      ELSEIF ( present( rhov ) ) THEN
         !
         nr1x_ = nr1
         IF ( present( nr1x )) nr1x_ = nr1x
         nr2x_ = nr2
         IF ( present( nr2x )) nr2x_ = nr2x
         !
         IF ( nr1x_ /= nr1 .or. nr2x_ /= nr2 ) THEN
            !
            ! we need to separately reconstruct the rho-plane
            !
            ALLOCATE( plane(nr1, nr2 ) )
            !
            DO ip = 1, nr3
               !
               DO i2 = 1, nr2
               DO i1 = 1, nr1
                   !
                   i = (nr1x_ * nr2x_) * ( ip -1 ) + nr1x_ * ( i2 -1 ) + i1
                   !
                   plane( i1, i2) = rhov( i )
                   !
               ENDDO
               ENDDO
               !
               CALL iotk_write_dat( iunaux, "z"//trim(iotk_index(ip)), plane )
               !
            ENDDO
            !
            DEALLOCATE( plane )
            !
         ELSE
            !
            DO ip = 1, nr3
               !
               i1  = ( nr1 * nr2 ) * ( ip -1 ) + 1
               i2  = ( nr1 * nr2 ) * ip
               !
               CALL iotk_write_dat( iunaux, "z"//trim(iotk_index(ip)), rhov(i1:i2) )
               !
            ENDDO
            !
         ENDIF
         !
      ENDIF
      !
      !
      CALL iotk_write_end( iunaux, "CHARGE-DENSITY" )
      !
      CALL iotk_close_write( iunaux )
      !
      !
    END SUBROUTINE qexml_write_rho
!
!-------------------------------------------
! ... read subroutines
!-------------------------------------------
!
    !------------------------------------------------------------------------
    SUBROUTINE qexml_read_header( creator_name, creator_version, &
                                  format_name, format_version, ierr )
      !------------------------------------------------------------------------
      !
      IMPLICIT NONE
      CHARACTER(len=*),  OPTIONAL, INTENT(out) :: creator_name, creator_version
      CHARACTER(len=*),  OPTIONAL, INTENT(out) :: format_name, format_version
      INTEGER,           INTENT(out) :: ierr
      !
      CHARACTER(256) :: creator_name_, creator_version_
      CHARACTER(256) :: format_name_,     format_version_
      !
      ierr = 0
      !
      !
      CALL iotk_scan_begin( iunit, "HEADER", IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_empty( iunit, "FORMAT", ATTR=attr, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_attr(attr, "NAME", format_name_, IERR=ierr)
      IF (ierr/=0) RETURN
      CALL iotk_scan_attr(attr, "VERSION", format_version_, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_empty( iunit, "CREATOR", ATTR=attr, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_attr(attr, "NAME", creator_name_, IERR=ierr)
      IF (ierr/=0) RETURN
      CALL iotk_scan_attr(attr, "VERSION", creator_version_, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_end( iunit, "HEADER", IERR=ierr )
      IF (ierr/=0) RETURN
      !
      !
      IF ( present(creator_name) )     creator_name    = trim(creator_name_)
      IF ( present(creator_version) )  creator_version = trim(creator_version_)
      IF ( present(format_name) )      format_name     = trim(format_name_)
      IF ( present(format_version) )   format_version  = trim(format_version_)
      !
    END SUBROUTINE qexml_read_header
    !
    !
    !------------------------------------------------------------------------  
    SUBROUTINE qexml_read_status_cp( nfi,simtime,time_units,title, &
                                  ekin, eht, esr, eself, epseu, enl, exc, vave, enthal, &
                                  energy_units, found, ierr )
      !------------------------------------------------------------------------
      !
      INTEGER, OPTIONAL, INTENT(OUT) :: nfi
      REAL(DP), OPTIONAL, INTENT(OUT) :: simtime, ekin,eht,esr,eself,epseu,enl,exc,vave,enthal
      CHARACTER(len=*), OPTIONAL, INTENT(OUT) :: time_units, title, energy_units
      LOGICAL,INTENT(OUT) :: found
      INTEGER, INTENT(OUT) :: ierr
      !
      INTEGER :: nfi_
      REAL(DP) :: simtime_, ekin_,eht_,esr_,eself_,epseu_,enl_,exc_,vave_,enthal_
      CHARACTER(len=256) :: time_units_, title_, energy_units_
      !
      CALL iotk_scan_begin( iunit, "STATUS", ATTR=attr, FOUND = found )
      IF ( .NOT.found ) RETURN
      !
      CALL iotk_scan_empty( iunit, "STEP", ATTR = attr, IERR = ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_attr( attr, "ITERATION", nfi_, IERR = ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_dat( iunit, "TIME", simtime_, ATTR = attr, IERR = ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_attr( attr, "UNITS", time_units_, IERR = ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_dat( iunit, "TITLE", title_, IERR = ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_dat( iunit, "KINETIC_ENERGY", ekin_,   ATTR = attr, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_attr( attr, "UNITS", energy_units_, IERR = ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_dat( iunit, "HARTREE_ENERGY", eht_,   IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_dat( iunit, "EWALD_TERM",     esr_,   IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_dat( iunit, "GAUSS_SELFINT",  eself_, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_dat( iunit, "LPSP_ENERGY",    epseu_, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_dat( iunit, "NLPSP_ENERGY",   enl_,   IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_dat( iunit, "EXC_ENERGY",     exc_,   IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_dat( iunit, "AVERAGE_POT",    vave_,  IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_dat( iunit, "ENTHALPY",       enthal_,IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_end( iunit, "STATUS", IERR=ierr )
      IF (ierr/=0) RETURN
      !
      !
      IF (present(nfi)) nfi = nfi_
      IF (present(simtime)) simtime = simtime_
      IF (present(time_units)) time_units = time_units_
      IF (present(title)) title = title_
      IF (present(ekin)) ekin = ekin_
      IF (present(eht)) eht = eht_
      IF (present(esr)) esr = esr_
      IF (present(eself)) eself = eself_
      IF (present(epseu)) epseu = epseu_
      IF (present(enl)) enl = enl_
      IF (present(exc)) exc = exc_
      IF (present(vave)) vave = vave_
      IF (present(enthal)) enthal = enthal_
      IF (present(energy_units)) energy_units = energy_units_
      !
    END SUBROUTINE qexml_read_status_cp
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_read_cell( bravais_lattice, celldm, alat, &
                    a1, a2, a3, b1, b2, b3, alat_units, a_units, b_units, &
                    es_corr, ierr )
      !------------------------------------------------------------------------
      !
      CHARACTER(len=*),  OPTIONAL, INTENT(out) :: bravais_lattice
      REAL(DP),         OPTIONAL, INTENT(out) :: celldm(6), alat
      REAL(DP),         OPTIONAL, INTENT(out) :: a1(3), a2(3), a3(3)
      REAL(DP),         OPTIONAL, INTENT(out) :: b1(3), b2(3), b3(3)
      CHARACTER(len=*),  OPTIONAL, INTENT(out) :: alat_units, a_units, b_units
      CHARACTER(len=*),  OPTIONAL, INTENT(out) :: es_corr
      INTEGER,                     INTENT(out) :: ierr
      !
      CHARACTER(256)     :: bravais_lattice_
      CHARACTER(256)     :: alat_units_, a_units_, b_units_,es_corr_
      REAL(DP)          :: celldm_(6), alat_
      REAL(DP)          :: a1_(3), a2_(3), a3_(3)
      REAL(DP)          :: b1_(3), b2_(3), b3_(3)
      !

      ierr=0
      !
      !
      CALL iotk_scan_begin( iunit, "CELL" )
      !
      CALL iotk_scan_dat( iunit, "BRAVAIS_LATTICE", bravais_lattice_, IERR=ierr )
      IF ( ierr /= 0 ) RETURN
      !
      !
      CALL iotk_scan_dat( iunit, "NON-PERIODIC_CELL_CORRECTION", es_corr_, IERR=ierr)
      IF ( ierr /= 0 ) RETURN
      !
      !
      CALL iotk_scan_dat( iunit, "LATTICE_PARAMETER", alat_, ATTR=attr, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      !
      CALL iotk_scan_attr( attr, "UNITS", alat_units_, IERR=ierr )
      IF ( ierr /= 0 ) RETURN
      !
      !
      CALL iotk_scan_dat( iunit, "CELL_DIMENSIONS", celldm_, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      !
      CALL iotk_scan_begin( iunit, "DIRECT_LATTICE_VECTORS", IERR=ierr )
      IF (ierr/=0) RETURN
      !
      !
      CALL iotk_scan_empty( iunit, "UNITS_FOR_DIRECT_LATTICE_VECTORS", &
                            ATTR=attr, IERR=ierr )
      IF (ierr/=0) RETURN
      CALL iotk_scan_attr( attr, "UNITS", a_units_, IERR=ierr )
      IF (ierr/=0) RETURN
      CALL iotk_scan_dat(   iunit, "a1", a1_(:), ATTR=attr, IERR=ierr )
      IF (ierr/=0) RETURN
      CALL iotk_scan_dat(   iunit, "a2", a2_(:), IERR=ierr )
      IF (ierr/=0) RETURN
      CALL iotk_scan_dat(   iunit, "a3", a3_(:), IERR=ierr )
      IF (ierr/=0) RETURN
      CALL iotk_scan_end(   iunit, "DIRECT_LATTICE_VECTORS", IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_begin( iunit, "RECIPROCAL_LATTICE_VECTORS", IERR=ierr )
      IF (ierr/=0) RETURN
      CALL iotk_scan_empty( iunit, "UNITS_FOR_RECIPROCAL_LATTICE_VECTORS", &
                            ATTR=attr, IERR=ierr )
      IF (ierr/=0) RETURN
      CALL iotk_scan_attr( attr, "UNITS", b_units_, IERR=ierr )
      IF (ierr/=0) RETURN
      CALL iotk_scan_dat(   iunit, "b1", b1_(:), ATTR=attr, IERR=ierr )
      IF (ierr/=0) RETURN
      CALL iotk_scan_dat(   iunit, "b2", b2_(:), IERR=ierr )
      IF (ierr/=0) RETURN
      CALL iotk_scan_dat(   iunit, "b3", b3_(:), IERR=ierr )
      IF (ierr/=0) RETURN
      CALL iotk_scan_end(   iunit, "RECIPROCAL_LATTICE_VECTORS", IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_end( iunit, "CELL", IERR=ierr )
      IF (ierr/=0) RETURN
      !
      !
      IF ( present(bravais_lattice) )  bravais_lattice = bravais_lattice_
      IF ( present(celldm) )        celldm       = celldm_
      IF ( present(alat) )          alat         = alat_
      IF ( present(a1) )            a1           = a1_
      IF ( present(a2) )            a2           = a2_
      IF ( present(a3) )            a3           = a3_
      IF ( present(b1) )            b1           = b1_
      IF ( present(b2) )            b2           = b2_
      IF ( present(b3) )            b3           = b3_
      IF ( present(alat_units) )    alat_units   = trim(alat_units_)
      IF ( present(a_units) )       a_units      = trim(a_units_)
      IF ( present(b_units) )       b_units      = trim(b_units_)
      IF ( present(es_corr) )       es_corr      = trim(es_corr_)
      !
    END SUBROUTINE qexml_read_cell
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_read_moving_cell(lmovecell, cell_factor, ierr)
      !------------------------------------------------------------------------
      !
      LOGICAL,  INTENT(OUT) :: lmovecell
      REAL(DP), INTENT(OUT) :: cell_factor
      INTEGER,  INTENT(OUT) :: ierr
      !
      LOGICAL :: found
      !
      CALL iotk_scan_begin( iunit, "MOVING_CELL", found=lmovecell, IERR=ierr )
      !
      IF (lmovecell) THEN
         CALL iotk_scan_dat( iunit, "CELL_FACTOR", cell_factor, IERR=ierr)
         IF (ierr/=0) RETURN
         !
         CALL iotk_scan_end( iunit, "MOVING_CELL", IERR=ierr )
         IF (ierr/=0) RETURN
      END IF
      !
    END SUBROUTINE qexml_read_moving_cell
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_read_ions( nsp, nat, atm, ityp, psfile, amass, amass_units, &
                                tau, tau_units, if_pos, pseudo_dir, ierr )
      !------------------------------------------------------------------------
      !
      INTEGER,          OPTIONAL, INTENT(out) :: nsp, nat
      INTEGER,          OPTIONAL, INTENT(out) :: ityp(:)
      CHARACTER(len=*), OPTIONAL, INTENT(out) :: atm(:)
      CHARACTER(len=*), OPTIONAL, INTENT(out) :: psfile(:)
      REAL(DP),         OPTIONAL, INTENT(out) :: amass(:)
      CHARACTER(len=*), OPTIONAL, INTENT(out) :: amass_units
      REAL(DP),         OPTIONAL, INTENT(out) :: tau(:,:)
      INTEGER,          OPTIONAL, INTENT(out) :: if_pos(:,:)
      CHARACTER(len=*), OPTIONAL, INTENT(out) :: tau_units
      CHARACTER(len=*), OPTIONAL, INTENT(out) :: pseudo_dir
      INTEGER,                    INTENT(out) :: ierr
      !
      INTEGER                     :: nat_, nsp_
      CHARACTER(256)              :: tau_units_, amass_units_
      INTEGER,        ALLOCATABLE :: ityp_(:)
      CHARACTER(3),   ALLOCATABLE :: atm_(:)
      CHARACTER(256), ALLOCATABLE :: psfile_(:)
      CHARACTER(256)              :: pseudo_dir_
      REAL(DP),       ALLOCATABLE :: amass_(:)
      REAL(DP),       ALLOCATABLE :: tau_(:,:)
      INTEGER,        ALLOCATABLE :: if_pos_(:,:)
      !
      INTEGER :: i
      !
      ierr=0
      !
      CALL iotk_scan_begin( iunit, "IONS", IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_dat( iunit, "NUMBER_OF_ATOMS", nat_, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_dat( iunit, "NUMBER_OF_SPECIES", nsp_ )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_empty( iunit, "UNITS_FOR_ATOMIC_MASSES", ATTR=attr, IERR=ierr )
      IF (ierr/=0) RETURN
      CALL iotk_scan_attr( attr, "UNITS", amass_units_, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      IF ( present(nat) )   nat = nat_
      IF ( present(nsp) )   nsp = nsp_
      !
      ALLOCATE( atm_(nsp_) )
      ALLOCATE( amass_(nsp_) )
      ALLOCATE( psfile_(nsp_) )
      !
      DO i = 1, nsp_
         !
         IF ( qexml_version_before_1_4_0 ) THEN
            !
            CALL iotk_scan_dat( iunit, "ATOM_TYPE", atm_(i), IERR=ierr )
            IF (ierr/=0) RETURN
            CALL iotk_scan_dat( iunit, trim( atm_(i) ) // "_MASS", amass_(i), IERR=ierr )
            IF (ierr/=0) RETURN
            CALL iotk_scan_dat( iunit, "PSEUDO_FOR_" // trim( atm_(i) ), &
                                psfile_(i), IERR=ierr )
            IF (ierr/=0) RETURN
            !
         ELSE
            !
            ! current version
            !
            CALL iotk_scan_begin( iunit, "SPECIE"//trim(iotk_index(i)), IERR=ierr )
            IF (ierr/=0) RETURN
            !
            CALL iotk_scan_dat( iunit, "ATOM_TYPE", atm_(i), IERR=ierr )
            IF (ierr/=0) RETURN
            CALL iotk_scan_dat( iunit, "MASS", amass_(i), IERR=ierr )
            IF (ierr/=0) RETURN
            CALL iotk_scan_dat( iunit, "PSEUDO", psfile_(i), IERR=ierr )
            IF (ierr/=0) RETURN
            !
            CALL iotk_scan_end( iunit, "SPECIE"//trim(iotk_index(i)), IERR=ierr )
            IF (ierr/=0) RETURN
            !
         ENDIF
         !
      ENDDO
      !
      CALL iotk_scan_dat( iunit, "PSEUDO_DIR", pseudo_dir_ )
      !
      CALL iotk_scan_empty( iunit, "UNITS_FOR_ATOMIC_POSITIONS", ATTR=attr, IERR=ierr )
      IF (ierr/=0) RETURN
      CALL iotk_scan_attr( attr, "UNITS", tau_units_, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      ALLOCATE( ityp_(nat_) )
      ALLOCATE( tau_(3,nat_) )
      ALLOCATE( if_pos_(3,nat_) )
      !
      DO i = 1, nat_
         !
         CALL iotk_scan_empty( iunit, &
                               "ATOM" // trim( iotk_index(i) ), ATTR=attr, IERR=ierr )
         IF (ierr/=0) RETURN
         !
         CALL iotk_scan_attr( attr, "INDEX",  ityp_(i), IERR=ierr )
         IF (ierr/=0) RETURN
         CALL iotk_scan_attr( attr, "tau",    tau_(:,i), IERR=ierr )
         IF (ierr/=0) RETURN
         CALL iotk_scan_attr( attr, "if_pos", if_pos_(:,i), IERR=ierr )
         IF (ierr/=0) RETURN
         !
      ENDDO
      !
      CALL iotk_scan_end( iunit, "IONS", IERR=ierr )
      IF (ierr/=0) RETURN
      !
      !
      IF ( present(nsp) )         nsp    = nsp_
      IF ( present(nat) )         nat    = nat_
      IF ( present(atm) )         atm(1:nsp_)    = atm_
      IF ( present(amass) )       amass(1:nsp_)  = amass_
      IF ( present(amass_units) ) amass_units    = trim(amass_units_)
      IF ( present(psfile) )      psfile(1:nsp_) = psfile_(1:nsp_)
      IF ( present(ityp) )        ityp(1:nat_)   = ityp_
      IF ( present(tau_units) )   tau_units      = trim(tau_units_)
      IF ( present(tau) )         tau(1:3, 1:nat_)    = tau_
      IF ( present(if_pos) )      if_pos(1:3, 1:nat_) = if_pos_
      IF ( present(pseudo_dir) )  pseudo_dir = pseudo_dir_
      !
      DEALLOCATE( atm_ )
      DEALLOCATE( amass_ )
      DEALLOCATE( psfile_ )
      DEALLOCATE( ityp_ )
      DEALLOCATE( tau_ )
      DEALLOCATE( if_pos_ )
      !
    END SUBROUTINE qexml_read_ions
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_read_magnetization(starting_magnetization, angle1, angle2, &
                                   nsp, two_fermi_energies, i_cons, mcons, bfield, &
                                   ef_up, ef_dw, nelup, neldw, lambda, energy_units, found, ierr)
      !------------------------------------------------------------------------
      !
      IMPLICIT NONE
      INTEGER,      OPTIONAL, INTENT(OUT) :: nsp, i_cons
      REAL(DP),     OPTIONAL, INTENT(OUT) :: starting_magnetization(:), &
                                             angle1(:), angle2(:), mcons(:,:), &
                                             bfield(:), ef_up, ef_dw, nelup, neldw, lambda
      LOGICAL,      OPTIONAL, INTENT(OUT) :: two_fermi_energies
      LOGICAL,      OPTIONAL, INTENT(OUT) :: found
      CHARACTER(*), OPTIONAL, INTENT(OUT) :: energy_units
      INTEGER,                INTENT(OUT) :: ierr
      !
      INTEGER  :: i
      INTEGER  :: nsp_, i_cons_
      LOGICAL  :: two_fermi_energies_,found_,found2
      REAL(DP) :: ef_up_, ef_dw_, nelup_, neldw_, lambda_, bfield_(3)
      REAL(DP), ALLOCATABLE :: angle1_(:), angle2_(:)
      REAL(DP), ALLOCATABLE :: mcons_(:,:), starting_magnetization_(:) 
      CHARACTER(256) :: energy_units_
      !
      !
      CALL iotk_scan_begin( iunit, "MAGNETIZATION_INIT", IERR=ierr, FOUND = found_ )
      !
      IF (found_) THEN
         !
         CALL iotk_scan_dat(iunit,"CONSTRAINT_MAG", i_cons_)
         !
         CALL iotk_scan_dat( iunit, "NUMBER_OF_SPECIES", nsp_ )
         !
         ALLOCATE( starting_magnetization_(nsp_) )
         ALLOCATE( angle1_(nsp_) )
         ALLOCATE( angle2_(nsp_) )

         IF ( i_cons_ ==1 .OR. i_cons_ ==2 ) ALLOCATE( mcons_(3,nsp_) )
         !
         DO i=1,nsp_
            !
            CALL iotk_scan_begin( iunit, "SPECIE"//TRIM(iotk_index(i)) )
            !
            CALL iotk_scan_dat( iunit, "STARTING_MAGNETIZATION", &
                 starting_magnetization_(i) )
            CALL iotk_scan_dat( iunit, "ANGLE1", angle1_(i) )
            CALL iotk_scan_dat( iunit, "ANGLE2", angle2_(i) )
            !
            !
            IF (i_cons_==1.OR.i_cons_==2) THEN
               !
               CALL iotk_scan_dat( iunit, "CONSTRANT_1", mcons_(1,i) )
               CALL iotk_scan_dat( iunit, "CONSTRANT_2", mcons_(2,i) )
               CALL iotk_scan_dat( iunit, "CONSTRANT_3", mcons_(3,i) )
               !
            ENDIF
            !
            CALL iotk_scan_end( iunit, "SPECIE"//TRIM(iotk_index(i)) )
            !
         ENDDO
         !
         IF ( i_cons_ ==1 .OR. i_cons_ ==2 ) THEN
            !
            mcons_(1:3,1:nsp_) = mcons_
            !
            DEALLOCATE( mcons_ )
            !
         ENDIF
         !
         IF (i_cons_==3) THEN
            !
            ALLOCATE( mcons_(3,1) )
            !
            CALL iotk_scan_dat( iunit, "FIXED_MAGNETIZATION_1", mcons_(1,1) )
            CALL iotk_scan_dat( iunit, "FIXED_MAGNETIZATION_2", mcons_(2,1) )
            CALL iotk_scan_dat( iunit, "FIXED_MAGNETIZATION_3", mcons_(3,1) )
            !
            IF (present(mcons) ) mcons(1:3,1:1) = mcons_
            !
            DEALLOCATE( mcons_)
            !
         ELSE IF (i_cons_==4) THEN
            ! 
            CALL iotk_scan_dat( iunit, "MAGNETIC_FIELD_1", bfield_(1) )
            CALL iotk_scan_dat( iunit, "MAGNETIC_FIELD_2", bfield_(2) )
            CALL iotk_scan_dat( iunit, "MAGNETIC_FIELD_3", bfield_(3) )
            !
            IF (present(bfield)) bfield(1:3) = bfield_(1:3)
            !
         ENDIF
         !
         CALL iotk_scan_dat(iunit,"TWO_FERMI_ENERGIES", &
              two_fermi_energies_,FOUND=found2 )
         IF ( .not. found2 ) two_fermi_energies_=.FALSE.
         !
         IF (two_fermi_energies_) THEN
            !
            CALL iotk_scan_empty( iunit, "UNITS_FOR_ENERGIES", ATTR=attr, IERR=ierr )
            IF (ierr/=0) RETURN
            CALL iotk_scan_attr( attr, "UNITS", energy_units_, IERR=ierr )
            !
            ALLOCATE( mcons_(3,1) )
            !
            CALL iotk_scan_dat( iunit, "FIXED_MAGNETIZATION", mcons_(3,1) )
            CALL iotk_scan_dat( iunit, "ELECTRONS_UP", nelup_ )
            CALL iotk_scan_dat( iunit, "ELECTRONS_DOWN", neldw_ )
            CALL iotk_scan_dat( iunit, "FERMI_ENERGY_UP", ef_up_ )
            CALL iotk_scan_dat( iunit, "FERMI_ENERGY_DOWN", ef_dw_ )
            !
            IF (present(mcons) ) mcons(3,1) = mcons_(3,1)
            IF (present(ef_up) ) ef_up = ef_up_
            IF (present(ef_dw) ) ef_dw = ef_dw_
            IF (present(nelup) ) nelup = nelup_
            IF (present(neldw) ) neldw = neldw_
            IF (present(energy_units) ) energy_units = trim(energy_units_)
            !
            DEALLOCATE( mcons_)
            !
         ENDIF
         !
         lambda_ = 0.0d0
         IF (i_cons_ > 0) CALL iotk_scan_dat(iunit,"LAMBDA",lambda_)
         !
         CALL iotk_scan_end( iunit, "MAGNETIZATION_INIT" )
         !
         IF (present(nsp)) nsp = nsp_
         IF (present(two_fermi_energies)) two_fermi_energies = two_fermi_energies_
         IF (present(i_cons)) i_cons = i_cons_
         !
         IF (present(lambda) ) lambda = lambda_
         IF (present(starting_magnetization) ) starting_magnetization(1:nsp_) = starting_magnetization_
         IF (present(angle1) ) angle1(1:nsp_) = angle1_(1:nsp_)
         IF (present(angle2) ) angle2(1:nsp_) = angle2_(1:nsp_)
         !
      END IF
      !
      IF (present(found)) found = found_
      IF ( (.NOT. present(found)) .AND. ( .NOT. found_) ) ierr = 1
      !
      !
    END SUBROUTINE qexml_read_magnetization
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_read_symmetry( nsym, nrot, invsym, noinv, time_reversal, no_t_rev, &
                                    trasl, s, sname, s_units, t_rev, &
                                    irt, nat, found, ierr )
      !------------------------------------------------------------------------
      !
      INTEGER,          OPTIONAL, INTENT(out) :: nsym, nrot
      LOGICAL,          OPTIONAL, INTENT(out) :: invsym, noinv, time_reversal, no_t_rev
      INTEGER,          OPTIONAL, INTENT(out) :: s(:,:,:)
      REAL(DP),         OPTIONAL, INTENT(out) :: trasl(:,:)
      CHARACTER(len=*), OPTIONAL, INTENT(out) :: sname(:)
      CHARACTER(len=*), OPTIONAL, INTENT(out) :: s_units
      INTEGER,          OPTIONAL, INTENT(out) :: t_rev(:)
      INTEGER,          OPTIONAL, INTENT(out) :: irt(:,:), nat
      LOGICAL,                    INTENT(out) :: found
      INTEGER,                    INTENT(out) :: ierr
      !
      INTEGER              :: nsym_
      INTEGER              :: nrot_
      CHARACTER(256)       :: sname_(48), s_units_
      LOGICAL              :: invsym_, noinv_, time_reversal_, no_t_rev_
      INTEGER              :: s_(3,3,48)
      REAL(DP)             :: trasl_(3,48)
      INTEGER              :: t_rev_(48)
      INTEGER              :: nat_
      INTEGER, ALLOCATABLE :: irt_(:,:)
      INTEGER              :: i
      LOGICAL              :: found_tmp
      !
      !
      ierr=0
      !
      !
      CALL iotk_scan_begin( iunit, "SYMMETRIES", FOUND=found ,IERR=ierr )
      IF ((ierr/=0).OR.(.NOT.found)) RETURN
      !
      CALL iotk_scan_dat( iunit, "NUMBER_OF_SYMMETRIES", nsym_, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_dat( iunit, "NUMBER_OF_BRAVAIS_SYMMETRIES", &
                                 nrot_, FOUND=found_tmp, IERR=ierr )
      IF (ierr/=0) RETURN
      IF (.NOT. found_tmp) nrot_ = nsym_
      !
      CALL iotk_scan_dat( iunit, "INVERSION_SYMMETRY", invsym_, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_dat( iunit, "DO_NOT_USE_TIME_REVERSAL", &
                                  noinv_, FOUND = found_tmp, IERR=ierr )
      IF (ierr/=0) RETURN
      IF (.NOT. found_tmp) noinv_ = .FALSE.
      !
      CALL iotk_scan_dat( iunit, "TIME_REVERSAL_FLAG", &
                                  time_reversal_, FOUND = found_tmp, IERR=ierr )
      IF (ierr/=0) RETURN
      IF (.NOT. found_tmp) time_reversal_ = .TRUE.
      !
      CALL iotk_scan_dat( iunit, "NO_TIME_REV_OPERATIONS", &
                                   no_t_rev_, FOUND = found_tmp, IERR=ierr )
      IF (ierr/=0) RETURN
      IF (.NOT. found_tmp) no_t_rev_ = .FALSE.
      !
      CALL iotk_scan_dat( iunit, "NUMBER_OF_ATOMS", nat_, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      ALLOCATE( irt_(48, nat_) )
      !
      CALL iotk_scan_empty( iunit, "UNITS_FOR_SYMMETRIES", ATTR=attr, IERR=ierr )
      IF (ierr/=0) RETURN
      CALL iotk_scan_attr( attr, "UNITS", s_units_, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      DO i = 1, nsym_
          !
          CALL iotk_scan_begin( iunit, "SYMM"//trim( iotk_index( i ) ), IERR=ierr )
          IF (ierr/=0) RETURN
          !
          CALL iotk_scan_empty( iunit, "INFO", ATTR=attr, IERR=ierr )
          IF (ierr/=0) RETURN
          !
          CALL iotk_scan_attr( attr, "NAME", sname_(i), IERR=ierr )
          IF (ierr/=0) RETURN
          CALL iotk_scan_attr( attr, "T_REV", t_rev_(i), IERR=ierr )
          IF (ierr/=0) RETURN
          !
          CALL iotk_scan_dat( iunit, "ROTATION", s_(1:3,1:3,i), IERR=ierr )
          IF (ierr/=0) RETURN
          !
          CALL iotk_scan_dat( iunit, "FRACTIONAL_TRANSLATION", trasl_(1:3,i), IERR=ierr )
          IF (ierr/=0) RETURN
          !
          CALL iotk_scan_dat( iunit, "EQUIVALENT_IONS", irt_(i,1:nat_), IERR=ierr )
          IF (ierr/=0) RETURN
          !
          CALL iotk_scan_end( iunit, "SYMM"//trim( iotk_index( i ) ), IERR=ierr )
          IF (ierr/=0) RETURN
          !
      ENDDO
      !
      DO i = nsym_+1, nrot_
         !    
         CALL iotk_scan_begin( iunit, "SYMM" // TRIM( iotk_index( i ) ), IERR=ierr )
         IF (ierr/=0) RETURN
         !
         CALL iotk_scan_empty( iunit, "INFO", ATTR = attr, IERR=ierr )
         IF (ierr/=0) RETURN
         !
         CALL iotk_scan_attr( attr, "NAME",  sname_(i), IERR=ierr )
         IF (ierr/=0) RETURN
         !
         CALL iotk_scan_dat( iunit, "ROTATION", s_(1:3,1:3,i), IERR=ierr )
         IF (ierr/=0) RETURN
         !
         CALL iotk_scan_end( iunit, "SYMM" // TRIM( iotk_index( i ) ), IERR=ierr )
         IF (ierr/=0) RETURN
         !
      END DO
      !
      CALL iotk_scan_end( iunit, "SYMMETRIES", IERR=ierr )
      IF (ierr/=0) RETURN
      !
      !
      IF ( present(nsym) )        nsym          = nsym_
      IF ( present(nrot) )        nrot          = nrot_
      IF ( present(invsym) )      invsym        = invsym_
      IF ( present(noinv) )       noinv         = noinv_
      IF ( present(time_reversal) ) time_reversal = time_reversal_
      IF ( present(no_t_rev) )    no_t_rev      = no_t_rev_
      IF ( present(nat) )         nat           = nat_
      IF ( present(trasl) )       trasl(1:3, 1:nsym_)   = trasl_(1:3, 1:nsym_)
      IF ( present(s) )           s(1:3, 1:3, 1:nrot_)  = s_(1:3, 1:3, 1:nrot_)
      IF ( present(irt) )         irt(1:nsym_, 1:nat_)  = irt_(1:nsym_, 1:nat_)
      IF ( present(sname) )  THEN
          DO i = 1, nrot_
                                  sname( i )            = trim( sname_( i ) )
          ENDDO
      ENDIF
      IF ( present(s_units) )     s_units               = trim( s_units_ )
      IF ( present(t_rev) )       t_rev( 1:nsym_ )      = t_rev_( 1:nsym_ )
      !
      DEALLOCATE( irt_ )
      !
    END SUBROUTINE qexml_read_symmetry
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_read_efield( tefield, dipfield, edir, emaxpos, eopreg, eamp, &
                                  gate, zgate, relaxz, block, block_1, block_2,&
                                  block_height, found, ierr )
      !----------------------------------------------------------------------
      !
      IMPLICIT NONE
      !
      LOGICAL,   OPTIONAL, INTENT(out) :: tefield, dipfield, gate, relaxz, block
      INTEGER,   OPTIONAL, INTENT(out) :: edir
      REAL(DP),  OPTIONAL, INTENT(out) :: emaxpos, eopreg, eamp, zgate, block_1, block_2, block_height
      LOGICAL,             INTENT(out) :: found
      INTEGER,             INTENT(out) :: ierr
      !
      LOGICAL   :: tefield_, dipfield_, gate_, block_, relaxz_
      INTEGER   :: edir_
      REAL(DP)  :: emaxpos_, eopreg_, eamp_, zgate_, block_1_, block_2_, block_height_
      !
      ierr = 0
      !
      CALL iotk_scan_begin( iunit, "ELECTRIC_FIELD", FOUND=found, IERR=ierr )
      IF ( ( .NOT. found ).OR.( ierr /= 0 ) ) RETURN
      !
      !
      CALL iotk_scan_dat( iunit, "HAS_ELECTRIC_FIELD", tefield_, IERR=ierr )
      IF ( ierr /= 0 ) RETURN
      !
      CALL iotk_scan_dat( iunit, "HAS_DIPOLE_CORRECTION", dipfield_, IERR=ierr )
      IF ( ierr /= 0 ) RETURN
      !
      CALL iotk_scan_dat( iunit, "FIELD_DIRECTION", edir_, IERR=ierr )
      IF ( ierr /= 0 ) RETURN
      !
      CALL iotk_scan_dat( iunit, "MAXIMUM_POSITION", emaxpos_, IERR=ierr )
      IF ( ierr /= 0 ) RETURN
      !
      CALL iotk_scan_dat( iunit, "INVERSE_REGION", eopreg_, IERR=ierr )
      IF ( ierr /= 0 ) RETURN
      !
      CALL iotk_scan_dat( iunit, "FIELD_AMPLITUDE", eamp_, IERR=ierr )
      IF ( ierr /= 0 ) RETURN
      !
      !-----------------------------------------------------------------------
      !Earlier versions do not have the following field (e.g. 5.1.0).
      gate_= .FALSE.
      block_= .FALSE.
      relaxz_ = .FALSE.
      zgate_ = 0.0
      block_1_ = 0.0
      block_2_ = 0.0
      block_height_ = 0.0
      !-----------------------------------------------------------------------
      CALL iotk_scan_dat( iunit, "CHARGED_PLATE", gate_, FOUND=found, IERR=ierr )
      IF ( found .and. ( ierr /= 0 ) ) RETURN
      !
      CALL iotk_scan_dat( iunit, "GATE_POS", zgate_, FOUND=found, IERR=ierr )
      IF ( found .and. ( ierr /= 0 ) ) RETURN
      !
      CALL iotk_scan_dat( iunit, "RELAX_Z", relaxz_, FOUND=found, IERR=ierr )
      IF ( found .and. ( ierr /= 0 ) ) RETURN
      !
      CALL iotk_scan_dat( iunit, "BLOCK", block_, FOUND=found, IERR=ierr )
      IF ( found .and. ( ierr /= 0 ) ) RETURN
      !
      CALL iotk_scan_dat( iunit, "BLOCK_1", block_1_, FOUND=found, IERR=ierr )
      IF ( found .and. ( ierr /= 0 ) ) RETURN
      !
      CALL iotk_scan_dat( iunit, "BLOCK_2", block_2_, FOUND=found, IERR=ierr )
      IF ( found .and. ( ierr /= 0 ) ) RETURN
      !
      CALL iotk_scan_dat( iunit, "BLOCK_HEIGHT", block_height_, FOUND=found, IERR=ierr )
      IF ( found .and. ( ierr /= 0 ) ) RETURN
      !
      CALL iotk_scan_end( iunit, "ELECTRIC_FIELD", IERR=ierr )
      IF ( ierr /= 0 ) RETURN
      !
      !
      IF ( present(tefield) )        tefield      = tefield_
      IF ( present(dipfield) )       dipfield     = dipfield_
      IF ( present(edir) )           edir         = edir_
      IF ( present(emaxpos) )        emaxpos      = emaxpos_
      IF ( present(eopreg) )         eopreg       = eopreg_
      IF ( present(eamp) )           eamp         = eamp_
      IF ( present(gate) )           gate         = gate_
      IF ( present(zgate) )          zgate        = zgate_
      IF ( present(relaxz) )         relaxz       = relaxz_
      IF ( present(block) )          block        = block_
      IF ( present(block_1) )        block_1      = block_1_
      IF ( present(block_2) )        block_2      = block_2_
      IF ( present(block_height) )   block_height = block_height_
      !
    END SUBROUTINE qexml_read_efield
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_read_exx( x_gamma_extrapolation, nqx1, nqx2, nqx3, &
                          exxdiv_treatment, yukawa, ecutvcut, exx_fraction, &
                          screening_parameter, gau_parameter, exx_is_active, ecutfock, &
                          found, ierr )
      !----------------------------------------------------------------------
      !
      IMPLICIT NONE
      !
      LOGICAL,          OPTIONAL, INTENT(OUT) :: x_gamma_extrapolation, exx_is_active
      INTEGER,          OPTIONAL, INTENT(OUT) :: nqx1, nqx2, nqx3
      CHARACTER(LEN=*), OPTIONAL, INTENT(OUT) :: exxdiv_treatment
      REAL(DP),         OPTIONAL, INTENT(OUT) :: yukawa, ecutvcut, exx_fraction
      REAL(DP),         OPTIONAL, INTENT(OUT) :: screening_parameter, ecutfock
      REAL(DP),         OPTIONAL, INTENT(OUT) :: gau_parameter
      LOGICAL,                    INTENT(out) :: found
      INTEGER,                    INTENT(out) :: ierr
      !
      LOGICAL  :: x_gamma_extrapolation_, exx_is_active_
      INTEGER  :: nqx1_, nqx2_, nqx3_
      REAL(DP) :: yukawa_, ecutvcut_, exx_fraction_
      REAL(DP) :: screening_parameter_, ecutfock_
      REAL(DP) :: gau_parameter_
      CHARACTER(LEN=80) :: exxdiv_treatment_
      !
      !
      ierr = 0
      !
      CALL iotk_scan_begin( iunit, "EXACT_EXCHANGE", FOUND=found, IERR=ierr )
      IF ( ( .NOT. found ).OR.( ierr /= 0 ) ) RETURN
      !
      call iotk_scan_dat(iunit, "x_gamma_extrapolation", x_gamma_extrapolation_, IERR=ierr)
      IF ( ierr /= 0 ) RETURN
      !
      call iotk_scan_dat(iunit, "nqx1", nqx1_, IERR=ierr)
      IF ( ierr /= 0 ) RETURN
      !
      call iotk_scan_dat(iunit, "nqx2", nqx2_, IERR=ierr)
      IF ( ierr /= 0 ) RETURN
      !
      call iotk_scan_dat(iunit, "nqx3", nqx3_, IERR=ierr)
      IF ( ierr /= 0 ) RETURN
      !
      call iotk_scan_dat(iunit, "exxdiv_treatment", exxdiv_treatment_, IERR=ierr)
      IF ( ierr /= 0 ) RETURN
      !
      call iotk_scan_dat(iunit, "yukawa", yukawa_, IERR=ierr)
      IF ( ierr /= 0 ) RETURN
      !
      call iotk_scan_dat(iunit, "ecutvcut", ecutvcut_, IERR=ierr)
      IF ( ierr /= 0 ) RETURN
      !
      call iotk_scan_dat(iunit, "exx_fraction", exx_fraction_, IERR=ierr)
      IF ( ierr /= 0 ) RETURN
      !
      call iotk_scan_dat(iunit, "screening_parameter", screening_parameter_, IERR=ierr)
      IF ( ierr /= 0 ) RETURN
      !
      ! Check if existing, for back-compatibility
      call iotk_scan_dat(iunit, "gau_parameter", gau_parameter_, FOUND=found, IERR=ierr)
      IF ( .NOT. found )  gau_parameter_=0.0_dp
      IF ( ierr /= 0 ) RETURN
      !
      call iotk_scan_dat(iunit, "exx_is_active", exx_is_active_, IERR=ierr)
      IF ( ierr /= 0 ) RETURN
      !
      ! Check if existing, for back-compatibility
      call iotk_scan_dat(iunit, "ecutfock", ecutfock_, IERR=ierr, FOUND=found)
      IF ( .NOT. found )  ecutfock_=-1.0_dp
      IF ( ierr /= 0 ) RETURN
      !
      CALL iotk_scan_end(iunit, "EXACT_EXCHANGE", IERR=ierr)
      IF ( ierr /= 0 ) RETURN
      !
      !
      IF ( present(x_gamma_extrapolation) ) x_gamma_extrapolation = x_gamma_extrapolation_
      IF ( present(nqx1) )                                   nqx1 = nqx1_
      IF ( present(nqx2) )                                   nqx2 = nqx2_
      IF ( present(nqx3) )                                   nqx3 = nqx3_
      IF ( present(exxdiv_treatment) )           exxdiv_treatment = exxdiv_treatment_
      IF ( present(yukawa) )                               yukawa = yukawa_
      IF ( present(ecutvcut) )                           ecutvcut = ecutvcut_
      IF ( present(exx_fraction) )                   exx_fraction = exx_fraction_
      IF ( present(screening_parameter) )     screening_parameter = screening_parameter_
      IF ( present(ecutfock) )                           ecutfock = ecutfock_
      IF ( present(gau_parameter) )                 gau_parameter = gau_parameter_
      IF ( present(exx_is_active) )                 exx_is_active = exx_is_active_
      !
      found = .TRUE.
      !
    END SUBROUTINE qexml_read_exx
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_read_esm( esm_nfit, esm_efield, esm_w, esm_a, esm_bc, ierr )
      !----------------------------------------------------------------------
      !
      IMPLICIT NONE
      !
      INTEGER,          OPTIONAL, INTENT(OUT) :: esm_nfit
      REAL(DP),         OPTIONAL, INTENT(OUT) :: esm_efield, esm_w, esm_a
      CHARACTER(LEN=*), OPTIONAL, INTENT(OUT) :: esm_bc
      INTEGER,                    INTENT(out) :: ierr
      !
      INTEGER  :: esm_nfit_
      REAL(DP) :: esm_efield_, esm_w_, esm_a_
      CHARACTER(LEN=3) :: esm_bc_
      !
      !
      ierr = 0
      !
      CALL iotk_scan_begin( iunit, "ESM", IERR=ierr )
      IF ( ierr /= 0 ) RETURN
      !
      call iotk_scan_dat(iunit, "esm_nfit", esm_nfit_, IERR=ierr)
      IF ( ierr /= 0 ) RETURN
      !
      call iotk_scan_dat(iunit, "esm_efield", esm_efield_, IERR=ierr)
      IF ( ierr /= 0 ) RETURN
      !
      call iotk_scan_dat(iunit, "esm_w", esm_w_, IERR=ierr)
      IF ( ierr /= 0 ) RETURN
      !
      call iotk_scan_dat(iunit, "esm_a", esm_a_, IERR=ierr)
      IF ( ierr /= 0 ) RETURN
      !
      call iotk_scan_dat(iunit, "esm_bc", esm_bc_, IERR=ierr)
      IF ( ierr /= 0 ) RETURN
      !
      CALL iotk_scan_end(iunit, "ESM", IERR=ierr)
      IF ( ierr /= 0 ) RETURN
      !
      !
      IF ( present(esm_nfit) )    esm_nfit    = esm_nfit_
      IF ( present(esm_efield) )  esm_efield  = esm_efield_
      IF ( present(esm_w) )       esm_w       = esm_w_
      IF ( present(esm_a) )       esm_a       = esm_a_
      IF ( present(esm_bc) )      esm_bc      = esm_bc_
      !
    END SUBROUTINE qexml_read_esm
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_read_planewaves( ecutwfc, ecutrho, npwx, gamma_only, &
                                      nr1, nr2, nr3,  ngm,  nr1s, nr2s, nr3s, ngms, &
                                      nr1b, nr2b, nr3b,  igv, cutoff_units, ierr )
      !------------------------------------------------------------------------
      !
      !
      INTEGER,      OPTIONAL, INTENT(out) :: npwx, nr1, nr2, nr3, ngm, &
                                             nr1s, nr2s, nr3s, ngms, nr1b, nr2b, nr3b
      INTEGER,      OPTIONAL, INTENT(out) :: igv(:,:)
      REAL(DP),     OPTIONAL, INTENT(out) :: ecutwfc, ecutrho
      LOGICAL,      OPTIONAL, INTENT(out) :: gamma_only
      CHARACTER(*), OPTIONAL, INTENT(out) :: cutoff_units
      INTEGER,                INTENT(out) :: ierr
      !
      INTEGER        :: npwx_, nr1_, nr2_, nr3_, ngm_, &
                        nr1s_, nr2s_, nr3s_, ngms_, nr1b_, nr2b_, nr3b_
      REAL(DP)       :: ecutwfc_, ecutrho_
      CHARACTER(256) :: cutoff_units_
      LOGICAL        :: gamma_only_
      !
      ierr = 0
      !
      CALL iotk_scan_begin( iunit, "PLANE_WAVES", IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_empty( iunit, "UNITS_FOR_CUTOFF", ATTR=attr, IERR=ierr )
      IF (ierr/=0) RETURN
      CALL iotk_scan_attr( attr, "UNITS", cutoff_units_, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_dat( iunit, "WFC_CUTOFF", ecutwfc_, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_dat( iunit, "RHO_CUTOFF", ecutrho_ , IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_dat( iunit, "MAX_NUMBER_OF_GK-VECTORS", npwx_, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_dat( iunit, "GAMMA_ONLY", gamma_only_, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_empty( iunit, "FFT_GRID", ATTR = attr, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_attr( attr, "nr1", nr1_, IERR=ierr )
      IF (ierr/=0) RETURN
      CALL iotk_scan_attr( attr, "nr2", nr2_, IERR=ierr )
      IF (ierr/=0) RETURN
      CALL iotk_scan_attr( attr, "nr3", nr3_, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_dat( iunit, "GVECT_NUMBER", ngm_, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_empty( iunit, "SMOOTH_FFT_GRID", ATTR = attr, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_attr( attr, "nr1s", nr1s_, IERR=ierr )
      IF (ierr/=0) RETURN
      CALL iotk_scan_attr( attr, "nr2s", nr2s_, IERR=ierr )
      IF (ierr/=0) RETURN
      CALL iotk_scan_attr( attr, "nr3s", nr3s_, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_dat( iunit, "SMOOTH_GVECT_NUMBER", ngms_, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      !
      IF ( present( igv ) ) THEN
          !
          CALL iotk_scan_begin( iunit, "G-VECTORS", IERR=ierr )
          IF (ierr/=0) RETURN
          !
          CALL iotk_scan_dat( iunit, "g", igv(1:3,1:ngm_), IERR=ierr )
          IF (ierr/=0) RETURN
          !
          CALL iotk_scan_end( iunit, "G-VECTORS", IERR=ierr )
          IF (ierr/=0) RETURN
          !
      ENDIF
      !
      !
      CALL iotk_scan_empty( iunit, "SMALLBOX_FFT_GRID", ATTR = attr, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_attr( attr, "nr1b", nr1b_, IERR=ierr )
      IF (ierr/=0) RETURN
      CALL iotk_scan_attr( attr, "nr2b", nr2b_, IERR=ierr )
      IF (ierr/=0) RETURN
      CALL iotk_scan_attr( attr, "nr3b", nr3b_, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_end( iunit, "PLANE_WAVES", IERR=ierr )
      IF (ierr/=0) RETURN
      !
      !
      IF ( present( ecutwfc ) )           ecutwfc      = ecutwfc_
      IF ( present( ecutrho ) )           ecutrho      = ecutrho_
      IF ( present( npwx ) )              npwx         = npwx_
      IF ( present( gamma_only ) )        gamma_only   = gamma_only_
      IF ( present( nr1 ) )               nr1          = nr1_
      IF ( present( nr2 ) )               nr2          = nr2_
      IF ( present( nr3 ) )               nr3          = nr3_
      IF ( present( ngm ) )               ngm          = ngm_
      IF ( present( nr1s ) )              nr1s         = nr1s_
      IF ( present( nr2s ) )              nr2s         = nr2s_
      IF ( present( nr3s ) )              nr3s         = nr3s_
      IF ( present( ngms ) )              ngms         = ngms_
      IF ( present( nr1b ) )              nr1b         = nr1b_
      IF ( present( nr2b ) )              nr2b         = nr2b_
      IF ( present( nr3b ) )              nr3b         = nr3b_
      IF ( present( cutoff_units ) )      cutoff_units = trim( cutoff_units_ )
      !
    END SUBROUTINE qexml_read_planewaves
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_read_gk( ik, npwk, npwkx, gamma_only, xk, k_units, index, igk, ierr )
      !------------------------------------------------------------------------
      !
      INTEGER,                INTENT(in)  :: ik
      INTEGER,      OPTIONAL, INTENT(out) :: npwk, npwkx
      LOGICAL,      OPTIONAL, INTENT(out) :: gamma_only
      REAL(DP),     OPTIONAL, INTENT(out) :: xk(3)
      CHARACTER(*), OPTIONAL, INTENT(out) :: k_units
      INTEGER,      OPTIONAL, INTENT(out) :: igk(:,:), index(:)
      INTEGER,                INTENT(out) :: ierr
      !
      CHARACTER(256) :: filename, k_units_
      INTEGER   :: npwk_, npwkx_
      LOGICAL   :: gamma_only_
      REAL(DP) :: xk_(3)
      INTEGER   :: iunaux
      !

      ierr = 0
      !
      CALL iotk_free_unit( iunaux )
      filename = qexml_wfc_filename( datadir_in, 'gkvectors', ik )
      !
      CALL iotk_open_read ( iunaux, FILE = trim(filename), IERR=ierr )
      IF (ierr/=0)  RETURN
      !
      CALL iotk_scan_dat( iunaux, 'NUMBER_OF_GK-VECTORS', npwk_, IERR=ierr)
      IF (ierr/=0)  RETURN
      !
      CALL iotk_scan_dat( iunaux, 'MAX_NUMBER_OF_GK-VECTORS', npwkx_, IERR=ierr)
      IF (ierr/=0)  RETURN
      !
      IF ( qexml_version_before_1_4_0 ) THEN
         !
         IF ( present( gamma_only ) ) THEN
             !
             CALL qexml_read_planewaves( GAMMA_ONLY=gamma_only_, IERR=ierr)
             IF (ierr/=0)  RETURN
             !
         ENDIF
         !
      ELSE
         !
         CALL iotk_scan_dat( iunaux, 'GAMMA_ONLY', gamma_only_, IERR=ierr)
         IF (ierr/=0)  RETURN
         !
      ENDIF
      !
      CALL iotk_scan_dat( iunaux, 'K-POINT_COORDS', xk_, ATTR=attr, IERR=ierr)
      IF (ierr/=0)  RETURN
      CALL iotk_scan_attr( attr, 'UNITS', k_units_, IERR=ierr)
      IF (ierr/=0)  RETURN
      !
      IF ( present( index ) ) THEN
          !
          CALL iotk_scan_dat( iunaux, 'INDEX', index(1:npwk_), IERR=ierr)
          IF (ierr/=0)  RETURN
          !
      ENDIF
      !
      IF ( present( igk ) ) THEN
          !
          CALL iotk_scan_dat( iunaux, 'GRID', igk(1:3, 1:npwk_), IERR=ierr)
          IF (ierr/=0)  RETURN
          !
      ENDIF
      !
      CALL iotk_close_read ( iunaux, IERR=ierr )
      IF (ierr/=0)  RETURN
      !
      !
      IF ( present( npwk ) )       npwk          = npwk_
      IF ( present( npwkx ) )      npwkx         = npwkx_
      IF ( present( gamma_only ) ) gamma_only    = gamma_only_
      IF ( present( xk ) )         xk(1:3)       = xk_(1:3)
      IF ( present( k_units ) )    k_units       = trim(k_units_)
      !
    END SUBROUTINE qexml_read_gk
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_read_spin( lsda, noncolin, npol, lspinorb, domag, ierr )
      !------------------------------------------------------------------------
      !
      LOGICAL, OPTIONAL, INTENT(out) :: lsda, noncolin, lspinorb, domag
      INTEGER, OPTIONAL, INTENT(out) :: npol
      INTEGER,           INTENT(out) :: ierr
      !
      LOGICAL   :: lsda_, noncolin_, lspinorb_, domag_,found
      INTEGER   :: npol_
      !

      ierr = 0
      !
      CALL iotk_scan_begin( iunit, "SPIN", IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_dat( iunit, "LSDA", lsda_, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_dat( iunit, "NON-COLINEAR_CALCULATION", noncolin_, IERR=ierr, FOUND=found )
      IF (ierr/=0) RETURN
      IF ( .not. found ) noncolin_ = .FALSE.
      !
      npol_ = 1
      !
      IF ( noncolin_ ) THEN
          !
          CALL iotk_scan_dat( iunit, "SPINOR_DIM", npol_, IERR=ierr )
          IF (ierr/=0) RETURN
          !
      ENDIF
      !
      CALL iotk_scan_dat( iunit, "SPIN-ORBIT_CALCULATION", lspinorb_, IERR=ierr, FOUND=found )
      IF (ierr/=0) RETURN
      IF ( .NOT. found ) lspinorb_ = .FALSE.
      !
      CALL iotk_scan_dat( iunit, "SPIN-ORBIT_DOMAG", domag_, IERR=ierr, FOUND=found )
      IF ( .NOT. found ) domag_ = .FALSE.
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_end( iunit, "SPIN", IERR=ierr )
      IF (ierr/=0) RETURN
      !
      !
      IF ( present( lsda ) )       lsda      = lsda_
      IF ( present( noncolin ) )   noncolin  = noncolin_
      IF ( present( npol ) )       npol      = npol_
      IF ( present( lspinorb ) )   lspinorb  = lspinorb_
      IF ( present( domag ) )      domag     = domag_
      !

    END SUBROUTINE qexml_read_spin
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_read_xc( dft, lda_plus_u, lda_plus_u_kind, U_projection, &
                              Hubbard_lmax, Hubbard_l, nsp, Hubbard_U, Hubbard_J,&
                              Hubbard_J0, Hubbard_alpha, Hubbard_beta, &
                              inlc, vdw_table_name, acfdt_in_pw, llondon, london_s6, &
                              london_rcut, london_c6, london_rvdw, &
                              lxdm, ts_vdw, vdw_isolated, ierr )
      !----------------------------------------------------------------------
      !
      CHARACTER(len=*), OPTIONAL, INTENT(out) :: dft
      LOGICAL,          OPTIONAL, INTENT(out) :: lda_plus_u
      INTEGER,          OPTIONAL, INTENT(out) :: lda_plus_u_kind
      !
      INTEGER,          OPTIONAL, INTENT(out) :: Hubbard_lmax
      INTEGER,          OPTIONAL, INTENT(out) :: Hubbard_l(:)
      INTEGER,          OPTIONAL, INTENT(out) :: nsp
      REAL(DP),         OPTIONAL, INTENT(out) :: Hubbard_U(:), Hubbard_J(:,:),&
                                                 Hubbard_alpha(:), &
                                                 Hubbard_J0(:), Hubbard_beta(:)
      INTEGER,          OPTIONAL, INTENT(out) :: inlc
      CHARACTER(LEN=*), OPTIONAL, INTENT(out) :: U_projection
      CHARACTER(LEN=*), OPTIONAL, INTENT(out) :: vdw_table_name
      LOGICAL,          OPTIONAL, INTENT(out) :: acfdt_in_pw
      LOGICAL,  OPTIONAL, INTENT(out) :: llondon, lxdm, ts_vdw, vdw_isolated
      REAL(DP), OPTIONAL, INTENT(out) :: london_s6, london_rcut, london_c6(:), london_rvdw(:)
      !
      INTEGER,                    INTENT(out) :: ierr
      !
      CHARACTER(LEN=256)      :: dft_, vdw_table_name_, U_projection_
      LOGICAL                 :: lda_plus_u_, found, found_nsp
      LOGICAL                 :: acfdt_in_pw_
      INTEGER                 :: Hubbard_lmax_, nsp_,lda_plus_u_kind_, inlc_
      INTEGER,    ALLOCATABLE :: Hubbard_l_(:)
      REAL(DP),   ALLOCATABLE :: Hubbard_U_(:), Hubbard_J_(:,:)
      REAL(DP),   ALLOCATABLE :: Hubbard_alpha_(:), Hubbard_J0_(:), Hubbard_beta_(:)
      LOGICAL                 :: llondon_, lxdm_, ts_vdw_, vdw_isolated_
      REAL(DP)                :: london_s6_=0._dp, london_rcut_=0._dp
      REAL(DP),   ALLOCATABLE :: london_c6_(:), london_rvdw_(:)
      !
      ierr = 0
      !
      !
      CALL iotk_scan_begin( iunit, "EXCHANGE_CORRELATION", IERR=ierr )
      IF ( ierr/=0 ) RETURN
      !
      CALL iotk_scan_dat( iunit, "DFT", dft_, IERR=ierr )
      IF ( ierr/=0 ) RETURN
      !
      CALL iotk_scan_dat( iunit, "NUMBER_OF_SPECIES", nsp_, FOUND=found_nsp, IERR=ierr )
      IF ( ierr/=0 ) RETURN
      !
      CALL iotk_scan_dat( iunit, "LDA_PLUS_U_CALCULATION", lda_plus_u_, FOUND=found, IERR=ierr )
      IF ( ierr/=0 ) RETURN
      IF ( .NOT. found ) lda_plus_u_ = .FALSE.
      !
      IF ( lda_plus_u_ ) THEN
         !
         IF ( .not.found_nsp ) RETURN
         !
         CALL iotk_scan_dat( iunit, "HUBBARD_LMAX", Hubbard_lmax_, IERR=ierr )
         IF ( ierr/=0 ) RETURN
         !
         ALLOCATE( Hubbard_l_(1:nsp_) )
         ALLOCATE( Hubbard_U_(nsp_) )
         !
         CALL iotk_scan_dat( iunit, "HUBBARD_L", Hubbard_l_, IERR=ierr )
         IF ( ierr/=0 ) RETURN
         !
         CALL iotk_scan_dat( iunit, "HUBBARD_U", Hubbard_U_, IERR=ierr )
         IF ( ierr/=0 ) RETURN
         !
         IF ( PRESENT (lda_plus_u_kind) ) THEN
            CALL iotk_scan_dat( iunit, "LDA_PLUS_U_KIND", lda_plus_u_kind_, FOUND = found, IERR=ierr )
            IF ( ierr/=0 ) RETURN
         END IF
         !
         IF ( PRESENT (U_projection) ) THEN
            CALL iotk_scan_dat( iunit, "U_PROJECTION_TYPE", U_projection_, FOUND = found, IERR=ierr )
            IF ( ierr/=0 ) RETURN
            IF ( .NOT. found ) U_projection_='atomic' ! for compatibility
         END IF
         !
         IF ( PRESENT (Hubbard_J) ) THEN
            ALLOCATE( Hubbard_J_(3,nsp_) )
            CALL iotk_scan_dat( iunit, "HUBBARD_J", Hubbard_J_, FOUND = found, IERR=ierr )
            IF ( ierr/=0 ) RETURN
         END IF
         !
         IF ( PRESENT (Hubbard_J0) ) THEN
            ALLOCATE( Hubbard_J0_(nsp_) )
            CALL iotk_scan_dat( iunit, "HUBBARD_J0", Hubbard_J0_, FOUND = found, IERR=ierr )
            IF ( ierr/=0 ) RETURN
         END IF
         !
         IF ( PRESENT (Hubbard_alpha) ) THEN
            ALLOCATE( Hubbard_alpha_(nsp_) )
            CALL iotk_scan_dat( iunit, "HUBBARD_ALPHA", Hubbard_alpha_, FOUND = found, IERR=ierr )
            IF ( ierr/=0 ) RETURN
         END IF
         !
         IF ( PRESENT (Hubbard_beta) ) THEN
            ALLOCATE( Hubbard_beta_(nsp_) )
            CALL iotk_scan_dat( iunit, "HUBBARD_BETA", Hubbard_beta_, FOUND = found, IERR=ierr )
            IF ( ierr/=0 ) RETURN
         END IF
         !
      ENDIF
      !
      CALL iotk_scan_dat( iunit, "NON_LOCAL_DF", inlc_, FOUND = found )
      IF ( found ) THEN
         !
         IF ( inlc_ > 0 ) CALL iotk_scan_dat( iunit, "VDW_KERNEL_NAME", vdw_table_name_ )
         !
      ELSE
         !
         inlc_ = 0
         vdw_table_name_ = ' '
         !
      ENDIF
      !
      CALL iotk_scan_dat( iunit, "ACFDT_IN_PW", acfdt_in_pw_, FOUND=found, IERR=ierr )
      IF ( ierr/=0 ) RETURN
      IF ( .NOT. found ) acfdt_in_pw_ = .FALSE.
!      IF (acfdt_in_pw) dft_name = 'NOX NOC NOGX NOGC'
      !
      CALL iotk_scan_dat( iunit, "ACFDT_IN_PW", acfdt_in_pw_, FOUND=found, IERR=ierr )
      IF ( ierr/=0 ) RETURN
      IF ( .NOT. found ) acfdt_in_pw_ = .FALSE.
!      IF (acfdt_in_pw) dft_name = 'NOX NOC NOGX NOGC'
      !
      CALL iotk_scan_begin( iunit, "DFT_D2", FOUND=found, IERR=ierr )
      IF ( ierr/=0 ) RETURN
      llondon_ = found
      IF ( llondon_ ) THEN
         !         
         IF ( .not. found_nsp ) RETURN
         !
         ALLOCATE( london_c6_(nsp_) )
         ALLOCATE( london_rvdw_(nsp_) )
         !
         london_c6_(:) = -1.0_DP
         london_rvdw_(:) = -1.0_DP
         !
         CALL iotk_scan_dat( iunit, "SCALING_FACTOR", london_s6_ )
         CALL iotk_scan_dat( iunit, "CUTOFF_RADIUS",  london_rcut_)
         CALL iotk_scan_dat( iunit, "C6",             london_c6_ )
         CALL iotk_scan_dat( iunit, "RADIUS_VDW",     london_rvdw_ )
         CALL iotk_scan_end( iunit, "DFT_D2" )
      ENDIF
      !
      CALL iotk_scan_dat( iunit, "XDM", lxdm_, FOUND = found, IERR=ierr )
      IF ( ierr/=0 ) RETURN
      IF (.NOT. found) lxdm_ = .FALSE.
      !
      CALL iotk_scan_begin( iunit,"TKATCHENKO-SCHEFFLER", FOUND=found, IERR=ierr )
      IF ( ierr/=0 ) RETURN
      ts_vdw_ = found
      IF ( ts_vdw_ ) THEN
         CALL iotk_scan_dat( iunit, "ISOLATED_SYSTEM", vdw_isolated_ )
         CALL iotk_scan_end( iunit, "TKATCHENKO-SCHEFFLER" )
      END IF
      !
      CALL iotk_scan_end( iunit, "EXCHANGE_CORRELATION", IERR=ierr )
      IF ( ierr/=0 ) RETURN
      !
      IF ( present( dft ) )           dft           = dft_
      IF ( present( lda_plus_u ) )    lda_plus_u    = lda_plus_u_
      !
      IF ( lda_plus_u_ )  THEN
         !
         IF ( present( nsp ) )             nsp                   = nsp_
         IF ( present( lda_plus_u_kind ) ) lda_plus_u_kind       = lda_plus_u_kind_
         IF ( present( U_projection ) )    U_projection          = U_projection_
         IF ( present( Hubbard_lmax ) )    Hubbard_lmax          = Hubbard_lmax_
         IF ( present( Hubbard_l ) )       Hubbard_l(1:nsp_)     = Hubbard_l_(:)
         IF ( present( Hubbard_U ) )       Hubbard_U(1:nsp_)     = Hubbard_U_(1:nsp_)
         IF ( present( Hubbard_J ) )       Hubbard_J(1:3,1:nsp_) = Hubbard_J_(1:3,1:nsp_)
         IF ( present( Hubbard_J0 ) )      Hubbard_J0(1:nsp_)    = Hubbard_J0_(1:nsp_)
         IF ( present( Hubbard_alpha ) )   Hubbard_alpha(1:nsp_) = Hubbard_alpha_(1:nsp_)
         IF ( present( Hubbard_beta )  )   Hubbard_beta(1:nsp_)  = Hubbard_beta_(1:nsp_)
         !
         DEALLOCATE( Hubbard_l_ )
         DEALLOCATE( Hubbard_U_ )
         DEALLOCATE( Hubbard_J_ )
         DEALLOCATE( Hubbard_J0_ )
         DEALLOCATE( Hubbard_alpha_ )
         DEALLOCATE( Hubbard_beta_ )
         !
      ENDIF
      !
      IF (present(inlc) ) inlc = inlc_
      IF (present( vdw_table_name) )  vdw_table_name =  vdw_table_name_
      !
      IF ( present( acfdt_in_pw ) )    acfdt_in_pw    = acfdt_in_pw_
      IF (present(llondon) ) THEN
         llondon = llondon_
         IF (present(london_s6) )   london_s6   = london_s6_
         IF (present(london_rcut) ) london_rcut = london_rcut_
         IF ( llondon ) THEN
            !
            IF (present(london_c6) )   london_c6(1:nsp_)  =london_c6_(1:nsp_)
            IF (present(london_rvdw) ) london_rvdw(1:nsp_)=london_rvdw_(1:nsp_)
            DEALLOCATE( london_c6_ )
            DEALLOCATE( london_rvdw_ )
           !
        END IF
        !
      ELSE IF (present(lxdm) ) THEN
         lxdm = lxdm_
      ELSE IF (present(ts_vdw) ) THEN
         ts_vdw = ts_vdw_
         IF (present(vdw_isolated) ) vdw_isolated=vdw_isolated_
      END IF
      !
    END SUBROUTINE qexml_read_xc
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_read_occ( lgauss, ngauss, degauss, degauss_units, &
                               ltetra, tetra_type, ntetra, tetra, tfixed_occ, &
                               nstates_up, nstates_dw, input_occ, ierr )
      !------------------------------------------------------------------------
      !
      LOGICAL,      OPTIONAL, INTENT(out) :: lgauss, ltetra, tfixed_occ
      INTEGER,      OPTIONAL, INTENT(out) :: ngauss, ntetra, tetra_type
      INTEGER,      OPTIONAL, INTENT(out) :: tetra(:,:)
      INTEGER,      OPTIONAL, INTENT(out) :: nstates_up, nstates_dw
      REAL(DP),     OPTIONAL, INTENT(out) :: degauss, input_occ(:,:)
      CHARACTER(*), OPTIONAL, INTENT(out) :: degauss_units
      INTEGER,                INTENT(out) :: ierr
      !
      LOGICAL        :: lgauss_, ltetra_, tfixed_occ_
      INTEGER        :: ngauss_, ntetra_, nstates_up_, nstates_dw_, tetra_type_
      LOGICAL        :: lsda_
      REAL(DP)      :: degauss_
      CHARACTER(256) :: degauss_units_
      INTEGER,  ALLOCATABLE :: tetra_(:,:)
      INTEGER :: i
      LOGICAL :: lfound,found
      !
      ierr = 0
      !
      CALL iotk_scan_begin( iunit, "OCCUPATIONS", IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_dat( iunit, "SMEARING_METHOD", lgauss_, FOUND=found, IERR=ierr )
      IF (ierr/=0) RETURN
      IF ( .NOT. found ) lgauss_ = .FALSE.
      !
      !
      ngauss_=0
      degauss_=-1.0d0 
      degauss_units_="none"
      !
      IF ( lgauss_ ) THEN
         !
         CALL iotk_scan_dat( iunit, "SMEARING_TYPE", ngauss_, IERR=ierr )
         IF (ierr/=0) RETURN
         !
         CALL iotk_scan_dat( iunit, "SMEARING_PARAMETER", degauss_ , &
                                     ATTR=attr, IERR=ierr )
         IF (ierr/=0) RETURN
         !
         CALL iotk_scan_attr( ATTR, "UNITS", degauss_units_, IERR=ierr )
         IF (ierr/=0) RETURN
         !
      ENDIF
      !
      CALL iotk_scan_dat( iunit, "TETRAHEDRON_METHOD", ltetra_, FOUND=found, IERR=ierr )
      IF (ierr/=0) RETURN
      IF ( .NOT. found ) ltetra_ = .FALSE.
      !
      !
      ntetra_ = 0
      IF ( ltetra_ ) THEN
         !
         CALL iotk_scan_dat( iunit, "NUMBER_OF_TETRAHEDRA", ntetra_, IERR=ierr )
         IF (ierr/=0) RETURN
         !
         CALL iotk_scan_dat( iunit, "TETRAHEDRON_TYPE", tetra_type_, IERR=ierr )
         !
         IF(tetra_type_ == 0) then
            !
            ALLOCATE( tetra_(4, ntetra_) )
            !
            DO i = 1, ntetra_
               !
               CALL iotk_scan_dat( iunit, "TETRAHEDRON"//iotk_index(i), &
                                               tetra_(1:4,i), IERR=ierr )
               IF (ierr/=0) RETURN
               !
            ENDDO
            !
         END IF
         !
      ENDIF
      !
      CALL iotk_scan_dat( iunit, "FIXED_OCCUPATIONS", tfixed_occ_, FOUND=found, IERR=ierr )
      IF (ierr/=0) RETURN
      IF ( .NOT. found ) tfixed_occ_ = .FALSE.
      !
      nstates_up_=0.0d0
      nstates_dw_=0.0d0
      !
      IF ( tfixed_occ_  .and. ( present(input_occ)   .or. &
                                present(nstates_up)  .or. present(nstates_dw) ) ) THEN
         !
         CALL iotk_scan_empty( iunit, "INFO", ATTR=attr, IERR=ierr)
         IF (ierr /=0 ) RETURN
         !
         CALL iotk_scan_attr( attr, "lsda", lsda_, IERR=ierr )
         IF (ierr /=0 ) RETURN
         !
         IF ( qexml_version_before_1_4_0 ) THEN
            !
            CALL iotk_scan_attr( attr, "nelup", nstates_up_, IERR=ierr )
            IF (ierr /=0 ) RETURN
            CALL iotk_scan_attr( attr, "neldw", nstates_dw_, IERR=ierr )
            IF (ierr /=0 ) RETURN
            !
         ELSE
            !
            ! current version
            !
            CALL iotk_scan_attr( attr, "nstates_up", nstates_up_, IERR=ierr )
            IF (ierr /=0 ) RETURN
            CALL iotk_scan_attr( attr, "nstates_down", nstates_dw_, IERR=ierr )
            IF (ierr /=0 ) RETURN
            !
         ENDIF
         !
         IF ( present( input_occ ) ) THEN
            !
            !
            CALL iotk_scan_dat( iunit, "INPUT_OCC_UP", input_occ(1:nstates_up_,1), IERR=ierr )
            IF (ierr/=0) RETURN
            !
            IF ( lsda_  ) THEN
               !
               CALL iotk_scan_dat( iunit, "INPUT_OCC_DOWN", input_occ(1:nstates_dw_,2), IERR=ierr )
               IF (ierr/=0) RETURN
               !
            ENDIF
            !
         ENDIF
         !
      ENDIF
      !
      CALL iotk_scan_end( iunit, "OCCUPATIONS", IERR=ierr )
      IF (ierr/=0) RETURN
      !
      !
      IF ( present( lgauss ))           lgauss      = lgauss_
      IF ( present( ltetra ))           ltetra      = ltetra_
      IF ( present( tfixed_occ ))       tfixed_occ  = tfixed_occ_
      IF ( present( ngauss ))           ngauss      = ngauss_
      IF ( present( ntetra ))           ntetra      = ntetra_
      IF ( present( tetra_type ) .and. ltetra_)       tetra_type  = tetra_type_
      IF ( present( degauss ))          degauss     = degauss_
      IF ( present( degauss_units ))    degauss_units  = trim(degauss_units_)
      IF ( present( nstates_up ))       nstates_up  = nstates_up_
      IF ( present( nstates_dw ))       nstates_dw  = nstates_dw_
      !
      IF ( ltetra_ .and. (tetra_type_ == 0)) THEN
         !
         IF ( present( tetra ) )         tetra(1:4, 1:ntetra_)  = tetra_
         !
         DEALLOCATE( tetra_ )
         !
      ENDIF

    END SUBROUTINE qexml_read_occ
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_read_bz( num_k_points, xk, wk, k1, k2, k3, nk1, nk2, nk3, &
                              nks_start, xk_start, wk_start, qnorm, &
                              k_units, ierr )
      !------------------------------------------------------------------------
      !
      INTEGER,       OPTIONAL, INTENT(out) :: num_k_points, k1, k2, k3, nk1, nk2, nk3, &
                                              nks_start
      REAL(DP),     OPTIONAL, INTENT(out) :: xk(:,:), wk(:), qnorm
      REAL(DP),     OPTIONAL, ALLOCATABLE, INTENT(out) :: xk_start(:,:), wk_start(:)
      CHARACTER(*),  OPTIONAL, INTENT(out) :: k_units
      INTEGER,                 INTENT(out) :: ierr
      !
      INTEGER                :: num_k_points_, k1_, k2_, k3_, nk1_, nk2_, nk3_,nks_start_
      CHARACTER(256)         :: k_units_
      REAL(DP)               :: qnorm_
      REAL(DP), ALLOCATABLE  :: xk_(:,:), wk_(:)
      REAL(DP), ALLOCATABLE  :: xk_start_(:,:), wk_start_(:)
      !
      INTEGER :: ik, i
      LOGICAL :: found
      !
      ierr = 0
      !
      CALL iotk_scan_begin( iunit, "BRILLOUIN_ZONE", IERR=ierr )
      IF ( ierr/=0 ) RETURN
      !
      CALL iotk_scan_dat( iunit, "NUMBER_OF_K-POINTS", num_k_points_, IERR=ierr )
      IF ( ierr/=0 ) RETURN
      !
      !
      CALL iotk_scan_empty( iunit, "UNITS_FOR_K-POINTS", ATTR=attr, IERR=ierr )
      IF ( ierr/=0 ) RETURN
      CALL iotk_scan_attr( attr, "UNITS", k_units_, IERR=ierr )
      IF ( ierr/=0 ) RETURN
      !
      CALL iotk_scan_empty( iunit, "MONKHORST_PACK_GRID", ATTR=attr, IERR=ierr )
      IF ( ierr/=0 ) RETURN
      !
      CALL iotk_scan_attr( attr, "nk1", nk1_, IERR=ierr  )
      IF ( ierr/=0 ) RETURN
      CALL iotk_scan_attr( attr, "nk2", nk2_, IERR=ierr )
      IF ( ierr/=0 ) RETURN
      CALL iotk_scan_attr( attr, "nk3", nk3_, IERR=ierr )
      IF ( ierr/=0 ) RETURN
      !
      !
      CALL iotk_scan_empty( iunit, "MONKHORST_PACK_OFFSET", ATTR=attr, IERR=ierr )
      IF ( ierr/=0 ) RETURN
      !
      CALL iotk_scan_attr( attr, "k1", k1_, IERR=ierr )
      IF ( ierr/=0 ) RETURN
      CALL iotk_scan_attr( attr, "k2", k2_, IERR=ierr )
      IF ( ierr/=0 ) RETURN
      CALL iotk_scan_attr( attr, "k3", k3_, IERR=ierr )
      IF ( ierr/=0 ) RETURN
      !
      !
      ALLOCATE( xk_( 3, num_k_points_ ) )
      ALLOCATE( wk_(    num_k_points_ ) )
      !
      DO ik = 1, num_k_points_
         !
         CALL iotk_scan_empty( iunit, "K-POINT" // trim( iotk_index(ik) ), &
                               ATTR=attr, IERR=ierr )
         IF ( ierr/=0 ) RETURN
         !
         CALL iotk_scan_attr( attr, "XYZ", xk_(:,ik), IERR=ierr )
         IF ( ierr/=0 ) RETURN
         !
         CALL iotk_scan_attr( attr, "WEIGHT", wk_(ik), IERR=ierr )
         IF ( ierr/=0 ) RETURN
         !
      ENDDO
      !
      nks_start_=0
      !
      IF ( present(nks_start) .or. present(xk_start) .or. present(wk_start) ) THEN
         !
         CALL iotk_scan_dat( iunit, "STARTING_K-POINTS", nks_start_, &
              FOUND = found )
         IF (.NOT. found) nks_start_=0
         !
         IF (nks_start_ > 0 ) THEN
            !
            ALLOCATE( xk_start_(3,nks_start_) )
            ALLOCATE( wk_start_(nks_start_) )
            !
         END IF
         !
         DO ik = 1, nks_start_
            !
            CALL iotk_scan_empty( iunit, "K-POINT_START" // &
                 & TRIM( iotk_index( ik ) ), ATTR=attr )
            !
            CALL iotk_scan_attr( attr, "XYZ", xk_start_(:,ik) )
            !
            CALL iotk_scan_attr( attr, "WEIGHT", wk_start_(ik) )
            !
         END DO
         !
      END IF
      !   
      CALL iotk_scan_dat( iunit, "NORM-OF-Q", qnorm_, FOUND = found )
      IF (.not. found) qnorm_=0.0_DP
      !
      !
      CALL iotk_scan_end( iunit, "BRILLOUIN_ZONE", IERR=ierr )
      IF ( ierr/=0 ) RETURN
      !
      !
      IF ( present( num_k_points ) )       num_k_points  = num_k_points_
      IF ( present( nk1 ) )                nk1           = nk1_
      IF ( present( nk2 ) )                nk2           = nk2_
      IF ( present( nk3 ) )                nk3           = nk3_
      IF ( present( k1 ) )                 k1            =  k1_
      IF ( present( k2 ) )                 k2            =  k2_
      IF ( present( k3 ) )                 k3            =  k3_
      IF ( present( k_units ) )            k_units       =  trim(k_units_)
      IF ( present( xk ) )                 xk(1:3,1:num_k_points_) = xk_(:,:)
      IF ( present( wk ) )                 wk(1:num_k_points_)     = wk_(:)
      IF ( present( nks_start ) )          nks_start     =  nks_start_
      !
      IF ( nks_start_>0 .AND. present( xk_start ) ) THEN
         IF (.NOT.ALLOCATED(xk_start)) ALLOCATE(xk_start(3,nks_start_))
         xk_start(1:3,1:nks_start_) =  xk_start_(:,:)
      ENDIF
      IF ( nks_start_>0 .AND. present( wk_start ) ) THEN
         IF (.NOT.ALLOCATED(wk_start)) ALLOCATE(wk_start(nks_start_))
         wk_start(1:nks_start_) =  wk_start_(:)
      ENDIF
      !
      IF ( present( qnorm ) )              qnorm         = qnorm_
      !
      DEALLOCATE( xk_ )
      DEALLOCATE( wk_ )
      IF (ALLOCATED(xk_start_)) DEALLOCATE(xk_start_)
      IF (ALLOCATED(wk_start_)) DEALLOCATE(wk_start_)
      !
    END SUBROUTINE qexml_read_bz
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_read_para( kunit, nproc, nproc_pool, nproc_image, &
                    ntask_groups, nproc_bgrp, nproc_ortho, found, ierr )
      !------------------------------------------------------------------------
      !
      INTEGER, OPTIONAL, INTENT(OUT) :: kunit, nproc, nproc_pool, nproc_image, &
           ntask_groups, nproc_bgrp, nproc_ortho
      LOGICAL, INTENT(OUT) :: found
      INTEGER, INTENT(OUT) :: ierr
      !
      INTEGER :: kunit_, nproc_, nproc_pool_, nproc_image_, ntask_groups_, &
                 nproc_bgrp_, nproc_ortho_
      !
      LOGICAL :: found2
      !
      !
      CALL iotk_scan_begin( iunit, "PARALLELISM", FOUND=found,IERR=ierr )
      IF ((.NOT. found ) .OR. (ierr /= 0 ) ) RETURN
      !
      CALL iotk_scan_dat( iunit, &
                              "GRANULARITY_OF_K-POINTS_DISTRIBUTION", kunit_ )
      !
      CALL iotk_scan_dat( iunit, "NUMBER_OF_PROCESSORS", nproc_, FOUND=found2 )
      IF ( .NOT. found2) nproc_=1  !compatibility
      !
      CALL iotk_scan_dat( iunit, &
                              "NUMBER_OF_PROCESSORS_PER_POOL", nproc_pool_, FOUND=found2 )
      IF ( .NOT. found2) nproc_pool_=1 ! compatibility
      !
      CALL iotk_scan_dat( iunit, &
                              "NUMBER_OF_PROCESSORS_PER_IMAGE", nproc_image_, FOUND=found2 )
      IF ( .NOT. found2) nproc_image_=1 ! compatibility
      !
      CALL iotk_scan_dat( iunit, "NUMBER_OF_PROCESSORS_PER_TASKGROUP", &
                                              ntask_groups_, FOUND=found2 )
      IF ( .NOT. found2) ntask_groups_=1 ! compatibility
      !
      CALL iotk_scan_dat( iunit, "NUMBER_OF_PROCESSORS_PER_BAND_GROUP", &
                                              nproc_bgrp_, FOUND=found2 )
      IF ( .NOT. found2) nproc_bgrp_=1 ! compatibility
      !
      CALL iotk_scan_dat( iunit, "NUMBER_OF_PROCESSORS_PER_DIAGONALIZATION", &
                                              nproc_ortho_, FOUND=found2 )
      IF ( .NOT. found2) nproc_ortho_=1 ! compatibility
      !
      CALL iotk_scan_end( iunit, "PARALLELISM" )
      !
      !
      IF (present(kunit)) kunit = kunit_
      IF (present(nproc)) nproc = nproc_
      IF (present(nproc_pool)) nproc_pool = nproc_pool_
      IF (present(nproc_image)) nproc_image = nproc_image_
      IF (present(ntask_groups)) ntask_groups = ntask_groups_
      IF (present(nproc_bgrp)) nproc_bgrp = nproc_bgrp_
      IF (present(nproc_ortho)) nproc_ortho = nproc_ortho_
      !
    END SUBROUTINE qexml_read_para
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_read_phonon( modenum, xqq, q_units, ierr )
      !------------------------------------------------------------------------
      !
      INTEGER,       OPTIONAL, INTENT(out) :: modenum
      REAL(DP),     OPTIONAL, INTENT(out) :: xqq(:)
      CHARACTER(*),  OPTIONAL, INTENT(out) :: q_units
      INTEGER,                 INTENT(out) :: ierr
      !
      INTEGER         :: modenum_
      CHARACTER(256)  :: q_units_
      !

      ierr = 0
      !
      CALL iotk_scan_begin( iunit, "PHONON", IERR=ierr )
      IF ( ierr/=0 ) RETURN
      !
      CALL iotk_scan_dat( iunit, "NUMBER_OF_MODES", modenum_, IERR=ierr )
      IF ( ierr/=0 ) RETURN
      !
      CALL iotk_scan_empty( iunit, "UNITS_FOR_Q-POINT", attr, IERR=ierr )
      IF ( ierr/=0 ) RETURN
      CALL iotk_scan_attr( attr, "UNITS", q_units_, IERR=ierr )
      IF ( ierr/=0 ) RETURN
      !
      IF ( present (xqq) ) THEN
         !
         CALL iotk_scan_dat( iunit, "Q-POINT", xqq(:), IERR=ierr )
         IF ( ierr/=0 ) RETURN
         !
      ENDIF
      !
      CALL iotk_scan_end( iunit, "PHONON", IERR=ierr )
      IF ( ierr/=0 ) RETURN
      !
      !
      IF ( present (modenum) )      modenum = modenum_
      IF ( present (q_units) )      q_units = trim(q_units_)
      !
    END SUBROUTINE qexml_read_phonon
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_read_bands_info( num_k_points, natomwfc, &
                                      nbnd, nbnd_up, nbnd_down, &
                                      nspin, nelec, nel_up, nel_down, &
                                      ef, two_fermi_energies, &
                                      ef_up, ef_dw ,energy_units, k_units, &
                                      noncolin, ierr )
      !------------------------------------------------------------------------
      !
      INTEGER,      OPTIONAL, INTENT(out) :: nbnd, nbnd_up, nbnd_down, num_k_points, nspin, natomwfc, nel_up,nel_down
      LOGICAL,      OPTIONAL, INTENT(out) :: noncolin, two_fermi_energies
      REAL(DP),     OPTIONAL, INTENT(out) :: ef, nelec, ef_up, ef_dw
      CHARACTER(*), OPTIONAL, INTENT(out) :: energy_units, k_units
      INTEGER,                INTENT(out) :: ierr
      !
      INTEGER        :: nbnd_, nbnd_up_, nbnd_down_, num_k_points_, nspin_, natomwfc_, nel_up_, nel_down_
      LOGICAL        :: noncolin_, two_fermi_energies_
      REAL(DP)       :: ef_, nelec_, ef_up_, ef_dw_
      CHARACTER(256) :: energy_units_, k_units_
      !
      LOGICAL :: found
      !
      ierr = 0
      !
      !
      CALL iotk_scan_begin( iunit, "BAND_STRUCTURE_INFO", IERR=ierr )
      IF (ierr/=0) RETURN
      !
      !
      CALL iotk_scan_dat  ( iunit, "NUMBER_OF_K-POINTS", num_k_points_, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_dat  ( iunit, "NUMBER_OF_SPIN_COMPONENTS", nspin_, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_dat  ( iunit, "NON-COLINEAR_CALCULATION", noncolin_, FOUND=found, IERR=ierr )
      IF (ierr/=0) RETURN
      IF (.NOT. found) noncolin_ = .FALSE.
      !
      CALL iotk_scan_dat  ( iunit, "NUMBER_OF_ATOMIC_WFC", natomwfc_, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      nbnd_up_   = 0
      nbnd_down_ = 0
      nel_up_    = 0.0d0
      nel_down_  = 0.0d0
      !
      IF ( nspin_ == 2 ) THEN
         !
         CALL iotk_scan_dat( iunit, &
                              "NUMBER_OF_BANDS", nbnd_, ATTR = attr, IERR = ierr )
         IF (ierr/=0) RETURN
         !
         CALL iotk_scan_attr( attr, "UP", nbnd_up_, IERR = ierr )
         IF (ierr/=0) RETURN
         !
         CALL iotk_scan_attr( attr, "DW", nbnd_down_, IERR = ierr )
         IF (ierr/=0) RETURN
         !
         CALL iotk_scan_dat( iunit, &
                              "NUMBER_OF_ELECTRONS", nelec_, ATTR = attr, IERR = ierr )
         IF (ierr/=0) RETURN
         !
         CALL iotk_scan_attr( attr, "UP", nel_up_, IERR = ierr )
         IF (ierr/=0) RETURN
         !
         CALL iotk_scan_attr( attr, "DW", nel_down_, IERR = ierr )
         IF (ierr/=0) RETURN
         !
      ELSE
         !
         CALL iotk_scan_dat( iunit, "NUMBER_OF_BANDS", nbnd_, IERR = ierr )
         IF (ierr/=0) RETURN
         !
         CALL iotk_scan_dat( iunit, "NUMBER_OF_ELECTRONS", nelec_, IERR = ierr )
         IF (ierr/=0) RETURN
         !
      END IF
      !
      CALL iotk_scan_empty( iunit, "UNITS_FOR_K-POINTS", ATTR = attr, IERR=ierr )
      IF (ierr/=0) RETURN
      CALL iotk_scan_attr ( attr,   "UNITS", k_units_, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_empty( iunit, "UNITS_FOR_ENERGIES", ATTR = attr, IERR=ierr )
      IF (ierr/=0) RETURN
      CALL iotk_scan_attr ( attr,   "UNITS", energy_units_, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_dat( iunit, "TWO_FERMI_ENERGIES", two_fermi_energies_, FOUND = found)
      IF ( .not. found ) two_fermi_energies_=.FALSE.
      !
      ef_up_  =0.0d0
      ef_dw_  =0.0d0
      ef_     =0.0d0
      !
      IF ( two_fermi_energies_ ) THEN
         !
         CALL iotk_scan_dat( iunit, "FERMI_ENERGY_UP", ef_up_, IERR=ierr )
         IF (ierr/=0) RETURN
         CALL iotk_scan_dat( iunit, "FERMI_ENERGY_DOWN", ef_dw_, IERR=ierr )
         IF (ierr/=0) RETURN
         CALL iotk_scan_dat( iunit, "ELECTRONS_UP", nel_up_, IERR=ierr )
         IF (ierr/=0) RETURN
         CALL iotk_scan_dat( iunit, "ELECTRONS_DOWN", nel_down_, IERR=ierr )
         IF (ierr/=0) RETURN
         !
      ELSE
         !
         CALL iotk_scan_dat  ( iunit, "FERMI_ENERGY", ef_ , FOUND=found )
         IF (ierr/=0) RETURN
         !
         !
      END IF
      !
      CALL iotk_scan_end( iunit, "BAND_STRUCTURE_INFO", IERR=ierr )
      IF (ierr/=0) RETURN
      !
      !
      IF ( present( nbnd ) )             nbnd           = nbnd_
      IF ( present( nbnd_up ) )          nbnd_up        = nbnd_up_
      IF ( present( nbnd_down ) )        nbnd_down      = nbnd_down_
      IF ( present( num_k_points ) )     num_k_points   = num_k_points_
      IF ( present( nspin ) )            nspin          = nspin_
      IF ( present( noncolin ) )         noncolin       = noncolin_
      IF ( present( natomwfc ) )         natomwfc       = natomwfc_
      IF ( present( nelec ) )            nelec          = nelec_
      IF ( present( nel_up ) )           nel_up         = nel_up_
      IF ( present( nel_down ) )         nel_down       = nel_down_
      IF ( present( ef ) )               ef             = ef_
      IF ( present( two_fermi_energies ) ) two_fermi_energies = two_fermi_energies_
      IF ( present( ef_up ) )            ef_up          = ef_up_
      IF ( present( ef_dw ) )            ef_dw          = ef_dw_
      IF ( present( energy_units ) )     energy_units   = trim( energy_units_ )
      IF ( present( k_units ) )          k_units        = trim( k_units_ )
      !
      !
    END SUBROUTINE qexml_read_bands_info
    !
    !
    !--------------------------------------------------------------------------
    SUBROUTINE qexml_read_bands_pw( num_k_points, nbnd, nkstot, lsda, lkpoint_dir, &
                                    filename, isk, et, wg , ierr )
      !------------------------------------------------------------------------ 
      !
      INTEGER,   INTENT(in) :: num_k_points, nbnd, nkstot
      LOGICAL,   INTENT(in) :: lsda, lkpoint_dir
      CHARACTER(LEN=*), INTENT(in) :: filename
      INTEGER,   INTENT(out), OPTIONAL :: isk(:)
      REAL(DP),  INTENT(out), OPTIONAL :: et(:,:), wg(:,:)
      INTEGER,   INTENT(out):: ierr
      !
      INTEGER  :: ik, ik_eff, iunaux
      INTEGER  :: isk_(nkstot)
      REAL(DP) :: et_(nbnd, nkstot),wg_(nbnd, nkstot)
      LOGICAL  :: found
      !
      !
      IF ( .NOT. lkpoint_dir) THEN
         !
         CALL iotk_free_unit( iunaux )
         !
         CALL iotk_open_read ( iunaux, FILE = trim(filename), IERR=ierr )
         IF (ierr/=0)  RETURN
         !
      END IF
      !
      !
      CALL iotk_scan_begin( iunit, "EIGENVALUES", IERR=ierr )
      IF (ierr/=0) RETURN
      !
      k_points_loop: DO ik = 1, num_k_points
         !
         CALL iotk_scan_begin( iunit, "K-POINT" // TRIM( iotk_index( ik ) ) )
         !
         IF ( lsda ) THEN
            !
            isk_(ik) = 1
            !
            IF (lkpoint_dir) THEN
               CALL iotk_scan_begin(iunit, "DATAFILE"//TRIM(iotk_index(1)) , FOUND = found)
               IF (.NOT. found ) GO TO 10 ! workaround: PW-CP compatibility
               CALL iotk_scan_dat  ( iunit, "EIGENVALUES", et_(:,ik)  )
               CALL iotk_scan_dat  ( iunit, "OCCUPATIONS", wg_(:,ik) )
               CALL iotk_scan_end  ( iunit, "DATAFILE"//TRIM(iotk_index(1)) )
            ELSE
               CALL iotk_scan_begin( iunaux, &
                    "DATA_EIG"//TRIM( iotk_index(ik) )//"_SPIN_UP", FOUND=found )
               IF (.NOT. found ) GO TO 10 ! workaround: PW-CP compatibility
               CALL iotk_scan_dat  ( iunaux, "EIGENVALUES", et_(:,ik)  )
               CALL iotk_scan_dat  ( iunaux, "OCCUPATIONS", wg_(:,ik) )
               CALL iotk_scan_end( iunaux, &
                    "DATA_EIG"//TRIM( iotk_index( ik ) )//"_SPIN_UP")
            ENDIF
            !
10          CONTINUE
            !
            ik_eff = ik + num_k_points
            isk_(ik_eff) = 2
            !
            IF (lkpoint_dir) THEN
               CALL iotk_scan_begin(iunit,"DATAFILE"//TRIM(iotk_index(2)) &
                    , FOUND = found)
               IF (.NOT. found ) GO TO 20 ! workaround: PW-CP compatibility
               CALL iotk_scan_dat  ( iunit, "EIGENVALUES", et_(:,ik_eff) )
               CALL iotk_scan_dat  ( iunit, "OCCUPATIONS", wg_(:,ik_eff) )
               CALL iotk_scan_end( iunit, "DATAFILE"//TRIM(iotk_index(2)) )
            ELSE
               CALL iotk_scan_begin( iunaux, &
               "DATA_EIG"//TRIM( iotk_index(ik) )//"_SPIN_DW", FOUND=found )
               IF (.NOT. found ) GO TO 20 ! workaround: PW-CP compatibility
               CALL iotk_scan_dat  ( iunaux, "EIGENVALUES", et_(:,ik_eff) )
               CALL iotk_scan_dat  ( iunaux, "OCCUPATIONS", wg_(:,ik_eff) )
               CALL iotk_scan_end( iunaux, &
                    "DATA_EIG"//TRIM( iotk_index( ik ) )//"_SPIN_DW")
            ENDIF
            !
20          CONTINUE
            !
         ELSE
            !
            isk_(ik) = 1
            !
            IF (lkpoint_dir) THEN
               CALL iotk_scan_begin( iunit, "DATAFILE" , FOUND = found)
               IF (.NOT. found ) GO TO 15 ! workaround: PW-CP compatibility
               CALL iotk_scan_dat  ( iunit, "EIGENVALUES", et_(:,ik) )
               CALL iotk_scan_dat  ( iunit, "OCCUPATIONS", wg_(:,ik) )
               CALL iotk_scan_end  ( iunit, "DATAFILE" )
            ELSE
               CALL iotk_scan_begin( iunaux, &
                    "DATA_EIG"//TRIM( iotk_index(ik) ), FOUND = found )
               IF (.NOT. found ) GO TO 15 ! workaround: PW-CP compatibility
               CALL iotk_scan_dat  ( iunaux, "EIGENVALUES", et_(:,ik) )
               CALL iotk_scan_dat  ( iunaux, "OCCUPATIONS", wg_(:,ik) )
               CALL iotk_scan_end( iunaux, &
                    "DATA_EIG"//TRIM( iotk_index( ik ) ))
            ENDIF
15          CONTINUE
            !
         END IF
         !
         CALL iotk_scan_end( iunit, "K-POINT" // TRIM( iotk_index( ik ) ) )
         !
      END DO k_points_loop
      !
      CALL iotk_scan_end( iunit, "EIGENVALUES", IERR=ierr )
      IF (ierr/=0) RETURN
      !
      IF (.NOT.lkpoint_dir) THEN
         CALL iotk_close_read ( iunaux, IERR=ierr )
         IF (ierr/=0)  RETURN
      END IF
      !
      IF ( present( isk ) )              isk( 1:nkstot )         = isk_(:)
      IF ( present( et ) )                et( 1:nbnd, 1:nkstot ) = et_(:,:)
      IF ( present( wg ) )                wg( 1:nbnd, 1:nkstot ) = wg_(:,:)
      !
    END SUBROUTINE qexml_read_bands_pw
    !
    !
    !-----------------------------------------------------------------------------
    SUBROUTINE qexml_read_bands_cp( num_k_points, nbnd_tot, nudx , nspin, iupdwn, &
      nupdwn, occ0, occm, ierr )
    !-----------------------------------------------------------------------------
      !
      INTEGER,  INTENT(OUT) :: ierr
      REAL(DP), INTENT(OUT) :: occ0(:)
      REAL(DP), INTENT(OUT) :: occm(:)
      !
      INTEGER, INTENT(in)  :: num_k_points, nspin, nbnd_tot, nudx
      INTEGER,               INTENT(IN) :: iupdwn(:)
      INTEGER,               INTENT(IN) :: nupdwn(:)
      !
      INTEGER :: ik, iss, ik_eff
      CHARACTER(LEN=4)      :: cspin
      REAL(DP), ALLOCATABLE :: occ_(:)
      REAL(DP)              :: wk_
      LOGICAL :: found
      !
#if !defined __HDF5
      CALL iotk_scan_begin( iunit, "EIGENVALUES", IERR=ierr )
#endif
      IF (ierr /= 0) RETURN
      !
      !
      k_points_loop1: DO ik = 1, num_k_points
         !
#if !defined __HDF5
         CALL iotk_scan_begin( iunit, "K-POINT" // TRIM( iotk_index(ik) ) )
#endif
         !
         CALL iotk_scan_dat( iunit, "WEIGHT", wk_ )
         !
         !
         DO iss = 1, nspin
            !
            cspin = iotk_index( iss )
            !
            ik_eff = ik + ( iss - 1 ) * num_k_points
            !
            ALLOCATE( occ_ ( MAX( nudx , nbnd_tot ) ) )
            !
            occ_ = 0.0d0
            !
            CALL iotk_scan_dat( iunit, "OCC0" // TRIM( cspin ), occ_ ( 1 :  nupdwn( iss ) ), FOUND = found )
            !
            IF( .NOT. found ) THEN
               !
               IF( nspin == 1 ) THEN
                  CALL iotk_scan_begin( iunit, "DATAFILE", FOUND = found )
               ELSE
                  CALL iotk_scan_begin( iunit, "DATAFILE"//TRIM(cspin), FOUND = found )
               END IF
               !
               CALL iotk_scan_dat  ( iunit, "OCCUPATIONS", occ_( 1:nbnd_tot ) )
               IF( nspin == 1 ) THEN
                  CALL iotk_scan_end( iunit, "DATAFILE" )
               ELSE
                  CALL iotk_scan_end( iunit, "DATAFILE"//TRIM(cspin) )
               END IF
               !
               IF( found ) THEN
                  occ0( iupdwn( iss ) : iupdwn( iss ) + nupdwn( iss ) - 1 ) = occ_ ( 1:nupdwn( iss ) ) * wk_
                  occm( iupdwn( iss ) : iupdwn( iss ) + nupdwn( iss ) - 1 ) = occ_ ( 1:nupdwn( iss ) ) * wk_
               END IF
               !
            ELSE
               !
               occ0( iupdwn( iss ) : iupdwn( iss ) + nupdwn( iss ) - 1 ) = occ_ ( 1:nupdwn( iss ) )
               !
               CALL iotk_scan_dat( iunit, "OCCM" // TRIM( cspin ), occ_ ( 1 :  nupdwn( iss ) ), FOUND = found )
               !
               IF( found ) THEN
                  occm( iupdwn( iss ) : iupdwn( iss ) + nupdwn( iss ) - 1 ) = occ_ ( 1:nupdwn( iss ) )
               END IF
               !
            END IF
            !
            DEALLOCATE ( occ_ )
            !
            IF( .NOT. found ) THEN
               ierr = 1
               RETURN
            END IF
            !
         END DO
         !
#if !defined __HDF5
         CALL iotk_scan_end( iunit, "K-POINT" // TRIM( iotk_index(ik) ), IERR = ierr )
#endif
         IF (ierr /= 0) RETURN
         !
      END DO k_points_loop1
      !
#if !defined __HDF5
      CALL iotk_scan_end  ( iunit, "EIGENVALUES", IERR = ierr )
#endif
      IF (ierr /= 0) RETURN
      !
      !
    END SUBROUTINE qexml_read_bands_cp
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_read_wfc( ibnds, ibnde, ik, ispin, ipol, igk, ngw, igwx, &
                               gamma_only, wf, wf_kindip, ierr )
      !------------------------------------------------------------------------
      !
      ! read wfc from IBNDS to IBNDE, for kpt IK and spin ISPIN
      ! WF is the wfc on its proper k+g grid, while WF_KINDIP is the same wfc
      ! but on a truncated rho grid (k-point indipendent)
      !
      INTEGER,                 INTENT(in)  :: ibnds, ibnde, ik
      INTEGER,       OPTIONAL, INTENT(in)  :: ispin, ipol
      INTEGER,       OPTIONAL, INTENT(in)  :: igk(:)
      INTEGER,       OPTIONAL, INTENT(out) :: ngw, igwx
      LOGICAL,       OPTIONAL, INTENT(out) :: gamma_only
      COMPLEX(DP),  OPTIONAL, INTENT(out) :: wf(:,:), wf_kindip(:,:)
      INTEGER,                 INTENT(out) :: ierr
      !
      INTEGER :: iunaux
      INTEGER :: ngw_, igwx_, ig, ib, lindex
      LOGICAL :: gamma_only_
      COMPLEX(DP),  ALLOCATABLE :: wf_(:)
      CHARACTER(256)             :: filename

      ierr = 0
      !
      !
      ! few check
      !
      IF ( present( ispin ) .and. present( ipol )  ) THEN
         !
         ierr = 1
         RETURN
         !
      ENDIF
      !
      !
      ! read the main data
      !
      CALL iotk_free_unit( iunaux )
      !
      IF ( present( ispin ) ) THEN
         !
         filename = trim( qexml_wfc_filename( datadir_in, 'evc', ik, ispin ) )
         !
      ELSEIF ( present( ipol )  ) THEN
         !
         filename = trim( qexml_wfc_filename( datadir_in, 'evc', ik, ipol ) )
         !
      ELSE
         !
         filename = trim( qexml_wfc_filename( datadir_in, 'evc', ik ) )
         !
      ENDIF
      !
      CALL iotk_open_read ( iunaux, FILE = trim(filename), IERR=ierr )
      IF (ierr/=0)  RETURN
      !
      !
      CALL iotk_scan_empty( iunaux, "INFO", ATTR=attr, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_attr( attr, "ngw",  ngw_, IERR=ierr )
      IF (ierr/=0) RETURN
      CALL iotk_scan_attr( attr, "igwx", igwx_, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      !
      IF ( qexml_version_before_1_4_0 ) THEN
         !
         IF ( present( gamma_only ) ) THEN
             !
             CALL qexml_read_planewaves( GAMMA_ONLY=gamma_only_, IERR=ierr)
             IF (ierr/=0)  RETURN
             !
         ENDIF
         !
      ELSE
         !
         CALL iotk_scan_attr( attr, 'gamma_only', gamma_only_, IERR=ierr)
         IF (ierr/=0)  RETURN
         !
      ENDIF
      !
      !
      IF ( present( wf )  )  THEN
          !
          lindex = 0
          !
          DO ib = ibnds, ibnde
              !
              lindex = lindex + 1
              !
              CALL iotk_scan_dat( iunaux, "evc"//trim(iotk_index(ib)), &
                                  wf( 1:igwx_, lindex ), IERR=ierr )
              IF (ierr/=0) RETURN
              !
          ENDDO
          !
      ENDIF
      !
      IF ( present( wf_kindip )  )  THEN
          !
          ALLOCATE( wf_(igwx_ ), STAT=ierr )
          IF (ierr/=0) RETURN
          !
          IF ( .not. present( igk ) ) THEN
              ierr = 3
              RETURN
          ENDIF
          !
          IF ( maxval( igk( 1: igwx_ ) ) > size( wf_kindip, 1)  ) THEN
              ierr = 4
              RETURN
          ENDIF
          !
          !
          lindex = 0
          !
          DO ib = ibnds, ibnde
              !
              lindex = lindex + 1
              !
              CALL iotk_scan_dat( iunaux, "evc"//trim(iotk_index( ib ) ), &
                                           wf_(1:igwx_), IERR=ierr )
              IF (ierr/=0) RETURN
              !
              ! use the igk map to do the transformation
              !
              wf_kindip(:, lindex) = 0.0_DP
              !
              DO ig = 1, igwx_
                  !
                  wf_kindip( igk( ig ), lindex ) = wf_( ig )
                  !
              ENDDO
              !
          ENDDO
          !
          DEALLOCATE( wf_, STAT=ierr )
          IF (ierr/=0) RETURN
          !
      ENDIF
      !
      CALL iotk_close_read ( iunaux, IERR=ierr )
      IF (ierr/=0)  RETURN
      !
      !
      IF ( present( ngw ) )                 ngw   = ngw_
      IF ( present( igwx ) )               igwx   = igwx_
      IF ( present( gamma_only ) )   gamma_only   = gamma_only_
      !
    END SUBROUTINE qexml_read_wfc
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE qexml_read_rho( nr1, nr2, nr3, rho, ip, rhoz, ierr  )
      !------------------------------------------------------------------------
      !
      ! Reads charge density rho, as a whole or one plane at a time.
      ! if RHO is specified, the whole charge density is read;
      ! if RHOZ is specified only the IP-th plane is read
      !
      IMPLICIT NONE
      !
      INTEGER,   OPTIONAL, INTENT(out) :: nr1, nr2, nr3
      INTEGER,   OPTIONAL, INTENT(in)  :: ip
      REAL(DP), OPTIONAL, INTENT(out) :: rho(:,:,:), rhoz(:)
      INTEGER,             INTENT(out) :: ierr
      !
      INTEGER        :: nr1_, nr2_, nr3_, ip_
      INTEGER        :: iunaux
      LOGICAL        :: lexists
      CHARACTER(256) :: filename

      ierr = 0
      !
      !
      CALL iotk_free_unit( iunaux )
      !
      filename = trim( datadir_in ) // '/' // 'charge-density.dat'
      lexists  = check_file_exst( trim(filename) )
      !
      IF ( .not. lexists ) THEN
          !
          filename = trim( datadir_in ) // '/' // 'charge-density.xml'
          lexists  = check_file_exst( trim(filename) )
          !
      ENDIF
      !
      IF ( .not. lexists ) THEN
          !
          ierr = -1
          RETURN
          !
      ENDIF
      !
      CALL iotk_open_read( iunaux, FILE = filename, IERR=ierr )
      IF ( ierr/=0 ) RETURN
      !
      !
      CALL iotk_scan_begin( iunaux, "CHARGE-DENSITY", IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_empty( iunaux, "INFO", ATTR=attr, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_scan_attr( attr, "nr1", nr1_, IERR=ierr )
      IF (ierr/=0) RETURN
      CALL iotk_scan_attr( attr, "nr2", nr2_, IERR=ierr )
      IF (ierr/=0) RETURN
      CALL iotk_scan_attr( attr, "nr3", nr3_, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      !
      IF ( present( rhoz ) ) THEN
         !
         IF ( .not. present( ip ) ) THEN
            ierr = 71
            RETURN
         ENDIF
         !
         CALL iotk_scan_dat( iunaux, "z"//trim(iotk_index(ip)), rhoz, IERR=ierr)
         IF (ierr/=0) RETURN
         !
      ENDIF
      !
      !
      IF ( present( rho ) ) THEN
         !
         DO ip_ = 1, nr3_
            !
            CALL iotk_scan_dat( iunaux, "z"//trim(iotk_index(ip_)), rho(1:nr1_,1:nr2_,ip_), &
                                IERR=ierr)
            IF (ierr/=0) RETURN
            !
         ENDDO
         !
      ENDIF
      !
      CALL iotk_scan_end( iunaux, "CHARGE-DENSITY", IERR=ierr )
      IF (ierr/=0) RETURN
      !
      CALL iotk_close_read( iunaux, IERR=ierr )
      IF (ierr/=0) RETURN
      !
      !
      IF ( present( nr1 ) )     nr1 = nr1_
      IF ( present( nr2 ) )     nr2 = nr2_
      IF ( present( nr3 ) )     nr3 = nr3_
      !
    END SUBROUTINE qexml_read_rho
    !
#endif
    !
END MODULE oldxml_qexml_module
