├── src ├── fft_defs.h ├── config.f ├── opt_param.h ├── version.f90 ├── g_psi_mod.f90 ├── run_info.f90 ├── customize_signals.c ├── parallel_include.f90 ├── parameters.f90 ├── c_defs.h ├── flush_unit.f90 ├── allocate_wfc.f90 ├── atom.f90 ├── date_and_tim.f90 ├── compute_deff.f90 ├── memstat.c ├── Makefile.edison.intel ├── cptimer.c ├── eqvect.f90 ├── stack.c ├── allocate_locpot.f90 ├── s_1psi.f90 ├── find_free_unit.f90 ├── Makefile ├── allocate_fft_custom.f90 ├── trimcheck.f90 ├── h_1psi.f90 ├── s_psi.f90 ├── remove_atomic_rho.f90 ├── MQEoptions.f90 ├── g2_kin.f90 ├── volume.f90 ├── iweights.f90 ├── invmat.f90 ├── divide.f90 ├── set_kup_and_kdw.f90 ├── multable.f90 ├── init_vloc.f90 ├── int_to_char.f90 ├── set_vrs.f90 ├── lchk_tauxk.f90 ├── rotate_wfc.f90 ├── setlocal.f90 ├── a2fmod.f90 ├── n_plane_waves.f90 ├── recips.f90 ├── wavefunctions.f90 ├── deriv_drhoc.f90 ├── ruotaijk.f90 ├── drhoc.f90 ├── close_files.f90 ├── image_io_routines.f90 ├── g_psi.f90 ├── init_at_1.f90 ├── weights.f90 ├── cryst_to_car.f90 ├── hinit0.f90 ├── h_psi.f90 ├── upf.f90 ├── divide_et_impera.f90 ├── gk_sort.f90 ├── stop_run.f90 ├── read_input.f90 ├── upf_to_internal.f90 ├── capital.f90 ├── coset.f90 ├── data_structure.f90 ├── md5_from_file.c ├── data_structure_custom.f90 ├── allocate_fft.f90 ├── matches.f90 ├── kind.f90 ├── struct_fact.f90 ├── memory_report.f90 ├── start_k.f90 ├── remove_tot_torque.f90 ├── md5.h ├── rgen.f90 ├── usnldiag.f90 ├── add_vuspsi.f90 ├── pwscf.f90 ├── init_run.f90 ├── set_signal.f90 ├── allocate_nlpot.f90 ├── openfil.f90 ├── Makefile.base ├── dvloc_of_g.f90 ├── io_global.f90 ├── ylmr2.f90 ├── vloc_of_g.f90 ├── print_clock_pw.f90 └── simpsn.f90 ├── benchmark ├── large.pbs ├── large.sl └── small.in ├── espresso ├── README_espresso ├── test │ └── small.in └── benchmark │ └── small.in ├── ChangeLog └── test └── small.in /src/fft_defs.h: -------------------------------------------------------------------------------- 1 | 2 | #define C_POINTER integer*8 3 | -------------------------------------------------------------------------------- /src/config.f: -------------------------------------------------------------------------------- 1 | #if defined(__PGI) || defined(__CRAY) 2 | #define DECLARE_IARGC external 3 | #else 4 | #define DECLARE_IARGC intrinsic 5 | #endif 6 | -------------------------------------------------------------------------------- /benchmark/large.pbs: -------------------------------------------------------------------------------- 1 | #PBS -q regular 2 | #PBS -l mppwidth=18432 3 | #PBS -j oe 4 | #PBS -l walltime=00:30:00 5 | #PBS -N MiniDft 6 | #PBS -V 7 | 8 | cd $PBS_O_WORKDIR 9 | 10 | export OMP_NUM_THREADS=6 11 | 12 | aprun -n 3072 -N 4 -S 2 -d 6 -cc numa_node ../src/mini_dft -nbgrp 96 -in large.in > large.out 13 | -------------------------------------------------------------------------------- /benchmark/large.sl: -------------------------------------------------------------------------------- 1 | #!/bin/bash -l 2 | #SBATCH -p regular 3 | #SBATCH -N 768 4 | #SBATCH -t 00:01:00 5 | #SBATCH -J my_job 6 | #SBATCH -o my_job.o%j 7 | #SBATCH -A mpccc 8 | 9 | export OMP_NUM_THREADS=6 10 | export KMP_AFFINITY=compact,granularity=core,1 11 | 12 | srun -n 3072 -c 6 ../src/mini_dft -nbgrp 96 -in large.in > large.out 13 | -------------------------------------------------------------------------------- /src/opt_param.h: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2002 FPMD group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | 9 | #if defined __AIX 10 | # define __BSIZ_VALUE 55 11 | #else 12 | # define __BSIZ_VALUE 35 13 | #endif 14 | -------------------------------------------------------------------------------- /src/version.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2003-2011 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | !---------------------------------------------------------------------------- 9 | MODULE global_version 10 | ! 11 | IMPLICIT NONE 12 | ! 13 | SAVE 14 | ! 15 | CHARACTER (LEN=6) :: version_number = '1.1' 16 | ! 17 | END MODULE global_version 18 | -------------------------------------------------------------------------------- /src/g_psi_mod.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2007 PWSCF group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | MODULE g_psi_mod 9 | ! 10 | ! ... These are the variables needed in g_psi 11 | ! 12 | USE kinds, only : DP 13 | ! 14 | IMPLICIT NONE 15 | ! 16 | REAL(DP), ALLOCATABLE :: & 17 | h_diag (:,:),& ! diagonal part of the Hamiltonian 18 | s_diag (:,:) ! diagonal part of the overlap matrix 19 | ! 20 | END MODULE g_psi_mod 21 | -------------------------------------------------------------------------------- /src/run_info.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2011 Quantum ESPRESSO groups 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | !==-----------------------------------------------------------------------==! 9 | MODULE run_info 10 | !==-----------------------------------------------------------------------==! 11 | 12 | IMPLICIT NONE 13 | ! ... title of the simulation 14 | CHARACTER(LEN=75) :: title=' ' 15 | ! 16 | END MODULE run_info 17 | !==-----------------------------------------------------------------------==! 18 | -------------------------------------------------------------------------------- /src/customize_signals.c: -------------------------------------------------------------------------------- 1 | 2 | #ifdef __TRAP_SIGUSR1 3 | #include 4 | #include 5 | #include 6 | 7 | int init_signal(int signum, void (*new_handler)(int)) 8 | { 9 | static struct sigaction action; 10 | 11 | action.sa_handler = new_handler; 12 | // Don't block anything. 13 | // Not sure if it's the correct behavior (or even if there is one) 14 | sigemptyset(&action.sa_mask); 15 | // This will probably make MPI happy 16 | action.sa_flags = SA_RESTART; 17 | 18 | return sigaction(signum, &action, NULL); 19 | } 20 | 21 | 22 | int init_signal_USR1(void (*new_handler)(int)) 23 | { 24 | return init_signal(SIGUSR1, new_handler); 25 | } 26 | #else 27 | void dummy ( ) { } 28 | #endif 29 | -------------------------------------------------------------------------------- /espresso/README_espresso: -------------------------------------------------------------------------------- 1 | This directory provides Quantum Espresso input files that are equivalent 2 | to the MiniDFT benchmark calculations. Although the input options for 3 | MiniDFT reproduce those of QE, MiniDFT uses a different format for 4 | pseudopotential files because miniDFT does not include QE's I/O toolkit. 5 | 6 | MiniDFT developers should use these input files to ensure that the Mini-DFT mini-app reproduces both the physics and the computational profile of the full-application (i.e. Quantum Espresso.) 7 | 8 | The QE documention includes instructions for building QE. The README 9 | file in this directory describes the procedure for running the miniDFT 10 | benchmark calculations. The same instructions can be followed using the 11 | pw.x executable from the QE package. 12 | -------------------------------------------------------------------------------- /src/parallel_include.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2003-2004 Carlo Cavazzoni 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | !------------------------------------------------------------------------------! 9 | ! SISSA Code Interface -- Carlo Cavazzoni 10 | !------------------------------------------------------------------------------C 11 | MODULE parallel_include 12 | 13 | ! 14 | ! Include file for MPI 15 | ! 16 | INCLUDE 'mpif.h' 17 | ! 18 | ! this is only for symmetry with respect to the serial build 19 | LOGICAL :: tparallel = .true. 20 | 21 | END MODULE parallel_include 22 | -------------------------------------------------------------------------------- /src/parameters.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2009 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | MODULE parameters 10 | 11 | IMPLICIT NONE 12 | SAVE 13 | 14 | INTEGER, PARAMETER :: & 15 | ntypx = 10, &! max number of different types of atom 16 | npsx = ntypx, &! max number of different PPs (obsolete) 17 | nsx = ntypx, &! max number of atomic species (CP) 18 | npk = 40000, &! max number of k-points 19 | lmaxx = 3, &! max non local angular momentum (l=0 to lmaxx) 20 | lqmax= 2*lmaxx+1 ! max number of angular momenta of Q 21 | 22 | END MODULE parameters 23 | -------------------------------------------------------------------------------- /src/c_defs.h: -------------------------------------------------------------------------------- 1 | /* include/c_defs.h. Generated from c_defs.h.in by configure. */ 2 | /* 3 | Copyright (C) 2006 Quantum-ESPRESSO group 4 | This file is distributed under the terms of the 5 | GNU General Public License. See the file `License' 6 | in the root directory of the present distribution, 7 | or http://www.gnu.org/copyleft/gpl.txt . 8 | */ 9 | 10 | /* File c_defs.h.in is used by configure to generate c_defs.h 11 | Variables that configure defines should be #undef-ined in 12 | include/c_defs.h.in !!! */ 13 | 14 | /* fortran-to-C naming convention, for functions with and without 15 | underscores in the name (some compilers treat them differently) */ 16 | 17 | #define F77_FUNC(name,NAME) name ## _ 18 | #define F77_FUNC_(name,NAME) name ## _ 19 | 20 | /* do we have the mallinfo structure (see clib/memstat.c) ? */ 21 | 22 | /* #undef HAVE_MALLINFO */ 23 | -------------------------------------------------------------------------------- /src/flush_unit.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2005 PWSCF-FPMD-CPV groups 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | #if defined(__XLF) || defined(__ABSOFT) 9 | #define flush flush_ 10 | #endif 11 | ! 12 | !---------------------------------------------------------------------------- 13 | SUBROUTINE flush_unit( unit_tobeflushed ) 14 | !---------------------------------------------------------------------------- 15 | ! 16 | ! ... this is a wrapper to the standard flush routine 17 | ! 18 | INTEGER, INTENT(IN) :: unit_tobeflushed 19 | LOGICAL :: opnd 20 | ! 21 | ! 22 | INQUIRE( UNIT = unit_tobeflushed, OPENED = opnd ) 23 | ! 24 | IF ( opnd ) CALL flush( unit_tobeflushed ) 25 | ! 26 | RETURN 27 | ! 28 | END SUBROUTINE 29 | -------------------------------------------------------------------------------- /src/allocate_wfc.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2008 PWSCF group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | !---------------------------------------------------------------------------- 10 | SUBROUTINE allocate_wfc() 11 | !---------------------------------------------------------------------------- 12 | ! 13 | ! ... dynamical allocation of arrays: wavefunctions 14 | ! ... must be called after allocate_nlpot 15 | ! 16 | USE io_global, ONLY : stdout 17 | USE wvfct, ONLY : npwx, nbnd 18 | USE basis, ONLY : natomwfc 19 | USE fixed_occ, ONLY : one_atom_occupations 20 | USE wavefunctions_module, ONLY : evc 21 | ! 22 | IMPLICIT NONE 23 | ! 24 | ! 25 | ALLOCATE( evc( npwx, nbnd ) ) 26 | ! 27 | RETURN 28 | ! 29 | END subroutine allocate_wfc 30 | -------------------------------------------------------------------------------- /src/atom.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2004-2007 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | !-------------------------------------------------------------------------- 9 | ! 10 | MODULE atom 11 | ! 12 | ! ... The variables needed to describe the atoms and related quantities 13 | ! 14 | USE radial_grids, ONLY : radial_grid_type 15 | ! 16 | SAVE 17 | ! 18 | type(radial_grid_type), allocatable, target :: & 19 | rgrid(:) ! the information on atomic radial grids. 20 | ! NB: some of the subsequent data are therefore redundant 21 | ! and will be eliminated in due course asap 22 | INTEGER, ALLOCATABLE :: & 23 | msh(:) ! the point at rcut 24 | ! 25 | END MODULE atom 26 | -------------------------------------------------------------------------------- /src/date_and_tim.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001 PWSCF group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | subroutine date_and_tim (cdate, ctime) 9 | ! 10 | ! Returns two strings containing the date and the time 11 | ! in human-readable format. Uses a standard f90 call. 12 | ! 13 | implicit none 14 | character (len=9) :: cdate, ctime 15 | ! 16 | character(len=3), dimension(12) :: months 17 | data months /'Jan','Feb','Mar','Apr','May','Jun', & 18 | 'Jul','Aug','Sep','Oct','Nov','Dec'/ 19 | INTEGER date_time(8) 20 | ! 21 | call date_and_time(values=date_time) 22 | ! 23 | write (cdate,'(i2,a3,i4)') date_time(3), months(date_time(2)), date_time(1) 24 | write (ctime,'(i2,":",i2,":",i2)') date_time(5), date_time(6), date_time(7) 25 | 26 | end subroutine date_and_tim 27 | -------------------------------------------------------------------------------- /src/compute_deff.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2009-2010 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | !--------------------------------------------------------------------------- 9 | SUBROUTINE compute_deff(deff, et) 10 | ! 11 | ! This routine computes the effective value of the D-eS coefficients 12 | ! which appear often in many expressions in the US or PAW case. 13 | ! This routine is for the collinear case. 14 | ! 15 | USE kinds, ONLY : DP 16 | USE ions_base, ONLY : nsp, nat, ityp 17 | USE uspp, ONLY : deeq, qq, okvan 18 | USE uspp_param, ONLY : nhm 19 | USE lsda_mod, ONLY : current_spin 20 | IMPLICIT NONE 21 | 22 | INTEGER :: nt, na, is 23 | REAL(DP), INTENT(OUT) :: deff(nhm, nhm, nat) 24 | REAL(DP), INTENT(IN) :: et 25 | 26 | deff(:,:,:) = deeq(:,:,:,current_spin) 27 | RETURN 28 | END SUBROUTINE compute_deff 29 | -------------------------------------------------------------------------------- /src/memstat.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright (C) 2002 FPMD group 3 | This file is distributed under the terms of the 4 | GNU General Public License. See the file `License' 5 | in the root directory of the present distribution, 6 | or http://www.gnu.org/copyleft/gpl.txt . 7 | */ 8 | 9 | #include "c_defs.h" 10 | 11 | /* 12 | This function return the numer of kilobytes allocated 13 | by the calling process. 14 | Auhor: Carlo Cavazzoni. 15 | */ 16 | 17 | #if defined (__SVR4) && defined (__sun) 18 | #define SUN_MALLINFO 19 | #endif 20 | 21 | #if defined(HAVE_MALLINFO) && !defined(__QK_USER__) && !defined(SUN__MALLINFO) 22 | #include 23 | 24 | void F77_FUNC(memstat,MEMSTAT)(int *kilobytes) 25 | { 26 | 27 | struct mallinfo info; 28 | info = mallinfo(); 29 | 30 | #if defined(__AIX) 31 | *kilobytes = (info.arena) / 1024 ; 32 | #else 33 | *kilobytes = (info.arena + info.hblkhd) / 1024 ; 34 | #endif 35 | 36 | #else 37 | void F77_FUNC(memstat,MEMSTAT)(int *kilobytes) 38 | { 39 | *kilobytes = -1; 40 | #endif 41 | } 42 | -------------------------------------------------------------------------------- /src/Makefile.edison.intel: -------------------------------------------------------------------------------- 1 | 2 | MKLROOT = /opt/intel/composer_xe_2015.1.133/mkl 3 | 4 | FFTW_INCL = -I/opt/intel/composer_xe_2015.1.133/mkl/include/fftw/ 5 | #FFTW_LIBS = -L${MKLROOT}/lib/intel64 -lmkl_scalapack_lp64 -lmkl_intel_lp64 -lmkl_core -lmkl_intel_thread -lmkl_blacs_intelmpi_lp64 -lpthread -lm ${IPM} 6 | FFTW_LIBS = $(MKLROOT)/lib/intel64/libmkl_scalapack_lp64.a -Wl,--start-group $(MKLROOT)/lib/intel64/libmkl_intel_lp64.a \ 7 | $(MKLROOT)/lib/intel64/libmkl_intel_thread.a $(MKLROOT)/lib/intel64/libmkl_core.a $(MKLROOT)/lib/intel64/libmkl_blacs_intelmpi_lp64.a \ 8 | -Wl,--end-group -lpthread -lm ${IPM} 9 | 10 | SCALAPACK_LIBS = 11 | 12 | DFLAGS = -D__INTEL 13 | 14 | CC = cc 15 | CFLAGS = -O2 16 | 17 | FC = ftn 18 | FFLAGS = -fpp -O3 -xAVX 19 | #FFLAGS = -fpp -O2 -g 20 | 21 | LD = ftn 22 | #LD = hpclink ftn 23 | #LDFLAGS = -g -dynamic 24 | 25 | #ifort -openmp defines _OPENMP instead of__OPENMP 26 | DFLAGS += -D__OPENMP 27 | 28 | FFLAGS += -openmp 29 | LDFLAGS += -openmp 30 | 31 | include Makefile.base 32 | -------------------------------------------------------------------------------- /src/cptimer.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright (C) 2002-2006 Quantum ESPRESSO group 3 | This file is distributed under the terms of the 4 | GNU General Public License. See the file `License' 5 | in the root directory of the present distribution, 6 | or http://www.gnu.org/copyleft/gpl.txt . 7 | */ 8 | 9 | #include 10 | #include 11 | #include 12 | 13 | #include "c_defs.h" 14 | 15 | double F77_FUNC(cclock,CCLOCK)() 16 | 17 | /* Return the second elapsed since Epoch (00:00:00 UTC, January 1, 1970) 18 | */ 19 | 20 | { 21 | 22 | struct timeval tmp; 23 | double sec; 24 | gettimeofday( &tmp, (struct timezone *)0 ); 25 | sec = tmp.tv_sec + ((double)tmp.tv_usec)/1000000.0; 26 | return sec; 27 | 28 | } 29 | 30 | double F77_FUNC(scnds,SCNDS) ( ) 31 | 32 | /* Return the cpu time associated to the current process 33 | */ 34 | 35 | { 36 | static struct rusage T; 37 | 38 | getrusage(RUSAGE_SELF, &T); 39 | 40 | return ((double)T.ru_utime.tv_sec + ((double)T.ru_utime.tv_usec)/1000000.0); 41 | } 42 | 43 | -------------------------------------------------------------------------------- /src/eqvect.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2008 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | !----------------------------------------------------------------------- 9 | logical function eqvect (x, y, f) 10 | !----------------------------------------------------------------------- 11 | ! 12 | ! This function test if the difference x-y-f is an integer. 13 | ! x, y = 3d vectors in crystal axis, f = fractionary translation 14 | ! 15 | USE kinds 16 | implicit none 17 | real(DP), intent(in) :: x (3), y (3), f (3) 18 | ! 19 | real(DP), parameter :: accep = 1.0d-5 ! acceptance parameter 20 | ! 21 | eqvect = abs( x(1)-y(1)-f(1) - nint(x(1)-y(1)-f(1)) ) < accep .and. & 22 | abs( x(2)-y(2)-f(2) - nint(x(2)-y(2)-f(2)) ) < accep .and. & 23 | abs( x(3)-y(3)-f(3) - nint(x(3)-y(3)-f(3)) ) < accep 24 | ! 25 | return 26 | end function eqvect 27 | -------------------------------------------------------------------------------- /src/stack.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright (C) 2007-2008 Quantum ESPRESSO group 3 | This file is distributed under the terms of the 4 | GNU General Public License. See the file `License' 5 | in the root directory of the present distribution, 6 | or http://www.gnu.org/copyleft/gpl.txt . 7 | */ 8 | 9 | #include "c_defs.h" 10 | #include 11 | #include 12 | #ifdef __INTEL 13 | 14 | #include 15 | 16 | void F77_FUNC_(remove_stack_limit,REMOVE_STACK_LIMIT) (void) { 17 | 18 | struct rlimit rlim = { RLIM_INFINITY, RLIM_INFINITY }; 19 | 20 | /* Modified according to Cesar Da Silva suggestions */ 21 | if ( setrlimit(RLIMIT_STACK, &rlim) == -1 ) { 22 | if ( getrlimit(RLIMIT_STACK, &rlim) == 0 ) { 23 | rlim.rlim_cur = rlim.rlim_max; 24 | if ( setrlimit(RLIMIT_STACK, &rlim) == 0 ) { 25 | getrlimit(RLIMIT_STACK, &rlim); 26 | } else { 27 | perror(" Cannot set stack size to new value"); 28 | } 29 | } 30 | } 31 | } 32 | 33 | #else 34 | void F77_FUNC_(remove_stack_limit,REMOVE_STACK_LIMIT) (void) { 35 | } 36 | #endif 37 | -------------------------------------------------------------------------------- /src/allocate_locpot.f90: -------------------------------------------------------------------------------- 1 | 2 | ! Copyright (C) 2001 PWSCF group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | !----------------------------------------------------------------------- 10 | subroutine allocate_locpot 11 | !----------------------------------------------------------------------- 12 | ! 13 | ! dynamical allocation of arrays: 14 | ! local potential for each kind of atom, structure factor 15 | ! 16 | USE ions_base, ONLY : nat, ntyp => nsp 17 | USE vlocal, ONLY : vloc, strf 18 | USE gvect, ONLY : eigts1, eigts2, eigts3, ngm, ngl 19 | USE fft_base , ONLY : dfftp 20 | ! 21 | implicit none 22 | ! 23 | allocate (vloc( ngl, ntyp)) 24 | allocate (strf( ngm, ntyp)) 25 | 26 | allocate( eigts1(-dfftp%nr1:dfftp%nr1,nat) ) 27 | allocate( eigts2(-dfftp%nr2:dfftp%nr2,nat) ) 28 | allocate( eigts3(-dfftp%nr3:dfftp%nr3,nat) ) 29 | 30 | return 31 | end subroutine allocate_locpot 32 | 33 | -------------------------------------------------------------------------------- /src/s_1psi.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2004 PWSCF group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | !---------------------------------------------------------------------------- 9 | SUBROUTINE s_1psi( npwx, n, psi, spsi ) 10 | !---------------------------------------------------------------------------- 11 | ! 12 | ! ... spsi = S*psi for one wavefunction 13 | ! ... Wrapper routine - calls calbec and s_psi 14 | ! 15 | USE kinds, ONLY : DP 16 | USE uspp, ONLY : vkb, nkb 17 | USE wvfct, ONLY: nbnd 18 | ! 19 | IMPLICIT NONE 20 | ! 21 | integer, parameter :: npol=1 !substitute for noncollin_module%npol 22 | INTEGER :: npwx, n, ibnd 23 | COMPLEX(DP) :: psi(npwx*npol,1), spsi(npwx*npol,1) 24 | ! 25 | ! 26 | CALL start_clock( 's_1psi' ) 27 | ! 28 | CALL s_psi( npwx, n, 1, psi, spsi ) 29 | ! 30 | CALL stop_clock( 's_1psi' ) 31 | ! 32 | RETURN 33 | ! 34 | END SUBROUTINE s_1psi 35 | -------------------------------------------------------------------------------- /src/find_free_unit.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2002-2009 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | !-------------------------------------------------------------------------- 9 | FUNCTION find_free_unit() 10 | !-------------------------------------------------------------------------- 11 | ! 12 | IMPLICIT NONE 13 | ! 14 | INTEGER :: find_free_unit 15 | INTEGER :: iunit 16 | LOGICAL :: opnd 17 | ! 18 | ! 19 | unit_loop: DO iunit = 99, 1, -1 20 | ! 21 | INQUIRE( UNIT = iunit, OPENED = opnd ) 22 | ! 23 | IF ( .NOT. opnd ) THEN 24 | ! 25 | find_free_unit = iunit 26 | ! 27 | RETURN 28 | ! 29 | END IF 30 | ! 31 | END DO unit_loop 32 | ! 33 | CALL errore( 'find_free_unit()', 'free unit not found ?!?', 1 ) 34 | ! 35 | RETURN 36 | ! 37 | END FUNCTION find_free_unit 38 | ! 39 | -------------------------------------------------------------------------------- /src/Makefile: -------------------------------------------------------------------------------- 1 | 2 | #MKLROOT = /opt/intel/composer_xe_2015.1.133/mkl 3 | MKLROOT = /opt/intel/compilers_and_libraries_2016.0.109/linux/mkl 4 | 5 | FFTW_INCL = -I/${MKLROOT}/include/fftw/ 6 | #FFTW_LIBS = -L${MKLROOT}/lib/intel64 -lmkl_scalapack_lp64 -lmkl_intel_lp64 -lmkl_core -lmkl_intel_thread -lmkl_blacs_intelmpi_lp64 -lpthread -lm ${IPM} 7 | FFTW_LIBS = $(MKLROOT)/lib/intel64/libmkl_scalapack_lp64.a -Wl,--start-group $(MKLROOT)/lib/intel64/libmkl_intel_lp64.a \ 8 | $(MKLROOT)/lib/intel64/libmkl_intel_thread.a $(MKLROOT)/lib/intel64/libmkl_core.a $(MKLROOT)/lib/intel64/libmkl_blacs_intelmpi_lp64.a \ 9 | -Wl,--end-group -lpthread -lm ${IPM} 10 | 11 | SCALAPACK_LIBS = 12 | 13 | DFLAGS = -D__INTEL 14 | 15 | CC = cc 16 | CFLAGS = -O2 17 | 18 | FC = ftn 19 | #FFLAGS = -fpp -O3 -xAVX 20 | FFLAGS = -fpp -fast -no-ipo 21 | #FFLAGS = -fpp -O2 -g 22 | 23 | LD = ftn 24 | #LD = hpclink ftn 25 | #LDFLAGS = -g -dynamic 26 | 27 | #ifort -openmp defines _OPENMP instead of__OPENMP 28 | DFLAGS += -D__OPENMP 29 | 30 | FFLAGS += -openmp 31 | LDFLAGS += -openmp 32 | 33 | include Makefile.base 34 | -------------------------------------------------------------------------------- /src/allocate_fft_custom.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2012 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | !----------------------------------------------------------------------- 10 | ! This subroutine allocates all of the fft stuff for the custom defined grid 11 | ! 12 | SUBROUTINE allocate_fft_custom(fc) 13 | 14 | USE kinds, ONLY : DP 15 | USE gvect, ONLY : g, mill 16 | USE cell_base, ONLY : at, bg, tpiba2 17 | USE control_flags, ONLY : gamma_only 18 | USE fft_custom, ONLY : fft_cus, set_custom_grid, ggent 19 | USE grid_subroutines, ONLY : realspace_grid_init_custom 20 | IMPLICIT NONE 21 | 22 | TYPE (fft_cus) :: fc 23 | 24 | INTEGER :: ng,n1t,n2t,n3t 25 | 26 | IF(fc%initalized) RETURN 27 | ! 28 | fc%gcutmt = fc%dual_t*fc%ecutt / tpiba2 29 | ! 30 | CALL realspace_grid_init_custom(fc%dfftt, at, bg, fc%gcutmt) 31 | ! 32 | CALL data_structure_custom(fc, .TRUE.) 33 | ! 34 | fc%initalized = .true. 35 | ! 36 | CALL ggent(fc) 37 | 38 | RETURN 39 | END SUBROUTINE allocate_fft_custom 40 | -------------------------------------------------------------------------------- /src/trimcheck.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2002-2009 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | !----------------------------------------------------------------------- 10 | FUNCTION trimcheck ( directory ) 11 | !----------------------------------------------------------------------- 12 | ! 13 | ! ... verify if directory ends with /, add one if needed; 14 | ! ... trim white spaces and put the result in trimcheck 15 | ! 16 | IMPLICIT NONE 17 | ! 18 | CHARACTER (LEN=*), INTENT(IN) :: directory 19 | CHARACTER (LEN=256) :: trimcheck 20 | INTEGER :: l 21 | ! 22 | l = LEN_TRIM( directory ) 23 | IF ( l == 0 ) CALL errore( 'trimcheck', ' input name empty', 1) 24 | ! 25 | IF ( directory(l:l) == '/' ) THEN 26 | trimcheck = TRIM ( directory) 27 | ELSE 28 | IF ( l < LEN( trimcheck ) ) THEN 29 | trimcheck = TRIM ( directory ) // '/' 30 | ELSE 31 | CALL errore( 'trimcheck', ' input name too long', l ) 32 | END IF 33 | END IF 34 | ! 35 | RETURN 36 | ! 37 | END FUNCTION trimcheck 38 | ! 39 | -------------------------------------------------------------------------------- /src/h_1psi.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001 PWSCF group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | !---------------------------------------------------------------------------- 10 | SUBROUTINE h_1psi( lda, n, psi, hpsi, spsi ) 11 | !---------------------------------------------------------------------------- 12 | ! 13 | ! ... This routine applies the Hamiltonian and the S matrix 14 | ! ... to a vector psi and puts the result in hpsi and spsi 15 | ! ... Wrapper routine - calls h_psi and s_psi 16 | ! 17 | USE kinds, ONLY: DP 18 | 19 | ! 20 | IMPLICIT NONE 21 | ! 22 | integer, parameter :: npol=1 !substitute for noncollin_module%npol 23 | INTEGER :: lda, n 24 | COMPLEX (DP) :: psi(lda*npol,1), hpsi(n), spsi(n,1) 25 | ! 26 | ! 27 | CALL start_clock( 'h_1psi' ) 28 | ! 29 | !OBM: I know this form is somewhat inelegant but, leaving the pre-real_space part intact 30 | ! makes it easier to debug probable errors, please do not "beautify" 31 | CALL h_psi( lda, n, 1, psi, hpsi ) 32 | CALL s_psi( lda, n, 1, psi, spsi ) 33 | ! 34 | CALL stop_clock( 'h_1psi' ) 35 | ! 36 | RETURN 37 | ! 38 | END SUBROUTINE h_1psi 39 | -------------------------------------------------------------------------------- /src/s_psi.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2007 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | !---------------------------------------------------------------------------- 10 | SUBROUTINE s_psi( lda, n, m, psi, spsi ) 11 | !---------------------------------------------------------------------------- 12 | ! 13 | ! ... This routine applies the S matrix to m wavefunctions psi 14 | ! ... and puts the results in spsi. 15 | ! 16 | ! ... input: 17 | ! 18 | ! ... lda leading dimension of arrays psi, spsi 19 | ! ... n true dimension of psi, spsi 20 | ! ... m number of states psi 21 | ! ... psi 22 | ! 23 | ! ... output: 24 | ! 25 | ! ... spsi S*psi 26 | ! 27 | USE kinds, ONLY : DP 28 | USE uspp, ONLY : vkb, nkb, qq, okvan 29 | USE uspp_param, ONLY : upf, nh 30 | USE ions_base, ONLY : nat, nsp, ityp 31 | ! 32 | IMPLICIT NONE 33 | ! 34 | integer, parameter ::npol=1 !substitute for noncollin_module%npol 35 | INTEGER, INTENT(IN) :: lda, n, m 36 | COMPLEX(DP), INTENT(IN) :: psi(lda*npol,m) 37 | COMPLEX(DP), INTENT(OUT)::spsi(lda*npol,m) 38 | ! 39 | INTEGER :: ibnd 40 | ! 41 | ! ... initialize spsi 42 | ! 43 | spsi = psi 44 | ! 45 | ! 46 | RETURN 47 | ! 48 | 49 | END SUBROUTINE s_psi 50 | -------------------------------------------------------------------------------- /src/remove_atomic_rho.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001 PWSCF group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | !----------------------------------------------------------------------- 9 | subroutine remove_atomic_rho 10 | !----------------------------------------------------------------------- 11 | USE io_global, ONLY: stdout 12 | USE io_files, ONLY: output_drho 13 | USE kinds, ONLY: DP 14 | USE fft_base, ONLY: dfftp 15 | USE lsda_mod, ONLY: nspin 16 | USE scf, ONLY: rho 17 | implicit none 18 | 19 | real(DP), allocatable :: work (:,:) 20 | ! workspace, is the difference between the charge density 21 | ! and the superposition of atomic charges 22 | 23 | allocate ( work( dfftp%nnr, 1 ) ) 24 | work = 0.d0 25 | ! 26 | IF ( nspin > 1 ) CALL errore & 27 | ( 'remove_atomic_rho', 'spin polarization not allowed in drho', 1 ) 28 | 29 | WRITE( stdout, '(/5x,"remove atomic charge density from scf rho")') 30 | ! 31 | ! subtract the old atomic charge density 32 | ! 33 | call atomic_rho (work, nspin) 34 | ! 35 | work = rho%of_r - work 36 | ! 37 | call infomsg("remove_atomic_rho.f90:38","skipping write_rho, requires iotk") 38 | !call write_rho ( work, 1, output_drho ) 39 | ! 40 | deallocate(work) 41 | return 42 | 43 | end subroutine remove_atomic_rho 44 | 45 | -------------------------------------------------------------------------------- /src/MQEoptions.f90: -------------------------------------------------------------------------------- 1 | #include "config.f" 2 | 3 | module MQEoptions 4 | 5 | type :: MQEoptions_t 6 | character*256 :: infile = ' ' 7 | integer :: npool 8 | integer :: ntg 9 | integer :: ndiag 10 | end type MQEoptions_t 11 | 12 | type( MQEoptions_t ) :: MQEo 13 | 14 | end module MQEoptions 15 | 16 | subroutine MQEoptions_read() 17 | 18 | use MQEoptions, only: MQEo 19 | integer, DECLARE_IARGC :: iargc 20 | 21 | integer :: iarg, narg 22 | character*80 :: arg_i 23 | 24 | !set default options 25 | MQEo%infile = "pw.in" 26 | MQEo%npool = 1 27 | MQEo%ntg = 1 28 | MQEo%ndiag = 0 29 | 30 | iarg = 1 31 | narg = iargc() 32 | do while( iarg .le. narg ) 33 | 34 | call getarg( iarg, arg_i ) 35 | 36 | select case( arg_i ) 37 | 38 | case("-in") 39 | iarg = iarg + 1 40 | call getarg( iarg, arg_i ) 41 | read(arg_i,*) MQEo%infile 42 | 43 | case("-npool") 44 | iarg = iarg + 1 45 | call getarg( iarg, arg_i ) 46 | read(arg_i,*) MQEo%npool 47 | 48 | case("-ntg") 49 | iarg = iarg + 1 50 | call getarg( iarg, arg_i ) 51 | read(arg_i,*) MQEo%ntg 52 | 53 | case("-ndiag") 54 | iarg = iarg + 1 55 | call getarg( iarg, arg_i ) 56 | read(arg_i,*) MQEo%ndiag 57 | 58 | case default 59 | write(*,*)"Error: Unrecognized option: ", trim(arg_i) 60 | stop 61 | 62 | end select 63 | 64 | iarg = iarg + 1 65 | end do 66 | 67 | end subroutine MQEoptions_read 68 | -------------------------------------------------------------------------------- /src/g2_kin.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2007 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | !---------------------------------------------------------------------------- 10 | SUBROUTINE g2_kin ( ik ) 11 | !---------------------------------------------------------------------------- 12 | ! 13 | ! ... Calculation of kinetic energy - includes the case of the modified 14 | ! ... kinetic energy functional for variable-cell calculations 15 | ! 16 | USE kinds, ONLY : DP 17 | USE cell_base, ONLY : tpiba2 18 | USE klist, ONLY : xk 19 | USE gvect, ONLY : g 20 | USE wvfct, ONLY : g2kin, igk, npw, ecfixed, qcutz, q2sigma 21 | ! 22 | IMPLICIT NONE 23 | ! 24 | INTEGER, INTENT (IN) :: ik 25 | ! 26 | ! ... local variables 27 | ! 28 | INTEGER :: ig 29 | REAL(DP), EXTERNAL :: qe_erf 30 | ! 31 | ! 32 | g2kin(1:npw) = ( ( xk(1,ik) + g(1,igk(1:npw)) )**2 + & 33 | ( xk(2,ik) + g(2,igk(1:npw)) )**2 + & 34 | ( xk(3,ik) + g(3,igk(1:npw)) )**2 ) * tpiba2 35 | ! 36 | IF ( qcutz > 0.D0 ) THEN 37 | ! 38 | DO ig = 1, npw 39 | ! 40 | g2kin(ig) = g2kin(ig) + qcutz * & 41 | ( 1.D0 + qe_erf( ( g2kin(ig) - ecfixed ) / q2sigma ) ) 42 | ! 43 | END DO 44 | ! 45 | END IF 46 | ! 47 | RETURN 48 | ! 49 | END SUBROUTINE g2_kin 50 | -------------------------------------------------------------------------------- /src/volume.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001 PWSCF group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | !--------------------------------------------------------------------- 10 | subroutine volume (alat, a1, a2, a3, omega) 11 | !--------------------------------------------------------------------- 12 | ! 13 | ! Compute the volume of the unit cell 14 | ! 15 | use kinds, ONLY: DP 16 | implicit none 17 | ! 18 | ! First the I/O variables 19 | ! 20 | real(DP) :: alat, a1 (3), a2 (3), a3 (3), omega 21 | ! input: lattice parameter (unit length) 22 | ! input: the first lattice vector 23 | ! input: the second lattice vector 24 | ! input: the third lattice vector 25 | ! input: the volume of the unit cell 26 | ! 27 | ! Here the local variables required by the routine 28 | ! 29 | 30 | real(DP) :: s 31 | ! the sign of a permutation 32 | integer :: i, j, k, l, iperm 33 | !\ 34 | ! \ 35 | ! / auxiliary indices 36 | !/ 37 | ! counter on permutations 38 | ! 39 | ! Compute the volume 40 | ! 41 | omega = 0.d0 42 | s = 1.d0 43 | i = 1 44 | j = 2 45 | k = 3 46 | 101 do iperm = 1, 3 47 | omega = omega + s * a1 (i) * a2 (j) * a3 (k) 48 | l = i 49 | i = j 50 | j = k 51 | k = l 52 | enddo 53 | i = 2 54 | j = 1 55 | k = 3 56 | s = - s 57 | 58 | if (s.lt.0.d0) goto 101 59 | 60 | omega = abs (omega) * alat**3 61 | return 62 | end subroutine volume 63 | -------------------------------------------------------------------------------- /src/iweights.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001 PWSCF group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | !-------------------------------------------------------------------- 10 | subroutine iweights (nks, wk, nbnd, nelec, et, Ef, wg, is, isk) 11 | !-------------------------------------------------------------------- 12 | ! calculates weights for semiconductors and insulators 13 | ! (bands are either empty or filled) 14 | ! On output, Ef is the highest occupied Kohn-Sham level 15 | USE kinds 16 | USE mp, ONLY : mp_max 17 | USE mp_global, ONLY : inter_pool_comm 18 | implicit none 19 | ! 20 | integer, intent(in) :: nks, nbnd, is, isk(nks) 21 | real(DP), intent(in) :: wk (nks), et(nbnd, nks), nelec 22 | real(DP), intent(out) :: wg (nbnd, nks), Ef 23 | real(DP) :: degspin 24 | integer :: kpoint, ibnd 25 | 26 | degspin=2.d0 27 | if (is /= 0) degspin = 1.d0 28 | Ef = - 1.0d+20 29 | do kpoint = 1, nks 30 | if (is /= 0) then 31 | if (isk(kpoint) .ne. is ) cycle 32 | end if 33 | do ibnd = 1, nbnd 34 | if (ibnd <= nint (nelec) / degspin) then 35 | wg (ibnd, kpoint) = wk (kpoint) 36 | Ef = MAX (Ef, et (ibnd, kpoint) ) 37 | else 38 | wg (ibnd, kpoint) = 0.d0 39 | endif 40 | enddo 41 | enddo 42 | ! 43 | ! find max across pools 44 | ! 45 | CALL mp_max( ef, inter_pool_comm ) 46 | 47 | return 48 | end subroutine iweights 49 | -------------------------------------------------------------------------------- /src/invmat.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2004 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | subroutine invmat (n, a, a_inv, da) 9 | !----------------------------------------------------------------------- 10 | ! computes the inverse "a_inv" of matrix "a", both dimensioned (n,n) 11 | ! if the matrix is dimensioned 3x3, it also computes determinant "da" 12 | ! matrix "a" is unchanged on output - LAPACK 13 | ! 14 | USE kinds, ONLY : DP 15 | implicit none 16 | integer :: n 17 | real(DP), DIMENSION (n,n) :: a, a_inv 18 | real(DP) :: da 19 | ! 20 | integer :: info, lda, lwork, ipiv (n) 21 | ! info=0: inversion was successful 22 | ! lda : leading dimension (the same as n) 23 | ! ipiv : work space for pivoting (assumed of length lwork=n) 24 | real(DP) :: work (n) 25 | ! more work space 26 | ! 27 | lda = n 28 | lwork=n 29 | ! 30 | a_inv(:,:) = a(:,:) 31 | ! 32 | call dgetrf (n, n, a_inv, lda, ipiv, info) 33 | call errore ('invmat', 'error in DGETRF', abs (info) ) 34 | call dgetri (n, a_inv, lda, ipiv, work, lwork, info) 35 | call errore ('invmat', 'error in DGETRI', abs (info) ) 36 | ! 37 | if (n == 3) then 38 | da = a(1,1)*(a(2,2)*a(3,3)-a(2,3)*a(3,2)) + & 39 | a(1,2)*(a(2,3)*a(3,1)-a(2,1)*a(3,3)) + & 40 | a(1,3)*(a(2,1)*a(3,2)-a(3,1)*a(2,2)) 41 | IF (ABS(da) < 1.d-10) CALL errore(' invmat ',' singular matrix ', 1) 42 | else 43 | da = 0.d0 44 | end if 45 | 46 | return 47 | end subroutine invmat 48 | 49 | -------------------------------------------------------------------------------- /src/divide.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2012 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | !----------------------------------------------------------------------- 10 | SUBROUTINE divide (comm, ntodiv, startn, lastn) 11 | !----------------------------------------------------------------------- 12 | ! Divide ntodiv poins across processors belonging to communicator comm 13 | ! Each processor gets points from startn to lastn 14 | ! 15 | ! 16 | USE mp, ONLY : mp_size, mp_rank 17 | IMPLICIT NONE 18 | ! 19 | INTEGER, INTENT(in) :: comm 20 | INTEGER, INTENT(in) :: ntodiv 21 | INTEGER, INTENT(out):: startn, lastn 22 | ! 23 | INTEGER :: me_comm, nproc_comm 24 | ! 25 | INTEGER :: nb, resto, idx, ip 26 | ! number of bands per processor 27 | ! one additional band if me_pool+1 <= resto 28 | ! counter on bands 29 | ! counter on processors 30 | ! 31 | nproc_comm = mp_size(comm) 32 | me_comm = mp_rank(comm) 33 | ! 34 | nb = ntodiv / nproc_comm 35 | resto = ntodiv - nb * nproc_comm 36 | idx = 0 37 | DO ip = 1, nproc_comm 38 | IF (ip <= resto) THEN 39 | IF (me_comm+1 == ip) THEN 40 | startn = idx + 1 41 | lastn = startn + nb 42 | ENDIF 43 | idx = idx + nb + 1 44 | ELSE 45 | IF (me_comm+1 == ip) THEN 46 | startn = idx + 1 47 | lastn = startn + nb - 1 48 | ENDIF 49 | idx = idx + nb 50 | ENDIF 51 | ENDDO 52 | RETURN 53 | 54 | END SUBROUTINE divide 55 | 56 | -------------------------------------------------------------------------------- /src/set_kup_and_kdw.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2007 PWSCF group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | !----------------------------------------------------------------------- 9 | subroutine set_kup_and_kdw (xk, wk, isk, nkstot, npk) 10 | !----------------------------------------------------------------------- 11 | ! This routine sets the k vectors for the up and down spin wfc 12 | ! 13 | ! on input: xk and wk contain k-points and corresponding weights 14 | ! 15 | ! on output: the number of points is doubled and xk and wk in the 16 | ! first (nkstot/2) positions correspond to up spin 17 | ! those in the second (nkstot/2) ones correspond to down spin 18 | ! 19 | USE kinds, ONLY : DP 20 | implicit none 21 | ! 22 | ! I/O variables first 23 | ! 24 | integer :: npk, isk (npk), nkstot 25 | ! input: maximum allowed number of k-points 26 | ! output: spin associated to a given k-point 27 | ! input-output: starting and ending number of k-points 28 | real(DP) :: xk (3, npk), wk (npk) 29 | ! input-output: coordinates of k points 30 | ! input-output: weights of k points 31 | ! 32 | integer :: ik, iq, ikq 33 | ! 34 | ! 35 | if (2*nkstot > npk) call errore ('set_kup&kdw','too many k points',nkstot) 36 | do ik = 1, nkstot 37 | xk(:,ik+nkstot)= xk(:,ik) 38 | wk (ik+nkstot) = wk(ik) 39 | isk(ik) = 1 40 | isk(ik+nkstot) = 2 41 | enddo 42 | nkstot = 2 * nkstot 43 | 44 | return 45 | 46 | end subroutine set_kup_and_kdw 47 | -------------------------------------------------------------------------------- /src/multable.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2010 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | !----------------------------------------------------------------------- 10 | SUBROUTINE multable (nsym, s, table) 11 | !----------------------------------------------------------------------- 12 | ! 13 | ! Checks that {S} is a group and calculates multiplication table 14 | ! 15 | IMPLICIT NONE 16 | ! 17 | INTEGER, INTENT(IN) :: nsym, s(3,3,nsym) 18 | ! nsym = number of symmetry operations 19 | ! s = rotation matrix (in crystal axis, represented by integers) 20 | INTEGER, INTENT(OUT) :: table (48, 48) 21 | ! multiplication table: S(n)*S(m) = S (table(n,m) ) 22 | ! 23 | INTEGER :: isym, jsym, ksym, ss (3, 3) 24 | LOGICAL :: found, smn 25 | ! 26 | DO isym = 1, nsym 27 | DO jsym = 1, nsym 28 | ! 29 | ss = MATMUL (s(:,:,jsym),s(:,:,isym)) 30 | ! 31 | ! here we check that the input matrices really form a group 32 | ! and we set the multiplication table 33 | ! 34 | found = .false. 35 | DO ksym = 1, nsym 36 | smn = ALL ( s(:,:,ksym) == ss(:,:) ) 37 | IF (smn) THEN 38 | IF (found) CALL errore ('multable', 'Not a group', 1) 39 | found = .true. 40 | table (jsym, isym) = ksym 41 | END IF 42 | END DO 43 | IF ( .NOT.found) CALL errore ('multable', ' Not a group', 2) 44 | END DO 45 | END DO 46 | RETURN 47 | ! 48 | END SUBROUTINE multable 49 | -------------------------------------------------------------------------------- /src/init_vloc.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2007 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | !---------------------------------------------------------------------- 10 | subroutine init_vloc() 11 | !---------------------------------------------------------------------- 12 | ! 13 | ! This routine computes the fourier coefficient of the local 14 | ! potential vloc(ig,it) for each type of atom 15 | ! 16 | USE atom, ONLY : msh, rgrid 17 | USE kinds, ONLY : dp 18 | USE uspp_param, ONLY : upf 19 | USE ions_base, ONLY : ntyp => nsp 20 | USE cell_base, ONLY : omega, tpiba2 21 | USE vlocal, ONLY : vloc 22 | USE gvect, ONLY : ngl, gl 23 | ! 24 | implicit none 25 | ! 26 | integer :: nt 27 | ! counter on atomic types 28 | ! 29 | call start_clock ('init_vloc') 30 | vloc(:,:) = 0._dp 31 | do nt = 1, ntyp 32 | ! 33 | ! compute V_loc(G) for a given type of atom 34 | ! 35 | IF ( .NOT. ASSOCIATED ( upf(nt)%vloc ) ) THEN 36 | ! 37 | ! special case: pseudopotential is coulomb 1/r potential 38 | ! 39 | call vloc_coul (upf(nt)%zp, tpiba2, ngl, gl, omega, vloc (1, nt) ) 40 | ! 41 | ELSE 42 | ! 43 | ! normal case 44 | ! 45 | call vloc_of_g (rgrid(nt)%mesh, msh (nt), rgrid(nt)%rab, rgrid(nt)%r, & 46 | upf(nt)%vloc(1), upf(nt)%zp, tpiba2, ngl, gl, omega, vloc (1, nt) ) 47 | ! 48 | END IF 49 | enddo 50 | call stop_clock ('init_vloc') 51 | return 52 | end subroutine init_vloc 53 | 54 | -------------------------------------------------------------------------------- /src/int_to_char.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2009 Quantum ESPRESSO groups 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | !----------------------------------------------------------------------- 9 | FUNCTION int_to_char( i ) 10 | !----------------------------------------------------------------------- 11 | ! 12 | ! ... converts an integer number of up to 6 figures 13 | ! ... into a left-justifed character variable 14 | ! 15 | IMPLICIT NONE 16 | ! 17 | INTEGER, INTENT(IN) :: i 18 | CHARACTER (LEN=6) :: int_to_char 19 | CHARACTER :: c 20 | INTEGER :: n, j, nc 21 | LOGICAL :: neg 22 | ! 23 | nc = 6 24 | ! 25 | IF( i < 0 ) then 26 | nc = nc - 1 27 | n = -i 28 | neg = .true. 29 | ELSE 30 | n = i 31 | neg = .false. 32 | END IF 33 | ! 34 | j = 1 35 | DO WHILE( j <= nc ) 36 | int_to_char(j:j) = CHAR( MOD( n, 10 ) + ICHAR( '0' ) ) 37 | n = n / 10 38 | IF( n == 0 ) EXIT 39 | j = j + 1 40 | END DO 41 | ! 42 | IF( j <= nc ) THEN 43 | DO n = 1, j/2 44 | c = int_to_char( n : n ) 45 | int_to_char( n : n ) = int_to_char( j-n+1 : j-n+1 ) 46 | int_to_char( j-n+1 : j-n+1 ) = c 47 | END DO 48 | IF( j < nc ) int_to_char(j+1:nc) = ' ' 49 | ELSE 50 | int_to_char(:) = '*' 51 | END IF 52 | ! 53 | IF( neg ) THEN 54 | DO n = nc+1, 2, -1 55 | int_to_char(n:n) = int_to_char(n-1:n-1) 56 | END DO 57 | int_to_char(1:1) = '-' 58 | END IF 59 | ! 60 | RETURN 61 | ! 62 | END FUNCTION int_to_char 63 | -------------------------------------------------------------------------------- /ChangeLog: -------------------------------------------------------------------------------- 1 | 01-May-2015 J. Deslippe 2 | * Added EXX to MiniDFT - supports PBE0 functional. 3 | * Deleted unused code including forces/stress/spin/gamma-only. 4 | * Moved large becp allocations to be done on the fly 5 | * Added openmp to BLAS1 like code in exx routine etc. 6 | * Update benchmarks to pbe0 7 | 8 | 01-June-2013 v1.06 B. Austin 9 | * README: removed 10k MPI task constraint for capability run 10 | 11 | 28-May-2013 v1.05 B. Austin 12 | * src/init_run.f90: force stop if npool != nkpoint 13 | * src/c_bands.f90 hinit0.f90 init_run.f90 openfil.f90 14 | version.f90 wfcinit.f90: added ifdef to override new force stop 15 | * README: updated to describe force stop behavior. 16 | * src/pwscf.f90: renamed IPM regions 17 | 18 | 25-April-2013 v1.04 B. Austin 19 | * README: described capability improvement experiment 20 | * benchmark/*.out.ref: moved to sample_outputs/*.out.ref, and updated 21 | * benchmark/*.in and espresso/benchmark/*.in: 22 | renamed single-node.in and large.in 23 | * Added benchmark/*.pbs - sample queue scripts 24 | 25 | 18-April-2013 v1.03 B. Austin 26 | * src/pwscf.f90: added IPM regions (ifdef protected) 27 | * src/Makefile.hopper.*: added optional (default=off) IPM defines 28 | * benchmark/magnesia_10_130.out.ref: updated reference output 29 | 30 | 27-March-2013 v1.02 B. Austin 31 | * README: define concurrency for MPI-only tests. 32 | * Added ChangeLog 33 | 34 | 22-March-2013 v1.01 B. Austin 35 | * src/*.UPF src/*.nml: removed pseudopotential files from src directory 36 | 37 | 02-March-2013 v1.0 B. Austin 38 | * Initial check-in 39 | -------------------------------------------------------------------------------- /src/set_vrs.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001 PWSCF group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | !-------------------------------------------------------------------- 9 | subroutine set_vrs (vrs, vltot, vr, kedtau, kedtaur,nrxx, nspin, doublegrid) 10 | !-------------------------------------------------------------------- 11 | ! set the total local potential vrs on the smooth mesh to be used in 12 | ! h_psi, adding the (spin dependent) scf (H+xc) part and the sum of 13 | ! all the local pseudopotential contributions. 14 | ! 15 | USE kinds 16 | USE fft_base, only : dffts 17 | implicit none 18 | 19 | integer :: nspin, nrxx 20 | ! input: number of spin components: 1 if lda, 2 if lsd, 4 if noncolinear 21 | ! input: the fft grid dimension 22 | real(DP) :: vrs (nrxx, nspin), vltot (nrxx), vr (nrxx, nspin), & 23 | kedtau, kedtaur 24 | ! output: total local potential on the smooth grid 25 | ! vrs=vltot+vr 26 | ! input: the total local pseudopotential 27 | ! input: the scf(H+xc) part of the local potential 28 | logical :: doublegrid 29 | ! input: true if a doublegrid is used 30 | 31 | integer:: is 32 | 33 | do is = 1, nspin 34 | ! 35 | ! define the total local potential (external + scf) for each spin ... 36 | ! 37 | if (is > 1 .and. nspin == 4) then 38 | ! 39 | ! noncolinear case: only the first component contains vltot 40 | ! 41 | vrs (:, is) = vr (:, is) 42 | else 43 | vrs (:, is) = vltot (:) + vr (:, is) 44 | end if 45 | ! 46 | ! ... and interpolate it on the smooth mesh if necessary 47 | ! 48 | if (doublegrid) call interpolate (vrs (1, is), vrs (1, is), - 1) 49 | enddo 50 | return 51 | 52 | end subroutine set_vrs 53 | -------------------------------------------------------------------------------- /src/lchk_tauxk.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2008 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | !----------------------------------------------------------------------- 10 | subroutine check_atoms (nvec, vec, trmat) 11 | !----------------------------------------------------------------------- 12 | ! 13 | ! This routine tests that the atomic coordinates (or k-points) 14 | ! are different and not related by a lattice translation 15 | ! 16 | ! 17 | USE kinds 18 | implicit none 19 | ! 20 | integer, intent(in) :: nvec 21 | ! nvec : number of atomic positions (or k-points) 22 | real(DP), intent(in) :: vec (3, nvec), trmat (3, 3) 23 | ! vec : cartesian coordinates of atomic positions (or k-points) 24 | ! trmat: transformation matrix to crystal axis 25 | ! ( = bg , basis of the real-space lattice, for atoms 26 | ! = at , basis of the rec.-space lattice, for k-points ) 27 | ! 28 | integer :: nv1, nv2 29 | real(DP), allocatable :: vaux(:,:) 30 | real(DP) :: zero (3) = 0.0_dp 31 | character(len=30) :: message 32 | logical, external :: eqvect 33 | ! 34 | ! Copy input positions and transform them to crystal units 35 | ! 36 | allocate ( vaux(3,nvec) ) 37 | vaux = vec 38 | call cryst_to_cart ( nvec, vaux, trmat, -1) 39 | ! 40 | ! Test that all the atomic positions (or k-points) are different 41 | ! 42 | do nv1 = 1, nvec-1 43 | do nv2 = nv1+1, nvec 44 | if ( eqvect ( vaux (1,nv1), vaux (1,nv2), zero ) ) then 45 | write (message,'("atoms #",i4," and #",i4," overlap!")') nv1, nv2 46 | call errore ( 'check_atoms', message, 1) 47 | end if 48 | enddo 49 | enddo 50 | ! 51 | deallocate(vaux) 52 | return 53 | end subroutine check_atoms 54 | 55 | -------------------------------------------------------------------------------- /src/rotate_wfc.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2007 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | !---------------------------------------------------------------------------- 10 | SUBROUTINE rotate_wfc & 11 | ( npwx, npw, nstart, gstart, nbnd, psi, npol, overlap, evc, e ) 12 | !---------------------------------------------------------------------------- 13 | ! 14 | ! ... Driver routine (maybe it should be an interface) for 15 | ! ... Hamiltonian diagonalization in the subspace spanned 16 | ! ... by nstart states psi ( atomic or random wavefunctions ). 17 | ! ... Produces on output nbnd eigenvectors ( nbnd <= nstart ) in evc. 18 | ! ... Calls h_psi, s_psi to calculate H|psi> ans S|psi> 19 | ! ... It only uses an auxiliary array of the same size as psi. 20 | ! 21 | USE kinds, ONLY : DP 22 | ! 23 | IMPLICIT NONE 24 | ! 25 | ! ... I/O variables 26 | ! 27 | INTEGER, INTENT(IN) :: npw, npwx, nstart, nbnd, gstart, npol 28 | ! dimension of the matrix to be diagonalized 29 | ! leading dimension of matrix psi, as declared in the calling pgm unit 30 | ! input number of states 31 | ! output number of states 32 | ! first G with nonzero norm 33 | ! number of spin polarizations 34 | LOGICAL, INTENT(IN) :: overlap 35 | ! if .FALSE. : S|psi> not needed 36 | COMPLEX(DP), INTENT(INOUT) :: psi(npwx*npol,nstart), evc(npwx*npol,nbnd) 37 | ! input and output eigenvectors (may overlap) 38 | REAL(DP), INTENT(OUT) :: e(nbnd) 39 | ! eigenvalues 40 | ! 41 | CALL start_clock( 'wfcrot' ) 42 | ! 43 | ! 44 | ! use data distributed subroutine 45 | ! 46 | ! 47 | CALL protate_wfc_k & 48 | ( npwx, npw, nstart, nbnd, npol, psi, overlap, evc, e ) 49 | ! 50 | ! 51 | CALL stop_clock( 'wfcrot' ) 52 | ! 53 | END SUBROUTINE rotate_wfc 54 | -------------------------------------------------------------------------------- /src/setlocal.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001 PWSCF group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | !---------------------------------------------------------------------- 10 | subroutine setlocal 11 | !---------------------------------------------------------------------- 12 | ! 13 | ! This routine computes the local potential in real space vltot(ir) 14 | ! 15 | USE kinds, ONLY : DP 16 | USE constants, ONLY : eps8 17 | USE ions_base, ONLY : zv, ntyp => nsp 18 | USE cell_base, ONLY : omega 19 | USE extfield, ONLY : tefield, dipfield, etotefield 20 | USE gvect, ONLY : igtongl, gg 21 | USE scf, ONLY : rho, v_of_0, vltot 22 | USE vlocal, ONLY : strf, vloc 23 | USE fft_base, ONLY : dfftp 24 | USE fft_interfaces,ONLY : invfft 25 | USE gvect, ONLY : nl, nlm, ngm 26 | USE mp_global, ONLY : intra_pool_comm, intra_bgrp_comm 27 | USE mp, ONLY : mp_sum 28 | 29 | ! 30 | implicit none 31 | complex(DP), allocatable :: aux (:), v_corr(:) 32 | ! auxiliary variable 33 | integer :: nt, ng 34 | ! counter on atom types 35 | ! counter on g vectors 36 | ! 37 | allocate (aux( dfftp%nnr)) 38 | aux(:)=(0.d0,0.d0) 39 | ! 40 | ! 41 | do nt = 1, ntyp 42 | do ng = 1, ngm 43 | aux (nl(ng))=aux(nl(ng)) + vloc (igtongl (ng), nt) * strf (ng, nt) 44 | enddo 45 | enddo 46 | ! 47 | ! ... v_of_0 is (Vloc)(G=0) 48 | ! 49 | v_of_0=0.0_DP 50 | if (gg(1) < eps8) v_of_0 = DBLE ( aux (nl(1)) ) 51 | ! 52 | call mp_sum( v_of_0, intra_bgrp_comm ) 53 | ! 54 | ! ... aux = potential in G-space . FFT to real space 55 | ! 56 | CALL invfft ('Dense', aux, dfftp) 57 | ! 58 | vltot (:) = DBLE (aux (:) ) 59 | ! 60 | ! ... If required add an electric field to the local potential 61 | ! 62 | ! 63 | deallocate(aux) 64 | ! 65 | return 66 | end subroutine setlocal 67 | 68 | -------------------------------------------------------------------------------- /src/a2fmod.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2006 Malgorzata Wierbowska and Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | MODULE a2F 9 | ! 10 | ! This module contains a routine saving variables needed for the 11 | ! electron-phonon calculation (new algorithm implemeted by MW) 12 | ! 13 | USE kinds, ONLY : DP 14 | ! 15 | LOGICAL :: la2F = .FALSE. 16 | ! 17 | PRIVATE 18 | PUBLIC :: la2F, a2Fsave 19 | CONTAINS 20 | ! 21 | SUBROUTINE a2Fsave 22 | 23 | USE kinds, ONLY : DP 24 | USE klist, ONLY : nks, nkstot, xk, wk 25 | USE ions_base, ONLY : nat 26 | USE wvfct, ONLY : et, nbnd 27 | USE start_k, ONLY : nk1, nk2, nk3 28 | USE symm_base, ONLY : s, nsym, irt 29 | USE io_global, ONLY : ionode 30 | USE io_files, ONLY : seqopn 31 | implicit none 32 | ! 33 | INTEGER :: iuna2Fsave = 40, i, j, ik, ns, na 34 | logical :: exst 35 | ! 36 | ! parallel case: only first node writes 37 | IF ( ionode ) THEN 38 | ! 39 | CALL seqopn( iuna2Fsave, 'a2Fsave', 'FORMATTED', exst ) 40 | !=========================================== 41 | ! 42 | WRITE( iuna2Fsave, * ) nbnd, nkstot 43 | WRITE( iuna2Fsave, * ) et 44 | WRITE( iuna2Fsave, * ) ((xk(i,ik), i=1,3), ik=1,nkstot) 45 | WRITE( iuna2Fsave, * ) wk(1:nkstot) 46 | WRITE( iuna2Fsave, * ) nk1, nk2, nk3 47 | ! 48 | WRITE( iuna2Fsave, * ) nsym 49 | do ns=1,nsym 50 | WRITE( iuna2Fsave, * ) ((s(i,j,ns),j=1,3),i=1,3) 51 | enddo 52 | WRITE( iuna2Fsave, * ) ((irt(ns,na),ns=1,nsym),na=1,nat) 53 | ! 54 | CLOSE( UNIT = iuna2Fsave, STATUS = 'KEEP' ) 55 | ! 56 | END IF 57 | ! 58 | RETURN 59 | END SUBROUTINE a2Fsave 60 | END MODULE a2F 61 | -------------------------------------------------------------------------------- /src/n_plane_waves.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001 PWSCF group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | !----------------------------------------------------------------------- 10 | subroutine n_plane_waves (ecutwfc, tpiba2, nks, xk, g, ngm, npwx, ngk) 11 | !----------------------------------------------------------------------- 12 | ! 13 | ! Find number of plane waves for each k-point 14 | ! 15 | USE kinds, only: DP 16 | USE mp, ONLY : mp_max 17 | USE mp_global, ONLY : inter_pool_comm 18 | implicit none 19 | ! 20 | integer, intent(in) :: nks, ngm 21 | real(DP), intent(in) :: ecutwfc, tpiba2, xk (3, nks), g (3, ngm) 22 | ! 23 | integer, intent(out) :: npwx, ngk (nks) 24 | ! 25 | integer :: nk, ng 26 | real(DP) :: q2 27 | ! 28 | npwx = 0 29 | do nk = 1, nks 30 | ngk (nk) = 0 31 | do ng = 1, ngm 32 | q2 = (xk (1, nk) + g (1, ng) ) **2 + (xk (2, nk) + g (2, ng) ) ** & 33 | 2 + (xk (3, nk) + g (3, ng) ) **2 34 | if (q2 <= ecutwfc / tpiba2) then 35 | ! 36 | ! here if |k+G|^2 <= Ecut increase the number of G inside the sphere 37 | ! 38 | ngk (nk) = ngk (nk) + 1 39 | else 40 | if (sqrt (g (1, ng) **2 + g (2, ng) **2 + g (3, ng) **2) & 41 | .gt.sqrt (xk (1, nk) **2 + xk (2, nk) **2 + xk (3, nk) **2) & 42 | + sqrt (ecutwfc / tpiba2) ) goto 100 43 | ! 44 | ! if |G| > |k| + sqrt(Ecut) stop search 45 | ! 46 | endif 47 | enddo 48 | 100 npwx = max (npwx, ngk (nk) ) 49 | enddo 50 | if (npwx <= 0) call errore ('n_plane_waves', & 51 | 'No plane waves found: running on too many processors?', 1) 52 | ! 53 | ! when using pools, set npwx to the maximum value across pools 54 | ! (you may run into trouble at restart otherwise) 55 | ! 56 | CALL mp_max ( npwx, inter_pool_comm ) 57 | ! 58 | return 59 | end subroutine n_plane_waves 60 | -------------------------------------------------------------------------------- /src/recips.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001 PWSCF group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | !--------------------------------------------------------------------- 10 | 11 | subroutine recips (a1, a2, a3, b1, b2, b3) 12 | !--------------------------------------------------------------------- 13 | ! 14 | ! This routine generates the reciprocal lattice vectors b1,b2,b3 15 | ! given the real space vectors a1,a2,a3. The b's are units of 2 pi/a. 16 | ! 17 | ! first the input variables 18 | ! 19 | use kinds, ONLY: DP 20 | implicit none 21 | real(DP) :: a1 (3), a2 (3), a3 (3), b1 (3), b2 (3), b3 (3) 22 | ! input: first direct lattice vector 23 | ! input: second direct lattice vector 24 | ! input: third direct lattice vector 25 | ! output: first reciprocal lattice vector 26 | ! output: second reciprocal lattice vector 27 | ! output: third reciprocal lattice vector 28 | ! 29 | ! then the local variables 30 | ! 31 | real(DP) :: den, s 32 | ! the denominator 33 | ! the sign of the permutations 34 | integer :: iperm, i, j, k, l, ipol 35 | ! counter on the permutations 36 | !\ 37 | ! Auxiliary variables 38 | !/ 39 | ! 40 | ! Counter on the polarizations 41 | ! 42 | ! first we compute the denominator 43 | ! 44 | den = 0 45 | i = 1 46 | j = 2 47 | k = 3 48 | s = 1.d0 49 | 100 do iperm = 1, 3 50 | den = den + s * a1 (i) * a2 (j) * a3 (k) 51 | l = i 52 | i = j 53 | j = k 54 | k = l 55 | enddo 56 | i = 2 57 | j = 1 58 | k = 3 59 | s = - s 60 | if (s.lt.0.d0) goto 100 61 | ! 62 | ! here we compute the reciprocal vectors 63 | ! 64 | i = 1 65 | j = 2 66 | k = 3 67 | do ipol = 1, 3 68 | b1 (ipol) = (a2 (j) * a3 (k) - a2 (k) * a3 (j) ) / den 69 | b2 (ipol) = (a3 (j) * a1 (k) - a3 (k) * a1 (j) ) / den 70 | b3 (ipol) = (a1 (j) * a2 (k) - a1 (k) * a2 (j) ) / den 71 | l = i 72 | i = j 73 | j = k 74 | k = l 75 | enddo 76 | return 77 | end subroutine recips 78 | -------------------------------------------------------------------------------- /src/wavefunctions.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2002-2011 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | 9 | !=----------------------------------------------------------------------------=! 10 | MODULE wavefunctions_module 11 | !=----------------------------------------------------------------------------=! 12 | USE kinds, ONLY : DP 13 | 14 | IMPLICIT NONE 15 | SAVE 16 | 17 | ! 18 | COMPLEX(DP), ALLOCATABLE, TARGET :: & 19 | evc(:,:) ! wavefunctions in the PW basis set 20 | ! noncolinear case: first index 21 | ! is a combined PW + spin index 22 | ! 23 | COMPLEX(DP) , ALLOCATABLE, TARGET :: & 24 | psic(:), & ! additional memory for FFT 25 | psic_nc(:,:) ! as above for the noncolinear case 26 | ! 27 | ! 28 | ! electronic wave functions, CPV code 29 | ! distributed over gvector and bands 30 | ! 31 | COMPLEX(DP), ALLOCATABLE :: c0_bgrp(:,:) ! wave functions at time t 32 | COMPLEX(DP), ALLOCATABLE :: cm_bgrp(:,:) ! wave functions at time t-delta t 33 | COMPLEX(DP), ALLOCATABLE :: phi_bgrp(:,:) ! |phi> = s'|c0> = |c0> + sum q_ij |i> 34 | ! for hybrid functionals in CP with Wannier functions 35 | COMPLEX(DP), ALLOCATABLE :: cv0(:,:) ! Lingzhu Kong 36 | 37 | CONTAINS 38 | 39 | SUBROUTINE deallocate_wavefunctions 40 | IF( ALLOCATED( cv0) ) DEALLOCATE( cv0) ! Lingzhu Kong 41 | IF( ALLOCATED( c0_bgrp ) ) DEALLOCATE( c0_bgrp ) 42 | IF( ALLOCATED( cm_bgrp ) ) DEALLOCATE( cm_bgrp ) 43 | IF( ALLOCATED( phi_bgrp ) ) DEALLOCATE( phi_bgrp ) 44 | IF( ALLOCATED( psic_nc ) ) DEALLOCATE( psic_nc ) 45 | IF( ALLOCATED( psic ) ) DEALLOCATE( psic ) 46 | IF( ALLOCATED( evc ) ) DEALLOCATE( evc ) 47 | END SUBROUTINE deallocate_wavefunctions 48 | 49 | !=----------------------------------------------------------------------------=! 50 | END MODULE wavefunctions_module 51 | !=----------------------------------------------------------------------------=! 52 | -------------------------------------------------------------------------------- /src/deriv_drhoc.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2007 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | !----------------------------------------------------------------------- 9 | subroutine deriv_drhoc (ngl, gl, omega, tpiba2, mesh, r, rab, rhoc, drhocg) 10 | !----------------------------------------------------------------------- 11 | USE kinds 12 | USE constants, ONLY : pi, fpi 13 | implicit none 14 | ! 15 | ! first the dummy variables 16 | ! 17 | 18 | integer :: ngl, mesh 19 | ! input: the number of g shell 20 | ! input: the number of radial mesh points 21 | 22 | real(DP), intent(in) :: gl (ngl), r (mesh), rab (mesh), rhoc (mesh), & 23 | omega, tpiba2 24 | real(DP), intent(out) :: drhocg (ngl) 25 | ! input: the number of G shells 26 | ! input: the radial mesh 27 | ! input: the derivative of the radial mesh 28 | ! input: the radial core charge 29 | ! input: the volume of the unit cell 30 | ! input: 2 times pi / alat 31 | ! output: fourier transform of d Rho_c/dG 32 | ! 33 | ! here the local variables 34 | ! 35 | real(DP) :: gx, rhocg1 36 | ! the modulus of g for a given shell 37 | ! the fourier transform 38 | real(DP), allocatable :: aux (:) 39 | ! auxiliary memory for integration 40 | 41 | integer :: ir, igl, igl0 42 | ! counter on radial mesh points 43 | ! counter on g shells 44 | ! lower limit for loop on ngl 45 | 46 | ! 47 | ! G=0 term 48 | ! 49 | if (gl (1) < 1.0d-8) then 50 | drhocg (1) = 0.0d0 51 | igl0 = 2 52 | else 53 | igl0 = 1 54 | endif 55 | ! 56 | ! G <> 0 term 57 | ! 58 | allocate (aux( mesh)) 59 | do igl = igl0, ngl 60 | gx = sqrt (gl (igl) * tpiba2) 61 | do ir = 1, mesh 62 | aux (ir) = r (ir) * rhoc (ir) * (r (ir) * cos (gx * r (ir) ) & 63 | / gx - sin (gx * r (ir) ) / gx**2) 64 | enddo 65 | call simpson (mesh, aux, rab, rhocg1) 66 | drhocg (igl) = fpi / omega * rhocg1 67 | enddo 68 | deallocate (aux) 69 | 70 | return 71 | end subroutine deriv_drhoc 72 | 73 | -------------------------------------------------------------------------------- /src/ruotaijk.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001 PWSCF group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | !---------------------------------------------------------------------- 10 | subroutine ruotaijk (s, ftau, i, j, k, nr1, nr2, nr3, ri, rj, rk) 11 | !---------------------------------------------------------------------- 12 | ! 13 | ! This routine computes the rotated of the point i,j,k throught 14 | ! the symmetry (s,f). Then it computes the equivalent point 15 | ! on the original mesh 16 | ! 17 | ! 18 | USE kinds 19 | implicit none 20 | ! 21 | ! first the dummy variables 22 | ! 23 | integer :: s (3, 3), ftau (3), i, j, k, nr1, nr2, nr3, ri, rj, rk 24 | ! input: the rotation matrix 25 | ! input: the fractionary translation 26 | ! ! input: the point to rotate 27 | 28 | ! / 29 | ! ! input: the dimension of the mesh 30 | 31 | ! / 32 | ! ! output: the rotated point 33 | 34 | !/ 35 | ! 36 | ! local variable 37 | ! 38 | ! the rotation matrix in scaled crystallogra 39 | integer :: ss (3, 3) 40 | ! axes. Compatibility with the FFT grid must 41 | ! been checked elsewhere (sgam_at) 42 | ! 43 | ! this is a temporary fix. Much better would be to pass directly ss matr 44 | ! 45 | ss (1, 1) = s (1, 1) 46 | ss (2, 1) = s (2, 1) * nr1 / nr2 47 | ss (3, 1) = s (3, 1) * nr1 / nr3 48 | ss (1, 2) = s (1, 2) * nr2 / nr1 49 | ss (2, 2) = s (2, 2) 50 | ss (3, 2) = s (3, 2) * nr2 / nr3 51 | ss (1, 3) = s (1, 3) * nr3 / nr1 52 | ss (2, 3) = s (2, 3) * nr3 / nr2 53 | ss (3, 3) = s (3, 3) 54 | ! 55 | ri = ss (1, 1) * (i - 1) + ss (2, 1) * (j - 1) + ss (3, 1) & 56 | * (k - 1) - ftau (1) 57 | ri = mod (ri, nr1) + 1 58 | if (ri.lt.1) ri = ri + nr1 59 | rj = ss (1, 2) * (i - 1) + ss (2, 2) * (j - 1) + ss (3, 2) & 60 | * (k - 1) - ftau (2) 61 | rj = mod (rj, nr2) + 1 62 | if (rj.lt.1) rj = rj + nr2 63 | rk = ss (1, 3) * (i - 1) + ss (2, 3) * (j - 1) + ss (3, 3) & 64 | * (k - 1) - ftau (3) 65 | rk = mod (rk, nr3) + 1 66 | if (rk.lt.1) rk = rk + nr3 67 | return 68 | end subroutine ruotaijk 69 | -------------------------------------------------------------------------------- /src/drhoc.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2007 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | !----------------------------------------------------------------------- 10 | subroutine drhoc (ngl, gl, omega, tpiba2, mesh, r, rab, rhoc, rhocg) 11 | !----------------------------------------------------------------------- 12 | ! 13 | USE kinds 14 | USE constants, ONLY : pi, fpi 15 | implicit none 16 | ! 17 | ! first the dummy variables 18 | ! 19 | integer :: ngl, mesh 20 | ! input: the number of g shell 21 | ! input: the number of radial mesh points 22 | 23 | real(DP) :: gl (ngl), r (mesh), rab (mesh), rhoc (mesh), omega, & 24 | tpiba2, rhocg (ngl) 25 | ! input: the number of G shells 26 | ! input: the radial mesh 27 | ! input: the derivative of the radial mesh 28 | ! input: the radial core charge 29 | ! input: the volume of the unit cell 30 | ! input: 2 times pi / alat 31 | ! output: the fourier transform of the core charge 32 | ! 33 | ! here the local variables 34 | ! 35 | real(DP) :: gx, rhocg1 36 | ! the modulus of g for a given shell 37 | ! the fourier transform 38 | real(DP), allocatable :: aux (:) 39 | ! auxiliary memory for integration 40 | 41 | integer :: ir, igl, igl0 42 | ! counter on radial mesh points 43 | ! counter on g shells 44 | ! lower limit for loop on ngl 45 | 46 | allocate (aux( mesh)) 47 | ! 48 | ! G=0 term 49 | ! 50 | if (gl (1) < 1.0d-8) then 51 | do ir = 1, mesh 52 | aux (ir) = r (ir) **2 * rhoc (ir) 53 | enddo 54 | call simpson (mesh, aux, rab, rhocg1) 55 | rhocg (1) = fpi * rhocg1 / omega 56 | igl0 = 2 57 | else 58 | igl0 = 1 59 | endif 60 | ! 61 | ! G <> 0 term 62 | ! 63 | do igl = igl0, ngl 64 | gx = sqrt (gl (igl) * tpiba2) 65 | call sph_bes (mesh, r, gx, 0, aux) 66 | do ir = 1, mesh 67 | aux (ir) = r (ir) **2 * rhoc (ir) * aux (ir) 68 | enddo 69 | call simpson (mesh, aux, rab, rhocg1) 70 | rhocg (igl) = fpi * rhocg1 / omega 71 | enddo 72 | deallocate(aux) 73 | ! 74 | return 75 | end subroutine drhoc 76 | 77 | -------------------------------------------------------------------------------- /src/close_files.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2003 PWSCF group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | !---------------------------------------------------------------------------- 9 | SUBROUTINE close_files(lflag) 10 | !---------------------------------------------------------------------------- 11 | ! 12 | ! ... Close all files and synchronize processes for a new scf calculation. 13 | ! 14 | USE control_flags, ONLY : twfcollect, io_level 15 | USE fixed_occ, ONLY : one_atom_occupations 16 | USE io_files, ONLY : prefix, iunwfc, iunigk, iunat, iunsat, & 17 | iunefield, iunefieldm, iunefieldp 18 | USE buffers, ONLY : close_buffer 19 | USE mp_global, ONLY : intra_image_comm 20 | USE mp, ONLY : mp_barrier 21 | ! 22 | IMPLICIT NONE 23 | ! 24 | LOGICAL, intent(in) :: lflag 25 | ! 26 | LOGICAL :: opnd 27 | ! ... close buffer/file containing wavefunctions: discard if 28 | ! ... wavefunctions are written in xml format, save otherwise 29 | ! 30 | !BMA: eliminiate filesystem activity for miniDFT 31 | !IF ( lflag .AND. (twfcollect .OR. io_level < 0 )) THEN 32 | ! CALL close_buffer ( iunwfc, 'DELETE' ) 33 | !ELSE 34 | ! CALL close_buffer ( iunwfc, 'KEEP' ) 35 | !END IF 36 | ! 37 | ! ... iunigk is kept open during the execution - close and remove 38 | ! 39 | ! BMA: eliminating filesystem ops that arent used by mini-app 40 | !INQUIRE( UNIT = iunigk, OPENED = opnd ) 41 | !IF ( opnd ) CLOSE( UNIT = iunigk, STATUS = 'DELETE' ) 42 | ! 43 | ! ... iunat contains the (orthogonalized) atomic wfcs 44 | ! ... iunsat contains the (orthogonalized) atomic wfcs * S 45 | ! 46 | IF ( one_atom_occupations) THEN 47 | ! 48 | INQUIRE( UNIT = iunat, OPENED = opnd ) 49 | IF ( opnd ) CLOSE( UNIT = iunat, STATUS = 'KEEP' ) 50 | INQUIRE( UNIT = iunsat, OPENED = opnd ) 51 | IF ( opnd ) CLOSE( UNIT = iunsat, STATUS = 'KEEP' ) 52 | ! 53 | END IF 54 | ! 55 | ! ... close unit for electric field if needed 56 | ! 57 | ! 58 | CALL mp_barrier( intra_image_comm ) 59 | ! 60 | RETURN 61 | ! 62 | END SUBROUTINE close_files 63 | -------------------------------------------------------------------------------- /test/small.in: -------------------------------------------------------------------------------- 1 | &control 2 | prefix = 'titania' 3 | calculation = 'scf' 4 | restart_mode = 'from_scratch' 5 | wf_collect = .false. 6 | disk_io = 'none' 7 | tstress = .false. 8 | tprnfor = .false. 9 | outdir = './' 10 | wfcdir = './' 11 | pseudo_dir = './' 12 | / 13 | &system 14 | ibrav = 0 15 | celldm(1) = 8.7671 16 | nat = 48 17 | ntyp = 2 18 | nbnd = 192 19 | ecutwfc = 120 20 | input_dft = 'pbe0' 21 | nqx1 = 1 22 | nqx2 = 1 23 | nqx3 = 1 24 | exxdiv_treatment = 'gygi-baldereschi' 25 | / 26 | &electrons 27 | startingwfc='atomic' 28 | electron_maxstep = 1 29 | conv_thr = 1.0d5 30 | mixing_mode = 'plain' 31 | mixing_beta = 0.7 32 | mixing_ndim = 8 33 | diagonalization = 'david' 34 | diago_david_ndim = 4 35 | diago_full_acc = .true. 36 | / 37 | CELL_PARAMETERS 38 | 2.0 0.0 0.0 39 | 0.0 2.0 0.0 40 | 0.0 0.0 1.277176 41 | ATOMIC_SPECIES 42 | Ti 47.867 Ti.pbe.nml 43 | O 15.9994 O.pbe.nml 44 | ATOMIC_POSITIONS crystal 45 | Ti 0.0 0.0 0.0 46 | Ti 0.25 0.25 0.25 47 | O 0.15254385 0.15254385 0.0 48 | O -0.15254385 -0.15254385 0.0 49 | O 0.40254385 0.09745615 0.25 50 | O 0.09745615 0.40254385 0.25 51 | Ti 0.0 0.0 0.5 52 | Ti 0.25 0.25 0.75 53 | O 0.15254385 0.15254385 0.5 54 | O -0.15254385 -0.15254385 0.5 55 | O 0.40254385 0.09745615 0.75 56 | O 0.09745615 0.40254385 0.75 57 | Ti 0.0 0.5 0.0 58 | Ti 0.25 0.75 0.25 59 | O 0.15254385 0.65254385 0.0 60 | O -0.15254385 0.34745615 0.0 61 | O 0.40254385 0.59745615 0.25 62 | O 0.09745615 0.90254385 0.25 63 | Ti 0.0 0.5 0.5 64 | Ti 0.25 0.75 0.75 65 | O 0.15254385 0.65254385 0.5 66 | O -0.15254385 0.34745615 0.5 67 | O 0.40254385 0.59745615 0.75 68 | O 0.09745615 0.90254385 0.75 69 | Ti 0.5 0.0 0.0 70 | Ti 0.75 0.25 0.25 71 | O 0.65254385 0.15254385 0.0 72 | O 0.34745615 -0.15254385 0.0 73 | O 0.90254385 0.09745615 0.25 74 | O 0.59745615 0.40254385 0.25 75 | Ti 0.5 0.0 0.5 76 | Ti 0.75 0.25 0.75 77 | O 0.65254385 0.15254385 0.5 78 | O 0.34745615 -0.15254385 0.5 79 | O 0.90254385 0.09745615 0.75 80 | O 0.59745615 0.40254385 0.75 81 | Ti 0.5 0.5 0.0 82 | Ti 0.75 0.75 0.25 83 | O 0.65254385 0.65254385 0.0 84 | O 0.34745615 0.34745615 0.0 85 | O 0.90254385 0.59745615 0.25 86 | O 0.59745615 0.90254385 0.25 87 | Ti 0.5 0.5 0.5 88 | Ti 0.75 0.75 0.75 89 | O 0.65254385 0.65254385 0.5 90 | O 0.34745615 0.34745615 0.5 91 | O 0.90254385 0.59745615 0.75 92 | O 0.59745615 0.90254385 0.75 93 | K_POINTS automatic 94 | 1 1 1 1 1 1 95 | -------------------------------------------------------------------------------- /benchmark/small.in: -------------------------------------------------------------------------------- 1 | &control 2 | prefix = 'titania' 3 | calculation = 'scf' 4 | restart_mode = 'from_scratch' 5 | wf_collect = .false. 6 | disk_io = 'none' 7 | tstress = .false. 8 | tprnfor = .false. 9 | outdir = './' 10 | wfcdir = './' 11 | pseudo_dir = './' 12 | / 13 | &system 14 | ibrav = 0 15 | celldm(1) = 8.7671 16 | nat = 48 17 | ntyp = 2 18 | nbnd = 192 19 | ecutwfc = 120 20 | input_dft = 'pbe0' 21 | nqx1 = 1 22 | nqx2 = 1 23 | nqx3 = 1 24 | exxdiv_treatment = 'gygi-baldereschi' 25 | / 26 | &electrons 27 | startingwfc='atomic' 28 | electron_maxstep = 1 29 | conv_thr = 1.0d10 30 | mixing_mode = 'plain' 31 | mixing_beta = 0.7 32 | mixing_ndim = 8 33 | diagonalization = 'david' 34 | diago_david_ndim = 4 35 | diago_full_acc = .true. 36 | / 37 | CELL_PARAMETERS 38 | 2.0 0.0 0.0 39 | 0.0 2.0 0.0 40 | 0.0 0.0 1.277176 41 | ATOMIC_SPECIES 42 | Ti 47.867 Ti.pbe.nml 43 | O 15.9994 O.pbe.nml 44 | ATOMIC_POSITIONS crystal 45 | Ti 0.0 0.0 0.0 46 | Ti 0.25 0.25 0.25 47 | O 0.15254385 0.15254385 0.0 48 | O -0.15254385 -0.15254385 0.0 49 | O 0.40254385 0.09745615 0.25 50 | O 0.09745615 0.40254385 0.25 51 | Ti 0.0 0.0 0.5 52 | Ti 0.25 0.25 0.75 53 | O 0.15254385 0.15254385 0.5 54 | O -0.15254385 -0.15254385 0.5 55 | O 0.40254385 0.09745615 0.75 56 | O 0.09745615 0.40254385 0.75 57 | Ti 0.0 0.5 0.0 58 | Ti 0.25 0.75 0.25 59 | O 0.15254385 0.65254385 0.0 60 | O -0.15254385 0.34745615 0.0 61 | O 0.40254385 0.59745615 0.25 62 | O 0.09745615 0.90254385 0.25 63 | Ti 0.0 0.5 0.5 64 | Ti 0.25 0.75 0.75 65 | O 0.15254385 0.65254385 0.5 66 | O -0.15254385 0.34745615 0.5 67 | O 0.40254385 0.59745615 0.75 68 | O 0.09745615 0.90254385 0.75 69 | Ti 0.5 0.0 0.0 70 | Ti 0.75 0.25 0.25 71 | O 0.65254385 0.15254385 0.0 72 | O 0.34745615 -0.15254385 0.0 73 | O 0.90254385 0.09745615 0.25 74 | O 0.59745615 0.40254385 0.25 75 | Ti 0.5 0.0 0.5 76 | Ti 0.75 0.25 0.75 77 | O 0.65254385 0.15254385 0.5 78 | O 0.34745615 -0.15254385 0.5 79 | O 0.90254385 0.09745615 0.75 80 | O 0.59745615 0.40254385 0.75 81 | Ti 0.5 0.5 0.0 82 | Ti 0.75 0.75 0.25 83 | O 0.65254385 0.65254385 0.0 84 | O 0.34745615 0.34745615 0.0 85 | O 0.90254385 0.59745615 0.25 86 | O 0.59745615 0.90254385 0.25 87 | Ti 0.5 0.5 0.5 88 | Ti 0.75 0.75 0.75 89 | O 0.65254385 0.65254385 0.5 90 | O 0.34745615 0.34745615 0.5 91 | O 0.90254385 0.59745615 0.75 92 | O 0.59745615 0.90254385 0.75 93 | K_POINTS automatic 94 | 1 1 1 1 1 1 95 | -------------------------------------------------------------------------------- /src/image_io_routines.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2002-2006 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | !---------------------------------------------------------------------------- 10 | MODULE image_io_routines 11 | !---------------------------------------------------------------------------- 12 | ! 13 | ! ... This module contains all subroutines used for I/O in image 14 | ! ... parallelization 15 | ! 16 | ! ... from the orignal path_io Written by Carlo Sbraccia ( 2003-2006 ) 17 | ! 18 | USE kinds, ONLY : DP 19 | USE io_global, ONLY : meta_ionode, meta_ionode_id 20 | ! 21 | IMPLICIT NONE 22 | ! 23 | PRIVATE 24 | ! 25 | PUBLIC :: io_image_start, io_image_stop 26 | ! 27 | CONTAINS 28 | ! 29 | !----------------------------------------------------------------------- 30 | SUBROUTINE io_image_start() 31 | !----------------------------------------------------------------------- 32 | ! 33 | USE io_global, ONLY : ionode, ionode_id 34 | USE mp_global, ONLY : me_image, root_image 35 | ! 36 | IMPLICIT NONE 37 | ! 38 | ! 39 | ! ... the I/O node is set again according to the number of parallel 40 | ! ... images that have been required: for each parallel image there 41 | ! ... is only one node that does I/O 42 | ! 43 | ionode = ( me_image == root_image ) 44 | ionode_id = root_image 45 | ! 46 | RETURN 47 | ! 48 | END SUBROUTINE io_image_start 49 | ! 50 | ! 51 | !----------------------------------------------------------------------- 52 | SUBROUTINE io_image_stop() 53 | !----------------------------------------------------------------------- 54 | ! 55 | USE io_global, ONLY : io_global_start 56 | USE mp_global, ONLY : mpime, root 57 | ! 58 | IMPLICIT NONE 59 | ! 60 | ! 61 | ! ... the original I/O node is set again 62 | ! 63 | CALL io_global_start( mpime, root ) 64 | ! 65 | RETURN 66 | ! 67 | END SUBROUTINE io_image_stop 68 | ! 69 | END MODULE image_io_routines 70 | -------------------------------------------------------------------------------- /espresso/test/small.in: -------------------------------------------------------------------------------- 1 | &control 2 | prefix = 'titania' 3 | calculation = 'scf' 4 | restart_mode = 'from_scratch' 5 | wf_collect = .false. 6 | disk_io = 'none' 7 | tstress = .false. 8 | tprnfor = .false. 9 | outdir = './' 10 | wfcdir = './' 11 | pseudo_dir = './' 12 | / 13 | &system 14 | ibrav = 0 15 | celldm(1) = 8.7671 16 | nat = 48 17 | ntyp = 2 18 | nbnd = 192 19 | ecutwfc = 120 20 | input_dft = 'pbe0' 21 | nqx1 = 1 22 | nqx2 = 1 23 | nqx3 = 1 24 | exxdiv_treatment = 'gygi-baldereschi' 25 | / 26 | &electrons 27 | startingwfc='atomic' 28 | electron_maxstep = 1 29 | conv_thr = 1.0d5 30 | mixing_mode = 'plain' 31 | mixing_beta = 0.7 32 | mixing_ndim = 8 33 | diagonalization = 'david' 34 | diago_david_ndim = 4 35 | diago_full_acc = .true. 36 | / 37 | CELL_PARAMETERS 38 | 2.0 0.0 0.0 39 | 0.0 2.0 0.0 40 | 0.0 0.0 1.277176 41 | ATOMIC_SPECIES 42 | Ti 47.867 Ti.pbe.UPF 43 | O 15.9994 O.pbe.UPF 44 | ATOMIC_POSITIONS crystal 45 | Ti 0.0 0.0 0.0 46 | Ti 0.25 0.25 0.25 47 | O 0.15254385 0.15254385 0.0 48 | O -0.15254385 -0.15254385 0.0 49 | O 0.40254385 0.09745615 0.25 50 | O 0.09745615 0.40254385 0.25 51 | Ti 0.0 0.0 0.5 52 | Ti 0.25 0.25 0.75 53 | O 0.15254385 0.15254385 0.5 54 | O -0.15254385 -0.15254385 0.5 55 | O 0.40254385 0.09745615 0.75 56 | O 0.09745615 0.40254385 0.75 57 | Ti 0.0 0.5 0.0 58 | Ti 0.25 0.75 0.25 59 | O 0.15254385 0.65254385 0.0 60 | O -0.15254385 0.34745615 0.0 61 | O 0.40254385 0.59745615 0.25 62 | O 0.09745615 0.90254385 0.25 63 | Ti 0.0 0.5 0.5 64 | Ti 0.25 0.75 0.75 65 | O 0.15254385 0.65254385 0.5 66 | O -0.15254385 0.34745615 0.5 67 | O 0.40254385 0.59745615 0.75 68 | O 0.09745615 0.90254385 0.75 69 | Ti 0.5 0.0 0.0 70 | Ti 0.75 0.25 0.25 71 | O 0.65254385 0.15254385 0.0 72 | O 0.34745615 -0.15254385 0.0 73 | O 0.90254385 0.09745615 0.25 74 | O 0.59745615 0.40254385 0.25 75 | Ti 0.5 0.0 0.5 76 | Ti 0.75 0.25 0.75 77 | O 0.65254385 0.15254385 0.5 78 | O 0.34745615 -0.15254385 0.5 79 | O 0.90254385 0.09745615 0.75 80 | O 0.59745615 0.40254385 0.75 81 | Ti 0.5 0.5 0.0 82 | Ti 0.75 0.75 0.25 83 | O 0.65254385 0.65254385 0.0 84 | O 0.34745615 0.34745615 0.0 85 | O 0.90254385 0.59745615 0.25 86 | O 0.59745615 0.90254385 0.25 87 | Ti 0.5 0.5 0.5 88 | Ti 0.75 0.75 0.75 89 | O 0.65254385 0.65254385 0.5 90 | O 0.34745615 0.34745615 0.5 91 | O 0.90254385 0.59745615 0.75 92 | O 0.59745615 0.90254385 0.75 93 | K_POINTS automatic 94 | 1 1 1 1 1 1 95 | -------------------------------------------------------------------------------- /espresso/benchmark/small.in: -------------------------------------------------------------------------------- 1 | &control 2 | prefix = 'titania' 3 | calculation = 'scf' 4 | restart_mode = 'from_scratch' 5 | wf_collect = .false. 6 | disk_io = 'none' 7 | tstress = .false. 8 | tprnfor = .false. 9 | outdir = './' 10 | wfcdir = './' 11 | pseudo_dir = './' 12 | / 13 | &system 14 | ibrav = 0 15 | celldm(1) = 8.7671 16 | nat = 48 17 | ntyp = 2 18 | nbnd = 192 19 | ecutwfc = 120 20 | input_dft = 'pbe0' 21 | nqx1 = 1 22 | nqx2 = 1 23 | nqx3 = 1 24 | exxdiv_treatment = 'gygi-baldereschi' 25 | / 26 | &electrons 27 | startingwfc='atomic' 28 | electron_maxstep = 1 29 | conv_thr = 1.0d5 30 | mixing_mode = 'plain' 31 | mixing_beta = 0.7 32 | mixing_ndim = 8 33 | diagonalization = 'david' 34 | diago_david_ndim = 4 35 | diago_full_acc = .true. 36 | / 37 | CELL_PARAMETERS 38 | 2.0 0.0 0.0 39 | 0.0 2.0 0.0 40 | 0.0 0.0 1.277176 41 | ATOMIC_SPECIES 42 | Ti 47.867 Ti.pbe.UPF 43 | O 15.9994 O.pbe.UPF 44 | ATOMIC_POSITIONS crystal 45 | Ti 0.0 0.0 0.0 46 | Ti 0.25 0.25 0.25 47 | O 0.15254385 0.15254385 0.0 48 | O -0.15254385 -0.15254385 0.0 49 | O 0.40254385 0.09745615 0.25 50 | O 0.09745615 0.40254385 0.25 51 | Ti 0.0 0.0 0.5 52 | Ti 0.25 0.25 0.75 53 | O 0.15254385 0.15254385 0.5 54 | O -0.15254385 -0.15254385 0.5 55 | O 0.40254385 0.09745615 0.75 56 | O 0.09745615 0.40254385 0.75 57 | Ti 0.0 0.5 0.0 58 | Ti 0.25 0.75 0.25 59 | O 0.15254385 0.65254385 0.0 60 | O -0.15254385 0.34745615 0.0 61 | O 0.40254385 0.59745615 0.25 62 | O 0.09745615 0.90254385 0.25 63 | Ti 0.0 0.5 0.5 64 | Ti 0.25 0.75 0.75 65 | O 0.15254385 0.65254385 0.5 66 | O -0.15254385 0.34745615 0.5 67 | O 0.40254385 0.59745615 0.75 68 | O 0.09745615 0.90254385 0.75 69 | Ti 0.5 0.0 0.0 70 | Ti 0.75 0.25 0.25 71 | O 0.65254385 0.15254385 0.0 72 | O 0.34745615 -0.15254385 0.0 73 | O 0.90254385 0.09745615 0.25 74 | O 0.59745615 0.40254385 0.25 75 | Ti 0.5 0.0 0.5 76 | Ti 0.75 0.25 0.75 77 | O 0.65254385 0.15254385 0.5 78 | O 0.34745615 -0.15254385 0.5 79 | O 0.90254385 0.09745615 0.75 80 | O 0.59745615 0.40254385 0.75 81 | Ti 0.5 0.5 0.0 82 | Ti 0.75 0.75 0.25 83 | O 0.65254385 0.65254385 0.0 84 | O 0.34745615 0.34745615 0.0 85 | O 0.90254385 0.59745615 0.25 86 | O 0.59745615 0.90254385 0.25 87 | Ti 0.5 0.5 0.5 88 | Ti 0.75 0.75 0.75 89 | O 0.65254385 0.65254385 0.5 90 | O 0.34745615 0.34745615 0.5 91 | O 0.90254385 0.59745615 0.75 92 | O 0.59745615 0.90254385 0.75 93 | K_POINTS automatic 94 | 1 1 1 1 1 1 95 | -------------------------------------------------------------------------------- /src/g_psi.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2003 PWSCF group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | #define TEST_NEW_PRECONDITIONING 9 | ! 10 | !----------------------------------------------------------------------- 11 | subroutine g_psi (lda, n, m, npol, psi, e) 12 | !----------------------------------------------------------------------- 13 | ! 14 | ! This routine computes an estimate of the inverse Hamiltonian 15 | ! and applies it to m wavefunctions 16 | ! 17 | USE kinds 18 | USE g_psi_mod 19 | implicit none 20 | integer :: lda, n, m, npol, ipol 21 | ! input: the leading dimension of psi 22 | ! input: the real dimension of psi 23 | ! input: the number of bands 24 | ! input: the number of coordinates of psi 25 | ! local variable: counter of coordinates of psi 26 | real(DP) :: e (m) 27 | ! input: the eigenvectors 28 | complex(DP) :: psi (lda, npol, m) 29 | ! inp/out: the psi vector 30 | ! 31 | ! Local variables 32 | ! 33 | real(DP), parameter :: eps = 1.0d-4 34 | ! a small number 35 | real(DP) :: x, scala, denm 36 | integer :: k, i 37 | ! counter on psi functions 38 | ! counter on G vectors 39 | ! 40 | call start_clock ('g_psi') 41 | ! 42 | #ifdef TEST_NEW_PRECONDITIONING 43 | scala = 1.d0 44 | do ipol=1,npol 45 | do k = 1, m 46 | do i = 1, n 47 | x = (h_diag(i,ipol) - e(k)*s_diag(i,ipol))*scala 48 | denm = (1.d0+x+sqrt(1.d0+(x-1)*(x-1.d0)))/scala 49 | ! denm = 1.d0 + 16*x*x*x*x/(27.d0+18*x+12*x*x+8*x*x*x) 50 | psi (i, ipol, k) = psi (i, ipol, k) / denm 51 | enddo 52 | enddo 53 | enddo 54 | #else 55 | do ipol=1,npol 56 | do k = 1, m 57 | do i = 1, n 58 | denm = h_diag (i,ipol) - e (k) * s_diag (i,ipol) 59 | ! 60 | ! denm = g2+v(g=0) - e(k) 61 | ! 62 | if (abs (denm) < eps) denm = sign (eps, denm) 63 | ! 64 | ! denm = sign( max( abs(denm),eps ), denm ) 65 | ! 66 | psi (i, ipol, k) = psi (i, ipol, k) / denm 67 | enddo 68 | enddo 69 | enddo 70 | #endif 71 | 72 | call stop_clock ('g_psi') 73 | return 74 | end subroutine g_psi 75 | -------------------------------------------------------------------------------- /src/init_at_1.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2007 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | !----------------------------------------------------------------------- 10 | subroutine init_at_1() 11 | !----------------------------------------------------------------------- 12 | ! 13 | ! This routine computes a table with the radial Fourier transform 14 | ! of the atomic wavefunctions. 15 | ! 16 | USE kinds, ONLY : dp 17 | USE atom, ONLY : rgrid, msh 18 | USE constants, ONLY : fpi 19 | USE cell_base, ONLY : omega 20 | USE ions_base, ONLY : ntyp => nsp 21 | USE us, ONLY : tab_at, nqx, dq 22 | USE uspp_param, ONLY : upf 23 | USE mp_global, ONLY : intra_bgrp_comm 24 | USE mp, ONLY : mp_sum 25 | ! 26 | implicit none 27 | ! 28 | integer :: nt, nb, iq, ir, l, startq, lastq, ndm 29 | ! 30 | real(DP), allocatable :: aux (:), vchi (:) 31 | real(DP) :: vqint, pref, q 32 | 33 | call start_clock ('init_at_1') 34 | 35 | ndm = MAXVAL (msh(1:ntyp)) 36 | allocate (aux(ndm),vchi(ndm)) 37 | 38 | ! 39 | ! chiq = radial fourier transform of atomic orbitals chi 40 | ! 41 | pref = fpi/sqrt(omega) 42 | ! needed to normalize atomic wfcs (not a bad idea in general and 43 | ! necessary to compute correctly lda+U projections) 44 | call divide (intra_bgrp_comm, nqx, startq, lastq) 45 | tab_at(:,:,:) = 0.d0 46 | do nt = 1, ntyp 47 | do nb = 1, upf(nt)%nwfc 48 | if (upf(nt)%oc(nb) >= 0.d0) then 49 | l = upf(nt)%lchi (nb) 50 | do iq = startq, lastq 51 | q = dq * (iq - 1) 52 | call sph_bes (msh(nt), rgrid(nt)%r, q, l, aux) 53 | do ir = 1, msh(nt) 54 | vchi(ir) = upf(nt)%chi(ir,nb) * aux(ir) * rgrid(nt)%r(ir) 55 | enddo 56 | call simpson (msh(nt), vchi, rgrid(nt)%rab, vqint) 57 | tab_at (iq, nb, nt) = vqint * pref 58 | enddo 59 | endif 60 | enddo 61 | enddo 62 | call mp_sum ( tab_at, intra_bgrp_comm ) 63 | 64 | deallocate(aux ,vchi) 65 | 66 | call stop_clock ('init_at_1') 67 | return 68 | 69 | end subroutine init_at_1 70 | 71 | -------------------------------------------------------------------------------- /src/weights.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2011 PWSCF group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | !---------------------------------------------------------------------------- 10 | SUBROUTINE weights() 11 | !---------------------------------------------------------------------------- 12 | ! 13 | ! ... calculates weights of Kohn-Sham orbitals used in calculation of rho, 14 | ! ... Fermi energies, HOMO and LUMO, "-TS" term (gaussian) 15 | ! 16 | USE kinds, ONLY : DP 17 | USE ener, ONLY : demet, ef, ef_up, ef_dw 18 | USE fixed_occ, ONLY : f_inp, tfixed_occ 19 | USE klist, ONLY : lgauss, degauss, ngauss, nks, & 20 | nkstot, wk, xk, nelec, nelup, neldw, & 21 | two_fermi_energies 22 | USE ktetra, ONLY : ltetra, ntetra, tetra 23 | USE lsda_mod, ONLY : nspin, current_spin, isk 24 | USE wvfct, ONLY : nbnd, wg, et 25 | USE mp_global, ONLY : intra_image_comm, inter_pool_comm 26 | USE mp, ONLY : mp_bcast, mp_sum 27 | USE io_global, ONLY : ionode, ionode_id 28 | ! 29 | IMPLICIT NONE 30 | ! 31 | ! ... local variables 32 | ! 33 | INTEGER :: ibnd, ik ! counters: bands, k-points 34 | real (DP) demet_up, demet_dw 35 | ! 36 | demet = 0.D0 37 | ! 38 | ! 39 | ! ... calculate weights for the insulator case 40 | ! 41 | IF ( two_fermi_energies ) THEN 42 | ! 43 | CALL iweights( nks, wk, nbnd, nelup, et, ef_up, wg, 1, isk ) 44 | CALL iweights( nks, wk, nbnd, neldw, et, ef_dw, wg, 2, isk ) 45 | ! 46 | ! the following line to prevent NaN in Ef 47 | ! 48 | ef = ( ef_up + ef_dw ) / 2.0_dp 49 | ! 50 | ELSE 51 | ! 52 | CALL iweights( nks, wk, nbnd, nelec, et, ef, wg, 0, isk ) 53 | ! 54 | END IF 55 | ! 56 | ! 57 | ! ... collect all weights on the first pool; 58 | ! ... not needed for calculation but useful for printout 59 | ! 60 | CALL poolrecover( wg, nbnd, nkstot, nks ) 61 | ! 62 | ! 63 | RETURN 64 | ! 65 | END SUBROUTINE weights 66 | -------------------------------------------------------------------------------- /src/cryst_to_car.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2003 PWSCF group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | !----------------------------------------------------------------------- 10 | subroutine cryst_to_cart (nvec, vec, trmat, iflag) 11 | !----------------------------------------------------------------------- 12 | ! 13 | ! This routine transforms the atomic positions or the k-point 14 | ! components from crystallographic to cartesian coordinates 15 | ! ( iflag=1 ) and viceversa ( iflag=-1 ). 16 | ! Output cartesian coordinates are stored in the input ('vec') array 17 | ! 18 | ! 19 | USE kinds, ONLY : DP 20 | implicit none 21 | ! 22 | integer, intent(in) :: nvec, iflag 23 | ! nvec: number of vectors (atomic positions or k-points) 24 | ! to be transformed from crystal to cartesian and vice versa 25 | ! iflag: gives the direction of the transformation 26 | real(DP), intent(in) :: trmat (3, 3) 27 | ! trmat: transformation matrix 28 | ! if iflag=1: 29 | ! trmat = at , basis of the real-space lattice, for atoms or 30 | ! = bg , basis of the reciprocal-space lattice, for k-points 31 | ! if iflag=-1: the opposite 32 | real(DP), intent(inout) :: vec (3, nvec) 33 | ! coordinates of the vector (atomic positions or k-points) to be 34 | ! transformed - overwritten on output 35 | ! 36 | ! local variables 37 | ! 38 | integer :: nv, kpol 39 | ! counter on vectors 40 | ! counter on polarizations 41 | real(DP) :: vau (3) 42 | ! workspace 43 | ! 44 | ! Compute the cartesian coordinates of each vectors 45 | ! (atomic positions or k-points components) 46 | ! 47 | do nv = 1, nvec 48 | if (iflag.eq.1) then 49 | do kpol = 1, 3 50 | vau (kpol) = trmat (kpol, 1) * vec (1, nv) + trmat (kpol, 2) & 51 | * vec (2, nv) + trmat (kpol, 3) * vec (3, nv) 52 | enddo 53 | else 54 | do kpol = 1, 3 55 | vau (kpol) = trmat (1, kpol) * vec (1, nv) + trmat (2, kpol) & 56 | * vec (2, nv) + trmat (3, kpol) * vec (3, nv) 57 | enddo 58 | endif 59 | do kpol = 1, 3 60 | vec (kpol, nv) = vau (kpol) 61 | enddo 62 | enddo 63 | ! 64 | return 65 | end subroutine cryst_to_cart 66 | 67 | -------------------------------------------------------------------------------- /src/hinit0.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2005 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | !----------------------------------------------------------------------- 9 | SUBROUTINE hinit0() 10 | !----------------------------------------------------------------------- 11 | ! 12 | ! ... hamiltonian initialization: 13 | ! ... atomic position independent initialization for nonlocal PP, 14 | ! ... structure factors, local potential, core charge 15 | ! 16 | USE ions_base, ONLY : nat, nsp, ityp, tau 17 | USE basis, ONLY : startingconfig 18 | USE cell_base, ONLY : at, bg, omega, tpiba2 19 | USE klist, ONLY : nks, xk 20 | USE fft_base, ONLY : dfftp 21 | USE gvect, ONLY : ngm, ig_l2g, g, eigts1, eigts2, eigts3 22 | USE vlocal, ONLY : strf 23 | USE wvfct, ONLY : npw, g2kin, igk, ecutwfc 24 | USE io_files, ONLY : iunigk 25 | USE control_flags, ONLY : tqr 26 | USE io_global, ONLY : stdout 27 | ! 28 | IMPLICIT NONE 29 | ! 30 | INTEGER :: ik 31 | ! counter on k points 32 | ! 33 | ! ... calculate the Fourier coefficients of the local part of the PP 34 | ! 35 | CALL init_vloc() 36 | ! 37 | ! ... k-point independent parameters of non-local pseudopotentials 38 | ! 39 | CALL init_us_1() 40 | CALL init_at_1() 41 | ! 42 | #ifdef __IGKIO 43 | REWIND( iunigk ) 44 | #endif 45 | ! 46 | ! ... The following loop must NOT be called more than once in a run 47 | ! ... or else there will be problems with variable-cell calculations 48 | ! 49 | DO ik = 1, nks 50 | ! 51 | ! ... g2kin is used here as work space 52 | ! 53 | CALL gk_sort( xk(1,ik), ngm, g, ecutwfc / tpiba2, npw, igk, g2kin ) 54 | ! 55 | ! ... if there is only one k-point npw and igk stay in memory 56 | ! 57 | #ifdef __IGKIO 58 | IF ( nks > 1 ) WRITE( iunigk ) igk 59 | #endif __IGKIO 60 | ! 61 | END DO 62 | ! 63 | ! 64 | ! ... initialize the structure factor 65 | ! 66 | CALL struc_fact( nat, tau, nsp, ityp, ngm, g, bg, & 67 | dfftp%nr1, dfftp%nr2, dfftp%nr3, strf, eigts1, eigts2, eigts3 ) 68 | ! 69 | ! ... calculate the total local potential 70 | ! 71 | CALL setlocal() 72 | ! 73 | ! ... calculate the core charge (if any) for the nonlinear core correction 74 | ! 75 | CALL set_rhoc() 76 | ! 77 | ! 78 | RETURN 79 | ! 80 | END SUBROUTINE hinit0 81 | 82 | -------------------------------------------------------------------------------- /src/h_psi.f90: -------------------------------------------------------------------------------- 1 | 2 | ! Copyright (C) 2002-2009 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | !---------------------------------------------------------------------------- 9 | SUBROUTINE h_psi( lda, n, m, psi, hpsi ) 10 | !---------------------------------------------------------------------------- 11 | ! 12 | ! ... This routine computes the product of the Hamiltonian 13 | ! ... matrix with m wavefunctions contained in psi 14 | ! 15 | ! ... input: 16 | ! ... lda leading dimension of arrays psi, spsi, hpsi 17 | ! ... n true dimension of psi, spsi, hpsi 18 | ! ... m number of states psi 19 | ! ... psi 20 | ! 21 | ! ... output: 22 | ! ... hpsi H*psi 23 | ! 24 | USE kinds, ONLY : DP 25 | USE lsda_mod, ONLY : current_spin 26 | USE scf, ONLY : vrs 27 | USE wvfct, ONLY : g2kin 28 | USE uspp, ONLY : vkb, nkb 29 | USE gvect, ONLY : gstart 30 | USE fft_base, ONLY : dffts 31 | USE exx, ONLY : vexx 32 | USE funct, ONLY : exx_is_active 33 | ! 34 | IMPLICIT NONE 35 | ! 36 | integer, parameter :: npol=1 !substitute for noncollin_module%npol 37 | INTEGER, INTENT(IN) :: lda, n, m 38 | COMPLEX(DP), INTENT(IN) :: psi(lda*npol,m) 39 | COMPLEX(DP), INTENT(OUT) :: hpsi(lda*npol,m) 40 | ! 41 | INTEGER :: ipol, ibnd, incr 42 | ! 43 | CALL start_clock( 'h_psi' ) 44 | ! 45 | ! ... Here we apply the kinetic energy (k+G)^2 psi 46 | ! 47 | DO ibnd = 1, m 48 | hpsi (1:n, ibnd) = g2kin (1:n) * psi (1:n, ibnd) 49 | hpsi (n+1:lda,ibnd) = (0.0_dp, 0.0_dp) 50 | END DO 51 | ! 52 | ! 53 | ! 54 | ! ... the local potential V_Loc psi 55 | ! 56 | CALL start_clock( 'h_psi:vloc' ) 57 | ! 58 | CALL vloc_psi_k ( lda, n, m, psi, vrs(1,current_spin), hpsi ) 59 | ! 60 | CALL stop_clock( 'h_psi:vloc' ) 61 | ! 62 | ! ... Here the product with the non local potential V_NL psi 63 | ! ... (not in the real-space case: it is done together with V_loc) 64 | ! 65 | ! 66 | CALL start_clock( 'h_psi:vnl' ) 67 | ! JRD: calbec done in add_vuspsi now 68 | CALL add_vuspsi( lda, n, m, psi, hpsi ) 69 | CALL stop_clock( 'h_psi:vnl' ) 70 | ! 71 | !JRD 72 | IF ( exx_is_active() ) CALL vexx( lda, n, m, psi, hpsi ) 73 | ! 74 | ! ... electric enthalpy if required 75 | ! 76 | ! 77 | CALL stop_clock( 'h_psi' ) 78 | ! 79 | RETURN 80 | ! 81 | END SUBROUTINE h_psi 82 | -------------------------------------------------------------------------------- /src/upf.f90: -------------------------------------------------------------------------------- 1 | ! Copyright (C) 2008 Quantum ESPRESSO group 2 | ! This file is distributed under the terms of the 3 | ! GNU General Public License. See the file `License' 4 | ! in the root directory of the present distribution, 5 | ! or http://www.gnu.org/copyleft/gpl.txt . 6 | ! 7 | !=----------------------------------------------------------------------------=! 8 | MODULE upf_module 9 | !=----------------------------------------------------------------------------=! 10 | ! this module handles reading and writing of unified pseudopotential format (UPF) 11 | ! it can manage v2 read/write and v1 read only. 12 | ! 13 | ! A macro to trim both from left and right 14 | #define TRIM(a) trim(adjustl(a)) 15 | ! 16 | USE kinds, ONLY: DP 17 | USE pseudo_types, ONLY: pseudo_upf, deallocate_pseudo_upf 18 | ! 19 | IMPLICIT NONE 20 | PUBLIC 21 | ! 22 | CONTAINS 23 | 24 | !------------------------------------------------+ 25 | SUBROUTINE read_upf(upf, grid, ierr, unit, filename) ! 26 | !---------------------------------------------+ 27 | ! Read pseudopotential in UPF format (either v.1 or v.2) 28 | ! ierr = -1 : read UPF v.1 29 | ! ierr = 0 : read UPF v.2 30 | ! ierr = 1 : not an UPF file, or error while reading 31 | ! 32 | USE radial_grids, ONLY: radial_grid_type, deallocate_radial_grid 33 | use upf_nml, only: upf_nml_read 34 | IMPLICIT NONE 35 | INTEGER,INTENT(IN),OPTIONAL :: unit ! i/o unit 36 | CHARACTER(len=*),INTENT(IN),OPTIONAL :: filename ! i/o filename 37 | TYPE(pseudo_upf),INTENT(INOUT) :: upf ! the pseudo data 38 | TYPE(radial_grid_type),OPTIONAL,INTENT(INOUT),TARGET :: grid 39 | INTEGER,INTENT(OUT) :: ierr 40 | ! 41 | INTEGER :: u ! i/o unit 42 | 43 | ierr = 0 44 | 45 | IF(.not. present(unit)) THEN 46 | IF (.not. present(filename)) & 47 | CALL errore('read_upf',& 48 | 'You have to specify at least one between filename and unit',1) 49 | ELSE 50 | u = unit 51 | ENDIF 52 | ! 53 | !call infomsg( "upf.f90:59", "replacing read_upf_v2 with upf_nml_read to avoit iotk" ) 54 | IF( present(filename) ) & 55 | open( unit=u, file=trim(filename), status='old', delim='APOSTROPHE', iostat=ierr ) 56 | IF(ierr>0) CALL errore('read_upf', 'Cannot open file: '//TRIM(filename),1) 57 | call upf_nml_read( u, upf, grid, ierr ) 58 | close( u, status='keep' ) 59 | ! 60 | 61 | RETURN 62 | 63 | END SUBROUTINE read_upf 64 | 65 | 66 | 67 | !=----------------------------------------------------------------------------=! 68 | END MODULE upf_module 69 | !=----------------------------------------------------------------------------=! 70 | #undef TRIM 71 | 72 | -------------------------------------------------------------------------------- /src/divide_et_impera.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2008 PWSCF group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | !---------------------------------------------------------------------------- 10 | SUBROUTINE divide_et_impera( xk, wk, isk, lsda, nkstot, nks ) 11 | !---------------------------------------------------------------------------- 12 | ! 13 | ! ... This routine divides the k points across nodes, sets the variable 14 | ! ... nks equal to the local (on this processors) number of k-points 15 | ! ... (nkstot on input is the total number of k-points) 16 | ! ... The distributed has "granularity kunit", that is, kunit consecutive 17 | ! ... points stay on the same processor. Usually kunit=1; kunit=2 is used 18 | ! ... in phonon calculations, when one has interspersed k_i and k_i+q and 19 | ! ... it is needed that they stay on the same processor 20 | ! 21 | USE io_global, only : stdout 22 | USE kinds, ONLY : DP 23 | USE mp_global, ONLY : my_pool_id, npool, kunit 24 | ! 25 | IMPLICIT NONE 26 | ! 27 | LOGICAL, INTENT(IN) :: lsda 28 | ! logical for local spin density approx. 29 | INTEGER, INTENT(IN) :: nkstot 30 | ! total number of k-points 31 | INTEGER, INTENT(INOUT) :: isk(nkstot) 32 | ! spin index of each kpoint (when lsda=.t.) 33 | INTEGER, INTENT(OUT) :: nks 34 | ! number of k-points per pool 35 | REAL (DP), INTENT(INOUT) :: xk(3,nkstot), wk(nkstot) 36 | ! k-points 37 | ! k-point weights 38 | ! 39 | ! 40 | INTEGER :: ik, nbase, rest 41 | ! 42 | ! 43 | IF ( MOD( nkstot, kunit ) /= 0 ) & 44 | CALL errore( 'd_&_i', ' nkstot/kunit is not an integer', nkstot ) 45 | ! 46 | nks = kunit * ( nkstot / kunit / npool ) 47 | ! 48 | IF ( nks == 0 ) CALL errore( 'd_&_i', ' some nodes have no k-points', 1 ) 49 | ! 50 | rest = ( nkstot - nks * npool ) / kunit 51 | ! 52 | IF ( ( my_pool_id + 1 ) <= rest ) nks = nks + kunit 53 | ! 54 | ! ... calculates nbase = the position in the list of the first point that 55 | ! ... belong to this npool - 1 56 | ! 57 | nbase = nks * my_pool_id 58 | ! 59 | IF ( ( my_pool_id + 1 ) > rest ) nbase = nbase + rest * kunit 60 | ! 61 | ! ... displaces these points in the first positions of the list 62 | ! 63 | IF ( nbase > 0 ) THEN 64 | ! 65 | xk(:,1:nks) = xk(:,nbase+1:nbase+nks) 66 | ! 67 | wk(1:nks) = wk(nbase+1:nbase+nks) 68 | ! 69 | IF ( lsda ) isk(1:nks) = isk(nbase+1:nbase+nks) 70 | ! 71 | ! 72 | END IF 73 | ! 74 | ! 75 | RETURN 76 | ! 77 | END SUBROUTINE divide_et_impera 78 | -------------------------------------------------------------------------------- /src/gk_sort.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2010 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | !---------------------------------------------------------------------------- 9 | SUBROUTINE gk_sort( k, ngm, g, ecut, ngk, igk, gk ) 10 | !---------------------------------------------------------------------------- 11 | ! 12 | ! ... sorts k+g in order of increasing magnitude, up to ecut 13 | ! ... NB: this version should yield the same ordering for different ecut 14 | ! ... and the same ordering in all machines 15 | ! 16 | USE kinds, ONLY : DP 17 | USE constants, ONLY : eps8 18 | USE wvfct, ONLY : npwx 19 | ! 20 | IMPLICIT NONE 21 | ! 22 | REAL(DP), INTENT(in) :: k(3) ! the k point 23 | INTEGER, INTENT(in) :: ngm ! the number of g vectors 24 | REAL(DP), INTENT(in) :: g(3,ngm) ! the coordinates of G vectors 25 | REAL(DP), INTENT(in) :: ecut ! the cut-off energy 26 | INTEGER, INTENT(out) :: ngk ! the number of k+G vectors inside the "ecut sphere" 27 | INTEGER, INTENT(out) :: igk(npwx) ! the correspondence k+G <-> G 28 | REAL(DP), INTENT(out) :: gk(npwx) ! the moduli of k+G 29 | ! 30 | INTEGER :: ng ! counter on G vectors 31 | INTEGER :: nk ! counter on k+G vectors 32 | REAL(DP) :: q ! |k+G|^2 33 | REAL(DP) :: q2x ! upper bound for |G| 34 | ! 35 | ! ... first we count the number of k+G vectors inside the cut-off sphere 36 | ! 37 | q2x = ( sqrt( sum(k(:)**2) ) + sqrt( ecut ) )**2 38 | ! 39 | ngk = 0 40 | igk(:) = 0 41 | gk (:) = 0.0_dp 42 | ! 43 | DO ng = 1, ngm 44 | q = sum( ( k(:) + g(:,ng) )**2 ) 45 | IF(q<=eps8) q=0.d0 46 | ! 47 | ! ... here if |k+G|^2 <= Ecut 48 | ! 49 | IF ( q <= ecut ) THEN 50 | ngk = ngk + 1 51 | IF ( ngk > npwx ) & 52 | CALL errore( 'gk_sort', 'array gk out-of-bounds', 1 ) 53 | ! 54 | gk(ngk) = q 55 | ! 56 | ! set the initial value of index array 57 | igk(ngk) = ng 58 | ELSE 59 | ! if |G| > |k| + SQRT( Ecut ) stop search and order vectors 60 | IF ( sum( g(:,ng)**2 ) > ( q2x + eps8 ) ) exit 61 | ENDIF 62 | ENDDO 63 | ! 64 | IF ( ng > ngm ) & 65 | CALL infomsg( 'gk_sort', 'unexpected exit from do-loop') 66 | ! 67 | ! ... order vector gk keeping initial position in index 68 | ! 69 | CALL hpsort_eps( ngk, gk, igk, eps8 ) 70 | ! 71 | ! ... now order true |k+G| 72 | ! 73 | DO nk = 1, ngk 74 | gk(nk) = sum( (k(:) + g(:,igk(nk)) )**2 ) 75 | ENDDO 76 | ! 77 | END SUBROUTINE gk_sort 78 | -------------------------------------------------------------------------------- /src/stop_run.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2009 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | !---------------------------------------------------------------------------- 9 | SUBROUTINE stop_run( lflag ) 10 | !---------------------------------------------------------------------------- 11 | ! 12 | ! ... Close all files and synchronize processes before stopping. 13 | ! ... Called at the end of the run with flag = .TRUE. (removes 'restart') 14 | ! ... or during execution with flag = .FALSE. (does not remove 'restart') 15 | ! 16 | USE io_global, ONLY : ionode 17 | USE mp_global, ONLY : mp_global_end 18 | USE environment, ONLY : environment_end 19 | USE io_files, ONLY : iuntmp, seqopn 20 | USE image_io_routines, ONLY : io_image_stop 21 | ! 22 | IMPLICIT NONE 23 | ! 24 | LOGICAL, INTENT(IN) :: lflag 25 | LOGICAL :: exst, opnd 26 | ! 27 | ! 28 | ! 29 | ! ... iunwfc contains wavefunctions and is kept open during 30 | ! ... the execution - close the file and save it (or delete it 31 | ! ... if the wavefunctions are already stored in the .save file) 32 | ! 33 | IF (lflag ) THEN 34 | CALL seqopn( iuntmp, 'restart', 'UNFORMATTED', exst ) 35 | CLOSE( UNIT = iuntmp, STATUS = 'DELETE' ) 36 | ENDIF 37 | 38 | IF ( lflag .AND. ionode ) THEN 39 | ! 40 | ! ... all other files must be reopened and removed 41 | ! 42 | CALL seqopn( iuntmp, 'update', 'FORMATTED', exst ) 43 | CLOSE( UNIT = iuntmp, STATUS = 'DELETE' ) 44 | ! 45 | CALL seqopn( iuntmp, 'para', 'FORMATTED', exst ) 46 | CLOSE( UNIT = iuntmp, STATUS = 'DELETE' ) 47 | ! 48 | END IF 49 | ! 50 | CALL close_files(lflag) 51 | ! 52 | CALL print_clock_pw() 53 | ! 54 | CALL environment_end( 'MiniDFT' ) 55 | ! 56 | CALL io_image_stop() 57 | ! 58 | CALL mp_global_end () 59 | ! 60 | CALL clean_pw( .TRUE. ) 61 | ! 62 | IF ( lflag ) THEN 63 | ! 64 | STOP 65 | ! 66 | ELSE 67 | ! 68 | STOP 1 69 | ! 70 | END IF 71 | ! 72 | END SUBROUTINE stop_run 73 | ! 74 | !---------------------------------------------------------------------------- 75 | SUBROUTINE closefile() 76 | !---------------------------------------------------------------------------- 77 | ! 78 | USE io_global, ONLY : stdout 79 | ! 80 | ! ... Close all files and synchronize processes before stopping 81 | ! ... Called by "sigcatch" when it receives a signal 82 | ! 83 | WRITE( stdout,'(5X,"Signal Received, stopping ... ")') 84 | ! 85 | CALL stop_run( .FALSE. ) 86 | ! 87 | RETURN 88 | ! 89 | END SUBROUTINE closefile 90 | -------------------------------------------------------------------------------- /src/read_input.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2011 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | !---------------------------------------------------------------------------- 9 | MODULE read_input 10 | !--------------------------------------------------------------------------- 11 | ! 12 | USE kinds, ONLY: DP 13 | ! 14 | IMPLICIT NONE 15 | SAVE 16 | ! 17 | PRIVATE 18 | PUBLIC :: read_input_file, has_been_read 19 | ! 20 | LOGICAL :: has_been_read = .FALSE. 21 | ! 22 | CONTAINS 23 | ! 24 | !------------------------------------------------------------------------- 25 | SUBROUTINE read_input_file ( prog ) 26 | !------------------------------------------------------------------------- 27 | ! 28 | !use MQEoptions, only : MQEo 29 | USE read_namelists_module, ONLY : read_namelists 30 | USE read_cards_module, ONLY : read_cards 31 | USE io_global, ONLY : stdout, ionode, ionode_id 32 | USE mp, ONLY : mp_bcast 33 | USE mp_global, ONLY : intra_image_comm 34 | ! 35 | IMPLICIT NONE 36 | ! 37 | !borrowed from QE iotk_base.f90 38 | integer, parameter :: iotk_taglenx = 65535 ! (2**16-1) 39 | integer, parameter :: iotk_namlenx = 256 40 | integer, parameter :: iotk_attlenx = iotk_taglenx - iotk_namlenx - 1 ! for space 41 | ! 42 | CHARACTER(LEN=2), INTENT (IN) :: prog 43 | CHARACTER(LEN=iotk_attlenx) :: attr 44 | LOGICAL :: xmlinput 45 | INTEGER :: ierr 46 | ! 47 | ! 48 | if( ionode ) then 49 | call input_from_file( ierr ) 50 | !WRITE(stdout, '(5x,a)') "Reading input from "//TRIM( MQEo%infile) 51 | !OPEN ( UNIT = 5, FILE = TRIM( MQEo%infile), FORM = 'FORMATTED', & 52 | ! STATUS = 'OLD', IOSTAT = ierr ) 53 | !if( ierr > 0 ) ierr = 2 54 | xmlinput = .false. 55 | end if 56 | ! 57 | CALL mp_bcast( ierr, ionode_id, intra_image_comm ) 58 | IF ( ierr > 0 ) CALL errore('read_input', 'opening input file',ierr) 59 | CALL mp_bcast( xmlinput, ionode_id, intra_image_comm ) 60 | CALL mp_bcast( attr, ionode_id, intra_image_comm ) 61 | ! 62 | ! 63 | ! ... Read NAMELISTS 64 | ! 65 | CALL read_namelists( prog ) 66 | ! 67 | ! ... Read CARDS 68 | ! 69 | CALL read_cards ( prog ) 70 | ! 71 | if( ionode ) CLOSE( UNIT=5, STATUS='keep', IOSTAT=ierr ) 72 | ! 73 | has_been_read = .TRUE. 74 | ! 75 | RETURN 76 | ! 77 | END SUBROUTINE read_input_file 78 | ! 79 | END MODULE read_input 80 | -------------------------------------------------------------------------------- /src/upf_to_internal.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2004-2007 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! This module is USEd, for the time being, as an interface 9 | ! between the UPF pseudo type and the pseudo variables internal representation 10 | 11 | !=----------------------------------------------------------------------------=! 12 | MODULE upf_to_internal 13 | !=----------------------------------------------------------------------------=! 14 | 15 | IMPLICIT NONE 16 | PRIVATE 17 | PUBLIC :: set_pseudo_upf 18 | SAVE 19 | 20 | !=----------------------------------------------------------------------------=! 21 | CONTAINS 22 | !=----------------------------------------------------------------------------=! 23 | ! 24 | !--------------------------------------------------------------------- 25 | subroutine set_pseudo_upf (is, upf, grid) 26 | !--------------------------------------------------------------------- 27 | ! 28 | ! set "is"-th pseudopotential using the Unified Pseudopotential Format 29 | ! "upf" - convert and copy to internal variables 30 | ! If "grid" is present, reconstruct radial grid. 31 | ! Obsolescent - for old-style PP formats only. 32 | ! 33 | USE funct, ONLY: set_dft_from_name, set_dft_from_indices 34 | ! 35 | USE pseudo_types 36 | USE radial_grids, ONLY: radial_grid_type, allocate_radial_grid 37 | ! 38 | implicit none 39 | ! 40 | INTEGER :: is 41 | TYPE (pseudo_upf) :: upf 42 | TYPE (radial_grid_type), target, optional :: grid 43 | ! 44 | ! Local variables 45 | ! 46 | integer :: iexch,icorr,igcx,igcc 47 | ! 48 | ! old formats never contain "1/r" pseudopotentials 49 | ! 50 | upf%tcoulombp = .false. 51 | ! 52 | ! workaround for rrkj format - it contains the indices, not the name 53 | ! 54 | if ( upf%dft(1:6)=='INDEX:') then 55 | read( upf%dft(7:10), '(4i1)') iexch,icorr,igcx,igcc 56 | call set_dft_from_indices(iexch,icorr,igcx,igcc, 0) !Cannot read nonloc in this format 57 | else 58 | call set_dft_from_name( upf%dft ) 59 | end if 60 | ! 61 | if(present(grid)) then 62 | call allocate_radial_grid(grid,upf%mesh) 63 | grid%dx = upf%dx 64 | grid%xmin = upf%xmin 65 | grid%zmesh= upf%zmesh 66 | grid%mesh = upf%mesh 67 | ! 68 | grid%r (1:upf%mesh) = upf%r (1:upf%mesh) 69 | grid%rab(1:upf%mesh) = upf%rab(1:upf%mesh) 70 | upf%grid => grid 71 | endif 72 | ! 73 | end subroutine set_pseudo_upf 74 | 75 | !=----------------------------------------------------------------------------=! 76 | END MODULE upf_to_internal 77 | !=----------------------------------------------------------------------------=! 78 | -------------------------------------------------------------------------------- /src/capital.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2008 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | !----------------------------------------------------------------------- 9 | FUNCTION capital( in_char ) 10 | !----------------------------------------------------------------------- 11 | ! 12 | ! ... converts character to capital if lowercase 13 | ! ... copy character to output in all other cases 14 | ! 15 | IMPLICIT NONE 16 | ! 17 | CHARACTER(LEN=1), INTENT(IN) :: in_char 18 | CHARACTER(LEN=1) :: capital 19 | CHARACTER(LEN=26), PARAMETER :: lower = 'abcdefghijklmnopqrstuvwxyz', & 20 | upper = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 21 | INTEGER :: i 22 | ! 23 | ! 24 | DO i=1, 26 25 | ! 26 | IF ( in_char == lower(i:i) ) THEN 27 | ! 28 | capital = upper(i:i) 29 | ! 30 | RETURN 31 | ! 32 | END IF 33 | ! 34 | END DO 35 | ! 36 | capital = in_char 37 | ! 38 | RETURN 39 | ! 40 | END FUNCTION capital 41 | ! 42 | !----------------------------------------------------------------------- 43 | FUNCTION lowercase( in_char ) 44 | !----------------------------------------------------------------------- 45 | ! 46 | ! ... converts character to lowercase if capital 47 | ! ... copy character to output in all other cases 48 | ! 49 | IMPLICIT NONE 50 | ! 51 | CHARACTER(LEN=1), INTENT(IN) :: in_char 52 | CHARACTER(LEN=1) :: lowercase 53 | CHARACTER(LEN=26), PARAMETER :: lower = 'abcdefghijklmnopqrstuvwxyz', & 54 | upper = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 55 | INTEGER :: i 56 | ! 57 | ! 58 | DO i=1, 26 59 | ! 60 | IF ( in_char == upper(i:i) ) THEN 61 | ! 62 | lowercase = lower(i:i) 63 | ! 64 | RETURN 65 | ! 66 | END IF 67 | ! 68 | END DO 69 | ! 70 | lowercase = in_char 71 | ! 72 | RETURN 73 | ! 74 | END FUNCTION lowercase 75 | ! 76 | !----------------------------------------------------------------------- 77 | LOGICAL FUNCTION isnumeric ( in_char ) 78 | !----------------------------------------------------------------------- 79 | ! 80 | ! ... check if a character is a number 81 | ! 82 | IMPLICIT NONE 83 | ! 84 | CHARACTER(LEN=1), INTENT(IN) :: in_char 85 | CHARACTER(LEN=10), PARAMETER :: numbers = '0123456789' 86 | INTEGER :: i 87 | ! 88 | ! 89 | DO i=1, 10 90 | ! 91 | isnumeric = ( in_char == numbers(i:i) ) 92 | IF ( isnumeric ) RETURN 93 | ! 94 | END DO 95 | RETURN 96 | ! 97 | END FUNCTION isnumeric 98 | -------------------------------------------------------------------------------- /src/coset.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001 PWSCF group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | !----------------------------------------------------------------------- 10 | subroutine coset (nrot, table, sym, nsym, irg) 11 | !----------------------------------------------------------------------- 12 | ! 13 | ! Divides the elements of a given group into left cosets of one 14 | ! of its subgroups. 15 | ! The input is the array sym which is true only for the 16 | ! operations of the subgroup, the output is nsym, and the array irg, 17 | ! which contains as its first elements the indices of the subgroup, 18 | ! and then its right cosets. 19 | ! 20 | ! revised layout 1 may 1995 by A. Dal Corso 21 | ! 22 | USE kinds 23 | implicit none 24 | ! 25 | ! first the dummy variables 26 | ! 27 | integer :: nrot, table (48, 48), nsym, irg (48) 28 | ! input: order of the group 29 | ! input: multiplication table of the group 30 | ! output: order of the subgroup 31 | ! output: gives the correspondence of symme 32 | ! operations forming a n-th coset 33 | ! input: flag indicating if an operations 34 | logical :: sym (48) 35 | ! belongs to the subgroup 36 | ! 37 | ! here the local variables 38 | ! 39 | logical :: done (48) 40 | ! if true the operation has been already ch 41 | 42 | integer :: irot, ncos, isym, nc, nelm 43 | ! counter on rotations 44 | ! number of cosets (=nrot/nsym) 45 | ! counter on symmetries 46 | ! counter on cosets 47 | ! counter on the number of elements 48 | ! 49 | ! here we count the elements of the subgroup and set the first part o 50 | ! irg which contain the subgroup 51 | ! 52 | nsym = 0 53 | do irot = 1, nrot 54 | done (irot) = sym (irot) 55 | if (sym (irot) ) then 56 | nsym = nsym + 1 57 | irg (nsym) = irot 58 | endif 59 | enddo 60 | ! 61 | ! we check that the order of the subgroup is a divisor of the order 62 | ! total group. ncos is the number of cosets 63 | ! 64 | IF ( nsym == 0 ) CALL errore( 'coset', 'nsym == 0', 1 ) 65 | ! 66 | ncos = nrot / nsym 67 | if (ncos * nsym.ne.nrot) call errore ('coset', & 68 | 'The order'//' of the group is not a multiple of that of the subgroup', 1) 69 | ! 70 | ! here we set the other elements of irg, by using the multiplication 71 | ! 72 | nelm = nsym 73 | do nc = 2, ncos 74 | do irot = 1, nrot 75 | if (.not.done (irot) ) then 76 | do isym = 1, nsym 77 | nelm = nelm + 1 78 | irg (nelm) = table (irot, irg (isym) ) 79 | done (irg (nelm) ) = .true. 80 | enddo 81 | endif 82 | enddo 83 | 84 | enddo 85 | return 86 | end subroutine coset 87 | -------------------------------------------------------------------------------- /src/data_structure.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2010 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | !----------------------------------------------------------------------- 10 | SUBROUTINE data_structure( gamma_only ) 11 | !----------------------------------------------------------------------- 12 | ! this routine sets the data structure for the fft arrays 13 | ! (both the smooth and the dense grid) 14 | ! In the parallel case, it distributes columns to processes, too 15 | ! 16 | USE kinds, ONLY : DP 17 | USE io_global, ONLY : stdout 18 | USE mp, ONLY : mp_max 19 | USE mp_global, ONLY : me_bgrp, nproc_bgrp, inter_pool_comm, intra_bgrp_comm, root_bgrp 20 | USE mp_global, ONLY : get_ntask_groups 21 | USE fft_base, ONLY : dfftp, dffts 22 | USE cell_base, ONLY : bg, tpiba 23 | USE klist, ONLY : xk, nks 24 | USE gvect, ONLY : gcutm, gvect_init 25 | USE gvecs, ONLY : gcutms, gvecs_init 26 | USE stick_set, ONLY : pstickset 27 | USE wvfct, ONLY : ecutwfc 28 | 29 | 30 | ! 31 | IMPLICIT NONE 32 | LOGICAL, INTENT(in) :: gamma_only 33 | REAL (DP) :: gkcut 34 | INTEGER :: ik, ngm_, ngs_, ngw_ , nogrp 35 | INTEGER :: me, nproc, inter_comm, intra_comm, root 36 | me = me_bgrp 37 | nproc = nproc_bgrp 38 | inter_comm = inter_pool_comm 39 | intra_comm = intra_bgrp_comm 40 | root = root_bgrp 41 | ! 42 | ! ... calculate gkcut = max |k+G|^2, in (2pi/a)^2 units 43 | ! 44 | IF (nks == 0) THEN 45 | ! 46 | ! if k-points are automatically generated (which happens later) 47 | ! use max(bg)/2 as an estimate of the largest k-point 48 | ! 49 | gkcut = 0.5d0 * max ( & 50 | sqrt (sum(bg (1:3, 1)**2) ), & 51 | sqrt (sum(bg (1:3, 2)**2) ), & 52 | sqrt (sum(bg (1:3, 3)**2) ) ) 53 | ELSE 54 | gkcut = 0.0d0 55 | DO ik = 1, nks 56 | gkcut = max (gkcut, sqrt ( sum(xk (1:3, ik)**2) ) ) 57 | ENDDO 58 | ENDIF 59 | gkcut = (sqrt (ecutwfc) / tpiba + gkcut)**2 60 | ! 61 | ! ... find maximum value among all the processors 62 | ! 63 | CALL mp_max (gkcut, inter_comm ) 64 | ! 65 | ! ... set up fft descriptors, including parallel stuff: sticks, planes, etc. 66 | ! 67 | nogrp = get_ntask_groups() 68 | ! 69 | CALL pstickset( gamma_only, bg, gcutm, gkcut, gcutms, & 70 | dfftp, dffts, ngw_ , ngm_ , ngs_ , me, root, nproc, intra_comm, & 71 | nogrp ) 72 | ! 73 | ! on output, ngm_ and ngs_ contain the local number of G-vectors 74 | ! for the two grids. Initialize local and global number of G-vectors 75 | ! 76 | call gvect_init ( ngm_ , intra_comm ) 77 | call gvecs_init ( ngs_ , intra_comm ); 78 | ! 79 | 80 | END SUBROUTINE data_structure 81 | 82 | -------------------------------------------------------------------------------- /src/md5_from_file.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright (C) 2005-2008 Quantum ESPRESSO group 3 | This file is distributed under the terms of the 4 | GNU General Public License. See the file `License' 5 | in the root directory of the present distribution, 6 | or http://www.gnu.org/copyleft/gpl.txt . 7 | 8 | ------------------------------------------------------ 9 | */ 10 | 11 | 12 | #include 13 | #include 14 | #include 15 | #include "c_defs.h" 16 | #include "md5.h" 17 | 18 | #define MAX_BUF 1024 19 | 20 | 21 | static void fatal ( const char * msg ) 22 | { 23 | 24 | fprintf( stderr , "fatal: %s" , *msg ? msg : "Oops!" ) ; 25 | exit( -1 ) ; 26 | 27 | } /* fatal */ 28 | 29 | static void * xcmalloc ( size_t size ) 30 | { 31 | 32 | register void * ptr = malloc( size ) ; 33 | 34 | if ( ptr == NULL ) 35 | fatal( "md5_from_file: virtual memory exhausted" ) ; 36 | else 37 | memset( ptr , 0 , size ) ; 38 | 39 | return ptr ; 40 | 41 | } /* xcmalloc */ 42 | 43 | char *readFile( FILE *file ) 44 | { 45 | 46 | char *out; 47 | unsigned long fileLen; 48 | 49 | if (!file) 50 | { 51 | exit(1); 52 | } 53 | 54 | fseek(file, 0, SEEK_END); 55 | fileLen=ftell(file); 56 | fseek(file, 0, SEEK_SET); 57 | 58 | out=(char *)xcmalloc(fileLen+1); 59 | 60 | if (!out) 61 | { 62 | fprintf(stderr, "Memory error!"); 63 | fclose(file); 64 | exit(1); 65 | } 66 | 67 | fread(out, fileLen, 1, file); 68 | 69 | return out; 70 | 71 | } 72 | 73 | 74 | void get_md5(const char *file, char *md5, int err) 75 | { 76 | 77 | FILE *fp; 78 | char *data; 79 | md5_state_t state; 80 | md5_byte_t digest[16]; 81 | 82 | if(file==NULL) { 83 | err = 1; 84 | return; 85 | } 86 | 87 | fp=fopen(file,"rb"); 88 | if(fp==NULL) { 89 | err = 2; 90 | return; 91 | } 92 | 93 | data=readFile(fp); 94 | if(data==NULL) { 95 | err = 3; 96 | return; 97 | } 98 | 99 | md5_init(&state); 100 | md5_append(&state,(const md5_byte_t *)data,strlen(data)); 101 | md5_finish(&state,digest); 102 | 103 | int i=0; 104 | for(i;i<16;i++){ 105 | snprintf(md5+i*2,sizeof(md5),"%02x",digest[i]); 106 | } 107 | fclose(fp); 108 | 109 | free(data); 110 | err = 0; 111 | return; 112 | } 113 | 114 | int F77_FUNC_(file_md5,FILE_MD5)( const int * f_name, const int * f_len, int * out ) 115 | { 116 | int i, err = -1 ; 117 | char * md5 = ( char * ) xcmalloc( 32 + 1 ) ; 118 | char * f = ( char * ) xcmalloc( (*f_len) + 1) ; 119 | 120 | for( i = 0; i < * f_len; i++ ) f[ i ] = (char)f_name[ i ]; 121 | 122 | f[*f_len] = '\0' ; 123 | 124 | get_md5( f , md5, err) ; 125 | for( i = 0; i < 32; i++ ) out[ i ] = md5[ i ]; 126 | 127 | free(f); 128 | free(md5); 129 | return err; 130 | } 131 | 132 | -------------------------------------------------------------------------------- /src/data_structure_custom.f90: -------------------------------------------------------------------------------- 1 | 2 | ! 3 | ! Copyright (C) 2001-2012 Quantum ESPRESSO group 4 | ! This file is distributed under the terms of the 5 | ! GNU General Public License. See the file `License' 6 | ! in the root directory of the present distribution, 7 | ! or http://www.gnu.org/copyleft/gpl.txt . 8 | ! 9 | ! 10 | !----------------------------------------------------------------------- 11 | SUBROUTINE data_structure_custom(fc, gamma_only) 12 | !----------------------------------------------------------------------- 13 | ! this routine sets the data structure for the custom fft array 14 | ! In the parallel case, it distributes columns to processes, too 15 | ! 16 | USE kinds, ONLY : DP 17 | USE cell_base, ONLY : bg, tpiba, tpiba2 18 | USE klist, ONLY : xk, nks 19 | USE mp, ONLY : mp_sum, mp_max,mp_barrier 20 | USE mp_global, ONLY : mpime, me_bgrp, nproc_bgrp, inter_bgrp_comm,& 21 | & intra_bgrp_comm, root_bgrp, inter_pool_comm 22 | USE mp_global, ONLY : get_ntask_groups 23 | USE stick_set, ONLY : pstickset_custom 24 | USE fft_custom, ONLY : fft_cus, gvec_init 25 | ! 26 | ! 27 | IMPLICIT NONE 28 | 29 | TYPE(fft_cus) :: fc 30 | LOGICAL :: gamma_only 31 | REAL (DP) :: gkcut 32 | INTEGER :: ik, ngm_, ngs_, ngw_ , nogrp 33 | INTEGER :: me, nproc, inter_comm, intra_comm, root 34 | 35 | INTEGER :: kpoint 36 | ! sticks coordinates 37 | 38 | ! 39 | ! Subroutine body 40 | ! 41 | 42 | ! 43 | ! compute gkcut calling an internal procedure 44 | ! 45 | 46 | me = me_bgrp 47 | nproc = nproc_bgrp 48 | inter_comm = inter_pool_comm 49 | intra_comm = intra_bgrp_comm 50 | root = root_bgrp 51 | 52 | nogrp = get_ntask_groups() 53 | 54 | IF (nks == 0) THEN 55 | ! 56 | ! if k-points are automatically generated (which happens later) 57 | ! use max(bg)/2 as an estimate of the largest k-point 58 | ! 59 | gkcut = 0.5d0 * MAX ( & 60 | &SQRT (SUM(bg (1:3, 1)**2) ), & 61 | &SQRT (SUM(bg (1:3, 2)**2) ), & 62 | &SQRT (SUM(bg (1:3, 3)**2) ) ) 63 | ELSE 64 | gkcut = 0.0d0 65 | DO kpoint = 1, nks 66 | gkcut = MAX (gkcut, SQRT ( SUM(xk (1:3, kpoint)**2) ) ) 67 | ENDDO 68 | ENDIF 69 | gkcut = (SQRT (fc%ecutt) / tpiba + gkcut)**2 70 | 71 | ! 72 | ! ... find maximum value among all the processors 73 | ! 74 | CALL mp_max (gkcut, inter_comm ) 75 | ! 76 | ! ... set up fft descriptors, including parallel stuff: sticks, planes, etc. 77 | ! 78 | nogrp = get_ntask_groups() 79 | ! 80 | CALL pstickset_custom( gamma_only, bg, fc%gcutmt, gkcut, & 81 | fc%dfftt, ngw_ , ngm_ , me, root, nproc, intra_comm, & 82 | nogrp ) 83 | ! 84 | ! on output, ngm_ and ngs_ contain the local number of G-vectors 85 | ! for the two grids. Initialize local and global number of G-vectors 86 | ! 87 | CALL gvec_init (fc, ngm_ , intra_comm ) 88 | 89 | 90 | END SUBROUTINE data_structure_custom 91 | -------------------------------------------------------------------------------- /src/allocate_fft.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2010 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | !----------------------------------------------------------------------- 10 | SUBROUTINE allocate_fft 11 | !----------------------------------------------------------------------- 12 | ! This routine computes the data structure associated to the FFT 13 | ! grid and allocate memory for all the arrays which depend upon 14 | ! these dimensions 15 | ! 16 | USE io_global, ONLY : stdout 17 | USE gvect, ONLY : ngm, g, gg, nl, nlm, mill, igtongl 18 | USE gvecs, ONLY : ngms, nls, nlsm 19 | USE fft_base, ONLY : dfftp, dffts 20 | ! DCC 21 | ! USE gcoarse, ONLY : nr1c,nr2c,nr3c,nnr,ngmc, nlc, nlcm 22 | ! USE ee_mod, ONLY : do_coarse 23 | USE ions_base, ONLY : nat 24 | USE lsda_mod, ONLY : nspin 25 | USE spin_orb, ONLY : domag 26 | USE scf, ONLY : rho, v, vnew, vltot, vrs, rho_core, rhog_core, & 27 | kedtau, create_scf_type 28 | USE wavefunctions_module, ONLY : psic 29 | IMPLICIT NONE 30 | ! 31 | ! determines the data structure for fft arrays 32 | ! 33 | CALL data_structure( .false. ) 34 | ! 35 | ! DCC 36 | ! IF( do_coarse ) CALL data_structure_coarse( gamma_only, nr1,nr2,nr3, ecutwfc ) 37 | ! 38 | 39 | IF (dfftp%nnr.lt.ngm) THEN 40 | WRITE( stdout, '(/,4x," nr1=",i4," nr2= ", i4, " nr3=",i4, & 41 | &" nrxx = ",i8," ngm=",i8)') dfftp%nr1, dfftp%nr2, dfftp%nr3, dfftp%nnr, ngm 42 | CALL errore ('allocate_fft', 'the nr"s are too small!', 1) 43 | 44 | ENDIF 45 | IF (dffts%nnr.lt.ngms) THEN 46 | WRITE( stdout, '(/,4x," nr1s=",i4," nr2s= ", i4, " nr3s=",i4, & 47 | &" nrxxs = ",i8," ngms=",i8)') dffts%nr1, dffts%nr2, dffts%nr3, dffts%nnr, ngms 48 | CALL errore ('allocate_fft', 'the nrs"s are too small!', 1) 49 | 50 | ENDIF 51 | IF (ngm <= 0) CALL errore ('allocate_fft', 'wrong ngm', 1) 52 | IF (ngms <= 0) CALL errore ('allocate_fft', 'wrong ngms', 1) 53 | IF (dfftp%nnr <= 0) CALL errore ('allocate_fft', 'wrong nnr', 1) 54 | IF (dffts%nnr<= 0) CALL errore ('allocate_fft', 'wrong smooth nnr', 1) 55 | IF (nspin<= 0) CALL errore ('allocate_fft', 'wrong nspin', 1) 56 | ! 57 | ! Allocate memory for all kind of stuff. 58 | ! 59 | CALL create_scf_type(rho) 60 | CALL create_scf_type(v, do_not_allocate_becsum = .true.) 61 | CALL create_scf_type(vnew, do_not_allocate_becsum = .true.) 62 | ALLOCATE (vltot( dfftp%nnr)) 63 | ALLOCATE (rho_core( dfftp%nnr)) 64 | ALLOCATE ( kedtau(1,nspin) ) 65 | ALLOCATE( rhog_core( ngm ) ) 66 | ALLOCATE (psic( dfftp%nnr)) 67 | ALLOCATE (vrs( dfftp%nnr, nspin)) 68 | 69 | ! DCC 70 | ! IF( do_coarse ) THEN 71 | ! ALLOCATE (nlc( ngmc)) 72 | ! IF (gamma_only) ALLOCATE (nlcm(ngmc)) 73 | ! ENDIF 74 | 75 | 76 | 77 | RETURN 78 | END SUBROUTINE allocate_fft 79 | -------------------------------------------------------------------------------- /src/matches.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2004 Carlo Cavazzoni and PWSCF group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | !----------------------------------------------------------------------- 9 | FUNCTION matches( string1, string2 ) 10 | !----------------------------------------------------------------------- 11 | ! 12 | ! ... .TRUE. if string1 is contained in string2, .FALSE. otherwise 13 | ! 14 | IMPLICIT NONE 15 | ! 16 | CHARACTER (LEN=*), INTENT(IN) :: string1, string2 17 | LOGICAL :: matches 18 | INTEGER :: len1, len2, l 19 | ! 20 | ! 21 | len1 = LEN_TRIM( string1 ) 22 | len2 = LEN_TRIM( string2 ) 23 | ! 24 | DO l = 1, ( len2 - len1 + 1 ) 25 | ! 26 | IF ( string1(1:len1) == string2(l:(l+len1-1)) ) THEN 27 | ! 28 | matches = .TRUE. 29 | ! 30 | RETURN 31 | ! 32 | END IF 33 | ! 34 | END DO 35 | ! 36 | matches = .FALSE. 37 | ! 38 | RETURN 39 | ! 40 | END FUNCTION matches 41 | ! 42 | !----------------------------------------------------------------------- 43 | FUNCTION imatches( string1, string2 ) 44 | !----------------------------------------------------------------------- 45 | ! 46 | ! ... .TRUE. if string1 is contained in string2, .FALSE. otherwise 47 | ! *** case insensitive *** 48 | ! 49 | IMPLICIT NONE 50 | ! 51 | CHARACTER (LEN=*), INTENT(IN) :: string1, string2 52 | CHARACTER(LEN=len(string1)) :: aux1 53 | CHARACTER(LEN=len(string2)) :: aux2 54 | CHARACTER(LEN=1) :: lowercase 55 | LOGICAL :: imatches 56 | LOGICAL, EXTERNAL :: matches 57 | INTEGER :: i 58 | ! 59 | aux1 = string1 60 | aux2 = string2 61 | ! 62 | do i=1,len(aux1) 63 | aux1(i:i)=lowercase(aux1(i:i)) 64 | enddo 65 | do i=1,len(aux2) 66 | aux2(i:i)=lowercase(aux2(i:i)) 67 | enddo 68 | ! 69 | imatches = matches(aux1, aux2) 70 | ! 71 | RETURN 72 | ! 73 | END FUNCTION imatches 74 | ! 75 | !----------------------------------------------------------------------- 76 | SUBROUTINE remove_comments_from_string( string ) 77 | !----------------------------------------------------------------------- 78 | ! 79 | ! chop string removing everything after an esclamation mark (!) 80 | ! 81 | IMPLICIT NONE 82 | ! 83 | CHARACTER (LEN=*), INTENT(INOUT) :: string 84 | INTEGER :: len, l 85 | ! 86 | ! 87 | len = LEN_TRIM( string ) 88 | ! 89 | l=1 90 | DO WHILE ( string(l:l) /= "!" ) 91 | l = l + 1 92 | if (l == len+1) EXIT 93 | END DO 94 | len = l-1 95 | ! 96 | string = string(1:len) 97 | ! 98 | RETURN 99 | ! 100 | END SUBROUTINE remove_comments_from_string 101 | ! 102 | -------------------------------------------------------------------------------- /src/kind.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2002-2004 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | !------------------------------------------------------------------------------! 9 | MODULE kinds 10 | !------------------------------------------------------------------------------! 11 | 12 | IMPLICIT NONE 13 | SAVE 14 | ! ... kind definitions 15 | INTEGER, PARAMETER :: DP = selected_real_kind(14,200) 16 | INTEGER, PARAMETER :: sgl = selected_real_kind(6,30) 17 | INTEGER, PARAMETER :: i4b = selected_int_kind(9) 18 | PRIVATE 19 | PUBLIC :: i4b, sgl, DP, print_kind_info 20 | ! 21 | !------------------------------------------------------------------------------! 22 | ! 23 | CONTAINS 24 | ! 25 | !------------------------------------------------------------------------------! 26 | ! 27 | !! Print information about the used data types. 28 | ! 29 | SUBROUTINE print_kind_info (stdout) 30 | ! 31 | !------------------------------------------------------------------------------! 32 | ! 33 | IMPLICIT NONE 34 | INTEGER, INTENT(IN) :: stdout 35 | ! 36 | WRITE( stdout,'(/,T2,A)') 'DATA TYPE INFORMATION:' 37 | ! 38 | WRITE( stdout,'(/,T2,A,T78,A,2(/,T2,A,T75,I6),3(/,T2,A,T67,E14.8))') & 39 | 'REAL: Data type name:', 'DP', ' Kind value:', kind(0.0_DP), & 40 | ' Precision:', precision(0.0_DP), & 41 | ' Smallest nonnegligible quantity relative to 1:', & 42 | epsilon(0.0_DP), ' Smallest positive number:', tiny(0.0_DP), & 43 | ' Largest representable number:', huge(0.0_DP) 44 | WRITE( stdout,'(/,T2,A,T78,A,2(/,T2,A,T75,I6),3(/,T2,A,T67,E14.8))') & 45 | ' Data type name:', 'sgl', ' Kind value:', kind(0.0_sgl), & 46 | ' Precision:', precision(0.0_sgl), & 47 | ' Smallest nonnegligible quantity relative to 1:', & 48 | epsilon(0.0_sgl), ' Smallest positive number:', tiny(0.0_sgl), & 49 | ' Largest representable number:', huge(0.0_sgl) 50 | WRITE( stdout,'(/,T2,A,T72,A,4(/,T2,A,T61,I20))') & 51 | 'INTEGER: Data type name:', '(default)', ' Kind value:', & 52 | kind(0), ' Bit size:', bit_size(0), & 53 | ' Largest representable number:', huge(0) 54 | WRITE( stdout,'(/,T2,A,T72,A,/,T2,A,T75,I6,/)') 'LOGICAL: Data type name:', & 55 | '(default)', ' Kind value:', kind(.TRUE.) 56 | WRITE( stdout,'(/,T2,A,T72,A,/,T2,A,T75,I6,/)') & 57 | 'CHARACTER: Data type name:', '(default)', ' Kind value:', & 58 | kind('C') 59 | ! 60 | END SUBROUTINE print_kind_info 61 | ! 62 | !------------------------------------------------------------------------------! 63 | END MODULE kinds 64 | !------------------------------------------------------------------------------! 65 | -------------------------------------------------------------------------------- /src/struct_fact.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001 PWSCF group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | !---------------------------------------------------------------------- 10 | subroutine struc_fact (nat, tau, ntyp, ityp, ngm, g, bg, nr1, nr2, & 11 | nr3, strf, eigts1, eigts2, eigts3) 12 | !---------------------------------------------------------------------- 13 | ! 14 | ! calculate the structure factors for each type of atoms in the unit 15 | ! cell 16 | ! 17 | USE kinds 18 | USE constants, ONLY : tpi 19 | implicit none 20 | ! 21 | ! Here the dummy variables 22 | ! 23 | 24 | integer :: nat, ntyp, ityp (nat), ngm, nr1, nr2, nr3 25 | ! input: the number of atom in the unit cel 26 | ! input: the number of atom types 27 | ! input: for each atom gives the type 28 | ! input: the number of G vectors 29 | ! input: fft dimension along x 30 | ! input: fft dimension along y 31 | ! input: fft dimension along z 32 | 33 | real(DP) :: bg (3, 3), tau (3, nat), g (3, ngm) 34 | ! input: reciprocal crystal basis vectors 35 | ! input: the positions of the atoms in the c 36 | ! input: the coordinates of the g vectors 37 | 38 | complex(DP) :: strf (ngm, ntyp), & 39 | eigts1 ( -nr1:nr1, nat), & 40 | eigts2 ( -nr2:nr2, nat), & 41 | eigts3 ( -nr3:nr3, nat) 42 | ! output: the structure factor 43 | ! 44 | ! output: the phases e^{-iG\tau_s} 45 | ! 46 | ! 47 | ! here the local variables 48 | ! 49 | integer :: nt, na, ng, n1, n2, n3, ipol 50 | ! counter over atom type 51 | ! counter over atoms 52 | ! counter over G vectors 53 | ! counter over fft dimension along x 54 | ! counter over fft dimension along y 55 | ! counter over fft dimension along z 56 | ! counter over polarizations 57 | 58 | real(DP) :: arg, bgtau (3) 59 | ! the argument of the exponent 60 | ! scalar product of bg and tau 61 | 62 | strf(:,:) = (0.d0,0.d0) 63 | do nt = 1, ntyp 64 | do na = 1, nat 65 | if (ityp (na) .eq.nt) then 66 | do ng = 1, ngm 67 | arg = (g (1, ng) * tau (1, na) + g (2, ng) * tau (2, na) & 68 | + g (3, ng) * tau (3, na) ) * tpi 69 | strf (ng, nt) = strf (ng, nt) + CMPLX(cos (arg), -sin (arg),kind=DP) 70 | enddo 71 | endif 72 | enddo 73 | enddo 74 | 75 | do na = 1, nat 76 | do ipol = 1, 3 77 | bgtau (ipol) = bg (1, ipol) * tau (1, na) + & 78 | bg (2, ipol) * tau (2, na) + & 79 | bg (3, ipol) * tau (3, na) 80 | enddo 81 | do n1 = - nr1, nr1 82 | arg = tpi * n1 * bgtau (1) 83 | eigts1 (n1, na) = CMPLX(cos (arg), - sin (arg) ,kind=DP) 84 | enddo 85 | do n2 = - nr2, nr2 86 | arg = tpi * n2 * bgtau (2) 87 | eigts2 (n2, na) = CMPLX(cos (arg), - sin (arg) ,kind=DP) 88 | enddo 89 | do n3 = - nr3, nr3 90 | arg = tpi * n3 * bgtau (3) 91 | eigts3 (n3, na) = CMPLX(cos (arg), - sin (arg) ,kind=DP) 92 | enddo 93 | enddo 94 | 95 | return 96 | end subroutine struc_fact 97 | 98 | -------------------------------------------------------------------------------- /src/memory_report.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2007 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | !---------------------------------------------------------------------------- 10 | SUBROUTINE memory_report() 11 | !---------------------------------------------------------------------------- 12 | ! 13 | USE io_global, ONLY : stdout 14 | USE wvfct, ONLY : npwx, nbnd, nbndx 15 | USE basis, ONLY : natomwfc 16 | USE fft_base, ONLY : dfftp 17 | USE gvect, ONLY : ngl, ngm 18 | USE uspp, ONLY : nkb 19 | USE lsda_mod, ONLY : nspin 20 | USE control_flags, ONLY: isolve, nmix, lscf 21 | USE mp_global, ONLY : np_ortho 22 | ! 23 | IMPLICIT NONE 24 | ! 25 | integer, parameter :: npol=1 !substitute for noncollin_module%npol 26 | INTEGER, PARAMETER :: Mb=1024*1024, complex_size=16, real_size=8 27 | INTEGER :: g_size, nbnd_l 28 | ! 29 | ! the conversions to double prevent integer overflow in very large run 30 | ! 31 | WRITE( stdout, '(/5x,"Largest allocated arrays",5x,"est. size (Mb)", & 32 | &5x,"dimensions")') 33 | WRITE( stdout, '(8x,"Kohn-Sham Wavefunctions ",f10.2," Mb", & 34 | & 5x,"(",i7,",",i5,")")') & 35 | complex_size*nbnd*npol*DBLE(npwx)/Mb, npwx*npol,nbnd 36 | WRITE( stdout, '(8x,"NL pseudopotentials ",f10.2," Mb", & 37 | & 5x,"(",i7,",",i5,")")') & 38 | complex_size*nkb*DBLE(npwx)/Mb, npwx, nkb 39 | IF ( nspin == 2 ) THEN 40 | WRITE( stdout, '(8x,"Each V/rho on FFT grid ",f10.2," Mb", & 41 | & 5x,"(",i7,",",i4,")")') & 42 | DBLE(complex_size*nspin*dfftp%nnr)/Mb, dfftp%nnr, nspin 43 | ELSE 44 | WRITE( stdout, '(8x,"Each V/rho on FFT grid ",f10.2," Mb", & 45 | & 5x,"(",i7,")")') DBLE(complex_size*dfftp%nnr)/Mb, dfftp%nnr 46 | END IF 47 | WRITE( stdout, '(8x,"Each G-vector array ",f10.2," Mb", & 48 | & 5x,"(",i7,")")') DBLE(real_size*ngm)/Mb, ngm 49 | WRITE( stdout, '(8x,"G-vector shells ",f10.2," Mb", & 50 | & 5x,"(",i7,")")') DBLE(real_size*ngl)/Mb, ngl 51 | ! 52 | WRITE( stdout, '(5x,"Largest temporary arrays",5x,"est. size (Mb)", & 53 | &5x,"dimensions")') 54 | g_size = complex_size 55 | ! 56 | IF ( isolve == 0 ) THEN 57 | WRITE( stdout, '(8x,"Auxiliary wavefunctions ",f10.2," Mb", & 58 | & 5x,"(",i7,",",i5,")")') & 59 | g_size*nbndx*npol*DBLE(npwx)/Mb, npwx*npol, nbndx 60 | ENDIF 61 | ! nbnd_l : estimated dimension of distributed matrices 62 | nbnd_l = nbndx/np_ortho(1) 63 | WRITE( stdout, '(8x,"Each subspace H/S matrix ",f10.2," Mb", & 64 | & 5x,"(",i4,",",i4,")")') & 65 | DBLE(g_size*nbnd_l*nbnd_l)/Mb, nbnd_l, nbnd_l 66 | ! 67 | WRITE( stdout, '(8x,"Each matrix",f10.2," Mb", & 68 | & 5x,"(",i7,",",i5,")")') & 69 | DBLE(g_size*nkb)/Mb, nkb, nbnd 70 | ! 71 | IF ( lscf) WRITE( stdout, & 72 | '(8x,"Arrays for rho mixing ",f10.2," Mb", 5x,"(",i7,",",i4,")")') & 73 | DBLE(complex_size*dfftp%nnr*nmix)/Mb, dfftp%nnr, nmix 74 | ! 75 | RETURN 76 | ! 77 | END subroutine memory_report 78 | -------------------------------------------------------------------------------- /src/start_k.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2011 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | !-------------------------------------------------------------------------- 9 | ! 10 | MODULE start_k 11 | ! 12 | ! ... Basic variables for k-point generations, as read from input 13 | ! 14 | USE kinds, ONLY : DP 15 | USE cell_base, ONLY : bg 16 | ! 17 | SAVE 18 | ! 19 | ! ... uniform k-point grid parameters 20 | ! 21 | INTEGER :: & 22 | nk1, nk2, nk3, &! the special-point grid 23 | k1, k2, k3 ! the offset from the origin 24 | ! 25 | ! 26 | ! ... k points and weights, read from input, if any 27 | ! 28 | INTEGER :: nks_start=0 ! number of k points 29 | REAL(DP), ALLOCATABLE :: wk_start(:) ! weights of k points 30 | REAL(DP), ALLOCATABLE :: xk_start(:,:) ! coordinates of k points 31 | 32 | CONTAINS 33 | 34 | SUBROUTINE init_start_k ( nk1_, nk2_, nk3_, k1_, k2_, k3_, & 35 | k_points, nk_, xk_, wk_ ) 36 | ! 37 | ! initialize the grid of k points 38 | ! 39 | INTEGER, INTENT (IN) :: nk1_, nk2_, nk3_, k1_, k2_, k3_, nk_ 40 | CHARACTER(LEN=*), INTENT (IN) :: k_points 41 | REAL(dp),INTENT (IN) :: xk_(3,nk_), wk_(nk_) 42 | ! 43 | LOGICAL :: done 44 | ! 45 | ! variables for automatic grid 46 | ! 47 | nk1 = 0; nk2 = 0; nk3 = 0; k1 = 0; k2 = 0; k3 = 0 48 | done = reset_grid ( nk1_, nk2_, nk3_, k1_, k2_, k3_ ) 49 | IF ( k_points == 'automatic' .AND. .not. done ) & 50 | CALL errore ('init_start_k','automatic k-points and nk*=0?',1) 51 | ! 52 | ! variables for manual grid 53 | ! 54 | IF ( k_points == 'gamma' ) THEN 55 | nks_start = 1 56 | ELSE 57 | nks_start = nk_ 58 | END IF 59 | ! 60 | IF ( nks_start > 0) THEN 61 | IF ( .NOT. ALLOCATED (xk_start) ) ALLOCATE ( xk_start(3,nks_start) ) 62 | IF ( .NOT. ALLOCATED (wk_start) ) ALLOCATE ( wk_start(nks_start) ) 63 | ! 64 | ! k-points in crystal axis: transform to cartesian (in units 2pi/a) 65 | ! BEWARE: reciprocal axis bg NEEDED, must have been initialized 66 | ! 67 | IF ( k_points == 'crystal' ) CALL cryst_to_cart(nk_, xk_, bg, 1) 68 | ! 69 | IF ( k_points == 'gamma' ) THEN 70 | xk_start(:,1) = 0.0_dp 71 | wk_start(1) = 1.0_dp 72 | ELSE 73 | xk_start(:,:) = xk_(:,1:nk_) 74 | wk_start(:) = wk_(1:nk_) 75 | ENDIF 76 | END IF 77 | ! 78 | END SUBROUTINE init_start_k 79 | ! 80 | LOGICAL FUNCTION reset_grid ( nk1_, nk2_, nk3_, k1_, k2_, k3_ ) 81 | ! 82 | ! reset the automatic grid to new values if these are > 0 83 | ! 84 | INTEGER, INTENT (IN) :: nk1_, nk2_, nk3_, k1_, k2_, k3_ 85 | ! 86 | IF ( nk1_ > 0 ) nk1 = nk1_ 87 | IF ( nk2_ > 0 ) nk2 = nk2_ 88 | IF ( nk3_ > 0 ) nk3 = nk3_ 89 | IF ( k1_ > 0 ) k1 = k1_ 90 | IF ( k2_ > 0 ) k2 = k2_ 91 | IF ( k3_ > 0 ) k3 = k3_ 92 | ! 93 | reset_grid = (nk1_*nk2_*nk3_ > 0) 94 | ! 95 | END FUNCTION reset_grid 96 | 97 | END MODULE start_k 98 | -------------------------------------------------------------------------------- /src/remove_tot_torque.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2006 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | !---------------------------------------------------------------------------- 9 | SUBROUTINE remove_tot_torque( nat, tau, mass, force ) 10 | !---------------------------------------------------------------------------- 11 | ! 12 | ! ... This routine sets to zero the total torque associated to the internal 13 | ! ... forces acting on the atoms by correcting the force vector. 14 | ! 15 | ! ... The algorithm is based on the following expressions ( F' is the 16 | ! ... torqueless force ) : 17 | ! _ 18 | ! _ 1 \ __ _ __ _ _ 19 | ! ... m = --- /_ dR_i /\ F_i , dR_i = ( R_i - R_cm ) , 20 | ! N i 21 | ! 22 | ! __ _ 1 _ __ 23 | ! ... F'_i = F_i - -------- m /\ dR_i 24 | ! |dR_i|^2 25 | ! 26 | ! 27 | ! ... written by carlo sbraccia (2006) 28 | ! 29 | USE kinds, ONLY : DP 30 | ! 31 | IMPLICIT NONE 32 | ! 33 | INTEGER, INTENT(IN) :: nat 34 | REAL(DP), INTENT(IN) :: tau(3,nat) 35 | REAL(DP), INTENT(IN) :: mass(nat) 36 | REAL(DP), INTENT(INOUT) :: force(3,nat) 37 | ! 38 | INTEGER :: ia 39 | REAL(DP) :: m(3), mo(3), tauref(3), delta(3), sumf(3) 40 | REAL(DP) :: nrmsq 41 | ! 42 | ! 43 | tauref(:) = 0.D0 44 | ! 45 | DO ia = 1, nat 46 | ! 47 | tauref(:) = tauref(:) + tau(:,ia)*mass(ia) 48 | ! 49 | END DO 50 | ! 51 | tauref(:) = tauref(:) / SUM( mass(:) ) 52 | ! 53 | m(:) = 0.D0 54 | ! 55 | DO ia = 1, nat 56 | ! 57 | delta(:) = tau(:,ia) - tauref(:) 58 | ! 59 | m(:) = m(:) + ext_prod( delta(:), force(:,ia) ) 60 | ! 61 | END DO 62 | ! 63 | mo(:) = m(:) 64 | ! 65 | m(:) = m(:) / DBLE( nat ) 66 | ! 67 | sumf(:) = 0.D0 68 | ! 69 | DO ia = 1, nat 70 | ! 71 | delta(:) = tau(:,ia) - tauref(:) 72 | ! 73 | nrmsq = delta(1)**2 + delta(2)**2 + delta(3)**2 74 | ! 75 | force(:,ia) = force(:,ia) - ext_prod( m(:), delta(:) ) / nrmsq 76 | ! 77 | sumf(:) = sumf(:) + force(:,ia) 78 | ! 79 | END DO 80 | ! 81 | DO ia = 1, nat 82 | ! 83 | force(:,ia) = force(:,ia) - sumf(:) / DBLE( nat ) 84 | ! 85 | END DO 86 | ! 87 | m(:) = 0.D0 88 | ! 89 | DO ia = 1, nat 90 | ! 91 | delta(:) = tau(:,ia) - tauref(:) 92 | ! 93 | m(:) = m(:) + ext_prod( delta(:), force(:,ia) ) 94 | ! 95 | END DO 96 | ! 97 | IF ( m(1)**2+m(2)**2+m(3)**2 > mo(1)**2+mo(2)**2+mo(3)**2 ) & 98 | CALL errore( 'remove_tot_torque', & 99 | 'total torque has not been properly removed', 1 ) 100 | ! 101 | RETURN 102 | ! 103 | CONTAINS 104 | ! 105 | !------------------------------------------------------------------------ 106 | FUNCTION ext_prod( a, b ) 107 | !------------------------------------------------------------------------ 108 | ! 109 | REAL(DP), INTENT(IN) :: a(3), b(3) 110 | REAL(DP) :: ext_prod(3) 111 | ! 112 | ext_prod(1) = a(2)*b(3) - a(3)*b(2) 113 | ext_prod(2) = a(3)*b(1) - a(1)*b(3) 114 | ext_prod(3) = a(1)*b(2) - a(2)*b(1) 115 | ! 116 | END FUNCTION ext_prod 117 | ! 118 | END SUBROUTINE remove_tot_torque 119 | -------------------------------------------------------------------------------- /src/md5.h: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright (C) 1999, 2002 Aladdin Enterprises. All rights reserved. 3 | 4 | This software is provided 'as-is', without any express or implied 5 | warranty. In no event will the authors be held liable for any damages 6 | arising from the use of this software. 7 | 8 | Permission is granted to anyone to use this software for any purpose, 9 | including commercial applications, and to alter it and redistribute it 10 | freely, subject to the following restrictions: 11 | 12 | 1. The origin of this software must not be misrepresented; you must not 13 | claim that you wrote the original software. If you use this software 14 | in a product, an acknowledgment in the product documentation would be 15 | appreciated but is not required. 16 | 2. Altered source versions must be plainly marked as such, and must not be 17 | misrepresented as being the original software. 18 | 3. This notice may not be removed or altered from any source distribution. 19 | 20 | L. Peter Deutsch 21 | ghost@aladdin.com 22 | 23 | */ 24 | /* $Id: md5.h,v 1.1 2010-08-13 10:50:08 degironc Exp $ */ 25 | /* 26 | Independent implementation of MD5 (RFC 1321). 27 | 28 | This code implements the MD5 Algorithm defined in RFC 1321, whose 29 | text is available at 30 | http://www.ietf.org/rfc/rfc1321.txt 31 | The code is derived from the text of the RFC, including the test suite 32 | (section A.5) but excluding the rest of Appendix A. It does not include 33 | any code or documentation that is identified in the RFC as being 34 | copyrighted. 35 | 36 | The original and principal author of md5.h is L. Peter Deutsch 37 | . Other authors are noted in the change history 38 | that follows (in reverse chronological order): 39 | 40 | 2002-04-13 lpd Removed support for non-ANSI compilers; removed 41 | references to Ghostscript; clarified derivation from RFC 1321; 42 | now handles byte order either statically or dynamically. 43 | 1999-11-04 lpd Edited comments slightly for automatic TOC extraction. 44 | 1999-10-18 lpd Fixed typo in header comment (ansi2knr rather than md5); 45 | added conditionalization for C++ compilation from Martin 46 | Purschke . 47 | 1999-05-03 lpd Original version. 48 | */ 49 | 50 | #ifndef md5_INCLUDED 51 | # define md5_INCLUDED 52 | 53 | /* 54 | * This package supports both compile-time and run-time determination of CPU 55 | * byte order. If ARCH_IS_BIG_ENDIAN is defined as 0, the code will be 56 | * compiled to run only on little-endian CPUs; if ARCH_IS_BIG_ENDIAN is 57 | * defined as non-zero, the code will be compiled to run only on big-endian 58 | * CPUs; if ARCH_IS_BIG_ENDIAN is not defined, the code will be compiled to 59 | * run on either big- or little-endian CPUs, but will run slightly less 60 | * efficiently on either one than if ARCH_IS_BIG_ENDIAN is defined. 61 | */ 62 | 63 | typedef unsigned char md5_byte_t; /* 8-bit byte */ 64 | typedef unsigned int md5_word_t; /* 32-bit word */ 65 | 66 | /* Define the state of the MD5 Algorithm. */ 67 | typedef struct md5_state_s { 68 | md5_word_t count[2]; /* message length in bits, lsw first */ 69 | md5_word_t abcd[4]; /* digest buffer */ 70 | md5_byte_t buf[64]; /* accumulate block */ 71 | } md5_state_t; 72 | 73 | #ifdef __cplusplus 74 | extern "C" 75 | { 76 | #endif 77 | 78 | /* Initialize the algorithm. */ 79 | void md5_init(md5_state_t *pms); 80 | 81 | /* Append a string to the message. */ 82 | void md5_append(md5_state_t *pms, const md5_byte_t *data, int nbytes); 83 | 84 | /* Finish the message and return the digest. */ 85 | void md5_finish(md5_state_t *pms, md5_byte_t digest[16]); 86 | 87 | 88 | #ifdef __cplusplus 89 | } /* end extern "C" */ 90 | #endif 91 | 92 | #endif /* md5_INCLUDED */ 93 | -------------------------------------------------------------------------------- /src/rgen.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2010 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | !----------------------------------------------------------------------- 9 | SUBROUTINE rgen ( dtau, rmax, mxr, at, bg, r, r2, nrm) 10 | !----------------------------------------------------------------------- 11 | ! 12 | ! generates neighbours shells (cartesian, in units of lattice parameter) 13 | ! with length < rmax,and returns them in order of increasing length: 14 | ! r(:) = i*a1(:) + j*a2(:) + k*a3(:) - dtau(:), r2 = r^2 15 | ! where a1, a2, a3 are primitive lattice vectors. Other input variables: 16 | ! mxr = maximum number of vectors 17 | ! at = lattice vectors ( a1=at(:,1), a2=at(:,2), a3=at(:,3) ) 18 | ! bg = reciprocal lattice vectors ( b1=bg(:,1), b2=bg(:,2), b3=bg(:,3) ) 19 | ! Other output variables: 20 | ! nrm = the number of vectors with r^2 < rmax^2 21 | ! 22 | USE kinds, ONLY : DP 23 | ! 24 | IMPLICIT NONE 25 | INTEGER, INTENT(in) :: mxr 26 | INTEGER, INTENT(out):: nrm 27 | REAL(DP), INTENT(in) :: at(3,3), bg(3,3), dtau(3), rmax 28 | REAL(DP), INTENT(out):: r(3,mxr), r2(mxr) 29 | ! 30 | ! and here the local variables 31 | ! 32 | INTEGER, ALLOCATABLE :: irr (:) 33 | INTEGER :: nm1, nm2, nm3, i, j, k, ipol, ir, indsw, iswap 34 | real(DP) :: ds(3), dtau0(3) 35 | real(DP) :: t (3), tt, swap 36 | real(DP), EXTERNAL :: dnrm2 37 | ! 38 | ! 39 | nrm = 0 40 | IF (rmax==0.d0) RETURN 41 | 42 | ! bring dtau into the unit cell centered on the origin - prevents trouble 43 | ! if atomic positions are not centered around the origin but displaced 44 | ! far away (remember that translational invariance allows this!) 45 | ! 46 | ds(:) = matmul( dtau(:), bg(:,:) ) 47 | ds(:) = ds(:) - anint(ds(:)) 48 | dtau0(:) = matmul( at(:,:), ds(:) ) 49 | ! 50 | ALLOCATE (irr( mxr)) 51 | ! 52 | ! these are estimates of the maximum values of needed integer indices 53 | ! 54 | nm1 = int (dnrm2 (3, bg (1, 1), 1) * rmax) + 2 55 | nm2 = int (dnrm2 (3, bg (1, 2), 1) * rmax) + 2 56 | nm3 = int (dnrm2 (3, bg (1, 3), 1) * rmax) + 2 57 | ! 58 | DO i = -nm1, nm1 59 | DO j = -nm2, nm2 60 | DO k = -nm3, nm3 61 | tt = 0.d0 62 | DO ipol = 1, 3 63 | t (ipol) = i*at (ipol, 1) + j*at (ipol, 2) + k*at (ipol, 3) & 64 | - dtau0(ipol) 65 | tt = tt + t (ipol) * t (ipol) 66 | ENDDO 67 | IF (tt<=rmax**2.and.abs (tt) >1.d-10) THEN 68 | nrm = nrm + 1 69 | IF (nrm>mxr) CALL errore ('rgen', 'too many r-vectors', nrm) 70 | DO ipol = 1, 3 71 | r (ipol, nrm) = t (ipol) 72 | ENDDO 73 | r2 (nrm) = tt 74 | ENDIF 75 | ENDDO 76 | ENDDO 77 | ENDDO 78 | ! 79 | ! reorder the vectors in order of increasing magnitude 80 | ! 81 | ! initialize the index inside sorting routine 82 | ! 83 | irr (1) = 0 84 | IF (nrm>1) CALL hpsort (nrm, r2, irr) 85 | DO ir = 1, nrm - 1 86 | 20 indsw = irr (ir) 87 | IF (indsw/=ir) THEN 88 | DO ipol = 1, 3 89 | swap = r (ipol, indsw) 90 | r (ipol, indsw) = r (ipol, irr (indsw) ) 91 | r (ipol, irr (indsw) ) = swap 92 | ENDDO 93 | iswap = irr (ir) 94 | irr (ir) = irr (indsw) 95 | irr (indsw) = iswap 96 | GOTO 20 97 | ENDIF 98 | 99 | ENDDO 100 | DEALLOCATE(irr) 101 | ! 102 | RETURN 103 | END SUBROUTINE rgen 104 | 105 | -------------------------------------------------------------------------------- /src/usnldiag.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001 PWSCF group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | !----------------------------------------------------------------------- 10 | subroutine usnldiag (h_diag, s_diag) 11 | !----------------------------------------------------------------------- 12 | ! 13 | ! add nonlocal pseudopotential term to diagonal part of Hamiltonian 14 | ! compute the diagonal part of the S matrix 15 | ! 16 | USE kinds, ONLY: DP 17 | USE ions_base, ONLY : nat, ityp, ntyp => nsp 18 | USE wvfct, ONLY: npw, npwx 19 | USE lsda_mod, ONLY: current_spin 20 | USE uspp, ONLY: deeq, vkb, qq, qq_so, deeq_nc 21 | USE uspp_param, ONLY: upf, nh, newpseudo 22 | USE spin_orb, ONLY: lspinorb 23 | ! 24 | implicit none 25 | 26 | integer, parameter :: npol=1 !substitute for noncollin_module 27 | 28 | ! here the dummy variables 29 | ! 30 | real(DP) :: h_diag (npwx,npol), s_diag (npwx,npol) 31 | ! input/output: the diagonal part of the hamiltonian 32 | ! output: the diagonal part of the S matrix 33 | ! 34 | ! and here the local variables 35 | ! 36 | integer :: ikb, jkb, ih, jh, na, nt, ig, ijkb0, ipol 37 | ! counters 38 | complex(DP) :: ps1(2), ps2(2), ar 39 | ! 40 | ! initialise s_diag 41 | ! 42 | s_diag = 1.d0 43 | ! 44 | ! multiply on projectors 45 | ! 46 | ijkb0 = 0 47 | do nt = 1, ntyp 48 | do na = 1, nat 49 | if (ityp (na) == nt) then 50 | do ih = 1, nh (nt) 51 | ikb = ijkb0 + ih 52 | if (lspinorb) then 53 | ps1(1) = deeq_nc (ih, ih, na, 1) 54 | ps1(2) = deeq_nc (ih, ih, na, 4) 55 | ps2(1) = qq_so(ih, ih, 1, nt) 56 | ps2(2) = qq_so(ih, ih, 4, nt) 57 | else 58 | ps1(1) = deeq (ih, ih, na, current_spin) 59 | ps2(1) = qq (ih, ih, nt) 60 | end if 61 | do ipol =1, npol 62 | do ig = 1, npw 63 | ar = vkb (ig, ikb)*CONJG(vkb (ig, ikb)) 64 | h_diag (ig,ipol) = h_diag (ig,ipol) + ps1(ipol) * ar 65 | s_diag (ig,ipol) = s_diag (ig,ipol) + ps2(ipol) * ar 66 | enddo 67 | enddo 68 | if ( newpseudo (nt) ) then 69 | do jh = 1, nh (nt) 70 | if (jh.ne.ih) then 71 | jkb = ijkb0 + jh 72 | if (lspinorb) then 73 | ps1(1) = deeq_nc (ih, jh, na, 1) 74 | ps1(2) = deeq_nc (ih, jh, na, 4) 75 | ps2(1) = qq_so(ih, jh, 1, nt) 76 | ps2(2) = qq_so(ih, jh, 4, nt) 77 | else 78 | ps1(1) = deeq (ih, jh, na, current_spin) 79 | ps2(1) = qq (ih, jh, nt) 80 | end if 81 | do ipol = 1, npol 82 | do ig = 1, npw 83 | ar = vkb (ig, ikb) *CONJG( vkb (ig, jkb)) 84 | h_diag (ig,ipol) = h_diag (ig,ipol) + & 85 | ps1(ipol) * ar 86 | s_diag (ig,ipol) = s_diag (ig,ipol) + & 87 | ps2(ipol) * ar 88 | enddo 89 | enddo 90 | endif 91 | enddo 92 | endif 93 | enddo 94 | ijkb0 = ijkb0 + nh (nt) 95 | endif 96 | enddo 97 | enddo 98 | 99 | return 100 | end subroutine usnldiag 101 | -------------------------------------------------------------------------------- /src/add_vuspsi.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2003 PWSCF group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | !---------------------------------------------------------------------------- 10 | SUBROUTINE add_vuspsi( lda, n, m, psi, hpsi ) 11 | !---------------------------------------------------------------------------- 12 | ! 13 | ! This routine applies the Ultra-Soft Hamiltonian to a 14 | ! vector psi and puts the result in hpsi. 15 | ! Requires the products of psi with all beta functions 16 | ! in array becp(nkb,m) (calculated by calbec) 17 | ! input: 18 | ! lda leading dimension of arrays psi, spsi 19 | ! n true dimension of psi, spsi 20 | ! m number of states psi 21 | ! output: 22 | ! hpsi V_US|psi> is added to hpsi 23 | ! 24 | USE kinds, ONLY: DP 25 | USE ions_base, ONLY: nat, ntyp => nsp, ityp 26 | USE lsda_mod, ONLY: current_spin 27 | USE uspp, ONLY: vkb, nkb, deeq, deeq_nc 28 | USE uspp_param, ONLY: nh 29 | USE becmod, ONLY : bec_type, becp, calbec 30 | ! 31 | IMPLICIT NONE 32 | ! 33 | ! ... I/O variables 34 | ! 35 | integer, parameter :: npol=1 !subsitute for noncollin_module%npol 36 | INTEGER, INTENT(IN) :: lda, n, m 37 | COMPLEX(DP), INTENT(IN) :: psi(lda*npol,m) 38 | COMPLEX(DP), INTENT(INOUT) :: hpsi(lda*npol,m) 39 | ! 40 | ! ... here the local variables 41 | ! 42 | INTEGER :: jkb, ikb, ih, jh, na, nt, ijkb0, ibnd 43 | ! counters 44 | ! 45 | ! 46 | CALL start_clock( 'add_vuspsi' ) 47 | ! 48 | CALL add_vuspsi_k() 49 | ! 50 | CALL stop_clock( 'add_vuspsi' ) 51 | ! 52 | RETURN 53 | ! 54 | CONTAINS 55 | ! 56 | !----------------------------------------------------------------------- 57 | ! 58 | !----------------------------------------------------------------------- 59 | SUBROUTINE add_vuspsi_k() 60 | !----------------------------------------------------------------------- 61 | ! 62 | IMPLICIT NONE 63 | COMPLEX(DP), ALLOCATABLE :: ps (:,:) 64 | INTEGER :: ierr 65 | ! 66 | IF ( nkb == 0 ) RETURN 67 | ! 68 | ALLOCATE (ps (nkb,m), STAT=ierr ) 69 | IF( ierr /= 0 ) & 70 | CALL errore( ' add_vuspsi_k ', ' cannot allocate ps ', ABS( ierr ) ) 71 | ps(:,:) = ( 0.D0, 0.D0 ) 72 | ! 73 | ijkb0 = 0 74 | ! 75 | 76 | DO ibnd = 1, m 77 | 78 | ! JRD: Compute becp for just this ibnd here 79 | CALL calbec ( n, vkb, psi, becp, ibnd ) 80 | !write(*,*) 'Computing becp', ibnd 81 | 82 | ijkb0 = 0 83 | 84 | DO nt = 1, ntyp 85 | DO na = 1, nat 86 | IF ( ityp(na) == nt ) THEN 87 | 88 | DO jh = 1, nh(nt) 89 | jkb = ijkb0 + jh 90 | 91 | DO ih = 1, nh(nt) 92 | ikb = ijkb0 + ih 93 | ps(ikb,ibnd) = ps(ikb,ibnd) + & 94 | deeq(ih,jh,na,current_spin) * becp%k(jkb) 95 | END DO 96 | END DO 97 | ijkb0 = ijkb0 + nh(nt) 98 | END IF 99 | END DO 100 | END DO 101 | ! 102 | END DO 103 | ! 104 | CALL ZGEMM( 'N', 'N', n, m, nkb, ( 1.D0, 0.D0 ) , vkb, & 105 | lda, ps, nkb, ( 1.D0, 0.D0 ) , hpsi, lda ) 106 | ! 107 | DEALLOCATE (ps) 108 | ! 109 | RETURN 110 | ! 111 | END SUBROUTINE add_vuspsi_k 112 | ! 113 | !----------------------------------------------------------------------- 114 | ! 115 | ! 116 | END SUBROUTINE add_vuspsi 117 | -------------------------------------------------------------------------------- /src/pwscf.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2011 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | !---------------------------------------------------------------------------- 9 | PROGRAM pwscf 10 | !---------------------------------------------------------------------------- 11 | ! 12 | ! ... Plane Wave Self-Consistent Field code 13 | ! 14 | USE io_global, ONLY : stdout, ionode, ionode_id 15 | USE parameters, ONLY : ntypx, npk, lmaxx 16 | USE cell_base, ONLY : fix_volume 17 | USE control_flags, ONLY : conv_elec, lscf 18 | USE control_flags, ONLY : conv_ions, istep, nstep, restart, lmd, lbfgs 19 | USE environment, ONLY : environment_start 20 | USE check_stop, ONLY : check_stop_init 21 | USE mp_global, ONLY : mp_startup, mp_global_end, intra_image_comm 22 | USE mp_global, ONLY : nimage, me_image, root_image, my_image_id 23 | USE io_files, ONLY : tmp_dir 24 | USE image_io_routines, ONLY : io_image_start 25 | USE read_input, ONLY : read_input_file 26 | ! 27 | IMPLICIT NONE 28 | ! 29 | #ifdef __OPENMP 30 | include 'omp_lib.h' 31 | #endif 32 | ! 33 | INTEGER :: ierr 34 | CHARACTER(len=256) :: dirname 35 | ! 36 | #ifdef __HPCTK 37 | call hpctoolkit_sampling_stop(); 38 | #endif 39 | ! 40 | ! 41 | CALL mp_startup ( ) 42 | ! reset IO nodes 43 | ! (do this to make each "image head node" an ionode) 44 | ! Has to be used ONLY to run nimage copies of pwscf 45 | ! 46 | #ifdef __OPENMP 47 | call dfftw_init_threads( omp_get_max_threads() ) 48 | call dfftw_plan_with_nthreads( omp_get_max_threads() ) 49 | #endif 50 | ! 51 | IF ( nimage > 1 ) CALL io_image_start( ) 52 | CALL environment_start ( 'MiniDFT' ) 53 | ! 54 | IF ( ionode ) WRITE( unit = stdout, FMT = 9010 ) & 55 | ntypx, npk, lmaxx 56 | ! 57 | ! 58 | ! ... open, read, close input file 59 | !call MQEoptions_read() 60 | CALL read_input_file ('PW') 61 | ! 62 | ! ... convert to internal variables 63 | ! 64 | CALL iosys() 65 | ! 66 | ! 67 | IF( nimage > 1 ) THEN 68 | ! 69 | ! ... When nimage are used, open a directory for each one 70 | ! ...It has to be done here in order not to disturb NEB like calculations 71 | ! 72 | WRITE( dirname, FMT = '( I5.5 )' ) my_image_id 73 | tmp_dir = TRIM( tmp_dir )//TRIM( dirname )//'/' 74 | ! 75 | END IF 76 | ! 77 | ! 78 | CALL check_stop_init() 79 | ! 80 | ! 81 | CALL setup () 82 | ! 83 | ! 84 | CALL init_run() 85 | ! 86 | CALL MPI_Barrier( intra_image_comm, ierr ) 87 | CALL start_clock( 'Benchmark_Time' ) 88 | #ifdef __HPCTK 89 | call hpctoolkit_sampling_start(); 90 | #endif 91 | #ifdef __IPM 92 | call MPI_Pcontrol( 1, "Benchmark_Time"//char(0)) 93 | #endif 94 | 95 | ! 96 | ! ... electronic self-consistentcy 97 | ! 98 | CALL electrons() 99 | ! 100 | IF ( .NOT. conv_elec ) THEN 101 | CALL stop_run( conv_elec ) 102 | ENDIF 103 | 104 | CALL MPI_Barrier( intra_image_comm, ierr ) 105 | CALL stop_clock( 'Benchmark_Time' ) 106 | ! 107 | #ifdef __IPM 108 | call MPI_Pcontrol( -1, "Benchmark_Time"//char(0)) 109 | #endif 110 | #ifdef __HPCTK 111 | call hpctoolkit_sampling_stop(); 112 | #endif 113 | ! 114 | ! ... save final data file 115 | ! 116 | CALL stop_run( conv_ions ) 117 | #ifdef __OPENMP 118 | call dfftw_cleanup_threads() 119 | #endif 120 | ! 121 | ! END IF 122 | ! 123 | STOP 124 | ! 125 | 9010 FORMAT( /,5X,'Current dimensions of program MiniDFT are:', & 126 | & /,5X,'Max number of different atomic species (ntypx) = ',I2,& 127 | & /,5X,'Max number of k-points (npk) = ',I6,& 128 | & /,5X,'Max angular momentum in pseudopotentials (lmaxx) = ',i2) 129 | ! 130 | END PROGRAM pwscf 131 | -------------------------------------------------------------------------------- /src/init_run.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2006 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | !---------------------------------------------------------------------------- 9 | SUBROUTINE init_run() 10 | !---------------------------------------------------------------------------- 11 | ! 12 | USE klist, ONLY : nkstot, nks 13 | USE symme, ONLY : sym_rho_init 14 | USE wvfct, ONLY : nbnd, et, wg, btype 15 | USE control_flags, ONLY : lmd !!$, gamma_only 16 | USE cell_base, ONLY : at, bg 17 | USE recvec_subs, ONLY : ggen 18 | USE dfunct, ONLY : newd 19 | ! 20 | IMPLICIT NONE 21 | ! 22 | ! 23 | CALL start_clock( 'init_run' ) 24 | ! 25 | ! ... calculate limits of some indices, used in subsequent allocations 26 | ! 27 | CALL pre_init() 28 | ! 29 | ! ... allocate memory for G- and R-space fft arrays 30 | ! 31 | CALL allocate_fft() 32 | ! 33 | ! ... generate reciprocal-lattice vectors and fft indices 34 | ! 35 | CALL ggen ( .false. , at, bg ) 36 | CALL gshells ( .false. ) 37 | ! 38 | ! ... variable initialization for parallel symmetrization 39 | ! 40 | CALL sym_rho_init (.false.) 41 | ! 42 | CALL summary() 43 | ! 44 | #ifndef __IGKIO 45 | if( nks .ne. 1 )then 46 | !bma 20May2013 47 | ! A small amount of file I/O is required for multiple k-points per pool. 48 | ! MiniDFT skips this I/O (a feature), which introduces a bug if nks>1 49 | ! Stop here to count k-points without manually cancelling the job. 50 | ! To enable multiple k-points per pool, recompile with -D__IGKIO 51 | write(*,*) "================================" 52 | write(*,*) "This job uses multiple k-points." 53 | write(*,*) "Please restart with -npool",nkstot 54 | stop 55 | end if 56 | #endif 57 | ! 58 | ! ... allocate memory for all other arrays (potentials, wavefunctions etc) 59 | ! 60 | CALL allocate_nlpot() 61 | CALL allocate_locpot() 62 | CALL allocate_wfc() 63 | ! 64 | CALL memory_report() 65 | ! 66 | ALLOCATE( et( nbnd, nkstot ) , wg( nbnd, nkstot ), btype( nbnd, nkstot ) ) 67 | ! 68 | et(:,:) = 0.D0 69 | wg(:,:) = 0.D0 70 | ! 71 | btype(:,:) = 1 72 | ! 73 | CALL openfil() 74 | ! 75 | CALL hinit0() 76 | ! 77 | CALL potinit() 78 | ! 79 | CALL newd() 80 | ! 81 | CALL wfcinit() 82 | ! 83 | ! 84 | CALL stop_clock( 'init_run' ) 85 | ! 86 | 87 | RETURN 88 | ! 89 | END SUBROUTINE init_run 90 | ! 91 | !---------------------------------------------------------------------------- 92 | SUBROUTINE pre_init() 93 | !---------------------------------------------------------------------------- 94 | ! 95 | USE ions_base, ONLY : nat, nsp, ityp 96 | USE uspp_param, ONLY : upf, lmaxkb, nh, nhm, nbetam 97 | USE uspp, ONLY : nkb, nkbus 98 | IMPLICIT NONE 99 | INTEGER :: na, nt, nb 100 | ! 101 | ! calculate the number of beta functions for each atomic type 102 | ! 103 | lmaxkb = - 1 104 | DO nt = 1, nsp 105 | ! 106 | nh (nt) = 0 107 | ! 108 | ! do not add any beta projector if pseudo in 1/r fmt (AF) 109 | IF ( upf(nt)%tcoulombp ) CYCLE 110 | ! 111 | DO nb = 1, upf(nt)%nbeta 112 | nh (nt) = nh (nt) + 2 * upf(nt)%lll(nb) + 1 113 | lmaxkb = MAX (lmaxkb, upf(nt)%lll(nb) ) 114 | ENDDO 115 | ! 116 | ENDDO 117 | ! 118 | ! calculate the maximum number of beta functions 119 | ! 120 | nhm = MAXVAL (nh (1:nsp)) 121 | nbetam = MAXVAL (upf(:)%nbeta) 122 | ! 123 | ! calculate the number of beta functions of the solid 124 | ! 125 | nkb = 0 126 | nkbus = 0 127 | do na = 1, nat 128 | nt = ityp(na) 129 | nkb = nkb + nh (nt) 130 | enddo 131 | 132 | 133 | END SUBROUTINE pre_init 134 | -------------------------------------------------------------------------------- /src/set_signal.f90: -------------------------------------------------------------------------------- 1 | MODULE set_signal 2 | ! This module is a Fortran 2003 interface to the customize_signals.c C file 3 | ! Compatible with Intel/PGI/Gcc(>=4.3) compilers 4 | 5 | ! This module is compiled only if the following preprocessing option 6 | ! is enabled 7 | #if defined __TRAP_SIGUSR1 8 | 9 | USE iso_c_binding 10 | USE io_global, ONLY : stdout 11 | USE mp_global, ONLY : root, world_comm, mp_bcast, mpime 12 | 13 | IMPLICIT NONE 14 | 15 | LOGICAL,VOLATILE::signal_trapped 16 | 17 | INTERFACE 18 | FUNCTION init_signal_USR1(new_handler) BIND(c, name = "init_signal_USR1") 19 | USE iso_c_binding 20 | TYPE(C_FUNPTR),VALUE,INTENT(IN):: new_handler 21 | INTEGER(C_INT)::init_signal_USR1 22 | END FUNCTION init_signal_USR1 23 | 24 | FUNCTION init_signal(signum, new_handler) BIND(c, name = "init_signal") 25 | USE iso_c_binding 26 | INTEGER(C_INT),VALUE :: signum 27 | TYPE(C_FUNPTR), VALUE,INTENT(IN) :: new_handler 28 | INTEGER(C_INT)::init_signal 29 | END FUNCTION init_signal 30 | 31 | END INTERFACE 32 | 33 | CONTAINS 34 | 35 | SUBROUTINE set_signal_USR1(routine) 36 | USE iso_c_binding 37 | TYPE(C_FUNPTR),TARGET::ptr 38 | INTERFACE 39 | SUBROUTINE routine(signal) bind(C) 40 | USE iso_c_binding 41 | INTEGER(C_INT),VALUE, INTENT(IN)::signal 42 | END SUBROUTINE routine 43 | 44 | END INTERFACE 45 | 46 | ptr = C_FUNLOC(routine) 47 | 48 | IF (init_signal_USR1(ptr) .NE. 0) THEN 49 | CALL errore("set_signal_USR1", "The association of signal USR1 failed!", 1) 50 | ENDIF 51 | 52 | END SUBROUTINE set_signal_USR1 53 | 54 | ! Unused. Here for possible future developments 55 | SUBROUTINE set_signal_action(signal, routine) 56 | USE iso_c_binding 57 | INTEGER::signal 58 | TYPE(C_FUNPTR),TARGET::ptr 59 | INTERFACE 60 | SUBROUTINE routine(signal) bind(C) 61 | USE iso_c_binding 62 | INTEGER(C_INT),VALUE::signal 63 | END SUBROUTINE routine 64 | END INTERFACE 65 | 66 | ptr = C_FUNLOC(routine) 67 | 68 | IF (init_signal(signal, ptr) .NE. 0) THEN 69 | CALL errore("set_signal", "The association of the signal failed!", 1) 70 | ENDIF 71 | END SUBROUTINE set_signal_action 72 | 73 | 74 | ! Sets the signal_trapped flag on all nodes/processors 75 | ! Only the master will use the signal, though 76 | SUBROUTINE custom_handler(signum) BIND(c) 77 | USE iso_c_binding 78 | INTEGER(C_INT),VALUE,INTENT(IN):: signum 79 | WRITE(UNIT = stdout, FMT = *) " **** Trapped signal", signum 80 | signal_trapped = .TRUE. 81 | END SUBROUTINE custom_handler 82 | 83 | 84 | ! Set the signal handler for SIGUSR1 to 'custom_handler' 85 | ! Every processor will trap the signal, howver only 0 will actually 86 | ! use the result (required since the default action for SIGUSR1 is 87 | ! exit) 88 | SUBROUTINE signal_trap_init 89 | USE iso_c_binding 90 | WRITE(UNIT = stdout, FMT=*) " signal trapping enabled: kill the code with -SIGUSR1 to stop cleanly the simulation " 91 | CALL set_signal_USR1(custom_handler) 92 | END SUBROUTINE signal_trap_init 93 | 94 | 95 | FUNCTION signal_detected() 96 | LOGICAL::signal_detected 97 | ! If the signal is trapped, set the exit status and broadcast it 98 | ! DO NOT broadcast the signal_trapped variable or you will be Very 99 | ! Sorry 100 | signal_detected = signal_trapped 101 | 102 | CALL mp_bcast(signal_detected, root, world_comm) 103 | 104 | END FUNCTION signal_detected 105 | 106 | #else 107 | 108 | USE io_global, ONLY : stdout 109 | 110 | CONTAINS 111 | 112 | ! Place holders to employ when the signal trapping feature is disabled 113 | SUBROUTINE signal_trap_init 114 | WRITE(UNIT = stdout, FMT=*) " signal trapping disabled: compile with " 115 | WRITE(UNIT = stdout, FMT=*) " -D__TRAP_SIGUSR1 to enable this feature" 116 | END SUBROUTINE signal_trap_init 117 | 118 | FUNCTION signal_detected() 119 | LOGICAL::signal_detected 120 | signal_detected = .FALSE. 121 | END FUNCTION signal_detected 122 | 123 | #endif 124 | 125 | END MODULE set_signal 126 | -------------------------------------------------------------------------------- /src/allocate_nlpot.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2007 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | !----------------------------------------------------------------------- 10 | subroutine allocate_nlpot 11 | !----------------------------------------------------------------------- 12 | ! 13 | ! This routine computes the dimension of the Hamiltonian matrix and 14 | ! allocates arrays containing the non-local part of the pseudopotential 15 | ! 16 | ! It computes the following global quantities: 17 | ! 18 | ! ngk ! number of plane waves (for each k point) 19 | ! npwx ! maximum number of plane waves 20 | ! nqx ! number of points of the interpolation table 21 | ! nqxq ! as above, for q-function interpolation table 22 | ! 23 | ! 24 | use kinds, only : dp 25 | USE ions_base, ONLY : nat, nsp, ityp 26 | USE cell_base, ONLY : tpiba2 27 | USE gvect, ONLY : ngm, gcutm, g 28 | USE klist, ONLY : xk, wk, ngk, nks, qnorm 29 | USE lsda_mod, ONLY : nspin 30 | USE scf, ONLY : rho 31 | USE wvfct, ONLY : npwx, npw, igk, g2kin, ecutwfc 32 | USE us, ONLY : qrad, tab, tab_d2y, tab_at, dq, nqx, & 33 | nqxq, spline_ps 34 | USE uspp, ONLY : indv, nhtol, nhtolm, ijtoh, qq, dvan, deeq, vkb, & 35 | nkb, nkbus, nhtoj, becsum, qq_so, dvan_so, deeq_nc 36 | USE uspp_param, ONLY : upf, lmaxq, lmaxkb, nh, nhm, nbetam 37 | USE spin_orb, ONLY : lspinorb, fcoef 38 | USE control_flags, ONLY : program_name 39 | USE io_global, ONLY : stdout 40 | ! 41 | implicit none 42 | real(dp), parameter :: cell_factor=1.0_dp 43 | ! a few local variables 44 | ! 45 | integer :: nwfcm 46 | ! counters on atom type, atoms, beta functions 47 | ! 48 | ! calculate number of PWs for all kpoints 49 | ! 50 | allocate (ngk( nks )) 51 | ! 52 | call n_plane_waves (ecutwfc, tpiba2, nks, xk, g, ngm, npwx, ngk) 53 | ! 54 | ! igk relates the index of PW k+G to index in the list of G vector 55 | ! 56 | allocate (igk( npwx ), g2kin ( npwx ) ) 57 | ! 58 | ! Note: computation of the number of beta functions for 59 | ! each atomic type and the maximum number of beta functions 60 | ! and the number of beta functions of the solid has been 61 | ! moved to init_run.f90 : pre_init() 62 | ! 63 | allocate (indv( nhm, nsp)) 64 | allocate (nhtol(nhm, nsp)) 65 | allocate (nhtolm(nhm, nsp)) 66 | allocate (nhtoj(nhm, nsp)) 67 | allocate (ijtoh(nhm, nhm, nsp)) 68 | allocate (deeq( nhm, nhm, nat, nspin)) 69 | allocate (qq( nhm, nhm, nsp)) 70 | if (lspinorb) then 71 | allocate (qq_so(nhm, nhm, 4, nsp)) 72 | allocate (dvan_so( nhm, nhm, nspin, nsp)) 73 | allocate (fcoef(nhm,nhm,2,2,nsp)) 74 | else 75 | allocate (dvan( nhm, nhm, nsp)) 76 | endif 77 | ! 78 | ! This routine is called also by the phonon code, in which case it should 79 | ! allocate an array that includes q+G vectors up to |q+G|_max <= |Gmax|+|q| 80 | ! 81 | nqxq = INT( ( (sqrt(gcutm) + qnorm ) / dq + 4) * cell_factor ) 82 | lmaxq = 2*lmaxkb+1 83 | ! 84 | if (lmaxq > 0) allocate (qrad( nqxq, nbetam*(nbetam+1)/2, lmaxq, nsp)) 85 | if (nkb > 0) allocate (vkb( npwx, nkb)) 86 | allocate (becsum( nhm * (nhm + 1)/2, nat, nspin)) 87 | ! 88 | ! Calculate dimensions for array tab (including a possible factor 89 | ! coming from cell contraction during variable cell relaxation/MD) 90 | ! 91 | nqx = INT( (sqrt (ecutwfc) / dq + 4) * cell_factor ) 92 | 93 | allocate (tab( nqx , nbetam , nsp)) 94 | 95 | ! d2y is for the cubic splines 96 | if (spline_ps) then 97 | allocate (tab_d2y( nqx , nbetam , nsp)) 98 | endif 99 | 100 | nwfcm = MAXVAL ( upf(1:nsp)%nwfc ) 101 | allocate (tab_at( nqx , nwfcm , nsp)) 102 | 103 | return 104 | end subroutine allocate_nlpot 105 | 106 | -------------------------------------------------------------------------------- /src/openfil.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2006 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | !---------------------------------------------------------------------------- 10 | SUBROUTINE openfil() 11 | !---------------------------------------------------------------------------- 12 | ! 13 | ! ... This routine opens some files needed to the self consistent run, 14 | ! ... sets various file names, units, record lengths 15 | ! ... All units are set in Modules/io_files.f90 16 | ! 17 | USE kinds, ONLY : DP 18 | USE io_global, ONLY : stdout 19 | USE basis, ONLY : natomwfc, starting_wfc 20 | USE wvfct, ONLY : nbnd, npwx 21 | USE fixed_occ, ONLY : one_atom_occupations 22 | USE klist, ONLY : nks 23 | USE io_files, ONLY : prefix, iunpun, iunat, iunsat, iunwfc, iunigk, & 24 | nwordwfc, nwordatwfc, iunefield, diropn, & 25 | tmp_dir, wfc_dir, iunefieldm, iunefieldp, seqopn 26 | USE buffers, ONLY : open_buffer, init_buffer 27 | USE control_flags, ONLY : io_level, twfcollect 28 | ! 29 | IMPLICIT NONE 30 | ! 31 | integer, parameter :: npol=1 !substitute for noncollin_module%npol 32 | LOGICAL :: exst 33 | INTEGER :: ierr 34 | CHARACTER(LEN=256) :: tmp_dir_save 35 | ! 36 | ! ... tmp_dir may be replaced by wfc_dir for large files 37 | ! 38 | tmp_dir_save = tmp_dir 39 | ! 40 | IF ( wfc_dir /= 'undefined' ) THEN 41 | ! 42 | WRITE( stdout, '(5X,"writing wfc files to a dedicated directory")' ) 43 | ! 44 | tmp_dir = wfc_dir 45 | ! 46 | END IF 47 | ! 48 | ! ... nwordwfc is the record length (IN COMPLEX WORDS) 49 | ! ... for the direct-access file containing wavefunctions 50 | ! 51 | nwordwfc = nbnd*npwx*npol 52 | ! 53 | ! ... iunwfc=10: read/write wfc from/to file 54 | ! ... iunwfc=-1: copy wfc to/from RAM 55 | ! 56 | IF ( io_level > 0 ) THEN 57 | iunwfc = 10 58 | ELSE 59 | iunwfc = -1 60 | END IF 61 | ! 62 | #ifdef __IGKIO 63 | CALL open_buffer( iunwfc, 'wfc', nwordwfc, nks, exst ) 64 | #endif 65 | ! 66 | IF ( TRIM(starting_wfc) == 'file' .AND. .NOT. exst) THEN 67 | ! 68 | ierr = 1 69 | IF ( twfcollect ) THEN 70 | ! 71 | ! ... wavefunctions are read from the "save" file and rewritten 72 | ! ... (directly in pw_readfile) using the internal format 73 | ! 74 | write(*,*)"openfil.f90:75 skipping pw_readfile, requires iotk" 75 | !CALL pw_readfile( 'wave', ierr ) 76 | ! 77 | !ELSE 78 | ! 79 | ! ... wavefunctions are read into memory 80 | ! 81 | #ifdef __IGKIO 82 | CALL init_buffer ( iunwfc, exst, ierr ) 83 | #endif 84 | ! 85 | END IF 86 | 87 | IF ( ierr > 0 ) THEN 88 | ! 89 | WRITE( stdout, '(5X,"Cannot read wfc : file not found")' ) 90 | ! 91 | starting_wfc = 'atomic' 92 | ! 93 | END IF 94 | ! 95 | END IF 96 | ! 97 | ! ... Needed for LDA+U 98 | ! 99 | ! ... iunat contains the (orthogonalized) atomic wfcs 100 | ! ... iunsat contains the (orthogonalized) atomic wfcs * S 101 | ! ... iunocc contains the atomic occupations computed in new_ns 102 | ! ... it is opened and closed for each reading-writing operation 103 | ! 104 | nwordatwfc = 2*npwx*natomwfc*npol 105 | ! 106 | IF ( one_atom_occupations ) then 107 | CALL diropn( iunat, 'atwfc', nwordatwfc, exst ) 108 | CALL diropn( iunsat, 'satwfc', nwordatwfc, exst ) 109 | END IF 110 | ! 111 | ! ... iunigk contains the number of PW and the indices igk 112 | ! ... Note that unit 15 is reserved for error messages 113 | ! 114 | #ifdef __IGKIO 115 | CALL seqopn( iunigk, 'igk', 'UNFORMATTED', exst ) 116 | #endif 117 | ! 118 | ! ... open units for electric field calculations 119 | ! 120 | ! 121 | tmp_dir = tmp_dir_save 122 | ! 123 | RETURN 124 | ! 125 | END SUBROUTINE openfil 126 | -------------------------------------------------------------------------------- /src/Makefile.base: -------------------------------------------------------------------------------- 1 | 2 | LIBS = $(FFTW_LIBS) $(SCALAPACK_LIBS) $(BLAS_LIBS) 3 | 4 | DFLAGS += -D__FFTW3 -D__MPI -D__SCALAPACK 5 | 6 | CFLAGS += $(DFLAGS) 7 | 8 | FFLAGS += $(FFTW_INCL) $(DFLAGS) 9 | 10 | OBJECTS = \ 11 | kind.o \ 12 | constants.o \ 13 | radial_grids.o \ 14 | atom.o \ 15 | io_global.o \ 16 | parallel_include.o \ 17 | mp.o \ 18 | mp_global.o \ 19 | parser.o \ 20 | parameters.o \ 21 | input_parameters.o \ 22 | io_files.o \ 23 | control_flags.o \ 24 | cell_base.o \ 25 | check_stop.o \ 26 | clocks.o \ 27 | fft_types.o \ 28 | fft_base.o \ 29 | random_numbers.o \ 30 | ions_base.o \ 31 | descriptors.o \ 32 | electrons_base.o \ 33 | version.o \ 34 | environment.o \ 35 | error_handler.o \ 36 | fft_scalar.o \ 37 | fft_custom.o \ 38 | recvec.o \ 39 | pwcom.o \ 40 | stick_base.o \ 41 | stick_set.o \ 42 | data_structure_custom.o \ 43 | fft_parallel.o \ 44 | fft_interfaces.o \ 45 | wrappers.o \ 46 | funct.o \ 47 | griddim.o \ 48 | image_io_routines.o \ 49 | allocate_fft_custom.o \ 50 | ruotaijk.o \ 51 | xk_wk_collect.o \ 52 | mp_base.o \ 53 | mp_wave.o \ 54 | mp_image_global_module.o \ 55 | pseudo_types.o \ 56 | zhpev_drv.o \ 57 | ptoolkit.o \ 58 | read_cards.o \ 59 | read_namelists.o \ 60 | uspp.o \ 61 | upf_nml.o \ 62 | upf.o \ 63 | upf_to_internal.o \ 64 | read_pseudo.o \ 65 | recvec_subs.o \ 66 | run_info.o \ 67 | set_signal.o \ 68 | splinelib.o \ 69 | wavefunctions.o \ 70 | \ 71 | c_mkdir.o \ 72 | cptimer.o \ 73 | customize_signals.o \ 74 | eval_infix.o \ 75 | fft_stick.o \ 76 | md5.o \ 77 | md5_from_file.o \ 78 | memstat.o \ 79 | stack.o \ 80 | \ 81 | atomic_number.o \ 82 | capital.o \ 83 | cryst_to_car.o \ 84 | date_and_tim.o \ 85 | distools.o \ 86 | erf.o \ 87 | find_free_unit.o \ 88 | flush_unit.o \ 89 | functionals.o \ 90 | inpfile.o \ 91 | int_to_char.o \ 92 | invmat.o \ 93 | latgen.o \ 94 | lsda_functionals.o \ 95 | matches.o \ 96 | recips.o \ 97 | remove_tot_torque.o \ 98 | rgen.o \ 99 | simpsn.o \ 100 | sort.o \ 101 | sph_bes.o \ 102 | trimcheck.o \ 103 | volume.o \ 104 | ylmr2.o \ 105 | \ 106 | symm_base.o \ 107 | start_k.o \ 108 | scf_mod.o \ 109 | a2fmod.o \ 110 | buffers.o \ 111 | becmod.o \ 112 | add_vuspsi.o \ 113 | allocate_fft.o \ 114 | allocate_locpot.o \ 115 | allocate_nlpot.o \ 116 | allocate_wfc.o \ 117 | atomic_rho.o \ 118 | atomic_wfc.o \ 119 | g_psi_mod.o \ 120 | c_bands.o \ 121 | ccgdiagg.o \ 122 | cdiaghg.o \ 123 | cegterg.o \ 124 | symme.o \ 125 | close_files.o \ 126 | coset.o \ 127 | data_structure.o \ 128 | deriv_drhoc.o \ 129 | divide.o \ 130 | divide_et_impera.o \ 131 | drhoc.o \ 132 | dvloc_of_g.o \ 133 | compute_deff.o \ 134 | newd.o \ 135 | coulomb_vcut.o \ 136 | exx.o \ 137 | clean_pw.o \ 138 | input.o \ 139 | electrons.o \ 140 | eqvect.o \ 141 | ewald.o \ 142 | g2_kin.o \ 143 | g_psi.o \ 144 | gk_sort.o \ 145 | gradcorr.o \ 146 | h_1psi.o \ 147 | h_psi.o \ 148 | hinit0.o \ 149 | init_at_1.o \ 150 | openfil.o \ 151 | init_run.o \ 152 | init_us_1.o \ 153 | init_us_2.o \ 154 | init_vloc.o \ 155 | interpolate.o \ 156 | irrek.o \ 157 | iweights.o \ 158 | kpoint_grid.o \ 159 | lchk_tauxk.o \ 160 | memory_report.o \ 161 | mix_rho.o \ 162 | multable.o \ 163 | n_plane_waves.o \ 164 | para.o \ 165 | potinit.o \ 166 | print_clock_pw.o \ 167 | print_ks_energies.o \ 168 | read_input.o \ 169 | pwscf.o \ 170 | remove_atomic_rho.o \ 171 | rotate_wfc.o \ 172 | rotate_wfc_k.o \ 173 | s_1psi.o \ 174 | s_psi.o \ 175 | set_kup_and_kdw.o \ 176 | set_rhoc.o \ 177 | set_vrs.o \ 178 | setlocal.o \ 179 | setup.o \ 180 | stop_run.o \ 181 | struct_fact.o \ 182 | sum_band.o \ 183 | summary.o \ 184 | usnldiag.o \ 185 | v_of_rho.o \ 186 | vloc_of_g.o \ 187 | vloc_psi.o \ 188 | weights.o \ 189 | wfcinit.o 190 | 191 | 192 | all: mini_dft $(if $(USE_HPCTK), mini_dft.hpcstruct) 193 | 194 | %.o : %.f90 195 | $(FC) $(FFLAGS) -c $< 196 | 197 | mini_dft: $(OBJECTS) 198 | $(LD) $(LDFLAGS) -o $@ $(OBJECTS) $(LIBS) $(IPM) 199 | -rm -f mini_dft.hpcstruct 200 | 201 | mini_dft.hpcstruct: mini_dft 202 | hpcstruct $< 203 | 204 | .PHONY = clean 205 | clean: 206 | -rm -f *~ *.o *.mod mini_dft 207 | 208 | .PHONY = tarball 209 | tarball: 210 | tar -czf mini_dft.tar.gz Makefile *.UPF *.UPF.nml *.h *.c *.f *.f90 211 | -------------------------------------------------------------------------------- /src/dvloc_of_g.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2007 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | !---------------------------------------------------------------------- 10 | subroutine dvloc_of_g (mesh, msh, rab, r, vloc_at, zp, tpiba2, ngl, gl, & 11 | omega, dvloc) 12 | !---------------------------------------------------------------------- 13 | ! 14 | ! dvloc = D Vloc (g^2) / D g^2 = (1/2g) * D Vloc(g) / D g 15 | ! 16 | USE kinds 17 | USE constants , ONLY : pi, fpi, e2, eps8 18 | implicit none 19 | ! 20 | ! first the dummy variables 21 | ! 22 | integer, intent(in) :: ngl, mesh, msh 23 | ! the number of shell of G vectors 24 | ! max number of mesh points 25 | ! number of mesh points for radial integration 26 | 27 | real(DP), intent(in) :: zp, rab (mesh), r (mesh), vloc_at (mesh), & 28 | tpiba2, omega, gl (ngl) 29 | ! valence pseudocharge 30 | ! the derivative of the radial grid 31 | ! the radial grid 32 | ! the pseudo on the radial grid 33 | ! 2 pi / alat 34 | ! the volume of the unit cell 35 | ! the moduli of g vectors for each s 36 | ! 37 | real(DP), intent(out) :: dvloc (ngl) 38 | ! the fourier transform dVloc/dG 39 | ! 40 | real(DP) :: vlcp, g2a, gx 41 | real(DP), allocatable :: aux (:), aux1 (:) 42 | real(DP), external :: qe_erf 43 | 44 | integer :: i, igl, igl0 45 | ! counter on erf functions or gaussians 46 | ! counter on g shells vectors 47 | ! first shell with g != 0 48 | 49 | ! the G=0 component is not computed 50 | if (gl (1) < eps8) then 51 | dvloc (1) = 0.0d0 52 | igl0 = 2 53 | else 54 | igl0 = 1 55 | endif 56 | 57 | ! Pseudopotentials in numerical form (Vloc contains the local part) 58 | ! In order to perform the Fourier transform, a term erf(r)/r is 59 | ! subtracted in real space and added again in G space 60 | 61 | allocate (aux( mesh)) 62 | allocate (aux1( mesh)) 63 | ! 64 | ! This is the part of the integrand function 65 | ! indipendent of |G| in real space 66 | ! 67 | do i = 1, msh 68 | aux1 (i) = r (i) * vloc_at (i) + zp * e2 * qe_erf (r (i) ) 69 | enddo 70 | do igl = igl0, ngl 71 | gx = sqrt (gl (igl) * tpiba2) 72 | ! 73 | ! and here we perform the integral, after multiplying for the |G| 74 | ! dependent part 75 | ! 76 | ! DV(g)/Dg = Integral of r (Dj_0(gr)/Dg) V(r) dr 77 | do i = 1, msh 78 | aux (i) = aux1 (i) * (r (i) * cos (gx * r (i) ) / gx - sin (gx & 79 | * r (i) ) / gx**2) 80 | enddo 81 | call simpson (msh, aux, rab, vlcp) 82 | ! DV(g^2)/Dg^2 = (DV(g)/Dg)/2g 83 | vlcp = fpi / omega / 2.0d0 / gx * vlcp 84 | ! subtract the long-range term 85 | g2a = gl (igl) * tpiba2 / 4.d0 86 | vlcp = vlcp + fpi / omega * zp * e2 * exp ( - g2a) * (g2a + & 87 | 1.d0) / (gl (igl) * tpiba2) **2 88 | dvloc (igl) = vlcp 89 | enddo 90 | deallocate (aux1) 91 | deallocate (aux) 92 | 93 | return 94 | end subroutine dvloc_of_g 95 | ! 96 | !---------------------------------------------------------------------- 97 | subroutine dvloc_coul (zp, tpiba2, ngl, gl, omega, dvloc) 98 | !---------------------------------------------------------------------- 99 | ! 100 | ! Fourier transform of the Coulomb potential - For all-electron 101 | ! calculations, in specific cases only, for testing purposes 102 | ! 103 | USE kinds 104 | USE constants , ONLY : fpi, e2, eps8 105 | implicit none 106 | ! 107 | integer, intent(in) :: ngl 108 | ! the number of shell of G vectors 109 | real(DP), intent(in) :: zp, tpiba2, omega, gl (ngl) 110 | ! valence pseudocharge 111 | ! 2 pi / alat 112 | ! the volume of the unit cell 113 | ! the moduli of g vectors for each s 114 | real(DP), intent(out) :: dvloc (ngl) 115 | ! fourier transform: dvloc = D Vloc (g^2) / D g^2 = 4pi e^2/omegai /G^4 116 | ! 117 | integer :: igl0 118 | ! first shell with g != 0 119 | 120 | ! the G=0 component is 0 121 | if (gl (1) < eps8) then 122 | dvloc (1) = 0.0d0 123 | igl0 = 2 124 | else 125 | igl0 = 1 126 | endif 127 | 128 | dvloc (igl0:ngl) = fpi * zp * e2 / omega / ( tpiba2 * gl (igl0:ngl) ) ** 2 129 | 130 | return 131 | end subroutine dvloc_coul 132 | 133 | -------------------------------------------------------------------------------- /src/io_global.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2002-2004 FPMD & PWSCF group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | !---------------------------------------------------------------------------- 9 | MODULE io_global 10 | !---------------------------------------------------------------------------- 11 | ! 12 | IMPLICIT NONE 13 | ! 14 | PRIVATE 15 | SAVE 16 | ! 17 | PUBLIC :: io_global_start, meta_io_global_start, io_global_getionode, io_global_getmeta 18 | PUBLIC :: stdout, ionode, ionode_id, meta_ionode, meta_ionode_id 19 | PUBLIC :: xmlinputunit, xmloutputunit, xmltmpunit 20 | ! 21 | INTEGER :: stdout = 6 ! unit connected to standard output 22 | INTEGER :: ionode_id = 0 ! index of the i/o node 23 | LOGICAL :: ionode = .TRUE. ! identifies the i/o node 24 | INTEGER :: meta_ionode_id = 0 ! index of the i/o node for meta-codes 25 | LOGICAL :: meta_ionode = .TRUE. ! identifies the i/o node for meta-codes 26 | LOGICAL :: first = .TRUE. 27 | INTEGER :: xmlinputunit ! unit connected to the xml input 28 | INTEGER :: xmloutputunit = 51 ! unit connected to the xml output 29 | INTEGER :: xmltmpunit = 52 ! unit connected to the temp xml output 30 | ! 31 | CONTAINS 32 | ! 33 | !----------------------------------------------------------------------- 34 | SUBROUTINE io_global_start( mpime, ionode_set ) 35 | !----------------------------------------------------------------------- 36 | ! 37 | IMPLICIT NONE 38 | ! 39 | INTEGER, INTENT(IN) :: mpime, ionode_set 40 | ! 41 | ! 42 | IF ( mpime == ionode_set ) THEN 43 | ! 44 | ionode = .TRUE. 45 | ! 46 | ELSE 47 | ! 48 | ionode = .FALSE. 49 | ! 50 | END IF 51 | ! 52 | ionode_id = ionode_set 53 | ! 54 | first = .FALSE. 55 | ! 56 | RETURN 57 | ! 58 | END SUBROUTINE io_global_start 59 | ! 60 | !----------------------------------------------------------------------- 61 | SUBROUTINE meta_io_global_start( mpime, ionode_set ) 62 | !----------------------------------------------------------------------- 63 | ! 64 | IMPLICIT NONE 65 | ! 66 | INTEGER, INTENT(IN) :: mpime, ionode_set 67 | ! 68 | ! 69 | IF ( mpime == ionode_set ) THEN 70 | ! 71 | meta_ionode = .TRUE. 72 | ! 73 | ELSE 74 | ! 75 | meta_ionode = .FALSE. 76 | ! 77 | END IF 78 | ! 79 | meta_ionode_id = ionode_set 80 | ! 81 | first = .FALSE. 82 | ! 83 | RETURN 84 | ! 85 | END SUBROUTINE meta_io_global_start 86 | ! 87 | ! 88 | ! 89 | !----------------------------------------------------------------------- 90 | SUBROUTINE io_global_getionode( ionode_out, ionode_id_out ) 91 | !----------------------------------------------------------------------- 92 | ! 93 | IMPLICIT NONE 94 | ! 95 | LOGICAL, INTENT(OUT) :: ionode_out 96 | INTEGER, INTENT(OUT) :: ionode_id_out 97 | ! 98 | ! 99 | IF ( first ) & 100 | CALL errore( ' io_global_getionode ', ' ionode not yet defined ', 1 ) 101 | ! 102 | ionode_out = ionode 103 | ionode_id_out = ionode_id 104 | ! 105 | RETURN 106 | ! 107 | END SUBROUTINE io_global_getionode 108 | ! 109 | ! 110 | !----------------------------------------------------------------------- 111 | SUBROUTINE io_global_getmeta( myrank, root ) 112 | !----------------------------------------------------------------------- 113 | ! 114 | ! ... writes in module variables meta_ionode_id and meta_ionode 115 | ! 116 | IMPLICIT NONE 117 | ! 118 | INTEGER, INTENT(IN) :: myrank, root 119 | ! 120 | ! 121 | IF(myrank == root) THEN 122 | ! 123 | meta_ionode = .true. 124 | ! 125 | ELSE 126 | meta_ionode = .false. 127 | ! 128 | ENDIF 129 | ! 130 | meta_ionode_id = root 131 | ! 132 | RETURN 133 | ! 134 | END SUBROUTINE io_global_getmeta 135 | ! 136 | ! 137 | END MODULE io_global 138 | -------------------------------------------------------------------------------- /src/ylmr2.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2007 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | !----------------------------------------------------------------------- 9 | subroutine ylmr2 (lmax2, ng, g, gg, ylm) 10 | !----------------------------------------------------------------------- 11 | ! 12 | ! Real spherical harmonics ylm(G) up to l=lmax 13 | ! lmax2 = (lmax+1)^2 is the total number of spherical harmonics 14 | ! Numerical recursive algorithm based on the one given in Numerical 15 | ! Recipes but avoiding the calculation of factorials that generate 16 | ! overflow for lmax > 11 17 | ! 18 | USE kinds, ONLY : DP 19 | USE constants, ONLY : pi, fpi 20 | implicit none 21 | ! 22 | integer, intent(in) :: lmax2, ng 23 | real(DP), intent(in) :: g (3, ng), gg (ng) 24 | ! 25 | ! BEWARE: gg = g(1)^2 + g(2)^2 +g(3)^2 is not checked on input 26 | ! incorrect results will ensue if the above does not hold 27 | ! 28 | real(DP), intent(out) :: ylm (ng,lmax2) 29 | ! 30 | ! local variables 31 | ! 32 | real(DP), parameter :: eps = 1.0d-9 33 | real(DP), allocatable :: cost (:), sent(:), phi (:), Q(:,:,:) 34 | real(DP) :: c, gmod 35 | integer :: lmax, ig, l, m, lm 36 | ! 37 | if (ng < 1 .or. lmax2 < 1) return 38 | do lmax = 0, 25 39 | if ((lmax+1)**2 == lmax2) go to 10 40 | end do 41 | call errore (' ylmr', 'l > 25 or wrong number of Ylm required',lmax2) 42 | 10 continue 43 | 44 | ! 45 | if (lmax == 0) then 46 | ylm(:,1) = sqrt (1.d0 / fpi) 47 | return 48 | end if 49 | ! 50 | ! theta and phi are polar angles, cost = cos(theta) 51 | ! 52 | allocate(cost(ng), sent(ng), phi(ng), Q(ng,0:lmax,0:lmax) ) 53 | ! 54 | !$omp parallel default(shared), private(ig,gmod,lm,l,c,m) 55 | 56 | !$omp do 57 | do ig = 1, ng 58 | gmod = sqrt (gg (ig) ) 59 | if (gmod < eps) then 60 | cost(ig) = 0.d0 61 | else 62 | cost(ig) = g(3,ig)/gmod 63 | endif 64 | ! 65 | ! beware the arc tan, it is defined modulo pi 66 | ! 67 | if (g(1,ig) > eps) then 68 | phi (ig) = atan( g(2,ig)/g(1,ig) ) 69 | else if (g(1,ig) < -eps) then 70 | phi (ig) = atan( g(2,ig)/g(1,ig) ) + pi 71 | else 72 | phi (ig) = sign( pi/2.d0,g(2,ig) ) 73 | end if 74 | sent(ig) = sqrt(max(0d0,1.d0-cost(ig)**2)) 75 | enddo 76 | ! 77 | ! Q(:,l,m) are defined as sqrt ((l-m)!/(l+m)!) * P(:,l,m) where 78 | ! P(:,l,m) are the Legendre Polynomials (0 <= m <= l) 79 | ! 80 | lm = 0 81 | do l = 0, lmax 82 | c = sqrt (DBLE(2*l+1) / fpi) 83 | if ( l == 0 ) then 84 | !$omp do 85 | do ig = 1, ng 86 | Q (ig,0,0) = 1.d0 87 | end do 88 | else if ( l == 1 ) then 89 | !$omp do 90 | do ig = 1, ng 91 | Q (ig,1,0) = cost(ig) 92 | Q (ig,1,1) =-sent(ig)/sqrt(2.d0) 93 | end do 94 | else 95 | ! 96 | ! recursion on l for Q(:,l,m) 97 | ! 98 | do m = 0, l - 2 99 | !$omp do 100 | do ig = 1, ng 101 | Q(ig,l,m) = cost(ig)*(2*l-1)/sqrt(DBLE(l*l-m*m))*Q(ig,l-1,m) & 102 | - sqrt(DBLE((l-1)*(l-1)-m*m))/sqrt(DBLE(l*l-m*m))*Q(ig,l-2,m) 103 | end do 104 | end do 105 | !$omp do 106 | do ig = 1, ng 107 | Q(ig,l,l-1) = cost(ig) * sqrt(DBLE(2*l-1)) * Q(ig,l-1,l-1) 108 | end do 109 | !$omp do 110 | do ig = 1, ng 111 | Q(ig,l,l) = - sqrt(DBLE(2*l-1))/sqrt(DBLE(2*l))*sent(ig)*Q(ig,l-1,l-1) 112 | end do 113 | end if 114 | ! 115 | ! Y_lm, m = 0 116 | ! 117 | lm = lm + 1 118 | !$omp do 119 | do ig = 1, ng 120 | ylm(ig, lm) = c * Q(ig,l,0) 121 | end do 122 | ! 123 | do m = 1, l 124 | ! 125 | ! Y_lm, m > 0 126 | ! 127 | lm = lm + 1 128 | !$omp do 129 | do ig = 1, ng 130 | ylm(ig, lm) = c * sqrt(2.d0) * Q(ig,l,m) * cos (m*phi(ig)) 131 | end do 132 | ! 133 | ! Y_lm, m < 0 134 | ! 135 | lm = lm + 1 136 | !$omp do 137 | do ig = 1, ng 138 | ylm(ig, lm) = c * sqrt(2.d0) * Q(ig,l,m) * sin (m*phi(ig)) 139 | end do 140 | end do 141 | end do 142 | ! 143 | !$omp end parallel 144 | ! 145 | deallocate(cost, sent, phi, Q) 146 | ! 147 | return 148 | end subroutine ylmr2 149 | 150 | -------------------------------------------------------------------------------- /src/vloc_of_g.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2007 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | ! 9 | !---------------------------------------------------------------------- 10 | subroutine vloc_of_g (mesh, msh, rab, r, vloc_at, zp, tpiba2, ngl, & 11 | gl, omega, vloc) 12 | !---------------------------------------------------------------------- 13 | ! 14 | ! This routine computes the Fourier transform of the local 15 | ! part of an atomic pseudopotential, given in numerical form. 16 | ! A term erf(r)/r is subtracted in real space (thus making the 17 | ! function short-ramged) and added again in G space (for G<>0) 18 | ! The G=0 term contains \int (V_loc(r)+ Ze^2/r) 4pi r^2 dr. 19 | ! This is the "alpha" in the so-called "alpha Z" term of the energy. 20 | ! Atomic Ry units everywhere. 21 | ! 22 | USE kinds 23 | USE constants, ONLY : pi, fpi, e2, eps8 24 | implicit none 25 | ! 26 | ! first the dummy variables 27 | ! 28 | integer, intent(in) :: ngl, mesh, msh 29 | ! ngl : the number of shells of G vectors 30 | ! mesh: number of grid points in the radial grid 31 | ! msh : as above, used for radial integration 32 | ! 33 | real(DP), intent(in) :: zp, rab (mesh), r (mesh), vloc_at (mesh), tpiba2, & 34 | omega, gl (ngl) 35 | ! zp : valence pseudocharge 36 | ! rab: the derivative of mesh points 37 | ! r : the mesh points 38 | ! vloc_at: local part of the atomic pseudopotential on the radial mesh 39 | ! tpiba2 : 2 pi / alat 40 | ! omega : the volume of the unit cell 41 | ! gl : the moduli of g vectors for each shell 42 | ! 43 | real(DP), intent(out):: vloc (ngl) 44 | ! 45 | ! vloc: the fourier transform of the potential 46 | ! 47 | ! local variables 48 | ! 49 | real(DP) :: vlcp, fac, gx 50 | real(DP), allocatable :: aux (:), aux1 (:) 51 | integer :: igl, igl0, ir 52 | ! igl :counter on g shells vectors 53 | ! igl0:first shell with g != 0 54 | ! ir :counter on mesh points 55 | ! 56 | real(DP), external :: qe_erf 57 | ! 58 | allocate ( aux(msh), aux1(msh) ) 59 | if (gl (1) < eps8) then 60 | ! 61 | ! first the G=0 term 62 | ! 63 | do ir = 1, msh 64 | aux (ir) = r (ir) * (r (ir) * vloc_at (ir) + zp * e2) 65 | enddo 66 | call simpson (msh, aux, rab, vlcp) 67 | vloc (1) = vlcp 68 | igl0 = 2 69 | else 70 | igl0 = 1 71 | endif 72 | ! 73 | ! here the G<>0 terms, we first compute the part of the integrand 74 | ! function independent of |G| in real space 75 | ! 76 | do ir = 1, msh 77 | aux1 (ir) = r (ir) * vloc_at (ir) + zp * e2 * qe_erf (r (ir) ) 78 | enddo 79 | fac = zp * e2 / tpiba2 80 | ! 81 | ! and here we perform the integral, after multiplying for the |G| 82 | ! dependent part 83 | ! 84 | do igl = igl0, ngl 85 | gx = sqrt (gl (igl) * tpiba2) 86 | do ir = 1, msh 87 | aux (ir) = aux1 (ir) * sin (gx * r (ir) ) / gx 88 | enddo 89 | call simpson (msh, aux, rab, vlcp) 90 | ! 91 | ! here we re-add the analytic fourier transform of the erf function 92 | ! 93 | vlcp = vlcp - fac * exp ( - gl (igl) * tpiba2 * 0.25d0) / gl (igl) 94 | vloc (igl) = vlcp 95 | enddo 96 | vloc (:) = vloc(:) * fpi / omega 97 | deallocate (aux, aux1) 98 | 99 | return 100 | end subroutine vloc_of_g 101 | ! 102 | !---------------------------------------------------------------------- 103 | subroutine vloc_coul (zp, tpiba2, ngl, gl, omega, vloc) 104 | !---------------------------------------------------------------------- 105 | ! 106 | ! Fourier transform of the Coulomb potential - For all-electron 107 | ! calculations, in specific cases only, for testing purposes 108 | ! 109 | USE kinds 110 | USE constants, ONLY : fpi, e2, eps8 111 | implicit none 112 | ! 113 | integer, intent(in) :: ngl 114 | ! the number of shells of G vectors 115 | real(DP), intent(in) :: zp, tpiba2, omega, gl (ngl) 116 | ! valence pseudocharge 117 | ! 2 pi / alat 118 | ! the volume of the unit cell 119 | ! the moduli of g vectors for each shell 120 | real(DP), intent (out) :: vloc (ngl) 121 | ! the fourier transform of the potential 122 | ! 123 | integer :: igl0 124 | ! 125 | if (gl (1) < eps8) then 126 | igl0 = 2 127 | vloc(1) = 0.0_dp 128 | else 129 | igl0 = 1 130 | endif 131 | 132 | vloc (igl0:ngl) = - fpi * zp *e2 / omega / tpiba2 / gl (igl0:ngl) 133 | 134 | return 135 | end subroutine vloc_coul 136 | 137 | -------------------------------------------------------------------------------- /src/print_clock_pw.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001-2006 Quantum ESPRESSO group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | !---------------------------------------------------------------------------- 9 | SUBROUTINE print_clock_pw() 10 | !--------------------------------------------------------------------------- 11 | ! 12 | ! ... this routine prints out the clocks at the end of the run 13 | ! ... it tries to construct the calling tree of the program. 14 | ! 15 | USE io_global, ONLY : stdout 16 | USE control_flags, ONLY : isolve, iverbosity 17 | ! 18 | IMPLICIT NONE 19 | ! 20 | ! 21 | WRITE( stdout, * ) 22 | ! 23 | CALL print_clock( 'init_run' ) 24 | CALL print_clock( 'electrons' ) 25 | CALL print_clock( 'update_pot' ) 26 | CALL print_clock( 'forces' ) 27 | CALL print_clock( 'stress' ) 28 | ! 29 | WRITE( stdout, '(/5x,"Called by init_run:")' ) 30 | CALL print_clock( 'wfcinit' ) 31 | CALL print_clock( 'potinit' ) 32 | CALL print_clock( 'realus' ) 33 | IF ( iverbosity > 0 ) THEN 34 | CALL print_clock( 'realus:boxes' ) 35 | CALL print_clock( 'realus:spher' ) 36 | CALL print_clock( 'realus:qsave' ) 37 | END IF 38 | ! 39 | WRITE( stdout, '(/5x,"Called by electrons:")' ) 40 | CALL print_clock( 'c_bands' ) 41 | CALL print_clock( 'sum_band' ) 42 | CALL print_clock( 'v_of_rho' ) 43 | IF ( iverbosity > 0 ) THEN 44 | CALL print_clock( 'v_h' ) 45 | CALL print_clock( 'v_xc' ) 46 | CALL print_clock( 'v_xc_meta' ) 47 | END IF 48 | CALL print_clock( 'newd' ) 49 | IF ( iverbosity > 0 ) THEN 50 | CALL print_clock( 'newd:fftvg' ) 51 | CALL print_clock( 'newd:qvan2' ) 52 | CALL print_clock( 'newd:int1' ) 53 | CALL print_clock( 'newd:int2' ) 54 | END IF 55 | CALL print_clock( 'mix_rho' ) 56 | 57 | CALL print_clock( 'vdW_energy' ) 58 | CALL print_clock( 'vdW_ffts' ) 59 | CALL print_clock( 'vdW_v' ) 60 | 61 | ! 62 | WRITE( stdout, '(/5x,"Called by c_bands:")' ) 63 | CALL print_clock( 'init_us_2' ) 64 | IF ( isolve == 0 ) THEN 65 | !!$ IF ( gamma_only ) THEN 66 | CALL print_clock( 'cegterg' ) 67 | !!$ ENDIF 68 | ELSE 69 | CALL print_clock( 'ccgdiagg' ) 70 | CALL print_clock( 'wfcrot' ) 71 | ENDIF 72 | ! 73 | IF ( iverbosity > 0) THEN 74 | WRITE( stdout, '(/5x,"Called by sum_band:")' ) 75 | CALL print_clock( 'sum_band:becsum' ) 76 | CALL print_clock( 'addusdens' ) 77 | CALL print_clock( 'addus:qvan2' ) 78 | CALL print_clock( 'addus:strf' ) 79 | CALL print_clock( 'addus:aux2' ) 80 | CALL print_clock( 'addus:aux' ) 81 | ENDIF 82 | ! 83 | IF ( isolve == 0 ) THEN 84 | WRITE( stdout, '(/5x,"Called by *egterg:")' ) 85 | ELSE 86 | WRITE( stdout, '(/5x,"Called by *cgdiagg:")' ) 87 | END IF 88 | ! 89 | CALL print_clock( 'h_psi' ) 90 | CALL print_clock( 's_psi' ) 91 | CALL print_clock( 'g_psi' ) 92 | CALL print_clock( 'cdiaghg' ) 93 | IF ( iverbosity > 0 ) THEN 94 | CALL print_clock( 'cegterg:overlap' ) 95 | CALL print_clock( 'cegterg:update' ) 96 | CALL print_clock( 'cegterg:last' ) 97 | CALL print_clock( 'cdiaghg:choldc' ) 98 | CALL print_clock( 'cdiaghg:inversion' ) 99 | CALL print_clock( 'cdiaghg:paragemm' ) 100 | END IF 101 | ! 102 | WRITE( stdout, '(/5x,"Called by h_psi:")' ) 103 | IF ( iverbosity > 0 ) THEN 104 | CALL print_clock( 'h_psi:init' ) 105 | CALL print_clock( 'h_psi:vloc' ) 106 | CALL print_clock( 'h_psi:vnl' ) 107 | END IF 108 | CALL print_clock( 'add_vuspsi' ) 109 | CALL print_clock( 'h_psi_meta' ) 110 | ! 111 | WRITE( stdout, '(/5X,"General routines")' ) 112 | ! 113 | CALL print_clock( 'calbec' ) 114 | CALL print_clock( 'fft' ) 115 | CALL print_clock( 'ffts' ) 116 | CALL print_clock( 'fftw' ) 117 | CALL print_clock( 'interpolate' ) 118 | CALL print_clock( 'davcio' ) 119 | ! 120 | WRITE( stdout, * ) 121 | ! 122 | WRITE( stdout, '(5X,"Parallel routines")' ) 123 | ! 124 | CALL print_clock( 'reduce' ) 125 | CALL print_clock( 'fft_scatter' ) 126 | CALL print_clock( 'ALLTOALL' ) 127 | ! 128 | WRITE( stdout, '(5X,"EXX routines")' ) 129 | ! 130 | CALL print_clock( 'exx_grid' ) 131 | CALL print_clock( 'exxinit' ) 132 | CALL print_clock( 'vexx' ) 133 | !CALL print_clock( 'vexx_ngmloop' ) 134 | CALL print_clock( 'exxenergy' ) 135 | CALL print_clock( 'exxen2' ) 136 | !CALL print_clock( 'exxen2_ngmloop' ) 137 | CALL print_clock ('cycleig') 138 | ! 139 | ! 140 | RETURN 141 | ! 142 | END SUBROUTINE print_clock_pw 143 | -------------------------------------------------------------------------------- /src/simpsn.f90: -------------------------------------------------------------------------------- 1 | ! 2 | ! Copyright (C) 2001 PWSCF group 3 | ! This file is distributed under the terms of the 4 | ! GNU General Public License. See the file `License' 5 | ! in the root directory of the present distribution, 6 | ! or http://www.gnu.org/copyleft/gpl.txt . 7 | ! 8 | !----------------------------------------------------------------------- 9 | subroutine simpson (mesh, func, rab, asum) 10 | !----------------------------------------------------------------------- 11 | ! 12 | ! simpson's rule integration. On input: 13 | ! mesh = mhe number of grid points (should be odd) 14 | ! func(i)= function to be integrated 15 | ! rab(i) = r(i) * dr(i)/di * di 16 | ! For the logarithmic grid not including r=0 : 17 | ! r(i) = r_0*exp((i-1)*dx) ==> rab(i)=r(i)*dx 18 | ! For the logarithmic grid including r=0 : 19 | ! r(i) = a(exp((i-1)*dx)-1) ==> rab(i)=(r(i)+a)*dx 20 | ! Output in asum = \sum_i c_i f(i)*rab(i) = \int_0^\infty f(r) dr 21 | ! where c_i are alternativaly 2/3, 4/3 except c_1 = c_mesh = 1/3 22 | ! 23 | use kinds, ONLY: DP 24 | implicit none 25 | integer, intent(in) :: mesh 26 | real(DP), intent(in) :: rab (mesh), func (mesh) 27 | real(DP), intent(out):: asum 28 | ! 29 | real(DP) :: f1, f2, f3, r12 30 | integer :: i 31 | ! 32 | ! routine assumes that mesh is an odd number so run check 33 | ! if ( mesh+1 - ( (mesh+1) / 2 ) * 2 .ne. 1 ) then 34 | ! write(*,*) '***error in subroutine radlg' 35 | ! write(*,*) 'routine assumes mesh is odd but mesh =',mesh+1 36 | ! stop 37 | ! endif 38 | asum = 0.0d0 39 | r12 = 1.0d0 / 12.0d0 40 | f3 = func (1) * rab (1) * r12 41 | 42 | do i = 2, mesh - 1, 2 43 | f1 = f3 44 | f2 = func (i) * rab (i) * r12 45 | f3 = func (i + 1) * rab (i + 1) * r12 46 | asum = asum + 4.0d0 * f1 + 16.0d0 * f2 + 4.0d0 * f3 47 | enddo 48 | 49 | return 50 | end subroutine simpson 51 | 52 | !=----------------------------------------------------------------------- 53 | subroutine simpson_cp90( mesh, func, rab, asum ) 54 | !----------------------------------------------------------------------- 55 | ! 56 | ! This routine computes the integral of a function defined on a 57 | ! logaritmic mesh, by using the open simpson formula given on 58 | ! pag. 109 of Numerical Recipes. In principle it is used to 59 | ! perform integrals from zero to infinity. The first point of 60 | ! the function should be the closest to zero but not the value 61 | ! in zero. The formula used here automatically includes the 62 | ! contribution from the zero point and no correction is required. 63 | ! 64 | ! Input as "simpson". At least 8 integrating points are required. 65 | ! 66 | ! last revised 12 May 1995 by Andrea Dal Corso 67 | ! 68 | use kinds, ONLY: DP 69 | implicit none 70 | integer, intent(in) :: mesh 71 | real(DP), intent(in) :: rab (mesh), func (mesh) 72 | real(DP), intent(out):: asum 73 | ! 74 | real(DP) :: c(4) 75 | integer ::i 76 | ! 77 | if ( mesh < 8 ) call errore ('simpson_cp90','few mesh points',8) 78 | 79 | c(1) = 109.0d0 / 48.d0 80 | c(2) = -5.d0 / 48.d0 81 | c(3) = 63.d0 / 48.d0 82 | c(4) = 49.d0 / 48.d0 83 | 84 | asum = ( func(1)*rab(1) + func(mesh )*rab(mesh ) )*c(1) & 85 | + ( func(2)*rab(2) + func(mesh-1)*rab(mesh-1) )*c(2) & 86 | + ( func(3)*rab(3) + func(mesh-2)*rab(mesh-2) )*c(3) & 87 | + ( func(4)*rab(4) + func(mesh-3)*rab(mesh-3) )*c(4) 88 | do i=5,mesh-4 89 | asum = asum + func(i)*rab(i) 90 | end do 91 | 92 | return 93 | end subroutine simpson_cp90 94 | ! 95 | !----------------------------------------------------------------------- 96 | SUBROUTINE herman_skillman_int(mesh,func,rab,asum) 97 | !----------------------------------------------------------------------- 98 | ! simpson rule integration for herman skillman mesh (obsolescent) 99 | ! Input as in "simpson". BEWARE: "func" is overwritten!!! 100 | ! 101 | use kinds, ONLY: DP 102 | IMPLICIT NONE 103 | integer, intent(in) :: mesh 104 | real(DP), intent(in) :: rab (mesh) 105 | real(DP), intent(inout) :: func (mesh) 106 | real(DP), intent(out):: asum 107 | ! 108 | INTEGER :: i, j, k, i1, nblock 109 | REAL(DP) :: a1, a2e, a2o, a2es 110 | ! 111 | a1=0.0d0 112 | a2e=0.0d0 113 | asum=0.0d0 114 | nblock=mesh/40 115 | i=1 116 | func(1)=0.0d0 117 | DO j=1,nblock 118 | DO k=1,20 119 | i=i+2 120 | i1=i-1 121 | a2es=a2e 122 | a2o=func(i1)/12.0d0 123 | a2e=func(i)/12.0d0 124 | a1=a1+5.0d0*a2es+8.0d0*a2o-a2e 125 | func(i1)=asum+a1*rab(i1) 126 | a1=a1-a2es+8.0d0*a2o+5.0d0*a2e 127 | func(i)=asum+a1*rab(i) 128 | END DO 129 | asum=func(i) 130 | a1=0.0d0 131 | END DO 132 | ! 133 | RETURN 134 | END SUBROUTINE herman_skillman_int 135 | --------------------------------------------------------------------------------