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

- Variable cell: use Cesar Da Silva's version of the damping algorithm 

(he claims it is more tested); documentation updated (sort of)
- routines find_free_unit, delete_if_present, moved from 'parser'
  to 'io_files' (it is a more natural place)
- routines int_to_char moved from 'parser' to flib/ (it is quite
  unrelated with the rest of the module)
- routine trimcheck moved from flib/ to 'io_files' (more natural place)


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@2753 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
giannozz 2006-02-01 17:56:16 +00:00
parent 584b169835
commit 8eda231bbb
50 changed files with 268 additions and 270 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
CPV/compute_fes_grads.f90
View File

@ -27,8 +27,7 @@ SUBROUTINE compute_fes_grads( N_in, N_fin, stat )
sort_tau, tau_srt, ind_srt
USE path_formats, ONLY : scf_fmt, scf_fmt_para
USE io_files, ONLY : prefix, outdir, scradir, iunpath, iunaxsf, &
iunupdate, exit_file, iunexit
USE parser, ONLY : int_to_char, delete_if_present
iunupdate, exit_file, iunexit, delete_if_present
USE constants, ONLY : bohr_radius_angs
USE io_global, ONLY : stdout, ionode, ionode_id, meta_ionode
USE mp_global, ONLY : inter_image_comm, intra_image_comm, &
@ -54,6 +53,7 @@ SUBROUTINE compute_fes_grads( N_in, N_fin, stat )
REAL(DP), ALLOCATABLE :: tau(:,:)
REAL(DP), ALLOCATABLE :: fion(:,:)
REAL(DP) :: etot
CHARACTER (LEN=6), EXTERNAL :: int_to_char
REAL(DP), EXTERNAL :: get_clock
!
!

2
CPV/compute_scf.f90
View File

@ -21,7 +21,6 @@ SUBROUTINE compute_scf( N_in, N_fin, stat )
USE path_formats, ONLY : scf_fmt
USE path_variables, ONLY : pos, pes, grad_pes, num_of_images, &
dim, suspended_image, frozen
USE parser, ONLY : int_to_char
USE mp_global, ONLY : mpime, my_pool_id
USE mp, ONLY : mp_barrier
USE check_stop, ONLY : check_stop_now
@ -42,6 +41,7 @@ SUBROUTINE compute_scf( N_in, N_fin, stat )
REAL(DP), ALLOCATABLE :: fion(:,:)
REAL(DP) :: etot
INTEGER :: ia, is, isa, ipos
CHARACTER (LEN=6), EXTERNAL :: int_to_char
REAL(DP), EXTERNAL :: get_clock
!
!

2
CPV/cp_restart.f90
View File

@ -732,7 +732,6 @@ MODULE cp_restart
ekincm, c04, cm4, c02, cm2, mat_z )
!------------------------------------------------------------------------
!
USE parser, ONLY : int_to_char
USE control_flags, ONLY : gamma_only, force_pairing
USE io_files, ONLY : iunpun, xmlpun
USE printout_base, ONLY : title
@ -1470,7 +1469,6 @@ MODULE cp_restart
htm, htvel, gvel, xnhh0, xnhhm, vnhh )
!------------------------------------------------------------------------
!
USE parser, ONLY : int_to_char
USE io_files, ONLY : iunpun, xmlpun
USE mp, ONLY : mp_sum
!

5
CPV/environment.f90
View File

@ -35,17 +35,16 @@
USE io_global, ONLY: stdout, ionode
USE mp_global, ONLY: mpime, nproc
USE parser, ONLY: int_to_char
use para_mod, ONLY: me, node
use mp, only: mp_env
USE cp_version
LOGICAL :: texst
REAL(DP) :: elapsed_seconds, cclock
EXTERNAL elapsed_seconds, cclock
INTEGER :: nchar
CHARACTER(LEN=80) :: uname
CHARACTER(LEN=80) :: version_str
REAL(DP), EXTERNAL :: elapsed_seconds, cclock
CHARACTER (LEN=6), EXTERNAL :: int_to_char
CALL init_clocks( .TRUE. )

4
CPV/ksstates.f90
View File

@ -229,7 +229,6 @@
USE brillouin, ONLY: kpoints, kp
USE pseudo_projector, ONLY: projector
USE control_flags, ONLY: timing, force_pairing
USE parser, ONLY: int_to_char
IMPLICIT NONE
@ -253,6 +252,7 @@
REAL(DP), ALLOCATABLE :: fi(:,:)
REAL(DP), EXTERNAL :: cclock
CHARACTER (LEN=6), EXTERNAL :: int_to_char
! ... end of declarations
@ -391,7 +391,6 @@
USE pseudo_projector, ONLY: projector
USE control_flags, ONLY: timing
USE electrons_module, ONLY: nupdwn, nspin
USE parser, ONLY: int_to_char
IMPLICIT NONE
@ -413,6 +412,7 @@
COMPLEX(DP), ALLOCATABLE :: eforce(:,:,:,:)
REAL(DP), ALLOCATABLE :: fi(:,:)
CHARACTER (LEN=6), EXTERNAL :: int_to_char
REAL(DP), EXTERNAL :: cclock

2
CPV/path_routines.f90
View File

@ -55,7 +55,6 @@ MODULE path_routines
USE mp, ONLY : mp_bcast, mp_barrier, mp_sum
USE control_flags, ONLY : lpath, lneb, lcoarsegrained, lconstrain, &
lmd, ldamped, tprnfor
USE parser, ONLY : int_to_char
!
IMPLICIT NONE
!
@ -64,6 +63,7 @@ MODULE path_routines
REAL(DP), ALLOCATABLE :: tau(:,:)
CHARACTER(LEN=256) :: outdir_saved
CHARACTER(LEN=256) :: filename
CHARACTER (LEN=6), EXTERNAL :: int_to_char
!
INTEGER, EXTERNAL :: c_mkdir
!

4
D3/d3_readin.f90
View File

@ -22,7 +22,7 @@ SUBROUTINE d3_readin()
USE phcom
USE d3com
USE noncollin_module, ONLY : noncolin
USE io_files, ONLY : tmp_dir, prefix
USE io_files, ONLY : tmp_dir, prefix, trimcheck
USE io_global, ONLY : ionode
!
IMPLICIT NONE
@ -98,7 +98,7 @@ SUBROUTINE d3_readin()
300 CALL errore ('d3_readin', 'reading xq', ABS (ios) )
lgamma = xq (1) .EQ.0.d0.AND.xq (2) .EQ.0.d0.AND.xq (3) .EQ.0.d0
tmp_dir = TRIM(outdir)
tmp_dir = trimcheck (outdir)
!
END IF
!

8
Doc/INPUT_PW
View File

