From 8eda231bbbcd9a69ae158107eb96409e7a9d4b5c Mon Sep 17 00:00:00 2001 From: giannozz Date: Wed, 1 Feb 2006 17:56:16 +0000 Subject: [PATCH] - 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 --- CPV/compute_fes_grads.f90 | 4 +- CPV/compute_scf.f90 | 2 +- CPV/cp_restart.f90 | 2 - CPV/environment.f90 | 5 +- CPV/ksstates.f90 | 4 +- CPV/path_routines.f90 | 2 +- D3/d3_readin.f90 | 4 +- Doc/INPUT_PW | 8 +-- Doc/users-guide.tex | 36 ++++++++-- Gamma/cg_readin.f90 | 4 +- Modules/autopilot.f90 | 2 +- Modules/bfgs_module.f90 | 3 +- Modules/constraints_module.f90 | 2 +- Modules/io_files.f90 | 101 ++++++++++++++++++++++++++++ Modules/metadyn_base.f90 | 5 +- Modules/parser.f90 | 119 +++------------------------------ Modules/path_base.f90 | 2 +- Modules/path_io_routines.f90 | 2 +- Modules/path_opt_routines.f90 | 2 +- Modules/read_cards.f90 | 10 ++- Modules/xml_io_base.f90 | 8 +-- PH/phonon.f90 | 9 +-- PH/phq_readin.f90 | 6 +- PP/bands.f90 | 3 +- PP/dos.f90 | 3 +- PP/efg.f90 | 3 +- PP/initial_state.f90 | 3 +- PP/plan_avg.f90 | 2 +- PP/poormanwannier.f90 | 5 +- PP/postproc.f90 | 3 +- PP/projwfc.f90 | 3 +- PP/pw2casino.f90 | 3 +- PP/pw2gw.f90 | 4 +- PP/pw2wannier90.f90 | 14 ++-- PW/compute_fes_grads.f90 | 12 ++-- PW/compute_scf.f90 | 4 +- PW/dynamics_module.f90 | 2 +- PW/exx.f90 | 6 +- PW/input.f90 | 8 +-- PW/mix_rho.f90 | 2 +- PW/read_file.f90 | 3 +- PW/restart_from_file.f90 | 3 +- PW/vcsmd.f90 | 4 +- PW/vcsubs.f90 | 28 ++++---- PWCOND/do_cond.f90 | 2 +- VIB/environment.f90 | 5 +- flib/Makefile | 2 +- flib/int_to_char.f90 | 35 ++++++++++ flib/trimcheck.f90 | 31 --------- pwtools/q2r.f90 | 3 +- 50 files changed, 268 insertions(+), 270 deletions(-) create mode 100644 flib/int_to_char.f90 delete mode 100644 flib/trimcheck.f90 diff --git a/CPV/compute_fes_grads.f90 b/CPV/compute_fes_grads.f90 index e27e2c54b..30e56a019 100644 --- a/CPV/compute_fes_grads.f90 +++ b/CPV/compute_fes_grads.f90 @@ -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 ! ! diff --git a/CPV/compute_scf.f90 b/CPV/compute_scf.f90 index 18543e0d3..6067781e8 100644 --- a/CPV/compute_scf.f90 +++ b/CPV/compute_scf.f90 @@ -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 ! ! diff --git a/CPV/cp_restart.f90 b/CPV/cp_restart.f90 index c33f35173..db9cca91e 100644 --- a/CPV/cp_restart.f90 +++ b/CPV/cp_restart.f90 @@ -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 ! diff --git a/CPV/environment.f90 b/CPV/environment.f90 index 71df56893..1e56ca5f8 100644 --- a/CPV/environment.f90 +++ b/CPV/environment.f90 @@ -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. ) diff --git a/CPV/ksstates.f90 b/CPV/ksstates.f90 index fd8420573..0db3fe313 100644 --- a/CPV/ksstates.f90 +++ b/CPV/ksstates.f90 @@ -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 diff --git a/CPV/path_routines.f90 b/CPV/path_routines.f90 index 0d46c23e2..a2e88733f 100644 --- a/CPV/path_routines.f90 +++ b/CPV/path_routines.f90 @@ -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 ! diff --git a/D3/d3_readin.f90 b/D3/d3_readin.f90 index a7af95670..de569a28f 100644 --- a/D3/d3_readin.f90 +++ b/D3/d3_readin.f90 @@ -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 ! diff --git a/Doc/INPUT_PW b/Doc/INPUT_PW index 4bfdfda1f..a166da73a 100644 --- a/Doc/INPUT_PW +++ b/Doc/INPUT_PW @@ -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' ) diff --git a/Doc/users-guide.tex b/Doc/users-guide.tex index a664fb1f4..25b125d79 100644 --- a/Doc/users-guide.tex +++ b/Doc/users-guide.tex @@ -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 diff --git a/Gamma/cg_readin.f90 b/Gamma/cg_readin.f90 index 499e68894..83224a3ea 100644 --- a/Gamma/cg_readin.f90 +++ b/Gamma/cg_readin.f90 @@ -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 ! diff --git a/Modules/autopilot.f90 b/Modules/autopilot.f90 index bcedd5e51..410e98d67 100644 --- a/Modules/autopilot.f90 +++ b/Modules/autopilot.f90 @@ -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 = ' ' diff --git a/Modules/bfgs_module.f90 b/Modules/bfgs_module.f90 index 3449e5e4f..af40366a9 100644 --- a/Modules/bfgs_module.f90 +++ b/Modules/bfgs_module.f90 @@ -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 ! diff --git a/Modules/constraints_module.f90 b/Modules/constraints_module.f90 index f2afde27c..7a1fb4308 100644 --- a/Modules/constraints_module.f90 +++ b/Modules/constraints_module.f90 @@ -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 diff --git a/Modules/io_files.f90 b/Modules/io_files.f90 index 50be6f06b..e8d0c8257 100644 --- a/Modules/io_files.f90 +++ b/Modules/io_files.f90 @@ -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 !=----------------------------------------------------------------------------=! diff --git a/Modules/metadyn_base.f90 b/Modules/metadyn_base.f90 index 430f76bb1..38772fa4f 100644 --- a/Modules/metadyn_base.f90 +++ b/Modules/metadyn_base.f90 @@ -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 ) diff --git a/Modules/parser.f90 b/Modules/parser.f90 index 7580956c2..9474a688a 100644 --- a/Modules/parser.f90 +++ b/Modules/parser.f90 @@ -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 ) diff --git a/Modules/path_base.f90 b/Modules/path_base.f90 index 2a021009e..9a65cdae7 100644 --- a/Modules/path_base.f90 +++ b/Modules/path_base.f90 @@ -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 ! ! diff --git a/Modules/path_io_routines.f90 b/Modules/path_io_routines.f90 index b82ae3e15..855b674e1 100644 --- a/Modules/path_io_routines.f90 +++ b/Modules/path_io_routines.f90 @@ -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 ! diff --git a/Modules/path_opt_routines.f90 b/Modules/path_opt_routines.f90 index abc4c4b42..09f223bfe 100644 --- a/Modules/path_opt_routines.f90 +++ b/Modules/path_opt_routines.f90 @@ -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 diff --git a/Modules/read_cards.f90 b/Modules/read_cards.f90 index 319d60b03..8118270fd 100644 --- a/Modules/read_cards.f90 +++ b/Modules/read_cards.f90 @@ -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 ) & diff --git a/Modules/xml_io_base.f90 b/Modules/xml_io_base.f90 index bf4283e36..fb13a7032 100644 --- a/Modules/xml_io_base.f90 +++ b/Modules/xml_io_base.f90 @@ -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 ! diff --git a/PH/phonon.f90 b/PH/phonon.f90 index 1d996c8f4..4fe637811 100644 --- a/PH/phonon.f90 +++ b/PH/phonon.f90 @@ -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. ) diff --git a/PH/phq_readin.f90 b/PH/phq_readin.f90 index b495cb5c4..0234ea5a8 100644 --- a/PH/phq_readin.f90 +++ b/PH/phq_readin.f90 @@ -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(:) diff --git a/PP/bands.f90 b/PP/bands.f90 index 74cbf38dc..7af3553f2 100644 --- a/PP/bands.f90 +++ b/PP/bands.f90 @@ -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 diff --git a/PP/dos.f90 b/PP/dos.f90 index 866728cc4..1d6526c05 100644 --- a/PP/dos.f90 +++ b/PP/dos.f90 @@ -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 diff --git a/PP/efg.f90 b/PP/efg.f90 index 9b119e107..cc2ba4614 100644 --- a/PP/efg.f90 +++ b/PP/efg.f90 @@ -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 diff --git a/PP/initial_state.f90 b/PP/initial_state.f90 index dba080568..35f77bd90 100644 --- a/PP/initial_state.f90 +++ b/PP/initial_state.f90 @@ -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 ! diff --git a/PP/plan_avg.f90 b/PP/plan_avg.f90 index 02870e259..b945cce5d 100644 --- a/PP/plan_avg.f90 +++ b/PP/plan_avg.f90 @@ -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 diff --git a/PP/poormanwannier.f90 b/PP/poormanwannier.f90 index 3f1652723..8912d9eeb 100644 --- a/PP/poormanwannier.f90 +++ b/PP/poormanwannier.f90 @@ -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 diff --git a/PP/postproc.f90 b/PP/postproc.f90 index f05bf0179..e22656bd4 100644 --- a/PP/postproc.f90 +++ b/PP/postproc.f90 @@ -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,& diff --git a/PP/projwfc.f90 b/PP/projwfc.f90 index 3b65b2c55..7be71ac3f 100644 --- a/PP/projwfc.f90 +++ b/PP/projwfc.f90 @@ -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 ! diff --git a/PP/pw2casino.f90 b/PP/pw2casino.f90 index 64745ae12..4d4f3c58d 100644 --- a/PP/pw2casino.f90 +++ b/PP/pw2casino.f90 @@ -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 diff --git a/PP/pw2gw.f90 b/PP/pw2gw.f90 index ae2258d33..c9458227b 100644 --- a/PP/pw2gw.f90 +++ b/PP/pw2gw.f90 @@ -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 diff --git a/PP/pw2wannier90.f90 b/PP/pw2wannier90.f90 index bf7dd5f38..ba64be2a9 100644 --- a/PP/pw2wannier90.f90 +++ b/PP/pw2wannier90.f90 @@ -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 diff --git a/PW/compute_fes_grads.f90 b/PW/compute_fes_grads.f90 index cb62e1435..744989ca0 100644 --- a/PW/compute_fes_grads.f90 +++ b/PW/compute_fes_grads.f90 @@ -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 ! diff --git a/PW/compute_scf.f90 b/PW/compute_scf.f90 index 7aa1b4489..b97019752 100644 --- a/PW/compute_scf.f90 +++ b/PW/compute_scf.f90 @@ -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 ! ! diff --git a/PW/dynamics_module.f90 b/PW/dynamics_module.f90 index fb4de45c0..2982443e4 100644 --- a/PW/dynamics_module.f90 +++ b/PW/dynamics_module.f90 @@ -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 ! diff --git a/PW/exx.f90 b/PW/exx.f90 index 9a60f50c5..038ed2cf8 100644 --- a/PW/exx.f90 +++ b/PW/exx.f90 @@ -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 diff --git a/PW/input.f90 b/PW/input.f90 index b334fe897..075a6a7da 100644 --- a/PW/input.f90 +++ b/PW/input.f90 @@ -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 ! ! diff --git a/PW/mix_rho.f90 b/PW/mix_rho.f90 index 9ec84f8af..977fe5a61 100644 --- a/PW/mix_rho.f90 +++ b/PW/mix_rho.f90 @@ -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 diff --git a/PW/read_file.f90 b/PW/read_file.f90 index b55e39b95..026f8bca8 100644 --- a/PW/read_file.f90 +++ b/PW/read_file.f90 @@ -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 diff --git a/PW/restart_from_file.f90 b/PW/restart_from_file.f90 index 876c5b422..4dac29fa3 100644 --- a/PW/restart_from_file.f90 +++ b/PW/restart_from_file.f90 @@ -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 diff --git a/PW/vcsmd.f90 b/PW/vcsmd.f90 index 2b9f9334f..fa7f402f8 100644 --- a/PW/vcsmd.f90 +++ b/PW/vcsmd.f90 @@ -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 ! diff --git a/PW/vcsubs.f90 b/PW/vcsubs.f90 index 3b2e225de..2b3ca134f 100644 --- a/PW/vcsubs.f90 +++ b/PW/vcsubs.f90 @@ -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 + diff --git a/PWCOND/do_cond.f90 b/PWCOND/do_cond.f90 index 698b920d5..a67f00c23 100644 --- a/PWCOND/do_cond.f90 +++ b/PWCOND/do_cond.f90 @@ -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 diff --git a/VIB/environment.f90 b/VIB/environment.f90 index 930d552ef..bff3e0cbf 100644 --- a/VIB/environment.f90 +++ b/VIB/environment.f90 @@ -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. ) diff --git a/flib/Makefile b/flib/Makefile index 0492bd247..11ae0f52b 100644 --- a/flib/Makefile +++ b/flib/Makefile @@ -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 \ diff --git a/flib/int_to_char.f90 b/flib/int_to_char.f90 new file mode 100644 index 000000000..bdf1ce4e5 --- /dev/null +++ b/flib/int_to_char.f90 @@ -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 diff --git a/flib/trimcheck.f90 b/flib/trimcheck.f90 deleted file mode 100644 index dff8c449d..000000000 --- a/flib/trimcheck.f90 +++ /dev/null @@ -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 - diff --git a/pwtools/q2r.f90 b/pwtools/q2r.f90 index 97daa7c83..c765c3b06 100644 --- a/pwtools/q2r.f90 +++ b/pwtools/q2r.f90 @@ -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