1!
2! Copyright (C) 2001-2016 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!
8!--------------------------------------------------------------------
9SUBROUTINE lr_write_restart()
10  !---------------------------------------------------------------------
11  !
12  ! This subroutine reads in and stores vectors necessary to
13  ! restart the Lanczos recursion.
14  !
15  ! Modified by Osman Baris Malcioglu (2009)
16  ! Modified by Xiaochuan Ge (May. 2013) to adapt pseudo-hermitian
17  !
18  USE kinds,                ONLY : DP
19  USE io_files,             ONLY : tmp_dir, prefix, diropn
20  USE lr_variables,         ONLY : beta_store, gamma_store, zeta_store, norm0, &
21                                   LR_polarization, LR_iteration, n_ipol,F,project,&
22                                   evc1,evc1_new,evc1_old,iunrestart, nwordrestart, &
23                                   nbnd_total, charge_response,lr_verbosity,&
24                                   bgz_suffix, eels, q1, q2, q3, sum_rule, tmp_dir_lr
25  USE charg_resp,           ONLY : resonance_condition, rho_1_tot, rho_1_tot_im
26  USE wvfct,                ONLY : nbnd, npwx
27  USE fft_base,             ONLY : dfftp
28  USE io_global,            ONLY : ionode, stdout
29  USE klist,                ONLY : nks, nelec
30  USE noncollin_module,     ONLY : nspin_mag, noncolin, npol
31  use lsda_mod,             ONLY : nspin
32  USE cell_base,            ONLY : alat, omega
33  USE qpoint,               ONLY : nksq
34  !
35  IMPLICIT NONE
36  CHARACTER(len=6), EXTERNAL :: int_to_char
37  !
38  ! local variables
39  !
40  INTEGER :: i, j, pol_index,ibnd_occ,ibnd_virt
41  CHARACTER(len=256) :: tempfile, filename
42  LOGICAL :: exst
43  real(kind=dp) :: degspin
44  !
45  IF (lr_verbosity > 5) THEN
46    WRITE(stdout,'("<lr_write_restart>")')
47  ENDIF
48  !
49  ! Note: ionode only operations are carried out in tmp_dir not wfc_dir
50  !
51  ! If there is only one polarization dir, storage is one rank less.
52  !
53  pol_index = 1
54  !
55  IF ( n_ipol /= 1 ) pol_index = LR_polarization
56  !
57  IF (eels) tmp_dir = tmp_dir_lr
58  !
59#if defined(__MPI)
60  IF (ionode) THEN
61#endif
62  !
63  ! Writing beta, gamma and zeta coefficients.
64  !
65  IF (eels) THEN
66     filename = trim(prefix) // trim(bgz_suffix) // trim("dat")
67  ELSE
68     filename = trim(prefix) // trim(bgz_suffix) // trim(int_to_char(LR_polarization))
69  ENDIF
70  tempfile = trim(tmp_dir) // trim(filename)
71  !
72  OPEN (158, file = tempfile, form = 'formatted', status = 'unknown')
73  WRITE(158,*) LR_iteration
74  !
75  norm0(pol_index) = beta_store(pol_index,1)
76  WRITE(158,*) norm0(pol_index)
77  !
78  IF (nspin==2) THEN
79        degspin = 1.0d0
80  ELSE
81        degspin = 2.0d0
82  ENDIF
83  IF (noncolin) degspin = 1.0d0
84  !
85  ! Write the degenaracy wrt spin
86  !
87  WRITE(158,*) degspin
88  !
89  ! ------ Needed for EELS ----------
90  !
91  ! Write the lattice parameter
92  !
93  WRITE(158,*) alat
94  !
95  ! Write the unit-cell volume
96  !
97  WRITE(158,*) omega
98  !
99  ! Write the number of valence (and semicore electrons) in the unit cell
100  !
101  WRITE(158,*) nelec
102  !
103  ! Write the components of the transferred momentum
104  !
105  WRITE(158,*) q1
106  WRITE(158,*) q2
107  WRITE(158,*) q3
108  !
109  !-----------------------------------
110  !
111  DO i=1,LR_iteration-1
112     !
113     WRITE(158,*) beta_store(pol_index,i+1)
114     WRITE(158,*) gamma_store(pol_index,i+1)
115     !
116     ! This is absolutely necessary for cross platform compatibility
117     !
118     DO j=1,n_ipol
119      WRITE(158,*) zeta_store (pol_index,j,i)
120     ENDDO
121     !
122  ENDDO
123  !
124  ! X. Ge: Compatable with the old version. The beta & gamma will not be used in
125  ! the spectrum calculation.
126  !
127  WRITE(158,*) beta_store(pol_index,LR_iteration)
128  WRITE(158,*) gamma_store(pol_index,LR_iteration)
129  DO j=1,n_ipol
130    WRITE(158,*) zeta_store (pol_index,j,LR_iteration)
131  ENDDO
132  !
133  CLOSE(158)
134  !
135  ! Optical case: writing F
136  !
137  IF (project .AND. .NOT.eels) THEN
138     !
139     filename = trim(prefix) // ".projection." // trim(int_to_char(LR_polarization))
140     tempfile = trim(tmp_dir) // trim(filename)
141     !
142     OPEN (158, file = tempfile, form = 'formatted', status = 'unknown')
143     WRITE(158,*) LR_iteration
144     WRITE(158,*) nbnd        ! number of filled bands
145     WRITE(158,*) nbnd_total  !total number of bands
146     !
147     DO ibnd_occ=1,nbnd
148        DO ibnd_virt=1,(nbnd_total-nbnd)
149           WRITE(158,*) F(ibnd_occ,ibnd_virt,pol_index)
150        ENDDO
151     ENDDO
152     !
153     CLOSE(158)
154     !
155  ENDIF
156  !
157#if defined(__MPI)
158  ENDIF
159#endif
160    !
161    ! Parallel writing operations
162    !
163    ! Note: Restart files are writen in outdir.
164    ! If you do not want them to be written,
165    ! just disable restart saving completely.
166    !
167    ! Writing wavefuncion files for restart
168    !
169    nwordrestart = 2 * nbnd * npwx * npol * nksq
170    !
171    CALL diropn ( iunrestart, 'restart_lanczos.'//trim(int_to_char(LR_polarization)), nwordrestart, exst)
172    !
173    CALL davcio(evc1(:,:,:,1),nwordrestart,iunrestart,1,1)
174    CALL davcio(evc1(:,:,:,2),nwordrestart,iunrestart,2,1)
175    CALL davcio(evc1_old(:,:,:,1),nwordrestart,iunrestart,3,1)
176    CALL davcio(evc1_old(:,:,:,2),nwordrestart,iunrestart,4,1)
177    !
178    CLOSE( unit = iunrestart)
179    !
180    ! Optical case: Writing charge response density for restart
181    !
182    IF (charge_response == 1 .AND. .NOT.eels) THEN
183       !
184       IF (resonance_condition) THEN
185          CALL diropn ( iunrestart, 'restart_lanczos-rho_tot.'//trim(int_to_char(LR_polarization)), 2*dfftp%nnr*nspin_mag, exst)
186          CALL davcio(rho_1_tot_im(:,:),2*dfftp%nnr*nspin_mag,iunrestart,1,1)
187          CLOSE( unit = iunrestart)
188       ELSE
189          CALL diropn ( iunrestart, 'restart_lanczos-rho_tot.'//trim(int_to_char(LR_polarization)), 2*dfftp%nnr*nspin_mag, exst)
190          CALL davcio(rho_1_tot(:,:),2*dfftp%nnr*nspin_mag,iunrestart,1,1)
191          CLOSE( unit = iunrestart)
192       ENDIF
193       !
194    ENDIF
195    IF (sum_rule == -2 .AND. .NOT.eels) THEN
196       !
197       CALL diropn ( iunrestart, 'restart_lanczos-sum-2.'//trim(int_to_char(LR_polarization)), 2*dfftp%nnr*nspin_mag, exst)
198       CALL davcio(rho_1_tot_im(:,:),2*dfftp%nnr*nspin_mag,iunrestart,1,1)
199       CLOSE( unit = iunrestart)
200       !
201    ENDIF
202
203    !
204    RETURN
205    !
206END SUBROUTINE lr_write_restart
207!-----------------------------------------------------------------------
208