@ -802,7 +802,8 @@ press REAL ( default = 0.D0 )
target pressure [KBar] in a variable-cell md or relaxation run.
wmass REAL ( default = sum of atomic masses in the cell )
fictitious cell mass [amu] for variable-cell md simulations
fictitious cell mass [amu] for variable-cell simulations
(both 'vc-md' and 'vc-relax')
cell_factor REAL ( default = 1.2D0 )
used in the construction of the pseudopotential tables.
@ -811,9 +812,8 @@ cell_factor REAL ( default = 1.2D0 )
press_cov_thr REAL ( default = 0.5D0 Kbar )
convergence threshold on the pressure for variable cell
relazations (note that in variable-cell relaxations the
other convergence thresholds for ionic relaxation apply
as well).
relaxation ('vc-relax' : note that the other convergence
thresholds for ionic relaxation apply as well).
===============================================================================
&PHONON ( only in calculation = 'phonon' )

36
Doc/users-guide.tex
View File

@ -3068,14 +3068,40 @@ group of \textbf{q}, the code compares \textbf{q} and the rotated
You may run into trouble if your \textbf{q}-point differs from a
high-symmetry point by an amount in that order of magnitude.
\section{Frequently Asked Questions}
\section{Frequently Asked (and Seldom Answered) Questions}
\begin{itemize}
\item {\em How can I optimize the structural parameters of a
low-symmetry lattice? should I use $E(v)$ curves, the stress,
variable-cell molecular dynamics?}
\item {\em How can I choose parameters for variable-cell
molecular dynamics?}
\item {\em Is there a simple way to determine the symmetry
``A common mistake many new users make is to set the time step
\texttt{dt} inproperly to the same order of magnitude as for CP
algorithm, or not setting \texttt{dt} at all. This will produce
a "not evolving dynamics". Good values for the original RMW
(RM Wentzcovitch) dynamics are \texttt{dt}$=50\div70$.
The choice of the cell mass is a delicate matter. An off-optimal mass
will make convergence slower. Too small masses, as well as too long time
steps, can make the algorithm unstable. A good cell mass will make the
oscillation times for internal degrees of freedom comparable to
cell degrees of freedom in non-damped Variable-Cell MD. Test calculations
are advisable before extensive calculation.
I have tested the damping algorithm that I have developed and it has
worked well so far. It allows for a much longer time step
(\texttt{dt}$100\div150$) than the RMW one and is much more stable
with very small cell masses, which is useful when the cell shape,
not the internal degrees of freedom, is far out of equilibrium.
It also converges in a smaller number of steps than RMW.''
(Info from Cesar Da Silva: the new damping algorithm is the default
since v. 3.1).
% \item {\em How can I optimize the structural parameters of a
% low-symmetry lattice? should I use $E(v)$ curves, the stress,
% variable-cell molecular dynamics?}
\item {\em Is there a simple way to determine the symmetry
of a given phonon mode?}
In some cases, degeneracy will help. In other cases, the character of a

4
Gamma/cg_readin.f90
View File

@ -14,7 +14,7 @@ SUBROUTINE cg_readin()
USE ions_base, ONLY : nat, amass
USE pwcom
USE cgcom
USE io_files, ONLY : tmp_dir, prefix
USE io_files, ONLY : tmp_dir, prefix, trimcheck
USE io_global, ONLY : ionode, ionode_id
USE noncollin_module, ONLY : noncolin
USE mp, ONLY : mp_bcast
@ -51,7 +51,7 @@ SUBROUTINE cg_readin()
READ(iunit,'(a)') title_ph
READ(iunit,inputph)
!
tmp_dir = TRIM(outdir)
tmp_dir = trimcheck (outdir)
!
END IF
!

2
Modules/autopilot.f90
View File

@ -212,13 +212,13 @@ CONTAINS
! Put this in setcontrol_flags on the select statement
!-----------------------------------------------------------------------
LOGICAL FUNCTION auto_check (ndr, scradir)
USE parser, ONLY: int_to_char
USE io_global, ONLY: ionode, ionode_id
USE mp, ONLY : mp_bcast
IMPLICIT NONE
INTEGER, INTENT(IN) :: ndr ! I/O unit number
CHARACTER(LEN=*), INTENT(IN) :: scradir
CHARACTER(LEN=256) :: dirname, filename
CHARACTER (LEN=6), EXTERNAL :: int_to_char
LOGICAL :: restart_p = .FALSE.
INTEGER :: strlen
! right now cp_readfile is called with scradir = ' '

3
Modules/bfgs_module.f90
View File

@ -744,8 +744,7 @@ MODULE bfgs_module
SUBROUTINE terminate_bfgs( energy, stdout, scratch )
!------------------------------------------------------------------------
!
USE io_files, ONLY : prefix
USE parser, ONLY : delete_if_present
USE io_files, ONLY : prefix, delete_if_present
!
IMPLICIT NONE
!

2
Modules/constraints_module.f90
View File

@ -86,7 +86,6 @@ MODULE constraints_module
constr_type_inp, constr_inp, &
constr_target, constr_target_set, &
monitor_constr_ => monitor_constr
USE parser, ONLY : int_to_char
!
IMPLICIT NONE
!
@ -105,6 +104,7 @@ MODULE constraints_module
REAL(DP) :: dtau(3), norm_dtau
REAL(DP) :: k(3), phase, norm_k
COMPLEX(DP) :: struc_fac
CHARACTER(LEN=6), EXTERNAL :: int_to_char
!
!
nconstr = nconstr_inp

101
Modules/io_files.f90
View File

@ -123,6 +123,107 @@ MODULE io_files
!
INTEGER :: iunefield = 31 ! unit to store wavefunction for calculatin electric field operator
!
CONTAINS
!
!-----------------------------------------------------------------------
FUNCTION trimcheck ( directory )
!-----------------------------------------------------------------------
!
! ... verify if directory ends with /, add one if needed;
! ... trim white spaces and put the result in trimcheck
!
IMPLICIT NONE
!
CHARACTER (LEN=*), INTENT(IN) :: directory
CHARACTER (LEN=256) :: trimcheck
INTEGER :: l
!
l = LEN_TRIM( directory )
IF ( l == 0 ) CALL errore( 'trimcheck', ' input name empty', 1)
!
IF ( directory(l:l) == '/' ) THEN
trimcheck = TRIM ( directory)
ELSE
IF ( l < LEN( trimcheck ) ) THEN
trimcheck = TRIM ( directory ) // '/'
ELSE
CALL errore( 'trimcheck', ' input name too long', l )
END IF
END IF
!
RETURN
!
END FUNCTION trimcheck
!
!--------------------------------------------------------------------------
FUNCTION find_free_unit()
!--------------------------------------------------------------------------
!
IMPLICIT NONE
!
INTEGER :: find_free_unit
INTEGER :: iunit
LOGICAL :: opnd
!
!
unit_loop: DO iunit = 99, 1, -1
!
INQUIRE( UNIT = iunit, OPENED = opnd )
!
IF ( .NOT. opnd ) THEN
!
find_free_unit = iunit
!
RETURN
!
END IF
!
END DO unit_loop
!
CALL errore( 'find_free_unit()', 'free unit not found ?!?', 1 )
!
RETURN
!
END FUNCTION find_free_unit
!
!--------------------------------------------------------------------------
SUBROUTINE delete_if_present( filename, in_warning )
!--------------------------------------------------------------------------
!
USE io_global, ONLY : ionode, stdout
!
IMPLICIT NONE
!
CHARACTER(LEN=*), INTENT(IN) :: filename
LOGICAL, OPTIONAL, INTENT(IN) :: in_warning
LOGICAL :: exst, warning
INTEGER :: iunit
!
IF ( .NOT. ionode ) RETURN
!
INQUIRE( FILE = filename, EXIST = exst )
!
IF ( exst ) THEN
!
iunit = find_free_unit()
!
warning = .FALSE.
!
IF ( PRESENT( in_warning ) ) warning = in_warning
!
OPEN( UNIT = iunit, FILE = filename , STATUS = 'OLD' )
CLOSE( UNIT = iunit, STATUS = 'DELETE' )
!
IF ( warning ) &
WRITE( UNIT = stdout, FMT = '(/,5X,"WARNING: ",A, &
& " file was present; old file deleted")' ) filename
!
END IF
!
RETURN
!
END SUBROUTINE delete_if_present
!
!=----------------------------------------------------------------------------=!
END MODULE io_files
!=----------------------------------------------------------------------------=!

5
Modules/metadyn_base.f90
View File

@ -38,8 +38,8 @@ MODULE metadyn_base
metadyn_history, metadyn_fmt, fe_step, &
first_metadyn_iter, gaussian_pos
USE metadyn_io, ONLY : read_metadyn_restart
USE parser, ONLY : delete_if_present, int_to_char
USE io_files, ONLY : tmp_dir, scradir, prefix, iunaxsf, iunmeta
USE io_files, ONLY : tmp_dir, scradir, prefix, iunaxsf, &
iunmeta, delete_if_present
USE io_global, ONLY : stdout, ionode, ionode_id
USE mp, ONLY : mp_bcast
USE xml_io_base, ONLY : restart_dir
@ -55,6 +55,7 @@ MODULE metadyn_base
CHARACTER(LEN=256) :: dirname
CHARACTER(LEN=4) :: c_nconstr
CHARACTER(LEN=16) :: fe_step_fmt
CHARACTER(LEN=6), EXTERNAL :: int_to_char
!
!
c_nconstr = int_to_char( nconstr )

119
Modules/parser.f90
View File

@ -6,18 +6,18 @@
! or http://www.gnu.org/copyleft/gpl.txt .
!
!
! ... SUBROUTINE con_cam: counts the number of fields in a string
! separated by the optional character
!
! ... SUBROUTINE field_count: accepts two string (one of them is optional)
! and one integer and count the number of fields
! in the string separated by a blank or a tab
! character. If the optional string is specified
! (it has anyway len=1) it is assumed as the
! separator character.
! Ignores any charcter following the exclamation
! Ignores any character following the exclamation
! mark (fortran comment)
!
! ... SUBROUTINE con_cam: counts the number of fields in a string
! separated by the optional character
!
! ... SUBROUTINE field_compare: accepts two strings and one integer. Counts the
! fields contained in the first string and
! compares it with the integer.
@ -33,116 +33,15 @@ MODULE parser
!
USE io_global, ONLY : stdout
USE kinds
!
PRIVATE
!
PUBLIC :: parse_unit, field_count, read_line
!
INTEGER :: parse_unit = 5 ! normally 5, but can be set otherwise
!
CONTAINS
!
!-----------------------------------------------------------------------
PURE FUNCTION int_to_char( int )
!-----------------------------------------------------------------------
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: int
CHARACTER (LEN=6) :: int_to_char
!
!
IF ( int < 10 ) THEN
!
WRITE( UNIT = int_to_char , FMT = "(I1)" ) int
!
ELSE IF ( int < 100 ) THEN
!
WRITE( UNIT = int_to_char , FMT = "(I2)" ) int
!
ELSE IF ( int < 1000 ) THEN
!
WRITE( UNIT = int_to_char , FMT = "(I3)" ) int
!
ELSE IF ( int < 10000 ) THEN
!
WRITE( UNIT = int_to_char , FMT = "(I4)" ) int
!
ELSE
!
WRITE( UNIT = int_to_char , FMT = "(I5)" ) int
!
END IF
!
RETURN
!
END FUNCTION int_to_char
!
!
!--------------------------------------------------------------------------
FUNCTION find_free_unit()
!--------------------------------------------------------------------------
!
IMPLICIT NONE
!
INTEGER :: find_free_unit
INTEGER :: iunit
LOGICAL :: opnd
!
!
unit_loop: DO iunit = 99, 1, -1
!
INQUIRE( UNIT = iunit, OPENED = opnd )
!
IF ( .NOT. opnd ) THEN
!
find_free_unit = iunit
!
RETURN
!
END IF
!
END DO unit_loop
!
CALL errore( 'find_free_unit()', 'free unit not found ?!?', 1 )
!
RETURN
!
END FUNCTION find_free_unit
!
!--------------------------------------------------------------------------
SUBROUTINE delete_if_present( filename, in_warning )
!--------------------------------------------------------------------------
!
USE io_global, ONLY : ionode
!
IMPLICIT NONE
!
CHARACTER(LEN=*), INTENT(IN) :: filename
LOGICAL, OPTIONAL, INTENT(IN) :: in_warning
LOGICAL :: exst, warning
INTEGER :: iunit
!
IF ( .NOT. ionode ) RETURN
!
INQUIRE( FILE = filename, EXIST = exst )
!
IF ( exst ) THEN
!
iunit = find_free_unit()
!
warning = .FALSE.
!
IF ( PRESENT( in_warning ) ) warning = in_warning
!
OPEN( UNIT = iunit, FILE = filename , STATUS = 'OLD' )
CLOSE( UNIT = iunit, STATUS = 'DELETE' )
!
IF ( warning ) &
WRITE( UNIT = stdout, FMT = '(/,5X,"WARNING: ",A, &
& " file was present; old file deleted")' ) filename
!
END IF
!
RETURN
!
END SUBROUTINE delete_if_present
!
!--------------------------------------------------------------------------
PURE SUBROUTINE field_count( num, line, car )

2
Modules/path_base.f90
View File

@ -65,7 +65,6 @@ MODULE path_base
USE path_formats, ONLY : summary_fmt
USE mp_global, ONLY : nimage
USE io_global, ONLY : meta_ionode
USE parser, ONLY : int_to_char
USE path_io_routines, ONLY : read_restart
USE path_variables, ONLY : path_allocation
!
@ -77,6 +76,7 @@ MODULE path_base
REAL(DP) :: inter_image_dist, k_ratio
REAL(DP), ALLOCATABLE :: d_R(:,:), image_spacing(:)
CHARACTER(LEN=20) :: num_of_images_char, nstep_path_char
CHARACTER(LEN=6), EXTERNAL :: int_to_char
LOGICAL :: file_exists
!
!

2
Modules/path_io_routines.f90
View File

@ -19,7 +19,6 @@ MODULE path_io_routines
USE kinds, ONLY : DP
USE constants, ONLY : au, bohr_radius_angs
!
USE parser
USE basic_algebra_routines
!
IMPLICIT NONE
@ -372,6 +371,7 @@ MODULE path_io_routines
!
INTEGER :: i, j, ia
CHARACTER (LEN=256) :: file
CHARACTER(LEN=6), EXTERNAL :: int_to_char
!
IF ( meta_ionode ) THEN
!

2
Modules/path_opt_routines.f90
View File

@ -130,7 +130,6 @@ MODULE path_opt_routines
!
USE path_variables, ONLY : dim, use_precond, frozen
USE io_files, ONLY : iunpath, iunbfgs, tmp_dir, prefix
USE parser, ONLY : int_to_char
USE basic_algebra_routines
!
IMPLICIT NONE
@ -144,6 +143,7 @@ MODULE path_opt_routines
REAL(DP), ALLOCATABLE :: Hs(:), Hy(:), yH(:)
REAL(DP) :: sdoty, p_grad_norm
CHARACTER(LEN=256) :: bfgs_file
CHARACTER(LEN=6), EXTERNAL :: int_to_char
LOGICAL :: file_exists
!
REAL(DP), PARAMETER :: p_grad_norm_max = 0.6D0

10
Modules/read_cards.f90
View File

@ -1950,8 +1950,6 @@ MODULE read_cards_module
!------------------------------------------------------------------------
!
SUBROUTINE card_climbing_images( input_line )
!
USE parser, ONLY : int_to_char
!
IMPLICIT NONE
!
@ -1960,7 +1958,8 @@ MODULE read_cards_module
LOGICAL, EXTERNAL :: matches
!
INTEGER :: i
CHARACTER (LEN=5) :: i_char
CHARACTER(LEN=5) :: i_char
CHARACTER(LEN=6), EXTERNAL :: int_to_char
!
!
IF ( tread ) &
@ -2015,8 +2014,6 @@ MODULE read_cards_module
!------------------------------------------------------------------------
!
SUBROUTINE card_plot_wannier( input_line )
!
USE parser, ONLY : int_to_char
!
IMPLICIT NONE
!
@ -2025,7 +2022,8 @@ MODULE read_cards_module
LOGICAL, EXTERNAL :: matches
!
INTEGER :: i, ib
CHARACTER (LEN=5) :: i_char
CHARACTER(LEN=5) :: i_char
CHARACTER(LEN=6), EXTERNAL :: int_to_char
!
!
IF ( tread ) &

8
Modules/xml_io_base.f90
View File

@ -42,12 +42,12 @@ MODULE xml_io_base
!
USE mp, ONLY : mp_barrier
USE mp_global, ONLY : mpime
USE parser, ONLY : int_to_char
!
CHARACTER(LEN=*), INTENT(IN) :: dirname
!
INTEGER :: ierr, ik
INTEGER, EXTERNAL :: c_mkdir
CHARACTER(LEN=6), EXTERNAL :: int_to_char
!
ierr = 0
!
@ -69,7 +69,7 @@ MODULE xml_io_base
CLOSE( UNIT = 4, STATUS = 'DELETE' )
!
CALL errore( 'create_directory: ', &
TRIM( dirname ) // 'non existent or non writable', ierr )
TRIM( dirname ) // ' non existent or non writable', ierr )
!
RETURN
!
@ -177,14 +177,13 @@ MODULE xml_io_base
FUNCTION restart_dir( scradir, runit )
!------------------------------------------------------------------------
!
USE parser, ONLY: int_to_char
!
CHARACTER(LEN=256) :: restart_dir
CHARACTER(LEN=*), INTENT(IN) :: scradir
INTEGER, INTENT(IN) :: runit
!
CHARACTER(LEN=256) :: dirname
INTEGER :: strlen
CHARACTER(LEN=6), EXTERNAL :: int_to_char
!
! ... main restart directory
!
@ -211,7 +210,6 @@ MODULE xml_io_base
!
USE io_global, ONLY : ionode, ionode_id
USE mp, ONLY : mp_bcast
USE parser, ONLY : int_to_char
!
IMPLICIT NONE
!

9
PH/phonon.f90
View File

@ -22,12 +22,11 @@ PROGRAM phonon
USE relax, ONLY : restart_bfgs
USE basis, ONLY : startingwfc, startingpot, startingconfig
USE force_mod, ONLY : force
USE io_files, ONLY : prefix, tmp_dir, nd_nmbr
USE io_files, ONLY : prefix, tmp_dir, nd_nmbr, delete_if_present
USE mp, ONLY : mp_bcast
USE ions_base, ONLY : nat
USE lsda_mod, ONLY : nspin
USE gvect, ONLY : nrx1, nrx2, nrx3
USE parser, ONLY : int_to_char
USE control_flags, ONLY : restart, lphonon, tr2, wg_set, &
mixing_beta, lscf, david, isolve
USE qpoint, ONLY : xq, nksq
@ -35,8 +34,6 @@ PROGRAM phonon
USE control_ph, ONLY : ldisp, lnscf, lgamma, convt, epsil, trans, &
elph, zue, recover, maxirr, irr0
USE output, ONLY : fildyn, fildrho
USE parser, ONLY : delete_if_present
USE mp_global, ONLY : me_pool, root_pool
USE global_version, ONLY : version_number
USE ramanm, ONLY : lraman, elop
!
@ -51,8 +48,8 @@ PROGRAM phonon
! initial coordinates of k points
LOGICAL :: exst
CHARACTER (LEN=9) :: code = 'PHONON'
CHARACTER (LEN=256) :: auxdyn
CHARACTER (LEN=256) :: filname, filint
CHARACTER (LEN=256) :: auxdyn, filname, filint
CHARACTER(LEN=6), EXTERNAL :: int_to_char
!
!
CALL init_clocks( .TRUE. )

6
PH/phq_readin.f90
View File

@ -37,7 +37,7 @@ SUBROUTINE phq_readin()
USE partial, ONLY : atomo, list, nat_todo, nrapp
USE output, ONLY : fildyn, filelph, fildvscf, fildrho
USE disp, ONLY : nq1, nq2, nq3
USE io_files, ONLY : tmp_dir, prefix
USE io_files, ONLY : tmp_dir, prefix, trimcheck
USE noncollin_module, ONLY : noncolin
USE control_flags, ONLY : iverbosity, reduce_io, modenum
USE io_global, ONLY : ionode
@ -183,7 +183,9 @@ SUBROUTINE phq_readin()
'gamma is needed for elec.field', 1)
IF (zue.AND..NOT.trans) CALL errore ('phq_readin', 'trans must be &
&.t. for Zue calc.', 1)
tmp_dir = TRIM(outdir)
!
tmp_dir = trimcheck (outdir)
!
400 CONTINUE
CALL bcast_ph_input ( )
xqq(:) = xq(:)

3
PP/bands.f90
View File

@ -11,7 +11,7 @@
PROGRAM bands
!-----------------------------------------------------------------------
!
USE io_files, ONLY : nd_nmbr, prefix, tmp_dir
USE io_files, ONLY : nd_nmbr, prefix, tmp_dir, trimcheck
USE mp_global, ONLY : npool
USE io_global, ONLY : ionode, ionode_id
USE mp, ONLY : mp_bcast
@ -19,7 +19,6 @@ PROGRAM bands
IMPLICIT NONE
!
CHARACTER (len=256) :: filband, outdir
CHARACTER (len=256) :: trimcheck
LOGICAL :: lsigma(4)
INTEGER :: spin_component
INTEGER :: ios

3
PP/dos.f90
View File

@ -49,7 +49,7 @@ PROGRAM dos
! file, degauss=DeltaE (in Ry) and ngauss=0 will be used
!
USE io_global, ONLY : stdout, ionode, ionode_id
USE io_files, ONLY : nd_nmbr, prefix, tmp_dir
USE io_files, ONLY : nd_nmbr, prefix, tmp_dir, trimcheck
USE constants, ONLY : rytoev
USE kinds, ONLY : DP
USE klist, ONLY : xk, wk, degauss, ngauss, lgauss, nks, nkstot
@ -61,7 +61,6 @@ PROGRAM dos
!
IMPLICIT NONE
CHARACTER(len=256) :: fildos, outdir
CHARACTER(len=256), EXTERNAL :: trimcheck
REAL(DP) :: E, DOSofE (2), DOSint, Elw, Eup, DeltaE, Emin, Emax, &
degauss1
INTEGER :: nrot, ik, n, ndos, ngauss1, ios

3
PP/efg.f90
View File

@ -9,7 +9,7 @@
program efg
!-----------------------------------------------------------------------
use kinds, only : DP
use io_files, only : nd_nmbr,prefix, outdir, tmp_dir
use io_files, only : nd_nmbr,prefix, outdir, tmp_dir, trimcheck
use parameters, only : ntypx, lmaxx
use paw, only : read_recon, paw_nbeta, aephi, psphi
USE ions_base, ONLY : ntyp => nsp
@ -18,7 +18,6 @@ program efg
implicit none
character (len=256) :: filerec(ntypx)
CHARACTER(len=256), EXTERNAL :: trimcheck
real(DP) :: Q(ntypx), rc(ntypx,0:lmaxx)
integer :: ios
integer :: nt, il

3
PP/initial_state.f90
View File

@ -17,7 +17,7 @@ PROGRAM initial_state
!
USE io_global, ONLY : stdout, ionode, ionode_id
USE kinds, ONLY : DP
USE io_files, ONLY : nd_nmbr, prefix, tmp_dir, iunwfc, nwordwfc
USE io_files, ONLY : nd_nmbr, prefix, tmp_dir, iunwfc, nwordwfc, trimcheck
USE ions_base, ONLY : nat
USE klist, ONLY : nks, xk
USE wvfct, ONLY : npw, igk
@ -28,7 +28,6 @@ PROGRAM initial_state
!
IMPLICIT NONE
CHARACTER(len=256) :: outdir
CHARACTER(len=256), EXTERNAL :: trimcheck
INTEGER :: ios, ik, excite(ntypx)
NAMELIST / inputpp / outdir, prefix, excite
!

2
PP/plan_avg.f90
View File

@ -18,7 +18,7 @@ PROGRAM do_plan_avg
USE gvect, ONLY : nrx1, nrx2, nrx3, nr1, nr2, nr3, gcutm, dual, ecutwfc
USE klist, ONLY : nkstot, xk
USE ions_base, ONLY : nat, ntyp=>nsp, ityp, tau, atm, zv
USE io_files, ONLY : tmp_dir, prefix, nd_nmbr
USE io_files, ONLY : tmp_dir, prefix, nd_nmbr, trimcheck
USE io_global, ONLY : ionode, ionode_id
USE noncollin_module, ONLY : noncolin
USE wvfct, ONLY : nbnd, gamma_only

5
PP/poormanwannier.f90
View File

@ -21,12 +21,11 @@ PROGRAM poormanwannier
!
USE io_global, ONLY : stdout, ionode, ionode_id
USE kinds, ONLY : DP
USE io_files, ONLY : nd_nmbr, prefix, tmp_dir
USE io_files, ONLY : nd_nmbr, prefix, tmp_dir, trimcheck
USE mp, ONLY : mp_bcast
!
IMPLICIT NONE
CHARACTER(len=256) :: outdir
CHARACTER(len=256), EXTERNAL :: trimcheck
CHARACTER(len=256) :: outdir
INTEGER :: ios
INTEGER :: first_band, last_band
NAMELIST / inputpp / outdir, prefix, first_band, last_band

3
PP/postproc.f90
View File

@ -60,7 +60,7 @@ SUBROUTINE extract (filplot)
USE ions_base, ONLY : nat, ntyp=>nsp, ityp, tau
USE gvect
USE vlocal, ONLY : strf
USE io_files, ONLY : tmp_dir, prefix
USE io_files, ONLY : tmp_dir, prefix, trimcheck
USE io_global, ONLY : ionode, ionode_id
USE mp, ONLY : mp_bcast
@ -73,7 +73,6 @@ SUBROUTINE extract (filplot)
REAL(DP) :: emin, emax, sample_bias, z, dz, epsilon
! directory for temporary files
CHARACTER(len=256) :: outdir
CHARACTER(len=256), external :: trimcheck
NAMELIST / inputpp / outdir, prefix, plot_num, stm_wfc_matching, &
sample_bias, spin_component, z, dz, emin, emax, kpoint, kband,&

3
PP/projwfc.f90
View File

@ -85,13 +85,12 @@ PROGRAM projwfc
USE constants, ONLY : rytoev
USE kinds, ONLY : DP
USE klist, ONLY : degauss, ngauss, lgauss
USE io_files, ONLY : nd_nmbr, prefix, tmp_dir
USE io_files, ONLY : nd_nmbr, prefix, tmp_dir, trimcheck
USE noncollin_module, ONLY : noncolin
USE mp, ONLY : mp_bcast
!
IMPLICIT NONE
CHARACTER (len=256) :: filpdos, io_choice, outdir
CHARACTER (len=256), EXTERNAL :: trimcheck
REAL (DP) :: Emin, Emax, DeltaE, degauss1, smoothing
INTEGER :: ngauss1, ios
!

3
PP/pw2casino.f90
View File

@ -14,13 +14,12 @@ PROGRAM pw2casino
#include "f_defs.h"
USE io_files, ONLY : nd_nmbr, prefix, outdir, tmp_dir
USE io_files, ONLY : nd_nmbr, prefix, outdir, tmp_dir, trimcheck
USE io_global, ONLY : ionode, ionode_id
USE mp, ONLY : mp_bcast
!
IMPLICIT NONE
INTEGER :: ios
CHARACTER(len=256), EXTERNAL :: trimcheck
NAMELIST / inputpp / prefix, outdir

4
PP/pw2gw.f90
View File

@ -17,13 +17,13 @@ PROGRAM pw2gw
! This subroutine writes files containing plane wave coefficients
! and other stuff needed by GW codes
USE io_files, ONLY : nd_nmbr, prefix, outdir, tmp_dir
USE io_files, ONLY : nd_nmbr, prefix, outdir, tmp_dir, trimcheck
USE io_global, ONLY : ionode, ionode_id
USE mp, ONLY : mp_bcast
!
IMPLICIT NONE
INTEGER :: ios
CHARACTER(len=256), EXTERNAL :: trimcheck
NAMELIST / inputpp / prefix, outdir

14
PP/pw2wannier90.f90
View File

@ -30,13 +30,12 @@ program pw2wannier90
use lsda_mod, ONLY : nspin, isk
use klist, ONLY : nkstot
use ktetra, ONLY : k1, k2, k3, nk1, nk2, nk3
use io_files, ONLY : nd_nmbr, prefix, tmp_dir
use io_files, ONLY : nd_nmbr, prefix, tmp_dir, trimcheck
!
implicit none
integer :: ik, i, kunittmp
CHARACTER(LEN=4) :: spin_component
CHARACTER(len=256) :: outdir
CHARACTER(len=256), EXTERNAL :: trimcheck
integer :: ispinw
namelist / inputpp / outdir, prefix, spin_component
@ -91,7 +90,7 @@ subroutine read_nnkp
use klist, only: nkstot
use cell_base, only : at, bg
use gvect, only : g,gg
use parser, only : find_free_unit
use io_files, only : find_free_unit
use wannier
implicit none
@ -151,10 +150,9 @@ subroutine compute_mmn
use wavefunctions_module, only : evc, psic
use gsmooth, only: nls, nrxxs, nr1s, nr2s, nr3s, nrx1s, nrx2s, nrx3s
use klist, only : nkstot, xk
use io_files, only : nwordwfc, iunwfc
use io_files, only : nwordwfc, iunwfc, find_free_unit
use gvect, only : g, ngm, ecutwfc
use cell_base, only : tpiba2
use parser, only : find_free_unit
use wannier
implicit none
integer :: mmn_tot, ik, ikp, ipol, ib, ibnd, jbnd, npwq
@ -223,10 +221,9 @@ subroutine compute_amn
use klist, only: nkstot, xk
use wvfct, only : nbnd, npw, npwx, igk, g2kin
use wavefunctions_module, only : evc
use io_files, only : nwordwfc, iunwfc
use io_files, only : nwordwfc, iunwfc, find_free_unit
use gvect, only : g, ngm, ecutwfc
use cell_base, only : tpiba2
use parser, only : find_free_unit
use wannier
implicit none
complex(DP) :: amn, ZDOTC
@ -306,10 +303,11 @@ subroutine write_band
use wvfct, only : nbnd, et
use klist, only : nkstot
use constants, only: rytoev
use parser, only : find_free_unit
use io_files, only : find_free_unit
use wannier
implicit none
integer ik, ibnd
!
iun_band = find_free_unit()
open (unit=iun_band, file='BAND.dat',form='formatted')
do ik=1,nkstot

12
PW/compute_fes_grads.f90
View File

@ -33,8 +33,7 @@ SUBROUTINE compute_fes_grads( N_in, N_fin, stat )
USE ions_base, ONLY : nat, nsp, tau, ityp, if_pos
USE path_formats, ONLY : scf_fmt, scf_fmt_para
USE io_files, ONLY : prefix, tmp_dir, iunpath, iunaxsf, &
iunupdate, iunexit
USE parser, ONLY : int_to_char, delete_if_present
iunupdate, iunexit, delete_if_present
USE constants, ONLY : bohr_radius_angs
USE io_global, ONLY : stdout, ionode, ionode_id, meta_ionode
USE mp_global, ONLY : inter_image_comm, intra_image_comm, &
@ -57,8 +56,9 @@ SUBROUTINE compute_fes_grads( N_in, N_fin, stat )
LOGICAL :: opnd, file_exists
LOGICAL :: ldamped_saved
REAL(DP), ALLOCATABLE :: tauold(:,:,:)
! previous positions of atoms (needed for extrapolation)
! previous positions of atoms (needed for extrapolation)
!
CHARACTER(LEN=6), EXTERNAL :: int_to_char
REAL(DP), EXTERNAL :: get_clock
!
!
@ -508,8 +508,7 @@ SUBROUTINE metadyn()
USE control_flags, ONLY : istep, ldamped, conv_ions, nstep
USE metadyn_vars, ONLY : fe_nstep, dfe_acc, etot_av
USE constraints_module, ONLY : lagrange
USE io_files, ONLY : tmp_dir, prefix
USE parser, ONLY : delete_if_present
USE io_files, ONLY : tmp_dir, prefix, delete_if_present
!
IMPLICIT NONE
!
@ -574,8 +573,7 @@ SUBROUTINE metadyn()
!
USE metadyn_vars, ONLY : shake_nstep
USE control_flags, ONLY : istep, ldamped, nstep
USE io_files, ONLY : tmp_dir, prefix
USE parser, ONLY : delete_if_present
USE io_files, ONLY : tmp_dir, prefix, delete_if_present
!
LOGICAL, INTENT(INOUT) :: lfirst_scf
!

4
PW/compute_scf.f90
View File

@ -36,7 +36,6 @@ SUBROUTINE compute_scf( N_in, N_fin, stat )
USE path_variables, ONLY : pos, pes, grad_pes, num_of_images, &
dim, suspended_image, istep_path, &
first_last_opt, frozen, write_save
USE parser, ONLY : int_to_char
USE io_global, ONLY : stdout, ionode, ionode_id, meta_ionode
USE mp_global, ONLY : inter_image_comm, intra_image_comm, &
my_image_id, nimage, root
@ -58,8 +57,9 @@ SUBROUTINE compute_scf( N_in, N_fin, stat )
CHARACTER (LEN=256) :: tmp_dir_saved
LOGICAL :: file_exists, opnd
REAL(DP), ALLOCATABLE :: tauold(:,:,:)
! previous positions of atoms (needed for extrapolation)
! previous positions of atoms (needed for extrapolation)
!
CHARACTER(LEN=6), EXTERNAL :: int_to_char
REAL (DP), EXTERNAL :: get_clock
!
!

2
PW/dynamics_module.f90
View File

@ -489,7 +489,7 @@ MODULE dynamics_module
USE ions_base, ONLY : nat, tau
USE cell_base, ONLY : alat, at
USE constraints_module, ONLY : pbc
USE parser, ONLY : delete_if_present
USE io_files, ONLY : delete_if_present
!
IMPLICIT NONE
!

6
PW/exx.f90
View File

@ -343,16 +343,14 @@ contains
!It saves the wavefunctions for the right density matrix. in real space
!It saves all the wavefunctions in a single file called prefix.exx
USE wavefunctions_module, ONLY : evc
USE io_files, ONLY : nwordwfc
USE io_files, ONLY : prefix
USE io_files, ONLY : tmp_dir, iunwfc, iunigk
USE io_files, ONLY : nwordwfc, prefix, tmp_dir, iunwfc, &
iunigk, find_free_unit
USE io_global, ONLY : stdout
USE gvect, ONLY : nr1, nr2, nr3, nrx1, nrx2, nrx3, nrxx
USE gsmooth, ONLY : nls, nlsm, nr1s, nr2s, nr3s, &
nrx1s, nrx2s, nrx3s, nrxxs, doublegrid
USE wvfct, ONLY : nbnd, npwx, npw, igk, wg, et, gamma_only
USE klist, ONLY : wk
USE parser, ONLY : find_free_unit
USE symme, ONLY : nsym, s, ftau
use mp_global, ONLY : nproc_pool, me_pool

8
PW/input.f90
View File

@ -75,7 +75,8 @@ SUBROUTINE iosys()
USE io_files, ONLY : input_drho, output_drho, &
psfile, tmp_dir, wfc_dir, &
prefix_ => prefix, &
pseudo_dir_ => pseudo_dir
pseudo_dir_ => pseudo_dir, &
trimcheck
!
USE force_mod, ONLY : lforce, lstres, force
!
@ -262,7 +263,6 @@ SUBROUTINE iosys()
INTEGER :: i, ia, ios, is, image, nt
LOGICAL :: ltest
REAL(DP) :: theta, phi
CHARACTER (LEN=256), external :: trimcheck
!
!
CALL getenv( 'HOME', pseudo_dir )
@ -1631,12 +1631,11 @@ SUBROUTINE verify_tmpdir( tmp_dir )
!
USE input_parameters, ONLY : restart_mode
USE control_flags, ONLY : lpath
USE io_files, ONLY : prefix, nd_nmbr
USE io_files, ONLY : prefix, nd_nmbr, delete_if_present
USE path_variables, ONLY : num_of_images
USE mp_global, ONLY : mpime, nproc
USE io_global, ONLY : ionode
USE mp, ONLY : mp_barrier
USE parser, ONLY : int_to_char, delete_if_present
!
IMPLICIT NONE
!
@ -1644,6 +1643,7 @@ SUBROUTINE verify_tmpdir( tmp_dir )
!
INTEGER :: l, ios, image, proc
CHARACTER (LEN=256) :: file_path, tmp_dir_saved
CHARACTER(LEN=6), EXTERNAL :: int_to_char
INTEGER, EXTERNAL :: c_mkdir
!
!

2
PW/mix_rho.f90
View File

@ -28,7 +28,7 @@ SUBROUTINE mix_rho( rhocout, rhocin, nsout, nsin, alphamix, &
USE control_flags, ONLY : imix, tr2
USE wvfct, ONLY : gamma_only
USE wavefunctions_module, ONLY : psic
USE parser, ONLY : find_free_unit
USE io_files, ONLY : find_free_unit
USE cell_base, ONLY : omega
!
IMPLICIT NONE

3
PW/read_file.f90
View File

@ -15,7 +15,6 @@ SUBROUTINE read_file()
! ... in the pwscf program and reads them from the data file.
!
USE kinds, ONLY : DP
USE parameters, ONLY : natx
USE ions_base, ONLY : nat, nsp, ityp, tau, if_pos
USE basis, ONLY : natomwfc
USE cell_base, ONLY : tpiba2, at, bg
@ -77,7 +76,7 @@ SUBROUTINE read_file()
!
! ... allocate space for atomic positions, symmetries, forces, tetrahedra
!
IF ( nat <= 0 .OR. nat > natx ) &
IF ( nat <= 0 ) &
CALL errore( 'read_file', 'wrong number of atoms', 1 )
!
! ... allocation

3
PW/restart_from_file.f90
View File

@ -10,9 +10,8 @@ SUBROUTINE restart_from_file
!----------------------------------------------------------------------------
!
USE io_global, ONLY : stdout, ionode
USE io_files, ONLY : iunres, tmp_dir, prefix
USE io_files, ONLY : iunres, tmp_dir, prefix, delete_if_present
USE control_flags, ONLY : restart
USE parser, ONLY : delete_if_present
USE mp_global, ONLY : mpime
!
IMPLICIT NONE

4
PW/vcsmd.f90
View File

@ -5,7 +5,6 @@
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
#include "f_defs.h"
!
!----------------------------------------------------------------------------
SUBROUTINE vcsmd()
@ -41,8 +40,7 @@ SUBROUTINE vcsmd()
USE control_flags, ONLY : istep, tolp, conv_ions
USE parameters, ONLY : ntypx
USE ener, ONLY : etot
USE io_files, ONLY : prefix
USE parser, ONLY : delete_if_present
USE io_files, ONLY : prefix, delete_if_present
!
IMPLICIT NONE
!

28
PW/vcsubs.f90
View File

@ -6,6 +6,7 @@
! or http://www.gnu.org/copyleft/gpl.txt .
!
!*
#include "f_defs.h"
!*
subroutine init (mxdtyp, mxdatm, ntype, natot, rat, ityp, avec, &
vcell, force, frr, calc, temp, vx2, vy2, vz2, rms, vmean, ekin, &
@ -52,6 +53,7 @@ subroutine init (mxdtyp, mxdatm, ntype, natot, rat, ityp, avec, &
!
!
USE kinds
! USE io_global, ONLY: stdout
implicit none
!
real(DP) :: pi, twopi, zero, um, dois, tres, quatro, seis
@ -430,8 +432,10 @@ subroutine move (mxdtyp, mxdatm, ntype, ityp, rat, avec, vcell, &
! avmod(3) = lattice vectors moduli
!
!
USE kinds, only : DP
USE constants, ONLY: eps16
USE kinds, only : DP
USE constants, ONLY : eps16
USE io_global, ONLY : stdout
implicit none
!
real(DP) :: pi, twopi, zero, um, dois, tres, quatro, seis
@ -483,10 +487,12 @@ subroutine move (mxdtyp, mxdatm, ntype, ityp, rat, avec, vcell, &
!
! set the metric for the current step
!
call setg (avec, g)
!
! calculate (uncorrected) rat2d
!
do na = 1, natot
nt = ityp (na)
do i = 1, 3
@ -817,25 +823,18 @@ subroutine move (mxdtyp, mxdatm, ntype, ityp, rat, avec, vcell, &
endif
if (calc (2:2) .eq.'m') then
! WRITE( stdout,109) alpha,nst
! if(.true. ) = original version
! if(.true. ) = original version modified by Cesar Da Silva
! if(.false.) = modified algorithm by SdG
!
if (.false.) then
if (.true.) then
do na = 1, natot
do k = 1, 3
xx = rat2di (k, na) * rat2d (k, na)
if (xx.lt.zero) then
ratd (k, na) = zero
! ======================================================================
! Caution: Under testing!!!!!!!!!
rat(k,na)=rat2d(k,na)*rati(k,na)-rat2di(k,na)*rat(k,na)
rat(k,na)=rat(k,na)/(rat2d(k,na)-rat2di(k,na))
rat2d(k,na)=zero
rat2di(k,na)=zero
! ======================================================================
endif
enddo
enddo
@ -868,14 +867,10 @@ subroutine move (mxdtyp, mxdatm, ntype, ityp, rat, avec, vcell, &
xx = avec2d (l, k) * avec2di (l, k)
if (xx.lt.zero) then
avecd (l, k) = zero
! ======================================================================
! Caution: Under testing!!!!!!!!!
avec(l, k)=avec2d(l,k)*aveci(l,k)-avec2di(l,k)*avec(l,k)
avec(l, k)=avec(l,k)/(avec2d(l,k)-avec2di(l,k))
avec2d(l,k)=zero
avec2di(l,k)=zero
! ======================================================================
endif
enddo
enddo
@ -1293,7 +1288,7 @@ subroutine updg (avec, avecd, g, gd, gm1, gmgd, sigma, vcell)
!
! output: t
! g(3,3) = avec * avec
! t t
! t t
! gd(3,3) = avecd * avec + avecd * avec
! _1
! gm1(3,3) = g
@ -1468,3 +1463,4 @@ real(8) function ran3 (idum)
ran3 = mj * fac
return
end function ran3

2
PWCOND/do_cond.f90
View File

@ -79,7 +79,7 @@ SUBROUTINE do_cond(nodenumber)
!
READ (5, inputcond, err=200, iostat=ios )
200 CALL errore ('do_cond','reading inputcond namelist',ABS(ios))
tmp_dir=TRIM(outdir)
tmp_dir=trimcheck (outdir)
!
! Reading 2D k-point
READ(5, *, err=300, iostat=ios ) nkpts

5
VIB/environment.f90
View File

@ -35,17 +35,16 @@
USE io_global, ONLY: stdout, ionode
USE mp_global, ONLY: mpime, nproc
USE parser, ONLY: int_to_char
use para_mod, ONLY: me, node
use mp, only: mp_env
USE cp_version
LOGICAL :: texst
REAL(DP) :: elapsed_seconds, cclock
EXTERNAL elapsed_seconds, cclock
INTEGER :: nchar
CHARACTER(LEN=80) :: uname
CHARACTER(LEN=80) :: version_str
CHARACTER(LEN=6), EXTERNAL :: int_to_char
REAL(DP), EXTERNAL :: elapsed_seconds, cclock
CALL init_clocks( .TRUE. )

2
flib/Makefile
View File

@ -16,6 +16,7 @@ more_functionals.o \
iceil.o \
iglocal.o \
inpfile.o \
int_to_char.o \
invmat.o \
invmat_complex.o \
latgen.o \
@ -31,7 +32,6 @@ sph_bes.o \
sph_besr.o \
sph_dbes.o \
transto.o \
trimcheck.o \
date_and_tim.o \
sort_gvec.o \
volume.o \

35
flib/int_to_char.f90 Normal file
View File

@ -0,0 +1,35 @@
!-----------------------------------------------------------------------
FUNCTION int_to_char( int )
!-----------------------------------------------------------------------
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: int
CHARACTER (LEN=6) :: int_to_char
!
!
IF ( int < 10 ) THEN
!
WRITE( UNIT = int_to_char , FMT = "(I1)" ) int
!
ELSE IF ( int < 100 ) THEN
!
WRITE( UNIT = int_to_char , FMT = "(I2)" ) int
!
ELSE IF ( int < 1000 ) THEN
!
WRITE( UNIT = int_to_char , FMT = "(I3)" ) int
!
ELSE IF ( int < 10000 ) THEN
!
WRITE( UNIT = int_to_char , FMT = "(I4)" ) int
!
ELSE
!
WRITE( UNIT = int_to_char , FMT = "(I5)" ) int
!
END IF
!
RETURN
!
END FUNCTION int_to_char

31
flib/trimcheck.f90
View File

@ -1,31 +0,0 @@
!
!-----------------------------------------------------------------------
FUNCTION trimcheck ( outdir )
!-----------------------------------------------------------------------
!
! ... verify if outdir ends with /, add one if needed;
! ... trim white spaces and put the result in trimcheck
!
IMPLICIT NONE
!
CHARACTER(LEN=*), INTENT(IN) :: outdir
CHARACTER (LEN=256) :: trimcheck
INTEGER :: l
!
l = LEN_TRIM( outdir )
IF ( l == 0 ) CALL errore( 'trimcheck', ' input name empty', 1)
!
IF ( outdir(l:l) == '/' ) THEN
trimcheck = TRIM ( outdir)
ELSE
IF ( l < LEN( trimcheck ) ) THEN
trimcheck = TRIM ( outdir ) // '/'
ELSE
CALL errore( 'trimcheck', ' input name too long', l )
END IF
END IF
!
RETURN
!
END FUNCTION trimcheck

3
pwtools/q2r.f90
View File

@ -71,7 +71,6 @@ PROGRAM q2r
USE mp, ONLY : mp_start, mp_env, mp_end, mp_barrier
USE mp_global, ONLY : nproc, mpime, mp_global_start
USE dynamicalq, ONLY : phiq, tau, ityp, zeu
USE parser, ONLY : int_to_char
!
IMPLICIT NONE
!
@ -81,10 +80,10 @@ PROGRAM q2r
! dimensions of the FFT grid formed by the q-point grid
!
CHARACTER(len=20) :: crystal
CHARACTER(len=80) :: title
CHARACTER(len=256) :: fildyn, filin, filj, filf, flfrc
CHARACTER(len=3) :: atm(ntypx)
CHARACTER(len=9) :: symm_type
CHARACTER(LEN=6), EXTERNAL :: int_to_char
!
LOGICAL :: lq, lrigid, lrigid_save, lnogridinfo
CHARACTER (LEN=10) :: zasr