!
! Copyright (C) 2008 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 gw_restart
  !----------------------------------------------------------------------------
  !
  ! ... this module contains methods to read and write data saved by the
  !     GW code to restart smoothly
  !
  USE iotk_module
  !
  USE kinds,     ONLY : DP
  USE io_files,  ONLY : prefix, iunpun, xmlpun, &
                        qexml_version, qexml_version_init
  USE control_gw, ONLY : tmp_dir_gw
  USE io_global, ONLY : ionode, ionode_id
  USE mp_global, ONLY : intra_image_comm
  USE mp,        ONLY : mp_bcast
  !
  IMPLICIT NONE
  !
  SAVE
  !
  PRIVATE
  !
  PUBLIC :: gw_writefile, gw_readfile, init_status_run, check_status_run, &
            destroy_status_run
  !
  INTEGER, PRIVATE :: iunout
  !
  LOGICAL :: lheader           = .FALSE., &
             lstatus_read      = .FALSE., &
             lcontrol_gw_read  = .FALSE., &
             lq_read           = .FALSE., &
             lu_read           = .FALSE., &
             lpartial_dyn_read   = .FALSE.
  !
  ! variables to describe qexml current version
  ! and back compatibility
  !
  LOGICAL :: qexml_version_before_1_4_0 = .FALSE.

  CHARACTER(iotk_attlenx)  :: attr
  !
  !
  CONTAINS
    !
    !------------------------------------------------------------------------
    SUBROUTINE gw_writefile( what, irr )
      !------------------------------------------------------------------------
      !
      USE global_version,       ONLY : version_number
      USE control_gw,           ONLY : current_iq, done_bands, ldisp, trans
      USE disp, ONLY : nqs, x_q
      USE xml_io_base, ONLY : write_header, create_directory
      !
      IMPLICIT NONE
      !
      CHARACTER(LEN=*), INTENT(IN) :: what
      INTEGER, INTENT(IN) :: irr
      !
      CHARACTER(LEN=256)  :: dirname, filename
      INTEGER :: ierr
      CHARACTER(LEN=6), EXTERNAL :: int_to_char
      !
      IF ( ionode ) THEN
         !
         ! ... look for an empty unit (only ionode needs it)
         !
         CALL iotk_free_unit( iunpun, ierr )
         !
      END IF
      !
      CALL mp_bcast( ierr, ionode_id, intra_image_comm )
      !
      CALL errore( 'gw_writefile ', &
                   'no free units to write ', ierr )
      !
      dirname = TRIM( tmp_dir_gw ) // TRIM( prefix ) // '.gwsave'
      !
      ! ... create the main restart directory
      !
      CALL create_directory( dirname )
      !
      ! ... open the gw_recover file
      !
      IF ( ionode ) THEN
         !
         ! ... open XML descriptor
         !
         ierr=0
         IF (what=='init') THEN
            CALL iotk_open_write( iunpun, FILE = TRIM( dirname ) // '/' // &
                             & TRIM( xmlpun ), BINARY = .FALSE., IERR = ierr )
         ELSEIF (what=='data' .OR. what=='data_dyn') THEN
            filename= TRIM( dirname ) // '/' // &
                    & TRIM( xmlpun ) // '.' // TRIM(int_to_char(current_iq))
            IF (what=='data') &
               CALL iotk_open_write( iunpun, FILE = TRIM( filename ), &
                                          BINARY = .FALSE., IERR = ierr )
         ELSE
            CALL errore('gw_writefile','unknown what',1)
         ENDIF
         !
      END IF
      !
      CALL mp_bcast( ierr, ionode_id, intra_image_comm )
      !
      CALL errore( 'gw_writefile ', &
                   'cannot open xml_recover file for writing', ierr )
      !
      IF ( ionode ) THEN  
         !
         ! ... here we start writing the gw-punch-file
         !
