1!
2! Copyright (C) 2006 Malgorzata Wierbowska and Quantum ESPRESSO group
3! This file is distributed under the terms of the
4! GNU General Public License. See the file `License'
5! in the root directory of the present distribution,
6! or http://www.gnu.org/copyleft/gpl.txt .
7!
8MODULE a2F
9  !! author: Malgorzata Wierzbowska
10  !!
11  !! This module contains a routine saving variables needed for the
12  !! electron-phonon calculation (new algorithm implemeted by MW)
13  !!
14  USE kinds,      ONLY : DP
15  !
16  LOGICAL :: la2F = .FALSE.
17  !
18  PRIVATE
19  PUBLIC :: la2F, a2Fsave
20  CONTAINS
21    !
22    SUBROUTINE a2Fsave
23      !!
24      !!
25      USE kinds,        ONLY : DP
26      USE klist,        ONLY : nks, nkstot, xk, wk
27      USE ions_base,    ONLY : nat
28      USE wvfct,        ONLY : et, nbnd
29      USE start_k,      ONLY : nk1, nk2, nk3
30      USE symm_base,    ONLY : s, nsym, irt
31      USE io_global,    ONLY : ionode
32      USE io_files,     ONLY : seqopn
33      implicit none
34      !
35      INTEGER :: iuna2Fsave  = 40, i, j, ik, ns, na
36      logical  ::  exst
37      !
38      ! parallel case: only first node writes
39      IF ( ionode ) THEN
40         !
41         CALL seqopn( iuna2Fsave, 'a2Fsave', 'FORMATTED', exst )
42         !===========================================
43         !
44         WRITE( iuna2Fsave, * ) nbnd, nkstot
45         WRITE( iuna2Fsave, * ) et
46         WRITE( iuna2Fsave, * ) ((xk(i,ik), i=1,3), ik=1,nkstot)
47         WRITE( iuna2Fsave, * ) wk(1:nkstot)
48         WRITE( iuna2Fsave, * ) nk1, nk2, nk3
49         !
50         WRITE( iuna2Fsave, * ) nsym
51         do ns=1,nsym
52            WRITE( iuna2Fsave, * )  ((s(i,j,ns),j=1,3),i=1,3)
53         enddo
54         WRITE( iuna2Fsave, * )  ((irt(ns,na),ns=1,nsym),na=1,nat)
55         !
56         CLOSE( UNIT = iuna2Fsave, STATUS = 'KEEP' )
57         !
58      END IF
59      !
60      RETURN
61    END SUBROUTINE a2Fsave
62  END MODULE a2F
63