diff -urN bigdft-abi-1.0.4.old/configure.ac bigdft-abi-1.0.4.new/configure.ac --- bigdft-abi-1.0.4.old/configure.ac 2012-07-09 16:43:33.000000000 +0200 +++ bigdft-abi-1.0.4.new/configure.ac 2013-06-11 16:51:00.000000000 +0200 @@ -806,8 +806,8 @@ dnl Test the given implementation of libabinit. AC_CHECK_LIB(abinit, symbrav, withlibabinit=yes, withlibabinit=no) - AC_CHECK_FILE($ac_libabinit_dir/include/ab6_moldyn.$ax_fc_mod_ext, moldyn="yes", moldyn="no") - AC_CHECK_FILE($ac_libabinit_dir/include/ab6_symmetry.$ax_fc_mod_ext, sym="yes", sym="no") + AC_CHECK_FILE($ac_libabinit_dir/include/ab7_moldyn.$ax_fc_mod_ext, moldyn="yes", moldyn="no") + AC_CHECK_FILE($ac_libabinit_dir/include/ab7_symmetry.$ax_fc_mod_ext, sym="yes", sym="no") AC_CHECK_FILE($ac_libabinit_dir/include/libxc_functionals.$ax_fc_mod_ext, libxc="yes", libxc="no") if test "$withlibabinit" = "yes" -a "$moldyn" = "yes" -a "$sym" = "yes" -a "$libxc" = "yes"; then ac_use_libabinit="yes" diff -urN bigdft-abi-1.0.4.old/libABINIT/src/10_defs/defs_basis.F90 bigdft-abi-1.0.4.new/libABINIT/src/10_defs/defs_basis.F90 --- bigdft-abi-1.0.4.old/libABINIT/src/10_defs/defs_basis.F90 2012-07-09 16:43:33.000000000 +0200 +++ bigdft-abi-1.0.4.new/libABINIT/src/10_defs/defs_basis.F90 2013-06-11 16:51:00.000000000 +0200 @@ -211,18 +211,18 @@ integer, parameter :: abinit_comm_serial = -12345 ! Error codes used by the bindings. - integer, parameter, public :: AB6_NO_ERROR = 0 - integer, parameter, public :: AB6_ERROR_OBJ = 1 - integer, parameter, public :: AB6_ERROR_ARG = 2 - integer, parameter, public :: AB6_ERROR_INVARS_ATT = 3 - integer, parameter, public :: AB6_ERROR_INVARS_ID = 4 - integer, parameter, public :: AB6_ERROR_INVARS_SIZE = 5 - integer, parameter, public :: AB6_ERROR_SYM_NOT_PRIMITIVE = 6 - integer, parameter, public :: AB6_ERROR_SYM_BRAVAIS_XRED = 7 - integer, parameter, public :: AB6_ERROR_MIXING_ARG = 8 - integer, parameter, public :: AB6_ERROR_MIXING_CONVERGENCE = 9 - integer, parameter, public :: AB6_ERROR_MIXING_INTERNAL = 10 - integer, parameter, public :: AB6_ERROR_MIXING_INC_NNSLOOP = 11 + integer, parameter, public :: AB7_NO_ERROR = 0 + integer, parameter, public :: AB7_ERROR_OBJ = 1 + integer, parameter, public :: AB7_ERROR_ARG = 2 + integer, parameter, public :: AB7_ERROR_INVARS_ATT = 3 + integer, parameter, public :: AB7_ERROR_INVARS_ID = 4 + integer, parameter, public :: AB7_ERROR_INVARS_SIZE = 5 + integer, parameter, public :: AB7_ERROR_SYM_NOT_PRIMITIVE = 6 + integer, parameter, public :: AB7_ERROR_SYM_BRAVAIS_XRED = 7 + integer, parameter, public :: AB7_ERROR_MIXING_ARG = 8 + integer, parameter, public :: AB7_ERROR_MIXING_CONVERGENCE = 9 + integer, parameter, public :: AB7_ERROR_MIXING_INTERNAL = 10 + integer, parameter, public :: AB7_ERROR_MIXING_INC_NNSLOOP = 11 ! Values of optdriver corresponding to the different run-levels. integer, parameter, public :: RUNL_GSTATE = 0 diff -urN bigdft-abi-1.0.4.old/libABINIT/src/14_hidewrite/wrtout.F90 bigdft-abi-1.0.4.new/libABINIT/src/14_hidewrite/wrtout.F90 --- bigdft-abi-1.0.4.old/libABINIT/src/14_hidewrite/wrtout.F90 2012-07-09 16:43:33.000000000 +0200 +++ bigdft-abi-1.0.4.new/libABINIT/src/14_hidewrite/wrtout.F90 2013-06-11 16:51:00.000000000 +0200 @@ -62,7 +62,7 @@ !! ioniondist,irrzg,isfile,jellium,klocal,kpgio,kpgsph,kpgstr !! kramerskronig,ks_ddiago,kxc_alda,kxc_eok,ladielmt,lattice,lavnl !! leave_new,leave_test,linemin,listkk,lobpcgIIwf,lobpcgccIIwf,lobpcgccwf -!! lobpcgwf,loop3dte,loper3,lwf,m_ab6_invars_f90,m_abilasi,m_atom +!! lobpcgwf,loop3dte,loper3,lwf,m_ab7_invars_f90,m_abilasi,m_atom !! m_bands_sym,m_bs_defs,m_bz_mesh,m_coulombian,m_crystal,m_dyson_solver !! m_ebands,m_errors,m_fft_mesh,m_fftw3,m_geometry,m_green,m_gsphere !! m_gwdefs,m_hamiltonian,m_hidecudarec,m_initcuda,m_io_kss,m_io_screening diff -urN bigdft-abi-1.0.4.old/libABINIT/src/16_hideleave/leave_new.F90 bigdft-abi-1.0.4.new/libABINIT/src/16_hideleave/leave_new.F90 --- bigdft-abi-1.0.4.old/libABINIT/src/16_hideleave/leave_new.F90 2012-07-09 16:43:33.000000000 +0200 +++ bigdft-abi-1.0.4.new/libABINIT/src/16_hideleave/leave_new.F90 2013-06-11 16:51:00.000000000 +0200 @@ -54,7 +54,7 @@ !! inupper,invars0,invars1,invars1m,invars2,invars9,invcb,inwffil,inwffil3 !! ioarr,ioddb8_in,iofn1,iofn2,irrzg,isfile,jellium,klocal,kpgsph,kpgstr !! kxc_alda,kxc_eok,ladielmt,lavnl,linemin,listkk,lobpcgIIwf,lobpcgccIIwf -!! loper3,lwf,m_ab6_invars_f90,m_errors,m_green,m_libxc_functionals +!! loper3,lwf,m_ab7_invars_f90,m_errors,m_green,m_libxc_functionals !! m_matlu,m_matrix,m_oper,m_paw_dmft,m_special_funcs,m_wffile !! mat_mlms2jmj,mat_slm2ylm,matcginv,matcginv_dpc,mati3inv,matrginv !! matrixelmt_g,mean_fftr,meanvalue_g,memana,metcon,metric,metstr,mka2f diff -urN bigdft-abi-1.0.4.old/libABINIT/src/18_timing/timab.F90 bigdft-abi-1.0.4.new/libABINIT/src/18_timing/timab.F90 --- bigdft-abi-1.0.4.old/libABINIT/src/18_timing/timab.F90 2012-07-09 16:43:33.000000000 +0200 +++ bigdft-abi-1.0.4.new/libABINIT/src/18_timing/timab.F90 2013-06-11 16:51:00.000000000 +0200 @@ -50,7 +50,7 @@ !! getgsc,getngrec,gran_potrec,green_kernel,gstate,gstateimg,hartre !! hartre1,initylmg,inkpts,invars2,inwffil,inwffil3,kpgio,kpgsph,ladielmt !! lavnl,leave_test,lobpcgIIwf,lobpcgccIIwf,lobpcgccwf,lobpcgwf,loop3dte -!! loper3,m_ab6_invars_f90,m_hidecudarec,m_screening,matrixelmt_g +!! loper3,m_ab7_invars_f90,m_hidecudarec,m_screening,matrixelmt_g !! mean_fftr,meanvalue_g,mkcore,mkffnl,mklocl_realspace,mklocl_recipspace !! mkresi,mkrho,mkrho3,mkvxc3,mkvxcstr3,newkpt,newocc,newrho,newvtr !! newvtr3,nhatgrid,nlenergyrec,nonlinear,nonlop,nstdy3,nstwf3,odamix diff -urN bigdft-abi-1.0.4.old/libABINIT/src/32_util/mati3inv.F90 bigdft-abi-1.0.4.new/libABINIT/src/32_util/mati3inv.F90 --- bigdft-abi-1.0.4.old/libABINIT/src/32_util/mati3inv.F90 2012-07-09 16:43:33.000000000 +0200 +++ bigdft-abi-1.0.4.new/libABINIT/src/32_util/mati3inv.F90 2013-06-11 16:51:00.000000000 +0200 @@ -32,7 +32,7 @@ !! TODO !! !! PARENTS -!! ab6_symmetry_f90,debug_tools,get_full_kgrid,getkgrid,ingeo,invars2m +!! ab7_symmetry_f90,debug_tools,get_full_kgrid,getkgrid,ingeo,invars2m !! m_bands_sym,m_crystal,m_fft_mesh,m_io_kss,nstdy3,optic,outscfcv,rdddb9 !! read_gkk,setsym,strainsym,symdij,symdyma,wfconv !! diff -urN bigdft-abi-1.0.4.old/libABINIT/src/42_geometry/chkprimit.F90 bigdft-abi-1.0.4.new/libABINIT/src/42_geometry/chkprimit.F90 --- bigdft-abi-1.0.4.old/libABINIT/src/42_geometry/chkprimit.F90 2012-07-09 16:43:33.000000000 +0200 +++ bigdft-abi-1.0.4.new/libABINIT/src/42_geometry/chkprimit.F90 2013-06-11 16:51:00.000000000 +0200 @@ -32,7 +32,7 @@ ! !! !! PARENTS -!! ingeo,ab6_symmetry_f90 +!! ingeo,ab7_symmetry_f90 !! !! CHILDREN !! leave_new,wrtout diff -urN bigdft-abi-1.0.4.old/libABINIT/src/42_geometry/m_ab6_symmetry.F90 bigdft-abi-1.0.4.new/libABINIT/src/42_geometry/m_ab6_symmetry.F90 --- bigdft-abi-1.0.4.old/libABINIT/src/42_geometry/m_ab6_symmetry.F90 2012-07-09 16:43:33.000000000 +0200 +++ bigdft-abi-1.0.4.new/libABINIT/src/42_geometry/m_ab6_symmetry.F90 1970-01-01 01:00:00.000000000 +0100 @@ -1,1088 +0,0 @@ -!* * Fortran90 source file * -!* -!* Copyright (c) 2008-2010 ABINIT Group (Damien Caliste) -!* All rights reserved. -!* -!* This file is part of the ABINIT software package. For license information, -!* please see the COPYING file in the top-level directory of the ABINIT source -!* distribution. -!* -!* - -module m_ab6_symmetry - - use defs_basis - - implicit none - - private - - integer, parameter, public :: AB6_MAX_SYMMETRIES = 384 - - type, public :: symmetry_type - ! The input characteristics - real(dp) :: tolsym - real(dp) :: rprimd(3,3), gprimd(3,3), rmet(3,3) - integer :: nAtoms - integer, pointer :: typeAt(:) - real(dp), pointer :: xRed(:,:) - - logical :: withField - real(dp) :: field(3) - - logical :: withJellium - - integer :: withSpin - real(dp), pointer :: spinAt(:,:) - - logical :: withSpinOrbit - - integer :: vacuum(3) - - ! The output characteristics - ! The bravais parameters - integer :: nBravSym - integer :: bravais(11), bravSym(3, 3, AB6_MAX_SYMMETRIES) - ! The symmetry matrices - logical :: auto - integer :: nSym - integer, pointer :: sym(:,:,:) - real(dp), pointer :: transNon(:,:) - integer, pointer :: symAfm(:) - ! Some additional information - integer :: multiplicity - real(dp) :: genAfm(3) - integer :: spaceGroup, pointGroupMagn - integer, pointer :: indexingAtoms(:,:,:) - end type symmetry_type - - ! We store here a list of symmetry objects to be able to - ! call several symmetry operations on different objects. - ! The simplest portable way to do it, is to create - ! a list of Fortran structure and to use the list index - ! as an identifier that can be given to the other languages. - type, private :: symmetry_list - integer :: id - type(symmetry_list), pointer :: next - type(symmetry_type) :: data - end type symmetry_list - type(symmetry_list), pointer :: my_symmetries - integer :: n_symmetries = 0 - - logical, private, parameter :: AB_DBG = .false. - - public :: symmetry_new - public :: symmetry_free - public :: symmetry_set_tolerance - public :: symmetry_set_lattice - public :: symmetry_set_structure - public :: symmetry_set_collinear_spin - public :: symmetry_set_spin - public :: symmetry_set_spin_orbit - public :: symmetry_set_field - public :: symmetry_set_jellium - public :: symmetry_set_periodicity - public :: symmetry_set_n_sym - - public :: symmetry_get_from_id - public :: symmetry_get_n_atoms - public :: symmetry_get_n_sym - public :: symmetry_get_multiplicity - public :: symmetry_get_bravais - public :: symmetry_get_matrices - public :: symmetry_get_matrices_p - public :: symmetry_get_group - public :: symmetry_get_equivalent_atom - -contains - - subroutine new_item(token) - - -!This section has been created automatically by the script Abilint (TD). -!Do not modify the following lines by hand. -!End of the abilint section - - type(symmetry_list), pointer :: token - - ! We allocate a new list token and prepend it. - if (AB_DBG) write(0,*) "AB symmetry: create a new token." - - ! Init case, very first call. - if (n_symmetries == 0) then - nullify(my_symmetries) - end if - - ! Normal treatment. - n_symmetries = n_symmetries + 1 - - allocate(token) - token%id = n_symmetries - call new_symmetry(token%data) - token%next => my_symmetries - - my_symmetries => token - if (AB_DBG) write(0,*) "AB symmetry: creation OK with id ", token%id - end subroutine new_item - - subroutine free_item(token) - - -!This section has been created automatically by the script Abilint (TD). -!Do not modify the following lines by hand. -!End of the abilint section - - type(symmetry_list), pointer :: token - - type(symmetry_list), pointer :: tmp - - if (.not. associated(token)) then - return - end if - - call free_symmetry(token%data) - - if (AB_DBG) write(0,*) "AB symmetry: free request on token ", token%id - ! We remove token from the list. - if (my_symmetries%id == token%id) then - my_symmetries => token%next - else - tmp => my_symmetries - do - if (.not.associated(tmp)) then - return - end if - if (associated(tmp%next) .and. tmp%next%id == token%id) then - exit - end if - tmp => tmp%next - end do - tmp%next => token%next - end if - deallocate(token) - if (AB_DBG) write(0,*) "AB symmetry: free done" - end subroutine free_item - - subroutine get_item(token, id) - - - type(symmetry_list), pointer :: token - integer, intent(in) :: id - - type(symmetry_list), pointer :: tmp - - if (AB_DBG) write(0,*) "AB symmetry: request list element ", id - nullify(token) - - tmp => my_symmetries - do - if (.not. associated(tmp)) then - exit - end if - if (tmp%id == id) then - token => tmp - return - end if - tmp => tmp%next - end do - end subroutine get_item - - subroutine symmetry_get_from_id(sym, id, errno) - - type(symmetry_type), pointer :: sym - integer, intent(in) :: id - integer, intent(out) :: errno - - type(symmetry_list), pointer :: token - - errno = AB6_NO_ERROR - call get_item(token, id) - if (associated(token)) then - sym => token%data - if (sym%nSym <= 0) then - ! We do the computation of the matrix part. - call compute_matrices(sym, errno) - end if - else - errno = AB6_ERROR_OBJ - nullify(sym) - end if - end subroutine symmetry_get_from_id - - subroutine new_symmetry(sym) - - - type(symmetry_type), intent(out) :: sym - - if (AB_DBG) write(0,*) "AB symmetry: create a new symmetry object." - nullify(sym%xRed) - nullify(sym%spinAt) - nullify(sym%typeAt) - sym%tolsym = tol8 - sym%auto = .true. - sym%nSym = 0 - nullify(sym%sym) - nullify(sym%symAfm) - nullify(sym%transNon) - sym%nBravSym = -1 - sym%withField = .false. - sym%withJellium = .false. - sym%withSpin = 1 - sym%withSpinOrbit = .false. - sym%multiplicity = -1 - nullify(sym%indexingAtoms) - sym%vacuum = 0 - end subroutine new_symmetry - - subroutine free_symmetry(sym) - - - type(symmetry_type), intent(inout) :: sym - - if (AB_DBG) write(0,*) "AB symmetry: free a symmetry." - - if (associated(sym%xRed)) deallocate(sym%xRed) - if (associated(sym%spinAt)) deallocate(sym%spinAt) - if (associated(sym%typeAt)) deallocate(sym%typeAt) - if (associated(sym%indexingAtoms)) deallocate(sym%indexingAtoms) - if (associated(sym%sym)) deallocate(sym%sym) - if (associated(sym%symAfm)) deallocate(sym%symAfm) - if (associated(sym%transNon)) deallocate(sym%transNon) - end subroutine free_symmetry - - - - - - subroutine symmetry_new(id) - - -!This section has been created automatically by the script Abilint (TD). -!Do not modify the following lines by hand. -!End of the abilint section - - integer, intent(out) :: id - - type(symmetry_list), pointer :: token - - if (AB_DBG) write(0,*) "AB symmetry: call new symmetry." - call new_item(token) - id = token%id - end subroutine symmetry_new - - subroutine symmetry_free(id) - - -!This section has been created automatically by the script Abilint (TD). -!Do not modify the following lines by hand. -!End of the abilint section - - integer, intent(in) :: id - - type(symmetry_list), pointer :: token - - if (AB_DBG) write(0,*) "AB symmetry: call free symmetry." - - call get_item(token, id) - if (associated(token)) call free_item(token) - end subroutine symmetry_free - - subroutine symmetry_set_tolerance(id, tolsym, errno) - - -!This section has been created automatically by the script Abilint (TD). -!Do not modify the following lines by hand. -!End of the abilint section - - integer, intent(in) :: id - real(dp), intent(in) :: tolsym - integer, intent(out) :: errno - - type(symmetry_list), pointer :: token - - if (AB_DBG) write(0,*) "AB symmetry: call set tolerance." - - errno = AB6_NO_ERROR - call get_item(token, id) - if (.not. associated(token)) then - errno = AB6_ERROR_OBJ - return - end if - - token%data%tolsym = tolsym - - ! We unset all the computed symmetries - token%data%nBravSym = -1 - if (token%data%auto) then - token%data%nSym = 0 - end if - end subroutine symmetry_set_tolerance - - subroutine symmetry_set_lattice(id, rprimd, errno) - - -!This section has been created automatically by the script Abilint (TD). -!Do not modify the following lines by hand. - use interfaces_42_geometry -!End of the abilint section - - integer, intent(in) :: id - real(dp), intent(in) :: rprimd(3,3) - integer, intent(out) :: errno - - type(symmetry_list), pointer :: token - real(dp) :: ucvol - real(dp) :: gmet(3,3) - - if (AB_DBG) write(0,*) "AB symmetry: call set lattice." - if (AB_DBG) write(0, "(A,3F12.6,A)") " (", rprimd(:,1), ")" - if (AB_DBG) write(0, "(A,3F12.6,A)") " (", rprimd(:,2), ")" - if (AB_DBG) write(0, "(A,3F12.6,A)") " (", rprimd(:,3), ")" - - errno = AB6_NO_ERROR - call get_item(token, id) - if (.not. associated(token)) then - errno = AB6_ERROR_OBJ - return - end if - - token%data%rprimd = rprimd - call metric(gmet, token%data%gprimd, -1, token%data%rmet, rprimd, ucvol) - - ! We unset all the computed symmetries - token%data%nBravSym = -1 - if (token%data%auto) then - token%data%nSym = 0 - end if - end subroutine symmetry_set_lattice - - subroutine symmetry_set_structure(id, nAtoms, typeAt, xRed, errno) - - -!This section has been created automatically by the script Abilint (TD). -!Do not modify the following lines by hand. -!End of the abilint section - - integer, intent(in) :: id - integer, intent(in) :: nAtoms - integer, intent(in) :: typeAt(nAtoms) - real(dp), intent(in) :: xRed(3,nAtoms) - integer, intent(out) :: errno - - type(symmetry_list), pointer :: token - integer :: i - - if (AB_DBG) write(0,*) "AB symmetry: call set structure." - if (AB_DBG) write(0, "(A,I3,A)") " ", nAtoms, " atoms" - if (AB_DBG) then - do i = 1, nAtoms, 1 - write(0, "(A,3F12.6,I3)") " ", xRed(:, i), typeAt(i) - end do - end if - - errno = AB6_NO_ERROR - call get_item(token, id) - if (.not. associated(token)) then - errno = AB6_ERROR_OBJ - return - end if - - token%data%nAtoms = nAtoms - allocate(token%data%typeAt(nAtoms)) - token%data%typeAt = typeAt - allocate(token%data%xRed(3, nAtoms)) - token%data%xRed = xRed - - ! We unset only the symmetries - if (token%data%auto) then - token%data%nSym = 0 - end if - if (associated(token%data%indexingAtoms)) deallocate(token%data%indexingAtoms) - end subroutine symmetry_set_structure - - subroutine symmetry_set_spin(id, nAtoms, spinAt, errno) - - -!This section has been created automatically by the script Abilint (TD). -!Do not modify the following lines by hand. -!End of the abilint section - - integer, intent(in) :: id - integer, intent(in) :: nAtoms - real(dp), intent(in) :: spinAt(3,nAtoms) - integer, intent(out) :: errno - - type(symmetry_list), pointer :: token - integer :: i - - if (AB_DBG) write(0,*) "AB symmetry: call set spin." - if (AB_DBG) then - do i = 1, nAtoms, 1 - write(0, "(A,3F12.6)") " ", spinAt(:, i) - end do - end if - - errno = AB6_NO_ERROR - call get_item(token, id) - if (.not. associated(token)) then - errno = AB6_ERROR_OBJ - return - end if - if (token%data%nAtoms /= nAtoms) then - errno = AB6_ERROR_ARG - return - end if - - token%data%withSpin = 4 - allocate(token%data%spinAt(3, nAtoms)) - token%data%spinAt = spinAt - - ! We unset only the symmetries - if (token%data%auto) then - token%data%nSym = 0 - end if - end subroutine symmetry_set_spin - - subroutine symmetry_set_collinear_spin(id, nAtoms, spinAt, errno) - - -!This section has been created automatically by the script Abilint (TD). -!Do not modify the following lines by hand. -!End of the abilint section - - integer, intent(in) :: id - integer, intent(in) :: nAtoms - integer, intent(in) :: spinAt(nAtoms) - integer, intent(out) :: errno - - type(symmetry_list), pointer :: token - integer :: i - - if (AB_DBG) write(0,*) "AB symmetry: call set collinear spin." - if (AB_DBG) then - do i = 1, nAtoms, 1 - write(0, "(A,I3)") " ", spinAt(i) - end do - end if - - errno = AB6_NO_ERROR - call get_item(token, id) - if (.not. associated(token)) then - errno = AB6_ERROR_OBJ - return - end if - if (token%data%nAtoms /= nAtoms) then - errno = AB6_ERROR_ARG - return - end if - - token%data%withSpin = 2 - allocate(token%data%spinAt(1, nAtoms)) - token%data%spinAt = real(reshape(spinAt, (/ 1, nAtoms /)), dp) - - ! We unset only the symmetries - if (token%data%auto) then - token%data%nSym = 0 - end if - end subroutine symmetry_set_collinear_spin - - subroutine symmetry_set_spin_orbit(id, withSpinOrbit, errno) - - -!This section has been created automatically by the script Abilint (TD). -!Do not modify the following lines by hand. -!End of the abilint section - - integer, intent(in) :: id - logical, intent(in) :: withSpinOrbit - integer, intent(out) :: errno - - type(symmetry_list), pointer :: token - - if (AB_DBG) write(0,*) "AB symmetry: call set spin orbit." - - errno = AB6_NO_ERROR - call get_item(token, id) - if (.not. associated(token)) then - errno = AB6_ERROR_OBJ - return - end if - - token%data%withSpinOrbit = withSpinOrbit - - ! We unset only the symmetries - if (token%data%auto) then - token%data%nSym = 0 - end if - end subroutine symmetry_set_spin_orbit - - subroutine symmetry_set_field(id, field, errno) - - -!This section has been created automatically by the script Abilint (TD). -!Do not modify the following lines by hand. -!End of the abilint section - - integer, intent(in) :: id - real(dp), intent(in) :: field(3) - integer, intent(out) :: errno - - type(symmetry_list), pointer :: token - - if (AB_DBG) write(0,*) "AB symmetry: call set field." - - errno = AB6_NO_ERROR - call get_item(token, id) - if (.not. associated(token)) then - errno = AB6_ERROR_OBJ - return - end if - - token%data%withField = .true. - token%data%field = field - - ! We unset all the computed symmetries - token%data%nBravSym = -1 - if (token%data%auto) then - token%data%nSym = 0 - end if - end subroutine symmetry_set_field - - subroutine symmetry_set_jellium(id, jellium, errno) - - -!This section has been created automatically by the script Abilint (TD). -!Do not modify the following lines by hand. -!End of the abilint section - - integer, intent(in) :: id - logical, intent(in) :: jellium - integer, intent(out) :: errno - - type(symmetry_list), pointer :: token - - if (AB_DBG) write(0,*) "AB symmetry: call set jellium." - - errno = AB6_NO_ERROR - call get_item(token, id) - if (.not. associated(token)) then - errno = AB6_ERROR_OBJ - return - end if - - token%data%withJellium = jellium - - ! We unset only the symmetries - if (token%data%auto) then - token%data%nSym = 0 - end if - end subroutine symmetry_set_jellium - - subroutine symmetry_set_periodicity(id, periodic, errno) - - -!This section has been created automatically by the script Abilint (TD). -!Do not modify the following lines by hand. -!End of the abilint section - - integer, intent(in) :: id - logical, intent(in) :: periodic(3) - integer, intent(out) :: errno - - type(symmetry_list), pointer :: token - - if (AB_DBG) write(0,*) "AB symmetry: call set periodicity." - if (AB_DBG) write(0, "(A,3L1,A)") " (", periodic, ")" - - errno = AB6_NO_ERROR - call get_item(token, id) - if (.not. associated(token)) then - errno = AB6_ERROR_OBJ - return - end if - - token%data%vacuum = 0 - if (.not. periodic(1)) token%data%vacuum(1) = 1 - if (.not. periodic(2)) token%data%vacuum(2) = 1 - if (.not. periodic(3)) token%data%vacuum(3) = 1 - end subroutine symmetry_set_periodicity - - - - - - subroutine symmetry_get_n_atoms(id, nAtoms, errno) - !scalars - -!This section has been created automatically by the script Abilint (TD). -!Do not modify the following lines by hand. -!End of the abilint section - - integer, intent(in) :: id - integer, intent(out) :: errno - integer, intent(out) :: nAtoms - - type(symmetry_list), pointer :: token - - if (AB_DBG) write(0,*) "AB symmetry: call get nAtoms." - - errno = AB6_NO_ERROR - call get_item(token, id) - if (.not. associated(token)) then - errno = AB6_ERROR_OBJ - return - end if - - nAtoms = token%data%nAtoms - end subroutine symmetry_get_n_atoms - - subroutine compute_bravais(sym) - - -!This section has been created automatically by the script Abilint (TD). -!Do not modify the following lines by hand. - use interfaces_42_geometry -!End of the abilint section - - type(symmetry_type), intent(inout) :: sym - - integer :: berryopt - - ! We do the computation - if (sym%withField) then - berryopt = 4 - else - berryopt = 0 - end if - if (AB_DBG) write(0,*) "AB symmetry: call ABINIT symlatt." - call symlatt(sym%bravais, AB6_MAX_SYMMETRIES, & - & sym%nBravSym, sym%bravSym, sym%rprimd, sym%tolsym) - if (AB_DBG) write(0,*) "AB symmetry: call ABINIT OK." - if (AB_DBG) write(0, "(A,I3)") " nSymBrav :", sym%nBravSym - if (AB_DBG) write(0, "(A,I3)") " holohedry:", sym%bravais(1) - if (AB_DBG) write(0, "(A,I3)") " center :", sym%bravais(2) - end subroutine compute_bravais - - subroutine symmetry_get_bravais(id, bravais, holohedry, center, & - & nBravSym, bravSym, errno) - !scalars - -!This section has been created automatically by the script Abilint (TD). -!Do not modify the following lines by hand. -!End of the abilint section - - integer, intent(in) :: id - integer, intent(out) :: errno - integer, intent(out) :: nBravSym, holohedry, center - !arrays - integer, intent(out) :: bravais(3,3), bravSym(3, 3, AB6_MAX_SYMMETRIES) - - type(symmetry_list), pointer :: token - - if (AB_DBG) write(0,*) "AB symmetry: call get bravais." - - errno = AB6_NO_ERROR - call get_item(token, id) - if (.not. associated(token)) then - errno = AB6_ERROR_OBJ - return - end if - - if (token%data%nBravSym < 0) then - ! We do the computation - call compute_bravais(token%data) - end if - - holohedry = token%data%bravais(1) - center = token%data%bravais(2) - bravais = reshape(token%data%bravais(3:11), (/ 3,3 /)) - nBravSym = token%data%nBravSym - bravSym(:, :, 1:nBravSym) = token%data%bravSym(:, :, 1:nBravSym) - end subroutine symmetry_get_bravais - - subroutine compute_matrices(sym, errno) - - -!This section has been created automatically by the script Abilint (TD). -!Do not modify the following lines by hand. - use interfaces_42_geometry -!End of the abilint section - - type(symmetry_type), intent(inout) :: sym - integer, intent(out) :: errno - - integer :: berryopt, jellslab, noncol - integer :: use_inversion - real(dp), pointer :: spinAt_(:,:) - integer :: sym_(3, 3, AB6_MAX_SYMMETRIES) - real(dp) :: transNon_(3, AB6_MAX_SYMMETRIES) - integer :: symAfm_(AB6_MAX_SYMMETRIES) - - errno = AB6_NO_ERROR - - if (sym%nBravSym < 0) then - ! We do the computation of the Bravais part. - call compute_bravais(sym) - end if - - if (sym%withField) then - berryopt = 4 - else - berryopt = 0 - end if - if (sym%withJellium) then - jellslab = 1 - else - jellslab = 0 - end if - if (sym%withSpin == 4) then - noncol = 1 - spinAt_ => sym%spinAt - else if (sym%withSpin == 2) then - noncol = 0 - spinAt_ => sym%spinAt - else - noncol = 0 - allocate(spinAt_(3, sym%nAtoms)) - spinAt_ = 0 - end if - if (sym%withSpinOrbit) then - use_inversion = 0 - else - use_inversion = 1 - end if - - if (sym%nsym == 0) then - if (AB_DBG) write(0,*) "AB symmetry: call ABINIT symfind." - call symfind(berryopt, sym%field, sym%gprimd, jellslab, AB6_MAX_SYMMETRIES, & - & sym%nAtoms, noncol, sym%nBravSym, sym%nSym, sym%bravSym, spinAt_, & - & symAfm_, sym_, transNon_, sym%tolsym, sym%typeAt, & - & use_inversion, sym%xRed) - if (AB_DBG) write(0,*) "AB symmetry: call ABINIT OK." - if (AB_DBG) write(0, "(A,I3)") " nSym:", sym%nSym - if (associated(sym%sym)) deallocate(sym%sym) - if (associated(sym%symAfm)) deallocate(sym%symAfm) - if (associated(sym%transNon)) deallocate(sym%transNon) - allocate(sym%sym(3, 3, sym%nSym)) - sym%sym(:,:,:) = sym_(:,:, 1:sym%nSym) - allocate(sym%symAfm(sym%nSym)) - sym%symAfm(:) = symAfm_(1:sym%nSym) - allocate(sym%transNon(3, sym%nSym)) - sym%transNon(:,:) = transNon_(:, 1:sym%nSym) - else if (sym%nsym < 0) then - sym%nsym = -sym%nsym - sym_(:,:, 1:sym%nSym) = sym%sym(:,:,:) - transNon_(:, 1:sym%nSym) = sym%transNon(:,:) - symAfm_(1:sym%nSym) = sym%symAfm(:) - end if - - if (sym%withSpin == 1) then - deallocate(spinAt_) - end if - - if (AB_DBG) write(0,*) "AB symmetry: call ABINIT symanal." - call symanal(sym%bravais, 0, sym%genAfm, AB6_MAX_SYMMETRIES, sym%nSym, & - & sym%pointGroupMagn, sym%rprimd, sym%spaceGroup, symAfm_, & - & sym_, transNon_, sym%tolsym) - if (AB_DBG) write(0,*) "AB symmetry: call ABINIT OK." - sym%transNon(:,:) = transNon_(:, 1:sym%nSym) - - if (sym%bravais(1) < 0) then - sym%multiplicity = 2 - else - sym%multiplicity = 1 - end if - if (AB_DBG) write(0, "(A,I3)") " multi:", sym%multiplicity - if (AB_DBG) write(0, "(A,I3)") " space:", sym%spaceGroup - end subroutine compute_matrices - - subroutine symmetry_get_n_sym(id, nSym, errno) - !scalars - -!This section has been created automatically by the script Abilint (TD). -!Do not modify the following lines by hand. -!End of the abilint section - - integer, intent(in) :: id - integer, intent(out) :: errno - integer, intent(out) :: nSym - - type(symmetry_list), pointer :: token - - if (AB_DBG) write(0,*) "AB symmetry: call get nSym." - - errno = AB6_NO_ERROR - call get_item(token, id) - if (.not. associated(token)) then - errno = AB6_ERROR_OBJ - return - end if - - if (token%data%nSym <= 0) then - ! We do the computation of the matrix part. - call compute_matrices(token%data, errno) - end if - - nSym = token%data%nSym - end subroutine symmetry_get_n_sym - - subroutine symmetry_set_n_sym(id, nSym, sym, transNon, symAfm, errno) - !scalars - -!This section has been created automatically by the script Abilint (TD). -!Do not modify the following lines by hand. -!End of the abilint section - - integer, intent(in) :: id - integer, intent(in) :: nSym - integer, intent(in) :: sym(3, 3, nSym) - real(dp), intent(in) :: transNon(3, nSym) - integer, intent(in) :: symAfm(nSym) - integer, intent(out) :: errno - - type(symmetry_list), pointer :: token - - if (AB_DBG) write(0,*) "AB symmetry: call get nSym." - - errno = AB6_NO_ERROR - call get_item(token, id) - if (.not. associated(token)) then - errno = AB6_ERROR_OBJ - return - end if - - if (nSym <= 0) then - errno = AB6_ERROR_ARG - return - else - allocate(token%data%sym(3, 3, nSym)) - token%data%sym(:,:,:) = sym(:,:,:) - allocate(token%data%symAfm(nSym)) - token%data%symAfm(:) = symAfm(:) - allocate(token%data%transNon(3, nSym)) - token%data%transNon(:,:) = transNon(:,:) - - token%data%auto = .false. - token%data%nsym = -nSym - end if - - ! We do the computation of the matrix part. - call compute_matrices(token%data, errno) - end subroutine symmetry_set_n_sym - - subroutine symmetry_get_matrices(id, nSym, sym, transNon, symAfm, errno) - - -!This section has been created automatically by the script Abilint (TD). -!Do not modify the following lines by hand. -!End of the abilint section - - integer, intent(in) :: id - integer, intent(out) :: errno - integer, intent(out) :: nSym - integer, intent(out) :: sym(3, 3, AB6_MAX_SYMMETRIES) - integer, intent(out) :: symAfm(AB6_MAX_SYMMETRIES) - real(dp), intent(out) :: transNon(3, AB6_MAX_SYMMETRIES) - - type(symmetry_list), pointer :: token - - if (AB_DBG) write(0,*) "AB symmetry: call get matrices." - - errno = AB6_NO_ERROR - call get_item(token, id) - if (.not. associated(token)) then - errno = AB6_ERROR_OBJ - return - end if - - if (token%data%nSym <= 0) then - ! We do the computation of the matrix part. - call compute_matrices(token%data, errno) - end if - - nSym = token%data%nSym - sym(:, :, 1:nSym) = token%data%sym(:, :,:) - symAfm(1:nSym) = token%data%symAfm(:) - transNon(:, 1:nSym) = token%data%transNon(:,:) - end subroutine symmetry_get_matrices - - subroutine symmetry_get_matrices_p(id, nSym, sym, transNon, symAfm, errno) - - -!This section has been created automatically by the script Abilint (TD). -!Do not modify the following lines by hand. -!End of the abilint section - - integer, intent(in) :: id - integer, intent(out) :: errno - integer, intent(out) :: nSym - integer, pointer :: sym(:,:,:) - integer, pointer :: symAfm(:) - real(dp), pointer :: transNon(:,:) - - type(symmetry_list), pointer :: token - - if (AB_DBG) write(0,*) "AB symmetry: call get matrices as pointers." - - errno = AB6_NO_ERROR - call get_item(token, id) - if (.not. associated(token)) then - errno = AB6_ERROR_OBJ - return - end if - - if (token%data%nSym <= 0) then - ! We do the computation of the matrix part. - call compute_matrices(token%data, errno) - end if - - nSym = token%data%nSym - sym => token%data%sym - symAfm => token%data%symAfm - transNon => token%data%transNon - end subroutine symmetry_get_matrices_p - - subroutine symmetry_get_multiplicity(id, multiplicity, errno) - - -!This section has been created automatically by the script Abilint (TD). -!Do not modify the following lines by hand. -!End of the abilint section - - integer, intent(in) :: id - integer, intent(out) :: multiplicity, errno - - type(symmetry_list), pointer :: token - - if (AB_DBG) write(0,*) "AB symmetry: call get multiplicity." - - errno = AB6_NO_ERROR - call get_item(token, id) - if (.not. associated(token)) then - errno = AB6_ERROR_OBJ - return - end if - - if (token%data%multiplicity < 0) then - ! We do the computation of the matrix part. - call compute_matrices(token%data, errno) - end if - multiplicity = token%data%multiplicity - end subroutine symmetry_get_multiplicity - - subroutine symmetry_get_group(id, spaceGroup, spaceGroupId, & - & pointGroupMagn, genAfm, errno) - - -!This section has been created automatically by the script Abilint (TD). -!Do not modify the following lines by hand. - use interfaces_42_geometry -!End of the abilint section - - integer, intent(in) :: id - integer, intent(out) :: errno - real(dp), intent(out) :: genAfm(3) - character(len=15), intent(out) :: spaceGroup - integer, intent(out) :: spaceGroupId, pointGroupMagn - - type(symmetry_list), pointer :: token - integer :: sporder - character(len=1) :: brvLattice - character(len=15) :: ptintsb,ptschsb,schsb,spgrp - character(len=35) :: intsbl - - if (AB_DBG) write(0,*) "AB symmetry: call get group." - - errno = AB6_NO_ERROR - call get_item(token, id) - if (.not. associated(token)) then - errno = AB6_ERROR_OBJ - return - end if - - if (token%data%multiplicity < 0) then - ! We do the computation of the matrix part. - call compute_matrices(token%data, errno) - end if - - if (token%data%multiplicity /= 1) then - errno = AB6_ERROR_SYM_NOT_PRIMITIVE - return - end if - - call spgdata(brvLattice,spgrp,intsbl,ptintsb,ptschsb,& - & schsb,1,token%data%spaceGroup,sporder,1) - - write(spaceGroup, "(3A)") brvLattice, " ", trim(spgrp(1:13)) - pointGroupMagn = token%data%pointGroupMagn - spaceGroupId = token%data%spaceGroup - genAfm = token%data%genAfm - end subroutine symmetry_get_group - - subroutine compute_equivalent_atoms(sym) - - -!This section has been created automatically by the script Abilint (TD). -!Do not modify the following lines by hand. - use interfaces_32_util - use interfaces_42_geometry -!End of the abilint section - - type(symmetry_type), intent(inout) :: sym - - integer, allocatable :: symrec(:,:,:) - integer :: isym - - if (.not. associated(sym%indexingAtoms)) & - & allocate(sym%indexingAtoms(4, sym%nSym, sym%nAtoms)) - - !Get the symmetry matrices in terms of reciprocal basis - allocate(symrec(3, 3, sym%nSym)) - do isym = 1, sym%nSym, 1 - call mati3inv(sym%sym(:,:,isym), symrec(:,:,isym)) - end do - - !Obtain a list of rotated atom labels: - call symatm(sym%indexingAtoms, sym%nAtoms, sym%nSym, symrec, & - & sym%transNon, sym%tolsym, sym%typeAt, sym%xRed) - - deallocate(symrec) - end subroutine compute_equivalent_atoms - - subroutine symmetry_get_equivalent_atom(id, equiv, iAtom, errno) - - -!This section has been created automatically by the script Abilint (TD). -!Do not modify the following lines by hand. -!End of the abilint section - - integer, intent(in) :: id - integer, intent(in) :: iAtom - integer, intent(out) :: equiv(4, AB6_MAX_SYMMETRIES) - integer, intent(out) :: errno - - type(symmetry_list), pointer :: token - - if (AB_DBG) write(0,*) "AB symmetry: call get equivalent." - - errno = AB6_NO_ERROR - call get_item(token, id) - if (.not. associated(token)) then - errno = AB6_ERROR_OBJ - return - end if - - if (iAtom < 1 .or. iAtom > token%data%nAtoms) then - errno = AB6_ERROR_ARG - return - end if - - if (.not. associated(token%data%indexingAtoms)) then - ! We do the computation of the matrix part. - call compute_equivalent_atoms(token%data) - end if - - equiv(:, 1:token%data%nSym) = token%data%indexingAtoms(:,:,iAtom) - end subroutine symmetry_get_equivalent_atom - -end module m_ab6_symmetry diff -urN bigdft-abi-1.0.4.old/libABINIT/src/42_geometry/m_ab7_symmetry.F90 bigdft-abi-1.0.4.new/libABINIT/src/42_geometry/m_ab7_symmetry.F90 --- bigdft-abi-1.0.4.old/libABINIT/src/42_geometry/m_ab7_symmetry.F90 1970-01-01 01:00:00.000000000 +0100 +++ bigdft-abi-1.0.4.new/libABINIT/src/42_geometry/m_ab7_symmetry.F90 2013-06-11 16:51:00.000000000 +0200 @@ -0,0 +1,1088 @@ +!* * Fortran90 source file * +!* +!* Copyright (c) 2008-2010 ABINIT Group (Damien Caliste) +!* All rights reserved. +!* +!* This file is part of the ABINIT software package. For license information, +!* please see the COPYING file in the top-level directory of the ABINIT source +!* distribution. +!* +!* + +module m_ab7_symmetry + + use defs_basis + + implicit none + + private + + integer, parameter, public :: AB7_MAX_SYMMETRIES = 384 + + type, public :: symmetry_type + ! The input characteristics + real(dp) :: tolsym + real(dp) :: rprimd(3,3), gprimd(3,3), rmet(3,3) + integer :: nAtoms + integer, pointer :: typeAt(:) + real(dp), pointer :: xRed(:,:) + + logical :: withField + real(dp) :: field(3) + + logical :: withJellium + + integer :: withSpin + real(dp), pointer :: spinAt(:,:) + + logical :: withSpinOrbit + + integer :: vacuum(3) + + ! The output characteristics + ! The bravais parameters + integer :: nBravSym + integer :: bravais(11), bravSym(3, 3, AB7_MAX_SYMMETRIES) + ! The symmetry matrices + logical :: auto + integer :: nSym + integer, pointer :: sym(:,:,:) + real(dp), pointer :: transNon(:,:) + integer, pointer :: symAfm(:) + ! Some additional information + integer :: multiplicity + real(dp) :: genAfm(3) + integer :: spaceGroup, pointGroupMagn + integer, pointer :: indexingAtoms(:,:,:) + end type symmetry_type + + ! We store here a list of symmetry objects to be able to + ! call several symmetry operations on different objects. + ! The simplest portable way to do it, is to create + ! a list of Fortran structure and to use the list index + ! as an identifier that can be given to the other languages. + type, private :: symmetry_list + integer :: id + type(symmetry_list), pointer :: next + type(symmetry_type) :: data + end type symmetry_list + type(symmetry_list), pointer :: my_symmetries + integer :: n_symmetries = 0 + + logical, private, parameter :: AB_DBG = .false. + + public :: symmetry_new + public :: symmetry_free + public :: symmetry_set_tolerance + public :: symmetry_set_lattice + public :: symmetry_set_structure + public :: symmetry_set_collinear_spin + public :: symmetry_set_spin + public :: symmetry_set_spin_orbit + public :: symmetry_set_field + public :: symmetry_set_jellium + public :: symmetry_set_periodicity + public :: symmetry_set_n_sym + + public :: symmetry_get_from_id + public :: symmetry_get_n_atoms + public :: symmetry_get_n_sym + public :: symmetry_get_multiplicity + public :: symmetry_get_bravais + public :: symmetry_get_matrices + public :: symmetry_get_matrices_p + public :: symmetry_get_group + public :: symmetry_get_equivalent_atom + +contains + + subroutine new_item(token) + + +!This section has been created automatically by the script Abilint (TD). +!Do not modify the following lines by hand. +!End of the abilint section + + type(symmetry_list), pointer :: token + + ! We allocate a new list token and prepend it. + if (AB_DBG) write(0,*) "AB symmetry: create a new token." + + ! Init case, very first call. + if (n_symmetries == 0) then + nullify(my_symmetries) + end if + + ! Normal treatment. + n_symmetries = n_symmetries + 1 + + allocate(token) + token%id = n_symmetries + call new_symmetry(token%data) + token%next => my_symmetries + + my_symmetries => token + if (AB_DBG) write(0,*) "AB symmetry: creation OK with id ", token%id + end subroutine new_item + + subroutine free_item(token) + + +!This section has been created automatically by the script Abilint (TD). +!Do not modify the following lines by hand. +!End of the abilint section + + type(symmetry_list), pointer :: token + + type(symmetry_list), pointer :: tmp + + if (.not. associated(token)) then + return + end if + + call free_symmetry(token%data) + + if (AB_DBG) write(0,*) "AB symmetry: free request on token ", token%id + ! We remove token from the list. + if (my_symmetries%id == token%id) then + my_symmetries => token%next + else + tmp => my_symmetries + do + if (.not.associated(tmp)) then + return + end if + if (associated(tmp%next) .and. tmp%next%id == token%id) then + exit + end if + tmp => tmp%next + end do + tmp%next => token%next + end if + deallocate(token) + if (AB_DBG) write(0,*) "AB symmetry: free done" + end subroutine free_item + + subroutine get_item(token, id) + + + type(symmetry_list), pointer :: token + integer, intent(in) :: id + + type(symmetry_list), pointer :: tmp + + if (AB_DBG) write(0,*) "AB symmetry: request list element ", id + nullify(token) + + tmp => my_symmetries + do + if (.not. associated(tmp)) then + exit + end if + if (tmp%id == id) then + token => tmp + return + end if + tmp => tmp%next + end do + end subroutine get_item + + subroutine symmetry_get_from_id(sym, id, errno) + + type(symmetry_type), pointer :: sym + integer, intent(in) :: id + integer, intent(out) :: errno + + type(symmetry_list), pointer :: token + + errno = AB7_NO_ERROR + call get_item(token, id) + if (associated(token)) then + sym => token%data + if (sym%nSym <= 0) then + ! We do the computation of the matrix part. + call compute_matrices(sym, errno) + end if + else + errno = AB7_ERROR_OBJ + nullify(sym) + end if + end subroutine symmetry_get_from_id + + subroutine new_symmetry(sym) + + + type(symmetry_type), intent(out) :: sym + + if (AB_DBG) write(0,*) "AB symmetry: create a new symmetry object." + nullify(sym%xRed) + nullify(sym%spinAt) + nullify(sym%typeAt) + sym%tolsym = tol8 + sym%auto = .true. + sym%nSym = 0 + nullify(sym%sym) + nullify(sym%symAfm) + nullify(sym%transNon) + sym%nBravSym = -1 + sym%withField = .false. + sym%withJellium = .false. + sym%withSpin = 1 + sym%withSpinOrbit = .false. + sym%multiplicity = -1 + nullify(sym%indexingAtoms) + sym%vacuum = 0 + end subroutine new_symmetry + + subroutine free_symmetry(sym) + + + type(symmetry_type), intent(inout) :: sym + + if (AB_DBG) write(0,*) "AB symmetry: free a symmetry." + + if (associated(sym%xRed)) deallocate(sym%xRed) + if (associated(sym%spinAt)) deallocate(sym%spinAt) + if (associated(sym%typeAt)) deallocate(sym%typeAt) + if (associated(sym%indexingAtoms)) deallocate(sym%indexingAtoms) + if (associated(sym%sym)) deallocate(sym%sym) + if (associated(sym%symAfm)) deallocate(sym%symAfm) + if (associated(sym%transNon)) deallocate(sym%transNon) + end subroutine free_symmetry + + + + + + subroutine symmetry_new(id) + + +!This section has been created automatically by the script Abilint (TD). +!Do not modify the following lines by hand. +!End of the abilint section + + integer, intent(out) :: id + + type(symmetry_list), pointer :: token + + if (AB_DBG) write(0,*) "AB symmetry: call new symmetry." + call new_item(token) + id = token%id + end subroutine symmetry_new + + subroutine symmetry_free(id) + + +!This section has been created automatically by the script Abilint (TD). +!Do not modify the following lines by hand. +!End of the abilint section + + integer, intent(in) :: id + + type(symmetry_list), pointer :: token + + if (AB_DBG) write(0,*) "AB symmetry: call free symmetry." + + call get_item(token, id) + if (associated(token)) call free_item(token) + end subroutine symmetry_free + + subroutine symmetry_set_tolerance(id, tolsym, errno) + + +!This section has been created automatically by the script Abilint (TD). +!Do not modify the following lines by hand. +!End of the abilint section + + integer, intent(in) :: id + real(dp), intent(in) :: tolsym + integer, intent(out) :: errno + + type(symmetry_list), pointer :: token + + if (AB_DBG) write(0,*) "AB symmetry: call set tolerance." + + errno = AB7_NO_ERROR + call get_item(token, id) + if (.not. associated(token)) then + errno = AB7_ERROR_OBJ + return + end if + + token%data%tolsym = tolsym + + ! We unset all the computed symmetries + token%data%nBravSym = -1 + if (token%data%auto) then + token%data%nSym = 0 + end if + end subroutine symmetry_set_tolerance + + subroutine symmetry_set_lattice(id, rprimd, errno) + + +!This section has been created automatically by the script Abilint (TD). +!Do not modify the following lines by hand. + use interfaces_42_geometry +!End of the abilint section + + integer, intent(in) :: id + real(dp), intent(in) :: rprimd(3,3) + integer, intent(out) :: errno + + type(symmetry_list), pointer :: token + real(dp) :: ucvol + real(dp) :: gmet(3,3) + + if (AB_DBG) write(0,*) "AB symmetry: call set lattice." + if (AB_DBG) write(0, "(A,3F12.6,A)") " (", rprimd(:,1), ")" + if (AB_DBG) write(0, "(A,3F12.6,A)") " (", rprimd(:,2), ")" + if (AB_DBG) write(0, "(A,3F12.6,A)") " (", rprimd(:,3), ")" + + errno = AB7_NO_ERROR + call get_item(token, id) + if (.not. associated(token)) then + errno = AB7_ERROR_OBJ + return + end if + + token%data%rprimd = rprimd + call metric(gmet, token%data%gprimd, -1, token%data%rmet, rprimd, ucvol) + + ! We unset all the computed symmetries + token%data%nBravSym = -1 + if (token%data%auto) then + token%data%nSym = 0 + end if + end subroutine symmetry_set_lattice + + subroutine symmetry_set_structure(id, nAtoms, typeAt, xRed, errno) + + +!This section has been created automatically by the script Abilint (TD). +!Do not modify the following lines by hand. +!End of the abilint section + + integer, intent(in) :: id + integer, intent(in) :: nAtoms + integer, intent(in) :: typeAt(nAtoms) + real(dp), intent(in) :: xRed(3,nAtoms) + integer, intent(out) :: errno + + type(symmetry_list), pointer :: token + integer :: i + + if (AB_DBG) write(0,*) "AB symmetry: call set structure." + if (AB_DBG) write(0, "(A,I3,A)") " ", nAtoms, " atoms" + if (AB_DBG) then + do i = 1, nAtoms, 1 + write(0, "(A,3F12.6,I3)") " ", xRed(:, i), typeAt(i) + end do + end if + + errno = AB7_NO_ERROR + call get_item(token, id) + if (.not. associated(token)) then + errno = AB7_ERROR_OBJ + return + end if + + token%data%nAtoms = nAtoms + allocate(token%data%typeAt(nAtoms)) + token%data%typeAt = typeAt + allocate(token%data%xRed(3, nAtoms)) + token%data%xRed = xRed + + ! We unset only the symmetries + if (token%data%auto) then + token%data%nSym = 0 + end if + if (associated(token%data%indexingAtoms)) deallocate(token%data%indexingAtoms) + end subroutine symmetry_set_structure + + subroutine symmetry_set_spin(id, nAtoms, spinAt, errno) + + +!This section has been created automatically by the script Abilint (TD). +!Do not modify the following lines by hand. +!End of the abilint section + + integer, intent(in) :: id + integer, intent(in) :: nAtoms + real(dp), intent(in) :: spinAt(3,nAtoms) + integer, intent(out) :: errno + + type(symmetry_list), pointer :: token + integer :: i + + if (AB_DBG) write(0,*) "AB symmetry: call set spin." + if (AB_DBG) then + do i = 1, nAtoms, 1 + write(0, "(A,3F12.6)") " ", spinAt(:, i) + end do + end if + + errno = AB7_NO_ERROR + call get_item(token, id) + if (.not. associated(token)) then + errno = AB7_ERROR_OBJ + return + end if + if (token%data%nAtoms /= nAtoms) then + errno = AB7_ERROR_ARG + return + end if + + token%data%withSpin = 4 + allocate(token%data%spinAt(3, nAtoms)) + token%data%spinAt = spinAt + + ! We unset only the symmetries + if (token%data%auto) then + token%data%nSym = 0 + end if + end subroutine symmetry_set_spin + + subroutine symmetry_set_collinear_spin(id, nAtoms, spinAt, errno) + + +!This section has been created automatically by the script Abilint (TD). +!Do not modify the following lines by hand. +!End of the abilint section + + integer, intent(in) :: id + integer, intent(in) :: nAtoms + integer, intent(in) :: spinAt(nAtoms) + integer, intent(out) :: errno + + type(symmetry_list), pointer :: token + integer :: i + + if (AB_DBG) write(0,*) "AB symmetry: call set collinear spin." + if (AB_DBG) then + do i = 1, nAtoms, 1 + write(0, "(A,I3)") " ", spinAt(i) + end do + end if + + errno = AB7_NO_ERROR + call get_item(token, id) + if (.not. associated(token)) then + errno = AB7_ERROR_OBJ + return + end if + if (token%data%nAtoms /= nAtoms) then + errno = AB7_ERROR_ARG + return + end if + + token%data%withSpin = 2 + allocate(token%data%spinAt(1, nAtoms)) + token%data%spinAt = real(reshape(spinAt, (/ 1, nAtoms /)), dp) + + ! We unset only the symmetries + if (token%data%auto) then + token%data%nSym = 0 + end if + end subroutine symmetry_set_collinear_spin + + subroutine symmetry_set_spin_orbit(id, withSpinOrbit, errno) + + +!This section has been created automatically by the script Abilint (TD). +!Do not modify the following lines by hand. +!End of the abilint section + + integer, intent(in) :: id + logical, intent(in) :: withSpinOrbit + integer, intent(out) :: errno + + type(symmetry_list), pointer :: token + + if (AB_DBG) write(0,*) "AB symmetry: call set spin orbit." + + errno = AB7_NO_ERROR + call get_item(token, id) + if (.not. associated(token)) then + errno = AB7_ERROR_OBJ + return + end if + + token%data%withSpinOrbit = withSpinOrbit + + ! We unset only the symmetries + if (token%data%auto) then + token%data%nSym = 0 + end if + end subroutine symmetry_set_spin_orbit + + subroutine symmetry_set_field(id, field, errno) + + +!This section has been created automatically by the script Abilint (TD). +!Do not modify the following lines by hand. +!End of the abilint section + + integer, intent(in) :: id + real(dp), intent(in) :: field(3) + integer, intent(out) :: errno + + type(symmetry_list), pointer :: token + + if (AB_DBG) write(0,*) "AB symmetry: call set field." + + errno = AB7_NO_ERROR + call get_item(token, id) + if (.not. associated(token)) then + errno = AB7_ERROR_OBJ + return + end if + + token%data%withField = .true. + token%data%field = field + + ! We unset all the computed symmetries + token%data%nBravSym = -1 + if (token%data%auto) then + token%data%nSym = 0 + end if + end subroutine symmetry_set_field + + subroutine symmetry_set_jellium(id, jellium, errno) + + +!This section has been created automatically by the script Abilint (TD). +!Do not modify the following lines by hand. +!End of the abilint section + + integer, intent(in) :: id + logical, intent(in) :: jellium + integer, intent(out) :: errno + + type(symmetry_list), pointer :: token + + if (AB_DBG) write(0,*) "AB symmetry: call set jellium." + + errno = AB7_NO_ERROR + call get_item(token, id) + if (.not. associated(token)) then + errno = AB7_ERROR_OBJ + return + end if + + token%data%withJellium = jellium + + ! We unset only the symmetries + if (token%data%auto) then + token%data%nSym = 0 + end if + end subroutine symmetry_set_jellium + + subroutine symmetry_set_periodicity(id, periodic, errno) + + +!This section has been created automatically by the script Abilint (TD). +!Do not modify the following lines by hand. +!End of the abilint section + + integer, intent(in) :: id + logical, intent(in) :: periodic(3) + integer, intent(out) :: errno + + type(symmetry_list), pointer :: token + + if (AB_DBG) write(0,*) "AB symmetry: call set periodicity." + if (AB_DBG) write(0, "(A,3L1,A)") " (", periodic, ")" + + errno = AB7_NO_ERROR + call get_item(token, id) + if (.not. associated(token)) then + errno = AB7_ERROR_OBJ + return + end if + + token%data%vacuum = 0 + if (.not. periodic(1)) token%data%vacuum(1) = 1 + if (.not. periodic(2)) token%data%vacuum(2) = 1 + if (.not. periodic(3)) token%data%vacuum(3) = 1 + end subroutine symmetry_set_periodicity + + + + + + subroutine symmetry_get_n_atoms(id, nAtoms, errno) + !scalars + +!This section has been created automatically by the script Abilint (TD). +!Do not modify the following lines by hand. +!End of the abilint section + + integer, intent(in) :: id + integer, intent(out) :: errno + integer, intent(out) :: nAtoms + + type(symmetry_list), pointer :: token + + if (AB_DBG) write(0,*) "AB symmetry: call get nAtoms." + + errno = AB7_NO_ERROR + call get_item(token, id) + if (.not. associated(token)) then + errno = AB7_ERROR_OBJ + return + end if + + nAtoms = token%data%nAtoms + end subroutine symmetry_get_n_atoms + + subroutine compute_bravais(sym) + + +!This section has been created automatically by the script Abilint (TD). +!Do not modify the following lines by hand. + use interfaces_42_geometry +!End of the abilint section + + type(symmetry_type), intent(inout) :: sym + + integer :: berryopt + + ! We do the computation + if (sym%withField) then + berryopt = 4 + else + berryopt = 0 + end if + if (AB_DBG) write(0,*) "AB symmetry: call ABINIT symlatt." + call symlatt(sym%bravais, AB7_MAX_SYMMETRIES, & + & sym%nBravSym, sym%bravSym, sym%rprimd, sym%tolsym) + if (AB_DBG) write(0,*) "AB symmetry: call ABINIT OK." + if (AB_DBG) write(0, "(A,I3)") " nSymBrav :", sym%nBravSym + if (AB_DBG) write(0, "(A,I3)") " holohedry:", sym%bravais(1) + if (AB_DBG) write(0, "(A,I3)") " center :", sym%bravais(2) + end subroutine compute_bravais + + subroutine symmetry_get_bravais(id, bravais, holohedry, center, & + & nBravSym, bravSym, errno) + !scalars + +!This section has been created automatically by the script Abilint (TD). +!Do not modify the following lines by hand. +!End of the abilint section + + integer, intent(in) :: id + integer, intent(out) :: errno + integer, intent(out) :: nBravSym, holohedry, center + !arrays + integer, intent(out) :: bravais(3,3), bravSym(3, 3, AB7_MAX_SYMMETRIES) + + type(symmetry_list), pointer :: token + + if (AB_DBG) write(0,*) "AB symmetry: call get bravais." + + errno = AB7_NO_ERROR + call get_item(token, id) + if (.not. associated(token)) then + errno = AB7_ERROR_OBJ + return + end if + + if (token%data%nBravSym < 0) then + ! We do the computation + call compute_bravais(token%data) + end if + + holohedry = token%data%bravais(1) + center = token%data%bravais(2) + bravais = reshape(token%data%bravais(3:11), (/ 3,3 /)) + nBravSym = token%data%nBravSym + bravSym(:, :, 1:nBravSym) = token%data%bravSym(:, :, 1:nBravSym) + end subroutine symmetry_get_bravais + + subroutine compute_matrices(sym, errno) + + +!This section has been created automatically by the script Abilint (TD). +!Do not modify the following lines by hand. + use interfaces_42_geometry +!End of the abilint section + + type(symmetry_type), intent(inout) :: sym + integer, intent(out) :: errno + + integer :: berryopt, jellslab, noncol + integer :: use_inversion + real(dp), pointer :: spinAt_(:,:) + integer :: sym_(3, 3, AB7_MAX_SYMMETRIES) + real(dp) :: transNon_(3, AB7_MAX_SYMMETRIES) + integer :: symAfm_(AB7_MAX_SYMMETRIES) + + errno = AB7_NO_ERROR + + if (sym%nBravSym < 0) then + ! We do the computation of the Bravais part. + call compute_bravais(sym) + end if + + if (sym%withField) then + berryopt = 4 + else + berryopt = 0 + end if + if (sym%withJellium) then + jellslab = 1 + else + jellslab = 0 + end if + if (sym%withSpin == 4) then + noncol = 1 + spinAt_ => sym%spinAt + else if (sym%withSpin == 2) then + noncol = 0 + spinAt_ => sym%spinAt + else + noncol = 0 + allocate(spinAt_(3, sym%nAtoms)) + spinAt_ = 0 + end if + if (sym%withSpinOrbit) then + use_inversion = 0 + else + use_inversion = 1 + end if + + if (sym%nsym == 0) then + if (AB_DBG) write(0,*) "AB symmetry: call ABINIT symfind." + call symfind(berryopt, sym%field, sym%gprimd, jellslab, AB7_MAX_SYMMETRIES, & + & sym%nAtoms, noncol, sym%nBravSym, sym%nSym, sym%bravSym, spinAt_, & + & symAfm_, sym_, transNon_, sym%tolsym, sym%typeAt, & + & use_inversion, sym%xRed) + if (AB_DBG) write(0,*) "AB symmetry: call ABINIT OK." + if (AB_DBG) write(0, "(A,I3)") " nSym:", sym%nSym + if (associated(sym%sym)) deallocate(sym%sym) + if (associated(sym%symAfm)) deallocate(sym%symAfm) + if (associated(sym%transNon)) deallocate(sym%transNon) + allocate(sym%sym(3, 3, sym%nSym)) + sym%sym(:,:,:) = sym_(:,:, 1:sym%nSym) + allocate(sym%symAfm(sym%nSym)) + sym%symAfm(:) = symAfm_(1:sym%nSym) + allocate(sym%transNon(3, sym%nSym)) + sym%transNon(:,:) = transNon_(:, 1:sym%nSym) + else if (sym%nsym < 0) then + sym%nsym = -sym%nsym + sym_(:,:, 1:sym%nSym) = sym%sym(:,:,:) + transNon_(:, 1:sym%nSym) = sym%transNon(:,:) + symAfm_(1:sym%nSym) = sym%symAfm(:) + end if + + if (sym%withSpin == 1) then + deallocate(spinAt_) + end if + + if (AB_DBG) write(0,*) "AB symmetry: call ABINIT symanal." + call symanal(sym%bravais, 0, sym%genAfm, AB7_MAX_SYMMETRIES, sym%nSym, & + & sym%pointGroupMagn, sym%rprimd, sym%spaceGroup, symAfm_, & + & sym_, transNon_, sym%tolsym) + if (AB_DBG) write(0,*) "AB symmetry: call ABINIT OK." + sym%transNon(:,:) = transNon_(:, 1:sym%nSym) + + if (sym%bravais(1) < 0) then + sym%multiplicity = 2 + else + sym%multiplicity = 1 + end if + if (AB_DBG) write(0, "(A,I3)") " multi:", sym%multiplicity + if (AB_DBG) write(0, "(A,I3)") " space:", sym%spaceGroup + end subroutine compute_matrices + + subroutine symmetry_get_n_sym(id, nSym, errno) + !scalars + +!This section has been created automatically by the script Abilint (TD). +!Do not modify the following lines by hand. +!End of the abilint section + + integer, intent(in) :: id + integer, intent(out) :: errno + integer, intent(out) :: nSym + + type(symmetry_list), pointer :: token + + if (AB_DBG) write(0,*) "AB symmetry: call get nSym." + + errno = AB7_NO_ERROR + call get_item(token, id) + if (.not. associated(token)) then + errno = AB7_ERROR_OBJ + return + end if + + if (token%data%nSym <= 0) then + ! We do the computation of the matrix part. + call compute_matrices(token%data, errno) + end if + + nSym = token%data%nSym + end subroutine symmetry_get_n_sym + + subroutine symmetry_set_n_sym(id, nSym, sym, transNon, symAfm, errno) + !scalars + +!This section has been created automatically by the script Abilint (TD). +!Do not modify the following lines by hand. +!End of the abilint section + + integer, intent(in) :: id + integer, intent(in) :: nSym + integer, intent(in) :: sym(3, 3, nSym) + real(dp), intent(in) :: transNon(3, nSym) + integer, intent(in) :: symAfm(nSym) + integer, intent(out) :: errno + + type(symmetry_list), pointer :: token + + if (AB_DBG) write(0,*) "AB symmetry: call get nSym." + + errno = AB7_NO_ERROR + call get_item(token, id) + if (.not. associated(token)) then + errno = AB7_ERROR_OBJ + return + end if + + if (nSym <= 0) then + errno = AB7_ERROR_ARG + return + else + allocate(token%data%sym(3, 3, nSym)) + token%data%sym(:,:,:) = sym(:,:,:) + allocate(token%data%symAfm(nSym)) + token%data%symAfm(:) = symAfm(:) + allocate(token%data%transNon(3, nSym)) + token%data%transNon(:,:) = transNon(:,:) + + token%data%auto = .false. + token%data%nsym = -nSym + end if + + ! We do the computation of the matrix part. + call compute_matrices(token%data, errno) + end subroutine symmetry_set_n_sym + + subroutine symmetry_get_matrices(id, nSym, sym, transNon, symAfm, errno) + + +!This section has been created automatically by the script Abilint (TD). +!Do not modify the following lines by hand. +!End of the abilint section + + integer, intent(in) :: id + integer, intent(out) :: errno + integer, intent(out) :: nSym + integer, intent(out) :: sym(3, 3, AB7_MAX_SYMMETRIES) + integer, intent(out) :: symAfm(AB7_MAX_SYMMETRIES) + real(dp), intent(out) :: transNon(3, AB7_MAX_SYMMETRIES) + + type(symmetry_list), pointer :: token + + if (AB_DBG) write(0,*) "AB symmetry: call get matrices." + + errno = AB7_NO_ERROR + call get_item(token, id) + if (.not. associated(token)) then + errno = AB7_ERROR_OBJ + return + end if + + if (token%data%nSym <= 0) then + ! We do the computation of the matrix part. + call compute_matrices(token%data, errno) + end if + + nSym = token%data%nSym + sym(:, :, 1:nSym) = token%data%sym(:, :,:) + symAfm(1:nSym) = token%data%symAfm(:) + transNon(:, 1:nSym) = token%data%transNon(:,:) + end subroutine symmetry_get_matrices + + subroutine symmetry_get_matrices_p(id, nSym, sym, transNon, symAfm, errno) + + +!This section has been created automatically by the script Abilint (TD). +!Do not modify the following lines by hand. +!End of the abilint section + + integer, intent(in) :: id + integer, intent(out) :: errno + integer, intent(out) :: nSym + integer, pointer :: sym(:,:,:) + integer, pointer :: symAfm(:) + real(dp), pointer :: transNon(:,:) + + type(symmetry_list), pointer :: token + + if (AB_DBG) write(0,*) "AB symmetry: call get matrices as pointers." + + errno = AB7_NO_ERROR + call get_item(token, id) + if (.not. associated(token)) then + errno = AB7_ERROR_OBJ + return + end if + + if (token%data%nSym <= 0) then + ! We do the computation of the matrix part. + call compute_matrices(token%data, errno) + end if + + nSym = token%data%nSym + sym => token%data%sym + symAfm => token%data%symAfm + transNon => token%data%transNon + end subroutine symmetry_get_matrices_p + + subroutine symmetry_get_multiplicity(id, multiplicity, errno) + + +!This section has been created automatically by the script Abilint (TD). +!Do not modify the following lines by hand. +!End of the abilint section + + integer, intent(in) :: id + integer, intent(out) :: multiplicity, errno + + type(symmetry_list), pointer :: token + + if (AB_DBG) write(0,*) "AB symmetry: call get multiplicity." + + errno = AB7_NO_ERROR + call get_item(token, id) + if (.not. associated(token)) then + errno = AB7_ERROR_OBJ + return + end if + + if (token%data%multiplicity < 0) then + ! We do the computation of the matrix part. + call compute_matrices(token%data, errno) + end if + multiplicity = token%data%multiplicity + end subroutine symmetry_get_multiplicity + + subroutine symmetry_get_group(id, spaceGroup, spaceGroupId, & + & pointGroupMagn, genAfm, errno) + + +!This section has been created automatically by the script Abilint (TD). +!Do not modify the following lines by hand. + use interfaces_42_geometry +!End of the abilint section + + integer, intent(in) :: id + integer, intent(out) :: errno + real(dp), intent(out) :: genAfm(3) + character(len=15), intent(out) :: spaceGroup + integer, intent(out) :: spaceGroupId, pointGroupMagn + + type(symmetry_list), pointer :: token + integer :: sporder + character(len=1) :: brvLattice + character(len=15) :: ptintsb,ptschsb,schsb,spgrp + character(len=35) :: intsbl + + if (AB_DBG) write(0,*) "AB symmetry: call get group." + + errno = AB7_NO_ERROR + call get_item(token, id) + if (.not. associated(token)) then + errno = AB7_ERROR_OBJ + return + end if + + if (token%data%multiplicity < 0) then + ! We do the computation of the matrix part. + call compute_matrices(token%data, errno) + end if + + if (token%data%multiplicity /= 1) then + errno = AB7_ERROR_SYM_NOT_PRIMITIVE + return + end if + + call spgdata(brvLattice,spgrp,intsbl,ptintsb,ptschsb,& + & schsb,1,token%data%spaceGroup,sporder,1) + + write(spaceGroup, "(3A)") brvLattice, " ", trim(spgrp(1:13)) + pointGroupMagn = token%data%pointGroupMagn + spaceGroupId = token%data%spaceGroup + genAfm = token%data%genAfm + end subroutine symmetry_get_group + + subroutine compute_equivalent_atoms(sym) + + +!This section has been created automatically by the script Abilint (TD). +!Do not modify the following lines by hand. + use interfaces_32_util + use interfaces_42_geometry +!End of the abilint section + + type(symmetry_type), intent(inout) :: sym + + integer, allocatable :: symrec(:,:,:) + integer :: isym + + if (.not. associated(sym%indexingAtoms)) & + & allocate(sym%indexingAtoms(4, sym%nSym, sym%nAtoms)) + + !Get the symmetry matrices in terms of reciprocal basis + allocate(symrec(3, 3, sym%nSym)) + do isym = 1, sym%nSym, 1 + call mati3inv(sym%sym(:,:,isym), symrec(:,:,isym)) + end do + + !Obtain a list of rotated atom labels: + call symatm(sym%indexingAtoms, sym%nAtoms, sym%nSym, symrec, & + & sym%transNon, sym%tolsym, sym%typeAt, sym%xRed) + + deallocate(symrec) + end subroutine compute_equivalent_atoms + + subroutine symmetry_get_equivalent_atom(id, equiv, iAtom, errno) + + +!This section has been created automatically by the script Abilint (TD). +!Do not modify the following lines by hand. +!End of the abilint section + + integer, intent(in) :: id + integer, intent(in) :: iAtom + integer, intent(out) :: equiv(4, AB7_MAX_SYMMETRIES) + integer, intent(out) :: errno + + type(symmetry_list), pointer :: token + + if (AB_DBG) write(0,*) "AB symmetry: call get equivalent." + + errno = AB7_NO_ERROR + call get_item(token, id) + if (.not. associated(token)) then + errno = AB7_ERROR_OBJ + return + end if + + if (iAtom < 1 .or. iAtom > token%data%nAtoms) then + errno = AB7_ERROR_ARG + return + end if + + if (.not. associated(token%data%indexingAtoms)) then + ! We do the computation of the matrix part. + call compute_equivalent_atoms(token%data) + end if + + equiv(:, 1:token%data%nSym) = token%data%indexingAtoms(:,:,iAtom) + end subroutine symmetry_get_equivalent_atom + +end module m_ab7_symmetry diff -urN bigdft-abi-1.0.4.old/libABINIT/src/42_geometry/symfind.F90 bigdft-abi-1.0.4.new/libABINIT/src/42_geometry/symfind.F90 --- bigdft-abi-1.0.4.old/libABINIT/src/42_geometry/symfind.F90 2012-07-09 16:43:33.000000000 +0200 +++ bigdft-abi-1.0.4.new/libABINIT/src/42_geometry/symfind.F90 2013-06-11 16:51:00.000000000 +0200 @@ -49,7 +49,7 @@ !! be 0 0 0 each for a symmorphic space group) !! !! PARENTS -!! ingeo,ab6_symmetry_f90 +!! ingeo,ab7_symmetry_f90 !! !! CHILDREN !! leave_new,wrtout diff -urN bigdft-abi-1.0.4.old/libABINIT/src/56_mixing/findminscf.F90 bigdft-abi-1.0.4.new/libABINIT/src/56_mixing/findminscf.F90 --- bigdft-abi-1.0.4.old/libABINIT/src/56_mixing/findminscf.F90 2012-07-09 16:43:33.000000000 +0200 +++ bigdft-abi-1.0.4.new/libABINIT/src/56_mixing/findminscf.F90 2013-06-11 16:51:00.000000000 +0200 @@ -92,7 +92,7 @@ !write(6,*)' choice,lambda_1,lambda_2=',choice,lambda_1,lambda_2 !ENDDEBUG - errid = AB6_NO_ERROR + errid = AB7_NO_ERROR d_lambda=lambda_1-lambda_2 if(choice==1) then @@ -111,7 +111,7 @@ & +0.5_dp*d2edv2_1*(lambda_2-lambda_1)**2 if(d2edv2_mid<0.0_dp)then - errid = AB6_ERROR_MIXING_INTERNAL + errid = AB7_ERROR_MIXING_INTERNAL write(errmess, '(a,a,a,a,es18.10,a)' ) ch10,& & ' findminscf : WARNING -',ch10,& & ' (scfcge) The second derivative is negative, equal to',d2edv2_mid ,'.' @@ -128,7 +128,7 @@ d2edv2_2=d2edv2_1 d2edv2_predict=d2edv2_1 if(d2edv2_predict<0.0_dp)then - errid = AB6_ERROR_MIXING_INTERNAL + errid = AB7_ERROR_MIXING_INTERNAL write(errmess, '(a,a,a,a,es18.10,a,a,a)' ) ch10,& & ' findmin : WARNING -',ch10,& & ' (scfcge) The second derivative is negative, equal to',d2edv2_predict,'.',& diff -urN bigdft-abi-1.0.4.old/libABINIT/src/56_mixing/m_ab6_mixing.F90 bigdft-abi-1.0.4.new/libABINIT/src/56_mixing/m_ab6_mixing.F90 --- bigdft-abi-1.0.4.old/libABINIT/src/56_mixing/m_ab6_mixing.F90 2012-07-09 16:43:33.000000000 +0200 +++ bigdft-abi-1.0.4.new/libABINIT/src/56_mixing/m_ab6_mixing.F90 1970-01-01 01:00:00.000000000 +0100 @@ -1,688 +0,0 @@ -#if defined HAVE_CONFIG_H -#include "config.h" -#endif - - module m_ab6_mixing - - use m_profiling - use defs_basis - - implicit none - - private - - integer, parameter, public :: AB6_MIXING_NONE = 0 - integer, parameter, public :: AB6_MIXING_EIG = 1 - integer, parameter, public :: AB6_MIXING_SIMPLE = 2 - integer, parameter, public :: AB6_MIXING_ANDERSON = 3 - integer, parameter, public :: AB6_MIXING_ANDERSON_2 = 4 - integer, parameter, public :: AB6_MIXING_CG_ENERGY = 5 - integer, parameter, public :: AB6_MIXING_CG_ENERGY_2 = 6 - integer, parameter, public :: AB6_MIXING_PULAY = 7 - - integer, parameter, public :: AB6_MIXING_POTENTIAL = 0 - integer, parameter, public :: AB6_MIXING_DENSITY = 1 - - integer, parameter, public :: AB6_MIXING_REAL_SPACE = 1 - integer, parameter, public :: AB6_MIXING_FOURRIER_SPACE = 2 - - type, public :: ab6_mixing_object - integer :: iscf - integer :: nfft, nspden, kind, space - - logical :: useprec - integer :: mffmem - character(len = fnlen) :: diskCache - integer :: n_index, n_fftgr, n_pulayit, n_pawmix - integer, dimension(:), pointer :: i_rhor, i_vtrial, i_vresid, i_vrespc - real(dp), dimension(:,:,:), pointer :: f_fftgr, f_atm - real(dp), dimension(:,:), pointer :: f_paw - - ! Private - integer :: n_atom - real(dp), pointer :: xred(:,:), dtn_pc(:,:) - end type ab6_mixing_object - - public :: ab6_mixing_new - public :: ab6_mixing_deallocate - - public :: ab6_mixing_use_disk_cache - public :: ab6_mixing_use_moving_atoms - public :: ab6_mixing_copy_current_step - - public :: ab6_mixing_eval_allocate - public :: ab6_mixing_eval - public :: ab6_mixing_eval_deallocate - - contains - - subroutine init_(mix) - implicit none - - type(ab6_mixing_object), intent(out) :: mix - - ! Default values. - mix%iscf = AB6_MIXING_NONE - mix%mffmem = 1 - mix%n_index = 0 - mix%n_fftgr = 0 - mix%n_pulayit = 7 - mix%n_pawmix = 0 - mix%n_atom = 0 - mix%useprec = .true. - - call nullify_(mix) - end subroutine init_ - - subroutine nullify_(mix) - - - implicit none - - type(ab6_mixing_object), intent(inout) :: mix - - ! Nullify internal pointers. - nullify(mix%i_rhor) - nullify(mix%i_vtrial) - nullify(mix%i_vresid) - nullify(mix%i_vrespc) - nullify(mix%f_fftgr) - nullify(mix%f_atm) - nullify(mix%f_paw) - nullify(mix%dtn_pc) - nullify(mix%xred) - end subroutine nullify_ - - subroutine ab6_mixing_new(mix, iscf, kind, space, nfft, nspden, & - & npawmix, errid, errmess, npulayit, useprec) - implicit none - - type(ab6_mixing_object), intent(out) :: mix - integer, intent(in) :: iscf, kind, space, nfft, nspden, npawmix - integer, intent(out) :: errid - character(len = 500), intent(out) :: errmess - integer, intent(in), optional :: npulayit - logical, intent(in), optional :: useprec - - integer :: ii, i_stat - character(len = *), parameter :: subname = "ab6_mixing_new" - - ! Set default values. - call init_(mix) - - ! Argument checkings. - if (kind /= AB6_MIXING_POTENTIAL .and. kind /= AB6_MIXING_DENSITY) then - errid = AB6_ERROR_MIXING_ARG - write(errmess, '(a,a,a,a)' )ch10,& - & ' ab6_mixing_set_arrays: ERROR -',ch10,& - & ' Mixing must be done on density or potential only.' - return - end if - if (space /= AB6_MIXING_REAL_SPACE .and. & - & space /= AB6_MIXING_FOURRIER_SPACE) then - errid = AB6_ERROR_MIXING_ARG - write(errmess, '(a,a,a,a)' )ch10,& - & ' ab6_mixing_set_arrays: ERROR -',ch10,& - & ' Mixing must be done in real or Fourrier space only.' - return - end if - if (iscf /= AB6_MIXING_EIG .and. iscf /= AB6_MIXING_SIMPLE .and. & - & iscf /= AB6_MIXING_ANDERSON .and. & - & iscf /= AB6_MIXING_ANDERSON_2 .and. & - & iscf /= AB6_MIXING_CG_ENERGY .and. & - & iscf /= AB6_MIXING_PULAY .and. & - & iscf /= AB6_MIXING_CG_ENERGY_2) then - errid = AB6_ERROR_MIXING_ARG - write(errmess, "(A,I0,A)") "Unknown mixing scheme (", iscf, ")." - return - end if - errid = AB6_NO_ERROR - - ! Mandatory arguments. - mix%iscf = iscf - mix%kind = kind - mix%space = space - mix%nfft = nfft - mix%nspden = nspden - mix%n_pawmix = npawmix - - ! Optional arguments. - if (present(useprec)) mix%useprec = useprec - - ! Set-up internal dimensions. - !These arrays are needed only in the self-consistent case - if (iscf == AB6_MIXING_EIG) then - ! For iscf==1, five additional vectors are needed - ! The index 1 is attributed to the old trial potential, - ! The new residual potential, and the new - ! preconditioned residual potential receive now a temporary index - ! The indices number 4 and 5 are attributed to work vectors. - mix%n_fftgr=5 ; mix%n_index=1 - else if(iscf == AB6_MIXING_SIMPLE) then - ! For iscf==2, three additional vectors are needed. - ! The index number 1 is attributed to the old trial vector - ! The new residual potential, and the new preconditioned - ! residual potential, receive now a temporary index. - mix%n_fftgr=3 ; mix%n_index=1 - if (.not. mix%useprec) mix%n_fftgr = 2 - else if(iscf == AB6_MIXING_ANDERSON) then - ! For iscf==3 , four additional vectors are needed. - ! The index number 1 is attributed to the old trial vector - ! The new residual potential, and the new and old preconditioned - ! residual potential, receive now a temporary index. - mix%n_fftgr=4 ; mix%n_index=2 - if (.not. mix%useprec) mix%n_fftgr = 3 - else if (iscf == AB6_MIXING_ANDERSON_2) then - ! For iscf==4 , six additional vectors are needed. - ! The indices number 1 and 2 are attributed to two old trial vectors - ! The new residual potential, and the new and two old preconditioned - ! residual potentials, receive now a temporary index. - mix%n_fftgr=6 ; mix%n_index=3 - if (.not. mix%useprec) mix%n_fftgr = 5 - else if(iscf == AB6_MIXING_CG_ENERGY .or. iscf == AB6_MIXING_CG_ENERGY_2) then - ! For iscf==5 or 6, ten additional vectors are needed - ! The index number 1 is attributed to the old trial vector - ! The index number 6 is attributed to the search vector - ! Other indices are attributed now. Altogether ten vectors - mix%n_fftgr=10 ; mix%n_index=3 - else if(iscf == AB6_MIXING_PULAY) then - ! For iscf==7, lot of additional vectors are needed - ! The index number 1 is attributed to the old trial vector - ! The index number 2 is attributed to the old residual - ! The indices number 2 and 3 are attributed to two old precond. residuals - ! Other indices are attributed now. - if (present(npulayit)) mix%n_pulayit = npulayit - mix%n_fftgr=2+2*mix%n_pulayit ; mix%n_index=1+mix%n_pulayit - if (.not. mix%useprec) mix%n_fftgr = 1+2*mix%n_pulayit - end if ! iscf cases - - ! Allocate new arrays. - allocate(mix%i_rhor(mix%n_index), stat = i_stat) - call memocc(i_stat, mix%i_rhor, 'mix%i_rhor', subname) - allocate(mix%i_vtrial(mix%n_index), stat = i_stat) - call memocc(i_stat, mix%i_vtrial, 'mix%i_vtrial', subname) - allocate(mix%i_vresid(mix%n_index), stat = i_stat) - call memocc(i_stat, mix%i_vresid, 'mix%i_vresid', subname) - allocate(mix%i_vrespc(mix%n_index), stat = i_stat) - call memocc(i_stat, mix%i_vrespc, 'mix%i_vrespc', subname) - - ! Setup initial values. - if (iscf == AB6_MIXING_EIG) then - mix%i_vtrial(1)=1 ; mix%i_vresid(1)=2 ; mix%i_vrespc(1)=3 - else if(iscf == AB6_MIXING_SIMPLE) then - mix%i_vtrial(1)=1 ; mix%i_vresid(1)=2 ; mix%i_vrespc(1)=3 - if (.not. mix%useprec) mix%i_vrespc(1)=2 - else if(iscf == AB6_MIXING_ANDERSON) then - mix%i_vtrial(1)=1 ; mix%i_vresid(1)=2 - if (mix%useprec) then - mix%i_vrespc(1)=3 ; mix%i_vrespc(2)=4 - else - mix%i_vrespc(1)=2 ; mix%i_vrespc(2)=3 - end if - else if (iscf == AB6_MIXING_ANDERSON_2) then - mix%i_vtrial(1)=1 ; mix%i_vtrial(2)=2 - mix%i_vresid(1)=3 - if (mix%useprec) then - mix%i_vrespc(1)=4 ; mix%i_vrespc(2)=5 ; mix%i_vrespc(3)=6 - else - mix%i_vrespc(1)=3 ; mix%i_vrespc(2)=4 ; mix%i_vrespc(3)=5 - end if - else if(iscf == AB6_MIXING_CG_ENERGY .or. & - & iscf == AB6_MIXING_CG_ENERGY_2) then - mix%n_fftgr=10 ; mix%n_index=3 - mix%i_vtrial(1)=1 - mix%i_vresid(1)=2 ; mix%i_vresid(2)=4 ; mix%i_vresid(3)=7 - mix%i_vrespc(1)=3 ; mix%i_vrespc(2)=5 ; mix%i_vrespc(3)=8 - mix%i_rhor(2)=9 ; mix%i_rhor(3)=10 - else if(iscf == AB6_MIXING_PULAY) then - do ii=1,mix%n_pulayit - mix%i_vtrial(ii)=2*ii-1 ; mix%i_vrespc(ii)=2*ii - end do - mix%i_vrespc(mix%n_pulayit+1)=2*mix%n_pulayit+1 - mix%i_vresid(1)=2*mix%n_pulayit+2 - if (.not. mix%useprec) mix%i_vresid(1)=2 - end if ! iscf cases - end subroutine ab6_mixing_new - - subroutine ab6_mixing_use_disk_cache(mix, fnametmp_fft) - - - implicit none - - - type(ab6_mixing_object), intent(inout) :: mix - character(len = *), intent(in) :: fnametmp_fft - - if (len(trim(fnametmp_fft)) > 0) then - mix%mffmem = 0 - write(mix%diskCache, "(A)") fnametmp_fft - else - mix%mffmem = 1 - end if - end subroutine ab6_mixing_use_disk_cache - - subroutine ab6_mixing_use_moving_atoms(mix, natom, xred, dtn_pc) - - - type(ab6_mixing_object), intent(inout) :: mix - integer, intent(in) :: natom - real(dp), intent(in), target :: dtn_pc(3, natom) - real(dp), intent(in), target :: xred(3, natom) - - mix%n_atom = natom - mix%dtn_pc => dtn_pc - mix%xred => xred - end subroutine ab6_mixing_use_moving_atoms - - subroutine ab6_mixing_copy_current_step(mix, arr_resid, errid, errmess, & - & arr_respc, arr_paw_resid, arr_paw_respc, arr_atm) - - - type(ab6_mixing_object), intent(inout) :: mix - real(dp), intent(in) :: arr_resid(mix%space * mix%nfft, mix%nspden) - integer, intent(out) :: errid - character(len = 500), intent(out) :: errmess - real(dp), intent(in), optional :: arr_respc(mix%space * mix%nfft, mix%nspden) - real(dp), intent(in), optional :: arr_paw_resid(mix%n_pawmix), & - & arr_paw_respc(mix%n_pawmix) - real(dp), intent(in), optional :: arr_atm(3, mix%n_atom) - - if (.not. associated(mix%f_fftgr)) then - errid = AB6_ERROR_MIXING_ARG - write(errmess, '(a,a,a,a)' )ch10,& - & ' ab6_mixing_set_arr_current_step: ERROR -',ch10,& - & ' Working arrays not yet allocated.' - return - end if - errid = AB6_NO_ERROR - - mix%f_fftgr(:,:,mix%i_vresid(1)) = arr_resid(:,:) - if (present(arr_respc)) mix%f_fftgr(:,:,mix%i_vrespc(1)) = arr_respc(:,:) - if (present(arr_paw_resid)) mix%f_paw(:, mix%i_vresid(1)) = arr_paw_resid(:) - if (present(arr_paw_respc)) mix%f_paw(:, mix%i_vrespc(1)) = arr_paw_respc(:) - if (present(arr_atm)) mix%f_atm(:,:, mix%i_vresid(1)) = arr_atm(:,:) - end subroutine ab6_mixing_copy_current_step - - subroutine ab6_mixing_eval_allocate(mix, istep) - - -!This section has been created automatically by the script Abilint (TD). -!Do not modify the following lines by hand. - use interfaces_18_timing -!End of the abilint section - - implicit none - - type(ab6_mixing_object), intent(inout) :: mix - integer, intent(in), optional :: istep - - integer :: istep_, i_stat, usepaw - real(dp) :: tsec(2) - character(len = *), parameter :: subname = "ab6_mixing_eval_allocate" - - istep_ = 1 - if (present(istep)) istep_ = istep - - ! Allocate work array. - if (.not. associated(mix%f_fftgr)) then - allocate(mix%f_fftgr(mix%space * mix%nfft,mix%nspden,mix%n_fftgr), stat = i_stat) - call memocc(i_stat, mix%f_fftgr, 'mix%f_fftgr', subname) - mix%f_fftgr(:,:,:)=zero - if (mix%mffmem == 0 .and. istep_ > 1) then - call timab(83,1,tsec) - open(unit=tmp_unit,file=mix%diskCache,form='unformatted',status='old') - rewind(tmp_unit) - read(tmp_unit) mix%f_fftgr - if (mix%n_pawmix == 0) close(unit=tmp_unit) - call timab(83,2,tsec) - end if - end if - ! Allocate PAW work array. - if (.not. associated(mix%f_paw)) then - usepaw = 0 - if (mix%n_pawmix > 0) usepaw = 1 - allocate(mix%f_paw(max(1,mix%n_pawmix),max(1,mix%n_fftgr * usepaw)), & - & stat = i_stat) - call memocc(i_stat, mix%f_paw, 'mix%f_paw', subname) - if (mix%n_pawmix > 0) then - mix%f_paw(:,:)=zero - if (mix%mffmem == 0 .and. istep_ > 1) then - read(tmp_unit) mix%f_paw - close(unit=tmp_unit) - call timab(83,2,tsec) - end if - end if - end if - ! Allocate atom work array. - if (.not. associated(mix%f_atm)) then - allocate(mix%f_atm(3,mix%n_atom,mix%n_fftgr), stat = i_stat) - call memocc(i_stat, mix%f_atm, 'mix%f_atm', subname) - end if - end subroutine ab6_mixing_eval_allocate - - subroutine ab6_mixing_eval_deallocate(mix) - - -!This section has been created automatically by the script Abilint (TD). -!Do not modify the following lines by hand. - use interfaces_18_timing -!End of the abilint section - - implicit none - - type(ab6_mixing_object), intent(inout) :: mix - - integer :: i_all, i_stat - real(dp) :: tsec(2) - character(len = *), parameter :: subname = "ab6_mixing_eval_deallocate" - - ! Save on disk and deallocate work array in case on disk cache only. - if (mix%mffmem == 0) then - call timab(83,1,tsec) - open(unit=tmp_unit,file=mix%diskCache,form='unformatted',status='unknown') - rewind(tmp_unit) - ! VALGRIND complains not all of f_fftgr_disk is initialized - write(tmp_unit) mix%f_fftgr - if (mix%n_pawmix > 0) then - write(tmp_unit) mix%f_paw - end if - close(unit=tmp_unit) - call timab(83,2,tsec) - i_all = -product(shape(mix%f_fftgr))*kind(mix%f_fftgr) - deallocate(mix%f_fftgr, stat = i_stat) - call memocc(i_stat, i_all, 'mix%f_atm', subname) - nullify(mix%f_fftgr) - if (associated(mix%f_paw)) then - i_all = -product(shape(mix%f_paw))*kind(mix%f_paw) - deallocate(mix%f_paw, stat = i_stat) - call memocc(i_stat, i_all, 'mix%f_paw', subname) - nullify(mix%f_paw) - end if - end if - end subroutine ab6_mixing_eval_deallocate - - subroutine ab6_mixing_eval(mix, arr, istep, nfftot, ucvol, & - & mpi_comm, mpi_summarize, errid, errmess, & - & reset, isecur, pawarr, pawopt, response, etotal, potden, & - & resnrm, fnrm, fdot, user_data) - - -!This section has been created automatically by the script Abilint (TD). -!Do not modify the following lines by hand. - use interfaces_56_mixing -!End of the abilint section - - implicit none - - type(ab6_mixing_object), intent(inout) :: mix - integer, intent(in) :: istep, nfftot, mpi_comm - logical, intent(in) :: mpi_summarize - real(dp), intent(in) :: ucvol - real(dp), intent(inout) :: arr(mix%space * mix%nfft,mix%nspden) - integer, intent(out) :: errid - character(len = 500), intent(out) :: errmess - - logical, intent(in), optional :: reset - integer, intent(in), optional :: isecur, pawopt, response - real(dp), intent(inout), optional, target :: pawarr(mix%n_pawmix) - real(dp), intent(in), optional :: etotal - real(dp), intent(in), optional :: potden(mix%space * mix%nfft,mix%nspden) - real(dp), intent(out), optional :: resnrm - optional :: fnrm, fdot - integer, intent(in), optional :: user_data(:) - - interface - function fdot(x,y,cplex,nfft,nspden,opt_denpot,user_data) - integer, intent(in) :: cplex,nfft,nspden,opt_denpot - double precision, intent(in) :: x(*), y(*) - integer, intent(in) :: user_data(:) - - double precision :: fdot - end function fdot - - function fnrm(x,cplex,nfft,nspden,opt_denpot,user_data) - integer, intent(in) :: cplex,nfft,nspden,opt_denpot - double precision, intent(in) :: x(*) - integer, intent(in) :: user_data(:) - - double precision :: fnrm - end function fnrm - end interface - - character(len = *), parameter :: subname = "ab6_mixing_eval" - integer :: moveAtm, dbl_nnsclo, initialized, isecur_ - integer :: usepaw, pawoptmix_, response_, i_stat, i_all - integer :: user_data_(2) - real(dp) :: resnrm_ - real(dp), pointer :: pawarr_(:) - - ! Argument checkings. - if (mix%iscf == AB6_MIXING_NONE) then - errid = AB6_ERROR_MIXING_ARG - write(errmess, '(a,a,a,a)' )ch10,& - & ' ab6_mixing_eval: ERROR -',ch10,& - & ' No method has been chosen.' - return - end if - if (mix%n_pawmix > 0 .and. .not. present(pawarr)) then - errid = AB6_ERROR_MIXING_ARG - write(errmess, '(a,a,a,a)' )ch10,& - & ' ab6_mixing_eval: ERROR -',ch10,& - & ' PAW is used, but no pawarr argument provided.' - return - end if - if (mix%n_atom > 0 .and. (.not. associated(mix%dtn_pc) .or. & - & .not. associated(mix%xred))) then - errid = AB6_ERROR_MIXING_ARG - write(errmess, '(a,a,a,a)' )ch10,& - & ' ab6_mixing_eval: ERROR -',ch10,& - & ' Moving atoms is used, but no xred or dtn_pc attributes provided.' - return - end if - if ((present(fnrm) .or. present(fdot) .or. present(user_data)) .and. & - & .not. (present(fnrm) .and. present(fdot) .and. present(user_data))) then - errid = AB6_ERROR_MIXING_ARG - write(errmess, '(a,a,a,a)' )ch10,& - & ' ab6_mixing_eval: ERROR -',ch10,& - & ' Passing optional norm and dot product routines without user_data argument.' - return - end if - errid = AB6_NO_ERROR - - ! Miscellaneous - moveAtm = 0 - if (mix%n_atom > 0) moveAtm = 1 - initialized = 1 - if (present(reset)) then - if (reset) initialized = 0 - end if - isecur_ = 0 - if (present(isecur)) isecur_ = isecur - usepaw = 0 - if (mix%n_pawmix > 0) usepaw = 1 - pawoptmix_ = 0 - if (present(pawopt)) pawoptmix_ = pawopt - response_ = 0 - if (present(response)) response_ = response - if (present(pawarr)) then - pawarr_ => pawarr - else - allocate(pawarr_(1), stat = i_stat) - call memocc(i_stat, pawarr_, 'pawarr_', subname) - end if - - ! Norm and dot products. - if (.not. present(user_data)) then - user_data_(1) = 0 - if (mpi_summarize) user_data_(1) = 1 - user_data_(2) = mpi_comm - end if - - ! Do the mixing. - resnrm_ = 0.d0 - if (mix%iscf == AB6_MIXING_EIG) then - ! This routine compute the eigenvalues of the SCF operator - call scfeig(istep, mix%space * mix%nfft, mix%nspden, & - & mix%f_fftgr(:,:,mix%i_vrespc(1)), arr, & - & mix%f_fftgr(:,:,1), mix%f_fftgr(:,:,4:5), errid, errmess) - else if (mix%iscf == AB6_MIXING_SIMPLE .or. & - & mix%iscf == AB6_MIXING_ANDERSON .or. & - & mix%iscf == AB6_MIXING_ANDERSON_2 .or. & - & mix%iscf == AB6_MIXING_PULAY) then - if (present(user_data)) then - call scfopt(mix%space, mix%f_fftgr,mix%f_paw,mix%iscf,istep,& - & mix%i_vrespc,mix%i_vtrial, mix%nfft,mix%n_pawmix,mix%nspden, & - & mix%n_fftgr,mix%n_index,mix%kind,pawoptmix_,usepaw,pawarr_, & - & resnrm_, arr, fnrm, fdot, user_data, errid, errmess) - else - call scfopt(mix%space, mix%f_fftgr,mix%f_paw,mix%iscf,istep,& - & mix%i_vrespc,mix%i_vtrial, mix%nfft,mix%n_pawmix,mix%nspden, & - & mix%n_fftgr,mix%n_index,mix%kind,pawoptmix_,usepaw,pawarr_, & - & resnrm_, arr, fnrm_default, fdot_default, user_data_, errid, errmess) - end if - ! Change atomic positions - if((istep==1 .or. mix%iscf==AB6_MIXING_SIMPLE) .and. mix%n_atom > 0)then - ! GAF: 2009-06-03 - ! Apparently there are not reason - ! to restrict iscf=2 for ionmov=5 - mix%xred(:,:) = mix%xred(:,:) + mix%dtn_pc(:,:) - end if - else if (mix%iscf == AB6_MIXING_CG_ENERGY .or. & - & mix%iscf == AB6_MIXING_CG_ENERGY_2) then - ! Optimize next vtrial using an algorithm based - ! on the conjugate gradient minimization of etotal - if (.not. present(etotal) .or. .not. present(potden)) then - errid = AB6_ERROR_MIXING_ARG - write(errmess, '(a,a,a,a)' )ch10,& - & ' ab6_mixing_eval: ERROR -',ch10,& - & ' Arguments etotal or potden are missing for CG on energy methods.' - return - end if - if (mix%n_atom == 0) then - allocate(mix%xred(3,0), stat = i_stat) - call memocc(i_stat, mix%xred, 'mix%xred', subname) - allocate(mix%dtn_pc(3,0), stat = i_stat) - call memocc(i_stat, mix%dtn_pc, 'mix%dtn_pc', subname) - end if - if (present(user_data)) then - call scfcge(mix%space,dbl_nnsclo,mix%dtn_pc,etotal,mix%f_atm,& - & mix%f_fftgr,initialized,mix%iscf,isecur_,istep,& - & mix%i_rhor,mix%i_vresid,mix%i_vrespc,moveAtm,& - & mix%n_atom,mix%nfft,nfftot,& - & mix%nspden,mix%n_fftgr,mix%n_index,mix%kind,& - & response_,potden,ucvol,arr,mix%xred, & - & fnrm, fdot, user_data, errid, errmess) - else - call scfcge(mix%space,dbl_nnsclo,mix%dtn_pc,etotal,mix%f_atm,& - & mix%f_fftgr,initialized,mix%iscf,isecur_,istep,& - & mix%i_rhor,mix%i_vresid,mix%i_vrespc,moveAtm,& - & mix%n_atom,mix%nfft,nfftot,& - & mix%nspden,mix%n_fftgr,mix%n_index,mix%kind,& - & response_,potden,ucvol,arr,mix%xred, fnrm_default, & - & fdotn_default, user_data_, errid, errmess) - end if - if (mix%n_atom == 0) then - i_all = -product(shape(mix%xred))*kind(mix%xred) - deallocate(mix%xred, stat = i_stat) - call memocc(i_stat, i_all, 'mix%xred', subname) - i_all = -product(shape(mix%dtn_pc))*kind(mix%dtn_pc) - deallocate(mix%dtn_pc, stat = i_stat) - call memocc(i_stat, i_all, 'mix%dtn_pc', subname) - end if - if (dbl_nnsclo == 1) errid = AB6_ERROR_MIXING_INC_NNSLOOP - end if - - if (present(resnrm)) resnrm = resnrm_ - if (.not. present(pawarr)) then - i_all = -product(shape(pawarr_))*kind(pawarr_) - deallocate(pawarr_, stat = i_stat) - call memocc(i_stat, i_all, 'pawarr_', subname) - end if - end subroutine ab6_mixing_eval - - subroutine ab6_mixing_deallocate(mix) - implicit none - - type(ab6_mixing_object), intent(inout) :: mix - - integer :: i_all, i_stat - character(len = *), parameter :: subname = "ab6_mixing_deallocate" - - if (associated(mix%i_rhor)) then - i_all = -product(shape(mix%i_rhor))*kind(mix%i_rhor) - deallocate(mix%i_rhor, stat = i_stat) - call memocc(i_stat, i_all, 'mix%i_rhor', subname) - end if - if (associated(mix%i_vtrial)) then - i_all = -product(shape(mix%i_vtrial))*kind(mix%i_vtrial) - deallocate(mix%i_vtrial, stat = i_stat) - call memocc(i_stat, i_all, 'mix%i_vtrial', subname) - end if - if (associated(mix%i_vresid)) then - i_all = -product(shape(mix%i_vresid))*kind(mix%i_vresid) - deallocate(mix%i_vresid, stat = i_stat) - call memocc(i_stat, i_all, 'mix%i_vresid', subname) - end if - if (associated(mix%i_vrespc)) then - i_all = -product(shape(mix%i_vrespc))*kind(mix%i_vrespc) - deallocate(mix%i_vrespc, stat = i_stat) - call memocc(i_stat, i_all, 'mix%i_vrespc', subname) - end if - if (associated(mix%f_fftgr)) then - i_all = -product(shape(mix%f_fftgr))*kind(mix%f_fftgr) - deallocate(mix%f_fftgr, stat = i_stat) - call memocc(i_stat, i_all, 'mix%f_fftgr', subname) - end if - if (associated(mix%f_paw)) then - i_all = -product(shape(mix%f_paw))*kind(mix%f_paw) - deallocate(mix%f_paw, stat = i_stat) - call memocc(i_stat, i_all, 'mix%f_paw', subname) - end if - if (associated(mix%f_atm)) then - i_all = -product(shape(mix%f_atm))*kind(mix%f_atm) - deallocate(mix%f_atm, stat = i_stat) - call memocc(i_stat, i_all, 'mix%f_atm', subname) - end if - - call nullify_(mix) - end subroutine ab6_mixing_deallocate - - function fnrm_default(x,cplex,nfft,nspden,opt_denpot,user_data) - integer, intent(in) :: cplex,nfft,nspden,opt_denpot - double precision, intent(in) :: x(*) - integer, intent(in) :: user_data(:) - - double precision :: fnrm_default - real(dp) :: resid_new(1) - - call sqnormm_v(cplex,1,user_data(2),(user_data(1) /= 0),1,& - & nfft,resid_new,1,nspden,opt_denpot,x) - fnrm_default = resid_new(1) - end function fnrm_default - - function fdot_default(x,y,cplex,nfft,nspden,opt_denpot,user_data) - integer, intent(in) :: cplex,nfft,nspden,opt_denpot - double precision, intent(in) :: x(*), y(*) - integer, intent(in) :: user_data(:) - - double precision :: fdot_default - real(dp) :: prod_resid(1) - - call dotprodm_v(cplex,1,prod_resid,1,1,user_data(2),(user_data(1) /= 0),1,1,& - & nfft,1,1,nspden,opt_denpot,x,y) - fdot_default = prod_resid(1) - end function fdot_default - - function fdotn_default(x,y,cplex,nfft,nspden,opt_denpot,user_data) - integer, intent(in) :: cplex,nfft,nspden,opt_denpot - double precision, intent(in) :: x(*), y(*) - integer, intent(in) :: user_data(:) - - double precision :: fdotn_default - real(dp) :: prod_resid(1,1,1) - - call dotprodm_vn(cplex,1,x,prod_resid,1,1,user_data(2),(user_data(1) /= 0),1,1,& - & 1,nfft,1,nspden,y) - fdotn_default = prod_resid(1,1,1) - end function fdotn_default - end module m_ab6_mixing diff -urN bigdft-abi-1.0.4.old/libABINIT/src/56_mixing/m_ab7_mixing.F90 bigdft-abi-1.0.4.new/libABINIT/src/56_mixing/m_ab7_mixing.F90 --- bigdft-abi-1.0.4.old/libABINIT/src/56_mixing/m_ab7_mixing.F90 1970-01-01 01:00:00.000000000 +0100 +++ bigdft-abi-1.0.4.new/libABINIT/src/56_mixing/m_ab7_mixing.F90 2013-06-11 16:51:00.000000000 +0200 @@ -0,0 +1,688 @@ +#if defined HAVE_CONFIG_H +#include "config.h" +#endif + + module m_ab7_mixing + + use m_profiling + use defs_basis + + implicit none + + private + + integer, parameter, public :: AB7_MIXING_NONE = 0 + integer, parameter, public :: AB7_MIXING_EIG = 1 + integer, parameter, public :: AB7_MIXING_SIMPLE = 2 + integer, parameter, public :: AB7_MIXING_ANDERSON = 3 + integer, parameter, public :: AB7_MIXING_ANDERSON_2 = 4 + integer, parameter, public :: AB7_MIXING_CG_ENERGY = 5 + integer, parameter, public :: AB7_MIXING_CG_ENERGY_2 = 6 + integer, parameter, public :: AB7_MIXING_PULAY = 7 + + integer, parameter, public :: AB7_MIXING_POTENTIAL = 0 + integer, parameter, public :: AB7_MIXING_DENSITY = 1 + + integer, parameter, public :: AB7_MIXING_REAL_SPACE = 1 + integer, parameter, public :: AB7_MIXING_FOURRIER_SPACE = 2 + + type, public :: ab7_mixing_object + integer :: iscf + integer :: nfft, nspden, kind, space + + logical :: useprec + integer :: mffmem + character(len = fnlen) :: diskCache + integer :: n_index, n_fftgr, n_pulayit, n_pawmix + integer, dimension(:), pointer :: i_rhor, i_vtrial, i_vresid, i_vrespc + real(dp), dimension(:,:,:), pointer :: f_fftgr, f_atm + real(dp), dimension(:,:), pointer :: f_paw + + ! Private + integer :: n_atom + real(dp), pointer :: xred(:,:), dtn_pc(:,:) + end type ab7_mixing_object + + public :: ab7_mixing_new + public :: ab7_mixing_deallocate + + public :: ab7_mixing_use_disk_cache + public :: ab7_mixing_use_moving_atoms + public :: ab7_mixing_copy_current_step + + public :: ab7_mixing_eval_allocate + public :: ab7_mixing_eval + public :: ab7_mixing_eval_deallocate + + contains + + subroutine init_(mix) + implicit none + + type(ab7_mixing_object), intent(out) :: mix + + ! Default values. + mix%iscf = AB7_MIXING_NONE + mix%mffmem = 1 + mix%n_index = 0 + mix%n_fftgr = 0 + mix%n_pulayit = 7 + mix%n_pawmix = 0 + mix%n_atom = 0 + mix%useprec = .true. + + call nullify_(mix) + end subroutine init_ + + subroutine nullify_(mix) + + + implicit none + + type(ab7_mixing_object), intent(inout) :: mix + + ! Nullify internal pointers. + nullify(mix%i_rhor) + nullify(mix%i_vtrial) + nullify(mix%i_vresid) + nullify(mix%i_vrespc) + nullify(mix%f_fftgr) + nullify(mix%f_atm) + nullify(mix%f_paw) + nullify(mix%dtn_pc) + nullify(mix%xred) + end subroutine nullify_ + + subroutine ab7_mixing_new(mix, iscf, kind, space, nfft, nspden, & + & npawmix, errid, errmess, npulayit, useprec) + implicit none + + type(ab7_mixing_object), intent(out) :: mix + integer, intent(in) :: iscf, kind, space, nfft, nspden, npawmix + integer, intent(out) :: errid + character(len = 500), intent(out) :: errmess + integer, intent(in), optional :: npulayit + logical, intent(in), optional :: useprec + + integer :: ii, i_stat + character(len = *), parameter :: subname = "ab7_mixing_new" + + ! Set default values. + call init_(mix) + + ! Argument checkings. + if (kind /= AB7_MIXING_POTENTIAL .and. kind /= AB7_MIXING_DENSITY) then + errid = AB7_ERROR_MIXING_ARG + write(errmess, '(a,a,a,a)' )ch10,& + & ' ab7_mixing_set_arrays: ERROR -',ch10,& + & ' Mixing must be done on density or potential only.' + return + end if + if (space /= AB7_MIXING_REAL_SPACE .and. & + & space /= AB7_MIXING_FOURRIER_SPACE) then + errid = AB7_ERROR_MIXING_ARG + write(errmess, '(a,a,a,a)' )ch10,& + & ' ab7_mixing_set_arrays: ERROR -',ch10,& + & ' Mixing must be done in real or Fourrier space only.' + return + end if + if (iscf /= AB7_MIXING_EIG .and. iscf /= AB7_MIXING_SIMPLE .and. & + & iscf /= AB7_MIXING_ANDERSON .and. & + & iscf /= AB7_MIXING_ANDERSON_2 .and. & + & iscf /= AB7_MIXING_CG_ENERGY .and. & + & iscf /= AB7_MIXING_PULAY .and. & + & iscf /= AB7_MIXING_CG_ENERGY_2) then + errid = AB7_ERROR_MIXING_ARG + write(errmess, "(A,I0,A)") "Unknown mixing scheme (", iscf, ")." + return + end if + errid = AB7_NO_ERROR + + ! Mandatory arguments. + mix%iscf = iscf + mix%kind = kind + mix%space = space + mix%nfft = nfft + mix%nspden = nspden + mix%n_pawmix = npawmix + + ! Optional arguments. + if (present(useprec)) mix%useprec = useprec + + ! Set-up internal dimensions. + !These arrays are needed only in the self-consistent case + if (iscf == AB7_MIXING_EIG) then + ! For iscf==1, five additional vectors are needed + ! The index 1 is attributed to the old trial potential, + ! The new residual potential, and the new + ! preconditioned residual potential receive now a temporary index + ! The indices number 4 and 5 are attributed to work vectors. + mix%n_fftgr=5 ; mix%n_index=1 + else if(iscf == AB7_MIXING_SIMPLE) then + ! For iscf==2, three additional vectors are needed. + ! The index number 1 is attributed to the old trial vector + ! The new residual potential, and the new preconditioned + ! residual potential, receive now a temporary index. + mix%n_fftgr=3 ; mix%n_index=1 + if (.not. mix%useprec) mix%n_fftgr = 2 + else if(iscf == AB7_MIXING_ANDERSON) then + ! For iscf==3 , four additional vectors are needed. + ! The index number 1 is attributed to the old trial vector + ! The new residual potential, and the new and old preconditioned + ! residual potential, receive now a temporary index. + mix%n_fftgr=4 ; mix%n_index=2 + if (.not. mix%useprec) mix%n_fftgr = 3 + else if (iscf == AB7_MIXING_ANDERSON_2) then + ! For iscf==4 , six additional vectors are needed. + ! The indices number 1 and 2 are attributed to two old trial vectors + ! The new residual potential, and the new and two old preconditioned + ! residual potentials, receive now a temporary index. + mix%n_fftgr=6 ; mix%n_index=3 + if (.not. mix%useprec) mix%n_fftgr = 5 + else if(iscf == AB7_MIXING_CG_ENERGY .or. iscf == AB7_MIXING_CG_ENERGY_2) then + ! For iscf==5 or 6, ten additional vectors are needed + ! The index number 1 is attributed to the old trial vector + ! The index number 6 is attributed to the search vector + ! Other indices are attributed now. Altogether ten vectors + mix%n_fftgr=10 ; mix%n_index=3 + else if(iscf == AB7_MIXING_PULAY) then + ! For iscf==7, lot of additional vectors are needed + ! The index number 1 is attributed to the old trial vector + ! The index number 2 is attributed to the old residual + ! The indices number 2 and 3 are attributed to two old precond. residuals + ! Other indices are attributed now. + if (present(npulayit)) mix%n_pulayit = npulayit + mix%n_fftgr=2+2*mix%n_pulayit ; mix%n_index=1+mix%n_pulayit + if (.not. mix%useprec) mix%n_fftgr = 1+2*mix%n_pulayit + end if ! iscf cases + + ! Allocate new arrays. + allocate(mix%i_rhor(mix%n_index), stat = i_stat) + call memocc(i_stat, mix%i_rhor, 'mix%i_rhor', subname) + allocate(mix%i_vtrial(mix%n_index), stat = i_stat) + call memocc(i_stat, mix%i_vtrial, 'mix%i_vtrial', subname) + allocate(mix%i_vresid(mix%n_index), stat = i_stat) + call memocc(i_stat, mix%i_vresid, 'mix%i_vresid', subname) + allocate(mix%i_vrespc(mix%n_index), stat = i_stat) + call memocc(i_stat, mix%i_vrespc, 'mix%i_vrespc', subname) + + ! Setup initial values. + if (iscf == AB7_MIXING_EIG) then + mix%i_vtrial(1)=1 ; mix%i_vresid(1)=2 ; mix%i_vrespc(1)=3 + else if(iscf == AB7_MIXING_SIMPLE) then + mix%i_vtrial(1)=1 ; mix%i_vresid(1)=2 ; mix%i_vrespc(1)=3 + if (.not. mix%useprec) mix%i_vrespc(1)=2 + else if(iscf == AB7_MIXING_ANDERSON) then + mix%i_vtrial(1)=1 ; mix%i_vresid(1)=2 + if (mix%useprec) then + mix%i_vrespc(1)=3 ; mix%i_vrespc(2)=4 + else + mix%i_vrespc(1)=2 ; mix%i_vrespc(2)=3 + end if + else if (iscf == AB7_MIXING_ANDERSON_2) then + mix%i_vtrial(1)=1 ; mix%i_vtrial(2)=2 + mix%i_vresid(1)=3 + if (mix%useprec) then + mix%i_vrespc(1)=4 ; mix%i_vrespc(2)=5 ; mix%i_vrespc(3)=6 + else + mix%i_vrespc(1)=3 ; mix%i_vrespc(2)=4 ; mix%i_vrespc(3)=5 + end if + else if(iscf == AB7_MIXING_CG_ENERGY .or. & + & iscf == AB7_MIXING_CG_ENERGY_2) then + mix%n_fftgr=10 ; mix%n_index=3 + mix%i_vtrial(1)=1 + mix%i_vresid(1)=2 ; mix%i_vresid(2)=4 ; mix%i_vresid(3)=7 + mix%i_vrespc(1)=3 ; mix%i_vrespc(2)=5 ; mix%i_vrespc(3)=8 + mix%i_rhor(2)=9 ; mix%i_rhor(3)=10 + else if(iscf == AB7_MIXING_PULAY) then + do ii=1,mix%n_pulayit + mix%i_vtrial(ii)=2*ii-1 ; mix%i_vrespc(ii)=2*ii + end do + mix%i_vrespc(mix%n_pulayit+1)=2*mix%n_pulayit+1 + mix%i_vresid(1)=2*mix%n_pulayit+2 + if (.not. mix%useprec) mix%i_vresid(1)=2 + end if ! iscf cases + end subroutine ab7_mixing_new + + subroutine ab7_mixing_use_disk_cache(mix, fnametmp_fft) + + + implicit none + + + type(ab7_mixing_object), intent(inout) :: mix + character(len = *), intent(in) :: fnametmp_fft + + if (len(trim(fnametmp_fft)) > 0) then + mix%mffmem = 0 + write(mix%diskCache, "(A)") fnametmp_fft + else + mix%mffmem = 1 + end if + end subroutine ab7_mixing_use_disk_cache + + subroutine ab7_mixing_use_moving_atoms(mix, natom, xred, dtn_pc) + + + type(ab7_mixing_object), intent(inout) :: mix + integer, intent(in) :: natom + real(dp), intent(in), target :: dtn_pc(3, natom) + real(dp), intent(in), target :: xred(3, natom) + + mix%n_atom = natom + mix%dtn_pc => dtn_pc + mix%xred => xred + end subroutine ab7_mixing_use_moving_atoms + + subroutine ab7_mixing_copy_current_step(mix, arr_resid, errid, errmess, & + & arr_respc, arr_paw_resid, arr_paw_respc, arr_atm) + + + type(ab7_mixing_object), intent(inout) :: mix + real(dp), intent(in) :: arr_resid(mix%space * mix%nfft, mix%nspden) + integer, intent(out) :: errid + character(len = 500), intent(out) :: errmess + real(dp), intent(in), optional :: arr_respc(mix%space * mix%nfft, mix%nspden) + real(dp), intent(in), optional :: arr_paw_resid(mix%n_pawmix), & + & arr_paw_respc(mix%n_pawmix) + real(dp), intent(in), optional :: arr_atm(3, mix%n_atom) + + if (.not. associated(mix%f_fftgr)) then + errid = AB7_ERROR_MIXING_ARG + write(errmess, '(a,a,a,a)' )ch10,& + & ' ab7_mixing_set_arr_current_step: ERROR -',ch10,& + & ' Working arrays not yet allocated.' + return + end if + errid = AB7_NO_ERROR + + mix%f_fftgr(:,:,mix%i_vresid(1)) = arr_resid(:,:) + if (present(arr_respc)) mix%f_fftgr(:,:,mix%i_vrespc(1)) = arr_respc(:,:) + if (present(arr_paw_resid)) mix%f_paw(:, mix%i_vresid(1)) = arr_paw_resid(:) + if (present(arr_paw_respc)) mix%f_paw(:, mix%i_vrespc(1)) = arr_paw_respc(:) + if (present(arr_atm)) mix%f_atm(:,:, mix%i_vresid(1)) = arr_atm(:,:) + end subroutine ab7_mixing_copy_current_step + + subroutine ab7_mixing_eval_allocate(mix, istep) + + +!This section has been created automatically by the script Abilint (TD). +!Do not modify the following lines by hand. + use interfaces_18_timing +!End of the abilint section + + implicit none + + type(ab7_mixing_object), intent(inout) :: mix + integer, intent(in), optional :: istep + + integer :: istep_, i_stat, usepaw + real(dp) :: tsec(2) + character(len = *), parameter :: subname = "ab7_mixing_eval_allocate" + + istep_ = 1 + if (present(istep)) istep_ = istep + + ! Allocate work array. + if (.not. associated(mix%f_fftgr)) then + allocate(mix%f_fftgr(mix%space * mix%nfft,mix%nspden,mix%n_fftgr), stat = i_stat) + call memocc(i_stat, mix%f_fftgr, 'mix%f_fftgr', subname) + mix%f_fftgr(:,:,:)=zero + if (mix%mffmem == 0 .and. istep_ > 1) then + call timab(83,1,tsec) + open(unit=tmp_unit,file=mix%diskCache,form='unformatted',status='old') + rewind(tmp_unit) + read(tmp_unit) mix%f_fftgr + if (mix%n_pawmix == 0) close(unit=tmp_unit) + call timab(83,2,tsec) + end if + end if + ! Allocate PAW work array. + if (.not. associated(mix%f_paw)) then + usepaw = 0 + if (mix%n_pawmix > 0) usepaw = 1 + allocate(mix%f_paw(max(1,mix%n_pawmix),max(1,mix%n_fftgr * usepaw)), & + & stat = i_stat) + call memocc(i_stat, mix%f_paw, 'mix%f_paw', subname) + if (mix%n_pawmix > 0) then + mix%f_paw(:,:)=zero + if (mix%mffmem == 0 .and. istep_ > 1) then + read(tmp_unit) mix%f_paw + close(unit=tmp_unit) + call timab(83,2,tsec) + end if + end if + end if + ! Allocate atom work array. + if (.not. associated(mix%f_atm)) then + allocate(mix%f_atm(3,mix%n_atom,mix%n_fftgr), stat = i_stat) + call memocc(i_stat, mix%f_atm, 'mix%f_atm', subname) + end if + end subroutine ab7_mixing_eval_allocate + + subroutine ab7_mixing_eval_deallocate(mix) + + +!This section has been created automatically by the script Abilint (TD). +!Do not modify the following lines by hand. + use interfaces_18_timing +!End of the abilint section + + implicit none + + type(ab7_mixing_object), intent(inout) :: mix + + integer :: i_all, i_stat + real(dp) :: tsec(2) + character(len = *), parameter :: subname = "ab7_mixing_eval_deallocate" + + ! Save on disk and deallocate work array in case on disk cache only. + if (mix%mffmem == 0) then + call timab(83,1,tsec) + open(unit=tmp_unit,file=mix%diskCache,form='unformatted',status='unknown') + rewind(tmp_unit) + ! VALGRIND complains not all of f_fftgr_disk is initialized + write(tmp_unit) mix%f_fftgr + if (mix%n_pawmix > 0) then + write(tmp_unit) mix%f_paw + end if + close(unit=tmp_unit) + call timab(83,2,tsec) + i_all = -product(shape(mix%f_fftgr))*kind(mix%f_fftgr) + deallocate(mix%f_fftgr, stat = i_stat) + call memocc(i_stat, i_all, 'mix%f_atm', subname) + nullify(mix%f_fftgr) + if (associated(mix%f_paw)) then + i_all = -product(shape(mix%f_paw))*kind(mix%f_paw) + deallocate(mix%f_paw, stat = i_stat) + call memocc(i_stat, i_all, 'mix%f_paw', subname) + nullify(mix%f_paw) + end if + end if + end subroutine ab7_mixing_eval_deallocate + + subroutine ab7_mixing_eval(mix, arr, istep, nfftot, ucvol, & + & mpi_comm, mpi_summarize, errid, errmess, & + & reset, isecur, pawarr, pawopt, response, etotal, potden, & + & resnrm, fnrm, fdot, user_data) + + +!This section has been created automatically by the script Abilint (TD). +!Do not modify the following lines by hand. + use interfaces_56_mixing +!End of the abilint section + + implicit none + + type(ab7_mixing_object), intent(inout) :: mix + integer, intent(in) :: istep, nfftot, mpi_comm + logical, intent(in) :: mpi_summarize + real(dp), intent(in) :: ucvol + real(dp), intent(inout) :: arr(mix%space * mix%nfft,mix%nspden) + integer, intent(out) :: errid + character(len = 500), intent(out) :: errmess + + logical, intent(in), optional :: reset + integer, intent(in), optional :: isecur, pawopt, response + real(dp), intent(inout), optional, target :: pawarr(mix%n_pawmix) + real(dp), intent(in), optional :: etotal + real(dp), intent(in), optional :: potden(mix%space * mix%nfft,mix%nspden) + real(dp), intent(out), optional :: resnrm + optional :: fnrm, fdot + integer, intent(in), optional :: user_data(:) + + interface + function fdot(x,y,cplex,nfft,nspden,opt_denpot,user_data) + integer, intent(in) :: cplex,nfft,nspden,opt_denpot + double precision, intent(in) :: x(*), y(*) + integer, intent(in) :: user_data(:) + + double precision :: fdot + end function fdot + + function fnrm(x,cplex,nfft,nspden,opt_denpot,user_data) + integer, intent(in) :: cplex,nfft,nspden,opt_denpot + double precision, intent(in) :: x(*) + integer, intent(in) :: user_data(:) + + double precision :: fnrm + end function fnrm + end interface + + character(len = *), parameter :: subname = "ab7_mixing_eval" + integer :: moveAtm, dbl_nnsclo, initialized, isecur_ + integer :: usepaw, pawoptmix_, response_, i_stat, i_all + integer :: user_data_(2) + real(dp) :: resnrm_ + real(dp), pointer :: pawarr_(:) + + ! Argument checkings. + if (mix%iscf == AB7_MIXING_NONE) then + errid = AB7_ERROR_MIXING_ARG + write(errmess, '(a,a,a,a)' )ch10,& + & ' ab7_mixing_eval: ERROR -',ch10,& + & ' No method has been chosen.' + return + end if + if (mix%n_pawmix > 0 .and. .not. present(pawarr)) then + errid = AB7_ERROR_MIXING_ARG + write(errmess, '(a,a,a,a)' )ch10,& + & ' ab7_mixing_eval: ERROR -',ch10,& + & ' PAW is used, but no pawarr argument provided.' + return + end if + if (mix%n_atom > 0 .and. (.not. associated(mix%dtn_pc) .or. & + & .not. associated(mix%xred))) then + errid = AB7_ERROR_MIXING_ARG + write(errmess, '(a,a,a,a)' )ch10,& + & ' ab7_mixing_eval: ERROR -',ch10,& + & ' Moving atoms is used, but no xred or dtn_pc attributes provided.' + return + end if + if ((present(fnrm) .or. present(fdot) .or. present(user_data)) .and. & + & .not. (present(fnrm) .and. present(fdot) .and. present(user_data))) then + errid = AB7_ERROR_MIXING_ARG + write(errmess, '(a,a,a,a)' )ch10,& + & ' ab7_mixing_eval: ERROR -',ch10,& + & ' Passing optional norm and dot product routines without user_data argument.' + return + end if + errid = AB7_NO_ERROR + + ! Miscellaneous + moveAtm = 0 + if (mix%n_atom > 0) moveAtm = 1 + initialized = 1 + if (present(reset)) then + if (reset) initialized = 0 + end if + isecur_ = 0 + if (present(isecur)) isecur_ = isecur + usepaw = 0 + if (mix%n_pawmix > 0) usepaw = 1 + pawoptmix_ = 0 + if (present(pawopt)) pawoptmix_ = pawopt + response_ = 0 + if (present(response)) response_ = response + if (present(pawarr)) then + pawarr_ => pawarr + else + allocate(pawarr_(1), stat = i_stat) + call memocc(i_stat, pawarr_, 'pawarr_', subname) + end if + + ! Norm and dot products. + if (.not. present(user_data)) then + user_data_(1) = 0 + if (mpi_summarize) user_data_(1) = 1 + user_data_(2) = mpi_comm + end if + + ! Do the mixing. + resnrm_ = 0.d0 + if (mix%iscf == AB7_MIXING_EIG) then + ! This routine compute the eigenvalues of the SCF operator + call scfeig(istep, mix%space * mix%nfft, mix%nspden, & + & mix%f_fftgr(:,:,mix%i_vrespc(1)), arr, & + & mix%f_fftgr(:,:,1), mix%f_fftgr(:,:,4:5), errid, errmess) + else if (mix%iscf == AB7_MIXING_SIMPLE .or. & + & mix%iscf == AB7_MIXING_ANDERSON .or. & + & mix%iscf == AB7_MIXING_ANDERSON_2 .or. & + & mix%iscf == AB7_MIXING_PULAY) then + if (present(user_data)) then + call scfopt(mix%space, mix%f_fftgr,mix%f_paw,mix%iscf,istep,& + & mix%i_vrespc,mix%i_vtrial, mix%nfft,mix%n_pawmix,mix%nspden, & + & mix%n_fftgr,mix%n_index,mix%kind,pawoptmix_,usepaw,pawarr_, & + & resnrm_, arr, fnrm, fdot, user_data, errid, errmess) + else + call scfopt(mix%space, mix%f_fftgr,mix%f_paw,mix%iscf,istep,& + & mix%i_vrespc,mix%i_vtrial, mix%nfft,mix%n_pawmix,mix%nspden, & + & mix%n_fftgr,mix%n_index,mix%kind,pawoptmix_,usepaw,pawarr_, & + & resnrm_, arr, fnrm_default, fdot_default, user_data_, errid, errmess) + end if + ! Change atomic positions + if((istep==1 .or. mix%iscf==AB7_MIXING_SIMPLE) .and. mix%n_atom > 0)then + ! GAF: 2009-06-03 + ! Apparently there are not reason + ! to restrict iscf=2 for ionmov=5 + mix%xred(:,:) = mix%xred(:,:) + mix%dtn_pc(:,:) + end if + else if (mix%iscf == AB7_MIXING_CG_ENERGY .or. & + & mix%iscf == AB7_MIXING_CG_ENERGY_2) then + ! Optimize next vtrial using an algorithm based + ! on the conjugate gradient minimization of etotal + if (.not. present(etotal) .or. .not. present(potden)) then + errid = AB7_ERROR_MIXING_ARG + write(errmess, '(a,a,a,a)' )ch10,& + & ' ab7_mixing_eval: ERROR -',ch10,& + & ' Arguments etotal or potden are missing for CG on energy methods.' + return + end if + if (mix%n_atom == 0) then + allocate(mix%xred(3,0), stat = i_stat) + call memocc(i_stat, mix%xred, 'mix%xred', subname) + allocate(mix%dtn_pc(3,0), stat = i_stat) + call memocc(i_stat, mix%dtn_pc, 'mix%dtn_pc', subname) + end if + if (present(user_data)) then + call scfcge(mix%space,dbl_nnsclo,mix%dtn_pc,etotal,mix%f_atm,& + & mix%f_fftgr,initialized,mix%iscf,isecur_,istep,& + & mix%i_rhor,mix%i_vresid,mix%i_vrespc,moveAtm,& + & mix%n_atom,mix%nfft,nfftot,& + & mix%nspden,mix%n_fftgr,mix%n_index,mix%kind,& + & response_,potden,ucvol,arr,mix%xred, & + & fnrm, fdot, user_data, errid, errmess) + else + call scfcge(mix%space,dbl_nnsclo,mix%dtn_pc,etotal,mix%f_atm,& + & mix%f_fftgr,initialized,mix%iscf,isecur_,istep,& + & mix%i_rhor,mix%i_vresid,mix%i_vrespc,moveAtm,& + & mix%n_atom,mix%nfft,nfftot,& + & mix%nspden,mix%n_fftgr,mix%n_index,mix%kind,& + & response_,potden,ucvol,arr,mix%xred, fnrm_default, & + & fdotn_default, user_data_, errid, errmess) + end if + if (mix%n_atom == 0) then + i_all = -product(shape(mix%xred))*kind(mix%xred) + deallocate(mix%xred, stat = i_stat) + call memocc(i_stat, i_all, 'mix%xred', subname) + i_all = -product(shape(mix%dtn_pc))*kind(mix%dtn_pc) + deallocate(mix%dtn_pc, stat = i_stat) + call memocc(i_stat, i_all, 'mix%dtn_pc', subname) + end if + if (dbl_nnsclo == 1) errid = AB7_ERROR_MIXING_INC_NNSLOOP + end if + + if (present(resnrm)) resnrm = resnrm_ + if (.not. present(pawarr)) then + i_all = -product(shape(pawarr_))*kind(pawarr_) + deallocate(pawarr_, stat = i_stat) + call memocc(i_stat, i_all, 'pawarr_', subname) + end if + end subroutine ab7_mixing_eval + + subroutine ab7_mixing_deallocate(mix) + implicit none + + type(ab7_mixing_object), intent(inout) :: mix + + integer :: i_all, i_stat + character(len = *), parameter :: subname = "ab7_mixing_deallocate" + + if (associated(mix%i_rhor)) then + i_all = -product(shape(mix%i_rhor))*kind(mix%i_rhor) + deallocate(mix%i_rhor, stat = i_stat) + call memocc(i_stat, i_all, 'mix%i_rhor', subname) + end if + if (associated(mix%i_vtrial)) then + i_all = -product(shape(mix%i_vtrial))*kind(mix%i_vtrial) + deallocate(mix%i_vtrial, stat = i_stat) + call memocc(i_stat, i_all, 'mix%i_vtrial', subname) + end if + if (associated(mix%i_vresid)) then + i_all = -product(shape(mix%i_vresid))*kind(mix%i_vresid) + deallocate(mix%i_vresid, stat = i_stat) + call memocc(i_stat, i_all, 'mix%i_vresid', subname) + end if + if (associated(mix%i_vrespc)) then + i_all = -product(shape(mix%i_vrespc))*kind(mix%i_vrespc) + deallocate(mix%i_vrespc, stat = i_stat) + call memocc(i_stat, i_all, 'mix%i_vrespc', subname) + end if + if (associated(mix%f_fftgr)) then + i_all = -product(shape(mix%f_fftgr))*kind(mix%f_fftgr) + deallocate(mix%f_fftgr, stat = i_stat) + call memocc(i_stat, i_all, 'mix%f_fftgr', subname) + end if + if (associated(mix%f_paw)) then + i_all = -product(shape(mix%f_paw))*kind(mix%f_paw) + deallocate(mix%f_paw, stat = i_stat) + call memocc(i_stat, i_all, 'mix%f_paw', subname) + end if + if (associated(mix%f_atm)) then + i_all = -product(shape(mix%f_atm))*kind(mix%f_atm) + deallocate(mix%f_atm, stat = i_stat) + call memocc(i_stat, i_all, 'mix%f_atm', subname) + end if + + call nullify_(mix) + end subroutine ab7_mixing_deallocate + + function fnrm_default(x,cplex,nfft,nspden,opt_denpot,user_data) + integer, intent(in) :: cplex,nfft,nspden,opt_denpot + double precision, intent(in) :: x(*) + integer, intent(in) :: user_data(:) + + double precision :: fnrm_default + real(dp) :: resid_new(1) + + call sqnormm_v(cplex,1,user_data(2),(user_data(1) /= 0),1,& + & nfft,resid_new,1,nspden,opt_denpot,x) + fnrm_default = resid_new(1) + end function fnrm_default + + function fdot_default(x,y,cplex,nfft,nspden,opt_denpot,user_data) + integer, intent(in) :: cplex,nfft,nspden,opt_denpot + double precision, intent(in) :: x(*), y(*) + integer, intent(in) :: user_data(:) + + double precision :: fdot_default + real(dp) :: prod_resid(1) + + call dotprodm_v(cplex,1,prod_resid,1,1,user_data(2),(user_data(1) /= 0),1,1,& + & nfft,1,1,nspden,opt_denpot,x,y) + fdot_default = prod_resid(1) + end function fdot_default + + function fdotn_default(x,y,cplex,nfft,nspden,opt_denpot,user_data) + integer, intent(in) :: cplex,nfft,nspden,opt_denpot + double precision, intent(in) :: x(*), y(*) + integer, intent(in) :: user_data(:) + + double precision :: fdotn_default + real(dp) :: prod_resid(1,1,1) + + call dotprodm_vn(cplex,1,x,prod_resid,1,1,user_data(2),(user_data(1) /= 0),1,1,& + & 1,nfft,1,nspden,y) + fdotn_default = prod_resid(1,1,1) + end function fdotn_default + end module m_ab7_mixing diff -urN bigdft-abi-1.0.4.old/libABINIT/src/56_mixing/scfcge.F90 bigdft-abi-1.0.4.new/libABINIT/src/56_mixing/scfcge.F90 --- bigdft-abi-1.0.4.old/libABINIT/src/56_mixing/scfcge.F90 2012-07-09 16:43:33.000000000 +0200 +++ bigdft-abi-1.0.4.new/libABINIT/src/56_mixing/scfcge.F90 2013-06-11 16:51:00.000000000 +0200 @@ -182,7 +182,7 @@ !DEBUG !write(6,*)' scfcge : enter ' !ENDDEBUG - errid = AB6_NO_ERROR + errid = AB7_NO_ERROR dbl_nnsclo = 0 !reduction gives the level of reduction of the error in @@ -318,7 +318,7 @@ & d2edv2_new,d2edv2_old,d2edv2_predict,& & etotal,etotal_old,etotal_predict,& & lambda_new,lambda_old,lambda_predict,errid_,message) - if (errid_ /= AB6_NO_ERROR) then + if (errid_ /= AB7_NO_ERROR) then call wrtout(std_out,message,'COLL') end if @@ -388,7 +388,7 @@ & (abs(lambda_predict)<0.005_dp*lambda_adapt .and. iscf==6).or. & & ilinmin==mlinmin ) )then if(number_of_restart>12)then - errid = AB6_ERROR_MIXING_CONVERGENCE + errid = AB7_ERROR_MIXING_CONVERGENCE write(errmess, '(a,a,a,a,a,i3,a,a,a,a,a)' ) ch10,& & ' scfcge : ERROR -',ch10,& & ' Potential-based CG line minimization not',& @@ -572,7 +572,7 @@ & d2edv2_new,d2edv2_old,d2edv2_predict,& & etotal,etotal_old,etotal_predict,& & lambda_new,lambda_old,lambda_predict,errid_,message) - if (errid_ /= AB6_NO_ERROR) then + if (errid_ /= AB7_NO_ERROR) then call wrtout(std_out,message,'COLL') end if lambda_predict2=0.0_dp @@ -836,7 +836,7 @@ ! End of choice between initialisation or more developed ! parts of the CG algorithm else - errid = AB6_ERROR_MIXING_ARG + errid = AB7_ERROR_MIXING_ARG write(errmess, '(a,a,a,a)' ) ch10,& & ' scfcge : BUG ',ch10,& & ' You should not be here ! ' diff -urN bigdft-abi-1.0.4.old/libABINIT/src/56_mixing/scfeig.F90 bigdft-abi-1.0.4.new/libABINIT/src/56_mixing/scfeig.F90 --- bigdft-abi-1.0.4.old/libABINIT/src/56_mixing/scfeig.F90 2012-07-09 16:43:33.000000000 +0200 +++ bigdft-abi-1.0.4.new/libABINIT/src/56_mixing/scfeig.F90 2013-06-11 16:51:00.000000000 +0200 @@ -71,10 +71,10 @@ ! ************************************************************************* - errid = AB6_NO_ERROR + errid = AB7_NO_ERROR if(nspden==4)then - errid = AB6_ERROR_MIXING_ARG + errid = AB7_ERROR_MIXING_ARG write(errmess, *) ' scfeig : does not work yet for nspden=4' return end if @@ -103,7 +103,7 @@ & ' scfeig : initial PC_residual square =',resid_old call wrtout(std_out,message,'COLL') if(resid_old>1.0d-8)then - errid = AB6_ERROR_MIXING_ARG + errid = AB7_ERROR_MIXING_ARG write(errmess,'(a,a,a,a,a,a,a,a,a,a)') ch10,& & ' scfeig : ERROR -',ch10,& & ' This value is not good enough to allow',ch10,& diff -urN bigdft-abi-1.0.4.old/libABINIT/src/56_mixing/scfopt.F90 bigdft-abi-1.0.4.new/libABINIT/src/56_mixing/scfopt.F90 --- bigdft-abi-1.0.4.old/libABINIT/src/56_mixing/scfopt.F90 2012-07-09 16:43:33.000000000 +0200 +++ bigdft-abi-1.0.4.new/libABINIT/src/56_mixing/scfopt.F90 2013-06-11 16:51:00.000000000 +0200 @@ -136,7 +136,7 @@ !DEBUG !write(6,*)' scfopt : enter ; istep,iscf ',istep,iscf !ENDDEBUG - errid = AB6_NO_ERROR + errid = AB7_NO_ERROR i_vstore=i_vtrial(1) if (iscf==4) i_vstore=i_vtrial(2) @@ -322,7 +322,7 @@ call wrtout(std_out,message,'COLL') if (npulay>npulaymax) then - errid = AB6_ERROR_MIXING_CONVERGENCE + errid = AB7_ERROR_MIXING_CONVERGENCE write(errmess, '(4a)' ) ch10,& & ' scfopt : ERROR - ',ch10,& & ' Too much iterations required for Pulay algorithm (<50) !' diff -urN bigdft-abi-1.0.4.old/libABINIT/src/56_recipspace/m_ab6_kpoints.F90 bigdft-abi-1.0.4.new/libABINIT/src/56_recipspace/m_ab6_kpoints.F90 --- bigdft-abi-1.0.4.old/libABINIT/src/56_recipspace/m_ab6_kpoints.F90 2012-07-09 16:43:33.000000000 +0200 +++ bigdft-abi-1.0.4.new/libABINIT/src/56_recipspace/m_ab6_kpoints.F90 1970-01-01 01:00:00.000000000 +0100 @@ -1,281 +0,0 @@ -!* * Fortran90 source file * -!* -!* Copyright (C) 2008-2011 ABINIT Group (Damien Caliste) -!* All rights reserved. -!* -!* This file is part of the ABINIT software package. For license information, -!* please see the COPYING file in the top-level directory of the ABINIT source -!* distribution. -!* -!* - -#if defined HAVE_CONFIG_H -#include "config.inc" -#endif - -module m_ab6_kpoints - - use defs_basis - use m_ab6_symmetry - - implicit none - - private - - logical, private, parameter :: AB_DBG = .false. - - public :: kpoints_get_irreductible_zone - - public :: kpoints_get_mp_k_grid - public :: kpoints_get_auto_k_grid - - public :: kpoints_binding_mp_k_1 - public :: kpoints_binding_mp_k_2 - public :: kpoints_binding_auto_k_1 - public :: kpoints_binding_auto_k_2 - -contains - - subroutine kpoints_get_irreductible_zone(irrzon, phnons, & - & n1, n2, n3, nsppol, nspden, symid, errno) - - -!This section has been created automatically by the script Abilint (TD). -!Do not modify the following lines by hand. - use interfaces_56_recipspace -!End of the abilint section - - integer, intent(in) :: symid - integer, intent(in) :: n1, n2, n3, nsppol, nspden - integer, intent(out) :: irrzon(n1*n2*n3,2,(nspden/nsppol)-3*(nspden/4)) - real(dp), intent(out) :: phnons(2,n1*n2*n3,(nspden/nsppol)-3*(nspden/4)) - integer, intent(out) :: errno - - type(symmetry_type), pointer :: sym - - if (AB_DBG) write(std_err,*) "AB kpoints: call get irreductible zone." - - errno = AB6_NO_ERROR - call symmetry_get_from_id(sym, symid, errno) - if (errno /= AB6_NO_ERROR) return - - if (sym%withSpin /= nspden) then - errno = AB6_ERROR_ARG - return - end if - - call irrzg(irrzon, nspden, nsppol, sym%nSym, n1, n2, n3, phnons, & - & sym%symAfm, sym%sym, sym%transNon) - end subroutine kpoints_get_irreductible_zone - - - - subroutine kpoints_binding_mp_k_1(symid, nkpt, ngkpt, & - & kptrlatt, kptrlen, nshiftk, shiftk, errno) - - -!This section has been created automatically by the script Abilint (TD). -!Do not modify the following lines by hand. - use interfaces_56_recipspace -!End of the abilint section - - integer, intent(in) :: symid - integer, intent(out) :: errno - integer, intent(in) :: ngkpt(3) - integer, intent(inout) :: nshiftk - real(dp), intent(inout) :: shiftk(3, 8) - real(dp), intent(out) :: kptrlen - integer, intent(out) :: kptrlatt(3,3) - integer, intent(out) :: nkpt - - type(symmetry_type), pointer :: sym - real(dp) :: kpt(3,1), wkpt(1) - - if (AB_DBG) write(std_err,*) "AB symmetry: call get k grid1." - - errno = AB6_NO_ERROR - call symmetry_get_from_id(sym, symid, errno) - if (errno /= AB6_NO_ERROR) return - - ! First, compute the number of kpoints - kptrlatt(:,:) = 0 - kptrlatt(1,1) = ngkpt(1) - kptrlatt(2,2) = ngkpt(2) - kptrlatt(3,3) = ngkpt(3) - kptrlen = 20. - - call getkgrid(6, 1, kpt, 1, kptrlatt, kptrlen, & - & AB6_MAX_SYMMETRIES, 0, nkpt, nshiftk, sym%nSym, & - & sym%rprimd, shiftk, sym%symAfm, sym%sym, & - & sym%vacuum, wkpt) - end subroutine kpoints_binding_mp_k_1 - - subroutine kpoints_binding_mp_k_2(symid, nkpt, kpt, wkpt, & - & kptrlatt, kptrlen, nshiftk, shiftk, errno) - - -!This section has been created automatically by the script Abilint (TD). -!Do not modify the following lines by hand. - use interfaces_56_recipspace -!End of the abilint section - - integer, intent(in) :: symid - integer, intent(out) :: errno - integer, intent(inout) :: nshiftk - real(dp), intent(inout) :: shiftk(3, 8) - integer, intent(in) :: nkpt - real(dp), intent(out) :: kpt(3,nkpt), wkpt(nkpt) - real(dp), intent(inout) :: kptrlen - integer, intent(inout) :: kptrlatt(3,3) - - type(symmetry_type), pointer :: sym - integer :: nkpt_ - - if (AB_DBG) write(std_err,*) "AB symmetry: call get k grid2." - - errno = AB6_NO_ERROR - call symmetry_get_from_id(sym, symid, errno) - if (errno /= AB6_NO_ERROR) return - - ! Then, we call it again to get the actual values for the k points. - call getkgrid(6, 1, kpt, 1, kptrlatt, kptrlen, & - & AB6_MAX_SYMMETRIES, nkpt, nkpt_, nshiftk, sym%nSym, & - & sym%rprimd, shiftk, sym%symAfm, sym%sym, & - & sym%vacuum, wkpt) - end subroutine kpoints_binding_mp_k_2 - - - subroutine kpoints_get_mp_k_grid(symid, nkpt, kpt, wkpt, & - & ngkpt, nshiftk, shiftk, errno) - - integer, intent(in) :: symid - integer, intent(out) :: errno - integer, intent(in) :: ngkpt(3) - integer, intent(in) :: nshiftk - real(dp), intent(in) :: shiftk(3, nshiftk) - integer, intent(out) :: nkpt - real(dp), pointer :: kpt(:,:), wkpt(:) - - real(dp) :: kptrlen - integer :: kptrlatt(3,3) - integer :: nshiftk_ - real(dp) :: shiftk_(3, 8) - - if (AB_DBG) write(std_err,*) "AB symmetry: call get k grid." - - nshiftk_ = nshiftk - shiftk_(:,1:nshiftk_) = shiftk(:,:) - - call kpoints_binding_mp_k_1(symid, nkpt, ngkpt, kptrlatt, kptrlen, & - & nshiftk_, shiftk_, errno) - if (errno /= AB6_NO_ERROR) return - allocate(kpt(3, nkpt)) - allocate(wkpt(nkpt)) - call kpoints_binding_mp_k_2(symid, nkpt, kpt, wkpt, & - & kptrlatt, kptrlen, nshiftk_, shiftk_, errno) - end subroutine kpoints_get_mp_k_grid - - - - subroutine kpoints_binding_auto_k_1(symid, nkpt, kptrlatt, kptrlen, & - & nshiftk, shiftk, errno) - - -!This section has been created automatically by the script Abilint (TD). -!Do not modify the following lines by hand. - use interfaces_56_recipspace -!End of the abilint section - - integer, intent(in) :: symid - integer, intent(out) :: errno - integer, intent(out) :: nkpt - real(dp), intent(inout) :: kptrlen - integer, intent(out) :: nshiftk - real(dp), intent(out) :: shiftk(3, 8) - integer, intent(out) :: kptrlatt(3,3) - - type(symmetry_type), pointer :: sym - real(dp), allocatable :: kpt(:,:), wkpt(:) - - if (AB_DBG) write(std_err,*) "AB symmetry: call get auto k grid1." - - errno = AB6_NO_ERROR - call symmetry_get_from_id(sym, symid, errno) - if (errno /= AB6_NO_ERROR) return - - ! The parameters of the k lattice are not known, compute - ! kptrlatt, nshiftk, shiftk. - call testkgrid(sym%bravais,6,kptrlatt,kptrlen,& - & AB6_MAX_SYMMETRIES,nshiftk,sym%nSym,0,sym%rprimd,& - & shiftk,sym%symAfm,sym%sym,sym%vacuum) - if (AB_DBG) write(std_err,*) "AB symmetry: testkgrid -> kptrlatt=", kptrlatt - - call getkgrid(6, 1, kpt, 1, kptrlatt, kptrlen, & - & AB6_MAX_SYMMETRIES, 0, nkpt, nshiftk, sym%nSym, & - & sym%rprimd, shiftk, sym%symAfm, sym%sym, & - & sym%vacuum, wkpt) - if (AB_DBG) write(std_err,*) "AB symmetry: getkgrid -> nkpt=", nkpt - end subroutine kpoints_binding_auto_k_1 - - - subroutine kpoints_binding_auto_k_2(symid, nkpt, kpt, wkpt, kptrlatt, kptrlen, & - & nshiftk, shiftk, errno) - - -!This section has been created automatically by the script Abilint (TD). -!Do not modify the following lines by hand. - use interfaces_56_recipspace -!End of the abilint section - - integer, intent(in) :: symid - integer, intent(out) :: errno - integer, intent(in) :: nkpt - real(dp), intent(out) :: kpt(3,nkpt), wkpt(nkpt) - real(dp), intent(inout) :: kptrlen - integer, intent(inout) :: nshiftk - real(dp), intent(inout) :: shiftk(3, 8) - integer, intent(inout) :: kptrlatt(3,3) - - type(symmetry_type), pointer :: sym - integer :: nkpt_ - - if (AB_DBG) write(std_err,*) "AB symmetry: call get auto k grid2." - - errno = AB6_NO_ERROR - call symmetry_get_from_id(sym, symid, errno) - if (errno /= AB6_NO_ERROR) return - - ! Then, we call it again to get the actual values for the k points. - call getkgrid(6, 1, kpt, 1, kptrlatt, kptrlen, & - & AB6_MAX_SYMMETRIES, nkpt, nkpt_, nshiftk, sym%nSym, & - & sym%rprimd, shiftk, sym%symAfm, sym%sym, & - & sym%vacuum, wkpt) - end subroutine kpoints_binding_auto_k_2 - - subroutine kpoints_get_auto_k_grid(symid, nkpt, kpt, wkpt, & - & kptrlen, errno) - - integer, intent(in) :: symid - integer, intent(out) :: errno - integer, intent(out) :: nkpt - real(dp), intent(in) :: kptrlen - real(dp), pointer :: kpt(:,:), wkpt(:) - - real(dp) :: kptrlen_ - integer :: kptrlatt(3,3) - integer :: nshiftk - real(dp) :: shiftk(3, 8) - - if (AB_DBG) write(std_err,*) "AB symmetry: call get auto k grid." - - kptrlen_ = kptrlen - call kpoints_binding_auto_k_1(symid, nkpt, kptrlatt, kptrlen_, & - & nshiftk, shiftk, errno) - if (errno /= AB6_NO_ERROR) return - allocate(kpt(3, nkpt)) - allocate(wkpt(nkpt)) - call kpoints_binding_auto_k_2(symid, nkpt, kpt, wkpt, kptrlatt, kptrlen_, & - & nshiftk, shiftk, errno) - end subroutine kpoints_get_auto_k_grid - -end module m_ab6_kpoints diff -urN bigdft-abi-1.0.4.old/libABINIT/src/56_recipspace/m_ab7_kpoints.F90 bigdft-abi-1.0.4.new/libABINIT/src/56_recipspace/m_ab7_kpoints.F90 --- bigdft-abi-1.0.4.old/libABINIT/src/56_recipspace/m_ab7_kpoints.F90 1970-01-01 01:00:00.000000000 +0100 +++ bigdft-abi-1.0.4.new/libABINIT/src/56_recipspace/m_ab7_kpoints.F90 2013-06-11 16:51:00.000000000 +0200 @@ -0,0 +1,281 @@ +!* * Fortran90 source file * +!* +!* Copyright (C) 2008-2011 ABINIT Group (Damien Caliste) +!* All rights reserved. +!* +!* This file is part of the ABINIT software package. For license information, +!* please see the COPYING file in the top-level directory of the ABINIT source +!* distribution. +!* +!* + +#if defined HAVE_CONFIG_H +#include "config.inc" +#endif + +module m_ab7_kpoints + + use defs_basis + use m_ab7_symmetry + + implicit none + + private + + logical, private, parameter :: AB_DBG = .false. + + public :: kpoints_get_irreductible_zone + + public :: kpoints_get_mp_k_grid + public :: kpoints_get_auto_k_grid + + public :: kpoints_binding_mp_k_1 + public :: kpoints_binding_mp_k_2 + public :: kpoints_binding_auto_k_1 + public :: kpoints_binding_auto_k_2 + +contains + + subroutine kpoints_get_irreductible_zone(irrzon, phnons, & + & n1, n2, n3, nsppol, nspden, symid, errno) + + +!This section has been created automatically by the script Abilint (TD). +!Do not modify the following lines by hand. + use interfaces_56_recipspace +!End of the abilint section + + integer, intent(in) :: symid + integer, intent(in) :: n1, n2, n3, nsppol, nspden + integer, intent(out) :: irrzon(n1*n2*n3,2,(nspden/nsppol)-3*(nspden/4)) + real(dp), intent(out) :: phnons(2,n1*n2*n3,(nspden/nsppol)-3*(nspden/4)) + integer, intent(out) :: errno + + type(symmetry_type), pointer :: sym + + if (AB_DBG) write(std_err,*) "AB kpoints: call get irreductible zone." + + errno = AB7_NO_ERROR + call symmetry_get_from_id(sym, symid, errno) + if (errno /= AB7_NO_ERROR) return + + if (sym%withSpin /= nspden) then + errno = AB7_ERROR_ARG + return + end if + + call irrzg(irrzon, nspden, nsppol, sym%nSym, n1, n2, n3, phnons, & + & sym%symAfm, sym%sym, sym%transNon) + end subroutine kpoints_get_irreductible_zone + + + + subroutine kpoints_binding_mp_k_1(symid, nkpt, ngkpt, & + & kptrlatt, kptrlen, nshiftk, shiftk, errno) + + +!This section has been created automatically by the script Abilint (TD). +!Do not modify the following lines by hand. + use interfaces_56_recipspace +!End of the abilint section + + integer, intent(in) :: symid + integer, intent(out) :: errno + integer, intent(in) :: ngkpt(3) + integer, intent(inout) :: nshiftk + real(dp), intent(inout) :: shiftk(3, 8) + real(dp), intent(out) :: kptrlen + integer, intent(out) :: kptrlatt(3,3) + integer, intent(out) :: nkpt + + type(symmetry_type), pointer :: sym + real(dp) :: kpt(3,1), wkpt(1) + + if (AB_DBG) write(std_err,*) "AB symmetry: call get k grid1." + + errno = AB7_NO_ERROR + call symmetry_get_from_id(sym, symid, errno) + if (errno /= AB7_NO_ERROR) return + + ! First, compute the number of kpoints + kptrlatt(:,:) = 0 + kptrlatt(1,1) = ngkpt(1) + kptrlatt(2,2) = ngkpt(2) + kptrlatt(3,3) = ngkpt(3) + kptrlen = 20. + + call getkgrid(6, 1, kpt, 1, kptrlatt, kptrlen, & + & AB7_MAX_SYMMETRIES, 0, nkpt, nshiftk, sym%nSym, & + & sym%rprimd, shiftk, sym%symAfm, sym%sym, & + & sym%vacuum, wkpt) + end subroutine kpoints_binding_mp_k_1 + + subroutine kpoints_binding_mp_k_2(symid, nkpt, kpt, wkpt, & + & kptrlatt, kptrlen, nshiftk, shiftk, errno) + + +!This section has been created automatically by the script Abilint (TD). +!Do not modify the following lines by hand. + use interfaces_56_recipspace +!End of the abilint section + + integer, intent(in) :: symid + integer, intent(out) :: errno + integer, intent(inout) :: nshiftk + real(dp), intent(inout) :: shiftk(3, 8) + integer, intent(in) :: nkpt + real(dp), intent(out) :: kpt(3,nkpt), wkpt(nkpt) + real(dp), intent(inout) :: kptrlen + integer, intent(inout) :: kptrlatt(3,3) + + type(symmetry_type), pointer :: sym + integer :: nkpt_ + + if (AB_DBG) write(std_err,*) "AB symmetry: call get k grid2." + + errno = AB7_NO_ERROR + call symmetry_get_from_id(sym, symid, errno) + if (errno /= AB7_NO_ERROR) return + + ! Then, we call it again to get the actual values for the k points. + call getkgrid(6, 1, kpt, 1, kptrlatt, kptrlen, & + & AB7_MAX_SYMMETRIES, nkpt, nkpt_, nshiftk, sym%nSym, & + & sym%rprimd, shiftk, sym%symAfm, sym%sym, & + & sym%vacuum, wkpt) + end subroutine kpoints_binding_mp_k_2 + + + subroutine kpoints_get_mp_k_grid(symid, nkpt, kpt, wkpt, & + & ngkpt, nshiftk, shiftk, errno) + + integer, intent(in) :: symid + integer, intent(out) :: errno + integer, intent(in) :: ngkpt(3) + integer, intent(in) :: nshiftk + real(dp), intent(in) :: shiftk(3, nshiftk) + integer, intent(out) :: nkpt + real(dp), pointer :: kpt(:,:), wkpt(:) + + real(dp) :: kptrlen + integer :: kptrlatt(3,3) + integer :: nshiftk_ + real(dp) :: shiftk_(3, 8) + + if (AB_DBG) write(std_err,*) "AB symmetry: call get k grid." + + nshiftk_ = nshiftk + shiftk_(:,1:nshiftk_) = shiftk(:,:) + + call kpoints_binding_mp_k_1(symid, nkpt, ngkpt, kptrlatt, kptrlen, & + & nshiftk_, shiftk_, errno) + if (errno /= AB7_NO_ERROR) return + allocate(kpt(3, nkpt)) + allocate(wkpt(nkpt)) + call kpoints_binding_mp_k_2(symid, nkpt, kpt, wkpt, & + & kptrlatt, kptrlen, nshiftk_, shiftk_, errno) + end subroutine kpoints_get_mp_k_grid + + + + subroutine kpoints_binding_auto_k_1(symid, nkpt, kptrlatt, kptrlen, & + & nshiftk, shiftk, errno) + + +!This section has been created automatically by the script Abilint (TD). +!Do not modify the following lines by hand. + use interfaces_56_recipspace +!End of the abilint section + + integer, intent(in) :: symid + integer, intent(out) :: errno + integer, intent(out) :: nkpt + real(dp), intent(inout) :: kptrlen + integer, intent(out) :: nshiftk + real(dp), intent(out) :: shiftk(3, 8) + integer, intent(out) :: kptrlatt(3,3) + + type(symmetry_type), pointer :: sym + real(dp), allocatable :: kpt(:,:), wkpt(:) + + if (AB_DBG) write(std_err,*) "AB symmetry: call get auto k grid1." + + errno = AB7_NO_ERROR + call symmetry_get_from_id(sym, symid, errno) + if (errno /= AB7_NO_ERROR) return + + ! The parameters of the k lattice are not known, compute + ! kptrlatt, nshiftk, shiftk. + call testkgrid(sym%bravais,6,kptrlatt,kptrlen,& + & AB7_MAX_SYMMETRIES,nshiftk,sym%nSym,0,sym%rprimd,& + & shiftk,sym%symAfm,sym%sym,sym%vacuum) + if (AB_DBG) write(std_err,*) "AB symmetry: testkgrid -> kptrlatt=", kptrlatt + + call getkgrid(6, 1, kpt, 1, kptrlatt, kptrlen, & + & AB7_MAX_SYMMETRIES, 0, nkpt, nshiftk, sym%nSym, & + & sym%rprimd, shiftk, sym%symAfm, sym%sym, & + & sym%vacuum, wkpt) + if (AB_DBG) write(std_err,*) "AB symmetry: getkgrid -> nkpt=", nkpt + end subroutine kpoints_binding_auto_k_1 + + + subroutine kpoints_binding_auto_k_2(symid, nkpt, kpt, wkpt, kptrlatt, kptrlen, & + & nshiftk, shiftk, errno) + + +!This section has been created automatically by the script Abilint (TD). +!Do not modify the following lines by hand. + use interfaces_56_recipspace +!End of the abilint section + + integer, intent(in) :: symid + integer, intent(out) :: errno + integer, intent(in) :: nkpt + real(dp), intent(out) :: kpt(3,nkpt), wkpt(nkpt) + real(dp), intent(inout) :: kptrlen + integer, intent(inout) :: nshiftk + real(dp), intent(inout) :: shiftk(3, 8) + integer, intent(inout) :: kptrlatt(3,3) + + type(symmetry_type), pointer :: sym + integer :: nkpt_ + + if (AB_DBG) write(std_err,*) "AB symmetry: call get auto k grid2." + + errno = AB7_NO_ERROR + call symmetry_get_from_id(sym, symid, errno) + if (errno /= AB7_NO_ERROR) return + + ! Then, we call it again to get the actual values for the k points. + call getkgrid(6, 1, kpt, 1, kptrlatt, kptrlen, & + & AB7_MAX_SYMMETRIES, nkpt, nkpt_, nshiftk, sym%nSym, & + & sym%rprimd, shiftk, sym%symAfm, sym%sym, & + & sym%vacuum, wkpt) + end subroutine kpoints_binding_auto_k_2 + + subroutine kpoints_get_auto_k_grid(symid, nkpt, kpt, wkpt, & + & kptrlen, errno) + + integer, intent(in) :: symid + integer, intent(out) :: errno + integer, intent(out) :: nkpt + real(dp), intent(in) :: kptrlen + real(dp), pointer :: kpt(:,:), wkpt(:) + + real(dp) :: kptrlen_ + integer :: kptrlatt(3,3) + integer :: nshiftk + real(dp) :: shiftk(3, 8) + + if (AB_DBG) write(std_err,*) "AB symmetry: call get auto k grid." + + kptrlen_ = kptrlen + call kpoints_binding_auto_k_1(symid, nkpt, kptrlatt, kptrlen_, & + & nshiftk, shiftk, errno) + if (errno /= AB7_NO_ERROR) return + allocate(kpt(3, nkpt)) + allocate(wkpt(nkpt)) + call kpoints_binding_auto_k_2(symid, nkpt, kpt, wkpt, kptrlatt, kptrlen_, & + & nshiftk, shiftk, errno) + end subroutine kpoints_get_auto_k_grid + +end module m_ab7_kpoints diff -urN bigdft-abi-1.0.4.old/libABINIT/src/72_geomoptim/ab6_moldyn.F90 bigdft-abi-1.0.4.new/libABINIT/src/72_geomoptim/ab6_moldyn.F90 --- bigdft-abi-1.0.4.old/libABINIT/src/72_geomoptim/ab6_moldyn.F90 2012-07-09 16:43:33.000000000 +0200 +++ bigdft-abi-1.0.4.new/libABINIT/src/72_geomoptim/ab6_moldyn.F90 1970-01-01 01:00:00.000000000 +0100 @@ -1,42 +0,0 @@ -module ab6_moldyn - - use defs_basis - - implicit none - - interface - subroutine scfloop_main(acell, epot, fcart, grad, itime, me, natom, rprimd, xred) - use defs_basis - - integer, intent(in) :: natom, itime, me - real(dp), intent(out) :: epot - real(dp), intent(in) :: acell(3) - real(dp), intent(in) :: rprimd(3,3), xred(3,natom) - real(dp), intent(out) :: fcart(3, natom), grad(3, natom) - end subroutine scfloop_main - end interface - - interface - subroutine scfloop_output(acell, epot, ekin, fred, itime, me, natom, rprimd, vel, xred) - use defs_basis - - integer, intent(in) :: natom, itime, me - real(dp), intent(in) :: epot, ekin - real(dp), intent(in) :: acell(3) - real(dp), intent(in) :: rprimd(3,3), xred(3,natom) - real(dp), intent(in) :: fred(3, natom), vel(3, natom) - end subroutine scfloop_output - end interface - -contains - - include "velocity_verlet.F90" - include "quenched.F90" - include "langevin.F90" - include "nose.F90" - include "isokinetic.F90" - include "isotemp.F90" - include "isothermal.F90" - include "moldyn.F90" - -end module ab6_moldyn diff -urN bigdft-abi-1.0.4.old/libABINIT/src/72_geomoptim/ab7_moldyn.F90 bigdft-abi-1.0.4.new/libABINIT/src/72_geomoptim/ab7_moldyn.F90 --- bigdft-abi-1.0.4.old/libABINIT/src/72_geomoptim/ab7_moldyn.F90 1970-01-01 01:00:00.000000000 +0100 +++ bigdft-abi-1.0.4.new/libABINIT/src/72_geomoptim/ab7_moldyn.F90 2013-06-11 16:51:00.000000000 +0200 @@ -0,0 +1,42 @@ +module ab7_moldyn + + use defs_basis + + implicit none + + interface + subroutine scfloop_main(acell, epot, fcart, grad, itime, me, natom, rprimd, xred) + use defs_basis + + integer, intent(in) :: natom, itime, me + real(dp), intent(out) :: epot + real(dp), intent(in) :: acell(3) + real(dp), intent(in) :: rprimd(3,3), xred(3,natom) + real(dp), intent(out) :: fcart(3, natom), grad(3, natom) + end subroutine scfloop_main + end interface + + interface + subroutine scfloop_output(acell, epot, ekin, fred, itime, me, natom, rprimd, vel, xred) + use defs_basis + + integer, intent(in) :: natom, itime, me + real(dp), intent(in) :: epot, ekin + real(dp), intent(in) :: acell(3) + real(dp), intent(in) :: rprimd(3,3), xred(3,natom) + real(dp), intent(in) :: fred(3, natom), vel(3, natom) + end subroutine scfloop_output + end interface + +contains + + include "velocity_verlet.F90" + include "quenched.F90" + include "langevin.F90" + include "nose.F90" + include "isokinetic.F90" + include "isotemp.F90" + include "isothermal.F90" + include "moldyn.F90" + +end module ab7_moldyn diff -urN bigdft-abi-1.0.4.old/libABINIT/src/Makefile.am bigdft-abi-1.0.4.new/libABINIT/src/Makefile.am --- bigdft-abi-1.0.4.old/libABINIT/src/Makefile.am 2012-11-08 11:12:57.000000000 +0100 +++ bigdft-abi-1.0.4.new/libABINIT/src/Makefile.am 2013-06-11 16:51:00.000000000 +0200 @@ -85,7 +85,7 @@ 42_geometry/getspinrot.F90 \ 42_geometry/gridgcart.F90 \ 42_geometry/holocell.F90 \ - 42_geometry/m_ab6_symmetry.F90 \ + 42_geometry/m_ab7_symmetry.F90 \ 42_geometry/metric.F90 \ 42_geometry/mkrdim.F90 \ 42_geometry/operat.F90 \ @@ -128,14 +128,14 @@ 56_mixing/dotprodm_vn.F90 \ 56_mixing/findminscf.F90 \ 56_mixing/interfaces_56_mixing.F90 \ - 56_mixing/m_ab6_mixing.F90 \ + 56_mixing/m_ab7_mixing.F90 \ 56_mixing/scfcge.F90 \ 56_mixing/scfeig.F90 \ 56_mixing/scfopt.F90 \ 56_mixing/sqnormm_v.F90 \ 56_recipspace/interfaces_56_recipspace.F90 \ 56_recipspace/irrzg.F90 \ - 56_recipspace/m_ab6_kpoints.F90 \ + 56_recipspace/m_ab7_kpoints.F90 \ 56_recipspace/getkgrid.F90 \ 56_recipspace/smpbz.F90 \ 56_recipspace/symkpt.F90 \ @@ -159,7 +159,7 @@ 67_common/ewald2.F90 \ 67_common/fconv.F90 \ 67_common/prtxvf.F90 \ - 72_geomoptim/ab6_moldyn.F90 \ + 72_geomoptim/ab7_moldyn.F90 \ 72_geomoptim/xfpack.F90 CLEANFILES = mpif.h *.@MODULE_EXT@ diff -urN bigdft-abi-1.0.4.old/libABINIT/src/Makefile.in bigdft-abi-1.0.4.new/libABINIT/src/Makefile.in --- bigdft-abi-1.0.4.old/libABINIT/src/Makefile.in 2013-01-28 14:39:34.000000000 +0100 +++ bigdft-abi-1.0.4.new/libABINIT/src/Makefile.in 2013-06-11 16:51:00.000000000 +0200 @@ -91,7 +91,7 @@ gensymshub4.$(OBJEXT) gensymshub.$(OBJEXT) \ gensymspgr.$(OBJEXT) getptgroupma.$(OBJEXT) \ getspinrot.$(OBJEXT) gridgcart.$(OBJEXT) holocell.$(OBJEXT) \ - m_ab6_symmetry.$(OBJEXT) metric.$(OBJEXT) mkrdim.$(OBJEXT) \ + m_ab7_symmetry.$(OBJEXT) metric.$(OBJEXT) mkrdim.$(OBJEXT) \ operat.$(OBJEXT) prtspgroup.$(OBJEXT) ptgmadata.$(OBJEXT) \ smallprim.$(OBJEXT) spgdata.$(OBJEXT) strainsym.$(OBJEXT) \ strconv.$(OBJEXT) stresssym.$(OBJEXT) sym2cart.$(OBJEXT) \ @@ -106,10 +106,10 @@ symzat.$(OBJEXT) xredxcart.$(OBJEXT) defs_abitypes.$(OBJEXT) \ aprxdr.$(OBJEXT) dotprodm_v.$(OBJEXT) dotprodm_vn.$(OBJEXT) \ findminscf.$(OBJEXT) interfaces_56_mixing.$(OBJEXT) \ - m_ab6_mixing.$(OBJEXT) scfcge.$(OBJEXT) scfeig.$(OBJEXT) \ + m_ab7_mixing.$(OBJEXT) scfcge.$(OBJEXT) scfeig.$(OBJEXT) \ scfopt.$(OBJEXT) sqnormm_v.$(OBJEXT) \ interfaces_56_recipspace.$(OBJEXT) irrzg.$(OBJEXT) \ - m_ab6_kpoints.$(OBJEXT) getkgrid.$(OBJEXT) smpbz.$(OBJEXT) \ + m_ab7_kpoints.$(OBJEXT) getkgrid.$(OBJEXT) smpbz.$(OBJEXT) \ symkpt.$(OBJEXT) testkgrid.$(OBJEXT) \ interfaces_56_xc.$(OBJEXT) drivexc.$(OBJEXT) invcb.$(OBJEXT) \ mkdenpos.$(OBJEXT) m_libxc_functionals.$(OBJEXT) \ @@ -117,7 +117,7 @@ xclb.$(OBJEXT) xcpbe.$(OBJEXT) xcpzca.$(OBJEXT) \ xcspol.$(OBJEXT) xctetr.$(OBJEXT) xcwign.$(OBJEXT) \ xcxalp.$(OBJEXT) ewald.$(OBJEXT) ewald2.$(OBJEXT) \ - fconv.$(OBJEXT) prtxvf.$(OBJEXT) ab6_moldyn.$(OBJEXT) \ + fconv.$(OBJEXT) prtxvf.$(OBJEXT) ab7_moldyn.$(OBJEXT) \ xfpack.$(OBJEXT) libabinit_a_OBJECTS = $(am_libabinit_a_OBJECTS) DEFAULT_INCLUDES = -I.@am__isrc@ -I$(top_builddir) @@ -352,7 +352,7 @@ 42_geometry/getspinrot.F90 \ 42_geometry/gridgcart.F90 \ 42_geometry/holocell.F90 \ - 42_geometry/m_ab6_symmetry.F90 \ + 42_geometry/m_ab7_symmetry.F90 \ 42_geometry/metric.F90 \ 42_geometry/mkrdim.F90 \ 42_geometry/operat.F90 \ @@ -395,14 +395,14 @@ 56_mixing/dotprodm_vn.F90 \ 56_mixing/findminscf.F90 \ 56_mixing/interfaces_56_mixing.F90 \ - 56_mixing/m_ab6_mixing.F90 \ + 56_mixing/m_ab7_mixing.F90 \ 56_mixing/scfcge.F90 \ 56_mixing/scfeig.F90 \ 56_mixing/scfopt.F90 \ 56_mixing/sqnormm_v.F90 \ 56_recipspace/interfaces_56_recipspace.F90 \ 56_recipspace/irrzg.F90 \ - 56_recipspace/m_ab6_kpoints.F90 \ + 56_recipspace/m_ab7_kpoints.F90 \ 56_recipspace/getkgrid.F90 \ 56_recipspace/smpbz.F90 \ 56_recipspace/symkpt.F90 \ @@ -426,7 +426,7 @@ 67_common/ewald2.F90 \ 67_common/fconv.F90 \ 67_common/prtxvf.F90 \ - 72_geomoptim/ab6_moldyn.F90 \ + 72_geomoptim/ab7_moldyn.F90 \ 72_geomoptim/xfpack.F90 CLEANFILES = mpif.h *.@MODULE_EXT@ @@ -633,8 +633,8 @@ holocell.obj: 42_geometry/holocell.F90 $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o holocell.obj `if test -f '42_geometry/holocell.F90'; then $(CYGPATH_W) '42_geometry/holocell.F90'; else $(CYGPATH_W) '$(srcdir)/42_geometry/holocell.F90'; fi` -m_ab6_symmetry.obj: 42_geometry/m_ab6_symmetry.F90 - $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o m_ab6_symmetry.obj `if test -f '42_geometry/m_ab6_symmetry.F90'; then $(CYGPATH_W) '42_geometry/m_ab6_symmetry.F90'; else $(CYGPATH_W) '$(srcdir)/42_geometry/m_ab6_symmetry.F90'; fi` +m_ab7_symmetry.obj: 42_geometry/m_ab7_symmetry.F90 + $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o m_ab7_symmetry.obj `if test -f '42_geometry/m_ab7_symmetry.F90'; then $(CYGPATH_W) '42_geometry/m_ab7_symmetry.F90'; else $(CYGPATH_W) '$(srcdir)/42_geometry/m_ab7_symmetry.F90'; fi` metric.obj: 42_geometry/metric.F90 $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o metric.obj `if test -f '42_geometry/metric.F90'; then $(CYGPATH_W) '42_geometry/metric.F90'; else $(CYGPATH_W) '$(srcdir)/42_geometry/metric.F90'; fi` @@ -762,8 +762,8 @@ interfaces_56_mixing.obj: 56_mixing/interfaces_56_mixing.F90 $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o interfaces_56_mixing.obj `if test -f '56_mixing/interfaces_56_mixing.F90'; then $(CYGPATH_W) '56_mixing/interfaces_56_mixing.F90'; else $(CYGPATH_W) '$(srcdir)/56_mixing/interfaces_56_mixing.F90'; fi` -m_ab6_mixing.obj: 56_mixing/m_ab6_mixing.F90 - $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o m_ab6_mixing.obj `if test -f '56_mixing/m_ab6_mixing.F90'; then $(CYGPATH_W) '56_mixing/m_ab6_mixing.F90'; else $(CYGPATH_W) '$(srcdir)/56_mixing/m_ab6_mixing.F90'; fi` +m_ab7_mixing.obj: 56_mixing/m_ab7_mixing.F90 + $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o m_ab7_mixing.obj `if test -f '56_mixing/m_ab7_mixing.F90'; then $(CYGPATH_W) '56_mixing/m_ab7_mixing.F90'; else $(CYGPATH_W) '$(srcdir)/56_mixing/m_ab7_mixing.F90'; fi` scfcge.obj: 56_mixing/scfcge.F90 $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o scfcge.obj `if test -f '56_mixing/scfcge.F90'; then $(CYGPATH_W) '56_mixing/scfcge.F90'; else $(CYGPATH_W) '$(srcdir)/56_mixing/scfcge.F90'; fi` @@ -783,8 +783,8 @@ irrzg.obj: 56_recipspace/irrzg.F90 $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o irrzg.obj `if test -f '56_recipspace/irrzg.F90'; then $(CYGPATH_W) '56_recipspace/irrzg.F90'; else $(CYGPATH_W) '$(srcdir)/56_recipspace/irrzg.F90'; fi` -m_ab6_kpoints.obj: 56_recipspace/m_ab6_kpoints.F90 - $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o m_ab6_kpoints.obj `if test -f '56_recipspace/m_ab6_kpoints.F90'; then $(CYGPATH_W) '56_recipspace/m_ab6_kpoints.F90'; else $(CYGPATH_W) '$(srcdir)/56_recipspace/m_ab6_kpoints.F90'; fi` +m_ab7_kpoints.obj: 56_recipspace/m_ab7_kpoints.F90 + $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o m_ab7_kpoints.obj `if test -f '56_recipspace/m_ab7_kpoints.F90'; then $(CYGPATH_W) '56_recipspace/m_ab7_kpoints.F90'; else $(CYGPATH_W) '$(srcdir)/56_recipspace/m_ab7_kpoints.F90'; fi` getkgrid.obj: 56_recipspace/getkgrid.F90 $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o getkgrid.obj `if test -f '56_recipspace/getkgrid.F90'; then $(CYGPATH_W) '56_recipspace/getkgrid.F90'; else $(CYGPATH_W) '$(srcdir)/56_recipspace/getkgrid.F90'; fi` @@ -855,8 +855,8 @@ prtxvf.obj: 67_common/prtxvf.F90 $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o prtxvf.obj `if test -f '67_common/prtxvf.F90'; then $(CYGPATH_W) '67_common/prtxvf.F90'; else $(CYGPATH_W) '$(srcdir)/67_common/prtxvf.F90'; fi` -ab6_moldyn.obj: 72_geomoptim/ab6_moldyn.F90 - $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o ab6_moldyn.obj `if test -f '72_geomoptim/ab6_moldyn.F90'; then $(CYGPATH_W) '72_geomoptim/ab6_moldyn.F90'; else $(CYGPATH_W) '$(srcdir)/72_geomoptim/ab6_moldyn.F90'; fi` +ab7_moldyn.obj: 72_geomoptim/ab7_moldyn.F90 + $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o ab7_moldyn.obj `if test -f '72_geomoptim/ab7_moldyn.F90'; then $(CYGPATH_W) '72_geomoptim/ab7_moldyn.F90'; else $(CYGPATH_W) '$(srcdir)/72_geomoptim/ab7_moldyn.F90'; fi` xfpack.obj: 72_geomoptim/xfpack.F90 $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o xfpack.obj `if test -f '72_geomoptim/xfpack.F90'; then $(CYGPATH_W) '72_geomoptim/xfpack.F90'; else $(CYGPATH_W) '$(srcdir)/72_geomoptim/xfpack.F90'; fi` @@ -1268,11 +1268,11 @@ interfaces_42_geometry.o $(PPFCCOMPILE) -c -o symptgroup.o `test -f '42_geometry/symptgroup.F90' || echo '$(srcdir)/'`42_geometry/symptgroup.F90 -m_ab6_symmetry.o: 42_geometry/m_ab6_symmetry.F90 \ +m_ab7_symmetry.o: 42_geometry/m_ab7_symmetry.F90 \ defs_basis.o \ interfaces_32_util.o \ interfaces_42_geometry.o - $(PPFCCOMPILE) -c -o m_ab6_symmetry.o `test -f '42_geometry/m_ab6_symmetry.F90' || echo '$(srcdir)/'`42_geometry/m_ab6_symmetry.F90 + $(PPFCCOMPILE) -c -o m_ab7_symmetry.o `test -f '42_geometry/m_ab7_symmetry.F90' || echo '$(srcdir)/'`42_geometry/m_ab7_symmetry.F90 symchk.o: 42_geometry/symchk.F90 \ defs_basis.o @@ -1498,11 +1498,11 @@ interfaces_56_recipspace.o $(PPFCCOMPILE) -c -o getkgrid.o `test -f '56_recipspace/getkgrid.F90' || echo '$(srcdir)/'`56_recipspace/getkgrid.F90 -m_ab6_kpoints.o: 56_recipspace/m_ab6_kpoints.F90 \ +m_ab7_kpoints.o: 56_recipspace/m_ab7_kpoints.F90 \ defs_basis.o \ interfaces_56_recipspace.o \ - m_ab6_symmetry.o - $(PPFCCOMPILE) -c -o m_ab6_kpoints.o `test -f '56_recipspace/m_ab6_kpoints.F90' || echo '$(srcdir)/'`56_recipspace/m_ab6_kpoints.F90 + m_ab7_symmetry.o + $(PPFCCOMPILE) -c -o m_ab7_kpoints.o `test -f '56_recipspace/m_ab7_kpoints.F90' || echo '$(srcdir)/'`56_recipspace/m_ab7_kpoints.F90 interfaces_56_recipspace.o: 56_recipspace/interfaces_56_recipspace.F90 \ defs_abitypes.o \ @@ -1647,7 +1647,7 @@ defs_datatypes.o $(PPFCCOMPILE) -c -o moldyn.o `test -f '72_geomoptim/moldyn.F90' || echo '$(srcdir)/'`72_geomoptim/moldyn.F90 -ab6_moldyn.o: 72_geomoptim/ab6_moldyn.F90 \ +ab7_moldyn.o: 72_geomoptim/ab7_moldyn.F90 \ defs_basis.o \ defs_basis.o \ 72_geomoptim/isokinetic.F90 \ @@ -1669,7 +1669,7 @@ 72_geomoptim/quenched.F90 \ defs_basis.o \ 72_geomoptim/velocity_verlet.F90 - $(PPFCCOMPILE) -c -o ab6_moldyn.o `test -f '72_geomoptim/ab6_moldyn.F90' || echo '$(srcdir)/'`72_geomoptim/ab6_moldyn.F90 + $(PPFCCOMPILE) -c -o ab7_moldyn.o `test -f '72_geomoptim/ab7_moldyn.F90' || echo '$(srcdir)/'`72_geomoptim/ab7_moldyn.F90 velocity_verlet.o: 72_geomoptim/velocity_verlet.F90 \ defs_basis.o @@ -1768,12 +1768,12 @@ interfaces_14_hidewrite.o $(PPFCCOMPILE) -c -o scfeig.o `test -f '56_mixing/scfeig.F90' || echo '$(srcdir)/'`56_mixing/scfeig.F90 -m_ab6_mixing.o: 56_mixing/m_ab6_mixing.F90 \ +m_ab7_mixing.o: 56_mixing/m_ab7_mixing.F90 \ defs_basis.o \ interfaces_18_timing.o \ interfaces_56_mixing.o \ m_profiling.o - $(PPFCCOMPILE) -c -o m_ab6_mixing.o `test -f '56_mixing/m_ab6_mixing.F90' || echo '$(srcdir)/'`56_mixing/m_ab6_mixing.F90 + $(PPFCCOMPILE) -c -o m_ab7_mixing.o `test -f '56_mixing/m_ab7_mixing.F90' || echo '$(srcdir)/'`56_mixing/m_ab7_mixing.F90 dotprodm_vn.o: 56_mixing/dotprodm_vn.F90 \ defs_abitypes.o \ diff -urN bigdft-abi-1.0.4.old/libABINIT/src/deps bigdft-abi-1.0.4.new/libABINIT/src/deps --- bigdft-abi-1.0.4.old/libABINIT/src/deps 2012-11-08 11:13:29.000000000 +0100 +++ bigdft-abi-1.0.4.new/libABINIT/src/deps 2013-06-11 16:51:00.000000000 +0200 @@ -194,11 +194,11 @@ interfaces_42_geometry.o $(PPFCCOMPILE) -c -o symptgroup.o `test -f '42_geometry/symptgroup.F90' || echo '$(srcdir)/'`42_geometry/symptgroup.F90 -m_ab6_symmetry.o: 42_geometry/m_ab6_symmetry.F90 \ +m_ab7_symmetry.o: 42_geometry/m_ab7_symmetry.F90 \ defs_basis.o \ interfaces_32_util.o \ interfaces_42_geometry.o - $(PPFCCOMPILE) -c -o m_ab6_symmetry.o `test -f '42_geometry/m_ab6_symmetry.F90' || echo '$(srcdir)/'`42_geometry/m_ab6_symmetry.F90 + $(PPFCCOMPILE) -c -o m_ab7_symmetry.o `test -f '42_geometry/m_ab7_symmetry.F90' || echo '$(srcdir)/'`42_geometry/m_ab7_symmetry.F90 symchk.o: 42_geometry/symchk.F90 \ defs_basis.o @@ -424,11 +424,11 @@ interfaces_56_recipspace.o $(PPFCCOMPILE) -c -o getkgrid.o `test -f '56_recipspace/getkgrid.F90' || echo '$(srcdir)/'`56_recipspace/getkgrid.F90 -m_ab6_kpoints.o: 56_recipspace/m_ab6_kpoints.F90 \ +m_ab7_kpoints.o: 56_recipspace/m_ab7_kpoints.F90 \ defs_basis.o \ interfaces_56_recipspace.o \ - m_ab6_symmetry.o - $(PPFCCOMPILE) -c -o m_ab6_kpoints.o `test -f '56_recipspace/m_ab6_kpoints.F90' || echo '$(srcdir)/'`56_recipspace/m_ab6_kpoints.F90 + m_ab7_symmetry.o + $(PPFCCOMPILE) -c -o m_ab7_kpoints.o `test -f '56_recipspace/m_ab7_kpoints.F90' || echo '$(srcdir)/'`56_recipspace/m_ab7_kpoints.F90 interfaces_56_recipspace.o: 56_recipspace/interfaces_56_recipspace.F90 \ defs_abitypes.o \ @@ -573,7 +573,7 @@ defs_datatypes.o $(PPFCCOMPILE) -c -o moldyn.o `test -f '72_geomoptim/moldyn.F90' || echo '$(srcdir)/'`72_geomoptim/moldyn.F90 -ab6_moldyn.o: 72_geomoptim/ab6_moldyn.F90 \ +ab7_moldyn.o: 72_geomoptim/ab7_moldyn.F90 \ defs_basis.o \ defs_basis.o \ 72_geomoptim/isokinetic.F90 \ @@ -595,7 +595,7 @@ 72_geomoptim/quenched.F90 \ defs_basis.o \ 72_geomoptim/velocity_verlet.F90 - $(PPFCCOMPILE) -c -o ab6_moldyn.o `test -f '72_geomoptim/ab6_moldyn.F90' || echo '$(srcdir)/'`72_geomoptim/ab6_moldyn.F90 + $(PPFCCOMPILE) -c -o ab7_moldyn.o `test -f '72_geomoptim/ab7_moldyn.F90' || echo '$(srcdir)/'`72_geomoptim/ab7_moldyn.F90 velocity_verlet.o: 72_geomoptim/velocity_verlet.F90 \ defs_basis.o @@ -694,12 +694,12 @@ interfaces_14_hidewrite.o $(PPFCCOMPILE) -c -o scfeig.o `test -f '56_mixing/scfeig.F90' || echo '$(srcdir)/'`56_mixing/scfeig.F90 -m_ab6_mixing.o: 56_mixing/m_ab6_mixing.F90 \ +m_ab7_mixing.o: 56_mixing/m_ab7_mixing.F90 \ defs_basis.o \ interfaces_18_timing.o \ interfaces_56_mixing.o \ m_profiling.o - $(PPFCCOMPILE) -c -o m_ab6_mixing.o `test -f '56_mixing/m_ab6_mixing.F90' || echo '$(srcdir)/'`56_mixing/m_ab6_mixing.F90 + $(PPFCCOMPILE) -c -o m_ab7_mixing.o `test -f '56_mixing/m_ab7_mixing.F90' || echo '$(srcdir)/'`56_mixing/m_ab7_mixing.F90 dotprodm_vn.o: 56_mixing/dotprodm_vn.F90 \ defs_abitypes.o \ diff -urN bigdft-abi-1.0.4.old/src/abscalc.f90 bigdft-abi-1.0.4.new/src/abscalc.f90 --- bigdft-abi-1.0.4.old/src/abscalc.f90 2012-07-09 16:43:33.000000000 +0200 +++ bigdft-abi-1.0.4.new/src/abscalc.f90 2013-06-11 16:51:00.000000000 +0200 @@ -13,7 +13,7 @@ use module_base use module_types use module_interfaces - use m_ab6_symmetry + use m_ab7_symmetry ! use minimization, only: parameterminimization implicit none @@ -323,9 +323,9 @@ use module_xc use vdwcorrection use esatto - use m_ab6_symmetry - use m_ab6_mixing - use m_ab6_kpoints + use m_ab7_symmetry + use m_ab7_mixing + use m_ab7_kpoints implicit none integer, intent(in) :: nproc,iproc real(gp), intent(inout) :: hx_old,hy_old,hz_old diff -urN bigdft-abi-1.0.4.old/src/cluster.f90 bigdft-abi-1.0.4.new/src/cluster.f90 --- bigdft-abi-1.0.4.old/src/cluster.f90 2012-11-29 11:18:04.000000000 +0100 +++ bigdft-abi-1.0.4.new/src/cluster.f90 2013-06-11 16:51:00.000000000 +0200 @@ -192,7 +192,7 @@ ! use Poisson_Solver use module_xc ! use vdwcorrection - use m_ab6_mixing + use m_ab7_mixing use yaml_output implicit none integer, intent(in) :: nproc,iproc @@ -1140,7 +1140,7 @@ use module_types use module_interfaces, except_this_one => kswfn_optimization_loop use yaml_output - use m_ab6_mixing + use m_ab7_mixing implicit none real(dp), dimension(6), intent(out) :: xcstr integer, intent(in) :: iproc, nproc, idsx, inputpsi @@ -1306,7 +1306,7 @@ if (nproc > 1) call MPI_BARRIER(MPI_COMM_WORLD,ierr) !call kswfn_free_scf_data(KSwfn, (nproc > 1)) !if (opt%iscf /= SCF_KIND_DIRECT_MINIMIZATION) then - ! call ab6_mixing_deallocate(denspot%mix) + ! call ab7_mixing_deallocate(denspot%mix) ! deallocate(denspot%mix) !end if !>todo: change this return into a clean out of the routine, so the YAML is clean. diff -urN bigdft-abi-1.0.4.old/src/distances.f90 bigdft-abi-1.0.4.new/src/distances.f90 --- bigdft-abi-1.0.4.old/src/distances.f90 2012-07-09 16:43:33.000000000 +0200 +++ bigdft-abi-1.0.4.new/src/distances.f90 2013-06-11 16:51:00.000000000 +0200 @@ -275,7 +275,7 @@ subroutine box_features(whichone,contcar,nrep,nat,ntypes,iatype,pos,factor) use BigDFT_API use module_interfaces - use m_ab6_symmetry + use m_ab7_symmetry implicit none character(len=1), intent(in) :: whichone character(len=40), intent(in) :: contcar @@ -375,7 +375,7 @@ subroutine read_pos(iunit,whichone,nat,pos,nrep) use BigDFT_API use module_interfaces - use m_ab6_symmetry + use m_ab7_symmetry implicit none character(len=1), intent(in) :: whichone integer, intent(in) :: iunit,nat,nrep diff -urN bigdft-abi-1.0.4.old/src/forces.f90 bigdft-abi-1.0.4.new/src/forces.f90 --- bigdft-abi-1.0.4.old/src/forces.f90 2012-07-09 16:43:33.000000000 +0200 +++ bigdft-abi-1.0.4.new/src/forces.f90 2013-06-11 16:51:00.000000000 +0200 @@ -3757,7 +3757,7 @@ subroutine symm_stress(dump,tens,symobj) use defs_basis use module_base, only: verbose,gp - use m_ab6_symmetry + use m_ab7_symmetry use module_types implicit none !Arguments @@ -3773,7 +3773,7 @@ real(gp),dimension(3,3) :: symtens call symmetry_get_matrices_p(symObj, nsym, sym, transNon, symAfm, errno) - if (errno /= AB6_NO_ERROR) stop + if (errno /= AB7_NO_ERROR) stop if (nsym < 2) return if (dump)& @@ -3824,7 +3824,7 @@ !> Symmetrize the atomic forces (needed with special k points) subroutine symmetrise_forces(iproc, fxyz, at) use defs_basis - use m_ab6_symmetry + use m_ab7_symmetry use module_types implicit none @@ -3833,7 +3833,7 @@ type(atoms_data), intent(in) :: at real(gp), intent(inout) :: fxyz(3, at%nat) integer :: ia, mu, isym, errno, ind, nsym - integer :: indsym(4, AB6_MAX_SYMMETRIES) + integer :: indsym(4, AB7_MAX_SYMMETRIES) real(gp) :: summ real(gp) :: alat(3) real(gp), allocatable :: dedt(:,:) @@ -3843,7 +3843,7 @@ real(gp), pointer :: transNon(:,:) call symmetry_get_matrices_p(at%sym%symObj, nsym, sym, transNon, symAfm, errno) - if (errno /= AB6_NO_ERROR) stop + if (errno /= AB7_NO_ERROR) stop if (nsym < 2) return if (iproc == 0) write(*,"(1x,A,I0,A)") "Symmetrise forces with ", nsym, " symmetries." @@ -3866,7 +3866,7 @@ ! actually conduct symmetrization do ia = 1, at%nat call symmetry_get_equivalent_atom(at%sym%symObj, indsym, ia, errno) - if (errno /= AB6_NO_ERROR) stop + if (errno /= AB7_NO_ERROR) stop do mu = 1, 3 summ = real(0, gp) do isym = 1, nsym diff -urN bigdft-abi-1.0.4.old/src/frequencies.f90 bigdft-abi-1.0.4.new/src/frequencies.f90 --- bigdft-abi-1.0.4.old/src/frequencies.f90 2012-07-09 16:43:33.000000000 +0200 +++ bigdft-abi-1.0.4.new/src/frequencies.f90 2013-06-11 16:51:00.000000000 +0200 @@ -20,7 +20,7 @@ use module_base use module_types use module_interfaces - use m_ab6_symmetry + use m_ab7_symmetry use yaml_output implicit none diff -urN bigdft-abi-1.0.4.old/src/geometry.f90 bigdft-abi-1.0.4.new/src/geometry.f90 --- bigdft-abi-1.0.4.old/src/geometry.f90 2012-07-09 16:43:33.000000000 +0200 +++ bigdft-abi-1.0.4.new/src/geometry.f90 2013-06-11 16:51:00.000000000 +0200 @@ -159,7 +159,7 @@ use module_base use module_types use scfloop_API - use ab6_moldyn + use ab7_moldyn implicit none integer, intent(in) :: nproc,iproc integer, intent(inout) :: ncount_bigdft diff -urN bigdft-abi-1.0.4.old/src/hpsiortho.f90 bigdft-abi-1.0.4.new/src/hpsiortho.f90 --- bigdft-abi-1.0.4.old/src/hpsiortho.f90 2013-01-30 10:10:56.000000000 +0100 +++ bigdft-abi-1.0.4.new/src/hpsiortho.f90 2013-06-11 16:51:00.000000000 +0200 @@ -17,7 +17,7 @@ use module_types use module_interfaces, fake_name => psitohpsi use Poisson_Solver - use m_ab6_mixing + use m_ab7_mixing use yaml_output implicit none logical, intent(in) :: scf @@ -144,7 +144,7 @@ !here the density can be mixed if (iscf > SCF_KIND_DIRECT_MINIMIZATION ) then - if (denspot%mix%kind == AB6_MIXING_DENSITY) then + if (denspot%mix%kind == AB7_MIXING_DENSITY) then call mix_rhopot(iproc,nproc,denspot%mix%nfft*denspot%mix%nspden,alphamix,denspot%mix,& denspot%rhov,itrp,wfn%Lzd%Glr%d%n1i,wfn%Lzd%Glr%d%n2i,wfn%Lzd%Glr%d%n3i,& atoms%alat1*atoms%alat2*atoms%alat3,&!hx*hy*hz,& !volume should be used @@ -215,7 +215,7 @@ !here the potential can be mixed if (iscf > SCF_KIND_DIRECT_MINIMIZATION ) then - if (denspot%mix%kind == AB6_MIXING_POTENTIAL) then + if (denspot%mix%kind == AB7_MIXING_POTENTIAL) then call mix_rhopot(iproc,nproc,denspot%mix%nfft*denspot%mix%nspden,alphamix,denspot%mix,& denspot%rhov,itrp,wfn%Lzd%Glr%d%n1i,wfn%Lzd%Glr%d%n2i,wfn%Lzd%Glr%d%n3i,& atoms%alat1*atoms%alat2*atoms%alat3,&!volume should be used diff -urN bigdft-abi-1.0.4.old/src/init/atoms.f90 bigdft-abi-1.0.4.new/src/init/atoms.f90 --- bigdft-abi-1.0.4.old/src/init/atoms.f90 2012-07-09 16:43:33.000000000 +0200 +++ bigdft-abi-1.0.4.new/src/init/atoms.f90 2013-06-11 16:51:00.000000000 +0200 @@ -210,7 +210,7 @@ use module_base use module_types use defs_basis - use m_ab6_symmetry + use m_ab7_symmetry implicit none type(atoms_data), intent(inout) :: atoms real(gp), dimension(3,atoms%nat), intent(in) :: rxyz @@ -1901,8 +1901,8 @@ subroutine symmetry_set_irreductible_zone(sym, geocode, n1i, n2i, n3i, nspin) use module_base use module_types - use m_ab6_kpoints - use m_ab6_symmetry + use m_ab7_kpoints + use m_ab7_symmetry implicit none type(symmetry_data), intent(inout) :: sym integer, intent(in) :: n1i, n2i, n3i, nspin diff -urN bigdft-abi-1.0.4.old/src/init/denspotd.f90 bigdft-abi-1.0.4.new/src/init/denspotd.f90 --- bigdft-abi-1.0.4.old/src/init/denspotd.f90 2012-07-09 16:43:33.000000000 +0200 +++ bigdft-abi-1.0.4.new/src/init/denspotd.f90 2013-06-11 16:51:00.000000000 +0200 @@ -95,7 +95,7 @@ & n1i, n2i) !to be removed arguments when denspot has dimensions use module_base use module_types - use m_ab6_mixing + use m_ab7_mixing implicit none type(DFT_local_fields), intent(inout) :: denspot integer, intent(in) :: iscf, n1i, n2i, nspin @@ -104,20 +104,20 @@ character(len=500) :: errmess if (iscf < 10) then - potden = AB6_MIXING_POTENTIAL + potden = AB7_MIXING_POTENTIAL npoints = n1i*n2i*denspot%dpbox%n3p if (denspot%dpbox%n3p==0) npoints=1 else - potden = AB6_MIXING_DENSITY + potden = AB7_MIXING_DENSITY npoints = n1i*n2i*denspot%dpbox%n3d if (denspot%dpbox%n3d==0) npoints=1 end if if (iscf > SCF_KIND_DIRECT_MINIMIZATION) then allocate(denspot%mix) - call ab6_mixing_new(denspot%mix, modulo(iscf, 10), potden, & - AB6_MIXING_REAL_SPACE, npoints, nspin, 0, & + call ab7_mixing_new(denspot%mix, modulo(iscf, 10), potden, & + AB7_MIXING_REAL_SPACE, npoints, nspin, 0, & ierr, errmess, useprec = .false.) - call ab6_mixing_eval_allocate(denspot%mix) + call ab7_mixing_eval_allocate(denspot%mix) else nullify(denspot%mix) end if @@ -125,12 +125,12 @@ subroutine denspot_free_history(denspot) use module_types - use m_ab6_mixing + use m_ab7_mixing implicit none type(DFT_local_fields), intent(inout) :: denspot if (associated(denspot%mix)) then - call ab6_mixing_deallocate(denspot%mix) + call ab7_mixing_deallocate(denspot%mix) deallocate(denspot%mix) end if end subroutine denspot_free_history @@ -396,7 +396,7 @@ use module_base use module_types use module_interfaces, except_this_one => allocateRhoPot - use m_ab6_mixing + use m_ab7_mixing implicit none integer, intent(in) :: iproc,nspin type(locreg_descriptors), intent(in) :: Glr diff -urN bigdft-abi-1.0.4.old/src/init/sysprop.f90 bigdft-abi-1.0.4.new/src/init/sysprop.f90 --- bigdft-abi-1.0.4.old/src/init/sysprop.f90 2012-07-09 16:43:33.000000000 +0200 +++ bigdft-abi-1.0.4.new/src/init/sysprop.f90 2013-06-11 16:51:00.000000000 +0200 @@ -879,7 +879,7 @@ use module_base use module_types use module_xc - use m_ab6_symmetry + use m_ab7_symmetry implicit none character (len=*), intent(in) :: fileocc type(atoms_data), intent(inout) :: atoms diff -urN bigdft-abi-1.0.4.old/src/input_variables.f90 bigdft-abi-1.0.4.new/src/input_variables.f90 --- bigdft-abi-1.0.4.old/src/input_variables.f90 2012-07-09 16:43:33.000000000 +0200 +++ bigdft-abi-1.0.4.new/src/input_variables.f90 2013-06-11 16:51:00.000000000 +0200 @@ -908,7 +908,7 @@ use module_base use module_types use defs_basis - use m_ab6_kpoints + use m_ab7_kpoints use module_input implicit none character(len=*), intent(in) :: filename @@ -958,7 +958,7 @@ comment='Equivalent length of K-space resolution (Bohr)') call kpoints_get_auto_k_grid(sym%symObj, in%nkpt, in%kpt, in%wkpt, & & kptrlen, ierror) - if (ierror /= AB6_NO_ERROR) then + if (ierror /= AB7_NO_ERROR) then if (iproc==0) write(*,*) " ERROR in symmetry library. Error code is ", ierror stop end if @@ -984,7 +984,7 @@ end do call kpoints_get_mp_k_grid(sym%symObj, in%nkpt, in%kpt, in%wkpt, & & ngkpt, nshiftk, shiftk, ierror) - if (ierror /= AB6_NO_ERROR) then + if (ierror /= AB7_NO_ERROR) then if (iproc==0) write(*,*) " ERROR in symmetry library. Error code is ", ierror stop end if @@ -1126,7 +1126,7 @@ use module_base use module_types use defs_basis - use m_ab6_kpoints + use m_ab7_kpoints implicit none character(len=*), intent(in) :: filename integer, intent(in) :: iproc @@ -1178,11 +1178,11 @@ call check() call kpoints_get_auto_k_grid(atoms%sym%symObj, in%nkpt, in%kpt, in%wkpt, & & kptrlen, ierror) - if (ierror /= AB6_NO_ERROR) then + if (ierror /= AB7_NO_ERROR) then if (iproc==0) write(*,*) " ERROR in symmetry library. Error code is ", ierror stop end if - ! in%kpt and in%wkpt will be allocated by ab6_symmetry routine. + ! in%kpt and in%wkpt will be allocated by ab7_symmetry routine. call memocc(0,in%kpt,'in%kpt',subname) call memocc(0,in%wkpt,'in%wkpt',subname) else if (trim(type) == "MPgrid" .or. trim(type) == "mpgrid") then @@ -1198,11 +1198,11 @@ if (atoms%geocode == 'F') ngkpt = 1 call kpoints_get_mp_k_grid(atoms%sym%symObj, in%nkpt, in%kpt, in%wkpt, & & ngkpt, nshiftk, shiftk, ierror) - if (ierror /= AB6_NO_ERROR) then + if (ierror /= AB7_NO_ERROR) then if (iproc==0) write(*,*) " ERROR in symmetry library. Error code is ", ierror stop end if - ! in%kpt and in%wkpt will be allocated by ab6_symmetry routine. + ! in%kpt and in%wkpt will be allocated by ab7_symmetry routine. call memocc(0,in%kpt,'in%kpt',subname) call memocc(0,in%wkpt,'in%wkpt',subname) else if (trim(type) == "manual" .or. trim(type) == "Manual") then @@ -1858,7 +1858,7 @@ use module_base use module_types use module_interfaces, except_this_one => read_atomic_file - use m_ab6_symmetry + use m_ab7_symmetry use position_files implicit none character(len=*), intent(in) :: file @@ -2430,7 +2430,7 @@ use module_base use module_types use module_interfaces, except_this_one => initialize_atomic_file - use m_ab6_symmetry + use m_ab7_symmetry implicit none integer, intent(in) :: iproc type(atoms_data), intent(inout) :: atoms diff -urN bigdft-abi-1.0.4.old/src/memguess.f90 bigdft-abi-1.0.4.new/src/memguess.f90 --- bigdft-abi-1.0.4.old/src/memguess.f90 2012-07-09 16:43:33.000000000 +0200 +++ bigdft-abi-1.0.4.new/src/memguess.f90 2013-06-11 16:51:00.000000000 +0200 @@ -16,7 +16,7 @@ use module_types use module_interfaces use module_xc - use m_ab6_symmetry + use m_ab7_symmetry implicit none character(len=*), parameter :: subname='memguess' diff -urN bigdft-abi-1.0.4.old/src/modules/defs.F90 bigdft-abi-1.0.4.new/src/modules/defs.F90 --- bigdft-abi-1.0.4.old/src/modules/defs.F90 2012-07-09 16:43:33.000000000 +0200 +++ bigdft-abi-1.0.4.new/src/modules/defs.F90 2013-06-11 16:51:00.000000000 +0200 @@ -1074,7 +1074,7 @@ end subroutine herk_double function fnrm_denpot(x,cplex,nfft,nspden,opt_denpot,user_data) - use m_ab6_mixing + use m_ab7_mixing implicit none integer, intent(in) :: cplex,nfft,nspden,opt_denpot double precision, intent(in) :: x(*) @@ -1084,7 +1084,7 @@ double precision :: fnrm_denpot, ar, nrm_local, dnrm2 ! In case of density, we use nscatterarr. - if (opt_denpot == AB6_MIXING_DENSITY) then + if (opt_denpot == AB7_MIXING_DENSITY) then call MPI_COMM_RANK(MPI_COMM_WORLD,iproc,ierr) if (ierr /= 0) then call MPI_ABORT(MPI_COMM_WORLD, ierr, ie) @@ -1125,7 +1125,7 @@ end function fnrm_denpot function fdot_denpot(x,y,cplex,nfft,nspden,opt_denpot,user_data) - use m_ab6_mixing + use m_ab7_mixing implicit none integer, intent(in) :: cplex,nfft,nspden,opt_denpot double precision, intent(in) :: x(*), y(*) @@ -1135,7 +1135,7 @@ double precision :: fdot_denpot, ar, dot_local, ddot ! In case of density, we use nscatterarr. - if (opt_denpot == AB6_MIXING_DENSITY) then + if (opt_denpot == AB7_MIXING_DENSITY) then call MPI_COMM_RANK(MPI_COMM_WORLD,iproc,ierr) if (ierr /= 0) then call MPI_ABORT(MPI_COMM_WORLD, ierr, ie) diff -urN bigdft-abi-1.0.4.old/src/modules/interfaces.f90 bigdft-abi-1.0.4.new/src/modules/interfaces.f90 --- bigdft-abi-1.0.4.old/src/modules/interfaces.f90 2013-01-03 10:10:13.000000000 +0100 +++ bigdft-abi-1.0.4.new/src/modules/interfaces.f90 2013-06-11 16:51:00.000000000 +0200 @@ -5857,7 +5857,7 @@ energs,rpnrm,xcstr,proj_G,paw) use module_base use module_types - use m_ab6_mixing + use m_ab7_mixing implicit none logical, intent(in) :: scf integer, intent(in) :: iproc,nproc,itrp,iscf,ixc,linflag,itwfn diff -urN bigdft-abi-1.0.4.old/src/modules/types.f90 bigdft-abi-1.0.4.new/src/modules/types.f90 --- bigdft-abi-1.0.4.old/src/modules/types.f90 2013-01-03 10:18:08.000000000 +0100 +++ bigdft-abi-1.0.4.new/src/modules/types.f90 2013-06-11 16:51:00.000000000 +0200 @@ -12,7 +12,7 @@ !! and the routines of allocations and de-allocations module module_types - use m_ab6_mixing, only : ab6_mixing_object + use m_ab7_mixing, only : ab7_mixing_object use module_base, only : gp,wp,dp,tp,uninitialized implicit none @@ -828,7 +828,7 @@ type, public :: DFT_local_fields real(dp), dimension(:), pointer :: rhov !< generic workspace. What is there is indicated by rhov_is - type(ab6_mixing_object), pointer :: mix !< History of rhov, allocated only when using diagonalisation + type(ab7_mixing_object), pointer :: mix !< History of rhov, allocated only when using diagonalisation !local fields which are associated to their name !normally given in parallel distribution real(dp), dimension(:,:), pointer :: rho_psi !< density as given by square of el. WFN @@ -1658,7 +1658,7 @@ subroutine deallocate_symmetry(sym, subname) use module_base - use m_ab6_symmetry + use m_ab7_symmetry implicit none type(symmetry_data), intent(inout) :: sym character(len = *), intent(in) :: subname diff -urN bigdft-abi-1.0.4.old/src/output.f90 bigdft-abi-1.0.4.new/src/output.f90 --- bigdft-abi-1.0.4.old/src/output.f90 2012-07-09 16:43:33.000000000 +0200 +++ bigdft-abi-1.0.4.new/src/output.f90 2013-06-11 16:51:00.000000000 +0200 @@ -63,7 +63,7 @@ use module_base use module_types use defs_basis - use m_ab6_symmetry + use m_ab7_symmetry implicit none !Arguments integer, intent(in) :: nproc @@ -71,9 +71,9 @@ type(atoms_data), intent(in) :: atoms integer :: nSym, ierr, ityp, iat, i, lg - integer :: sym(3, 3, AB6_MAX_SYMMETRIES) - integer :: symAfm(AB6_MAX_SYMMETRIES) - real(gp) :: transNon(3, AB6_MAX_SYMMETRIES) + integer :: sym(3, 3, AB7_MAX_SYMMETRIES) + integer :: symAfm(AB7_MAX_SYMMETRIES) + real(gp) :: transNon(3, AB7_MAX_SYMMETRIES) real(gp) :: genAfm(3) character(len=15) :: spaceGroup integer :: spaceGroupId, pointGroupMagn @@ -138,7 +138,7 @@ call symmetry_get_matrices(atoms%sym%symObj, nSym, sym, transNon, symAfm, ierr) call symmetry_get_group(atoms%sym%symObj, spaceGroup, & & spaceGroupId, pointGroupMagn, genAfm, ierr) - if (ierr == AB6_ERROR_SYM_NOT_PRIMITIVE) write(spaceGroup, "(A)") "not prim." + if (ierr == AB7_ERROR_SYM_NOT_PRIMITIVE) write(spaceGroup, "(A)") "not prim." write(add(1), '(a,i0)') "N. sym. = ", nSym write(add(2), '(a,a,a)') "Sp. group = ", trim(spaceGroup) else if (atoms%geocode /= 'F' .and. input%disableSym) then diff -urN bigdft-abi-1.0.4.old/src/splinedsaddle.f90 bigdft-abi-1.0.4.new/src/splinedsaddle.f90 --- bigdft-abi-1.0.4.old/src/splinedsaddle.f90 2012-07-09 16:43:33.000000000 +0200 +++ bigdft-abi-1.0.4.new/src/splinedsaddle.f90 2013-06-11 16:51:00.000000000 +0200 @@ -14,7 +14,7 @@ use module_base use module_types use module_interfaces - use m_ab6_symmetry + use m_ab7_symmetry use yaml_output implicit none character(len=*), parameter :: subname='BigDFT' diff -urN bigdft-abi-1.0.4.old/src/sumrho.f90 bigdft-abi-1.0.4.new/src/sumrho.f90 --- bigdft-abi-1.0.4.old/src/sumrho.f90 2012-07-09 16:43:33.000000000 +0200 +++ bigdft-abi-1.0.4.new/src/sumrho.f90 2013-06-11 16:51:00.000000000 +0200 @@ -719,7 +719,7 @@ sym) use module_base!, only: gp,dp,wp,ndebug,memocc use module_types - use m_ab6_symmetry + use m_ab7_symmetry implicit none integer, intent(in) :: iproc,nproc,nspin, n1i, n2i, n3i diff -urN bigdft-abi-1.0.4.old/src/test_forces.f90 bigdft-abi-1.0.4.new/src/test_forces.f90 --- bigdft-abi-1.0.4.old/src/test_forces.f90 2012-07-09 16:43:33.000000000 +0200 +++ bigdft-abi-1.0.4.new/src/test_forces.f90 2013-06-11 16:51:00.000000000 +0200 @@ -22,7 +22,7 @@ use module_base use module_types use module_interfaces - use m_ab6_symmetry + use m_ab7_symmetry implicit none character(len=*), parameter :: subname='test_forces' diff -urN bigdft-abi-1.0.4.old/src/wfn_opt/diis.f90 bigdft-abi-1.0.4.new/src/wfn_opt/diis.f90 --- bigdft-abi-1.0.4.old/src/wfn_opt/diis.f90 2012-08-22 09:55:24.000000000 +0200 +++ bigdft-abi-1.0.4.new/src/wfn_opt/diis.f90 2013-06-11 16:51:00.000000000 +0200 @@ -459,13 +459,13 @@ subroutine mix_rhopot(iproc,nproc,npoints,alphamix,mix,rhopot,istep,& & n1,n2,n3,ucvol,rpnrm,nscatterarr) use module_base - use defs_basis, only: AB6_NO_ERROR - use m_ab6_mixing + use defs_basis, only: AB7_NO_ERROR + use m_ab7_mixing implicit none integer, intent(in) :: npoints, istep, n1, n2, n3, nproc, iproc real(gp), intent(in) :: alphamix, ucvol integer, dimension(0:nproc-1,4), intent(in) :: nscatterarr - type(ab6_mixing_object), intent(inout) :: mix + type(ab7_mixing_object), intent(inout) :: mix real(dp), dimension(npoints), intent(inout) :: rhopot real(gp), intent(out) :: rpnrm !local variables @@ -497,10 +497,10 @@ end do ! Do the mixing - call ab6_mixing_eval(mix, rhopot, istep, n1 * n2 * n3, ucvol, & + call ab7_mixing_eval(mix, rhopot, istep, n1 * n2 * n3, ucvol, & & MPI_COMM_WORLD, (nproc > 1), ierr, errmess, resnrm = rpnrm, & & fnrm = fnrm_denpot, fdot = fdot_denpot, user_data = user_data) - if (ierr /= AB6_NO_ERROR) then + if (ierr /= AB7_NO_ERROR) then if (iproc == 0) write(0,*) errmess call MPI_ABORT(MPI_COMM_WORLD, ierr, ie) end if