Commit ac9f2144 authored by giannozz's avatar giannozz

O-sesame


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@2 c92efa57-630b-4861-b058-cf58834340f0
parents
include ../make.sys
all: cp90
# Name of the program
PROGNAME= cp.x
######################################################################
WRAPPERS= wrapper.o
# Fortran objects
FOBJS= modules.o $(FFT) para.o \
read_pseudo.o cplib.o cpr.o input.o sort.o \
macdep.o which_dft.o $(WRAPPERS) \
restart.o cpr_mod.o cell_module.o cprsub.o cpflush.o
######################################################################
default:
make $(PROGNAME)
cp90 : $(FOBJS)
$(LNK) -o $(PROGNAME) $(LNKFLAGS) $(FOBJS) ../Modules/*.o cpflush.o \
../flib/eispack.o $(LIB)
chmod a+r $(PROGNAME)
chmod a+x $(PROGNAME)
clean :
- rm -f *.o *.i core* fort* *.mod *.s *.d work.pc
include .dependencies
include ../make.rules
This diff is collapsed.
subroutine cpflush()
return
end subroutine
This diff is collapsed.
This diff is collapsed.
!
! Copyright (C) 2002 CP90 group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
module stre
implicit none
save
real(kind=8) stress(3,3)
end module stre
module dqrad_mod
implicit none
save
real(kind=8),allocatable:: dqrad(:,:,:,:,:,:,:)
end module dqrad_mod
module betax
implicit none
save
integer, parameter:: mmx=5001
real(kind=8) :: refg
real(kind=8),allocatable:: betagx(:,:,:), dbetagx(:,:,:), &
qradx(:,:,:,:,:), dqradx(:,:,:,:,:)
end module betax
This diff is collapsed.
!
! Copyright (C) 2002 CP90 group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
!
!-------------------------------------------------------------------------
subroutine cfft3(f,nr1,nr2,nr3,nr1x,nr2x,nr3x,isign)
!-----------------------------------------------------------------------
! driver routine for 3d fft using cray's fft routine (by kl)
!
implicit none
integer nr1, nr2, nr3, nr1x, nr2x, nr3x, isign
real(kind=8) f(2,nr1x*nr2x*nr3x)
!
! initialization variables
!
logical first
data first/.true./
integer ifax1(19), ifax2(19), ifax3(19)
real(kind=8), allocatable :: trig1(:), trig2(:), trig3(:)
!
! work variables
!
real(kind=8), allocatable:: work(:)
real(kind=8) fac
integer inc, jump, lot, i, istart
!
save first, ifax1, ifax2, ifax3, trig1, trig2, trig3, work
!
!
if (first) then
allocate(work(4*nr1x*nr2x*nr3x))
allocate(trig1(2*nr1))
allocate(trig2(2*nr2))
allocate(trig3(2*nr3))
call cftfax(nr1,ifax1,trig1)
call cftfax(nr2,ifax2,trig2)
call cftfax(nr3,ifax3,trig3)
first=.false.
end if
! x - direction
inc=2
jump=2*nr1x
lot=nr3x*nr2x
call cfftmlt(f(1,1),f(2,1),work,trig1,ifax1,inc, &
& jump,nr1,lot,isign)
!
! y - direction
! inc=2*nr1x
! jump=2
! lot=nr1x
! do i=1,nr3
! istart=1+(i-1)*nr2x*nr1x
! call cfftmlt(f(1,istart),f(2,istart),work,trig2,
! c ifax2,inc,jump,nr2,lot,isign)
! end do
!
inc=2*nr1x
jump=2*nr1x*nr2x
lot=nr3x
do i=1,nr1
istart=i
call cfftmlt(f(1,istart),f(2,istart),work,trig2, &
& ifax2,inc,jump,nr2,lot,isign)
end do
!
! z - direction
inc=2*nr1x*nr2x
jump=2
lot=nr1x*nr2x
call cfftmlt(f(1,1),f(2,1),work,trig3,ifax3,inc, &
& jump,nr3,lot,isign)
!
if (isign.eq.-1) then
fac=1.d0/dfloat(nr1*nr2*nr3)
call SSCAL(2*nr1x*nr2x*nr3x,fac,f,1)
end if
!
return
end
!-------------------------------------------------------------------------
subroutine cfft3b(f,nr1b,nr2b,nr3b,nr1bx,nr2bx,nr3bx,isign)
!-----------------------------------------------------------------------
! driver routine for 3d fft using cray's fft routine (by kl)
!
implicit none
integer nr1b,nr2b,nr3b,nr1bx,nr2bx,nr3bx,isign
real(kind=8) f(2,nr1bx*nr2bx*nr3bx)
!
! initialization variables
!
logical first
data first/.true./
integer ifax1(19), ifax2(19), ifax3(19)
real(kind=8), allocatable :: trig1(:), trig2(:), trig3(:)
!
! work variables
!
real(kind=8), allocatable:: work(:)
real(kind=8) fac
integer inc, jump, lot, i, istart
save first, ifax1, ifax2,ifax3, trig1, trig2, trig3, work
!
!
if (first) then
allocate(work(4*nr1bx*nr2bx*nr3bx))
allocate(trig1(2*nr1b))
allocate(trig2(2*nr2b))
allocate(trig3(2*nr3b))
call cftfax(nr1b,ifax1,trig1)
call cftfax(nr2b,ifax2,trig2)
call cftfax(nr3b,ifax3,trig3)
first=.false.
end if
! x - direction
inc=2
jump=2*nr1bx
lot=nr3bx*nr2bx
call cfftmlt(f(1,1),f(2,1),work,trig1,ifax1,inc, &
& jump,nr1b,lot,isign)
!
! y - direction
inc=2*nr1bx
jump=2
lot=nr1bx
do i=1,nr3b
istart=1+(i-1)*nr2bx*nr1bx
call cfftmlt(f(1,istart),f(2,istart),work,trig2, &
& ifax2,inc,jump,nr2b,lot,isign)
end do
!
! z - direction
inc=2*nr1bx*nr2bx
jump=2
lot=nr1bx*nr2bx
call cfftmlt(f(1,1),f(2,1),work,trig3,ifax3,inc, &
& jump,nr3b,lot,isign)
!
if (isign.eq.-1) then
fac=1.d0/dfloat(nr1b*nr2b*nr3b)
call SSCAL(2*nr1bx*nr2bx*nr3bx,fac,f,1)
end if
!
return
end
!-------------------------------------------------------------------------
subroutine cfft3s(f,nr1s,nr2s,nr3s,nr1sx,nr2sx,nr3sx,isign)
!-----------------------------------------------------------------------
! driver routine for 3d fft using cray's fft routine (by kl)
!
implicit none
integer nr1s, nr2s, nr3s, nr1sx, nr2sx, nr3sx, isign
real(kind=8) f(2,nr1sx*nr2sx*nr3sx)
!
! initialization variables
!
logical first
data first/.true./
integer ifax1(19), ifax2(19), ifax3(19)
real(kind=8), allocatable :: trig1(:), trig2(:), trig3(:)
!
! work variables
!
real(kind=8), allocatable:: work(:)
real(kind=8) fac
integer inc, jump, lot, i, istart
!
save first, ifax1, ifax2, ifax3, trig1, trig2, trig3, work
!
!
if (first) then
allocate(work(4*nr1sx*nr2sx*nr3sx))
allocate(trig1(2*nr1s))
allocate(trig2(2*nr2s))
allocate(trig3(2*nr3s))
call cftfax(nr1s,ifax1,trig1)
call cftfax(nr2s,ifax2,trig2)
call cftfax(nr3s,ifax3,trig3)
first=.false.
end if
!
! x - direction
inc=2
jump=2*nr1sx
lot=nr3sx*nr2sx
call cfftmlt(f(1,1),f(2,1),work,trig1,ifax1,inc, &
& jump,nr1s,lot,isign)
!
! y - direction
! inc=2*nr1sx
! jump=2
! lot=nr1sx
! do i=1,nr3s
! istart=1+(i-1)*nr2sx*nr1sx
! call cfftmlt(f(1,istart),f(2,istart),work,trig2,
! c ifax2,inc,jump,nr2s,lot,isign)
! end do
!
inc=2*nr1sx
jump=2*nr1sx*nr2sx
lot=nr3sx
do i=1,nr1s
istart=i
call cfftmlt(f(1,istart),f(2,istart),work,trig2, &
& ifax2,inc,jump,nr2s,lot,isign)
end do
!
! z - direction
inc=2*nr1sx*nr2sx
jump=2
lot=nr1sx*nr2sx
call cfftmlt(f(1,1),f(2,1),work,trig3,ifax3,inc, &
& jump,nr3s,lot,isign)
!
if (isign.eq.-1) then
fac=1.d0/dfloat(nr1s*nr2s*nr3s)
call SSCAL(2*nr1sx*nr2sx*nr3sx,fac,f,1)
end if
!
return
end
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
!
!---------------------------------------------------------------------
subroutine read_pseudo (is, iunps, ierr)
!---------------------------------------------------------------------
!
! read "is"-th pseudopotential in the Unified Pseudopotential Format
! from unit "iunps" - convert and copy to internal PWscf variables
! return error code in "ierr" (success: ierr=0)
!
! CP90 modules
!
use ncprm
use dft_mod
use wfc_atomic
use ions_module, only: zv
!
use pseudo_types
use read_pseudo_module
!
implicit none
!
integer :: is, iunps, ierr
!
! Local variables
!
integer :: nb, iexch, icorr, igcx, igcc
TYPE (pseudo_upf) :: upf
!
!
call read_pseudo_upf(iunps, upf, ierr)
!
if (ierr .ne. 0) return
!
zv(is) = upf%zp
! psd (is)= upf%psd
! tvanp(is)=upf%tvanp
if (upf%nlcc) then
ifpcor(is) = 1
else
ifpcor(is) = 0
end if
!
call which_dft (upf%dft, iexch, icorr, igcx, igcc)
if (iexch==1.and.icorr==1.and.igcx==0.and.igcc==0) then
dft = lda
else if (iexch==1.and.icorr==3.and.igcx==1.and.igcc==3) then
dft = blyp
else if (iexch==1.and.icorr==1.and.igcx==1.and.igcc==1) then
dft = bp88
else if (iexch==1.and.icorr==4.and.igcx==2.and.igcc==2) then
dft = pw91
else if (iexch==1.and.icorr==4.and.igcx==3.and.igcc==4) then
dft = pbe
else
dft = -9
end if
!
mesh(is) = upf%mesh
!
nchi(is) = upf%nwfc
lchi(1:upf%nwfc, is) = upf%lchi(1:upf%nwfc)
! oc(1:upf%nwfc, is) = upf%oc(1:upf%nwfc)
chi(1:upf%mesh, 1:upf%nwfc, is) = upf%chi(1:upf%mesh, 1:upf%nwfc)
!
nbeta(is)= upf%nbeta
kkbeta(is)=0
do nb=1,upf%nbeta
kkbeta(is)=max(upf%kkbeta(nb),kkbeta(is))
end do
betar(1:upf%mesh, 1:upf%nbeta, is) = upf%beta(1:upf%mesh, 1:upf%nbeta)
dion(1:upf%nbeta, 1:upf%nbeta, is) = upf%dion(1:upf%nbeta, 1:upf%nbeta)
!
! lmax(is) = upf%lmax
nqlc(is) = upf%nqlc
nqf (is) = upf%nqf
lll(1:upf%nbeta,is) = upf%lll(1:upf%nbeta)
rinner(1:upf%nqlc,is) = upf%rinner(1:upf%nqlc)
qqq(1:upf%nbeta,1:upf%nbeta,is) = upf%qqq(1:upf%nbeta,1:upf%nbeta)
qfunc (1:upf%mesh, 1:upf%nbeta, 1:upf%nbeta, is) = &
upf%qfunc(1:upf%mesh,1:upf%nbeta,1:upf%nbeta)
qfcoef(1:upf%nqf, 1:upf%nqlc, 1:upf%nbeta, 1:upf%nbeta, is ) = &
upf%qfcoef( 1:upf%nqf, 1:upf%nqlc, 1:upf%nbeta, 1:upf%nbeta )
!
r (1:upf%mesh, is) = upf%r (1:upf%mesh)
rab(1:upf%mesh, is) = upf%rab(1:upf%mesh)
!
if ( upf%nlcc) then
rscore (1:upf%mesh, is) = upf%rho_atc(1:upf%mesh)
else
rscore (:,is) = 0.d0
end if
! rsatom (1:upf%mesh, is) = upf%rho_at (1:upf%mesh)