do_setup.f90 8.98 KB
Newer Older
Marco Govoni's avatar
Marco Govoni committed
1
!
Marco Govoni's avatar
Marco Govoni committed
2
! Copyright (C) 2015-2021 M. Govoni 
Marco Govoni's avatar
Marco Govoni committed
3
4
5
6
7
8
9
10
11
12
13
14
15
16
! 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 .
!
! This file is part of WEST.
!
! Contributors to this file: 
! Marco Govoni
!
!-----------------------------------------------------------------------
SUBROUTINE do_setup
  !-----------------------------------------------------------------------
  !
Marco Govoni's avatar
Marco Govoni committed
17
  USE json_module,            ONLY : json_file
Marco Govoni's avatar
Marco Govoni committed
18
19
20
21
22
  USE pwcom,                  ONLY : npw,nbnd,nkstot,xk,wk,nspin,nelec,nelup,neldw,et,wg,&
                                   & lspinorb,domag,lsda,isk,nks,two_fermi_energies,ngk
  USE fixed_occ,              ONLY : tfixed_occ,f_inp
  USE kinds,                  ONLY : DP
  USE mp,                     ONLY : mp_sum
Marco Govoni's avatar
Marco Govoni committed
23
  USE mp_global,              ONLY : intra_bgrp_comm,npool,nbgrp,nproc_bgrp,me_bgrp
Marco Govoni's avatar
Marco Govoni committed
24
25
26
27
28
29
30
  USE mp_pools,               ONLY : intra_pool_comm, inter_pool_comm, &
                                     my_pool_id, nproc_pool, kunit
  USE io_global,              ONLY : stdout
  USE lsda_mod,               ONLY : current_spin,lsda
  USE constants,              ONLY : rytoev
  USE control_flags,          ONLY : gamma_only
  USE noncollin_module,       ONLY : noncolin,npol
Marco Govoni's avatar
Marco Govoni committed
31
  USE cell_base,              ONLY : omega,celldm,at,bg,tpiba
Marco Govoni's avatar
Marco Govoni committed
32
33
  USE fft_base,               ONLY : dfftp,dffts
  USE gvecs,                  ONLY : ngms_g, ngms
Marco Govoni's avatar
Marco Govoni committed
34
  USE gvect,                  ONLY : ngm_g, ngm, ecutrho
Marco Govoni's avatar
Marco Govoni committed
35
36
  USE gvecw,                  ONLY : ecutwfc
  USE io_push
37
  USE westcom,                ONLY : logfile
Marco Govoni's avatar
Marco Govoni committed
38
  USE mp_world,               ONLY : mpime, root
39
  USE types_bz_grid,          ONLY : k_grid, q_grid
Marco Govoni's avatar
Marco Govoni committed
40
41
42
  !
  IMPLICIT NONE
  !
Marco Govoni's avatar
Marco Govoni committed
43
44
  TYPE(json_file) :: json
  INTEGER :: iunit
Marco Govoni's avatar
Marco Govoni committed
45
  INTEGER :: auxi,ib
Marco Govoni's avatar
Marco Govoni committed
46
  INTEGER :: ipol,ik,iq,npwx_g, nkbl, nkl, nkr, iks, ike, spin, ip, is
Marco Govoni's avatar
Marco Govoni committed
47
  INTEGER,ALLOCATABLE :: ngm_i(:), npw_i(:) 
Marco Govoni's avatar
Marco Govoni committed
48
  INTEGER, ALLOCATABLE :: ngk_g(:)
49
!  REAL(DP) :: xkg(3)
Marco Govoni's avatar
Marco Govoni committed
50
  REAL(DP) :: alat
51
  CHARACTER(LEN=6) :: cik, ciq, cip
Marco Govoni's avatar
Marco Govoni committed
52
53
54
55
56
57
58
  !
  CALL start_clock('do_setup')
  !
  ! INIT PW
  !
  CALL init_pw_arrays(nbnd)
  !
Marco Govoni's avatar
Marco Govoni committed
59
  CALL set_dirs()
Marco Govoni's avatar
Marco Govoni committed
60
  !
61
  ! INIT K, Q GRIDS
62
63
64
  !
  CALL k_grid%init('K')
  !
65
66
  CALL q_grid%init('Q')
  !
67
68
  CALL set_iks_l2g()
  !
69
  IF ( ANY ( (q_grid%ngrid(:) - k_grid%ngrid(:)) /= 0   ) ) THEN
70
     CALL errore( 'do_setup','q-point grid must be the same as k-point grid ',1)
71
72
  ENDIF
  !
Marco Govoni's avatar
Marco Govoni committed
73
74
  IF( mpime == root ) THEN 
     CALL json%initialize()