!-------------------------------------------------------------------------------
! ... HEADER
!-------------------------------------------------------------------------------
         !
         IF (what=='init') THEN
         !
            CALL write_header( "GW", TRIM(version_number) )
         !
!-------------------------------------------------------------------------------
! ... STATUS 
!-------------------------------------------------------------------------------
!   With what='init' the routine writes the status of the code 
!   needed to control the main flow of the dispersion calculation.
!   The mesh of q points, the current q, the main flags that control 
!   the run and the flag done_bands, that tells if this routine is 
!   called before or after the band calculation.
!
            CALL write_status_gw(current_iq, done_bands)
!-------------------------------------------------------------------------------
! ... CONTROL 
!-------------------------------------------------------------------------------
         !
            CALL write_control_gw( ldisp, trans)
         !
!-------------------------------------------------------------------------------
! ... Q POINTS
!------------------------------------------------------------------------------
         !
            CALL write_q( nqs, x_q )
         !
            CALL iotk_close_write( iunpun )
         ELSEIF (what=='data') THEN 
         !
!-------------------------------------------------------------------------------
! ... PARTIAL ITEMS
!-------------------------------------------------------------------------------
!
! with what='data' this routine writes the information on the irreducible
! representations. Number of irreducible representations, number of modes
! for each representation and displacements u. Moreover it writes the 
! point in which the gwonon code has written the recover file: where_rec 
! and rec_code give the same information, where_rec is a string 
! and rec_code an integer. The former is easy to read in the xml file, 
! the latter is simpler to use in the code. Moreover this routine saves
! the tensors that contain the result of the calculations done so far:
! epsilon, zstareu, ramtns, eloptns, dyn, zstarue.
!
            CALL write_partial_gw()
         !
         !
             CALL iotk_close_write( iunpun )
         ELSEIF (what=='data_dyn') THEN 

         END IF

      END IF


      RETURN
      !
      CONTAINS
      
         SUBROUTINE write_partial_gw()
            USE modes, ONLY : nirr, npert, u, name_rap_mode, nsymq
            USE partial, ONLY : done_irr
            USE control_gw, ONLY : current_iq, epsil, trans, elgw, zue, lgamma, where_rec, rec_code

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

            !
            CALL iotk_write_dat(iunpun,"STOPPED_IN",where_rec)
            !
            CALL iotk_write_dat(iunpun,"RECOVER_CODE",rec_code)
            !
            CALL iotk_write_dat(iunpun,"QPOINT_NUMBER",current_iq)
            !
            CALL iotk_write_dat(iunpun,"QPOINT_GROUP_RANK",nsymq)
            !
