Commit cc24e388 authored by Marco Govoni's avatar Marco Govoni
Browse files

Bug fix

parent dd3a25df
...@@ -108,7 +108,7 @@ MODULE fourier_interpolation ...@@ -108,7 +108,7 @@ MODULE fourier_interpolation
! ng = actual number of PW ! ng = actual number of PW
! ngx = leading dimendion for fg ! ngx = leading dimendion for fg
! ndim = 1, 2 ! 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] ) ! 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 ) ! OUTPUT : fg = ONE COMPLEX array containing ONE functions in G space (note that the array is distributed )
! !
...@@ -121,7 +121,7 @@ MODULE fourier_interpolation ...@@ -121,7 +121,7 @@ MODULE fourier_interpolation
! !
INTEGER, INTENT(IN) :: n1, n2, n3, ng, ngx, ndim INTEGER, INTENT(IN) :: n1, n2, n3, ng, ngx, ndim
INTEGER, INTENT(IN) :: nl(ngx,ndim) INTEGER, INTENT(IN) :: nl(ngx,ndim)
COMPLEX(DP), INTENT(IN) :: fr(n1*n2*n3) COMPLEX(DP), INTENT(INOUT) :: fr(n1*n2*n3)
COMPLEX(DP), INTENT(OUT) :: fg(ngx) COMPLEX(DP), INTENT(OUT) :: fg(ngx)
INTEGER, INTENT(IN), OPTIONAL :: igk(ng) INTEGER, INTENT(IN), OPTIONAL :: igk(ng)
! !
......
...@@ -54,10 +54,10 @@ MODULE function3d ...@@ -54,10 +54,10 @@ MODULE function3d
ELSE ELSE
nmaps = 1 nmaps = 1
ENDIF ENDIF
ALLOCATE( nl(ng,nmaps) ) ALLOCATE( nl(ngx,nmaps) )
CALL get_G2R_mapping (nx, ny, nz, ng, ngx, nmaps, nl) CALL get_G2R_mapping (nx, ny, nz, ng, ngx, nmaps, nl)
ALLOCATE( funct3d_r_complex(nx*ny*nz) ) ALLOCATE( funct3d_r_complex(nx*ny*nz) )
CALL single_invfft_toArbitraryRGrid (funct3d_r_complex, nx, ny, nz, ng, ngx, ndim, nl, funct3d_g) CALL single_invfft_toArbitraryRGrid (funct3d_r_complex, nx, ny, nz, ng, ngx, nmaps, nl, funct3d_g)
DEALLOCATE( nl ) DEALLOCATE( nl )
! !
IF( me_bgrp == 0 ) THEN IF( me_bgrp == 0 ) THEN
...@@ -95,25 +95,25 @@ MODULE function3d ...@@ -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)') '<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)') '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)') '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 DO i = 1, 3
WRITE(lab(i),'(f14.6)') celldm(1) * at(i,1) WRITE(lab(i),'(f14.6)') celldm(1) * at(i,1)
ENDDO 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 DO i = 1, 3
WRITE(lab(i),'(f14.6)') celldm(1) * at(i,2) WRITE(lab(i),'(f14.6)') celldm(1) * at(i,2)
ENDDO 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 DO i = 1, 3
WRITE(lab(i),'(f14.6)') celldm(1) * at(i,3) WRITE(lab(i),'(f14.6)') celldm(1) * at(i,3)
ENDDO 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(1),'(i14)') nx
WRITE(lab(2),'(i14)') ny WRITE(lab(2),'(i14)') ny
WRITE(lab(3),'(i14)') nz 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 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))), & WRITE(iu,'(a)') '<grid_function type="'//ctype//'" nx="'//TRIM(ADJUSTL(lab(1)))//'" ny="'//TRIM(ADJUSTL(lab(2)))// &
&'" nz="',TRIM(ADJUSTL(lab(3))),'" encoding="base64">' &'" nz="'//TRIM(ADJUSTL(lab(3)))//'" encoding="base64">'
CALL write_long_string(iu,charbase64) CALL write_long_string(iu,charbase64)
WRITE(iu,'(a)') '</grid_function>' WRITE(iu,'(a)') '</grid_function>'
WRITE(iu,'(a)') '</fpmd:function3d>' WRITE(iu,'(a)') '</fpmd:function3d>'
...@@ -135,7 +135,8 @@ MODULE function3d ...@@ -135,7 +135,8 @@ MODULE function3d
! !
USE kinds, ONLY : DP USE kinds, ONLY : DP
USE control_flags, ONLY : gamma_only 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 base64_module
USE fourier_interpolation USE fourier_interpolation
! !
...@@ -216,7 +217,7 @@ MODULE function3d ...@@ -216,7 +217,7 @@ MODULE function3d
CASE DEFAULT CASE DEFAULT
END SELECT END SELECT
nlen = lenbase64(nbytes) nlen = lenbase64(nbytes)
ALLOCATE(CHARACTER(LEN=nlen) :: charbase64) charbase64=""
! !
DO DO
READ(iu,'(a)',IOSTAT=ios) buffline READ(iu,'(a)',IOSTAT=ios) buffline
...@@ -225,11 +226,7 @@ MODULE function3d ...@@ -225,11 +226,7 @@ MODULE function3d
lstop = .TRUE. lstop = .TRUE.
EXIT EXIT
ENDIF ENDIF
IF( .NOT. ALLOCATED( charbase64 )) THEN charbase64 = charbase64 // TRIM( buffline )
charbase64 = TRIM( buffline )
ELSE
charbase64 = charbase64 // TRIM( buffline )
ENDIF
ENDDO ENDDO
ELSE ELSE
CALL errore("","Could not start tag",1) CALL errore("","Could not start tag",1)
...@@ -258,7 +255,13 @@ MODULE function3d ...@@ -258,7 +255,13 @@ MODULE function3d
CASE DEFAULT CASE DEFAULT
END SELECT END SELECT
! !
ENDIF 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 ! 1) F interpolate funct3_r --> funct3d_g
! !
...@@ -267,9 +270,9 @@ MODULE function3d ...@@ -267,9 +270,9 @@ MODULE function3d
ELSE ELSE
nmaps = 1 nmaps = 1
ENDIF ENDIF
ALLOCATE( nl(ng,nmaps) ) ALLOCATE( nl(ngx,nmaps) )
CALL get_G2R_mapping (nx, ny, nz, ng, ngx, nmaps, nl) CALL get_G2R_mapping (nx, ny, nz, ng, ngx, nmaps, nl)
CALL single_fwfft_fromArbitraryRGrid (funct3d_r_complex, nx, ny, nz, ng, ngx, ndim, nl, funct3d_g) CALL single_fwfft_fromArbitraryRGrid (funct3d_r_complex, nx, ny, nz, ng, ngx, nmaps, nl, funct3d_g)
DEALLOCATE( nl ) DEALLOCATE( nl )
DEALLOCATE( funct3d_r_complex ) DEALLOCATE( funct3d_r_complex )
! !
...@@ -297,7 +300,7 @@ MODULE function3d ...@@ -297,7 +300,7 @@ MODULE function3d
nlines = thislen / maxlen nlines = thislen / maxlen
IF( MOD( thislen, maxlen ) > 0 ) nlines = nlines + 1 IF( MOD( thislen, maxlen ) > 0 ) nlines = nlines + 1
DO j = 1, nlines 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 ENDDO
! !
END SUBROUTINE END SUBROUTINE
......
!
! 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
...@@ -49,13 +49,15 @@ PROGRAM wstat ...@@ -49,13 +49,15 @@ PROGRAM wstat
!PRINT*, npw, npwx !PRINT*, npw, npwx
PRINT*, evc(1:100, 3) 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)) CALL read_function3d ( 'wfcl.f3d', nx, ny, nz, npw, npwx, evc(:, 3))
PRINT*, "READ FINISHED"
PRINT*, nx, ny, nz PRINT*, nx, ny, nz
PRINT*, evc(1:100, 3) PRINT*, evc(1:100, 3)
! !
RETURN STOP
! !
CALL davidson_diago ( ) CALL davidson_diago ( )
! !
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment