scnc
/
quantum-espresso
mirror of https://gitlab.com/QEF/q-e.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

- lighter and more robust iotk modules 

- new pw_export


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@1588 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
cavazzon 2005-01-28 16:24:33 +00:00
parent f538f02c15
commit cfc3aa9fcc
19 changed files with 89941 additions and 60628 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
CPV/Makefile
View File

@ -109,7 +109,7 @@ turbo.o \
update.o \
util.o \
vanderwaals.o \
version.o \
cp_version.o \
vofrho2.o \
wannier.o \
waveinit.o \
@ -140,11 +140,11 @@ cp.x : cprstart.o $(FOBJS) $(LIBOBJ)
- ( cd ../bin ; ln -fs ../CPV/cp.x . )
version.o : version.h
cp_version.o : cpver
version.h :
cpver :
echo "CHARACTER(LEN=70), PARAMETER :: version_date = '"`date`"'" \
> version.h
> cpver
fpmd.x : start.o $(FOBJS) $(LIBOBJ)
$(LD) -o fpmd.x start.o $(FOBJS) $(LIBOBJ) ../Modules/*.o \

10
CPV/version.f90 → CPV/cp_version.f90
View File

@ -6,9 +6,13 @@
! or http://www.gnu.org/copyleft/gpl.txt .
!
MODULE version
MODULE cp_version
USE global_version, only : version_number
IMPLICIT NONE
SAVE
INCLUDE 'version.h'
END MODULE version
#if ! defined __G95
INCLUDE 'cpver.h'
#else
CHARACTER(LEN=70), PARAMETER :: version_date = 'Sat Jan 15 19:44:57 CET 2005'
#endif
END MODULE cp_version

14
CPV/environment.f90
View File

@ -41,14 +41,14 @@
USE parser, ONLY: int_to_char
use para_mod, ONLY: me, node
use mp, only: mp_env
USE version
USE cp_version
LOGICAL :: texst
REAL(dbl) :: elapsed_seconds, cclock
EXTERNAL elapsed_seconds, cclock
INTEGER :: nchar
CHARACTER(LEN=80) :: uname
CHARACTER(LEN=80) :: cp_version
CHARACTER(LEN=80) :: version_str
CALL init_clocks( .TRUE. )
@ -57,7 +57,7 @@
start_seconds = elapsed_seconds()
start_cclock_val = cclock( )
cp_version = TRIM (version_number) // " - " // TRIM (version_date)
version_str = TRIM (version_number) // " - " // TRIM (version_date)
! ... Temporary for para_mod
@ -123,7 +123,7 @@
ELSE IF( program_name == 'FPMD' ) THEN
CALL opening_date_and_time( cp_version )
CALL opening_date_and_time( version_str )
END IF
@ -168,18 +168,18 @@
!==-----------------------------------------------------------------------==!
SUBROUTINE opening_date_and_time( cp_version )
SUBROUTINE opening_date_and_time( version_str )
USE io_global, ONLY: stdout, ionode
CHARACTER(LEN=*), INTENT(IN) :: cp_version
CHARACTER(LEN=*), INTENT(IN) :: version_str
CHARACTER(LEN=9) :: cdate, ctime
CALL date_and_tim(cdate, ctime)
! ... write program heading
IF(ionode) THEN
WRITE( stdout,3333) cp_version
WRITE( stdout,3333) version_str
WRITE( stdout,3334) 'THIS RUN WAS STARTED ON: ' // ctime // ' ' // cdate
END IF

6
CPV/fft.f90
View File

@ -94,6 +94,7 @@
! Print some statistics about time wasted by fft routines
USE io_global, ONLY: stdout
USE fft_base, ONLY: fft_timing
INTEGER, INTENT(IN) :: nstep
REAL(dbl) :: tloop, tav, ttot
@ -119,6 +120,11 @@
WRITE( stdout,501) ' total fft time .....', ttot
WRITE( stdout,*)
WRITE( stdout, fmt ="(/,3X,'PC3FFT TIMINGS')" )
WRITE( stdout,910)
WRITE( stdout,999) ( ( fft_timing(i,j), i = 1, 4), j = 1, 2 )
DEALLOCATE( fft_timing )
910 FORMAT(' FFTXW FFTYW FFTZW TRASW FFTXP FFTYP FFTZP TRASP')
999 FORMAT(8(F9.3))
500 FORMAT(1X,A,I10)

28
CPV/fftdrv.f90
View File

@ -28,7 +28,7 @@
!==---------------------------------------------------------------------==!
! ...
USE fft_base, ONLY: fft_transpose
USE fft_base, ONLY: fft_transpose, fft_timing
USE fft_scalar, ONLY: cft_1z, cft_2xy
USE mp_global, ONLY: mpime, nproc
USE stick, ONLY: dfftp
@ -96,6 +96,11 @@
ldz = dfft%nr3x
nz_l = dfft%npp( mpime + 1 )
IF( .NOT. ALLOCATED( fft_timing ) ) THEN
ALLOCATE( fft_timing( 4, 2 ) )
fft_timing = 0.0d0
END IF
IF( FFT_MODE == FFT_MODE_POTE ) THEN
ns_l = dfft%nsp( mpime + 1 )
ELSE
@ -107,11 +112,11 @@
!
! ... BACKWARD FFT
!
!s1 = cclock()
s1 = cclock()
CALL cft_1z( c, ns_l, nz, ldz, isign, c )
!s2 = cclock()
s2 = cclock()
IF( FFT_MODE == FFT_MODE_POTE ) THEN
CALL fft_transpose(c, ldz, r, ldx, ldy, dfft, (mpime+1), nproc, -1)
@ -119,7 +124,7 @@
CALL fft_transpose(c, ldz, r, ldx, ldy, dfft, (mpime+1), nproc, -2)
END IF
!s3 = cclock()
s3 = cclock()
IF( FFT_MODE == FFT_MODE_POTE ) THEN
CALL cft_2xy( r, nz_l, nx, ny, ldx, ldy, isign, dfft%iplp )
@ -127,13 +132,14 @@
CALL cft_2xy( r, nz_l, nx, ny, ldx, ldy, isign, dfft%iplw )
END IF
!s4 = cclock()
s4 = cclock()
ELSE IF( isign < 0 ) THEN
!
! ... FORWARD FFT
!
!s4 = cclock()
s4 = cclock()
IF( FFT_MODE == FFT_MODE_POTE ) THEN
CALL cft_2xy( r, nz_l, nx, ny, ldx, ldy, isign, dfft%iplp )
@ -141,7 +147,7 @@
CALL cft_2xy( r, nz_l, nx, ny, ldx, ldy, isign, dfft%iplw )
END IF
!s3 = cclock()
s3 = cclock()
IF( FFT_MODE == FFT_MODE_POTE ) THEN
CALL fft_transpose(c, ldz, r, ldx, ldy, dfft, (mpime+1), nproc, 1)
@ -149,13 +155,17 @@
CALL fft_transpose(c, ldz, r, ldx, ldy, dfft, (mpime+1), nproc, 2)
END IF
!s2 = cclock()
s2 = cclock()
CALL cft_1z( c, ns_l, nz, ldz, isign, c )
!s1 = cclock()
s1 = cclock()
END IF
fft_timing( 2, FFT_MODE ) = fft_timing( 2, FFT_MODE ) + ABS(s4-s3)
fft_timing( 3, FFT_MODE ) = fft_timing( 3, FFT_MODE ) + ABS(s2-s1)
fft_timing( 4, FFT_MODE ) = fft_timing( 4, FFT_MODE ) + ABS(s3-s2)
!
RETURN

3
CPV/print_out.f90
View File

@ -496,7 +496,8 @@
timeloop = timeloop + timeloop_
timecnt = timecnt + 1
IF( timing .AND. ( tprint .OR. texit ) ) THEN
! IF( timing .AND. ( tprint .OR. texit ) ) THEN
IF( timing ) THEN
IF( ionode ) THEN

36
CPV/spharmonic.f90
View File

@ -107,25 +107,27 @@
!================================================================
!== Spherical harmonics (l=2) in cartesian coordinates
!================================================================
FUNCTION GKL(X,Y,Z,SQM,M)
REAL(dbl) FUNCTION GKL(X,Y,Z,SQM,M)
IMPLICIT NONE
REAL(dbl) X,Y,Z,SQM,GKL
INTEGER M
REAL(dbl) :: X,Y,Z,SQM
INTEGER :: M
SELECT CASE (M)
CASE (1)
GKL=(3.D0*Z*Z/SQM-1.D0)/2.D0
CASE (2)
GKL=(X*X-Y*Y)/SQM*SQRT(3.D0)/2.D0
CASE (3)
GKL= X*Y/SQM*SQRT(3.D0)
CASE (4)
GKL=-Y*Z/SQM*SQRT(3.D0)
CASE (5)
GKL=-Z*X/SQM*SQRT(3.D0)
CASE DEFAULT
CALL errore(' GKL ',' magnetic moment not implementent ',m)
END SELECT
GKL = 0.0d0
SELECT CASE (M)
CASE (1)
GKL=(3.D0*Z*Z/SQM-1.D0)/2.D0
CASE (2)
GKL=(X*X-Y*Y)/SQM*SQRT(3.D0)/2.D0
CASE (3)
GKL= X*Y/SQM*SQRT(3.D0)
CASE (4)
GKL=-Y*Z/SQM*SQRT(3.D0)
CASE (5)
GKL=-Z*X/SQM*SQRT(3.D0)
CASE DEFAULT
CALL errore(' GKL ',' magnetic moment not implementent ',m)
END SELECT
RETURN
END FUNCTION GKL

3
Modules/fft_base.f90
View File

@ -40,11 +40,12 @@
PRIVATE
PUBLIC :: fft_transpose, fft_scatter
PUBLIC :: fft_transpose, fft_scatter, fft_timing
PUBLIC :: dfftp, dffts, fft_dlay_descriptor
INTEGER, ALLOCATABLE :: stmask(:)
REAL(dbl), ALLOCATABLE :: fft_timing(:,:)
!=----------------------------------------------------------------------=!

12
Modules/iotk_base.f90
View File

@ -1,5 +1,5 @@
! Input/Output Tool Kit (IOTK)
! Copyright (C) 2004 Giovanni Bussi
! Copyright (C) 2004,2005 Giovanni Bussi
!
! This library is free software; you can redistribute it and/or
! modify it under the terms of the GNU Lesser General Public
@ -168,7 +168,7 @@ save
! For this reason, it should not be used directly by the end user.
! This line set the version string
character(10), parameter :: iotk_version = "1.0.0beta3"
character(9), parameter :: iotk_version = "1.0.0test"
integer, parameter :: iotk_version_major = 1
integer, parameter :: iotk_version_minor = 0
integer, parameter :: iotk_version_patch = 0
@ -176,9 +176,6 @@ character(3), parameter :: iotk_file_version = "1.0"
integer, parameter :: iotk_file_version_major = 1
integer, parameter :: iotk_file_version_minor = 0
! This line set the binary_format string
character(100), parameter :: iotk_binary_format = __IOTK_BINARY_FORMAT
character, parameter :: iotk_newline = __IOTK_NEWLINE
character, parameter :: iotk_eos = __IOTK_EOS
@ -193,6 +190,8 @@ integer, parameter :: iotk_vallenx = 32768
integer, parameter :: iotk_linlenx = 4096
integer, parameter :: iotk_fillenx = 256
integer, parameter :: iotk_linlen = 128
integer, parameter :: iotk_indent = 2
integer, parameter :: iotk_maxindent = 12
! These options can be modified runtime
! Margins for unit search
@ -254,9 +253,10 @@ type iotk_error
end type iotk_error
integer, parameter :: iotk_error_linelength = 120
integer, parameter :: iotk_error_pool_size = 5
integer, parameter :: iotk_error_pool_size = 100
type(iotk_error) :: iotk_error_pool (iotk_error_pool_size)
logical :: iotk_error_pool_used (iotk_error_pool_size) = .false.
integer :: iotk_error_pool_order (iotk_error_pool_size) = 0
end module iotk_base

8160
Modules/iotk_external.f90
View File

File diff suppressed because it is too large Load Diff

21556
Modules/iotk_interface.f90
View File

File diff suppressed because it is too large Load Diff

16
Modules/iotk_module.f90
View File

@ -1,5 +1,5 @@
! Input/Output Tool Kit (IOTK)
! Copyright (C) 2004 Giovanni Bussi
! Copyright (C) 2004,2005 Giovanni Bussi
!
! This library is free software; you can redistribute it and/or
! modify it under the terms of the GNU Lesser General Public
@ -18,7 +18,17 @@
module iotk_module
! This module is a wrapper for the entities in iotk_base which need to be public
use iotk_base
use iotk_interface
use iotk_misc_interf
use iotk_error_interf
use iotk_attr_interf
use iotk_dat_interf
use iotk_files_interf
use iotk_write_interf
use iotk_scan_interf
use iotk_unit_interf
use iotk_xtox_interf
use iotk_fmt_interf
implicit none
! All names are private ...
private
! ... except the names listed below
@ -46,7 +56,6 @@ module iotk_module
public :: iotk_fillenx
public :: iotk_index
public :: iotk_version
public :: iotk_binary_format
public :: iotk_header_kind
public :: iotk_copy_tag
public :: iotk_unit_print
@ -70,5 +79,6 @@ module iotk_module
public :: iotk_eos
public :: iotk_error_clear
public :: iotk_error_print
public :: iotk_error_pool_pending
end module iotk_module

2419
Modules/iotk_multitype_character.f90
View File

File diff suppressed because it is too large Load Diff

29560
Modules/iotk_multitype_complex.f90
View File

File diff suppressed because it is too large Load Diff

29512
Modules/iotk_multitype_integer.f90
View File

File diff suppressed because it is too large Load Diff

29608
Modules/iotk_multitype_logical.f90
View File

File diff suppressed because it is too large Load Diff

29552
Modules/iotk_multitype_real.f90
View File

File diff suppressed because it is too large Load Diff

62
PP/pw_export.f90
View File

@ -243,15 +243,18 @@ program pp_punch
!
! writes PWSCF data for postprocessing purposes in XML format using IOTK lib
! Wave-functions are collected and written using IO_BASE module.
! At the moment the preprocessor flag __PUNCH_IOTK should be defined
! in order to allow for iotk writing of the wfcs.
!
! input: namelist "&inputpp", with variables
! prefix prefix of input files saved by program pwscf
! outdir temporary directory where files resides
! pp_file output file. This variable coulb de eliminated
! adopting a suitable convention for the name
! involving prefix (prefix.XMLpun ??)
! pp_file output file. If it is omitted, a directory
! "prefix.export/" is created in outdir and
! some output files are put there. Anyway all the data
! are accessible through the "prefix.export/index.xml" file which
! contains implicit pointers to all the other files in the
! export directory. If reading is done by the IOTK library
! all data appear to be in index.xml even if physically it
! is not.
! uspp_spsi using US PP if set .TRUE. writes S | psi >
! and | psi > separately in the output file
! single_file one-file output is produced
@ -353,7 +356,7 @@ subroutine write_export (pp_file,kunit,uspp_spsi, ascii, single_file, raw)
use kinds, only : DP
use pwcom
use becmod, only : becp
use becmod, only : becp, rbecp
use wavefunctions_module, ONLY : evc
use io_files, only : nd_nmbr, outdir, prefix, iunwfc, nwordwfc
use io_files, only : pseudo_dir, psfile
@ -470,6 +473,7 @@ subroutine write_export (pp_file,kunit,uspp_spsi, ascii, single_file, raw)
write(0,*) "Writing dimensions"
call iotk_write_begin(50,"Dimensions")
call iotk_write_attr (attr,"nktot",nkstot,first=.true.)
call iotk_write_attr (attr,"nspin",nspin)
call iotk_write_attr (attr,"nk1",nk1)
call iotk_write_attr (attr,"nk2",nk2)
call iotk_write_attr (attr,"nk3",nk3)
@ -691,57 +695,69 @@ subroutine write_export (pp_file,kunit,uspp_spsi, ascii, single_file, raw)
CALL init_us_1
CALL init_at_1
IF ( gamma_only ) THEN
ALLOCATE (rbecp (nkb,nbnd))
ELSE
ALLOCATE ( becp (nkb,nbnd))
ENDIF
do ik = 1, nkstot
local_pw = 0
IF( (ik >= iks) .AND. (ik <= ike) ) THEN
CALL gk_sort (xk (1, ik+iks-1), ngm, g, ecutwfc / tpiba2, npw, igk, g2kin)
CALL davcio (evc, nwordwfc, iunwfc, (ik-iks+1), - 1)
CALL init_us_2(npw, igk, xk(1, ik), vkb)
call davcio (evc, nwordwfc, iunwfc, (ik-iks+1), - 1)
local_pw = ngk(ik-iks+1)
IF ( gamma_only ) THEN
!CALL pw_gemm ('Y', nkb, nbnd, ngk_g(ik), vkb, npwx, evc, npwx, becp, nkb)
CALL errore('pw_export','Gamma_only NOT YET implemented',1)
CALL pw_gemm ('Y', nkb, nbnd, ngk_g(ik), vkb, npwx, evc, npwx, rbecp, nkb)
WRITE(0,*) 'Gamma only PW_EXPORT not yet tested'
ELSE
CALL ccalbec (nkb, npwx, npw, nbnd, becp, vkb, evc)
ENDIF
CALL s_psi(npwx, npw, nbnd, evc, sevc)
ENDIF
allocate(l2g_new(local_pw))
ALLOCATE(l2g_new(local_pw))
l2g_new = 0
do ig = 1, local_pw
DO ig = 1, local_pw
ngg = igk_l2g(ig,ik-iks+1)
do ig_ = 1, ngk_g(ik)
if(ngg == igwk(ig_,ik)) then
DO ig_ = 1, ngk_g(ik)
IF(ngg == igwk(ig_,ik)) THEN
l2g_new(ig) = ig_
exit
end if
end do
end do
EXIT
ENDIF
ENDDO
ENDDO
ispin = isk( ik )
CALL write_restart_wfc(50, ik, nkstot, kunit, ispin, nspin, &
wfc_scal, sevc, twf0, sevc, twfm, npw_g, nbnd, &
l2g_new(:),local_pw )
deallocate(l2g_new)
end do
DEALLOCATE(l2g_new)
ENDDO
if( ionode ) call iotk_write_end (50, "Eigenvectors_Spsi")
DEALLOCATE( sevc, STAT=ierr )
IF ( ierr/= 0 ) CALL errore('pw_export','Unable to deallocate SEVC',ABS(ierr))
IF ( gamma_only ) THEN
DEALLOCATE (rbecp)
ELSE
DEALLOCATE ( becp)
ENDIF
ENDIF
deallocate( igwk )
deallocate ( ngk_g )
DEALLOCATE( igwk )
DEALLOCATE ( ngk_g )
if( ionode ) then
IF( ionode ) THEN
call iotk_close_write(50)
end if
END IF
end subroutine write_export

4
include/iotk_config.h
View File

@ -53,6 +53,7 @@
# define __IOTK_REAL2 8
# define __IOTK_WORKAROUND1
# define __IOTK_WORKAROUND3
# define __IOTK_WORKAROUND5
# endif
# ifdef __G95
# define __IOTK_BINARY_FORMAT "PC-LINUX/G95"
@ -75,7 +76,7 @@
# undef __IOTK_REAL1 4
# define __IOTK_REAL2 8
# define __IOTK_WORKAROUND2
# define __IOTK_WORKAROUND3
# define __IOTK_WORKAROUND4
# endif
#endif
@ -89,6 +90,7 @@
# define __IOTK_REAL2 8
# define __IOTK_WORKAROUND1
# define __IOTK_WORKAROUND3
# define __IOTK_WORKAROUND5
# endif
#endif