!   Save the current flags
            RETURN
         END SUBROUTINE write_partial_gw
    END SUBROUTINE gw_writefile 

    SUBROUTINE write_control_gw( ldisp, trans)
      !------------------------------------------------------------------------
      !
      IMPLICIT NONE
      LOGICAL, INTENT(IN) :: ldisp, trans

      CALL iotk_write_begin( iunpun, "CONTROL" )
      !
      CALL iotk_write_dat( iunpun, "DISPERSION_RUN", ldisp )
      CALL iotk_write_dat( iunpun, "GW_", trans )
      CALL iotk_write_end( iunpun, "CONTROL" )
      !
      RETURN
    END SUBROUTINE write_control_gw

    SUBROUTINE write_status_gw(current_iq, done_bands)
      !------------------------------------------------------------------------
      !
      IMPLICIT NONE
      INTEGER, INTENT(IN) :: current_iq
      LOGICAL, INTENT(IN) :: done_bands

      CALL iotk_write_begin( iunpun, "STATUS_PH" )
      !
      CALL iotk_write_dat( iunpun, "DONE_BANDS", done_bands )
      CALL iotk_write_dat( iunpun, "CURRENT_Q", current_iq )
      !
      CALL iotk_write_end( iunpun, "STATUS_PH" )
      !
      RETURN
    END SUBROUTINE write_status_gw
    !

    SUBROUTINE write_q( nqs, x_q)
      !------------------------------------------------------------------------
      !
      INTEGER, INTENT(IN) :: nqs
      REAL(DP), INTENT(IN) :: x_q(3,nqs)
      !
      CALL iotk_write_begin( iunpun, "Q_POINTS" )
      !
      CALL iotk_write_dat( iunpun, "NUMBER_OF_Q_POINTS", nqs  )
      !
      CALL iotk_write_attr( attr, "UNITS", "2 pi / a", FIRST = .TRUE. )
      !
      CALL iotk_write_empty( iunpun, "UNITS_FOR_Q-POINT", attr )
      !
      CALL iotk_write_dat( iunpun, "Q-POINT_COORDINATES", x_q(:,:), COLUMNS=3 )
      !
      CALL iotk_write_end( iunpun, "Q_POINTS" )
      !
      RETURN
    END SUBROUTINE write_q
    !
    !
    !
    !------------------------------------------------------------------------
    SUBROUTINE gw_readfile( what, ierr )
      !------------------------------------------------------------------------
      !
      IMPLICIT NONE
      !
      CHARACTER(LEN=*), INTENT(IN)  :: what
      INTEGER,          INTENT(OUT) :: ierr
      !
      CHARACTER(LEN=256) :: dirname
      !
      ierr = 0
      !
      dirname = TRIM( tmp_dir_gw ) // TRIM( prefix ) // '.gwsave'
      !
      ! ... look for an empty unit
      !
      IF (ionode) THEN
         CALL iotk_free_unit( iunout, ierr )
      ENDIF
      CALL mp_bcast(ierr,ionode_id,intra_image_comm)
      !
      CALL errore( 'gw_readfile', &
                   'no free units to read wavefunctions', ierr )
      !
      lheader = .FALSE.
      lstatus_read      = .FALSE.
      lcontrol_gw_read  = .FALSE.
      lq_read          = .FALSE.
      lpartial_dyn_read   = .FALSE.
      lu_read   = .FALSE.
      !
      SELECT CASE( what )
      CASE( 'init' )
         !
         lheader = .TRUE.
         lstatus_read=.TRUE.
         lq_read=.TRUE.
         lcontrol_gw_read=.TRUE.
         !
      CASE( 'data' )
         !
         lpartial_dyn_read = .TRUE.
         !
      CASE( 'data_u' )
         !
         lu_read = .TRUE.
         !
      CASE( 'reset' )
         !
         lheader = .FALSE.
         lstatus_read      = .FALSE.
         lcontrol_gw_read  = .FALSE.
         lq_read           = .FALSE.
         lpartial_dyn_read   = .FALSE.
         lu_read   = .FALSE.
         !
         RETURN
         !
      END SELECT
      !
      IF ( lheader ) THEN 
         !
         CALL read_header( dirname, ierr )
         IF (ierr /= 0 ) RETURN
         !
      ENDIF
      IF ( lstatus_read ) THEN
         !
         CALL read_status_gw( dirname, ierr )
         IF ( ierr /= 0 ) RETURN
         !
      END IF
      IF ( lcontrol_gw_read ) THEN
         !
        CALL read_control_gw( dirname, ierr )
         IF ( ierr /= 0 ) RETURN
         !
      END IF
      IF ( lq_read ) THEN
         !
         CALL read_q( dirname, ierr )
         IF ( ierr /= 0 ) RETURN
         !
      END IF
      IF ( lpartial_dyn_read ) THEN
         !
         CALL read_partial_gw( dirname, ierr )
         IF ( ierr /= 0 ) RETURN
         !
      END IF

      IF ( lu_read ) THEN
         !
         CALL read_u( dirname, ierr )

         IF ( ierr /= 0 ) RETURN
         !
      END IF
      !
      RETURN
      !
    END SUBROUTINE gw_readfile
    !
    !------------------------------------------------------------------------
    SUBROUTINE read_header( dirname, ierr )
      !------------------------------------------------------------------------
      !
      ! ... this routine reads the format version of the current xml datafile
      !
      USE parser, ONLY : version_compare
      USE xml_io_base, ONLY : attr

      IMPLICIT NONE
      !
      CHARACTER(LEN=*), INTENT(IN)  :: dirname
      INTEGER,          INTENT(OUT) :: ierr

      ierr = 0
      IF ( qexml_version_init ) RETURN
      !
      IF ( ionode ) &
         CALL iotk_open_read( iunpun, FILE = TRIM( dirname ) // '/' // &
                            & TRIM( xmlpun ), IERR = ierr )
      !
      CALL mp_bcast( ierr, ionode_id, intra_image_comm )
      !
      IF ( ierr /=0 ) RETURN
      !
      IF ( ionode ) THEN
         !
         CALL iotk_scan_begin( iunpun, "HEADER" )
         !
         CALL iotk_scan_empty( iunpun, "FORMAT", ATTR=attr )
         !
         CALL iotk_scan_attr( attr, "VERSION", qexml_version )
         !
         qexml_version_init = .TRUE.
         !
         CALL iotk_scan_end( iunpun, "HEADER" )
         !
         !
         CALL iotk_close_read( iunpun )
         !
      ENDIF
      !
      CALL mp_bcast( qexml_version,       ionode_id, intra_image_comm )
      CALL mp_bcast( qexml_version_init,  ionode_id, intra_image_comm )
      
      !
      ! init logical variables for versioning
      !
      qexml_version_before_1_4_0 = .FALSE.
      !
      IF ( TRIM( version_compare( qexml_version, "1.4.0" )) == "older" ) &
         qexml_version_before_1_4_0 = .TRUE.
      !
       RETURN
    END SUBROUTINE read_header
    !------------------------------------------------------------------------
    SUBROUTINE read_status_gw( dirname, ierr )
      !------------------------------------------------------------------------
      !
      USE control_gw, ONLY : current_iq, done_bands
      !
      IMPLICIT NONE
      !
      CHARACTER(LEN=*), INTENT(IN)  :: dirname
      INTEGER,          INTENT(OUT) :: ierr
      !
      !
      IF ( ionode ) THEN
         !
         CALL iotk_open_read( iunpun, FILE = TRIM( dirname ) // '/' // &
                            & TRIM( xmlpun ), IERR = ierr )
         !
      END IF
      !
      CALL mp_bcast( ierr, ionode_id, intra_image_comm )
      !
      IF ( ierr > 0 ) RETURN
      !
      ! ... then selected tags are read from the other sections
      !
      IF ( ionode ) THEN
         !
         CALL iotk_scan_begin( iunpun, "STATUS_PH" )
         !
         CALL iotk_scan_dat( iunpun, "DONE_BANDS", done_bands )         
         !
         CALL iotk_scan_dat( iunpun, "CURRENT_Q", current_iq )         
         !
         CALL iotk_scan_end( iunpun, "STATUS_PH" )
         !
         CALL iotk_close_read( iunpun )
      END IF
      !
      CALL mp_bcast( done_bands,       ionode_id, intra_image_comm )
      CALL mp_bcast( current_iq,       ionode_id, intra_image_comm )
      !
      RETURN
      !
    END SUBROUTINE read_status_gw
    !
    !------------------------------------------------------------------------
    SUBROUTINE read_control_gw( dirname, ierr )
      !------------------------------------------------------------------------
      USE control_gw, ONLY : ldisp, epsil, trans, elgw, zue, zeu

      !
      IMPLICIT NONE
      !
      CHARACTER(LEN=*), INTENT(IN)  :: dirname
      INTEGER,          INTENT(OUT) :: ierr
      !
      IF ( ionode ) THEN
         !
         CALL iotk_open_read( iunpun, FILE = TRIM( dirname ) // '/' // &
                            & TRIM( xmlpun ), IERR = ierr )
         !
      END IF
      !
      CALL mp_bcast( ierr, ionode_id, intra_image_comm )
      !
      IF ( ierr > 0 ) RETURN
      !
      IF ( ionode ) THEN
         CALL iotk_scan_begin( iunpun, "CONTROL" )
         CALL iotk_scan_dat( iunpun, "DISPERSION_RUN", ldisp )
         CALL iotk_scan_dat( iunpun, "PHONON_RUN", trans )
         CALL iotk_scan_end( iunpun, "CONTROL" )
         CALL iotk_close_read( iunpun )
      END IF
      CALL mp_bcast( ldisp,  ionode_id, intra_image_comm )
      CALL mp_bcast( trans,   ionode_id, intra_image_comm )
      !
      RETURN
      !
    END SUBROUTINE read_control_gw
    !
    !------------------------------------------------------------------------
    SUBROUTINE read_q( dirname, ierr )
      !------------------------------------------------------------------------
      !
      USE disp, ONLY : nqs, x_q, done_iq
      !
      IMPLICIT NONE
      !
      CHARACTER(LEN=*), INTENT(IN)  :: dirname
      INTEGER,          INTENT(OUT) :: ierr
      !
      IF ( ionode ) THEN
         !
         CALL iotk_open_read( iunpun, FILE = TRIM( dirname ) // '/' // &
                            & TRIM( xmlpun ), IERR = ierr )
         !
      END IF
      !
      CALL mp_bcast( ierr, ionode_id, intra_image_comm )
      !
      IF ( ierr > 0 ) RETURN
      !
      IF (ionode) THEN
         CALL iotk_scan_begin( iunpun, "Q_POINTS" )
         !
         CALL iotk_scan_dat( iunpun, "NUMBER_OF_Q_POINTS", nqs  )
         !
         ALLOCATE(x_q(3,nqs))
         CALL iotk_scan_dat( iunpun, "Q-POINT_COORDINATES", x_q(1:3,1:nqs) )
         !
         CALL iotk_scan_end( iunpun, "Q_POINTS" )
         !
         CALL iotk_close_read( iunpun )
      ENDIF

      CALL mp_bcast( nqs,    ionode_id, intra_image_comm )

      IF (.NOT. ionode) THEN
         ALLOCATE(x_q(3,nqs))
      ENDIF

      CALL mp_bcast( x_q,    ionode_id, intra_image_comm )

      RETURN
      !
    END SUBROUTINE read_q

    SUBROUTINE read_partial_gw( dirname, ierr )

    USE modes, ONLY : nirr
    USE partial, ONLY : done_irr, comp_irr
    USE efield_mod, ONLY : zstarue0_rec, zstarue0
    USE dynmat,  ONLY : dyn_rec, dyn
    USE control_gw, ONLY : current_iq, trans, zue

    IMPLICIT NONE

    CHARACTER(LEN=*), INTENT(IN)  :: dirname
    INTEGER,          INTENT(OUT) :: ierr
    INTEGER :: irr, iunout

    CHARACTER(LEN=256)    :: filename, filename1
    CHARACTER(LEN=6), EXTERNAL :: int_to_char
    !
    IF ( ionode ) THEN
       !
       filename= TRIM( dirname ) // '/' // &
               & TRIM( xmlpun ) // '.' // TRIM(int_to_char(current_iq))
       !
    END IF

    IF (ionode) THEN
       IF (trans) THEN
          done_irr=0
          dyn=(0.0_DP,0.0_DP)
          dyn_rec=(0.0_DP,0.0_DP)
          zstarue0=(0.0_DP, 0.0_DP)
          DO irr=0,nirr
             CALL iotk_free_unit( iunout, ierr )
             filename1=TRIM(filename) // "." // TRIM(int_to_char(irr))
             CALL iotk_open_read(iunout, FILE = TRIM(filename1), &
                                       BINARY = .FALSE., IERR = ierr )
             
             IF (ierr == 0 ) then
                CALL iotk_scan_begin( iunout, "PARTIAL_MATRIX" )
                CALL iotk_scan_dat(iunout,"DONE_IRR",done_irr(irr))
                IF (done_irr(irr)==1) comp_irr(irr)=1
                CALL iotk_scan_dat(iunout,"PARTIAL_DYN",&
                                                dyn_rec(:,:))
                dyn(:,:)=dyn(:,:) + dyn_rec(:,:)
                IF (zue) THEN
                   CALL iotk_scan_dat(iunout, &
                                     "PARTIAL_ZUE", zstarue0_rec(:,:))
                   zstarue0(:,:)=zstarue0(:,:)+zstarue0_rec(:,:)
                ENDIF
                CALL iotk_scan_end( iunout, "PARTIAL_MATRIX" )
                CALL iotk_close_read( iunout )
             ELSE
                ierr=0
             END IF
          ENDDO
       ENDIF
    ENDIF
    CALL mp_bcast( ierr, ionode_id, intra_image_comm )
    IF (trans) THEN
       CALL mp_bcast( done_irr,  ionode_id, intra_image_comm )
       CALL mp_bcast( comp_irr,  ionode_id, intra_image_comm )
       CALL mp_bcast( dyn_rec,  ionode_id, intra_image_comm )
       CALL mp_bcast( dyn,  ionode_id, intra_image_comm )
       IF (zue) THEN
          CALL mp_bcast( zstarue0,  ionode_id, intra_image_comm )
          CALL mp_bcast( zstarue0_rec,  ionode_id, intra_image_comm )
       ENDIF
    ENDIF

    RETURN
    END SUBROUTINE read_partial_gw

    SUBROUTINE read_u( dirname, ierr )
