!
! Copyright (C) 2008-2012 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 .
!
!
!----------------------------------------------------------------------------
MODULE ph_restart
  !----------------------------------------------------------------------------
  !! This module contains methods to read and write data saved by the
  !! \(\texttt{phonon}\) code to restart smoothly.
  !
  USE xmltools
  !
  USE kinds,     ONLY : DP
  USE io_files,  ONLY : prefix
  USE control_ph,ONLY : tmp_dir_ph
  USE io_global, ONLY : ionode, ionode_id
  USE mp_images, ONLY : intra_image_comm
  USE mp,        ONLY : mp_bcast
  !
  IMPLICIT NONE
  !
  SAVE
  !
  PRIVATE
  !
  PUBLIC :: ph_writefile, ph_readfile, allocate_grid_variables, &
       check_directory_phsave, destroy_status_run, check_available_bands, &
       read_disp_pattern_only
  !
  INTEGER :: iunpun
  !
  ! FIXME: obsolete variables?
  CHARACTER(len=256) :: qexml_version = ' '
  LOGICAL :: qexml_version_init = .FALSE.
  !
  CONTAINS
    !
    !------------------------------------------------------------------------
    SUBROUTINE ph_writefile( what, iq, irr, ierr )
      !------------------------------------------------------------------------
      !! Write the ph-punch-file.
      USE global_version,       ONLY : version_number
      USE control_ph,           ONLY : ldisp, epsil, trans, zue, zeu
      USE el_phon,              ONLY : elph
      USE freq_ph,              ONLY : fpol, nfs, fiu, current_iu
      USE ramanm,               ONLY : lraman, elop
      USE disp,                 ONLY : nqs, x_q, nq1, nq2, nq3
      !
      IMPLICIT NONE
      !
      CHARACTER(LEN=*), INTENT(IN) :: what
      INTEGER, INTENT(IN) :: iq, irr
      !
      INTEGER, INTENT(OUT) :: ierr
      !
      CALL ph_restart_set_filename( what, irr, iq, 1, ierr)
      !
      IF ( ionode ) THEN  
         !
         ! ... here we start writing the ph-punch-file
         !
!-------------------------------------------------------------------------------
! ... HEADER
!-------------------------------------------------------------------------------
         !
         IF (what=='init') THEN
         !
            CALL write_header_ph( "PH", TRIM(version_number) )
         !
!
!   With what='init' the routine writes the main variables that
!   control the main flow of the dispersion calculation:
!   The main flags of the phonon code, the mesh of q point, the
!   number of q points and their coordinates.
!
!-------------------------------------------------------------------------------
! ... CONTROL 
!-------------------------------------------------------------------------------
         !
            CALL write_control_ph( ldisp, epsil, trans, elph, zue, zeu, &
                      lraman, elop, fpol ) 
         !
!-------------------------------------------------------------------------------
! ... Q POINTS AND FREQUENCY POINTS
!------------------------------------------------------------------------------
         !
            CALL write_qu( nqs, nq1, nq2, nq3, x_q, nfs, fiu, fpol )
         !
         ELSEIF (what=='status_ph') THEN
!
!   In this case we save the information on the status of the calculation.
!   The current q point, the current frequency, the label and the
!   code with the point where the code arrived so far. 
!   The former is easy to read in the xml file, 
!   the latter is simpler to use in the code. 
!
            CALL write_status_ph(iq, current_iu)
            !
         ELSEIF (what=='data_u') THEN 
!
! with what='data_u' this routine writes the information on the irreducible
! representations. Number of irreducible representations, number of modes
! for each representation and displacements u.  
!
            CALL write_modes(iq)
         !
         ELSEIF (what=='polarization') THEN 
!
! With what='polarization' this routine saves the tensors that contain the 
! polarization as a function of frequency.
!
             CALL write_polarization(irr)
         !
         ELSEIF (what=='tensors') THEN 
!
! With what='tensors' this routine saves the tensors that contain the 
! result of the calculations done so far: epsilon, zstareu, ramtns, eloptns, 
! dyn, zstarue.
!
             CALL write_tensors()
         !
         ELSEIF (what=='data_dyn') THEN 
!
! with what='data_dyn' this routine writes the information calculated
! separately for each irreducible representation. The contributions
! of the representation to the dynamical matrix and to the Born effective 
! charges dP/du.
!
             CALL write_ph_dyn(irr)

         ELSEIF (what=='el_phon') THEN 
! with what='data_dyn' this routine writes the information calculated
! for this irreducible representation to the electron phonon    
!
             CALL write_el_phon(irr)

         END IF
         CALL xmlw_closetag ( ) ! Root
         CALL xml_closefile ( )
      END IF


      RETURN
      !
      CONTAINS
      
         SUBROUTINE write_polarization(iu)
!
            USE freq_ph, ONLY : polar, done_iu, fpol, done_fpol, fiu

            IMPLICIT NONE
            INTEGER :: iu

            IF (.NOT.fpol) RETURN
            CALL xmlw_opentag( "POLARIZ_IU" )
!
!   Save the current flags
!
            CALL xmlw_writetag( "DONE_POLARIZ_IU", done_fpol )
!
!    Here we save the frequency dependent polarization at this iu
!
            CALL xmlw_writetag( "FREQUENCY_IN_RY", fiu(iu) )
            CALL xmlw_writetag( "CALCULATED_FREQUENCY", done_iu(iu) )
            IF ( done_iu(iu) ) &
                 CALL xmlw_writetag( "POLARIZATION_IU", polar(:,:,iu) )
            !
            CALL xmlw_closetag( )
            RETURN
         END SUBROUTINE write_polarization

         SUBROUTINE write_tensors()
            !! This routine saves the tensors that contain the 
            !! result of the calculations done so far: epsilon, zstareu, ramtns, eloptns, 
            !! dyn, zstarue.
            USE control_ph, ONLY : done_epsil, done_start_zstar, done_zeu, done_zue
            USE ramanm,  ONLY : lraman, elop, ramtns, eloptns, done_lraman, &
                                done_elop
            USE efield_mod, ONLY : zstareu0, zstareu, zstarue, epsilon
            USE ions_base,  ONLY : nat

            IMPLICIT NONE
            INTEGER :: na
            !
            CALL xmlw_opentag( "EF_TENSORS" )
!
!   Save the current flags
!
            CALL xmlw_writetag( "DONE_ELECTRIC_FIELD",done_epsil )
            CALL xmlw_writetag( "DONE_START_EFFECTIVE_CHARGE",done_start_zstar )
            CALL xmlw_writetag( "DONE_EFFECTIVE_CHARGE_EU",done_zeu )
            CALL xmlw_writetag( "DONE_EFFECTIVE_CHARGE_PH",done_zue )
            CALL xmlw_writetag( "DONE_RAMAN_TENSOR",done_lraman )
            CALL xmlw_writetag( "DONE_ELECTRO_OPTIC",done_elop )
