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

Merge branch 'kWest_review' into 'doc'

# Conflicts:
#   Tools/fetch_input.f90
parents 4766a73a 5e8ab8e3
......@@ -62,7 +62,7 @@ MODULE dfpt_module
!
! Workspace
!
INTEGER :: ipert, ig, ir, ibnd, iks, ikqs, ik, is
INTEGER :: ipert, ig, ir, ibnd, iks, ikqs, ikq, ik, is
INTEGER :: i, j, k
INTEGER :: nbndval, ierr
INTEGER :: npwkq
......@@ -145,7 +145,10 @@ MODULE dfpt_module
!
! ... Find G0 and compute phase
!
CALL k_grid%find( k_grid%p_cart(:,ik) - q_grid%p_cart(:,iq), is, 'cart', ikqs, g0 )
!CALL k_grid%find( k_grid%p_cart(:,ik) - q_grid%p_cart(:,iq), is, 'cart', ikqs, g0 ) !MATTEO
CALL k_grid%find( k_grid%p_cart(:,ik) - q_grid%p_cart(:,iq), 'cart', ikq, g0 ) !MARCO
ikqs = k_grid%ipis2ips(ikq,is) !MARCO
!
CALL compute_phase( g0, 'cart', phase )
!
! ... Number of G vectors for PW expansion of wfs at [k-q]
......
......@@ -50,13 +50,14 @@ MODULE wfreq_db
REAL(DP) :: time_spent(2)
CHARACTER(20),EXTERNAL :: human_readable_time
INTEGER :: iunout,global_j,local_j
INTEGER :: ierr, iks, ib
INTEGER :: ierr, iks, ik, is, ib
CHARACTER(LEN=6) :: my_label_k, my_label_b
!
TYPE(json_file) :: json
INTEGER :: iunit, i
INTEGER :: iunit, i, counter
INTEGER,ALLOCATABLE :: ilist(:)
LOGICAL :: l_generate_plot, l_optics
CHARACTER(LEN=10) :: ccounter
!
! MPI BARRIER
!
......@@ -84,35 +85,60 @@ MODULE wfreq_db
DO ib = qp_bandrange(1),qp_bandrange(2)
ilist(ib) = ib
ENDDO
CALL json%add('output.Q.bandmap',ilist(qp_bandrange(1):qp_bandrange(2)))
!CALL json%add('output.Q.bandmap',ilist(qp_bandrange(1):qp_bandrange(2)))
DEALLOCATE(ilist)
IF( l_generate_plot ) CALL json%add('output.P.freqlist',sigma_freq(1:n_spectralf)*rytoev)
!
counter = 0
DO iks = 1, k_grid%nps
ik = k_grid%ip(iks)
is = k_grid%is(iks)
DO ib = qp_bandrange(1), qp_bandrange(2)
counter = counter + 1
WRITE( ccounter, '(i10)') counter
CALL json%add('output.Q('//TRIM(ADJUSTL(ccounter))//').ksb',(/ik,is,ib/))
CALL json%add('output.Q('//TRIM(ADJUSTL(ccounter))//').sigmax',sigma_exx(ib,iks)*rytoev)
CALL json%add('output.Q('//TRIM(ADJUSTL(ccounter))//').vxcl' ,sigma_vxcl(ib,iks)*rytoev)
CALL json%add('output.Q('//TRIM(ADJUSTL(ccounter))//').vxcnl' ,sigma_vxcnl(ib,iks)*rytoev)
CALL json%add('output.Q('//TRIM(ADJUSTL(ccounter))//').hf' ,sigma_hf(ib,iks)*rytoev)
CALL json%add('output.Q('//TRIM(ADJUSTL(ccounter))//').z' ,sigma_z(ib,iks)*rytoev)
CALL json%add('output.Q('//TRIM(ADJUSTL(ccounter))//').eks' ,et(ib,iks)*rytoev)
CALL json%add('output.Q('//TRIM(ADJUSTL(ccounter))//').eqpLin',sigma_eqplin(ib,iks)*rytoev)
CALL json%add('output.Q('//TRIM(ADJUSTL(ccounter))//').eqpSec',sigma_eqpsec(ib,iks)*rytoev)
CALL json%add('output.Q('//TRIM(ADJUSTL(ccounter))//').sigmac_eks',&
(/DBLE(sigma_sc_eks(ib,iks)*rytoev),AIMAG(sigma_sc_eks(ib,iks)*rytoev)/) )
CALL json%add('output.Q('//TRIM(ADJUSTL(ccounter))//').sigmac_eqpLin',&
(/DBLE(sigma_sc_eqplin(ib,iks)*rytoev),AIMAG(sigma_sc_eqplin(ib,iks)*rytoev)/) )
CALL json%add('output.Q('//TRIM(ADJUSTL(ccounter))//').sigmac_eqpSec',&
(/DBLE(sigma_sc_eqpsec(ib,iks)*rytoev),AIMAG(sigma_sc_eqpsec(ib,iks)*rytoev)/) )
ENDDO
ENDDO
!
DO iks = 1, k_grid%nps
!
WRITE(my_label_k,'(i6.6)') iks_l2g(iks)
!
CALL json%add('output.Q.K'//TRIM(my_label_k)//'.sigmax', sigma_exx(qp_bandrange(1):qp_bandrange(2),iks)*rytoev)
CALL json%add('output.Q.K'//TRIM(my_label_k)//'.vxcl', sigma_vxcl(qp_bandrange(1):qp_bandrange(2),iks)*rytoev)
CALL json%add('output.Q.K'//TRIM(my_label_k)//'.vxcnl', sigma_vxcnl(qp_bandrange(1):qp_bandrange(2),iks)*rytoev)
CALL json%add('output.Q.K'//TRIM(my_label_k)//'.hf', sigma_hf(qp_bandrange(1):qp_bandrange(2),iks)*rytoev)
CALL json%add('output.Q.K'//TRIM(my_label_k)//'.z', sigma_z(qp_bandrange(1):qp_bandrange(2),iks))
CALL json%add('output.Q.K'//TRIM(my_label_k)//'.eks', et(qp_bandrange(1):qp_bandrange(2),iks)*rytoev)
CALL json%add('output.Q.K'//TRIM(my_label_k)//'.eqpLin', sigma_eqplin(qp_bandrange(1):qp_bandrange(2),iks)*rytoev)
CALL json%add('output.Q.K'//TRIM(my_label_k)//'.eqpSec', sigma_eqpsec(qp_bandrange(1):qp_bandrange(2),iks)*rytoev)
CALL json%add('output.Q.K'//TRIM(my_label_k)//'.sigmac_eks.re', &
& DBLE(sigma_sc_eks(qp_bandrange(1):qp_bandrange(2),iks)*rytoev))
CALL json%add('output.Q.K'//TRIM(my_label_k)//'.sigmac_eks.im', &
& AIMAG(sigma_sc_eks(qp_bandrange(1):qp_bandrange(2),iks)*rytoev))
CALL json%add('output.Q.K'//TRIM(my_label_k)//'.sigmac_eqpLin.re', &
& DBLE(sigma_sc_eqplin(qp_bandrange(1):qp_bandrange(2),iks)*rytoev))
CALL json%add('output.Q.K'//TRIM(my_label_k)//'.sigmac_eqpLin.im', &
& AIMAG(sigma_sc_eqplin(qp_bandrange(1):qp_bandrange(2),iks)*rytoev))
CALL json%add('output.Q.K'//TRIM(my_label_k)//'.sigmac_eqpSec.re', &
& DBLE(sigma_sc_eqpsec(qp_bandrange(1):qp_bandrange(2),iks)*rytoev))
CALL json%add('output.Q.K'//TRIM(my_label_k)//'.sigmac_eqpSec.im', &
& AIMAG(sigma_sc_eqpsec(qp_bandrange(1):qp_bandrange(2),iks)*rytoev))
CALL json%add('output.Q.K'//TRIM(my_label_k)//'.sigma_diff', sigma_diff(qp_bandrange(1):qp_bandrange(2),iks)*rytoev)
! !
! CALL json%add('output.Q.K'//TRIM(my_label_k)//'.sigmax', sigma_exx(qp_bandrange(1):qp_bandrange(2),iks)*rytoev)
! CALL json%add('output.Q.K'//TRIM(my_label_k)//'.vxcl', sigma_vxcl(qp_bandrange(1):qp_bandrange(2),iks)*rytoev)
! CALL json%add('output.Q.K'//TRIM(my_label_k)//'.vxcnl', sigma_vxcnl(qp_bandrange(1):qp_bandrange(2),iks)*rytoev)
! CALL json%add('output.Q.K'//TRIM(my_label_k)//'.hf', sigma_hf(qp_bandrange(1):qp_bandrange(2),iks)*rytoev)
! CALL json%add('output.Q.K'//TRIM(my_label_k)//'.z', sigma_z(qp_bandrange(1):qp_bandrange(2),iks))
! CALL json%add('output.Q.K'//TRIM(my_label_k)//'.eks', et(qp_bandrange(1):qp_bandrange(2),iks)*rytoev)
! CALL json%add('output.Q.K'//TRIM(my_label_k)//'.eqpLin', sigma_eqplin(qp_bandrange(1):qp_bandrange(2),iks)*rytoev)
! CALL json%add('output.Q.K'//TRIM(my_label_k)//'.eqpSec', sigma_eqpsec(qp_bandrange(1):qp_bandrange(2),iks)*rytoev)
! CALL json%add('output.Q.K'//TRIM(my_label_k)//'.sigmac_eks.re', &
! & DBLE(sigma_sc_eks(qp_bandrange(1):qp_bandrange(2),iks)*rytoev))
! CALL json%add('output.Q.K'//TRIM(my_label_k)//'.sigmac_eks.im', &
! & AIMAG(sigma_sc_eks(qp_bandrange(1):qp_bandrange(2),iks)*rytoev))
! CALL json%add('output.Q.K'//TRIM(my_label_k)//'.sigmac_eqpLin.re', &
! & DBLE(sigma_sc_eqplin(qp_bandrange(1):qp_bandrange(2),iks)*rytoev))
! CALL json%add('output.Q.K'//TRIM(my_label_k)//'.sigmac_eqpLin.im', &
! & AIMAG(sigma_sc_eqplin(qp_bandrange(1):qp_bandrange(2),iks)*rytoev))
! CALL json%add('output.Q.K'//TRIM(my_label_k)//'.sigmac_eqpSec.re', &
! & DBLE(sigma_sc_eqpsec(qp_bandrange(1):qp_bandrange(2),iks)*rytoev))
! CALL json%add('output.Q.K'//TRIM(my_label_k)//'.sigmac_eqpSec.im', &
! & AIMAG(sigma_sc_eqpsec(qp_bandrange(1):qp_bandrange(2),iks)*rytoev))
! CALL json%add('output.Q.K'//TRIM(my_label_k)//'.sigma_diff', sigma_diff(qp_bandrange(1):qp_bandrange(2),iks)*rytoev)
!
IF( l_generate_plot ) THEN
DO ib = qp_bandrange(1), qp_bandrange(2)
......
==========================================
Based on the library: json-fortran v 6.3.0
==========================================
JSON-Fortran: A Fortran 2008 JSON API
<https://github.com/jacobwilliams/json-fortran>
Copyright (c) 2014-2018, Jacob Williams
All rights reserved.
Redistribution and use in source and binary forms, with or without modification,
are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above copyright notice, this
list of conditions and the following disclaimer in the documentation and/or
other materials provided with the distribution.
* The names of its contributors may not be used to endorse or promote products
derived from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR
ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
> -----------------------------------------------------------------------------------------
>
> Original FSON License:
>
> Copyright (c) 2012 Joseph A. Levin
>
> Permission is hereby granted, free of charge, to any person obtaining a copy of this
> software and associated documentation files (the "Software"), to deal in the Software
> without restriction, including without limitation the rights to use, copy, modify, merge,
> publish, distribute, sublicense, and/or sell copies of the Software, and to permit
> persons to whom the Software is furnished to do so, subject to the following conditions:
>
> The above copyright notice and this permission notice shall be included in all copies or
> substantial portions of the Software.
>
> THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED,
> INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
> PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
> LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT
> OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
> DEALINGS IN THE SOFTWARE.
>
> -----------------------------------------------------------------------------------------
......@@ -338,7 +338,9 @@
comment_char,&
path_mode,&
path_separator,&
compress_vectors)
compress_vectors,&
allow_duplicate_keys,&
escape_solidus)
implicit none
......@@ -355,7 +357,9 @@
comment_char,&
path_mode,&
path_separator,&
compress_vectors)
compress_vectors,&
allow_duplicate_keys,&
escape_solidus)
end subroutine initialize_json_core_in_file
!*****************************************************************************************
......@@ -419,7 +423,9 @@
comment_char,&
path_mode,&
path_separator,&
compress_vectors) result(file_object)
compress_vectors,&
allow_duplicate_keys,&
escape_solidus) result(file_object)
implicit none
......@@ -438,7 +444,9 @@
comment_char,&
path_mode,&
path_separator,&
compress_vectors)
compress_vectors,&
allow_duplicate_keys,&
escape_solidus)
if (present(p)) file_object%p => p
......@@ -1190,7 +1198,7 @@
! date: 12/17/2016
!
! Get an (allocatable length) string vector from a JSON file.
! This is just a wrapper for [[json_get_alloc_string_vec_with_path]].
! This is just a wrapper for [[json_get_alloc_string_vec_by_path]].
subroutine json_file_get_alloc_string_vec(me, path, vec, ilen, found)
......@@ -1212,7 +1220,7 @@
!*****************************************************************************************
!>
! Alternate version of [[json_file_get_alloc_string_vec]], where "path" is kind=CDK.
! This is just a wrapper for [[wrap_json_get_alloc_string_vec_with_path]].
! This is just a wrapper for [[wrap_json_get_alloc_string_vec_by_path]].
subroutine wrap_json_file_get_alloc_string_vec(me, path, vec, ilen, found)
......
......@@ -59,3 +59,18 @@ logical(LK),intent(in),optional :: compress_vectors
!! [Note: `no_whitespace` will
!! override this option if necessary].
!! (Default is False).
logical(LK),intent(in),optional :: allow_duplicate_keys
!! * If True [default] then no special checks
!! are done to check for duplicate keys.
!! * If False, then after parsing, if any duplicate
!! keys are found, an error is thrown. A call to
!! [[json_value_validate]] will also check for
!! duplicates.
logical(LK),intent(in),optional :: escape_solidus
!! * If True then the solidus "`/`" is always escaped
!! "`\/`" when serializing JSON
!! * If False [default], then it is not escaped.
!! Note that this option does not affect parsing
!! (both escaped and unescaped are still valid in
!! all cases).
......@@ -75,8 +75,8 @@
#elif REAL128
integer,parameter,public :: RK = real128 !! Default real kind [16 bytes]
#else
! integer,parameter,public :: RK = real64 !! Default real kind if not specified [8 bytes]
integer,parameter,public :: RK = selected_real_kind(14,200)
!integer,parameter,public :: RK = real64 !! Default real kind if not specified [8 bytes]
integer,parameter,public :: RK = selected_real_kind(14,200)
#endif
#ifdef INT8
......
......@@ -52,6 +52,7 @@
character(kind=CK,len=*),parameter :: dot = CK_'.' !! for [[json_get_by_path]]
character(kind=CK,len=*),parameter :: tilde = CK_'~' !! RFC 6901 escape character
character(kind=CK,len=*),parameter :: percent = CK_'%' !! Fortran path separator
character(kind=CK,len=*),parameter :: single_quote = CK_"'" !! for JSONPath bracket-notation
character(kind=CK,len=*),parameter :: bspace = achar(8, kind=CK)
character(kind=CK,len=*),parameter :: horizontal_tab = achar(9, kind=CK)
character(kind=CK,len=*),parameter :: newline = achar(10, kind=CK)
......
......@@ -126,7 +126,7 @@
! Compute how many digits we need to read
ndigits = 2*len_trim(str)
ndigits_digits = floor(log10(real(ndigits)))+1
!allocate(character(kind=CDK,len=ndigits_digits) :: digits) ! DOES NOT COMPILE ON BGQ
!allocate(character(kind=CDK,len=ndigits_digits) :: digits) DOES NOT COMPILE ON BGQ
allocate(character(len=ndigits_digits) :: digits)
write(digits,'(I0)') ndigits !gfortran will have a runtime error with * edit descriptor here
! gfortran bug: '*' edit descriptor for ISO_10646 strings does bad stuff.
......@@ -294,12 +294,14 @@
!
! Add the escape characters to a string for adding to JSON.
subroutine escape_string(str_in, str_out)
subroutine escape_string(str_in, str_out, escape_solidus)
implicit none
character(kind=CK,len=*),intent(in) :: str_in
character(kind=CK,len=:),allocatable,intent(out) :: str_out
logical(LK),intent(in) :: escape_solidus !! if the solidus (forward slash)
!! is also to be escaped
integer(IK) :: i !! counter
integer(IK) :: ipos !! accumulated string size
......@@ -309,20 +311,29 @@
#if defined __GFORTRAN__
character(kind=CK,len=:),allocatable :: tmp !! workaround for bug in gfortran 6.1
#endif
logical :: to_be_escaped !! if there are characters to be escaped
character(kind=CK,len=*),parameter :: specials = quotation_mark//&
character(kind=CK,len=*),parameter :: specials_no_slash = quotation_mark//&
backslash//&
slash//&
bspace//&
formfeed//&
newline//&
carriage_return//&
horizontal_tab
character(kind=CK,len=*),parameter :: specials = specials_no_slash//slash
!Do a quick scan for the special characters,
! if any are present, then process the string,
! otherwise, return the string as is.
if (scan(str_in,specials)>0) then
if (escape_solidus) then
to_be_escaped = scan(str_in,specials)>0
else
to_be_escaped = scan(str_in,specials_no_slash)>0
end if
if (to_be_escaped) then
str_out = repeat(space,chunk_size)
ipos = 1
......@@ -336,9 +347,33 @@
if (ipos+3>len(str_out)) str_out = str_out // repeat(space, chunk_size)
select case(c)
case(quotation_mark,backslash,slash)
case(backslash)
!test for unicode sequence: '\uXXXX'
![don't add an extra '\' for those]
if (i+5<=len(str_in)) then
if (str_in(i+1:i+1)==CK_'u' .and. &
valid_json_hex(str_in(i+2:i+5))) then
str_out(ipos:ipos) = c
ipos = ipos + 1
cycle
end if
end if
str_out(ipos:ipos+1) = backslash//c
ipos = ipos + 2
case(quotation_mark)
str_out(ipos:ipos+1) = backslash//c
ipos = ipos + 2
case(slash)
if (escape_solidus) then
str_out(ipos:ipos+1) = backslash//c
ipos = ipos + 2
else
str_out(ipos:ipos) = c
ipos = ipos + 1
end if
case(bspace)
str_out(ipos:ipos+1) = '\b'
ipos = ipos + 2
......@@ -388,18 +423,17 @@
!>
! Remove the escape characters from a JSON string and return it.
!
! The escaped characters are denoted by the '\' character:
!````
! '\"' quotation mark
! '\\' reverse solidus
! '\/' solidus
! '\b' backspace
! '\f' formfeed
! '\n' newline (LF)
! '\r' carriage return (CR)
! '\t' horizontal tab
! '\uXXXX' 4 hexadecimal digits
!````
! The escaped characters are denoted by the `\` character:
!
! * `\"` - quotation mark
! * `\\` - reverse solidus
! * `\/` - solidus
! * `\b` - backspace
! * `\f` - formfeed
! * `\n` - newline (LF)
! * `\r` - carriage return (CR)
! * `\t` - horizontal tab
! * `\uXXXX` - 4 hexadecimal digits
subroutine unescape_string(str_in, str_out, error_message)
......@@ -714,62 +748,38 @@
end function default_neq_ucs4
!*****************************************************************************************
!*****************************************************************************************
!> author: Jacob Williams
!
! Return the lowercase version of the `CK` character.
pure elemental function lowercase_character(c) result(c_lower)
implicit none
character(kind=CK,len=1),intent(in) :: c
character(kind=CK,len=1) :: c_lower
integer :: i !! index in uppercase array
i = index(upper,c)
c_lower = merge(lower(i:i),c,i>0)
end function lowercase_character
!*****************************************************************************************
!*****************************************************************************************
!> author: Jacob Williams
!
! Returns lowercase version of the `CK` string.
! !pure elemental function lowercase_string(str) result(s_lower) DOES NOT COMPILE ON BGQ
pure function lowercase_string(str) result(s_lower)
implicit none
!pure elemental function lowercase_string(str) result(s_lower) ! DOES NOT COMPILE ON BGQ
pure function lowercase_string(str) result(s_lower)
! !character(kind=CK,len=*),intent(in) :: str !! input string
! !character(kind=CK,len=(len(str))) :: s_lower !! lowercase version of the string
character(len=*),intent(in) :: str !! input string
character(len=(len(str))) :: s_lower !! lowercase version of the string
implicit none
integer :: i !! counter
integer :: n !! length of input string
!character(kind=CK,len=*),intent(in) :: str !! input string ! DOES NOT COMPILE ON BGQ
!character(kind=CK,len=(len(str))) :: s_lower !! lowercase version of the string !DOES NOT COMPILE ON BGQ
character(len=*),intent(in) :: str !! input string
character(len=(len(str))) :: s_lower !! lowercase version of the string
s_lower = CK_''
n = len_trim(str)
if (n>0) then
!do concurrent (i=1:n) DOES NOT COMPILE ON BGQ
do i=1,n
s_lower(i:i) = lowercase_character(str(i:i))
end do
end if
integer :: i !! counter
integer :: j !! index of uppercase character
end function lowercase_string
s_lower = str
do i = 1, len_trim(str)
j = index(upper,s_lower(i:i))
if (j>0) s_lower(i:i) = lower(j:j)
end do
end function lowercase_string
!*****************************************************************************************
!*****************************************************************************************
!>
! Replace all occurances of `s1` in `str` with `s2`.
! Replace all occurrences of `s1` in `str` with `s2`.
!
! A case-sensitive match is used.
!
......
This diff is collapsed.
......@@ -37,6 +37,7 @@ MODULE class_bz_grid
!
PROCEDURE :: init => k_or_q_grid_init
PROCEDURE :: find => findp
PROCEDURE :: ipis2ips => from_ip_and_is_to_ips ! MARCO
!
END TYPE bz_grid
!
......@@ -90,7 +91,8 @@ MODULE class_bz_grid
!
ALLOCATE ( this%p_cryst (3,this%np) )
this%p_cryst(:,:) = this%p_cart(:,:)
CALL cryst_to_cart( this%nps, this%p_cryst, at, -1 )
!CALL cryst_to_cart( this%nps, this%p_cryst, at, -1 ) !MATTEO
CALL cryst_to_cart( this%np, this%p_cryst, at, -1 ) !MARCO
!
! set weights
!
......@@ -168,7 +170,8 @@ MODULE class_bz_grid
!
!
!FUNCTION findp(this,p,unit_type) RESULT(ip)
SUBROUTINE findp( this, p, is, unit_type, ip, g0 )
!SUBROUTINE findp( this, p, is, unit_type, ip, g0 ) !MATTEO
SUBROUTINE findp( this, p, unit_type, ip, g0 ) !MARCO
!
! ... ip is the index of p (unit_type = [ "cryst", "cart"])
! ... if on exit ip == 0 --> p is not commensurate with this grid
......@@ -183,7 +186,7 @@ MODULE class_bz_grid
!
CLASS(bz_grid), INTENT(IN) :: this
REAL(DP), INTENT(IN) :: p(3)
INTEGER, INTENT(IN) :: is
!INTEGER, INTENT(IN) :: is !MATTEO
CHARACTER(LEN=*), INTENT(IN) :: unit_type
INTEGER, INTENT(OUT) :: ip
REAL(DP), INTENT(OUT) :: g0(3)
......@@ -203,15 +206,23 @@ MODULE class_bz_grid
!
IF ( unit_type == "cart" ) CALL cryst_to_cart( 1, p, at, -1 )
!
ip = 0
DO i = 1, this%np
deltap(:) = p(:) - this%p_cryst(:,i) - NINT( p(:) - this%p_cryst(:,i) )
IF ( ALL ( ABS ( deltap ) .LT. eps8 ) ) THEN
ip = i + (is-1) * this%np
g0(:) = p(:) - this%p_cryst(:,ip)
EXIT
ENDIF
ENDDO
ip = 0
!DO i = 1, this%np !MATTEO
! deltap(:) = p(:) - this%p_cryst(:,i) - NINT( p(:) - this%p_cryst(:,i) ) !MATTEO
! IF ( ALL ( ABS ( deltap ) .LT. eps8 ) ) THEN !MATTEO
! ip = i + (is-1) * this%np !MATTEO
! g0(:) = p(:) - this%p_cryst(:,ip) !MATTEO
! EXIT !MATTEO
! ENDIF !MATTEO
!ENDDO !MATTEO
DO i = 1, this%np !MARCO
deltap(:) = p(:) - this%p_cryst(:,i) - NINT( p(:) - this%p_cryst(:,i) ) !MARCO
IF ( ALL ( ABS ( deltap ) .LT. eps8 ) ) THEN !MARCO
g0(:) = p(:) - this%p_cryst(:,i) !MARCO
ip=i !MARCO
EXIT !MARCO
ENDIF !MARCO
ENDDO !MARCO
!
! Tranform g0 back to cartesian coordinates if needed
!
......@@ -241,6 +252,21 @@ MODULE class_bz_grid
END SUBROUTINE
!
!
FUNCTION from_ip_and_is_to_ips(this,ip,is) RESULT(ips) !MARCO
! !MARCO
IMPLICIT NONE !MARCO
! !MARCO
! I/O !MARCO
! !MARCO
CLASS(bz_grid), INTENT(IN) :: this !MARCO
INTEGER, INTENT(IN) :: ip,is !MARCO
INTEGER :: ips !MARCO
! !MARCO
ips = ip + (is-1) * this%np ! CI MANCHI MATTEO !MARCO
! !MARCO
END FUNCTION !MARCO
!
!
!SUBROUTINE addp( this, pin1, pin2, pout, g0, unit_type )
! !
! ! ... out : pout and g0
......
......@@ -28,7 +28,7 @@ SUBROUTINE do_setup
USE constants, ONLY : rytoev
USE control_flags, ONLY : gamma_only
USE noncollin_module, ONLY : noncolin,npol
USE cell_base, ONLY : omega,celldm,at
USE cell_base, ONLY : omega,celldm,at,bg,tpiba
USE fft_base, ONLY : dfftp,dffts
USE gvecs, ONLY : ngms_g, ngms
USE gvect, ONLY : ngm_g, ngm, ecutrho
......@@ -43,7 +43,7 @@ SUBROUTINE do_setup
TYPE(json_file) :: json