!
!   This routine reads the tensors that have been already calculated and
!   the displacement patterns. It reads also the code that tells the gwonon
!   where it stopped. The convention is the following:
!
!   rec_code    where_rec     status description
!
!    -1000                    Nothing has been read. There is no recover file.
!    -40         gwq_setup    Only the displacements u have been read from file
!    -30         gwq_init     u and dyn(0) read from file
!    -25                      not yet active. Restart in solve_e_fpol
!    -20         solve_e      all previous. Stopped within solve_e. There 
!                             should be a recover file.
!    -10         solve_e2     epsilon and zstareu are available if requested. 
!                             Within solve_e2. There should be a recover file.
!     10         solve_linter all previous, within solve linter. Recover file
!                             should be present.
!     20         gwqscf       all previous dyn_rec(irr) and zstarue0(irr) are
!                             available.
!     30         dynmatrix    all previous, dyn and zstarue are available.
!
!
    USE modes, ONLY : nirr, npert, u, name_rap_mode
    USE control_gw, ONLY : current_iq, epsil, trans, elgw, zue, zeu, lgamma, &
                           where_rec, rec_code, rec_code_read, done_epsil, &
                           done_zeu, done_zue
    USE efield_mod, ONLY : zstareu, zstarue, epsilon

    IMPLICIT NONE

    CHARACTER(LEN=*), INTENT(IN)  :: dirname
    INTEGER,          INTENT(OUT) :: ierr
    INTEGER :: imode0, imode, irr, ipert, iq, iunout

    CHARACTER(LEN=256)    :: filename
    CHARACTER(LEN=6), EXTERNAL :: int_to_char

    IF ( ionode ) THEN
       !
       filename= TRIM( dirname ) // '/' // &
               & TRIM( xmlpun ) // '.' // TRIM(int_to_char(current_iq))

       CALL iotk_open_read( iunpun, FILE = TRIM( filename ), IERR = ierr )
       !
    END IF
    !
    CALL mp_bcast( ierr, ionode_id, intra_image_comm )
    !
    IF ( ierr > 0 ) RETURN
    !
    IF (ionode) THEN
       CALL iotk_scan_begin( iunpun, "TENSOR_INFO" )
       !
       CALL iotk_scan_dat(iunpun,"STOPPED_IN",where_rec)
       !
       CALL iotk_scan_dat(iunpun,"RECOVER_CODE",rec_code_read)
       !
       CALL iotk_scan_dat(iunpun,"QPOINT_NUMBER",iq)
       !
    ENDIF
    CALL mp_bcast( iq,  ionode_id, intra_image_comm )
    IF (iq /= current_iq) CALL errore('read_partial_gw', &
              'problems with current_iq', 1 )

    IF (ionode) THEN
       IF (trans.or.zeu) THEN
          CALL iotk_scan_dat(iunpun,"NUMBER_IRR_REP",nirr)
          imode0=0
          DO irr=0,nirr
             IF (irr > 0) THEN
                CALL iotk_scan_dat(iunpun,"NUMBER_OF_PERTURBATIONS", npert(irr))
                CALL iotk_scan_dat(iunpun,"SYMMETRY_TYPE", name_rap_mode(irr))
                DO ipert=1,npert(irr)
                   imode=imode0+ipert
                   CALL iotk_scan_dat(iunpun,"DISPLACEMENT_PATTERN",u(:,imode))
                ENDDO
                imode0=imode0+npert(irr)
             ENDIF
          ENDDO
       ENDIF