!
!    save all calculated tensors
!
            IF (done_epsil) &
               CALL xmlw_writetag( "DIELECTRIC_CONSTANT", epsilon )
            IF (done_start_zstar) &
               CALL xmlw_writetag( "START_EFFECTIVE_CHARGES", zstareu0)
            IF (done_zeu) &
               CALL xmlw_writetag( "EFFECTIVE_CHARGES_EU", zstareu )
            IF (done_lraman) THEN
               DO na = 1, nat
                  CALL add_attr("atom", na)
                  CALL xmlw_writetag( "RAMAN_TNS",ramtns(:,:,:,na) )
               END DO
            END IF
            IF (done_elop) &
               CALL xmlw_writetag( "ELOP_TNS", eloptns)

            IF (done_zue) &
               CALL xmlw_writetag( "EFFECTIVE_CHARGES_UE", zstarue )
            !
            CALL xmlw_closetag( )
            RETURN
         END SUBROUTINE write_tensors

         SUBROUTINE write_modes(iq)
            !! This routine writes the information on the irreducible
            !! representations: number of irreducible representations,
            !! number of modes for each representation and displacements
            !! \(\text{u}\).
            USE modes, ONLY : nirr, npert, u, name_rap_mode, num_rap_mode

            USE lr_symm_base, ONLY : nsymq, minus_q
            ! Workaround
            use ions_base, only: nat

            IMPLICIT NONE
            ! Workaround
            INTEGER :: imode0, imode, irr, ipert, iq

            CALL xmlw_opentag( "IRREPS_INFO" )
            !
            CALL xmlw_writetag( "QPOINT_NUMBER",iq)
            !
            CALL xmlw_writetag( "QPOINT_GROUP_RANK",nsymq)
            !
            CALL xmlw_writetag( "MINUS_Q_SYM",minus_q)
            !
            CALL xmlw_writetag( "NUMBER_IRR_REP",nirr)
            !
            imode0=0
            DO irr=1,nirr
               CALL xmlw_opentag( "REPRESENTION."//i2c(irr) )
               CALL xmlw_writetag( "NUMBER_OF_PERTURBATIONS", npert(irr) )
               DO ipert=1,npert(irr)
                  imode=imode0+ipert
                  CALL xmlw_opentag( "PERTURBATION."//i2c(ipert) )
                  !CALL xmlw_writetag( "SYMMETRY_TYPE_CODE", num_rap_mode(imode))
                  !CALL xmlw_writetag( "SYMMETRY_TYPE", name_rap_mode(imode) )
                  CALL xmlw_writetag( "DISPLACEMENT_PATTERN", u(:,imode) )
                  CALL xmlw_closetag(  )
               ENDDO
               imode0=imode0+npert(irr)
               CALL xmlw_closetag( )
            ENDDO
            !
            CALL xmlw_closetag( )
            RETURN
         END SUBROUTINE write_modes

        SUBROUTINE write_ph_dyn(irr)
           !! This routine writes the information calculated separately for each 
           !! irreducible representation. The contributions of the representation
           !! to the dynamical matrix and to the Born effective charges \(dP/du\).
           USE partial, ONLY : done_irr
           USE dynmat,  ONLY : dyn_rec
           USE efield_mod, ONLY : zstarue0_rec
           USE control_ph, ONLY : trans, zue

           IMPLICIT NONE
           INTEGER, INTENT(IN) :: irr

           IF (trans.OR.zeu) THEN
              IF (done_irr(irr)) THEN
                 !
                 CALL xmlw_opentag( "PM_HEADER")
                 CALL xmlw_writetag( "DONE_IRR", done_irr(irr))
                 CALL xmlw_closetag( )
                 CALL xmlw_opentag( "PARTIAL_MATRIX")
                 CALL xmlw_writetag( "PARTIAL_DYN", dyn_rec(:,:))
                 IF ( zue .and. irr>0 ) &
                      CALL xmlw_writetag( "PARTIAL_ZUE", zstarue0_rec(:,:))
                 CALL xmlw_closetag( )
              ENDIF
           ENDIF
           RETURN
        END SUBROUTINE write_ph_dyn

        SUBROUTINE write_el_phon(irr)
           !! This routine writes the information calculated for this 
           !! irreducible representation to the electron phonon.
           USE el_phon, ONLY : done_elph, el_ph_mat_rec_col, elph
           USE modes, ONLY : npert
           USE klist, ONLY : nks
           USE wvfct, ONLY: nbnd
           USE qpoint, ONLY : nksqtot, xk_col
           USE control_lr, ONLY : lgamma
           IMPLICIT NONE
           INTEGER, INTENT(IN) :: irr
           INTEGER :: ik, ikk, np

           IF (.NOT. elph .OR. .NOT. done_elph(irr)) RETURN
           !
           CALL xmlw_opentag ( "EL_PHON_HEADER")
           CALL xmlw_writetag( "DONE_ELPH", done_elph(irr))
           CALL xmlw_closetag( ) ! el_phon_header
           CALL xmlw_opentag( "PARTIAL_EL_PHON" )
           CALL xmlw_writetag( "NUMBER_OF_K", nksqtot)
           CALL xmlw_writetag( "NUMBER_OF_BANDS", nbnd)
           DO ik=1,nksqtot
              ikk = 2 * ik - 1
              IF (lgamma) ikk = ik 
              CALL xmlw_opentag( "K_POINT." // i2c(ik) )
              CALL xmlw_writetag( "COORDINATES_XK", xk_col(:,ikk) )
              DO np = 1, npert(irr)
                 CALL add_attr("perturbation",np)
                 CALL xmlw_writetag( "PARTIAL_ELPH", el_ph_mat_rec_col(:,:,ik,np) )
              END DO
              CALL xmlw_closetag( )
           ENDDO
           CALL xmlw_closetag( ) ! partial_el_phon
           ! Note: Root tag closed by routine ph_writefile
        RETURN
        END SUBROUTINE write_el_phon

    END SUBROUTINE ph_writefile 

    !------------------------------------------------------------------------
    SUBROUTINE write_header_ph( creator_name, creator_version ) 
      !------------------------------------------------------------------------
      !! Write the header of the ph-punch-file.
      IMPLICIT NONE
      CHARACTER(LEN=*), INTENT(IN) :: creator_name, creator_version
      CHARACTER(5),  PARAMETER :: fmt_name = "QEXML"
      CHARACTER(5),  PARAMETER :: fmt_version = "1.4.0"

      CALL xmlw_opentag( "HEADER" )
      !
      CALL add_attr( "NAME", fmt_name )
      CALL add_attr( "VERSION", fmt_version )
      CALL xmlw_writetag( "FORMAT", "" )
      !
      CALL add_attr( "NAME", creator_name )
      CALL add_attr( "VERSION", creator_version )
      CALL xmlw_writetag( "CREATOR", "")
      !
      CALL xmlw_closetag( )
      !
    END SUBROUTINE write_header_ph
    !
    !
    SUBROUTINE write_control_ph( ldisp, epsil, trans, elph, zue, zeu, &
                      lraman, elop, fpol) 
      !------------------------------------------------------------------------
      !! The routine writes the main variables that control the
      !! main flow of the dispersion calculation: the main flags of
      !! the \(\texttt{phonon}\) code, the mesh of q point, the
      !! number of q points and their coordinates.
      IMPLICIT NONE
      LOGICAL, INTENT(IN) :: ldisp, epsil, trans, elph, zue, zeu, &
                      lraman, elop, fpol

      CALL xmlw_opentag( "CONTROL" )
      !
      CALL xmlw_writetag(  "DISPERSION_RUN", ldisp )
      CALL xmlw_writetag(  "ELECTRIC_FIELD", epsil )
      CALL xmlw_writetag(  "PHONON_RUN", trans )
      CALL xmlw_writetag(  "ELECTRON_PHONON", elph )
      CALL xmlw_writetag(  "EFFECTIVE_CHARGE_EU", zeu )
      CALL xmlw_writetag(  "EFFECTIVE_CHARGE_PH", zue )
      CALL xmlw_writetag(  "RAMAN_TENSOR", lraman )
      CALL xmlw_writetag(  "ELECTRO_OPTIC", elop )
      CALL xmlw_writetag(  "FREQUENCY_DEP_POL", fpol )
      !
      CALL xmlw_closetag( )
      !
      RETURN
    END SUBROUTINE write_control_ph

    SUBROUTINE write_status_ph(current_iq, current_iu)
      !------------------------------------------------------------------------
      !! In this case we save the information on the status of the calculation.
      !! The current q point, the current frequency, the label and the
      !! code with the point where the code arrived so far. 
      !! The former is easy to read in the xml file, 
      !! the latter is simpler to use in the code. 
      USE control_ph, ONLY : where_rec, rec_code
      IMPLICIT NONE
      INTEGER, INTENT(IN) :: current_iq, current_iu

      CALL xmlw_opentag ( "STATUS_PH" )
      CALL xmlw_writetag(  "STOPPED_IN", where_rec )
      CALL xmlw_writetag(  "RECOVER_CODE", rec_code )
      CALL xmlw_writetag(  "CURRENT_Q", current_iq )
      CALL xmlw_writetag(  "CURRENT_IU", current_iu )
      CALL xmlw_closetag( )
      !
      RETURN
    END SUBROUTINE write_status_ph
    !

    SUBROUTINE write_qu( nqs, nq1, nq2, nq3, x_q, nfs, fiu, fpol)
      !------------------------------------------------------------------------
      !! Write q points and frequency points.
      INTEGER, INTENT(IN) :: nqs, nfs, nq1, nq2, nq3
      REAL(DP), INTENT(IN) :: x_q(3,nqs), fiu(nfs)
      LOGICAL, INTENT(IN) :: fpol
      INTEGER :: dim(3)
      !
      CALL xmlw_opentag( "Q_POINTS" )
      !
      dim(1) = nqs ! FIXME: workaround for pp.py
      CALL xmlw_writetag(  "NUMBER_OF_Q_POINTS", dim(1:1)  )
      IF (nqs > 1) THEN
         dim(1) = nq1; dim(2) = nq2; dim(3) = nq3
         CALL xmlw_writetag(  "MESH_DIMENSIONS", dim )
      ENDIF
      CALL add_attr( "UNITS", "2 pi / a" )
      CALL xmlw_writetag( "UNITS_FOR_Q-POINT", "" )
      CALL xmlw_writetag(  "Q-POINT_COORDINATES", x_q(:,:) )
      !
      CALL xmlw_closetag( )
      !
      IF (fpol) THEN
         !
         CALL xmlw_opentag( "FREQUENCIES" )
         CALL xmlw_writetag(  "NUMBER_OF_FREQUENCIES", nfs  )
         CALL xmlw_writetag(  "FREQUENCY_VALUES", fiu(:) )
         CALL xmlw_closetag( )
         !
      ENDIF
      !
      RETURN
    END SUBROUTINE write_qu
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE ph_readfile( what, iq, irr, ierr )
      !------------------------------------------------------------------------
      !! Reads ph info file, depending on \(\text{what}\).
      IMPLICIT NONE
      !
      CHARACTER(LEN=*), INTENT(IN)  :: what
      INTEGER,          INTENT(IN)  :: irr, iq
      !
      !  irreducible representation and q point
      !
      INTEGER,          INTENT(OUT) :: ierr
      !
      CALL ph_restart_set_filename( what, irr, iq, -1, ierr)
      IF (ierr /= 0) RETURN
      !
      SELECT CASE( what )
      CASE( 'init' )
         !
         CALL read_header( ierr )
         IF (ierr /= 0 ) RETURN
         CALL read_control_ph( ierr )
         IF ( ierr /= 0 ) RETURN
         CALL read_qu( ierr )
         IF ( ierr /= 0 ) RETURN
         !
      CASE( 'status_ph')
         !
         CALL read_status_ph( ierr )
         IF ( ierr /= 0 ) RETURN
         !
      CASE( 'data_u' )
         !
         CALL read_disp_pattern( iunpun, iq, ierr )
         IF ( ierr /= 0 ) RETURN
         !
      CASE( 'polarization' )
         !
         CALL read_polarization( irr, ierr )
         IF ( ierr /= 0 ) RETURN
         !
      CASE( 'tensors' )
         !
         CALL read_tensors( ierr )
         IF ( ierr /= 0 ) RETURN
         !
      CASE( 'data_dyn' )
         !
         CALL read_partial_ph( irr, ierr )
         IF ( ierr /= 0 ) RETURN
         !
      CASE( 'el_phon' )
         !
         CALL read_el_phon( irr, ierr )
         IF ( ierr /= 0 ) RETURN
         !
      CASE DEFAULT
         !
         CALL errore('ph_readfile','called with the wrong what',1)
         !
      END SELECT
      !
      IF (ionode) THEN
         CALL xmlr_closetag ( ) ! Root
         CALL xml_closefile( )
      END IF
      !
      RETURN
      !
    END SUBROUTINE ph_readfile
    !
    !------------------------------------------------------------------------
    SUBROUTINE read_header( ierr )
      !------------------------------------------------------------------------
      !! This routine reads the format version of the current xml datafile.
      !
      IMPLICIT NONE
      INTEGER, INTENT(OUT) :: ierr
      CHARACTER(LEN=1) :: dummy

      ierr = 0
      IF ( qexml_version_init ) RETURN
      !
      IF ( ionode ) THEN
         !
         CALL xmlr_opentag( "HEADER" )
         CALL xmlr_readtag( "FORMAT", dummy )
         CALL get_attr( "VERSION", qexml_version )
         qexml_version_init = .TRUE.
         CALL xmlr_closetag( )
         !
      ENDIF
      !
      CALL mp_bcast( qexml_version,       ionode_id, intra_image_comm )
      CALL mp_bcast( qexml_version_init,  ionode_id, intra_image_comm )
      
       RETURN
    END SUBROUTINE read_header
    !------------------------------------------------------------------------
    SUBROUTINE read_status_ph( ierr )
      !------------------------------------------------------------------------
      !! This routine reads the status of \(\texttt{ph}\). It tells where the 
      !! code stopped.  
      !! There is both a number, to be used within the code, and a label
      !! that is easier to read within the recover file.
      !
      !! The convention with the \(\text{\rec_code}\) is the following:
      !
      !! * -1000: nothing has been read. There is no recover file;
      !! * -40: stops in \(\texttt{phq_setup}\). Only the displacements u 
      !!        have been read from file;
      !! * -30: stops in \(\texttt{phq_init}\). \(\text{u}\) and \(\text{dyn}(0)\)
      !!        read from file;
      !! * -25: not yet active. Restart in \(\texttt{solve_e_fpol}\);
      !! * -20: stops in \(\texttt{solve_e}\). All previous. There should be a 
      !!        recover file;
      !! * -10: stops in \(\texttt{solve_e2}\). \(\text{epsilon}\) and \(\text{zstareu}\)
      !!        are available if requested. There should be a recover file;
      !! * 2: stops in \(\texttt{phescf}\). All previous, Raman tenson and elop tensor
      !!      are available if required;
      !! * 10: stops in \(\texttt{solve_linter}\). All previous. Recover file should 
      !!       be present;
      !! * 20: stops in \(\texttt{phqscf}\). All previous \(\text{dyn_rec}(\text{irr})\)
      !!       and \(\texttt{zstarue0}(\texttt{irr})\) are available;
      !! * 30: stops in \(\texttt{dynmatrix}\). All previous, \(\text{dyn}\) and 
      !!       \(\text{zstarue}\) are available.
      !
      !
      USE control_ph, ONLY : current_iq, where_rec, rec_code_read
      USE freq_ph, ONLY : current_iu
      !
      IMPLICIT NONE
      !
      INTEGER,          INTENT(OUT) :: ierr
      !
      ! ... then selected tags are read from the other sections
      !
      ierr=0
      IF ( ionode ) THEN
         !
         CALL xmlr_opentag( "STATUS_PH" )
         CALL xmlr_readtag( "STOPPED_IN", where_rec )
         CALL xmlr_readtag( "RECOVER_CODE", rec_code_read )
         CALL xmlr_readtag( "CURRENT_Q", current_iq ) 
         CALL xmlr_readtag( "CURRENT_IU", current_iu )
         CALL xmlr_closetag( )
         !
      END IF
      !
      CALL mp_bcast( where_rec,        ionode_id, intra_image_comm )
      CALL mp_bcast( rec_code_read,         ionode_id, intra_image_comm )
      CALL mp_bcast( current_iq,       ionode_id, intra_image_comm )
      CALL mp_bcast( current_iu,       ionode_id, intra_image_comm )
      !
      RETURN
      !
    END SUBROUTINE read_status_ph
    !
    !------------------------------------------------------------------------
    SUBROUTINE read_control_ph( ierr )
      !------------------------------------------------------------------------
      !! Read \(\text{ph}\) control variables.
      USE control_ph, ONLY : ldisp, epsil, trans, zue, zeu
      USE el_phon,    ONLY : elph
      USE ramanm,     ONLY : lraman, elop
      USE freq_ph,    ONLY : fpol
      !
      IMPLICIT NONE
      !
      INTEGER,          INTENT(OUT) :: ierr
      LOGICAL :: ldisp_, epsil_, trans_, zue_, zeu_, elph_, lraman_, elop_, &
                 fpol_
      !
      ierr=0
      IF ( ionode ) THEN
         CALL xmlr_opentag( "CONTROL" )
         !
         CALL xmlr_readtag( "DISPERSION_RUN", ldisp_ )
         CALL xmlr_readtag( "ELECTRIC_FIELD", epsil_ )
         CALL xmlr_readtag( "PHONON_RUN", trans_ )
         CALL xmlr_readtag( "ELECTRON_PHONON", elph_ )
         CALL xmlr_readtag( "EFFECTIVE_CHARGE_EU", zeu_ )
         CALL xmlr_readtag( "EFFECTIVE_CHARGE_PH", zue_ )
         CALL xmlr_readtag( "RAMAN_TENSOR", lraman_ )
         CALL xmlr_readtag( "ELECTRO_OPTIC", elop_ )
         CALL xmlr_readtag( "FREQUENCY_DEP_POL", fpol_ )
         !
         CALL xmlr_closetag( )
         !
      END IF
      CALL mp_bcast( ldisp_,   ionode_id, intra_image_comm )
      CALL mp_bcast( epsil_,   ionode_id, intra_image_comm )
      CALL mp_bcast( trans_,   ionode_id, intra_image_comm )
      CALL mp_bcast( elph_,    ionode_id, intra_image_comm )
      CALL mp_bcast( zeu_,     ionode_id, intra_image_comm )
      CALL mp_bcast( zue_,     ionode_id, intra_image_comm )
      CALL mp_bcast( lraman_,  ionode_id, intra_image_comm )
      CALL mp_bcast( elop_,    ionode_id, intra_image_comm )
      CALL mp_bcast( fpol_,    ionode_id, intra_image_comm )
      !
      IF (ldisp_ .neqv. ldisp) CALL errore('read_control_ph','wrong ldisp',1)
      IF (epsil_ .neqv. epsil) CALL errore('read_control_ph','wrong epsil',1)
      IF (trans_ .neqv. trans) CALL errore('read_control_ph','wrong trans',1)
      IF (elph_ .neqv. elph) CALL errore('read_control_ph','wrong elph',1)
      IF (zeu_ .neqv. zeu) CALL errore('read_control_ph','wrong zeu',1)
      IF (zue_ .neqv. zue) CALL errore('read_control_ph','wrong zue',1)
      IF (lraman_ .neqv. lraman) CALL errore('read_control_ph','wrong lraman',1)
      IF (elop_ .neqv. elop) CALL errore('read_control_ph','wrong elop',1)
      IF (fpol_ .neqv. fpol) CALL errore('read_control_ph','wrong fpol',1)
      !
      RETURN
      !
    END SUBROUTINE read_control_ph
    !
    !------------------------------------------------------------------------
    SUBROUTINE read_qu( ierr )
      !------------------------------------------------------------------------
      !! Read q points and frequency points.
      USE disp, ONLY : nqs, x_q, nq1, nq2, nq3, lgamma_iq
      USE freq_ph, ONLY : fpol, nfs, fiu
      !
      IMPLICIT NONE
      !
      INTEGER,          INTENT(OUT) :: ierr
      INTEGER :: nfs_, nq1_, nq2_, nq3_, iq
      LOGICAL :: exst
      INTEGER :: dim(3)
      !
      ierr=0
      IF (ionode) THEN
         CALL xmlr_opentag( "Q_POINTS" )
         !
         CALL xmlr_readtag( "NUMBER_OF_Q_POINTS", nqs  )
         dim(3) = 0
         IF (nqs > 1) CALL xmlr_readtag( "MESH_DIMENSIONS", dim )
         !
         ALLOCATE(x_q(3,nqs))
         CALL xmlr_readtag( "Q-POINT_COORDINATES", x_q(1:3,1:nqs) )
         !
         CALL xmlr_closetag( )
         !
         IF (fpol) THEN
            !
            CALL xmlr_opentag( "FREQUENCIES" )
            !
            CALL xmlr_readtag( "NUMBER_OF_FREQUENCIES", nfs_  )
            !
            CALL xmlr_readtag( "FREQUENCY_VALUES", fiu(1:nfs_) )
            !
            CALL xmlr_closetag( )
            !
         ENDIF
      ENDIF

      CALL mp_bcast( nqs,    ionode_id, intra_image_comm )

      IF (nqs > 1) THEN
         CALL mp_bcast( dim,    ionode_id, intra_image_comm )
         nq1_ = dim(1); nq2_ = dim(2); nq3_ = dim(3)
         IF ( (nq1_ /= nq1 ) .OR. (nq2_ /= nq2) .OR. (nq3_ /= nq3 ) )  &
               CALL errore('read_qu','nq1, nq2, or nq3 do not match',1)
            !
      ENDIF

      IF (.NOT. ionode) ALLOCATE(x_q(3,nqs))
      CALL mp_bcast( x_q,    ionode_id, intra_image_comm )

      ALLOCATE(lgamma_iq(nqs))
      DO iq=1,nqs
        lgamma_iq(iq)=(x_q(1,iq)==0.D0.AND.x_q(2,iq)==0.D0.AND.x_q(3,iq)==0.D0) 
      END DO

      IF (fpol) THEN
         CALL mp_bcast( nfs_,    ionode_id, intra_image_comm )
         IF (nfs_ /= nfs) &
            CALL errore('read_qu','wrong number of frequencies',1)

         CALL mp_bcast( fiu,    ionode_id, intra_image_comm )
      END IF

      RETURN
      !
    END SUBROUTINE read_qu

    SUBROUTINE read_partial_ph( irr, ierr )
    !! Reads partial dyn matrix.
    USE partial,    ONLY : done_irr
    USE efield_mod, ONLY : zstarue0_rec
    USE dynmat,     ONLY : dyn_rec
    USE control_ph, ONLY : trans, zue

    IMPLICIT NONE

    INTEGER, INTENT(OUT) :: ierr
    INTEGER, INTENT(IN) :: irr

    !
    ierr=0
    IF (ionode) THEN
       IF (trans) THEN
          CALL xmlr_opentag( "PM_HEADER" )
          CALL xmlr_readtag( "DONE_IRR",done_irr(irr) )
          CALL xmlr_closetag( )
          CALL xmlr_opentag( "PARTIAL_MATRIX" )
          CALL xmlr_readtag( "PARTIAL_DYN", dyn_rec(:,:) )
          IF ( zue .AND. irr>0 ) &
               CALL xmlr_readtag( "PARTIAL_ZUE", zstarue0_rec(:,:) )
          CALL xmlr_closetag( )
       ENDIF
    ENDIF
    IF (trans) THEN
       CALL mp_bcast( done_irr(irr),  ionode_id, intra_image_comm )
       CALL mp_bcast( dyn_rec,  ionode_id, intra_image_comm )
       IF (zue) CALL mp_bcast( zstarue0_rec,  ionode_id, intra_image_comm )
    ENDIF

    RETURN
    END SUBROUTINE read_partial_ph

    SUBROUTINE read_el_phon(irr, ierr)
    !! This routine reads the information calculated
    !! for this irreducible representation to the electron phonon.
    USE qpoint,     ONLY : nksq, nksqtot
    USE el_phon,    ONLY : el_ph_mat_rec, el_ph_mat_rec_col, done_elph, elph
    USE modes,      ONLY : npert
    USE wvfct,      ONLY : nbnd
    USE mp_pools,   ONLY : npool
    
    IMPLICIT NONE
    INTEGER,          INTENT(in) :: irr
    INTEGER,          INTENT(OUT) :: ierr
    REAL(DP) :: xkdum(3)
    INTEGER :: ik, np, np_, npe, idum
    !
    ierr=0
    IF (.NOT. elph) RETURN
    npe=npert(irr)

    IF (npool>1) THEN
       ALLOCATE(el_ph_mat_rec_col(nbnd,nbnd,nksqtot,npe))
    ELSE
       el_ph_mat_rec_col => el_ph_mat_rec
    ENDIF

    IF (ionode) THEN
       CALL xmlr_opentag( "EL_PHON_HEADER")
       CALL xmlr_readtag( "DONE_ELPH", done_elph(irr) )
       CALL xmlr_closetag( )
       CALL xmlr_opentag( "PARTIAL_EL_PHON" )
       CALL xmlr_readtag( "NUMBER_OF_K", idum )
       CALL xmlr_readtag( "NUMBER_OF_BANDS", idum )
       DO ik=1,nksqtot
          CALL xmlr_opentag( "K_POINT." // i2c(ik) )
          CALL xmlr_readtag( "COORDINATES_XK", xkdum(:) )
          DO np = 1, npert(irr)
             CALL xmlr_readtag( "PARTIAL_ELPH", el_ph_mat_rec_col(:,:,ik,np) )
             CALL get_attr("perturbation", np_)
          END DO
          CALL xmlr_closetag( )
       ENDDO
       CALL xmlr_closetag( )
    ENDIF

    CALL mp_bcast(done_elph(irr), ionode_id, intra_image_comm)
    CALL mp_bcast(el_ph_mat_rec_col, ionode_id, intra_image_comm)

    IF (npool > 1) THEN
       CALL el_ph_distribute(npe,el_ph_mat_rec,el_ph_mat_rec_col,&
                                                   nksqtot,nksq)
       DEALLOCATE(el_ph_mat_rec_col)
    ENDIF

    RETURN
    END SUBROUTINE read_el_phon
    !
    !---------------------------------------------------------------------------
    SUBROUTINE read_disp_pattern_only(iunpun, filename, current_iq, ierr)
    !---------------------------------------------------------------------------
    !!
    !! Wrapper routine used by EPW: open file, calls \(\texttt{read_disp_pattern}\).
    !!
    IMPLICIT NONE
    !
    INTEGER, INTENT(in) :: iunpun
    !! Unit
    INTEGER, INTENT(in) :: current_iq
    !! Current q-point
    CHARACTER(LEN=*), INTENT(in) :: filename
    !! self-explanatory
    INTEGER, INTENT(out) :: ierr
    !! Error code
    INTEGER :: iun
    !
    iun =  xml_open_file (filename)
    IF ( iun == -1 ) then
       ierr = 1
       return
    end if
    CALL xmlr_opentag ( 'Root' )
    CALL read_disp_pattern(iun, current_iq, ierr)
    CALL xmlr_closetag () ! Root
    CALL xml_closefile ()
    !
    END SUBROUTINE read_disp_pattern_only
    !
    !---------------------------------------------------------------------------
    SUBROUTINE read_disp_pattern(iunpun, current_iq, ierr)
    !---------------------------------------------------------------------------
    !!
    !! This routine reads the displacement patterns.
    !!
    USE modes,        ONLY : nirr, npert, u, name_rap_mode, num_rap_mode
    USE lr_symm_base, ONLY : minus_q, nsymq
    USE io_global,    ONLY : ionode, ionode_id
    USE mp,           ONLY : mp_bcast
    !
    IMPLICIT NONE
    !
    INTEGER, INTENT(in) :: current_iq
    !! Current q-point
    INTEGER, INTENT(in) :: iunpun
    !! Current q-point
    INTEGER, INTENT(out) :: ierr
    !! Error
    !
    ! Local variables
    INTEGER :: imode0, imode
    !! Counter on modes
    INTEGER :: irr
    !! Counter on irreducible representations
    INTEGER :: ipert
    !! Counter on perturbations at each irr
    INTEGER :: iq
    !! Current q-point
    !
    ierr = 0
    IF (ionode) THEN
       CALL xmlr_opentag( "IRREPS_INFO" )
       CALL xmlr_readtag( "QPOINT_NUMBER",iq )
    ENDIF
    CALL mp_bcast(iq, ionode_id, intra_image_comm)
    IF (iq /= current_iq) CALL errore('read_disp_pattern', ' Problems with current_iq', 1)
    !
    IF (ionode) THEN
      !
      CALL xmlr_readtag( "QPOINT_GROUP_RANK", nsymq )
      CALL xmlr_readtag( "MINUS_Q_SYM", minus_q )
      CALL xmlr_readtag( "NUMBER_IRR_REP", nirr )
      imode0 = 0
      DO irr = 1, nirr
        CALL xmlr_opentag( "REPRESENTION."// i2c(irr) )
        CALL xmlr_readtag( "NUMBER_OF_PERTURBATIONS", npert(irr) )
        DO ipert = 1, npert(irr)
          imode = imode0 + ipert
          CALL xmlr_opentag( "PERTURBATION."// i2c(ipert) )
          ! not sure why these two lines break epw
          !CALL xmlr_readtag( "SYMMETRY_TYPE_CODE", num_rap_mode(imode) )
          !CALL xmlr_readtag( "SYMMETRY_TYPE", name_rap_mode(imode) )
          CALL xmlr_readtag( "DISPLACEMENT_PATTERN", u(:,imode) )
          CALL xmlr_closetag( )
        ENDDO
        imode0 = imode0 + npert(irr)
        CALL xmlr_closetag( )
      ENDDO
      !
      CALL xmlr_closetag( )
      !
    ENDIF
    !
    CALL mp_bcast(nirr   , ionode_id, intra_image_comm)
    CALL mp_bcast(npert  , ionode_id, intra_image_comm)
    CALL mp_bcast(nsymq  , ionode_id, intra_image_comm)
    CALL mp_bcast(minus_q, ionode_id, intra_image_comm)
    CALL mp_bcast(u      , ionode_id, intra_image_comm)
    !CALL mp_bcast(name_rap_mode,  ionode_id, intra_image_comm)
    !CALL mp_bcast(num_rap_mode,   ionode_id, intra_image_comm)
    !
    RETURN
    !
  END SUBROUTINE read_disp_pattern
  !
  !---------------------------------------------------------------------------
  SUBROUTINE read_tensors( ierr )
    !---------------------------------------------------------------------------
    !!
    !! This routine reads the tensors that have been already calculated.
    !!
    USE ions_base,  ONLY : nat
    USE control_ph, ONLY : done_epsil, done_start_zstar, done_zeu, done_zue
    USE ramanm,  ONLY : lraman, elop, ramtns, eloptns, done_lraman, done_elop
    USE efield_mod, ONLY : zstareu, zstarue, zstarue0, zstareu0, epsilon

    IMPLICIT NONE

    INTEGER,          INTENT(OUT) :: ierr
    INTEGER :: imode0, imode, ipol, irr, ipert, iq, iu, na, na_
    !
    ierr=0
    IF (ionode) THEN
       CALL xmlr_opentag( "EF_TENSORS" )
       !
       CALL xmlr_readtag( "DONE_ELECTRIC_FIELD", done_epsil )
       CALL xmlr_readtag( "DONE_START_EFFECTIVE_CHARGE", done_start_zstar )
       CALL xmlr_readtag( "DONE_EFFECTIVE_CHARGE_EU", done_zeu )
       CALL xmlr_readtag( "DONE_EFFECTIVE_CHARGE_PH", done_zue )
       CALL xmlr_readtag( "DONE_RAMAN_TENSOR", done_lraman )
       CALL xmlr_readtag( "DONE_ELECTRO_OPTIC", done_elop )

       IF (done_epsil) &
          CALL xmlr_readtag( "DIELECTRIC_CONSTANT",epsilon )
       IF (done_start_zstar) &
          CALL xmlr_readtag( "START_EFFECTIVE_CHARGES",zstareu0 )
       IF (done_zeu) &
          CALL xmlr_readtag( "EFFECTIVE_CHARGES_EU",zstareu )
       IF (done_lraman) THEN
          DO na = 1, nat
             CALL xmlr_readtag( "RAMAN_TNS",ramtns(:,:,:,na) )
             CALL get_attr("atom", na_)
          END DO
       END IF
       IF (done_elop) CALL xmlr_readtag( "ELOP_TNS",eloptns )
       IF (done_zue) CALL xmlr_readtag( "EFFECTIVE_CHARGES_UE", zstarue )
       !
       CALL xmlr_closetag( )
       !
    ENDIF

    CALL mp_bcast( done_epsil,  ionode_id, intra_image_comm )
    CALL mp_bcast( done_start_zstar,  ionode_id, intra_image_comm )
    CALL mp_bcast( done_zeu,  ionode_id, intra_image_comm )
    CALL mp_bcast( done_zue,  ionode_id, intra_image_comm )
    CALL mp_bcast( done_lraman,  ionode_id, intra_image_comm )
    CALL mp_bcast( done_elop,  ionode_id, intra_image_comm )
    IF (done_epsil) CALL mp_bcast( epsilon, ionode_id, intra_image_comm )
    IF (done_start_zstar) THEN
       CALL mp_bcast( zstareu0, ionode_id, intra_image_comm )
       DO ipol=1,3
          DO imode=1,3*nat
             zstarue0(imode,ipol)=zstareu0(ipol,imode)
          ENDDO
       ENDDO
    ENDIF   
    IF (done_zeu) CALL mp_bcast( zstareu, ionode_id, intra_image_comm )
    IF (done_zue) CALL mp_bcast( zstarue, ionode_id, intra_image_comm )
    IF (done_lraman) CALL mp_bcast( ramtns, ionode_id, intra_image_comm )
    IF (done_elop) CALL mp_bcast( eloptns,  ionode_id, intra_image_comm )

    RETURN
    END SUBROUTINE read_tensors

  !----------------------------------------------------------------------------
    SUBROUTINE read_polarization( iu, ierr ) 
    !!
    !! This routine reads the tensors that have been already calculated.
    !!
    USE ions_base,  ONLY : nat
    USE freq_ph, ONLY : fpol, done_iu, fiu, polar

    IMPLICIT NONE

    INTEGER, INTENT(IN) :: iu
    INTEGER, INTENT(OUT) :: ierr
    !
    ierr=0
    IF ( .NOT.fpol ) RETURN
    IF (ionode) THEN
       CALL xmlr_opentag( "POLARIZ_IU" )
       !
       CALL xmlr_readtag( "FREQUENCY_IN_RY", fiu(iu) )
       CALL xmlr_readtag( "CALCULATED_FREQUENCY", &
                               done_iu(iu))
       IF (done_iu(iu)) &
            CALL xmlr_readtag( "POLARIZATION_IU", polar(:,:,iu) )
       !
       CALL xmlr_closetag( )
       !
    ENDIF

    CALL mp_bcast( fiu(iu),  ionode_id, intra_image_comm )
    CALL mp_bcast( done_iu(iu),  ionode_id, intra_image_comm )
    IF ( done_iu(iu) ) &
             CALL mp_bcast( polar(:,:,iu),  ionode_id, intra_image_comm )

    RETURN
    END SUBROUTINE read_polarization

  !----------------------------------------------------------------------------
    SUBROUTINE check_directory_phsave(  )
  !----------------------------------------------------------------------------
  !! This routine sets the situation of the grid according to
  !! the files that it finds on the directory .phsave.  
  !! Check if representation files exist and which representations 
  !! have been already calculated.  
  !! Sets the initial information on the grid.  
  !! It sets \(\text{done_irr_iq}\) to TRUE for the q and the 
  !! representations that have already been done.  
  !! Moreover it sets \(\text{irr_iq}\), the number of representations 
  !! for each q, \(\text{nsymq_iq}\) the size of the small group of each
  !! q and \(\text{npert_irr_iq}\) the number of perturbations for each 
  !! irr and q.
  !
  USE kinds, ONLY : DP
  USE disp, ONLY : nqs, done_iq
  USE grid_irr_iq, ONLY : comp_irr_iq, done_irr_iq, irr_iq, done_elph_iq
  USE control_ph, ONLY : trans, current_iq, low_directory_check
  USE el_phon,    ONLY : elph
  ! 
  IMPLICIT NONE
  !
  CHARACTER(LEN=256)  :: dirname, filename, filename1
  CHARACTER(LEN=256), EXTERNAL  :: trimcheck
  INTEGER :: iunout, iq, irr, ierr
  CHARACTER(LEN=6), EXTERNAL :: int_to_char
  LOGICAL :: exst
  !
  dirname = trimcheck ( TRIM( tmp_dir_ph ) // TRIM( prefix ) // '.phsave' )
  ierr=0
  DO iq=1, nqs
     IF ( ionode ) THEN
        IF (trans.OR.elph) THEN
!
!    NB: the representation 0 is the initial dynamical matrix calculated by 
!        dyn0. If it finds the file read the relevant information
!
           filename= TRIM( dirname ) // 'dynmat.' // &
                     TRIM(int_to_char(iq)) // '.' 

           DO irr=0,irr_iq(iq)
              IF (comp_irr_iq(irr,iq).AND..NOT.low_directory_check) THEN
                 filename1=TRIM(filename) // TRIM(int_to_char(irr)) // '.xml'
                 INQUIRE(FILE=TRIM(filename1), EXIST=exst)
                 IF (.NOT.exst) CYCLE
                 iunout = xml_open_file( filename1 )
                 IF (iunout == -1 ) THEN
                    ierr = 1
                    GOTO 100
                 end if
                 CALL xmlr_opentag( "Root" )
                 CALL xmlr_opentag( "PM_HEADER" )
                 CALL xmlr_readtag( "DONE_IRR", done_irr_iq(irr,iq) )
                 CALL xmlr_closetag( ) ! PM_HEADER
                 CALL xmlr_closetag( ) ! Root
                 CALL xml_closefile( )
              ENDIF
           END DO
!
!   Check for the electron phonon files
!
           IF (elph) THEN
              filename= TRIM( dirname ) // 'elph.' // &
                        TRIM(int_to_char(iq)) // '.' 

              DO irr=1,irr_iq(iq)
                 IF (comp_irr_iq(irr,iq).OR..NOT.low_directory_check) THEN
                    filename1=TRIM(filename) // TRIM(int_to_char(irr)) // '.xml'
                    INQUIRE(FILE=TRIM(filename1), EXIST=exst)
                    IF (.NOT.exst) CYCLE
                    iunout = xml_open_file( filename1 ) 
                    IF (iunout == -1 ) THEN
                       ierr = 1
                       GOTO 100
                    END IF
                    CALL xmlr_opentag( "Root")
                    CALL xmlr_opentag( "EL_PHON_HEADER")
                    CALL xmlr_readtag( "DONE_ELPH", done_elph_iq(irr,iq))
                    CALL xmlr_closetag( ) ! EL_PHON_HEADER
                    CALL xmlr_closetag( ) ! Root
                    CALL xml_closefile( )
                 ENDIF
              ENDDO
           END IF
        END IF 
        done_iq(iq)=.TRUE.
        DO irr=1,irr_iq(iq)
           IF (comp_irr_iq(irr,iq).AND..NOT.done_irr_iq(irr,iq)) &
                                        done_iq(iq)=.FALSE.
           IF (elph) THEN
              IF (comp_irr_iq(irr,iq).AND..NOT.done_elph_iq(irr,iq)) &
                                        done_iq(iq)=.FALSE.
           ENDIF
        ENDDO
        IF (comp_irr_iq(0,iq).AND..NOT.done_irr_iq(0,iq)) done_iq(iq)=.FALSE.
     END IF
  END DO
100 CALL mp_bcast( ierr, ionode_id, intra_image_comm )
  IF (ierr /= 0) CALL errore('check_directory_phsave','opening file',1)
  !
  CALL mp_bcast( done_iq, ionode_id, intra_image_comm )
  CALL mp_bcast( done_irr_iq, ionode_id, intra_image_comm )
  IF (elph) CALL mp_bcast( done_elph_iq, ionode_id, intra_image_comm )
  !
  RETURN
  !
  END SUBROUTINE check_directory_phsave

  !----------------------------------------------------------------------------
    SUBROUTINE check_available_bands(  )
  !----------------------------------------------------------------------------
  !! This routine checks which bands are available on disk and
  !! sets the array done_bands(iq) to TRUE for each q point
  !! for which the bands are present.  
  !! If \(\text{lqdir}\) is FALSE only the bands corresponding to
  !! \(\text{current_iq}\) can be present, whereas if \(\text{lqdir}\)
  !! is TRUE several q points might have calculated the bands and saved 
  !! them on disk.
  !
  USE kinds, ONLY : DP
  USE disp, ONLY : nqs, x_q, lgamma_iq
  USE io_files, ONLY : tmp_dir, postfix, xmlpun_schema
  USE control_ph, ONLY : tmp_dir_ph, lqdir, current_iq, newgrid
  USE grid_irr_iq, ONLY : done_bands
  ! 
  IMPLICIT NONE
  !
  CHARACTER(LEN=256)  :: dirname, filename, dir_phq, tmp_dir_save
  CHARACTER(LEN=256), EXTERNAL :: trimcheck
  CHARACTER(LEN=6  ), EXTERNAL :: int_to_char
  INTEGER :: iq
  LOGICAL :: lgamma, exst, exst_restart, exst_recover
  !
  ! We check if the xml data file (data-file-schema.xml) is present 
  ! in the directory where it should be. If lqdir=.false. only the bands 
  ! of current_iq might be present, otherwise we have to check all q points.
  ! If the file is present and there is a restart file, the bands are not
  ! done yet.
  ! For the gamma point done_bands might be false only with newgrid. 
  !
  done_bands=.FALSE.
  dirname = TRIM( tmp_dir_ph ) // TRIM( prefix ) // postfix
  tmp_dir_save=tmp_dir

  DO iq=1, nqs
     IF ( iq == current_iq .OR. lqdir) THEN
        IF (lqdir .AND. .NOT. lgamma_iq(iq)) THEN
           dir_phq= trimcheck ( TRIM (tmp_dir_ph) // TRIM(prefix) //  &
                               & '.q_' // int_to_char(iq) )
           dirname= TRIM (dir_phq) // TRIM(prefix) // postfix
           tmp_dir=dir_phq
        ELSE
           tmp_dir=tmp_dir_ph
        ENDIF
        !
        filename=TRIM(dirname) // xmlpun_schema
        !
        IF (ionode) inquire (file =TRIM(filename), exist = exst)
        !
        CALL mp_bcast( exst, ionode_id, intra_image_comm )
        !
        exst_restart=.FALSE.
        IF (exst) CALL check_restart_recover(exst_recover, exst_restart)
        !
        IF (exst.AND..NOT.exst_restart) done_bands(iq)=.TRUE.
     END IF
     IF (lgamma_iq(iq).AND..NOT.newgrid) done_bands(iq) = .TRUE.
  END DO
  tmp_dir=tmp_dir_save
  !
  RETURN
  !
  END SUBROUTINE check_available_bands

   SUBROUTINE allocate_grid_variables()
   !
   !! This routine allocates and initializes the grid variables when the 
   !! \(\text{nqs}\) and \(\text{x_q}\) have been decided, either reading
   !! them from file when recover is TRUE or recalculating them from scratch.
   !
   USE disp, ONLY : nqs, done_iq, comp_iq, omega_disp              
   USE grid_irr_iq, ONLY : done_irr_iq, irr_iq, nsymq_iq, &
                           comp_irr_iq, npert_irr_iq, done_bands, &
                           done_elph_iq
   USE freq_ph, ONLY : done_iu, comp_iu, nfs
   USE ions_base, ONLY : nat
   USE el_phon, ONLY : elph_simple, gamma_disp, el_ph_nsigma
   USE control_ph, ONLY : qplot

   IMPLICIT NONE

   ALLOCATE(done_iq(nqs))
   ALLOCATE(done_bands(nqs))
   ALLOCATE(comp_iq(nqs))
   ALLOCATE(irr_iq(nqs))
   ALLOCATE(done_irr_iq(0:3*nat,nqs))
   ALLOCATE(done_elph_iq(1:3*nat,nqs))
   ALLOCATE(comp_irr_iq(0:3*nat,nqs))
   ALLOCATE(nsymq_iq(nqs))
   ALLOCATE(npert_irr_iq(3*nat,nqs))

   ALLOCATE(done_iu(nfs))
   ALLOCATE(comp_iu(nfs))

   done_iq=.FALSE.
   done_bands=.FALSE.
   done_irr_iq=.FALSE.
   done_elph_iq=.FALSE.
   done_iu=.FALSE.

   comp_iu=.TRUE.
   comp_iq=.TRUE.
   comp_irr_iq=.TRUE.

   irr_iq=3*nat
   nsymq_iq=0
   npert_irr_iq=0

   IF (qplot) THEN
      ALLOCATE(omega_disp(3*nat,nqs))
      IF (elph_simple) ALLOCATE(gamma_disp(3*nat,el_ph_nsigma,nqs))
   ENDIF

   RETURN
   END SUBROUTINE allocate_grid_variables

   SUBROUTINE destroy_status_run()
   USE start_k,     ONLY : xk_start, wk_start
   USE disp,        ONLY : nqs, x_q, done_iq, comp_iq, lgamma_iq, omega_disp
   USE grid_irr_iq, ONLY : done_irr_iq, irr_iq, nsymq_iq, &
                          npert_irr_iq, comp_irr_iq, done_bands, done_elph_iq
   USE el_phon,     ONLY : gamma_disp
   USE freq_ph,     ONLY : comp_iu, done_iu, fiu
   IMPLICIT NONE

   IF (ALLOCATED(x_q)) DEALLOCATE(x_q)
   IF (ALLOCATED(lgamma_iq)) DEALLOCATE(lgamma_iq)
   IF (ALLOCATED(done_bands)) DEALLOCATE(done_bands)
   IF (ALLOCATED(done_iq)) DEALLOCATE(done_iq)
   IF (ALLOCATED(comp_iq)) DEALLOCATE(comp_iq)
   IF (ALLOCATED(irr_iq)) DEALLOCATE(irr_iq)
   IF (ALLOCATED(done_irr_iq)) DEALLOCATE(done_irr_iq)
   IF (ALLOCATED(done_elph_iq)) DEALLOCATE(done_elph_iq)
   IF (ALLOCATED(comp_irr_iq)) DEALLOCATE(comp_irr_iq)
   IF (ALLOCATED(nsymq_iq)) DEALLOCATE(nsymq_iq)
   IF (ALLOCATED(npert_irr_iq)) DEALLOCATE(npert_irr_iq)
   IF (ALLOCATED(fiu)) DEALLOCATE(fiu)
   IF (ALLOCATED(done_iu)) DEALLOCATE(done_iu)
   IF (ALLOCATED(comp_iu)) DEALLOCATE(comp_iu)
   IF (ALLOCATED(omega_disp)) DEALLOCATE(omega_disp)
   IF (ALLOCATED(gamma_disp)) DEALLOCATE(gamma_disp)
!
! Note that these two variables are allocated by read_file. 
! They cannot be deallocated by clean_pw because the starting xk and wk 
! points must be known at each q point.
! The logic of these two variables must be improved.
!
  IF (ALLOCATED( xk_start )) DEALLOCATE( xk_start )
  IF (ALLOCATED( wk_start )) DEALLOCATE( wk_start )

   END SUBROUTINE destroy_status_run

   SUBROUTINE ph_restart_set_filename( what, irr, current_iq, iflag, ierr)
      !
      !! This subroutine sets the filename for each action required by what
      !! and opens the appropriate file for reading or writing.
      !
      USE io_global,    ONLY : ionode, ionode_id
      USE io_files,     ONLY : create_directory, xmlpun_schema
      USE freq_ph,      ONLY : fpol
      USE mp_images,    ONLY : intra_image_comm
      USE mp,           ONLY : mp_bcast

      IMPLICIT NONE
      INTEGER, INTENT(IN) :: irr, current_iq, iflag
      INTEGER, INTENT(OUT) :: ierr
      CHARACTER(LEN=*), INTENT(IN) :: what

      CHARACTER(LEN=256) :: dirname, filename
      CHARACTER(LEN=256), EXTERNAL :: trimcheck
      CHARACTER(LEN=6  ), EXTERNAL :: int_to_char
      LOGICAL :: exst

      ierr=0
      !
      dirname = trimcheck ( TRIM( tmp_dir_ph ) // TRIM( prefix ) // '.phsave' )
      !
      ! ... create the main restart directory
      !
      IF (ionode) inquire (file = TRIM(dirname) // xmlpun_schema, exist = exst)
      CALL mp_bcast( exst, ionode_id, intra_image_comm )
      !
      IF (.NOT. exst) CALL create_directory( dirname )
      !
      ! ... open the ph_recover file
      !
      IF ( ionode ) THEN
         !
         ! ... open XML descriptor
         !
         ierr=0
         IF (what=='init') THEN
            filename = TRIM( dirname ) // 'control_ph.xml'
         ELSEIF (what=='status_ph') THEN
            filename=TRIM( dirname ) //'status_run.xml'
         ELSEIF (what=='data_u') THEN
            filename= TRIM( dirname ) // 'patterns.' // &
                      TRIM(int_to_char(current_iq)) // '.xml'
         ELSEIF (what=='data_dyn') THEN
            filename= TRIM( dirname ) // 'dynmat.' // &
                      TRIM(int_to_char(current_iq)) // '.' //  &
                      TRIM(int_to_char(irr)) // '.xml'
         ELSEIF (what=='tensors') THEN
            filename= TRIM( dirname ) // 'tensors.xml'
         ELSEIF (what=='polarization') THEN
            IF (.NOT. fpol) RETURN
            filename= TRIM( dirname ) // 'polarization.'// &
                      TRIM(int_to_char(irr)) // '.xml'
         ELSEIF (what=='el_phon') THEN
            filename= TRIM( dirname ) // 'elph.' // &
                      TRIM(int_to_char(current_iq)) // '.' //  &
                      TRIM(int_to_char(irr)) // '.xml'
         ELSE
            CALL errore( 'ph_restart_set_filename ', &
              'no filename', 1 )
         ENDIF
         !
         IF (iflag/=1) THEN
            INQUIRE( FILE=TRIM(filename), EXIST=exst )
            IF (.NOT.exst) GOTO 100
         ENDIF

         iunpun = xml_open_file( filename )
         !
         exst = (iunpun /= -1)
         IF (.NOT.exst) GOTO 100
         !
         IF ( iflag == 1 ) THEN
            call add_attr( 'version','1.0')
            call add_attr( 'encoding','UTF-8')
            CALL xmlw_writetag ( 'xml', '?' )
            CALL xmlw_opentag ( 'Root' )
         ELSE
            CALL xmlr_opentag ( 'Root' )
         END IF
         !
      END IF
100   IF (iflag /= 0) THEN
         CALL mp_bcast( exst, ionode_id, intra_image_comm )
!
!     If the file does not exist and we must read from it, we return with
!     an error message.
!
         IF (.NOT.exst) THEN
            ierr=100
            RETURN
         ENDIF
      ENDIF

      CALL mp_bcast( ierr, ionode_id, intra_image_comm )
      !
      IF (.NOT.exst) THEN
         CALL infomsg( 'ph_restart_set_filename ', &
              'cannot open file for reading or writing' )
         ierr=100
      ENDIF
      !
    END SUBROUTINE ph_restart_set_filename
    !
END MODULE ph_restart