Victor Yu's avatar
Victor Yu committed
75
     CALL json%load(filename=TRIM(logfile))
Marco Govoni's avatar
Marco Govoni committed
76
77
  ENDIF
  !
Marco Govoni's avatar
Marco Govoni committed
78
79
80
  IF ( lsda ) THEN
     IF ( INT( nelup ) == 0 .AND. INT( neldw ) == 0 ) THEN
     !IF ( .NOT. two_fermi_energies ) THEN
81
        DO iks = 1, k_grid%nps
Marco Govoni's avatar
Marco Govoni committed
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
           spin = isk(iks)
           !
           SELECT CASE(spin)
           CASE(1)
              nelup = SUM( f_inp(:,1) )
           CASE(2)
              neldw = SUM( f_inp(:,2) )
           END SELECT
           !
        ENDDO
     ENDIF
     IF ( INT( nelup ) == 0 .AND. INT( neldw ) == 0 ) THEN
        CALL errore( 'do_setup','nelup = 0 and neldw = 0 ',1)
     ENDIF
  ENDIF
  !
  ! SYSTEM OVERVIEW
  !
Marco Govoni's avatar
Marco Govoni committed
100
101
102
103
104
105
106
107
108
109
110
111
112
113
  ALLOCATE( npw_i(0:nproc_bgrp-1), ngm_i(0:nproc_bgrp-1) )
  npw_i = 0 
  ngm_i = 0
  npw_i(me_bgrp) = npw
  ngm_i(me_bgrp) = ngm
  CALL mp_sum( npw_i, intra_bgrp_comm ) 
  CALL mp_sum( ngm_i, intra_bgrp_comm ) 
  IF( mpime == root ) THEN
     DO ip = 0, nproc_bgrp-1 
        WRITE(cip,'(i6)') ip+1
        CALL json%add('system.basis.npw.proc('//TRIM(ADJUSTL(cip))//')',npw_i(ip))
        CALL json%add('system.basis.ngm.proc('//TRIM(ADJUSTL(cip))//')',ngm_i(ip))
        CALL json%add('system.basis.npw.min',MINVAL(npw_i(:)))
        CALL json%add('system.basis.npw.max',MAXVAL(npw_i(:)))
Marco Govoni's avatar
Marco Govoni committed
114
        CALL json%add('system.basis.npw.sum',SUM(npw_i(:)))
Marco Govoni's avatar
Marco Govoni committed
115
116
        CALL json%add('system.basis.ngm.min',MINVAL(ngm_i(:)))
        CALL json%add('system.basis.ngm.max',MAXVAL(ngm_i(:)))
Marco Govoni's avatar
Marco Govoni committed
117
        CALL json%add('system.basis.ngm.sum',SUM(ngm_i(:)))
Marco Govoni's avatar
Marco Govoni committed
118
119
120
121
     ENDDO
  ENDIF
  DEALLOCATE( npw_i, ngm_i ) 
  !
Marco Govoni's avatar
Marco Govoni committed
122
123
  CALL io_push_title('System Overview')
  CALL io_push_value('gamma_only',gamma_only,20)
Marco Govoni's avatar
Marco Govoni committed
124
  IF( mpime == root ) CALL json%add('system.basis.gamma_only',gamma_only)
Marco Govoni's avatar
Marco Govoni committed
125
  CALL io_push_value('ecutwfc [Ry]',ecutwfc,20)
Marco Govoni's avatar
Marco Govoni committed
126
  IF( mpime == root ) CALL json%add('system.basis.ecutwfc:ry',ecutwfc)
Marco Govoni's avatar
Marco Govoni committed
127
128
  CALL io_push_value('ecutrho [Ry]',ecutrho,20)
  IF( mpime == root ) CALL json%add('system.basis.ecutrho:ry',ecutrho)
Marco Govoni's avatar
Marco Govoni committed
129
  CALL io_push_es0('omega [au^3]',omega,20)
Marco Govoni's avatar
Marco Govoni committed
130
131
  IF( mpime == root ) CALL json%add('system.cell.units','a.u.')
  IF( mpime == root ) CALL json%add('system.cell.omega',omega)
Marco Govoni's avatar
Marco Govoni committed
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
! IF ( gamma_only ) THEN
!    auxi = npw
!    CALL mp_sum(auxi,intra_bgrp_comm)
!    CALL io_push_value('glob. #G',auxi,20)
!    IF( mpime == root ) CALL json%add('system.basis.globg',auxi)
! ELSE
!    ALLOCATE( ngk_g(nkstot) )
!    !npool = nproc_image / nproc_pool
!    nkbl = nkstot / kunit
!    nkl = kunit * ( nkbl / npool )
!    nkr = ( nkstot - nkl * npool ) / kunit
!    IF ( my_pool_id < nkr ) nkl = nkl + kunit
!    iks = nkl*my_pool_id + 1
!    IF ( my_pool_id >= nkr ) iks = iks + nkr*kunit
!    ike = iks + nkl - 1
!    ngk_g = 0
!    ngk_g(iks:ike) = ngk(1:nks)
!    CALL mp_sum( ngk_g, inter_pool_comm )
!    CALL mp_sum( ngk_g, intra_pool_comm )
!    ngk_g = ngk_g / nbgrp
!    npwx_g = MAXVAL( ngk_g(1:nkstot) )
!    CALL io_push_value('glob. #PW',npwx_g,20)
!    IF( mpime == root ) CALL json%add('system.basis.globpw',npwx_g)
!    DEALLOCATE( ngk_g )
! ENDIF
Marco Govoni's avatar
Marco Govoni committed
157
  CALL io_push_value('nbnd',nbnd,20)
Marco Govoni's avatar
Marco Govoni committed
158
  IF( mpime == root ) CALL json%add('system.electron.nbnd',nbnd)
Marco Govoni's avatar
Marco Govoni committed
159
  CALL io_push_value('nkstot',nkstot,20)
Marco Govoni's avatar
Marco Govoni committed
160
  IF( mpime == root ) CALL json%add('system.electron.nkstot',nkstot)
Marco Govoni's avatar
Marco Govoni committed
161
  CALL io_push_value('nspin',nspin,20)
Marco Govoni's avatar
Marco Govoni committed
162
  IF( mpime == root ) CALL json%add('system.electron.nspin',nspin)
Marco Govoni's avatar
Marco Govoni committed
163
  CALL io_push_value('nelec',nelec,20)
Marco Govoni's avatar
Marco Govoni committed
164
  IF( mpime == root ) CALL json%add('system.electron.nelec',nelec)
Marco Govoni's avatar
Marco Govoni committed
165
166
  IF(nspin == 2) THEN
     CALL io_push_value('nelup',nelup,20)
Marco Govoni's avatar
Marco Govoni committed
167
     IF( mpime == root ) CALL json%add('system.electron.nelup',nelup)
Marco Govoni's avatar
Marco Govoni committed
168
     CALL io_push_value('neldw',neldw,20)
Marco Govoni's avatar
Marco Govoni committed
169
     IF( mpime == root ) CALL json%add('system.electron.neldw',neldw)
Marco Govoni's avatar
Marco Govoni committed
170
171
  ENDIF
  CALL io_push_value('npol',npol,20)
Marco Govoni's avatar
Marco Govoni committed
172
  IF( mpime == root ) CALL json%add('system.electron.npol',npol)
Marco Govoni's avatar
Marco Govoni committed
173
  CALL io_push_value('lsda',lsda,20)
Marco Govoni's avatar
Marco Govoni committed
174
  IF( mpime == root ) CALL json%add('system.electron.lsda',lsda)
Marco Govoni's avatar
Marco Govoni committed
175
  CALL io_push_value('noncolin',noncolin,20)
Marco Govoni's avatar
Marco Govoni committed
176
  IF( mpime == root ) CALL json%add('system.electron.noncolin',noncolin)
Marco Govoni's avatar
Marco Govoni committed
177
  CALL io_push_value('lspinorb',lspinorb,20)
Marco Govoni's avatar
Marco Govoni committed
178
  IF( mpime == root ) CALL json%add('system.electron.lspinorb',lspinorb)
Marco Govoni's avatar
Marco Govoni committed
179
  CALL io_push_value('domag',domag,20)
Marco Govoni's avatar
Marco Govoni committed
180
  IF( mpime == root ) CALL json%add('system.electron.domag',domag)
Marco Govoni's avatar
Marco Govoni committed
181
182
183
184
  CALL io_push_bar
  !
  alat = celldm(1)
  !
Marco Govoni's avatar
Marco Govoni committed
185
186
187
188
189
190
191
192
193
194
195
  WRITE( stdout, '(/5x,"3DFFT grid")') 
  WRITE( stdout, '( 8x,"s : (",i4,",",i4,",",i4,")")') dffts%nr1, dffts%nr2, dffts%nr3
  WRITE( stdout, '( 8x,"p : (",i4,",",i4,",",i4,")")') dfftp%nr1, dfftp%nr2, dfftp%nr3
  WRITE( stdout, '(/5x,"Direct Lattice Cell [a.u.]")') 
  WRITE( stdout, '( 8x,"a1 = (",3f14.7,")")') alat*at(1:3,1)
  WRITE( stdout, '( 8x,"a2 = (",3f14.7,")")') alat*at(1:3,2)
  WRITE( stdout, '( 8x,"a3 = (",3f14.7,")")') alat*at(1:3,3)
  WRITE( stdout, '(/5x,"Reciprocal Lattice Cell [a.u.]")')
  WRITE( stdout, '( 8x,"b1 = (",3f14.7,")")') tpiba*bg(1:3,1)
  WRITE( stdout, '( 8x,"b2 = (",3f14.7,")")') tpiba*bg(1:3,2)
  WRITE( stdout, '( 8x,"b3 = (",3f14.7,")")') tpiba*bg(1:3,3)
Marco Govoni's avatar
Marco Govoni committed
196
  WRITE( stdout, '( 5x," ")')
Marco Govoni's avatar
Marco Govoni committed
197
  IF( mpime == root ) THEN 
Marco Govoni's avatar
Marco Govoni committed
198
199
     CALL json%add('system.3dfft.s',(/ dffts%nr1, dffts%nr2, dffts%nr3 /) )
     CALL json%add('system.3dfft.p',(/ dfftp%nr1, dfftp%nr2, dfftp%nr3 /) )
Marco Govoni's avatar
Marco Govoni committed
200
201
202
     CALL json%add('system.cell.a1',alat*at(1:3,1))
     CALL json%add('system.cell.a2',alat*at(1:3,2))
     CALL json%add('system.cell.a3',alat*at(1:3,3))
Marco Govoni's avatar
Marco Govoni committed
203
204
205
     CALL json%add('system.cell.b1',tpiba*bg(1:3,1))
     CALL json%add('system.cell.b2',tpiba*bg(1:3,2))
     CALL json%add('system.cell.b3',tpiba*bg(1:3,3))
Marco Govoni's avatar
Marco Govoni committed
206
     CALL json%add('system.cell.alat',alat)
Marco Govoni's avatar
Marco Govoni committed
207
     CALL json%add('system.cell.tpiba',tpiba)
Marco Govoni's avatar
Marco Govoni committed
208
  ENDIF
Marco Govoni's avatar
Marco Govoni committed
209
  !
Marco Govoni's avatar
Marco Govoni committed
210
211
212
  WRITE( stdout, '(/5x,"Brillouin Zone sampling [cryst. coord.]")') 
  WRITE( stdout, * ) 
  DO ik = 1, k_grid%np
213
     WRITE( cik, '(i6)') ik
Marco Govoni's avatar
Marco Govoni committed
214
215
216
217
218
     WRITE( stdout, '(8x,"k(",i6.6,") = (",3f14.7,")")') ik, k_grid%p_cryst(1:3,ik) 
     IF( mpime == root ) THEN
        CALL json%add('system.bzsamp.k('//TRIM(ADJUSTL(cik))//').id',ik)
        CALL json%add('system.bzsamp.k('//TRIM(ADJUSTL(cik))//').crystcoord',k_grid%p_cryst(1:3,ik))
     ENDIF
Marco Govoni's avatar
Marco Govoni committed
219
  ENDDO
220
221
222
223
  !
  ! q-point grid
  !
  IF (.NOT. gamma_only ) THEN
Marco Govoni's avatar
Marco Govoni committed
224
     WRITE( stdout, * ) 
225
     DO iq = 1, q_grid%np
226
        WRITE( ciq, '(i6)') iq
Marco Govoni's avatar
Marco Govoni committed
227
228
229
230
231
        WRITE( stdout, '(8x,"q(",i6.6,") = (",3f14.7,")")') iq, q_grid%p_cryst(1:3,iq) 
        IF( mpime == root ) THEN 
           CALL json%add('system.bzsamp.q('//TRIM(ADJUSTL(ciq))//').id',iq)
           CALL json%add('system.bzsamp.q('//TRIM(ADJUSTL(ciq))//').crystcoord',q_grid%p_cryst(1:3,iq))
        ENDIF
232
233
234
     ENDDO
  ENDIF
  !
Marco Govoni's avatar
Marco Govoni committed
235
  !
Marco Govoni's avatar
Marco Govoni committed
236
237
  IF( mpime == root ) THEN
     OPEN( NEWUNIT=iunit, FILE=TRIM(logfile) )
Victor Yu's avatar
Victor Yu committed
238
     CALL json%print( iunit )
Marco Govoni's avatar
Marco Govoni committed
239
240
241
242
     CLOSE( iunit )
     CALL json%destroy()
  ENDIF 
  !
243
  !
Marco Govoni's avatar
Marco Govoni committed
244
245
246
  CALL stop_clock('do_setup')
  !
END SUBROUTINE