!
!   read all flags
!
       CALL iotk_close_read( iunpun )
    ENDIF

    CALL mp_bcast( where_rec,  ionode_id, intra_image_comm )
    CALL mp_bcast( rec_code_read,  ionode_id, intra_image_comm )
    rec_code=rec_code_read
    RETURN
    END SUBROUTINE read_u

  !----------------------------------------------------------------------------
    SUBROUTINE check_status_run(  )
  !----------------------------------------------------------------------------
  !
  ! ...
  ! ... This routine sets the situation of the grid according to
  ! ... the files that it finds in the directory .gwsave.

  ! ... From phonon days it checks if representation files exist and which representations 
  ! ... have been already calculated.

  ! ... set the initial information on the grid
  ! ... it sets done_iq and done_rep_iq to 1 for the q and the 
  ! ... representations that have already been done.
  ! ... Moreover it sets rep_iq, the number of representation for each q.
  !
  USE disp, ONLY : nqs, done_iq, done_rep_iq, rep_iq, nsymq_iq, npert_iq
  USE ions_base, ONLY : nat
  USE control_gw, ONLY : trans, zeu
  ! 
  IMPLICIT NONE
  !
  CHARACTER(LEN=256)  :: dirname, filename, filename1
  INTEGER :: iunout, iq, irr, ierr
  CHARACTER(LEN=6), EXTERNAL :: int_to_char
  !
  CALL init_status_run()
  !
  dirname = TRIM( tmp_dir_gw ) // TRIM( prefix ) // '.gwsave'
  DO iq=1, nqs
     IF ( ionode ) THEN
        !
        CALL iotk_free_unit( iunout, ierr )
        filename= TRIM( dirname ) // '/' // &
                & TRIM( xmlpun ) // '.' // TRIM(int_to_char(iq))

        CALL iotk_open_read( iunout, FILE = TRIM( filename ), IERR = ierr )
        
        IF (ierr /= 0) CYCLE
        CALL iotk_scan_begin( iunout, "TENSOR_INFO" )
        !
        CALL iotk_scan_dat(iunout,"QPOINT_GROUP_RANK",nsymq_iq(iq))
        !
        IF (trans.OR.zeu) THEN
           CALL iotk_scan_dat(iunout,"NUMBER_IRR_REP",rep_iq(iq))
           DO irr=1,rep_iq(iq)
              CALL iotk_scan_dat(iunout,"NUMBER_OF_PERTURBATIONS",&
                                         npert_iq(irr,iq))
           ENDDO
        ENDIF

        CALL iotk_scan_end( iunout, "TENSOR_INFO" )
        CALL iotk_close_read(iunout)

        IF (trans.OR.zeu) THEN
           DO irr=rep_iq(iq)+1,3*nat
              done_rep_iq(irr,iq)=2
           ENDDO
           DO irr=0,rep_iq(iq)
              filename1=TRIM(filename) // "." // TRIM(int_to_char(irr))
              CALL iotk_open_read(iunout, FILE = TRIM(filename1), &
                                       BINARY = .FALSE., IERR = ierr )
              IF (ierr /= 0 ) CYCLE
              CALL iotk_scan_begin( iunout, "PARTIAL_MATRIX" )
              CALL iotk_scan_dat(iunout,"DONE_IRR",done_rep_iq(irr,iq))
              CALL iotk_scan_end( iunout, "PARTIAL_MATRIX" )
              CALL iotk_close_read(iunout)
           END DO
           done_iq(iq)=1
           DO irr=0,rep_iq(iq)
              IF (done_rep_iq(irr,iq) /= 1) THEN
                 done_iq(iq)=0
                 EXIT
              ENDIF
           ENDDO    
        END IF 
     END IF
  END DO
  !
  CALL mp_bcast( done_iq, ionode_id, intra_image_comm )
  CALL mp_bcast( rep_iq, ionode_id, intra_image_comm )
  CALL mp_bcast( nsymq_iq, ionode_id, intra_image_comm )
  CALL mp_bcast( npert_iq, ionode_id, intra_image_comm )
  CALL mp_bcast( done_rep_iq, ionode_id, intra_image_comm )
  !
  !
  RETURN
  !
  END SUBROUTINE check_status_run


   SUBROUTINE init_status_run()
   USE  disp, ONLY : nqs, done_iq, done_rep_iq, rep_iq, nsymq_iq, npert_iq, &
                     comp_iq, comp_irr_iq
   USE ions_base, ONLY : nat
   USE mp_global, ONLY : nimage
   IMPLICIT NONE

   ALLOCATE(done_iq(nqs))
   ALLOCATE(rep_iq(nqs))
   ALLOCATE(done_rep_iq(0:3*nat,nqs))
   ALLOCATE(nsymq_iq(nqs))
   ALLOCATE(npert_iq(3*nat,nqs))
   ALLOCATE(comp_iq(nqs))
   IF (nimage>1) ALLOCATE(comp_irr_iq(0:3*nat,nqs))

   done_iq=0
   rep_iq=3*nat
   done_rep_iq=0
   nsymq_iq=0
   npert_iq=0
   IF ( allocated(comp_irr_iq) ) comp_irr_iq=0
   comp_iq=0

   RETURN
   END SUBROUTINE init_status_run

   SUBROUTINE destroy_status_run()
   USE start_k,         ONLY : xk_start, wk_start
   USE disp, ONLY : nqs, done_iq, done_rep_iq, rep_iq, nsymq_iq, npert_iq, &
                    comp_iq, comp_irr_iq, x_q
   IMPLICIT NONE

   IF (ALLOCATED(x_q)) DEALLOCATE(x_q)
   IF (ALLOCATED(done_iq)) DEALLOCATE(done_iq)
   IF (ALLOCATED(rep_iq)) DEALLOCATE(rep_iq)
   IF (ALLOCATED(done_rep_iq)) DEALLOCATE(done_rep_iq)
   IF (ALLOCATED(nsymq_iq)) DEALLOCATE(nsymq_iq)
   IF (ALLOCATED(npert_iq)) DEALLOCATE(npert_iq)
   IF (ALLOCATED(comp_iq)) DEALLOCATE(comp_iq)
   IF (ALLOCATED(comp_irr_iq)) DEALLOCATE(comp_irr_iq)
!
! 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

    !
END MODULE gw_restart