1!
2! Copyright (C) 2004-2010 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 write_resultsps ( )
10  !--------------------------------------------------------------
11  USE kinds,     ONLY : dp
12  USE radial_grids, ONLY : ndmx
13  USE io_global, ONLY : stdout, ionode, ionode_id
14  USE mp,        ONLY : mp_bcast
15  USE constants, ONLY : eps6
16  USE ld1inc,    ONLY : title, rel, zed, zval, lsd, isic, latt, beta, tr2, &
17                  nwfts, nnts, llts, jjts, elts, octs, iswts, enlts, nstoaets, &
18                  grid, enl,  eps0, iter, etot, etots, etot0, lpaw, &
19                  etots0, ekin, encl, ehrt, ecxc, nlcc, ecc, evxt, epseu, &
20                  dhrsic, dxcsic, file_wavefunctionsps, phits, rytoev_fact, &
21                  verbosity, frozen_core, ae_fc_energy, jj, max_out_wfc
22
23  USE ld1inc,    ONLY : nwf, el, psi, rcut
24  USE funct, ONLY: get_dft_name
25  IMPLICIT NONE
26
27  INTEGER :: counter
28  real(DP) :: psiaux(ndmx,2*max_out_wfc), phase
29  CHARACTER (len=2) :: elaux(2*max_out_wfc)
30
31  INTEGER :: i, j, n, wfc_num, ios
32  CHARACTER (len=20) :: dft_name
33  !
34  !
35  dft_name = get_dft_name()
36  WRITE(stdout,"(/,5x,22('-'),' Testing the pseudopotential ',22('-'),/)")
37  WRITE(stdout,'(5x,a75)') title
38  IF(rel==1) WRITE(stdout,'(5x,''scalar relativistic calculation'')')
39  IF(rel==2) WRITE(stdout,'(5x,''dirac relativistic calculation'')')
40  WRITE(stdout,"(/5x,'atomic number is',f6.2,'   valence charge is',f6.2)") &
41       zed, zval
42  WRITE(stdout,100) dft_name(1:len_trim(dft_name)),lsd,isic,latt,beta,tr2
43100 FORMAT(5x,'dft =',a,'   lsd =',i1,' sic =',i1,' latt =',i1, &
44       '  beta=',f4.2,' tr2=',1pe7.1)
45  WRITE(stdout,200) grid%mesh,grid%r(grid%mesh),grid%xmin,grid%dx
46200 FORMAT(5x,'mesh =',i4,' r(mesh) =',f10.5,' xmin =',f6.2,' dx =',f8.5)
47  IF (rel<2) THEN
48     WRITE(stdout,300)
49300 FORMAT(/5x,'n l     nl             e AE (Ry) ',  &
50          '       e PS (Ry)    De AE-PS (Ry) ')
51     DO n=1,nwfts
52        IF (verbosity=='high') THEN
53           IF (octs(n)>-eps6) THEN
54              IF (ABS(enl(nstoaets(n))-enlts(n))< 5.d-3) THEN
55                 WRITE(stdout,401) &
56                 nnts(n),llts(n),elts(n),iswts(n),octs(n), &
57                 enl(nstoaets(n)),enlts(n), &
58                 enl(nstoaets(n))-enlts(n)
59              ELSE
60!
61!     put a ! close to the eigenvalues that differ more than 5 mRy
62!
63                 WRITE(stdout,403) &
64                 nnts(n),llts(n),elts(n),iswts(n),octs(n), &
65                 enl(nstoaets(n)),enlts(n), &
66                 enl(nstoaets(n))-enlts(n)
67              ENDIF
68           ENDIF
69        ELSE
70           IF (octs(n)>-eps6) THEN
71              IF (ABS(enl(nstoaets(n))-enlts(n))< 5.d-3) THEN
72                WRITE(stdout,400) &
73                  nnts(n),llts(n),elts(n),iswts(n),octs(n), &
74                  enl(nstoaets(n)),enlts(n), &
75                  enl(nstoaets(n))-enlts(n)
76              ELSE
77                 WRITE(stdout,402) &
78                   nnts(n),llts(n),elts(n),iswts(n),octs(n), &
79                   enl(nstoaets(n)),enlts(n), &
80                   enl(nstoaets(n))-enlts(n)
81              ENDIF
82           ENDIF
83        ENDIF
84     ENDDO
85     IF (ionode) WRITE(13,400)  &
86          (nnts(n),llts(n),elts(n),iswts(n),octs(n), &
87          enl(nstoaets(n)),enlts(n),  &
88          enl(nstoaets(n))-enlts(n),  n=1,nwfts)
89400 FORMAT(4x,2i2,5x,a2,i4,'(',f5.2,')',f15.5,f15.5,f15.5)
90401 FORMAT(4x,2i2,5x,a2,i4,'(',f5.2,')',f15.5,f15.5,f15.8)
91402 FORMAT(4x,2i2,5x,a2,i4,'(',f5.2,')',f15.5,f15.5,f15.5,"  !")
92403 FORMAT(4x,2i2,5x,a2,i4,'(',f5.2,')',f15.5,f15.5,f15.8,"  !")
93  ELSE
94     WRITE(stdout,500)
95500 FORMAT(/5x,'n l  j  nl             e AE (Ry)',  &
96          '       e PS (Ry)    De AE-PS (Ry) ')
97     DO n=1,nwfts
98        IF (verbosity=='high') THEN
99           IF(octs(n)>-eps6) THEN
100             IF (ABS(enl(nstoaets(n))-enlts(n))< 5.d-3) THEN
101                WRITE(stdout,601) &
102                nnts(n),llts(n),jjts(n),elts(n),iswts(n),octs(n), &
103                enl(nstoaets(n)),enlts(n), enl(nstoaets(n))-enlts(n)
104             ELSE
105                WRITE(stdout,603) &
106                nnts(n),llts(n),jjts(n),elts(n),iswts(n),octs(n), &
107                enl(nstoaets(n)),enlts(n), enl(nstoaets(n))-enlts(n)
108             ENDIF
109           ENDIF
110        ELSE
111           IF(octs(n)>-eps6) THEN
112             IF (ABS(enl(nstoaets(n))-enlts(n))< 5.d-3) THEN
113                WRITE(stdout,600) &
114                  nnts(n),llts(n),jjts(n),elts(n),iswts(n),octs(n), &
115                  enl(nstoaets(n)),enlts(n), enl(nstoaets(n))-enlts(n)
116             ELSE
117                WRITE(stdout,602) &
118                   nnts(n),llts(n),jjts(n),elts(n),iswts(n),octs(n), &
119                   enl(nstoaets(n)),enlts(n), enl(nstoaets(n))-enlts(n)
120             ENDIF
121           ENDIF
122        ENDIF
123     ENDDO
124     IF (ionode) WRITE(13,600)  &
125          (nnts(n),llts(n),jjts(n),elts(n),iswts(n),octs(n), &
126          enl(nstoaets(n)),enlts(n),  &
127          enl(nstoaets(n))-enlts(n),  n=1,nwfts)
128600 FORMAT(4x,2i2,f4.1,1x,a2,i4,'(',f5.2,')',f15.5,f15.5,f15.5)
129601 FORMAT(4x,2i2,f4.1,1x,a2,i4,'(',f5.2,')',f15.5,f15.5,f15.8)
130602 FORMAT(4x,2i2,f4.1,1x,a2,i4,'(',f5.2,')',f15.5,f15.5,f15.5,"  !")
131603 FORMAT(4x,2i2,f4.1,1x,a2,i4,'(',f5.2,')',f15.5,f15.5,f15.8,"  !")
132  ENDIF
133  WRITE(stdout,"(/5x,'eps =',1pe8.1,'  iter =',i3)") eps0,iter
134  WRITE(stdout,*)
135  WRITE(stdout,700) etot, etot*0.5_dp, etot*rytoev_fact
136700 FORMAT (5x,'Etot =',f15.6,' Ry,',f15.6, ' Ha,',f15.6,' eV')
137  WRITE(stdout,800) etots, etots*0.5_dp, etots*rytoev_fact
138800 FORMAT (5x,'Etotps =',f13.6,' Ry,',f15.6,' Ha,',f15.6,' eV')
139  IF (frozen_core.or.(verbosity=='high'.and.lpaw)) &
140       WRITE(stdout,900) ae_fc_energy, ae_fc_energy*0.5_dp, &
141                                           ae_fc_energy*rytoev_fact
142900 FORMAT (5x,'Etotfc =',f13.6,' Ry,',f15.6,' Ha,',f15.6,' eV')
143
144  IF (abs(etot-etot0)> 1.d-9) THEN
145     WRITE(stdout,"(5x,'dEtot_ae =',f15.6,' Ry')") etot-etot0
146     WRITE(stdout,1000) etots-etots0, etot-etot0 - (etots-etots0)
1471000 FORMAT (5x,'dEtot_ps =',f15.6,' Ry,','   Delta E=',f15.6,' Ry' )
148     IF (ionode) WRITE(13,'(5x,''dEtot_ae ='',f15.6,'' Ry'')') etot-etot0
149     IF (ionode) WRITE(13,&
150       '(5x,''dEtot_ps ='',f15.6,'' Ry,'',''   Delta E='', f15.6,'' Ry'' )') &
151          etots-etots0, etot-etot0-(etots-etots0)
152  ELSE
153     IF (ionode) WRITE(13,700) etot, etot*0.5_dp, etot*rytoev_fact
154     IF (ionode) WRITE(13,800) etots, etots*0.5_dp, etots*rytoev_fact
155  ENDIF
156  WRITE(stdout,1100) ekin, ekin*0.5_dp, ekin*rytoev_fact
1571100 FORMAT (/,5x,'Ekin =',f15.6,' Ry,',f15.6,' Ha,',f15.6,' eV')
158
159  WRITE(stdout,1200) encl, encl*0.5_dp, encl*rytoev_fact
1601200 FORMAT (5x,'Encl =',f15.6,' Ry,',f15.6, ' Ha,',f15.6,' eV')
161  WRITE(stdout,1271) ehrt, ehrt*0.5_dp, ehrt*rytoev_fact
1621271 FORMAT (5x,'Ehrt =',f15.6,' Ry,',f15.6,' Ha,',f15.6,' eV')
163  WRITE(stdout,1281) ecxc, ecxc*0.5_dp, ecxc*rytoev_fact
1641281 FORMAT (5x,'Ecxc =',f15.6,' Ry,',f15.6,' Ha,',f15.6,' eV')
165  IF (nlcc) WRITE(stdout,1282) ecc, ecc*0.5_dp, ecc*rytoev_fact
1661282 FORMAT (5x,'(Ecc =',f15.6,' Ry,',f15.6,' Ha,',f15.6,' eV)')
167  IF (abs(evxt)>0.0_DP) &
168     WRITE(stdout,1291) evxt, evxt*0.5_dp, evxt*rytoev_fact
1691291 FORMAT(5x,'Evxt =',f15.6,' Ry,',f15.6,' Ha,',f15.6,' eV')
170  IF (abs(epseu)>0.0_DP) &
171     WRITE(stdout,1292) epseu, epseu*0.5_dp, epseu*rytoev_fact
1721292 FORMAT (5x,'Epseu=',f15.6,' Ry,',f15.6, ' Ha,',f15.6,' eV')
173  IF(isic/=0) WRITE(stdout,1300) dhrsic+dxcsic, dhrsic, dxcsic
1741300 FORMAT(5x,'desic:'/5x,0pf12.4,24x,2(0pf12.4))
175  WRITE(stdout,120)
176120 FORMAT (/,5x,22('-'), ' End of pseudopotential test ',22('-'),/)
177  !
178  IF (ionode) WRITE(13,*)
179  !
180  IF (file_wavefunctionsps/=' ') THEN
181     counter=1
182     wfc_num=MIN(nwfts, max_out_wfc)
183     DO i=1,nwfts
184        IF (counter > max_out_wfc) exit
185        elaux(counter)=elts(i)
186        psiaux(:,counter)=phits(:,i)
187        DO j=nwf,1,-1
188           IF ( elts(i) == el(j) .and. jjts(i)==jj(j) ) THEN
189              DO n=grid%mesh,1,-1
190                 phase = psiaux(n,counter)*psi(n,1,j)
191                 IF ( abs(phase) > 1.d-12 ) THEN
192                    phase = phase / abs(phase)
193                    exit
194                 ENDIF
195              ENDDO
196              psiaux(:,wfc_num+counter)=psi(:,1,j)*phase
197              elaux(wfc_num+counter)=el(j)
198              exit
199           ENDIF
200        ENDDO
201        counter=counter+1
202     ENDDO
203     counter = counter - 1
204     CALL write_wfcfile(file_wavefunctionsps,psiaux,elaux,2*counter)
205  ENDIF
206
207  RETURN
208END SUBROUTINE write_resultsps
209