Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
west-public
West
Commits
cc24e388
Commit
cc24e388
authored
Aug 08, 2018
by
Marco Govoni
Browse files
Bug fix
parent
dd3a25df
Changes
4
Show whitespace changes
Inline
Side-by-side
FFT_kernel/fft_interpolation.f90
View file @
cc24e388
...
...
@@ -108,7 +108,7 @@ MODULE fourier_interpolation
! ng = actual number of PW
! ngx = leading dimendion for fg
! ndim = 1, 2
! fr = ONE COMPLEX array containing ONE function in R space (note that the array is not distributed, i.e. dimension = n1*n2*n3 )
! fr = ONE COMPLEX array containing ONE function in R space (note that the array is not distributed, i.e. dimension = n1*n2*n3 )
DESTROYED
! nl = pre-computed mapping from G to R space (i,e. from [1,n] to [1, n1*n2*n3] )
! OUTPUT : fg = ONE COMPLEX array containing ONE functions in G space (note that the array is distributed )
!
...
...
@@ -121,7 +121,7 @@ MODULE fourier_interpolation
!
INTEGER
,
INTENT
(
IN
)
::
n1
,
n2
,
n3
,
ng
,
ngx
,
ndim
INTEGER
,
INTENT
(
IN
)
::
nl
(
ngx
,
ndim
)
COMPLEX
(
DP
),
INTENT
(
IN
)
::
fr
(
n1
*
n2
*
n3
)
COMPLEX
(
DP
),
INTENT
(
IN
OUT
)
::
fr
(
n1
*
n2
*
n3
)
COMPLEX
(
DP
),
INTENT
(
OUT
)
::
fg
(
ngx
)
INTEGER
,
INTENT
(
IN
),
OPTIONAL
::
igk
(
ng
)
!
...
...
IO_kernel/function3d.f90
View file @
cc24e388
...
...
@@ -54,10 +54,10 @@ MODULE function3d
ELSE
nmaps
=
1
ENDIF
ALLOCATE
(
nl
(
ng
,
nmaps
)
)
ALLOCATE
(
nl
(
ng
x
,
nmaps
)
)
CALL
get_G2R_mapping
(
nx
,
ny
,
nz
,
ng
,
ngx
,
nmaps
,
nl
)
ALLOCATE
(
funct3d_r_complex
(
nx
*
ny
*
nz
)
)
CALL
single_invfft_toArbitraryRGrid
(
funct3d_r_complex
,
nx
,
ny
,
nz
,
ng
,
ngx
,
n
dim
,
nl
,
funct3d_g
)
CALL
single_invfft_toArbitraryRGrid
(
funct3d_r_complex
,
nx
,
ny
,
nz
,
ng
,
ngx
,
n
maps
,
nl
,
funct3d_g
)
DEALLOCATE
(
nl
)
!
IF
(
me_bgrp
==
0
)
THEN
...
...
@@ -95,25 +95,25 @@ MODULE function3d
WRITE
(
iu
,
'(a)'
)
'<fpmd:function3d xmlns:fpmd="http://www.quantum-simulation.org/ns/fpmd/fpmd-1.0"'
WRITE
(
iu
,
'(a)'
)
'xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"'
WRITE
(
iu
,
'(a)'
)
'xsi:schemaLocation="http://www.quantum-simulation.org/ns/fpmd/fpmd-1.0 function3d.xsd"'
WRITE
(
iu
,
'(a)'
)
'name="delta_
rho
">'
WRITE
(
iu
,
'(a)'
)
'name="delta_
v
">'
DO
i
=
1
,
3
WRITE
(
lab
(
i
),
'(f14.6)'
)
celldm
(
1
)
*
at
(
i
,
1
)
ENDDO
WRITE
(
iu
,
'(a)'
)
'<domain a="'
,
TRIM
(
ADJUSTL
(
lab
(
1
)))
,
TRIM
(
ADJUSTL
(
lab
(
2
)))
,
TRIM
(
ADJUSTL
(
lab
(
3
)))
,
'"'
WRITE
(
iu
,
'(a)'
)
'<domain a="'
//
TRIM
(
ADJUSTL
(
lab
(
1
)))
//
" "
//
TRIM
(
ADJUSTL
(
lab
(
2
)))
//
" "
//
TRIM
(
ADJUSTL
(
lab
(
3
)))
//
'"'
DO
i
=
1
,
3
WRITE
(
lab
(
i
),
'(f14.6)'
)
celldm
(
1
)
*
at
(
i
,
2
)
ENDDO
WRITE
(
iu
,
'(a)'
)
'b="'
,
TRIM
(
ADJUSTL
(
lab
(
1
)))
,
TRIM
(
ADJUSTL
(
lab
(
2
)))
,
TRIM
(
ADJUSTL
(
lab
(
3
)))
,
'"'
WRITE
(
iu
,
'(a)'
)
'b="'
//
TRIM
(
ADJUSTL
(
lab
(
1
)))
//
" "
//
TRIM
(
ADJUSTL
(
lab
(
2
)))
//
" "
//
TRIM
(
ADJUSTL
(
lab
(
3
)))
//
'"'
DO
i
=
1
,
3
WRITE
(
lab
(
i
),
'(f14.6)'
)
celldm
(
1
)
*
at
(
i
,
3
)
ENDDO
WRITE
(
iu
,
'(a)'
)
'c="'
,
TRIM
(
ADJUSTL
(
lab
(
1
)))
,
TRIM
(
ADJUSTL
(
lab
(
2
)))
,
TRIM
(
ADJUSTL
(
lab
(
3
)))
,
'"/>'
WRITE
(
iu
,
'(a)'
)
'c="'
//
TRIM
(
ADJUSTL
(
lab
(
1
)))
//
" "
//
TRIM
(
ADJUSTL
(
lab
(
2
)))
//
" "
//
TRIM
(
ADJUSTL
(
lab
(
3
)))
//
'"/>'
WRITE
(
lab
(
1
),
'(i14)'
)
nx
WRITE
(
lab
(
2
),
'(i14)'
)
ny
WRITE
(
lab
(
3
),
'(i14)'
)
nz
WRITE
(
iu
,
'(a)'
)
'<grid nx="'
,
TRIM
(
ADJUSTL
(
lab
(
1
)))
,
'" ny="'
,
TRIM
(
ADJUSTL
(
lab
(
2
)))
,
'" nz="'
,
TRIM
(
ADJUSTL
(
lab
(
3
)))
,
'"/>'
WRITE
(
iu
,
'(a)'
)
'<grid_function type="'
,
ctype
,
'" nx="'
,
TRIM
(
ADJUSTL
(
lab
(
1
)))
,
'" ny="'
,
TRIM
(
ADJUSTL
(
lab
(
2
)))
,
&
&
'" nz="'
,
TRIM
(
ADJUSTL
(
lab
(
3
)))
,
'" encoding="base64">'
WRITE
(
iu
,
'(a)'
)
'<grid nx="'
//
TRIM
(
ADJUSTL
(
lab
(
1
)))
//
'" ny="'
//
TRIM
(
ADJUSTL
(
lab
(
2
)))
//
'" nz="'
//
TRIM
(
ADJUSTL
(
lab
(
3
)))
//
'"/>'
WRITE
(
iu
,
'(a)'
)
'<grid_function type="'
//
ctype
//
'" nx="'
//
TRIM
(
ADJUSTL
(
lab
(
1
)))
//
'" ny="'
//
TRIM
(
ADJUSTL
(
lab
(
2
)))
//
&
&
'" nz="'
//
TRIM
(
ADJUSTL
(
lab
(
3
)))
//
'" encoding="base64">'
CALL
write_long_string
(
iu
,
charbase64
)
WRITE
(
iu
,
'(a)'
)
'</grid_function>'
WRITE
(
iu
,
'(a)'
)
'</fpmd:function3d>'
...
...
@@ -135,7 +135,8 @@ MODULE function3d
!
USE
kinds
,
ONLY
:
DP
USE
control_flags
,
ONLY
:
gamma_only
USE
mp_bands
,
ONLY
:
me_bgrp
USE
mp
,
ONLY
:
mp_bcast
USE
mp_bands
,
ONLY
:
me_bgrp
,
intra_bgrp_comm
USE
base64_module
USE
fourier_interpolation
!
...
...
@@ -216,7 +217,7 @@ MODULE function3d
CASE
DEFAULT
END
SELECT
nlen
=
lenbase64
(
nbytes
)
ALLOCATE
(
CHARACTER
(
LEN
=
nlen
)
::
charbase64
)
charbase64
=
""
!
DO
READ
(
iu
,
'(a)'
,
IOSTAT
=
ios
)
buffline
...
...
@@ -225,11 +226,7 @@ MODULE function3d
lstop
=
.TRUE.
EXIT
ENDIF
IF
(
.NOT.
ALLOCATED
(
charbase64
))
THEN
charbase64
=
TRIM
(
buffline
)
ELSE
charbase64
=
charbase64
//
TRIM
(
buffline
)
ENDIF
ENDDO
ELSE
CALL
errore
(
""
,
"Could not start tag"
,
1
)
...
...
@@ -260,6 +257,12 @@ MODULE function3d
!
ENDIF
!
CALL
mp_bcast
(
ndim
,
0
,
intra_bgrp_comm
)
CALL
mp_bcast
(
nx
,
0
,
intra_bgrp_comm
)
CALL
mp_bcast
(
ny
,
0
,
intra_bgrp_comm
)
CALL
mp_bcast
(
nz
,
0
,
intra_bgrp_comm
)
IF
(
.NOT.
ALLOCATED
(
funct3d_r_complex
))
ALLOCATE
(
funct3d_r_complex
(
1
:
ndim
)
)
!
! 1) F interpolate funct3_r --> funct3d_g
!
IF
(
gamma_only
)
THEN
...
...
@@ -267,9 +270,9 @@ MODULE function3d
ELSE
nmaps
=
1
ENDIF
ALLOCATE
(
nl
(
ng
,
nmaps
)
)
ALLOCATE
(
nl
(
ng
x
,
nmaps
)
)
CALL
get_G2R_mapping
(
nx
,
ny
,
nz
,
ng
,
ngx
,
nmaps
,
nl
)
CALL
single_fwfft_fromArbitraryRGrid
(
funct3d_r_complex
,
nx
,
ny
,
nz
,
ng
,
ngx
,
n
dim
,
nl
,
funct3d_g
)
CALL
single_fwfft_fromArbitraryRGrid
(
funct3d_r_complex
,
nx
,
ny
,
nz
,
ng
,
ngx
,
n
maps
,
nl
,
funct3d_g
)
DEALLOCATE
(
nl
)
DEALLOCATE
(
funct3d_r_complex
)
!
...
...
@@ -297,7 +300,7 @@ MODULE function3d
nlines
=
thislen
/
maxlen
IF
(
MOD
(
thislen
,
maxlen
)
>
0
)
nlines
=
nlines
+
1
DO
j
=
1
,
nlines
WRITE
(
iu
,
'(a)'
)
longstring
((
j
-1
)
*
maxlen
+1
:
MIN
(
(
j
)
*
maxlen
,
thislen
))
WRITE
(
iu
,
'(a)'
)
longstring
((
j
-1
)
*
maxlen
+1
:
MIN
(
j
*
maxlen
,
thislen
))
ENDDO
!
END
SUBROUTINE
...
...
Modules/west_version.f90
deleted
100644 → 0
View file @
dd3a25df
!
! Copyright (C) 2015-2017 M. Govoni
! 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 .
!
! Contributors to this file:
! Marco Govoni
!
!-----------------------------------------------------------------------
MODULE
west_version
!-----------------------------------------------------------------------
!
IMPLICIT
NONE
!
SAVE
!
CHARACTER
(
LEN
=
6
)
::
west_version_number
=
'3.1.0'
CHARACTER
(
LEN
=
12
)
::
west_svn_revision
=
'unknown'
!
END
MODULE
Wstat/wstat.f90
View file @
cc24e388
...
...
@@ -49,13 +49,15 @@ PROGRAM wstat
!PRINT*, npw, npwx
PRINT
*
,
evc
(
1
:
100
,
3
)
!
!CALL write_function3d( 'wfcl.f3d', 30, 30, 30, npw, npwx, evc(:, 3))
CALL
write_function3d
(
'wfcl.f3d'
,
30
,
30
,
30
,
npw
,
npwx
,
evc
(:,
3
))
PRINT
*
,
"WRITE FINISHED"
!
CALL
read_function3d
(
'wfcl.f3d'
,
nx
,
ny
,
nz
,
npw
,
npwx
,
evc
(:,
3
))
PRINT
*
,
"READ FINISHED"
PRINT
*
,
nx
,
ny
,
nz
PRINT
*
,
evc
(
1
:
100
,
3
)
!
RETURN
STOP
!
CALL
davidson_diago
(
)
!
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment