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

Bug fix

parent dd3a25df
......@@ -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(INOUT) :: fr(n1*n2*n3)
COMPLEX(DP), INTENT(OUT) :: fg(ngx)
INTEGER, INTENT(IN), OPTIONAL :: igk(ng)
!
......
......@@ -54,10 +54,10 @@ MODULE function3d
ELSE
nmaps = 1
ENDIF
ALLOCATE( nl(ng,nmaps) )
ALLOCATE( nl(ngx,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, ndim, nl, funct3d_g)
CALL single_invfft_toArbitraryRGrid (funct3d_r_complex, nx, ny, nz, ng, ngx, nmaps, 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
charbase64 = charbase64 // TRIM( buffline )
ENDDO
ELSE
CALL errore("","Could not start tag",1)
......@@ -258,7 +255,13 @@ MODULE function3d
CASE DEFAULT
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
!
......@@ -267,9 +270,9 @@ MODULE function3d
ELSE
nmaps = 1
ENDIF
ALLOCATE( nl(ng,nmaps) )
ALLOCATE( nl(ngx,nmaps) )
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( 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
......
!
! 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
!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 ( )
!
......
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