2003-07-07 05:47:17 +08:00
|
|
|
!
|
2005-10-20 23:22:12 +08:00
|
|
|
! Copyright (C) 2002-2005 Quantum-ESPRESSO group
|
2003-07-07 05:47:17 +08:00
|
|
|
! This file is distributed under the terms of the
|
|
|
|
|
! GNU General Public License. See the file `License'
|
|
|
|
|
! in the root directory of the present distribution,
|
|
|
|
|
! or http://www.gnu.org/copyleft/gpl.txt .
|
|
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
!---------------------------------------------------------------------------
|
|
|
|
|
MODULE read_cards_module
|
|
|
|
|
!---------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! ... This module handles the reading of cards from standard input
|
2004-08-18 23:53:01 +08:00
|
|
|
! ... Written by Carlo Cavazzoni and modified for "path" implementation
|
2003-11-17 19:52:06 +08:00
|
|
|
! ... by Carlo Sbraccia
|
|
|
|
|
!
|
2006-05-11 02:17:56 +08:00
|
|
|
USE kinds, ONLY : DP
|
|
|
|
|
USE io_global, ONLY : stdout
|
|
|
|
|
USE constants, ONLY : angstrom_au
|
2008-07-22 20:40:51 +08:00
|
|
|
USE parser, ONLY : field_count, read_line, get_field
|
2006-05-11 02:17:56 +08:00
|
|
|
USE io_global, ONLY : ionode, ionode_id
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
2005-07-02 04:39:45 +08:00
|
|
|
USE input_parameters
|
|
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
IMPLICIT NONE
|
|
|
|
|
!
|
|
|
|
|
SAVE
|
|
|
|
|
!
|
|
|
|
|
PRIVATE
|
|
|
|
|
!
|
|
|
|
|
PUBLIC :: read_cards
|
|
|
|
|
!
|
|
|
|
|
! ... end of module-scope declarations
|
|
|
|
|
!
|
|
|
|
|
! ----------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
CONTAINS
|
|
|
|
|
!
|
|
|
|
|
! ... Read CARDS ....
|
|
|
|
|
!
|
|
|
|
|
! ... subroutines
|
|
|
|
|
!
|
|
|
|
|
!----------------------------------------------------------------------
|
2003-07-07 05:47:17 +08:00
|
|
|
SUBROUTINE card_default_values( prog )
|
2003-11-17 19:52:06 +08:00
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
!
|
2005-08-24 22:23:09 +08:00
|
|
|
USE autopilot, ONLY : init_autopilot
|
2005-09-11 08:50:13 +08:00
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
IMPLICIT NONE
|
|
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
CHARACTER(LEN=2) :: prog
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
!
|
2005-10-20 23:22:12 +08:00
|
|
|
! ... mask that control the printing of selected Kohn-Sham occupied
|
2006-03-24 02:00:12 +08:00
|
|
|
! ... orbitals, default allocation
|
2005-10-20 23:22:12 +08:00
|
|
|
!
|
2006-03-24 02:00:12 +08:00
|
|
|
CALL allocate_input_iprnks( 0, nspin )
|
|
|
|
|
nprnks = 0
|
2005-10-20 23:22:12 +08:00
|
|
|
!
|
|
|
|
|
! ... mask that control the printing of selected Kohn-Sham unoccupied
|
2006-03-24 02:00:12 +08:00
|
|
|
! ... orbitals, default allocation
|
2005-10-20 23:22:12 +08:00
|
|
|
!
|
2006-03-24 02:00:12 +08:00
|
|
|
CALL allocate_input_iprnks_empty( 0, nspin )
|
|
|
|
|
nprnks_empty = 0
|
2005-10-20 23:22:12 +08:00
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
! ... Simulation cell from standard input
|
2005-10-20 23:22:12 +08:00
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
trd_ht = .FALSE.
|
2007-06-12 01:13:15 +08:00
|
|
|
rd_ht = 0.0_DP
|
2005-10-20 23:22:12 +08:00
|
|
|
!
|
|
|
|
|
! ... dipole
|
|
|
|
|
!
|
|
|
|
|
tdipole_card = .FALSE.
|
|
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
! ... Constraints
|
2005-10-20 23:22:12 +08:00
|
|
|
!
|
|
|
|
|
nconstr_inp = 0
|
2007-06-12 01:13:15 +08:00
|
|
|
constr_tol_inp = 1.E-6_DP
|
2005-10-20 23:22:12 +08:00
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
! ... ionic mass initialization
|
2005-10-20 23:22:12 +08:00
|
|
|
!
|
2007-06-12 01:13:15 +08:00
|
|
|
atom_mass = 0.0_DP
|
2005-10-20 23:22:12 +08:00
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
! ... dimension of the real space Ewald summation
|
2005-10-20 23:22:12 +08:00
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
iesr_inp = 1
|
2005-10-20 23:22:12 +08:00
|
|
|
!
|
|
|
|
|
! ... k-points
|
|
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
k_points = 'gamma'
|
2005-10-20 23:22:12 +08:00
|
|
|
tk_inp = .FALSE.
|
|
|
|
|
nkstot = 1
|
|
|
|
|
nk1 = 0
|
|
|
|
|
nk2 = 0
|
|
|
|
|
nk3 = 0
|
|
|
|
|
k1 = 0
|
|
|
|
|
k2 = 0
|
|
|
|
|
k3 = 0
|
|
|
|
|
!
|
|
|
|
|
! ... neighbours
|
|
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
tneighbo = .FALSE.
|
2007-06-12 01:13:15 +08:00
|
|
|
neighbo_radius = 0.0_DP
|
2005-10-20 23:22:12 +08:00
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
! ... Turbo
|
2005-10-20 23:22:12 +08:00
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
tturbo_inp = .FALSE.
|
|
|
|
|
nturbo_inp = 0
|
2005-10-20 23:22:12 +08:00
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
! ... Grids
|
2005-10-20 23:22:12 +08:00
|
|
|
!
|
|
|
|
|
t2dpegrid_inp = .FALSE.
|
|
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
! ... Electronic states
|
2005-10-20 23:22:12 +08:00
|
|
|
!
|
|
|
|
|
tf_inp = .FALSE.
|
|
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
! ... Hartree planar mean
|
2005-10-20 23:22:12 +08:00
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
tvhmean_inp = .false.
|
|
|
|
|
vhnr_inp = 0
|
|
|
|
|
vhiunit_inp = 0
|
2007-06-12 01:13:15 +08:00
|
|
|
vhrmin_inp = 0.0_DP
|
|
|
|
|
vhrmax_inp = 0.0_DP
|
2003-11-17 19:52:06 +08:00
|
|
|
vhasse_inp = 'K'
|
2005-10-20 23:22:12 +08:00
|
|
|
!
|
|
|
|
|
! ... tchi
|
|
|
|
|
!
|
|
|
|
|
tchi2_inp = .FALSE.
|
|
|
|
|
!
|
|
|
|
|
! ... ion_velocities
|
|
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
tavel = .FALSE.
|
2005-10-20 23:22:12 +08:00
|
|
|
!
|
|
|
|
|
! ... setnfi
|
|
|
|
|
!
|
|
|
|
|
newnfi_card = -1
|
2003-11-17 19:52:06 +08:00
|
|
|
tnewnfi_card = .FALSE.
|
|
|
|
|
!
|
2005-09-11 08:50:13 +08:00
|
|
|
CALL init_autopilot()
|
|
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
RETURN
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
2005-12-28 23:57:48 +08:00
|
|
|
END SUBROUTINE card_default_values
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
!----------------------------------------------------------------------
|
2003-07-07 05:47:17 +08:00
|
|
|
SUBROUTINE read_cards( prog )
|
2003-11-17 19:52:06 +08:00
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
!
|
2005-08-24 22:23:09 +08:00
|
|
|
USE autopilot, ONLY : card_autopilot
|
2005-09-11 08:50:13 +08:00
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
IMPLICIT NONE
|
|
|
|
|
!
|
2005-07-02 04:39:45 +08:00
|
|
|
CHARACTER(LEN=2) :: prog ! calling program ( FP, PW, CP )
|
|
|
|
|
CHARACTER(LEN=256) :: input_line
|
|
|
|
|
CHARACTER(LEN=80) :: card
|
2004-05-20 00:56:56 +08:00
|
|
|
CHARACTER(LEN=1), EXTERNAL :: capital
|
2005-07-02 04:39:45 +08:00
|
|
|
LOGICAL :: tend
|
|
|
|
|
INTEGER :: i
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
CALL card_default_values( prog )
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
100 CALL read_line( input_line, end_of_file=tend )
|
|
|
|
|
!
|
|
|
|
|
IF( tend ) GO TO 120
|
|
|
|
|
IF( input_line == ' ' .OR. input_line(1:1) == '#' ) GO TO 100
|
|
|
|
|
!
|
|
|
|
|
READ (input_line, *) card
|
|
|
|
|
!
|
|
|
|
|
DO i = 1, LEN_TRIM( input_line )
|
|
|
|
|
input_line( i : i ) = capital( input_line( i : i ) )
|
|
|
|
|
END DO
|
|
|
|
|
!
|
2005-08-24 22:23:09 +08:00
|
|
|
IF ( TRIM(card) == 'AUTOPILOT' ) THEN
|
|
|
|
|
!
|
|
|
|
|
CALL card_autopilot( input_line )
|
|
|
|
|
!
|
|
|
|
|
ELSE IF ( TRIM(card) == 'ATOMIC_SPECIES' ) THEN
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
CALL card_atomic_species( input_line, prog )
|
|
|
|
|
!
|
|
|
|
|
ELSE IF ( TRIM(card) == 'ATOMIC_POSITIONS' ) THEN
|
|
|
|
|
!
|
|
|
|
|
CALL card_atomic_positions( input_line, prog )
|
|
|
|
|
!
|
2008-07-23 00:48:11 +08:00
|
|
|
ELSE IF ( TRIM(card) == 'ATOMIC_FORCES' ) THEN
|
|
|
|
|
!
|
|
|
|
|
CALL card_atomic_forces( input_line, prog )
|
|
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
ELSE IF ( TRIM(card) == 'SETNFI' ) THEN
|
|
|
|
|
!
|
|
|
|
|
CALL card_setnfi( input_line )
|
|
|
|
|
IF ( ( prog == 'PW' .OR. prog == 'CP' ) .AND. ionode ) &
|
2005-05-27 06:42:05 +08:00
|
|
|
WRITE( stdout,'(A)') 'Warning: card '//trim(input_line)//' ignored'
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
ELSE IF ( TRIM(card) == 'CONSTRAINTS' ) THEN
|
|
|
|
|
!
|
|
|
|
|
CALL card_constraints( input_line )
|
|
|
|
|
!
|
2006-05-01 09:07:57 +08:00
|
|
|
ELSE IF ( TRIM(card) == 'COLLECTIVE_VARS' ) THEN
|
|
|
|
|
!
|
|
|
|
|
CALL card_collective_vars( input_line )
|
2006-12-11 22:51:54 +08:00
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
ELSE IF ( TRIM(card) == 'VHMEAN' ) THEN
|
|
|
|
|
!
|
|
|
|
|
CALL card_vhmean( input_line )
|
|
|
|
|
IF ( ( prog == 'PW' .OR. prog == 'CP' ) .AND. ionode ) &
|
2005-05-27 06:42:05 +08:00
|
|
|
WRITE( stdout,'(A)') 'Warning: card '//trim(input_line)//' ignored'
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
ELSE IF ( TRIM(card) == 'DIPOLE' ) THEN
|
|
|
|
|
!
|
|
|
|
|
CALL card_dipole( input_line )
|
|
|
|
|
IF ( ( prog == 'PW' .OR. prog == 'CP' ) .AND. ionode ) &
|
2005-05-27 06:42:05 +08:00
|
|
|
WRITE( stdout,'(A)') 'Warning: card '//trim(input_line)//' ignored'
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
ELSE IF ( TRIM(card) == 'ESR' ) THEN
|
|
|
|
|
!
|
|
|
|
|
CALL card_esr( input_line )
|
|
|
|
|
IF ( ( prog == 'PW' .OR. prog == 'CP' ) .AND. ionode ) &
|
2005-05-27 06:42:05 +08:00
|
|
|
WRITE( stdout,'(A)') 'Warning: card '//trim(input_line)//' ignored'
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
ELSE IF ( TRIM(card) == 'K_POINTS' ) THEN
|
|
|
|
|
!
|
2007-02-06 00:38:52 +08:00
|
|
|
IF ( prog == 'CP' ) THEN
|
|
|
|
|
IF( ionode ) WRITE( stdout,'(A)') 'Warning: card '//trim(input_line)//' ignored'
|
|
|
|
|
ELSE
|
|
|
|
|
CALL card_kpoints( input_line )
|
|
|
|
|
END IF
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
ELSE IF ( TRIM(card) == 'NEIGHBOURS' ) THEN
|
|
|
|
|
!
|
|
|
|
|
CALL card_neighbours( input_line )
|
|
|
|
|
IF ( ( prog == 'PW' .OR. prog == 'CP' ) .AND. ionode ) &
|
2005-05-27 06:42:05 +08:00
|
|
|
WRITE( stdout,'(A)') 'Warning: card '//trim(input_line)//' ignored'
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
ELSE IF ( TRIM(card) == 'OCCUPATIONS' ) THEN
|
|
|
|
|
!
|
|
|
|
|
CALL card_occupations( input_line )
|
|
|
|
|
!
|
|
|
|
|
ELSE IF ( TRIM(card) == 'CELL_PARAMETERS' ) THEN
|
|
|
|
|
!
|
|
|
|
|
CALL card_cell_parameters( input_line )
|
|
|
|
|
!
|
|
|
|
|
ELSE IF ( TRIM(card) == 'TURBO' ) THEN
|
|
|
|
|
!
|
|
|
|
|
CALL card_turbo( input_line )
|
|
|
|
|
IF ( ( prog == 'PW' .OR. prog == 'CP' ) .AND. ionode ) &
|
2005-05-27 06:42:05 +08:00
|
|
|
WRITE( stdout,'(A)') 'Warning: card '//trim(input_line)//' ignored'
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
- FPMD: pseudopotential variable wsg, wnl, fnl substituted with
dion, beta, bec everyware.
- subroutines formfn, compute_beta, nlsm1, nlsm2, ecc ... now are common
between FPMD and CPV, a lot of clean ups!
- Changes in stdout: relevant physical quantities ( positions velocities an cell )
are now printed with the seme format of the corresponding input card,
like in PW, as was suggested by SdG.
- exemple23 updated to reflect the new input namelist "wannier"
- Subroutine init_run now is used in FPMD too.
- WARNING in the stress computed with CP, for a pseudo with core-corrections,
a contribution is missing! Not yet fixed, I need to talk with PG for the
box staff.
- WARNING the examples reference are not updated, I'm on the IBM sp, and
I prefer to update them from a linux machine.
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@2110 c92efa57-630b-4861-b058-cf58834340f0
2005-08-22 22:14:13 +08:00
|
|
|
ELSE IF ( TRIM(card) == 'ATOMIC_VELOCITIES' ) THEN
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
CALL card_ion_velocities( input_line )
|
2005-05-27 06:42:05 +08:00
|
|
|
IF ( ( prog == 'PW' .OR. prog == 'CP' ) .AND. ionode ) &
|
|
|
|
|
WRITE( stdout,'(A)') 'Warning: card '//trim(input_line)//' ignored'
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
ELSE IF ( TRIM(card) == 'KSOUT' ) THEN
|
|
|
|
|
!
|
|
|
|
|
CALL card_ksout( input_line )
|
2006-06-01 18:51:33 +08:00
|
|
|
IF ( ( prog == 'PW' ) .AND. ionode ) &
|
2005-05-27 06:42:05 +08:00
|
|
|
WRITE( stdout,'(a)') 'Warning: card '//trim(input_line)//' ignored'
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
ELSE IF ( TRIM(card) == 'KSOUT_EMPTY' ) THEN
|
|
|
|
|
!
|
|
|
|
|
CALL card_ksout_empty( input_line )
|
2006-06-01 18:51:33 +08:00
|
|
|
IF ( ( prog == 'PW' ) .AND. ionode ) &
|
2005-05-27 06:42:05 +08:00
|
|
|
WRITE( stdout,'(A)') 'Warning: card '//trim(input_line)//' ignored'
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
2003-11-24 23:24:07 +08:00
|
|
|
ELSE IF ( TRIM(card) == 'CLIMBING_IMAGES' ) THEN
|
|
|
|
|
!
|
|
|
|
|
CALL card_climbing_images( input_line )
|
2004-04-02 00:30:59 +08:00
|
|
|
|
2005-07-02 04:39:45 +08:00
|
|
|
ELSE IF ( TRIM(card) == 'PLOT_WANNIER' ) THEN
|
|
|
|
|
!
|
|
|
|
|
CALL card_plot_wannier( input_line )
|
|
|
|
|
|
2003-11-17 19:52:06 +08:00
|
|
|
ELSE
|
|
|
|
|
!
|
|
|
|
|
IF ( ionode ) &
|
2003-12-06 18:32:04 +08:00
|
|
|
WRITE( stdout,'(A)') 'Warning: card '//TRIM(input_line)//' ignored'
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
END IF
|
|
|
|
|
!
|
2005-10-20 23:22:12 +08:00
|
|
|
! ... END OF LOOP ... !
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
GOTO 100
|
|
|
|
|
!
|
|
|
|
|
120 CONTINUE
|
|
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
RETURN
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
2005-12-28 23:57:48 +08:00
|
|
|
END SUBROUTINE read_cards
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
! ... Description of the allowed input CARDS for FPMD code
|
|
|
|
|
!
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
! BEGIN manual
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! ATOMIC_SPECIES
|
|
|
|
|
!
|
|
|
|
|
! set the atomic species been read and their pseudopotential file
|
|
|
|
|
!
|
|
|
|
|
! Syntax:
|
|
|
|
|
!
|
|
|
|
|
! ATOMIC_SPECIE
|
|
|
|
|
! label(1) mass(1) psfile(1)
|
|
|
|
|
! ... ... ...
|
|
|
|
|
! label(n) mass(n) psfile(n)
|
|
|
|
|
!
|
|
|
|
|
! Example:
|
|
|
|
|
!
|
|
|
|
|
! ATOMIC_SPECIES
|
2007-06-12 01:13:15 +08:00
|
|
|
! O 16.0 O.BLYP.UPF
|
|
|
|
|
! H 1.00 H.fpmd.UPF
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
! Where:
|
|
|
|
|
!
|
|
|
|
|
! label(i) ( character(len=4) ) label of the atomic species
|
|
|
|
|
! mass(i) ( real ) atomic mass
|
|
|
|
|
! ( in u.m.a, carbon mass is 12.0 )
|
|
|
|
|
! psfile(i) ( character(len=80) ) file name of the pseudopotential
|
|
|
|
|
!
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
! END manual
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
SUBROUTINE card_atomic_species( input_line, prog )
|
|
|
|
|
!
|
|
|
|
|
IMPLICIT NONE
|
|
|
|
|
!
|
|
|
|
|
CHARACTER(LEN=256) :: input_line
|
|
|
|
|
CHARACTER(LEN=2) :: prog
|
2005-04-11 16:14:30 +08:00
|
|
|
INTEGER :: is, ip
|
2003-11-17 19:52:06 +08:00
|
|
|
CHARACTER(LEN=4) :: lb_pos
|
2004-10-26 17:32:48 +08:00
|
|
|
CHARACTER(LEN=256) :: psfile
|
2003-11-17 19:52:06 +08:00
|
|
|
LOGICAL, SAVE :: tread = .FALSE.
|
|
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
IF ( tread ) THEN
|
2008-03-11 23:38:23 +08:00
|
|
|
CALL errore( ' card_atomic_species ', ' two occurrences', 2 )
|
2003-11-17 19:52:06 +08:00
|
|
|
END IF
|
|
|
|
|
IF ( ntyp > nsx ) THEN
|
|
|
|
|
CALL errore( ' card_atomic_species ', ' nsp out of range ', ntyp )
|
|
|
|
|
END IF
|
|
|
|
|
!
|
|
|
|
|
DO is = 1, ntyp
|
|
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
CALL read_line( input_line )
|
2004-06-01 01:55:33 +08:00
|
|
|
READ( input_line, * ) lb_pos, atom_mass(is), psfile
|
2003-11-17 19:52:06 +08:00
|
|
|
atom_pfile(is) = TRIM( psfile )
|
2003-07-07 05:47:17 +08:00
|
|
|
lb_pos = ADJUSTL( lb_pos )
|
2003-11-17 19:52:06 +08:00
|
|
|
atom_label(is) = TRIM( lb_pos )
|
|
|
|
|
!
|
2007-07-18 00:26:27 +08:00
|
|
|
! IF ( atom_mass(is) <= 0.0_DP ) THEN
|
|
|
|
|
! CALL errore( ' card_atomic_species ',' invalid atom_mass ', is )
|
|
|
|
|
! END IF
|
2005-04-11 16:14:30 +08:00
|
|
|
DO ip = 1, is - 1
|
|
|
|
|
IF ( atom_label(ip) == atom_label(is) ) THEN
|
|
|
|
|
CALL errore( ' card_atomic_species ', &
|
|
|
|
|
& ' two occurrences of the same atomic label ', is )
|
|
|
|
|
END IF
|
|
|
|
|
END DO
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
END DO
|
|
|
|
|
taspc = .TRUE.
|
|
|
|
|
tread = .TRUE.
|
|
|
|
|
!
|
|
|
|
|
RETURN
|
|
|
|
|
!
|
2005-12-28 23:57:48 +08:00
|
|
|
END SUBROUTINE card_atomic_species
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
! BEGIN manual
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! ATOMIC_POSITIONS
|
|
|
|
|
!
|
|
|
|
|
! set the atomic positions in the cell
|
|
|
|
|
!
|
|
|
|
|
! Syntax:
|
|
|
|
|
!
|
|
|
|
|
! ATOMIC_POSITIONS (units_option)
|
|
|
|
|
! label(1) tau(1,1) tau(2,1) tau(3,1) mbl(1,1) mbl(2,1) mbl(3,1)
|
|
|
|
|
! label(2) tau(1,2) tau(2,2) tau(3,2) mbl(1,2) mbl(2,2) mbl(3,2)
|
|
|
|
|
! ... ... ... ... ...
|
|
|
|
|
! label(n) tau(1,n) tau(2,n) tau(3,n) mbl(1,3) mbl(2,3) mbl(3,3)
|
|
|
|
|
!
|
|
|
|
|
! Example:
|
|
|
|
|
!
|
|
|
|
|
! ATOMIC_POSITIONS (bohr)
|
|
|
|
|
! O 0.0099 0.0099 0.0000 0 0 0
|
|
|
|
|
! H 1.8325 -0.2243 -0.0001 1 1 1
|
|
|
|
|
! H -0.2243 1.8325 0.0002 1 1 1
|
2007-04-06 03:53:16 +08:00
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
! Where:
|
|
|
|
|
!
|
|
|
|
|
! units_option == crystal position are given in scaled units
|
|
|
|
|
! units_option == bohr position are given in Bohr
|
|
|
|
|
! units_option == angstrom position are given in Angstrom
|
|
|
|
|
! units_option == alat position are given in units of alat
|
|
|
|
|
!
|
|
|
|
|
! label(k) ( character(len=4) ) atomic type
|
|
|
|
|
! tau(:,k) ( real ) coordinates of the k-th atom
|
|
|
|
|
! mbl(:,k) ( integer ) mbl(i,k) > 0 the i-th coord. of the
|
|
|
|
|
! k-th atom is allowed to be moved
|
|
|
|
|
!
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
! END manual
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! ... routine modified for NEB ( C.S. 21/10/2003 )
|
2004-06-29 01:42:18 +08:00
|
|
|
! ... routine modified for SMD ( Y.K. 15/04/2004 )
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
SUBROUTINE card_atomic_positions( input_line, prog )
|
|
|
|
|
!
|
|
|
|
|
IMPLICIT NONE
|
|
|
|
|
!
|
|
|
|
|
CHARACTER(LEN=256) :: input_line
|
|
|
|
|
CHARACTER(LEN=2) :: prog
|
|
|
|
|
CHARACTER(LEN=4) :: lb_pos
|
2006-12-01 22:41:55 +08:00
|
|
|
INTEGER :: ia, k, is, nfield, idx, rep_i
|
2004-05-20 00:56:56 +08:00
|
|
|
LOGICAL, EXTERNAL :: matches
|
2006-03-08 18:08:58 +08:00
|
|
|
LOGICAL :: tend
|
2003-11-17 19:52:06 +08:00
|
|
|
LOGICAL, SAVE :: tread = .FALSE.
|
|
|
|
|
!
|
2008-07-22 20:40:51 +08:00
|
|
|
REAL(DP),EXTERNAL :: eval_infix
|
|
|
|
|
INTEGER :: ifield, ierr
|
|
|
|
|
REAL(DP) :: field_value
|
|
|
|
|
CHARACTER(len=256) :: field_str, error_msg
|
|
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
IF ( tread ) THEN
|
2008-03-18 17:40:02 +08:00
|
|
|
CALL errore( 'card_atomic_positions', 'two occurrences', 2 )
|
2003-11-17 19:52:06 +08:00
|
|
|
END IF
|
|
|
|
|
IF ( .NOT. taspc ) THEN
|
2006-02-28 04:06:23 +08:00
|
|
|
CALL errore( 'card_atomic_positions', &
|
|
|
|
|
& 'ATOMIC_SPECIES must be present before', 2 )
|
2003-11-17 19:52:06 +08:00
|
|
|
END IF
|
|
|
|
|
IF ( ntyp > nsx ) THEN
|
2006-02-28 04:06:23 +08:00
|
|
|
CALL errore( 'card_atomic_positions', 'nsp out of range', ntyp )
|
2003-11-17 19:52:06 +08:00
|
|
|
END IF
|
2006-03-24 02:00:12 +08:00
|
|
|
IF ( nat < 1 ) THEN
|
2006-02-28 04:06:23 +08:00
|
|
|
CALL errore( 'card_atomic_positions', 'nat out of range', nat )
|
2003-11-17 19:52:06 +08:00
|
|
|
END IF
|
|
|
|
|
!
|
|
|
|
|
if_pos = 1
|
2005-05-27 06:42:05 +08:00
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
sp_pos = 0
|
2007-06-12 01:13:15 +08:00
|
|
|
rd_pos = 0.0_DP
|
2003-11-17 19:52:06 +08:00
|
|
|
na_inp = 0
|
|
|
|
|
!
|
|
|
|
|
IF ( matches( "CRYSTAL", input_line ) ) THEN
|
2003-07-07 05:47:17 +08:00
|
|
|
atomic_positions = 'crystal'
|
2003-11-17 19:52:06 +08:00
|
|
|
ELSE IF ( matches( "BOHR", input_line ) ) THEN
|
2003-07-07 05:47:17 +08:00
|
|
|
atomic_positions = 'bohr'
|
2003-11-17 19:52:06 +08:00
|
|
|
ELSE IF ( matches( "ANGSTROM", input_line ) ) THEN
|
2003-07-07 05:47:17 +08:00
|
|
|
atomic_positions = 'angstrom'
|
2003-11-17 19:52:06 +08:00
|
|
|
ELSE IF ( matches( "ALAT", input_line ) ) THEN
|
2003-07-07 05:47:17 +08:00
|
|
|
atomic_positions = 'alat'
|
2003-11-17 19:52:06 +08:00
|
|
|
ELSE
|
2004-01-29 02:14:17 +08:00
|
|
|
IF ( TRIM( ADJUSTL( input_line ) ) /= 'ATOMIC_POSITIONS' ) THEN
|
2006-02-28 04:06:23 +08:00
|
|
|
CALL errore( 'read_cards ', &
|
2009-02-05 04:54:44 +08:00
|
|
|
& 'unknown option for ATOMIC_POSITION: '&
|
2006-02-28 04:06:23 +08:00
|
|
|
& // input_line, 1 )
|
2004-01-29 02:14:17 +08:00
|
|
|
END IF
|
All namelists and cards moved to Modules/input_parameters.f90 .
From now on, all new input variables should be added
to this module, and then copied to the code internal
variables in the input.f90 subroutine
The namelists and cards parsers are in :
Modules/read_namelists.f90 and Modules/read_cards.f90
files input_parameters.f90 read_namelists.f90 read_cards.f90
are shared by all codes, while each code has its own version
of input.f90 ( used to copy input values into internals variables ).
EXAMPLE:
suppose you need to add a new input variable called "pippo"
to the namelist control, then:
1) add pippo to the input_parameters.f90 file containing the
namelist control
INTEGER :: pippo = 0
NAMELIST / control / ....., pippo
remember: always set an initialization value!
2) add pippo to the control_default subroutine
( cantained in module read_namelists.f90 )
subroutine control_default( prog )
...
IF( prog == 'PW' ) pippo = 10
...
end subroutine
this routine set the default value for pippo,
that could vary with the code
3) add pippo to the control_bcast subroutine
( cantained in module read_namelists.f90 )
subroutine control_bcast( )
...
call mp_bcast( pippo )
...
end subroutine
4) add pippo to the control_checkin subroutine
( cantained in module read_namelists.f90 )
subroutine control_checking( prog )
...
IF( pippo < 0 ) &
CALL error(' control_checkin ',' variable pippo less than 0 ', 1 )
...
end subroutine
5) Copy the value of pippo in the code internal variables
( file input.f90 )
subroutine iosys()
use input_parameters, only: ...., pippo
use pwcom, only: ....., myvar
...
call read_namelists( 'PW' )
...
myvar = pippo
...
end subroutine
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@282 c92efa57-630b-4861-b058-cf58834340f0
2003-07-31 21:24:20 +08:00
|
|
|
IF ( prog == 'FP' ) atomic_positions = 'bohr'
|
2003-07-08 05:58:02 +08:00
|
|
|
IF ( prog == 'CP' ) atomic_positions = 'bohr'
|
All namelists and cards moved to Modules/input_parameters.f90 .
From now on, all new input variables should be added
to this module, and then copied to the code internal
variables in the input.f90 subroutine
The namelists and cards parsers are in :
Modules/read_namelists.f90 and Modules/read_cards.f90
files input_parameters.f90 read_namelists.f90 read_cards.f90
are shared by all codes, while each code has its own version
of input.f90 ( used to copy input values into internals variables ).
EXAMPLE:
suppose you need to add a new input variable called "pippo"
to the namelist control, then:
1) add pippo to the input_parameters.f90 file containing the
namelist control
INTEGER :: pippo = 0
NAMELIST / control / ....., pippo
remember: always set an initialization value!
2) add pippo to the control_default subroutine
( cantained in module read_namelists.f90 )
subroutine control_default( prog )
...
IF( prog == 'PW' ) pippo = 10
...
end subroutine
this routine set the default value for pippo,
that could vary with the code
3) add pippo to the control_bcast subroutine
( cantained in module read_namelists.f90 )
subroutine control_bcast( )
...
call mp_bcast( pippo )
...
end subroutine
4) add pippo to the control_checkin subroutine
( cantained in module read_namelists.f90 )
subroutine control_checking( prog )
...
IF( pippo < 0 ) &
CALL error(' control_checkin ',' variable pippo less than 0 ', 1 )
...
end subroutine
5) Copy the value of pippo in the code internal variables
( file input.f90 )
subroutine iosys()
use input_parameters, only: ...., pippo
use pwcom, only: ....., myvar
...
call read_namelists( 'PW' )
...
myvar = pippo
...
end subroutine
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@282 c92efa57-630b-4861-b058-cf58834340f0
2003-07-31 21:24:20 +08:00
|
|
|
IF ( prog == 'PW' ) atomic_positions = 'alat'
|
2003-11-17 19:52:06 +08:00
|
|
|
END IF
|
|
|
|
|
!
|
2006-02-28 04:06:23 +08:00
|
|
|
IF ( full_phs_path_flag ) THEN
|
2006-04-02 08:28:20 +08:00
|
|
|
!
|
|
|
|
|
IF ( ALLOCATED( pos ) ) DEALLOCATE( pos )
|
|
|
|
|
ALLOCATE( pos( 3*nat, num_of_images ) )
|
2007-06-12 01:13:15 +08:00
|
|
|
pos(:,:) = 0.0_DP
|
2005-05-27 06:42:05 +08:00
|
|
|
!
|
2006-02-28 04:06:23 +08:00
|
|
|
IF ( calculation == 'smd' .AND. prog == 'CP' ) THEN
|
2005-05-27 06:42:05 +08:00
|
|
|
!
|
2007-11-02 22:38:04 +08:00
|
|
|
CALL errore( 'read_cards', &
|
|
|
|
|
'smd no longer implemented in CP', 1 )
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
ELSE
|
2004-05-28 23:45:19 +08:00
|
|
|
!
|
2006-03-08 18:08:58 +08:00
|
|
|
CALL read_line( input_line, end_of_file = tend )
|
2006-04-01 00:00:17 +08:00
|
|
|
IF ( tend ) &
|
|
|
|
|
CALL errore( 'read_cards', &
|
|
|
|
|
'end of file reading atomic positions (path)', 1 )
|
2004-05-28 23:45:19 +08:00
|
|
|
!
|
2006-02-28 04:06:23 +08:00
|
|
|
IF ( matches( "first_image", input_line ) ) THEN
|
2007-04-06 03:53:16 +08:00
|
|
|
!
|
2006-02-28 04:06:23 +08:00
|
|
|
input_images = 1
|
|
|
|
|
CALL path_read_images( input_images )
|
|
|
|
|
!
|
|
|
|
|
ELSE
|
|
|
|
|
!
|
|
|
|
|
CALL errore( 'read_cards', &
|
2006-04-01 00:00:17 +08:00
|
|
|
'first_image missing in ATOMIC_POSITION', 1 )
|
2006-02-28 04:06:23 +08:00
|
|
|
!
|
2007-04-06 03:53:16 +08:00
|
|
|
END IF
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
2007-04-06 03:53:16 +08:00
|
|
|
read_conf_loop: DO
|
2006-02-28 04:06:23 +08:00
|
|
|
!
|
2006-03-08 18:08:58 +08:00
|
|
|
CALL read_line( input_line, end_of_file = tend )
|
|
|
|
|
!
|
2006-04-01 00:00:17 +08:00
|
|
|
IF ( tend ) &
|
|
|
|
|
CALL errore( 'read_cards', 'end of file reading ' // &
|
|
|
|
|
& 'atomic positions (path)', input_images + 1 )
|
2006-02-28 04:06:23 +08:00
|
|
|
!
|
2007-04-06 03:53:16 +08:00
|
|
|
input_images = input_images + 1
|
2006-02-28 04:06:23 +08:00
|
|
|
IF ( input_images > num_of_images ) &
|
|
|
|
|
CALL errore( 'read_cards', &
|
|
|
|
|
& 'too many images in ATOMIC_POSITION', 1 )
|
|
|
|
|
!
|
|
|
|
|
IF ( matches( "intermediate_image", input_line ) ) THEN
|
|
|
|
|
!
|
|
|
|
|
CALL path_read_images( input_images )
|
|
|
|
|
!
|
|
|
|
|
ELSE
|
|
|
|
|
!
|
|
|
|
|
EXIT read_conf_loop
|
|
|
|
|
!
|
|
|
|
|
END IF
|
|
|
|
|
!
|
|
|
|
|
END DO read_conf_loop
|
2004-05-28 23:45:19 +08:00
|
|
|
!
|
2006-02-28 04:06:23 +08:00
|
|
|
IF ( matches( "last_image", input_line ) ) THEN
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
2004-08-18 23:53:01 +08:00
|
|
|
CALL path_read_images( input_images )
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
2004-05-28 23:45:19 +08:00
|
|
|
ELSE
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
2006-02-28 04:06:23 +08:00
|
|
|
CALL errore( 'read_cards ', &
|
2006-04-01 00:00:17 +08:00
|
|
|
'last_image missing in ATOMIC_POSITION', 1 )
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
2004-05-28 23:45:19 +08:00
|
|
|
END IF
|
|
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
END IF
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
ELSE
|
|
|
|
|
!
|
|
|
|
|
DO ia = 1, nat
|
|
|
|
|
!
|
2006-03-08 18:08:58 +08:00
|
|
|
CALL read_line( input_line, end_of_file = tend )
|
2006-04-01 00:00:17 +08:00
|
|
|
IF ( tend ) &
|
|
|
|
|
CALL errore( 'read_cards', &
|
|
|
|
|
'end of file reading atomic positions', ia )
|
2006-03-08 18:08:58 +08:00
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
CALL field_count( nfield, input_line )
|
|
|
|
|
!
|
2006-04-01 00:00:17 +08:00
|
|
|
IF ( sic /= 'none' .AND. nfield /= 8 ) &
|
|
|
|
|
CALL errore( 'read_cards', &
|
|
|
|
|
'ATOMIC_POSITIONS with sic, 8 columns required', 1 )
|
2004-04-02 00:30:59 +08:00
|
|
|
!
|
2008-07-22 20:40:51 +08:00
|
|
|
IF ( nfield /= 4 .and. nfield /= 7 .and. nfield /= 8) &
|
2008-03-18 17:40:02 +08:00
|
|
|
CALL errore( 'read_cards', 'wrong number of columns ' // &
|
|
|
|
|
& 'in ATOMIC_POSITIONS', ia )
|
2008-07-22 20:40:51 +08:00
|
|
|
|
|
|
|
|
! read atom symbol (column 1) and coordinate
|
|
|
|
|
CALL get_field(1, lb_pos, input_line)
|
|
|
|
|
lb_pos = TRIM(lb_pos)
|
|
|
|
|
!
|
|
|
|
|
error_msg = 'Error while parsing atomic position card.'
|
|
|
|
|
! read field 2 (atom X coordinate)
|
|
|
|
|
CALL get_field(2, field_str, input_line)
|
|
|
|
|
rd_pos(1,ia) = eval_infix(ierr, field_str )
|
|
|
|
|
CALL errore('card_atomic_positions', error_msg, ierr)
|
|
|
|
|
! read field 2 (atom Y coordinate)
|
|
|
|
|
CALL get_field(3, field_str, input_line)
|
|
|
|
|
rd_pos(2,ia) = eval_infix(ierr, field_str )
|
|
|
|
|
CALL errore('card_atomic_positions', error_msg, ierr)
|
|
|
|
|
! read field 2 (atom Z coordinate)
|
|
|
|
|
CALL get_field(4, field_str, input_line)
|
|
|
|
|
rd_pos(3,ia) = eval_infix(ierr, field_str )
|
|
|
|
|
CALL errore('card_atomic_positions', error_msg, ierr)
|
2007-04-06 03:53:16 +08:00
|
|
|
!
|
2008-07-22 20:40:51 +08:00
|
|
|
IF ( nfield >= 7 ) THEN
|
|
|
|
|
! read constrains (fields 5-7, if present)
|
|
|
|
|
CALL get_field(5, field_str, input_line)
|
|
|
|
|
read(field_str, *) if_pos(1,ia)
|
|
|
|
|
CALL get_field(6, field_str, input_line)
|
|
|
|
|
read(field_str, *) if_pos(2,ia)
|
|
|
|
|
CALL get_field(7, field_str, input_line)
|
|
|
|
|
read(field_str, *) if_pos(3,ia)
|
|
|
|
|
ENDIF
|
|
|
|
|
!
|
|
|
|
|
IF ( nfield == 8 ) THEN
|
|
|
|
|
CALL get_field(5, field_str, input_line)
|
|
|
|
|
read(field_str, *) id_loc(ia)
|
2003-11-17 19:52:06 +08:00
|
|
|
END IF
|
|
|
|
|
!
|
|
|
|
|
match_label: DO is = 1, ntyp
|
|
|
|
|
!
|
|
|
|
|
IF ( TRIM(lb_pos) == TRIM( atom_label(is) ) ) THEN
|
|
|
|
|
!
|
|
|
|
|
sp_pos(ia) = is
|
|
|
|
|
EXIT match_label
|
|
|
|
|
!
|
|
|
|
|
END IF
|
|
|
|
|
!
|
|
|
|
|
END DO match_label
|
|
|
|
|
!
|
|
|
|
|
IF( ( sp_pos(ia) < 1 ) .OR. ( sp_pos(ia) > ntyp ) ) THEN
|
|
|
|
|
!
|
2008-03-19 19:17:35 +08:00
|
|
|
CALL errore( 'read_cards', 'species '//TRIM(lb_pos)// &
|
|
|
|
|
& ' in ATOMIC_POSITIONS is nonexistent', ia )
|
2007-04-06 03:53:16 +08:00
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
END IF
|
|
|
|
|
!
|
2006-02-28 04:06:23 +08:00
|
|
|
is = sp_pos(ia)
|
|
|
|
|
!
|
|
|
|
|
na_inp(is) = na_inp(is) + 1
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
END DO
|
|
|
|
|
!
|
2007-04-06 03:53:16 +08:00
|
|
|
END IF
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
2008-04-16 21:51:38 +08:00
|
|
|
DO is = 1, ntyp
|
|
|
|
|
IF( na_inp( is ) < 1 ) THEN
|
|
|
|
|
CALL errore( 'read_cards', &
|
|
|
|
|
'no atom found in ATOMIC_POSITIONS for species '//TRIM(atom_label(is)), is )
|
|
|
|
|
END IF
|
|
|
|
|
END DO
|
|
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
tapos = .TRUE.
|
|
|
|
|
tread = .TRUE.
|
|
|
|
|
!
|
|
|
|
|
RETURN
|
|
|
|
|
!
|
2004-05-28 23:45:19 +08:00
|
|
|
CONTAINS
|
|
|
|
|
!
|
|
|
|
|
!-------------------------------------------------------------------
|
2004-08-18 23:53:01 +08:00
|
|
|
SUBROUTINE path_read_images( image )
|
2004-05-28 23:45:19 +08:00
|
|
|
!-------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
IMPLICIT NONE
|
|
|
|
|
!
|
|
|
|
|
INTEGER, INTENT(IN) :: image
|
|
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
DO ia = 1, nat
|
|
|
|
|
!
|
2006-12-01 22:41:55 +08:00
|
|
|
idx = 3 * ( ia - 1 )
|
2004-05-28 23:45:19 +08:00
|
|
|
!
|
2006-03-08 18:08:58 +08:00
|
|
|
CALL read_line( input_line, end_of_file = tend )
|
|
|
|
|
!
|
2006-04-01 00:00:17 +08:00
|
|
|
IF ( tend ) &
|
|
|
|
|
CALL errore( 'read_cards', &
|
|
|
|
|
'end of file reading atomic positions', ia )
|
2006-03-08 18:08:58 +08:00
|
|
|
!
|
2004-05-28 23:45:19 +08:00
|
|
|
CALL field_count( nfield, input_line )
|
|
|
|
|
!
|
|
|
|
|
IF ( nfield == 4 ) THEN
|
|
|
|
|
!
|
2006-12-01 22:41:55 +08:00
|
|
|
READ( input_line, * ) lb_pos, pos((idx+1),image), &
|
|
|
|
|
pos((idx+2),image), &
|
|
|
|
|
pos((idx+3),image)
|
2004-05-28 23:45:19 +08:00
|
|
|
!
|
|
|
|
|
ELSE IF ( nfield == 7 ) THEN
|
|
|
|
|
!
|
|
|
|
|
IF ( image /= 1 ) THEN
|
|
|
|
|
!
|
2006-02-28 04:06:23 +08:00
|
|
|
CALL errore( 'read_cards', &
|
|
|
|
|
& 'wrong number of columns in ' // &
|
2007-04-06 03:53:16 +08:00
|
|
|
& 'ATOMIC_POSITIONS', sp_pos(ia) )
|
2004-05-28 23:45:19 +08:00
|
|
|
!
|
|
|
|
|
END IF
|
|
|
|
|
!
|
2006-12-01 22:41:55 +08:00
|
|
|
READ( input_line, * ) lb_pos, pos((idx+1),image), &
|
|
|
|
|
pos((idx+2),image), &
|
|
|
|
|
pos((idx+3),image), &
|
2004-05-28 23:45:19 +08:00
|
|
|
if_pos(1,ia), &
|
|
|
|
|
if_pos(2,ia), &
|
|
|
|
|
if_pos(3,ia)
|
|
|
|
|
!
|
|
|
|
|
ELSE
|
|
|
|
|
!
|
2006-02-28 04:06:23 +08:00
|
|
|
CALL errore( 'read_cards', &
|
|
|
|
|
& 'wrong number of columns in ' // &
|
|
|
|
|
& 'ATOMIC_POSITIONS', sp_pos(ia) )
|
2007-04-06 03:53:16 +08:00
|
|
|
!
|
2004-05-28 23:45:19 +08:00
|
|
|
END IF
|
|
|
|
|
!
|
|
|
|
|
IF ( image == 1 ) THEN
|
|
|
|
|
!
|
|
|
|
|
lb_pos = ADJUSTL( lb_pos )
|
|
|
|
|
!
|
2004-08-18 23:53:01 +08:00
|
|
|
match_label_path: DO is = 1, ntyp
|
2004-05-28 23:45:19 +08:00
|
|
|
!
|
|
|
|
|
IF ( TRIM( lb_pos ) == TRIM( atom_label(is) ) ) THEN
|
|
|
|
|
!
|
|
|
|
|
sp_pos(ia) = is
|
|
|
|
|
!
|
2004-08-18 23:53:01 +08:00
|
|
|
EXIT match_label_path
|
2004-05-28 23:45:19 +08:00
|
|
|
!
|
|
|
|
|
END IF
|
|
|
|
|
!
|
2004-08-18 23:53:01 +08:00
|
|
|
END DO match_label_path
|
2004-05-28 23:45:19 +08:00
|
|
|
!
|
|
|
|
|
IF ( ( sp_pos(ia) < 1 ) .OR. ( sp_pos(ia) > ntyp ) ) THEN
|
2007-04-06 03:53:16 +08:00
|
|
|
!
|
2006-02-28 04:06:23 +08:00
|
|
|
CALL errore( 'read_cards', &
|
2006-04-01 00:00:17 +08:00
|
|
|
'wrong index in ATOMIC_POSITIONS', ia )
|
2007-04-06 03:53:16 +08:00
|
|
|
!
|
2004-05-28 23:45:19 +08:00
|
|
|
END IF
|
|
|
|
|
!
|
2004-08-23 14:51:19 +08:00
|
|
|
is = sp_pos(ia)
|
2004-08-18 23:53:01 +08:00
|
|
|
!
|
2004-05-28 23:45:19 +08:00
|
|
|
na_inp( is ) = na_inp( is ) + 1
|
|
|
|
|
!
|
2007-04-06 03:53:16 +08:00
|
|
|
END IF
|
2004-05-28 23:45:19 +08:00
|
|
|
!
|
|
|
|
|
END DO
|
|
|
|
|
!
|
|
|
|
|
RETURN
|
|
|
|
|
!
|
2004-08-18 23:53:01 +08:00
|
|
|
END SUBROUTINE path_read_images
|
2004-05-28 23:45:19 +08:00
|
|
|
!
|
2006-02-28 04:06:23 +08:00
|
|
|
END SUBROUTINE card_atomic_positions
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
! BEGIN manual
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
!
|
2008-07-23 00:48:11 +08:00
|
|
|
! ATOMIC_FORCES
|
|
|
|
|
!
|
|
|
|
|
! read external forces (in atomic units) from standard input
|
|
|
|
|
!
|
|
|
|
|
! Syntax:
|
|
|
|
|
!
|
|
|
|
|
! ATOMIC_FORCES
|
|
|
|
|
! label Fx(1) Fy(1) Fz(1)
|
|
|
|
|
! .....
|
|
|
|
|
! label Fx(n) Fy(n) Fz(n)
|
|
|
|
|
!
|
|
|
|
|
! Example:
|
|
|
|
|
!
|
|
|
|
|
! ???
|
|
|
|
|
!
|
|
|
|
|
! Where:
|
|
|
|
|
!
|
|
|
|
|
! label (character(len=4)) atomic label
|
|
|
|
|
! Fx(:), Fy(:) and Fz(:) (REAL) x, y and z component of the external force
|
|
|
|
|
! acting on the ions whose coordinate are given
|
|
|
|
|
! in the same line in card ATOMIC_POSITION
|
|
|
|
|
!
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
! END manual
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
SUBROUTINE card_atomic_forces( input_line, prog )
|
|
|
|
|
!
|
|
|
|
|
IMPLICIT NONE
|
|
|
|
|
!
|
|
|
|
|
CHARACTER(LEN=256) :: input_line
|
|
|
|
|
CHARACTER(LEN=2) :: prog
|
|
|
|
|
INTEGER :: ia, k, nfield
|
|
|
|
|
LOGICAL, SAVE :: tread = .FALSE.
|
|
|
|
|
CHARACTER(LEN=4) :: lb
|
|
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
IF( tread ) THEN
|
2009-02-05 04:54:44 +08:00
|
|
|
CALL errore( ' card_atomic_forces ', ' two occurrences ', 2 )
|
2008-07-23 00:48:11 +08:00
|
|
|
END IF
|
|
|
|
|
!
|
|
|
|
|
IF( .NOT. taspc ) THEN
|
|
|
|
|
CALL errore( ' card_atomic_forces ', &
|
|
|
|
|
& ' ATOMIC_SPECIES must be present before ', 2 )
|
|
|
|
|
END IF
|
|
|
|
|
!
|
|
|
|
|
rd_for = 0.0_DP
|
|
|
|
|
!
|
|
|
|
|
DO ia = 1, nat
|
|
|
|
|
!
|
|
|
|
|
CALL read_line( input_line )
|
|
|
|
|
CALL field_count( nfield, input_line )
|
|
|
|
|
IF ( nfield == 4 ) THEN
|
|
|
|
|
READ(input_line,*) lb, ( rd_for(k,ia), k = 1, 3 )
|
|
|
|
|
ELSE IF( nfield == 3 ) THEN
|
|
|
|
|
READ(input_line,*) ( rd_for(k,ia), k = 1, 3 )
|
|
|
|
|
ELSE
|
|
|
|
|
CALL errore( ' iosys ', ' wrong entries in ATOMIC_FORCES ', ia )
|
|
|
|
|
END IF
|
|
|
|
|
!
|
|
|
|
|
END DO
|
|
|
|
|
!
|
|
|
|
|
tread = .TRUE.
|
|
|
|
|
!
|
|
|
|
|
RETURN
|
|
|
|
|
!
|
|
|
|
|
END SUBROUTINE card_atomic_forces
|
|
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
! BEGIN manual
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
! K_POINTS
|
|
|
|
|
!
|
|
|
|
|
! use the specified set of k points
|
|
|
|
|
!
|
|
|
|
|
! Syntax:
|
|
|
|
|
!
|
|
|
|
|
! K_POINTS (mesh_option)
|
|
|
|
|
! n
|
|
|
|
|
! xk(1,1) xk(2,1) xk(3,1) wk(1)
|
|
|
|
|
! ... ... ... ...
|
|
|
|
|
! xk(1,n) xk(2,n) xk(3,n) wk(n)
|
|
|
|
|
!
|
|
|
|
|
! Example:
|
|
|
|
|
!
|
|
|
|
|
! K_POINTS
|
|
|
|
|
! 10
|
|
|
|
|
! 0.1250000 0.1250000 0.1250000 1.00
|
|
|
|
|
! 0.1250000 0.1250000 0.3750000 3.00
|
|
|
|
|
! 0.1250000 0.1250000 0.6250000 3.00
|
|
|
|
|
! 0.1250000 0.1250000 0.8750000 3.00
|
|
|
|
|
! 0.1250000 0.3750000 0.3750000 3.00
|
|
|
|
|
! 0.1250000 0.3750000 0.6250000 6.00
|
|
|
|
|
! 0.1250000 0.3750000 0.8750000 6.00
|
|
|
|
|
! 0.1250000 0.6250000 0.6250000 3.00
|
|
|
|
|
! 0.3750000 0.3750000 0.3750000 1.00
|
|
|
|
|
! 0.3750000 0.3750000 0.6250000 3.00
|
|
|
|
|
!
|
|
|
|
|
! Where:
|
|
|
|
|
!
|
|
|
|
|
! mesh_option == automatic k points mesh is generated automatically
|
|
|
|
|
! with Monkhorst-Pack algorithm
|
|
|
|
|
! mesh_option == crystal k points mesh is given in stdin in scaled
|
|
|
|
|
! units
|
|
|
|
|
! mesh_option == tpiba k points mesh is given in stdin in units
|
|
|
|
|
! of ( 2 PI / alat )
|
|
|
|
|
! mesh_option == gamma only gamma point is used ( default in
|
|
|
|
|
! CPMD simulation )
|
2008-10-23 23:07:39 +08:00
|
|
|
! mesh_option == tpiba_b as tpiba but the weights gives the
|
|
|
|
|
! number of points between this point
|
|
|
|
|
! and the next
|
|
|
|
|
! mesh_option == crystal_b as crystal but the weights gives the
|
|
|
|
|
! number of points between this point and
|
|
|
|
|
! the next
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
! n ( integer ) number of k points
|
|
|
|
|
! xk(:,i) ( real ) coordinates of i-th k point
|
|
|
|
|
! wk(i) ( real ) weights of i-th k point
|
|
|
|
|
!
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
! END manual
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
SUBROUTINE card_kpoints( input_line )
|
|
|
|
|
!
|
|
|
|
|
IMPLICIT NONE
|
|
|
|
|
!
|
|
|
|
|
CHARACTER(LEN=256) :: input_line
|
2008-10-23 23:07:39 +08:00
|
|
|
INTEGER :: i, j
|
|
|
|
|
INTEGER :: nkaux
|
|
|
|
|
INTEGER, ALLOCATABLE :: wkaux(:)
|
|
|
|
|
REAL(DP), ALLOCATABLE :: xkaux(:,:)
|
|
|
|
|
REAL(DP) :: delta
|
2004-05-20 00:56:56 +08:00
|
|
|
LOGICAL, EXTERNAL :: matches
|
2003-11-17 19:52:06 +08:00
|
|
|
LOGICAL, SAVE :: tread = .FALSE.
|
2006-02-02 23:20:26 +08:00
|
|
|
LOGICAL :: tend
|
2008-10-23 23:07:39 +08:00
|
|
|
LOGICAL :: kband = .FALSE.
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
IF ( tread ) THEN
|
2008-03-11 23:38:23 +08:00
|
|
|
CALL errore( ' card_kpoints ', ' two occurrences', 2 )
|
2003-11-17 19:52:06 +08:00
|
|
|
END IF
|
|
|
|
|
!
|
|
|
|
|
IF ( matches( "AUTOMATIC", input_line ) ) THEN
|
All namelists and cards moved to Modules/input_parameters.f90 .
From now on, all new input variables should be added
to this module, and then copied to the code internal
variables in the input.f90 subroutine
The namelists and cards parsers are in :
Modules/read_namelists.f90 and Modules/read_cards.f90
files input_parameters.f90 read_namelists.f90 read_cards.f90
are shared by all codes, while each code has its own version
of input.f90 ( used to copy input values into internals variables ).
EXAMPLE:
suppose you need to add a new input variable called "pippo"
to the namelist control, then:
1) add pippo to the input_parameters.f90 file containing the
namelist control
INTEGER :: pippo = 0
NAMELIST / control / ....., pippo
remember: always set an initialization value!
2) add pippo to the control_default subroutine
( cantained in module read_namelists.f90 )
subroutine control_default( prog )
...
IF( prog == 'PW' ) pippo = 10
...
end subroutine
this routine set the default value for pippo,
that could vary with the code
3) add pippo to the control_bcast subroutine
( cantained in module read_namelists.f90 )
subroutine control_bcast( )
...
call mp_bcast( pippo )
...
end subroutine
4) add pippo to the control_checkin subroutine
( cantained in module read_namelists.f90 )
subroutine control_checking( prog )
...
IF( pippo < 0 ) &
CALL error(' control_checkin ',' variable pippo less than 0 ', 1 )
...
end subroutine
5) Copy the value of pippo in the code internal variables
( file input.f90 )
subroutine iosys()
use input_parameters, only: ...., pippo
use pwcom, only: ....., myvar
...
call read_namelists( 'PW' )
...
myvar = pippo
...
end subroutine
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@282 c92efa57-630b-4861-b058-cf58834340f0
2003-07-31 21:24:20 +08:00
|
|
|
! automatic generation of k-points
|
2003-07-07 05:47:17 +08:00
|
|
|
k_points = 'automatic'
|
2003-11-17 19:52:06 +08:00
|
|
|
ELSE IF ( matches( "CRYSTAL", input_line ) ) THEN
|
All namelists and cards moved to Modules/input_parameters.f90 .
From now on, all new input variables should be added
to this module, and then copied to the code internal
variables in the input.f90 subroutine
The namelists and cards parsers are in :
Modules/read_namelists.f90 and Modules/read_cards.f90
files input_parameters.f90 read_namelists.f90 read_cards.f90
are shared by all codes, while each code has its own version
of input.f90 ( used to copy input values into internals variables ).
EXAMPLE:
suppose you need to add a new input variable called "pippo"
to the namelist control, then:
1) add pippo to the input_parameters.f90 file containing the
namelist control
INTEGER :: pippo = 0
NAMELIST / control / ....., pippo
remember: always set an initialization value!
2) add pippo to the control_default subroutine
( cantained in module read_namelists.f90 )
subroutine control_default( prog )
...
IF( prog == 'PW' ) pippo = 10
...
end subroutine
this routine set the default value for pippo,
that could vary with the code
3) add pippo to the control_bcast subroutine
( cantained in module read_namelists.f90 )
subroutine control_bcast( )
...
call mp_bcast( pippo )
...
end subroutine
4) add pippo to the control_checkin subroutine
( cantained in module read_namelists.f90 )
subroutine control_checking( prog )
...
IF( pippo < 0 ) &
CALL error(' control_checkin ',' variable pippo less than 0 ', 1 )
...
end subroutine
5) Copy the value of pippo in the code internal variables
( file input.f90 )
subroutine iosys()
use input_parameters, only: ...., pippo
use pwcom, only: ....., myvar
...
call read_namelists( 'PW' )
...
myvar = pippo
...
end subroutine
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@282 c92efa57-630b-4861-b058-cf58834340f0
2003-07-31 21:24:20 +08:00
|
|
|
! input k-points are in crystal (reciprocal lattice) axis
|
2003-07-07 05:47:17 +08:00
|
|
|
k_points = 'crystal'
|
2008-10-23 23:07:39 +08:00
|
|
|
IF ( matches( "_B", input_line ) ) kband=.true.
|
2003-11-17 19:52:06 +08:00
|
|
|
ELSE IF ( matches( "TPIBA", input_line ) ) THEN
|
All namelists and cards moved to Modules/input_parameters.f90 .
From now on, all new input variables should be added
to this module, and then copied to the code internal
variables in the input.f90 subroutine
The namelists and cards parsers are in :
Modules/read_namelists.f90 and Modules/read_cards.f90
files input_parameters.f90 read_namelists.f90 read_cards.f90
are shared by all codes, while each code has its own version
of input.f90 ( used to copy input values into internals variables ).
EXAMPLE:
suppose you need to add a new input variable called "pippo"
to the namelist control, then:
1) add pippo to the input_parameters.f90 file containing the
namelist control
INTEGER :: pippo = 0
NAMELIST / control / ....., pippo
remember: always set an initialization value!
2) add pippo to the control_default subroutine
( cantained in module read_namelists.f90 )
subroutine control_default( prog )
...
IF( prog == 'PW' ) pippo = 10
...
end subroutine
this routine set the default value for pippo,
that could vary with the code
3) add pippo to the control_bcast subroutine
( cantained in module read_namelists.f90 )
subroutine control_bcast( )
...
call mp_bcast( pippo )
...
end subroutine
4) add pippo to the control_checkin subroutine
( cantained in module read_namelists.f90 )
subroutine control_checking( prog )
...
IF( pippo < 0 ) &
CALL error(' control_checkin ',' variable pippo less than 0 ', 1 )
...
end subroutine
5) Copy the value of pippo in the code internal variables
( file input.f90 )
subroutine iosys()
use input_parameters, only: ...., pippo
use pwcom, only: ....., myvar
...
call read_namelists( 'PW' )
...
myvar = pippo
...
end subroutine
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@282 c92efa57-630b-4861-b058-cf58834340f0
2003-07-31 21:24:20 +08:00
|
|
|
! input k-points are in 2pi/a units
|
2003-07-07 05:47:17 +08:00
|
|
|
k_points = 'tpiba'
|
2008-10-23 23:07:39 +08:00
|
|
|
IF ( matches( "_B", input_line ) ) kband=.true.
|
2003-11-17 19:52:06 +08:00
|
|
|
ELSE IF ( matches( "GAMMA", input_line ) ) THEN
|
All namelists and cards moved to Modules/input_parameters.f90 .
From now on, all new input variables should be added
to this module, and then copied to the code internal
variables in the input.f90 subroutine
The namelists and cards parsers are in :
Modules/read_namelists.f90 and Modules/read_cards.f90
files input_parameters.f90 read_namelists.f90 read_cards.f90
are shared by all codes, while each code has its own version
of input.f90 ( used to copy input values into internals variables ).
EXAMPLE:
suppose you need to add a new input variable called "pippo"
to the namelist control, then:
1) add pippo to the input_parameters.f90 file containing the
namelist control
INTEGER :: pippo = 0
NAMELIST / control / ....., pippo
remember: always set an initialization value!
2) add pippo to the control_default subroutine
( cantained in module read_namelists.f90 )
subroutine control_default( prog )
...
IF( prog == 'PW' ) pippo = 10
...
end subroutine
this routine set the default value for pippo,
that could vary with the code
3) add pippo to the control_bcast subroutine
( cantained in module read_namelists.f90 )
subroutine control_bcast( )
...
call mp_bcast( pippo )
...
end subroutine
4) add pippo to the control_checkin subroutine
( cantained in module read_namelists.f90 )
subroutine control_checking( prog )
...
IF( pippo < 0 ) &
CALL error(' control_checkin ',' variable pippo less than 0 ', 1 )
...
end subroutine
5) Copy the value of pippo in the code internal variables
( file input.f90 )
subroutine iosys()
use input_parameters, only: ...., pippo
use pwcom, only: ....., myvar
...
call read_namelists( 'PW' )
...
myvar = pippo
...
end subroutine
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@282 c92efa57-630b-4861-b058-cf58834340f0
2003-07-31 21:24:20 +08:00
|
|
|
! Only Gamma (k=0) is used
|
2003-07-07 05:47:17 +08:00
|
|
|
k_points = 'gamma'
|
2003-11-17 19:52:06 +08:00
|
|
|
ELSE
|
All namelists and cards moved to Modules/input_parameters.f90 .
From now on, all new input variables should be added
to this module, and then copied to the code internal
variables in the input.f90 subroutine
The namelists and cards parsers are in :
Modules/read_namelists.f90 and Modules/read_cards.f90
files input_parameters.f90 read_namelists.f90 read_cards.f90
are shared by all codes, while each code has its own version
of input.f90 ( used to copy input values into internals variables ).
EXAMPLE:
suppose you need to add a new input variable called "pippo"
to the namelist control, then:
1) add pippo to the input_parameters.f90 file containing the
namelist control
INTEGER :: pippo = 0
NAMELIST / control / ....., pippo
remember: always set an initialization value!
2) add pippo to the control_default subroutine
( cantained in module read_namelists.f90 )
subroutine control_default( prog )
...
IF( prog == 'PW' ) pippo = 10
...
end subroutine
this routine set the default value for pippo,
that could vary with the code
3) add pippo to the control_bcast subroutine
( cantained in module read_namelists.f90 )
subroutine control_bcast( )
...
call mp_bcast( pippo )
...
end subroutine
4) add pippo to the control_checkin subroutine
( cantained in module read_namelists.f90 )
subroutine control_checking( prog )
...
IF( pippo < 0 ) &
CALL error(' control_checkin ',' variable pippo less than 0 ', 1 )
...
end subroutine
5) Copy the value of pippo in the code internal variables
( file input.f90 )
subroutine iosys()
use input_parameters, only: ...., pippo
use pwcom, only: ....., myvar
...
call read_namelists( 'PW' )
...
myvar = pippo
...
end subroutine
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@282 c92efa57-630b-4861-b058-cf58834340f0
2003-07-31 21:24:20 +08:00
|
|
|
! by default, input k-points are in 2pi/a units
|
2003-07-07 05:47:17 +08:00
|
|
|
k_points = 'tpiba'
|
2003-11-17 19:52:06 +08:00
|
|
|
END IF
|
|
|
|
|
!
|
|
|
|
|
IF ( k_points == 'automatic' ) THEN
|
|
|
|
|
!
|
|
|
|
|
! ... automatic generation of k-points
|
|
|
|
|
!
|
|
|
|
|
nkstot = 0
|
2006-02-02 23:20:26 +08:00
|
|
|
CALL read_line( input_line, end_of_file = tend )
|
|
|
|
|
IF (tend) GO TO 10
|
|
|
|
|
READ(input_line, *, END=10, ERR=10) nk1, nk2, nk3, k1, k2 ,k3
|
2005-05-25 20:39:51 +08:00
|
|
|
IF ( k1 < 0 .OR. k1 > 1 .OR. &
|
|
|
|
|
k2 < 0 .OR. k2 > 1 .OR. &
|
|
|
|
|
k3 < 0 .OR. k3 > 1 ) CALL errore &
|
|
|
|
|
('card_kpoints', 'invalid offsets: must be 0 or 1', 1)
|
|
|
|
|
IF ( nk1 <= 0 .OR. nk2 <= 0 .OR. nk3 <= 0 ) CALL errore &
|
|
|
|
|
('card_kpoints', 'invalid values for nk1, nk2, nk3', 1)
|
|
|
|
|
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
ELSE IF ( ( k_points == 'tpiba' ) .OR. ( k_points == 'crystal' ) ) THEN
|
|
|
|
|
!
|
|
|
|
|
! ... input k-points are in 2pi/a units
|
|
|
|
|
!
|
2006-02-02 23:20:26 +08:00
|
|
|
CALL read_line( input_line, end_of_file = tend )
|
|
|
|
|
IF (tend) GO TO 10
|
|
|
|
|
READ(input_line, *, END=10, ERR=10) nkstot
|
2007-10-08 16:36:32 +08:00
|
|
|
IF ( nkstot > SIZE (xk,2) ) CALL errore &
|
|
|
|
|
('card_kpoints', 'too many k-points',nkstot)
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
DO i = 1, nkstot
|
2006-02-02 23:20:26 +08:00
|
|
|
CALL read_line( input_line, end_of_file = tend )
|
|
|
|
|
IF (tend) GO TO 10
|
|
|
|
|
READ(input_line,*, END=10, ERR=10) xk(1,i), xk(2,i), xk(3,i), wk(i)
|
2003-11-17 19:52:06 +08:00
|
|
|
END DO
|
2008-10-23 23:07:39 +08:00
|
|
|
IF (kband) THEN
|
|
|
|
|
nkaux=nkstot
|
|
|
|
|
ALLOCATE(xkaux(3,nkstot))
|
|
|
|
|
ALLOCATE(wkaux(nkstot))
|
|
|
|
|
xkaux(:,1:nkstot)=xk(:,1:nkstot)
|
|
|
|
|
wkaux(1:nkstot)=NINT(wk(1:nkstot))
|
|
|
|
|
nkstot=0
|
|
|
|
|
DO i=1,nkaux-1
|
|
|
|
|
delta=1.0_DP/wkaux(i)
|
|
|
|
|
DO j=0,wkaux(i)-1
|
|
|
|
|
nkstot=nkstot+1
|
|
|
|
|
IF ( nkstot > SIZE (xk,2) ) CALL errore &
|
|
|
|
|
('card_kpoints', 'too many k-points',nkstot)
|
|
|
|
|
xk(:,nkstot)=xkaux(:,i)+delta*j*(xkaux(:,i+1)-xkaux(:,i))
|
|
|
|
|
wk(nkstot)=1.0_DP
|
|
|
|
|
ENDDO
|
|
|
|
|
ENDDO
|
|
|
|
|
nkstot=nkstot+1
|
|
|
|
|
xk(:,nkstot)=xkaux(:,nkaux)
|
|
|
|
|
wk(nkstot)=1.0_DP
|
|
|
|
|
DEALLOCATE(xkaux)
|
|
|
|
|
DEALLOCATE(wkaux)
|
|
|
|
|
ENDIF
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
ELSE IF ( k_points == 'gamma' ) THEN
|
|
|
|
|
!
|
|
|
|
|
nkstot = 1
|
2007-06-12 01:13:15 +08:00
|
|
|
xk(:,1) = 0.0_DP
|
|
|
|
|
wk(1) = 1.0_DP
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
END IF
|
|
|
|
|
!
|
|
|
|
|
tread = .TRUE.
|
|
|
|
|
tk_inp = .TRUE.
|
|
|
|
|
!
|
|
|
|
|
RETURN
|
2006-02-02 23:20:26 +08:00
|
|
|
10 CALL errore ('card_kpoints', ' error or end of file while reading ' &
|
|
|
|
|
& // TRIM(k_points) // ' k points', 1)
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
2005-12-28 23:57:48 +08:00
|
|
|
END SUBROUTINE card_kpoints
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
! BEGIN manual
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! SETNFI
|
|
|
|
|
!
|
|
|
|
|
! Reset the step counter to the specified value
|
|
|
|
|
!
|
|
|
|
|
! Syntax:
|
|
|
|
|
!
|
|
|
|
|
! SETNFI
|
|
|
|
|
! nfi
|
|
|
|
|
!
|
|
|
|
|
! Example:
|
|
|
|
|
!
|
|
|
|
|
! SETNFI
|
|
|
|
|
! 100
|
|
|
|
|
!
|
|
|
|
|
! Where:
|
|
|
|
|
!
|
|
|
|
|
! nfi (integer) new value for the step counter
|
|
|
|
|
!
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
! END manual
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
SUBROUTINE card_setnfi( input_line )
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
IMPLICIT NONE
|
|
|
|
|
!
|
|
|
|
|
CHARACTER(LEN=256) :: input_line
|
|
|
|
|
LOGICAL, SAVE :: tread = .FALSE.
|
|
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
IF ( tread ) THEN
|
2008-03-11 23:38:23 +08:00
|
|
|
CALL errore( ' card_setnfi ', ' two occurrences', 2 )
|
2003-11-17 19:52:06 +08:00
|
|
|
END IF
|
|
|
|
|
CALL read_line( input_line )
|
|
|
|
|
READ(input_line,*) newnfi_card
|
|
|
|
|
tnewnfi_card = .TRUE.
|
|
|
|
|
tread = .TRUE.
|
|
|
|
|
!
|
|
|
|
|
RETURN
|
|
|
|
|
!
|
2005-12-28 23:57:48 +08:00
|
|
|
END SUBROUTINE card_setnfi
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
! BEGIN manual
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! 2DPROCMESH
|
|
|
|
|
!
|
|
|
|
|
! Distribute the Y and Z FFT dimensions across processors,
|
|
|
|
|
! instead of Z dimension only ( default distribution )
|
|
|
|
|
!
|
|
|
|
|
! Syntax:
|
|
|
|
|
!
|
|
|
|
|
! 2DPROCMESH
|
|
|
|
|
!
|
|
|
|
|
! Where:
|
|
|
|
|
!
|
|
|
|
|
! no parameters
|
|
|
|
|
!
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
! END manual
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
! BEGIN manual
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! OCCUPATIONS
|
|
|
|
|
!
|
|
|
|
|
! use the specified occupation numbers for electronic states.
|
|
|
|
|
! Note that you should specify 10 values per line maximum!
|
|
|
|
|
!
|
|
|
|
|
! Syntax (nspin == 1):
|
|
|
|
|
!
|
|
|
|
|
! OCCUPATIONS
|
|
|
|
|
! f(1) .... .... f(10)
|
|
|
|
|
! f(11) .... f(nbnd)
|
|
|
|
|
!
|
|
|
|
|
! Syntax (nspin == 2):
|
|
|
|
|
!
|
|
|
|
|
! OCCUPATIONS
|
|
|
|
|
! u(1) .... .... u(10)
|
|
|
|
|
! u(11) .... u(nbnd)
|
|
|
|
|
! d(1) .... .... d(10)
|
|
|
|
|
! d(11) .... d(nbnd)
|
|
|
|
|
!
|
|
|
|
|
! Example:
|
|
|
|
|
!
|
|
|
|
|
! OCCUPATIONS
|
|
|
|
|
! 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0
|
|
|
|
|
! 2.0 2.0 2.0 2.0 2.0 1.0 1.0
|
|
|
|
|
!
|
|
|
|
|
! Where:
|
|
|
|
|
!
|
|
|
|
|
! f(:) (real) these are the occupation numbers
|
|
|
|
|
! for LDA electronic states.
|
|
|
|
|
!
|
|
|
|
|
! u(:) (real) these are the occupation numbers
|
|
|
|
|
! for LSD spin == 1 electronic states
|
|
|
|
|
! d(:) (real) these are the occupation numbers
|
|
|
|
|
! for LSD spin == 2 electronic states
|
|
|
|
|
!
|
|
|
|
|
! Note, maximum 10 values per line!
|
|
|
|
|
!
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
! END manual
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
SUBROUTINE card_occupations( input_line )
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
IMPLICIT NONE
|
|
|
|
|
!
|
2008-07-22 20:40:51 +08:00
|
|
|
CHARACTER(LEN=256) :: input_line, field_str
|
2005-07-09 00:29:15 +08:00
|
|
|
INTEGER :: is, nx10, i, j, nspin0
|
2008-07-22 20:40:51 +08:00
|
|
|
INTEGER :: nfield, nbnd_read, nf, ierr
|
2003-11-17 19:52:06 +08:00
|
|
|
LOGICAL, SAVE :: tread = .FALSE.
|
2008-07-22 20:40:51 +08:00
|
|
|
REAL(DP),EXTERNAL :: eval_infix
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
IF ( tread ) THEN
|
2008-03-11 23:38:23 +08:00
|
|
|
CALL errore( ' card_occupations ', ' two occurrences', 2 )
|
2003-11-17 19:52:06 +08:00
|
|
|
END IF
|
2005-07-09 00:29:15 +08:00
|
|
|
nspin0=nspin
|
|
|
|
|
if (nspin == 4) nspin0=1
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
2006-03-29 03:43:35 +08:00
|
|
|
ALLOCATE ( f_inp ( nbnd, nspin0 ) )
|
2005-07-09 00:29:15 +08:00
|
|
|
DO is = 1, nspin0
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
2008-07-22 20:40:51 +08:00
|
|
|
nbnd_read = 0
|
|
|
|
|
DO WHILE ( nbnd_read < nbnd)
|
|
|
|
|
CALL read_line( input_line )
|
|
|
|
|
CALL field_count( nfield, input_line )
|
|
|
|
|
!
|
|
|
|
|
DO nf = 1,nfield
|
|
|
|
|
nbnd_read = nbnd_read+1
|
|
|
|
|
CALL get_field(nf, field_str, input_line)
|
|
|
|
|
!
|
|
|
|
|
f_inp(nbnd_read,is) = eval_infix(ierr, field_str )
|
|
|
|
|
CALL errore('card_occupations',&
|
|
|
|
|
'Error parsing occupation: '//TRIM(field_str), nbnd_read*ierr)
|
|
|
|
|
ENDDO
|
|
|
|
|
ENDDO
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
END DO
|
|
|
|
|
!
|
|
|
|
|
tf_inp = .TRUE.
|
|
|
|
|
tread = .TRUE.
|
|
|
|
|
!
|
|
|
|
|
RETURN
|
|
|
|
|
!
|
2005-12-28 23:57:48 +08:00
|
|
|
END SUBROUTINE card_occupations
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
! BEGIN manual
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! VHMEAN
|
|
|
|
|
!
|
|
|
|
|
! Calculation of potential average along a given axis
|
|
|
|
|
!
|
|
|
|
|
! Syntax:
|
|
|
|
|
!
|
|
|
|
|
! VHMEAN
|
|
|
|
|
! unit nr rmin rmax asse
|
|
|
|
|
!
|
|
|
|
|
! Example:
|
|
|
|
|
!
|
|
|
|
|
! ????
|
|
|
|
|
!
|
|
|
|
|
! Where:
|
|
|
|
|
!
|
|
|
|
|
! ????
|
|
|
|
|
!
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
! END manual
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
SUBROUTINE card_vhmean( input_line )
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
IMPLICIT NONE
|
|
|
|
|
!
|
|
|
|
|
CHARACTER(LEN=256) :: input_line
|
|
|
|
|
LOGICAL, SAVE :: tread = .FALSE.
|
|
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
IF ( tread ) THEN
|
2008-03-11 23:38:23 +08:00
|
|
|
CALL errore( ' card_vhmean ', ' two occurrences', 2 )
|
2003-11-17 19:52:06 +08:00
|
|
|
END IF
|
|
|
|
|
!
|
|
|
|
|
tvhmean_inp = .TRUE.
|
|
|
|
|
CALL read_line( input_line )
|
|
|
|
|
READ(input_line,*) &
|
|
|
|
|
vhiunit_inp, vhnr_inp, vhrmin_inp, vhrmax_inp, vhasse_inp
|
|
|
|
|
tread = .TRUE.
|
|
|
|
|
!
|
|
|
|
|
RETURN
|
|
|
|
|
!
|
2005-12-28 23:57:48 +08:00
|
|
|
END SUBROUTINE card_vhmean
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
! BEGIN manual
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! DIPOLE
|
|
|
|
|
!
|
|
|
|
|
! calculate polarizability
|
|
|
|
|
!
|
|
|
|
|
! Syntax:
|
|
|
|
|
!
|
|
|
|
|
! DIPOLE
|
|
|
|
|
!
|
|
|
|
|
! Where:
|
|
|
|
|
!
|
|
|
|
|
! no parameters
|
|
|
|
|
!
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
! END manual
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
SUBROUTINE card_dipole( input_line )
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
IMPLICIT NONE
|
|
|
|
|
!
|
|
|
|
|
CHARACTER(LEN=256) :: input_line
|
|
|
|
|
LOGICAL, SAVE :: tread = .FALSE.
|
|
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
IF ( tread ) THEN
|
2008-03-11 23:38:23 +08:00
|
|
|
CALL errore( ' card_dipole ', ' two occurrences', 2 )
|
2003-11-17 19:52:06 +08:00
|
|
|
END IF
|
|
|
|
|
!
|
|
|
|
|
tdipole_card = .TRUE.
|
|
|
|
|
tread = .TRUE.
|
|
|
|
|
!
|
|
|
|
|
RETURN
|
|
|
|
|
!
|
2005-12-28 23:57:48 +08:00
|
|
|
END SUBROUTINE card_dipole
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
! BEGIN manual
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! IESR
|
|
|
|
|
!
|
|
|
|
|
! use the specified number of neighbour cells for Ewald summations
|
|
|
|
|
!
|
|
|
|
|
! Syntax:
|
|
|
|
|
!
|
|
|
|
|
! ESR
|
|
|
|
|
! iesr
|
|
|
|
|
!
|
|
|
|
|
! Example:
|
|
|
|
|
!
|
|
|
|
|
! ESR
|
|
|
|
|
! 3
|
|
|
|
|
!
|
|
|
|
|
! Where:
|
|
|
|
|
!
|
|
|
|
|
! iesr (integer) determines the number of neighbour cells to be
|
|
|
|
|
! considered:
|
|
|
|
|
! iesr = 1 : nearest-neighbour cells (default)
|
|
|
|
|
! iesr = 2 : next-to-nearest-neighbour cells
|
|
|
|
|
! and so on
|
|
|
|
|
!
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
! END manual
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
SUBROUTINE card_esr( input_line )
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
IMPLICIT NONE
|
|
|
|
|
!
|
|
|
|
|
CHARACTER(LEN=256) :: input_line
|
|
|
|
|
LOGICAL, SAVE :: tread = .FALSE.
|
|
|
|
|
!
|
|
|
|
|
IF ( tread ) THEN
|
2008-03-11 23:38:23 +08:00
|
|
|
CALL errore( ' card_esr ', ' two occurrences', 2 )
|
2003-11-17 19:52:06 +08:00
|
|
|
END IF
|
|
|
|
|
CALL read_line( input_line )
|
|
|
|
|
READ(input_line,*) iesr_inp
|
|
|
|
|
!
|
|
|
|
|
tread = .TRUE.
|
|
|
|
|
!
|
|
|
|
|
RETURN
|
|
|
|
|
!
|
2005-12-28 23:57:48 +08:00
|
|
|
END SUBROUTINE card_esr
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
! BEGIN manual
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! NEIGHBOURS
|
|
|
|
|
!
|
|
|
|
|
! calculate the neighbours of (and the disance from) each atoms below
|
|
|
|
|
! the distance specified by the parameter
|
|
|
|
|
!
|
|
|
|
|
! Syntax:
|
|
|
|
|
!
|
|
|
|
|
! NEIGHBOURS
|
|
|
|
|
! cut_radius
|
|
|
|
|
!
|
|
|
|
|
! Example:
|
|
|
|
|
!
|
|
|
|
|
! NEIGHBOURS
|
|
|
|
|
! 4.0
|
|
|
|
|
!
|
|
|
|
|
! Where:
|
|
|
|
|
!
|
|
|
|
|
! cut_radius ( real ) radius of the region where atoms are
|
|
|
|
|
! considered as neighbours ( in a.u. )
|
|
|
|
|
!
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
! END manual
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
SUBROUTINE card_neighbours( input_line )
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
IMPLICIT NONE
|
|
|
|
|
!
|
|
|
|
|
CHARACTER(LEN=256) :: input_line
|
|
|
|
|
LOGICAL, SAVE :: tread = .FALSE.
|
|
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
IF ( tread ) THEN
|
2008-03-11 23:38:23 +08:00
|
|
|
CALL errore( ' card_neighbours ', ' two occurrences', 2 )
|
2003-11-17 19:52:06 +08:00
|
|
|
END IF
|
|
|
|
|
!
|
|
|
|
|
CALL read_line( input_line )
|
|
|
|
|
READ(input_line, *) neighbo_radius
|
|
|
|
|
!
|
|
|
|
|
tneighbo = .TRUE.
|
|
|
|
|
tread = .TRUE.
|
|
|
|
|
!
|
|
|
|
|
RETURN
|
|
|
|
|
!
|
2005-12-28 23:57:48 +08:00
|
|
|
END SUBROUTINE card_neighbours
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
! BEGIN manual
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! CELL_PARAMETERS
|
|
|
|
|
!
|
|
|
|
|
! use the specified cell dimensions
|
|
|
|
|
!
|
|
|
|
|
! Syntax:
|
|
|
|
|
!
|
|
|
|
|
! CELL_PARAMETERS
|
|
|
|
|
! HT(1,1) HT(1,2) HT(1,3)
|
|
|
|
|
! HT(2,1) HT(2,2) HT(2,3)
|
|
|
|
|
! HT(3,1) HT(3,2) HT(3,3)
|
|
|
|
|
!
|
|
|
|
|
! Example:
|
|
|
|
|
!
|
|
|
|
|
! CELL_PARAMETERS
|
|
|
|
|
! 24.50644311 0.00004215 -0.14717844
|
|
|
|
|
! -0.00211522 8.12850030 1.70624903
|
|
|
|
|
! 0.16447787 0.74511792 23.07395418
|
|
|
|
|
!
|
|
|
|
|
! Where:
|
|
|
|
|
!
|
|
|
|
|
! HT(i,j) (real) cell dimensions ( in a.u. ),
|
|
|
|
|
! note the relation with lattice vectors:
|
|
|
|
|
! HT(1,:) = A1, HT(2,:) = A2, HT(3,:) = A3
|
|
|
|
|
!
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
! END manual
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
SUBROUTINE card_cell_parameters( input_line )
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
IMPLICIT NONE
|
|
|
|
|
!
|
|
|
|
|
CHARACTER(LEN=256) :: input_line
|
|
|
|
|
INTEGER :: i, j
|
2004-05-20 00:56:56 +08:00
|
|
|
LOGICAL, EXTERNAL :: matches
|
2003-11-17 19:52:06 +08:00
|
|
|
LOGICAL, SAVE :: tread = .FALSE.
|
|
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
IF ( tread ) THEN
|
2008-03-11 23:38:23 +08:00
|
|
|
CALL errore( ' card_cell_parameters ', ' two occurrences', 2 )
|
2003-11-17 19:52:06 +08:00
|
|
|
END IF
|
|
|
|
|
!
|
|
|
|
|
IF ( matches( 'HEXAGONAL', input_line ) ) then
|
All namelists and cards moved to Modules/input_parameters.f90 .
From now on, all new input variables should be added
to this module, and then copied to the code internal
variables in the input.f90 subroutine
The namelists and cards parsers are in :
Modules/read_namelists.f90 and Modules/read_cards.f90
files input_parameters.f90 read_namelists.f90 read_cards.f90
are shared by all codes, while each code has its own version
of input.f90 ( used to copy input values into internals variables ).
EXAMPLE:
suppose you need to add a new input variable called "pippo"
to the namelist control, then:
1) add pippo to the input_parameters.f90 file containing the
namelist control
INTEGER :: pippo = 0
NAMELIST / control / ....., pippo
remember: always set an initialization value!
2) add pippo to the control_default subroutine
( cantained in module read_namelists.f90 )
subroutine control_default( prog )
...
IF( prog == 'PW' ) pippo = 10
...
end subroutine
this routine set the default value for pippo,
that could vary with the code
3) add pippo to the control_bcast subroutine
( cantained in module read_namelists.f90 )
subroutine control_bcast( )
...
call mp_bcast( pippo )
...
end subroutine
4) add pippo to the control_checkin subroutine
( cantained in module read_namelists.f90 )
subroutine control_checking( prog )
...
IF( pippo < 0 ) &
CALL error(' control_checkin ',' variable pippo less than 0 ', 1 )
...
end subroutine
5) Copy the value of pippo in the code internal variables
( file input.f90 )
subroutine iosys()
use input_parameters, only: ...., pippo
use pwcom, only: ....., myvar
...
call read_namelists( 'PW' )
...
myvar = pippo
...
end subroutine
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@282 c92efa57-630b-4861-b058-cf58834340f0
2003-07-31 21:24:20 +08:00
|
|
|
cell_symmetry = 'hexagonal'
|
2003-11-17 19:52:06 +08:00
|
|
|
ELSE
|
All namelists and cards moved to Modules/input_parameters.f90 .
From now on, all new input variables should be added
to this module, and then copied to the code internal
variables in the input.f90 subroutine
The namelists and cards parsers are in :
Modules/read_namelists.f90 and Modules/read_cards.f90
files input_parameters.f90 read_namelists.f90 read_cards.f90
are shared by all codes, while each code has its own version
of input.f90 ( used to copy input values into internals variables ).
EXAMPLE:
suppose you need to add a new input variable called "pippo"
to the namelist control, then:
1) add pippo to the input_parameters.f90 file containing the
namelist control
INTEGER :: pippo = 0
NAMELIST / control / ....., pippo
remember: always set an initialization value!
2) add pippo to the control_default subroutine
( cantained in module read_namelists.f90 )
subroutine control_default( prog )
...
IF( prog == 'PW' ) pippo = 10
...
end subroutine
this routine set the default value for pippo,
that could vary with the code
3) add pippo to the control_bcast subroutine
( cantained in module read_namelists.f90 )
subroutine control_bcast( )
...
call mp_bcast( pippo )
...
end subroutine
4) add pippo to the control_checkin subroutine
( cantained in module read_namelists.f90 )
subroutine control_checking( prog )
...
IF( pippo < 0 ) &
CALL error(' control_checkin ',' variable pippo less than 0 ', 1 )
...
end subroutine
5) Copy the value of pippo in the code internal variables
( file input.f90 )
subroutine iosys()
use input_parameters, only: ...., pippo
use pwcom, only: ....., myvar
...
call read_namelists( 'PW' )
...
myvar = pippo
...
end subroutine
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@282 c92efa57-630b-4861-b058-cf58834340f0
2003-07-31 21:24:20 +08:00
|
|
|
cell_symmetry = 'cubic'
|
2003-11-17 19:52:06 +08:00
|
|
|
END IF
|
|
|
|
|
!
|
2004-03-27 22:15:43 +08:00
|
|
|
IF ( matches( "BOHR", input_line ) ) THEN
|
|
|
|
|
cell_units = 'bohr'
|
|
|
|
|
ELSE IF ( matches( "ANGSTROM", input_line ) ) THEN
|
|
|
|
|
cell_units = 'angstrom'
|
|
|
|
|
ELSE
|
|
|
|
|
cell_units = 'alat'
|
|
|
|
|
END IF
|
|
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
DO i = 1, 3
|
2003-07-07 05:47:17 +08:00
|
|
|
CALL read_line( input_line )
|
2003-11-17 19:52:06 +08:00
|
|
|
READ(input_line,*) ( rd_ht( i, j ), j = 1, 3 )
|
|
|
|
|
END DO
|
|
|
|
|
!
|
|
|
|
|
trd_ht = .TRUE.
|
|
|
|
|
tread = .TRUE.
|
|
|
|
|
!
|
|
|
|
|
RETURN
|
|
|
|
|
!
|
2005-12-28 23:57:48 +08:00
|
|
|
END SUBROUTINE card_cell_parameters
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
! BEGIN manual
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! TURBO
|
|
|
|
|
!
|
|
|
|
|
! allocate space to store electronic states in real space while
|
|
|
|
|
! computing charge density, and then reuse the stored state
|
|
|
|
|
! in the calculation of forces instead of repeating the FFT
|
|
|
|
|
!
|
|
|
|
|
! Syntax:
|
|
|
|
|
!
|
|
|
|
|
! TURBO
|
|
|
|
|
! nturbo
|
|
|
|
|
!
|
|
|
|
|
! Example:
|
|
|
|
|
!
|
|
|
|
|
! TURBO
|
|
|
|
|
! 64
|
|
|
|
|
!
|
|
|
|
|
! Where:
|
|
|
|
|
!
|
|
|
|
|
! nturbo (integer) number of states to be stored
|
|
|
|
|
!
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
! END manual
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
SUBROUTINE card_turbo( input_line )
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
IMPLICIT NONE
|
|
|
|
|
!
|
|
|
|
|
CHARACTER(LEN=256) :: input_line
|
|
|
|
|
LOGICAL, SAVE :: tread = .FALSE.
|
|
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
IF ( tread ) THEN
|
2008-03-11 23:38:23 +08:00
|
|
|
CALL errore( ' card_turbo ', ' two occurrences', 2 )
|
2003-11-17 19:52:06 +08:00
|
|
|
END IF
|
|
|
|
|
!
|
|
|
|
|
CALL read_line( input_line )
|
|
|
|
|
READ(input_line,*) nturbo_inp
|
|
|
|
|
!
|
|
|
|
|
IF( (nturbo_inp < 0) .OR. (nturbo_inp > (nbnd/2)) ) THEN
|
|
|
|
|
CALL errore( ' card_turbo ', ' NTURBO OUT OF RANGE ', nturbo_inp )
|
|
|
|
|
END IF
|
|
|
|
|
!
|
|
|
|
|
tturbo_inp = .TRUE.
|
|
|
|
|
tread = .TRUE.
|
|
|
|
|
!
|
|
|
|
|
RETURN
|
|
|
|
|
!
|
2005-05-27 06:42:05 +08:00
|
|
|
END SUBROUTINE
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
! BEGIN manual
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
!
|
2005-05-27 06:42:05 +08:00
|
|
|
! ATOMIC_VELOCITIES
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
! read velocities (in atomic units) from standard input
|
|
|
|
|
!
|
|
|
|
|
! Syntax:
|
|
|
|
|
!
|
2005-05-27 06:42:05 +08:00
|
|
|
! ATOMIC_VELOCITIES
|
2003-11-17 19:52:06 +08:00
|
|
|
! label(1) Vx(1) Vy(1) Vz(1)
|
|
|
|
|
! ....
|
|
|
|
|
! label(n) Vx(n) Vy(n) Vz(n)
|
|
|
|
|
!
|
|
|
|
|
! Example:
|
|
|
|
|
!
|
|
|
|
|
! ???
|
|
|
|
|
!
|
|
|
|
|
! Where:
|
|
|
|
|
!
|
|
|
|
|
! label (character(len=4)) atomic label
|
|
|
|
|
! Vx(:), Vy(:) and Vz(:) (REAL) x, y and z velocity components of
|
|
|
|
|
! the ions
|
|
|
|
|
!
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
! END manual
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
SUBROUTINE card_ion_velocities( input_line )
|
|
|
|
|
!
|
|
|
|
|
IMPLICIT NONE
|
|
|
|
|
!
|
|
|
|
|
CHARACTER(LEN=256) :: input_line
|
|
|
|
|
INTEGER :: ia, k, is, nfield
|
|
|
|
|
LOGICAL, SAVE :: tread = .FALSE.
|
|
|
|
|
CHARACTER(LEN=4) :: lb_vel
|
|
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
IF( tread ) THEN
|
2008-03-11 23:38:23 +08:00
|
|
|
CALL errore( ' card_ion_velocities ', ' two occurrences', 2 )
|
2003-11-17 19:52:06 +08:00
|
|
|
END IF
|
|
|
|
|
!
|
|
|
|
|
IF( .NOT. taspc ) THEN
|
|
|
|
|
CALL errore( ' card_ion_velocities ', &
|
|
|
|
|
& ' ATOMIC_SPECIES must be present before ', 2 )
|
|
|
|
|
END IF
|
|
|
|
|
!
|
2007-06-12 01:13:15 +08:00
|
|
|
rd_vel = 0.0_DP
|
2003-11-17 19:52:06 +08:00
|
|
|
sp_vel = 0
|
|
|
|
|
!
|
|
|
|
|
IF ( ion_velocities == 'from_input' ) THEN
|
|
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
tavel = .TRUE.
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
DO ia = 1, nat
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
CALL read_line( input_line )
|
|
|
|
|
CALL field_count( nfield, input_line )
|
|
|
|
|
IF ( nfield == 4 ) THEN
|
|
|
|
|
READ(input_line,*) lb_vel, ( rd_vel(k,ia), k = 1, 3 )
|
|
|
|
|
ELSE
|
|
|
|
|
CALL errore( ' iosys ', &
|
|
|
|
|
& ' wrong entries in ION_VELOCITIES ', ia )
|
|
|
|
|
END IF
|
|
|
|
|
!
|
|
|
|
|
match_label: DO is = 1, ntyp
|
|
|
|
|
IF ( TRIM( lb_vel ) == atom_label(is) ) THEN
|
|
|
|
|
sp_vel(ia) = is
|
|
|
|
|
EXIT match_label
|
|
|
|
|
END IF
|
|
|
|
|
END DO match_label
|
|
|
|
|
!
|
|
|
|
|
IF ( sp_vel(ia) < 1 .OR. sp_vel(ia) > ntyp ) THEN
|
|
|
|
|
CALL errore( ' iosys ', ' wrong LABEL in ION_VELOCITIES ', ia )
|
|
|
|
|
END IF
|
|
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
END DO
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
END IF
|
|
|
|
|
!
|
|
|
|
|
tread = .TRUE.
|
|
|
|
|
!
|
|
|
|
|
RETURN
|
|
|
|
|
!
|
2005-05-27 06:42:05 +08:00
|
|
|
END SUBROUTINE
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
! BEGIN manual
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! CONSTRAINTS
|
|
|
|
|
!
|
|
|
|
|
! Ionic Constraints
|
|
|
|
|
!
|
|
|
|
|
! Syntax:
|
|
|
|
|
!
|
|
|
|
|
! CONSTRAINTS
|
|
|
|
|
! NCONSTR CONSTR_TOL
|
2005-04-29 07:44:39 +08:00
|
|
|
! CONSTR_TYPE(.) CONSTR(1,.) CONSTR(2,.) ... { CONSTR_TARGET(.) }
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
! Where:
|
|
|
|
|
!
|
|
|
|
|
! NCONSTR(INTEGER) number of constraints
|
2005-04-29 07:44:39 +08:00
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
! CONSTR_TOL tolerance for keeping the constraints
|
|
|
|
|
! satisfied
|
2005-04-29 07:44:39 +08:00
|
|
|
!
|
|
|
|
|
! CONSTR_TYPE(.) type of constrain:
|
|
|
|
|
! 1: for fixed distances ( two atom indexes must
|
|
|
|
|
! be specified )
|
|
|
|
|
! 2: for fixed planar angles ( three atom indexes
|
|
|
|
|
! must be specified )
|
2006-12-11 22:51:54 +08:00
|
|
|
!
|
2005-04-29 07:44:39 +08:00
|
|
|
! CONSTR(1,.) CONSTR(2,.) ...
|
2006-12-11 22:51:54 +08:00
|
|
|
!
|
2005-04-29 07:44:39 +08:00
|
|
|
! indices object of the constraint, as
|
|
|
|
|
! they appear in the 'POSITION' CARD
|
|
|
|
|
!
|
|
|
|
|
! CONSTR_TARGET target for the constrain ( in the case of
|
|
|
|
|
! planar angles it is the COS of the angle ).
|
|
|
|
|
! this variable is optional.
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
! END manual
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
SUBROUTINE card_constraints( input_line )
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
IMPLICIT NONE
|
|
|
|
|
!
|
|
|
|
|
CHARACTER(LEN=256) :: input_line
|
2005-04-29 07:30:51 +08:00
|
|
|
INTEGER :: i, nfield
|
2003-11-17 19:52:06 +08:00
|
|
|
LOGICAL, SAVE :: tread = .FALSE.
|
|
|
|
|
!
|
2006-05-01 09:07:57 +08:00
|
|
|
!
|
2008-03-18 17:40:02 +08:00
|
|
|
IF ( tread ) CALL errore( 'card_constraints', 'two occurrences', 2 )
|
2005-05-27 06:42:05 +08:00
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
CALL read_line( input_line )
|
2005-04-29 07:30:51 +08:00
|
|
|
!
|
2005-10-20 23:22:12 +08:00
|
|
|
CALL field_count( nfield, input_line )
|
2005-05-27 06:42:05 +08:00
|
|
|
!
|
2005-10-20 23:22:12 +08:00
|
|
|
IF ( nfield == 1 ) THEN
|
2005-05-27 06:42:05 +08:00
|
|
|
!
|
2005-10-20 23:22:12 +08:00
|
|
|
READ( input_line, * ) nconstr_inp
|
|
|
|
|
!
|
|
|
|
|
ELSE IF ( nfield == 2 ) THEN
|
|
|
|
|
!
|
|
|
|
|
READ( input_line, * ) nconstr_inp, constr_tol_inp
|
|
|
|
|
!
|
|
|
|
|
ELSE
|
|
|
|
|
!
|
2005-12-22 04:26:08 +08:00
|
|
|
CALL errore( 'card_constraints', 'too many fields', nfield )
|
2005-10-20 23:22:12 +08:00
|
|
|
!
|
|
|
|
|
END IF
|
|
|
|
|
!
|
2006-04-01 00:00:17 +08:00
|
|
|
CALL allocate_input_constr()
|
2005-10-20 23:22:12 +08:00
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
DO i = 1, nconstr_inp
|
|
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
CALL read_line( input_line )
|
2005-04-29 07:30:51 +08:00
|
|
|
!
|
2005-09-17 10:35:57 +08:00
|
|
|
READ( input_line, * ) constr_type_inp(i)
|
2005-04-29 07:30:51 +08:00
|
|
|
!
|
|
|
|
|
CALL field_count( nfield, input_line )
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
2006-06-22 21:15:32 +08:00
|
|
|
IF ( nfield > nc_fields + 2 ) &
|
2005-12-22 04:26:08 +08:00
|
|
|
CALL errore( 'card_constraints', &
|
2006-01-05 03:09:08 +08:00
|
|
|
'too many fields for this constraint', i )
|
2005-12-22 04:26:08 +08:00
|
|
|
!
|
2006-12-11 22:51:54 +08:00
|
|
|
SELECT CASE( constr_type_inp(i) )
|
2006-01-29 06:35:48 +08:00
|
|
|
CASE( 'type_coord', 'atom_coord' )
|
2005-05-03 07:14:06 +08:00
|
|
|
!
|
2006-05-01 09:07:57 +08:00
|
|
|
IF ( nfield == 5 ) THEN
|
2005-05-03 07:14:06 +08:00
|
|
|
!
|
|
|
|
|
READ( input_line, * ) constr_type_inp(i), &
|
|
|
|
|
constr_inp(1,i), &
|
|
|
|
|
constr_inp(2,i), &
|
|
|
|
|
constr_inp(3,i), &
|
|
|
|
|
constr_inp(4,i)
|
|
|
|
|
!
|
2005-05-27 06:42:05 +08:00
|
|
|
ELSE IF ( nfield == 6 ) THEN
|
2005-05-03 07:14:06 +08:00
|
|
|
!
|
|
|
|
|
READ( input_line, * ) constr_type_inp(i), &
|
|
|
|
|
constr_inp(1,i), &
|
|
|
|
|
constr_inp(2,i), &
|
|
|
|
|
constr_inp(3,i), &
|
|
|
|
|
constr_inp(4,i), &
|
|
|
|
|
constr_target(i)
|
|
|
|
|
!
|
|
|
|
|
constr_target_set(i) = .TRUE.
|
|
|
|
|
!
|
2005-05-27 06:42:05 +08:00
|
|
|
ELSE
|
|
|
|
|
!
|
2006-06-22 21:15:32 +08:00
|
|
|
CALL errore( 'card_constraints', 'type_coord, ' // &
|
|
|
|
|
& 'atom_coord: wrong number of fields', nfield )
|
2005-05-27 06:42:05 +08:00
|
|
|
!
|
2005-05-03 07:14:06 +08:00
|
|
|
END IF
|
|
|
|
|
!
|
2006-01-29 06:35:48 +08:00
|
|
|
CASE( 'distance' )
|
2005-04-29 07:30:51 +08:00
|
|
|
!
|
2006-05-01 09:07:57 +08:00
|
|
|
IF ( nfield == 3 ) THEN
|
2005-04-29 07:30:51 +08:00
|
|
|
!
|
|
|
|
|
READ( input_line, * ) constr_type_inp(i), &
|
|
|
|
|
constr_inp(1,i), &
|
|
|
|
|
constr_inp(2,i)
|
|
|
|
|
!
|
2005-05-27 06:42:05 +08:00
|
|
|
ELSE IF ( nfield == 4 ) THEN
|
2005-04-29 07:30:51 +08:00
|
|
|
!
|
|
|
|
|
READ( input_line, * ) constr_type_inp(i), &
|
|
|
|
|
constr_inp(1,i), &
|
|
|
|
|
constr_inp(2,i), &
|
|
|
|
|
constr_target(i)
|
|
|
|
|
!
|
|
|
|
|
constr_target_set(i) = .TRUE.
|
|
|
|
|
!
|
2005-05-27 06:42:05 +08:00
|
|
|
ELSE
|
|
|
|
|
!
|
2006-06-22 21:15:32 +08:00
|
|
|
CALL errore( 'card_constraints', &
|
|
|
|
|
& 'distance: wrong number of fields', nfield )
|
2005-05-27 06:42:05 +08:00
|
|
|
!
|
2005-04-29 07:30:51 +08:00
|
|
|
END IF
|
|
|
|
|
!
|
2006-01-29 06:35:48 +08:00
|
|
|
CASE( 'planar_angle' )
|
2005-04-29 07:30:51 +08:00
|
|
|
!
|
2006-05-01 09:07:57 +08:00
|
|
|
IF ( nfield == 4 ) THEN
|
2005-04-29 07:30:51 +08:00
|
|
|
!
|
|
|
|
|
READ( input_line, * ) constr_type_inp(i), &
|
|
|
|
|
constr_inp(1,i), &
|
|
|
|
|
constr_inp(2,i), &
|
|
|
|
|
constr_inp(3,i)
|
|
|
|
|
!
|
2005-05-27 06:42:05 +08:00
|
|
|
ELSE IF ( nfield == 5 ) THEN
|
2005-04-29 07:30:51 +08:00
|
|
|
!
|
|
|
|
|
READ( input_line, * ) constr_type_inp(i), &
|
|
|
|
|
constr_inp(1,i), &
|
|
|
|
|
constr_inp(2,i), &
|
|
|
|
|
constr_inp(3,i), &
|
|
|
|
|
constr_target(i)
|
|
|
|
|
!
|
|
|
|
|
constr_target_set(i) = .TRUE.
|
|
|
|
|
!
|
2005-05-27 06:42:05 +08:00
|
|
|
ELSE
|
|
|
|
|
!
|
2006-06-22 21:15:32 +08:00
|
|
|
CALL errore( 'card_constraints', &
|
|
|
|
|
& 'planar_angle: wrong number of fields', nfield )
|
2005-12-22 04:26:08 +08:00
|
|
|
!
|
|
|
|
|
END IF
|
|
|
|
|
!
|
2006-01-29 06:35:48 +08:00
|
|
|
CASE( 'torsional_angle' )
|
2005-12-22 04:26:08 +08:00
|
|
|
!
|
2006-05-01 09:07:57 +08:00
|
|
|
IF ( nfield == 5 ) THEN
|
2005-12-22 04:26:08 +08:00
|
|
|
!
|
|
|
|
|
READ( input_line, * ) constr_type_inp(i), &
|
|
|
|
|
constr_inp(1,i), &
|
|
|
|
|
constr_inp(2,i), &
|
|
|
|
|
constr_inp(3,i), &
|
|
|
|
|
constr_inp(4,i)
|
|
|
|
|
!
|
|
|
|
|
ELSE IF ( nfield == 6 ) THEN
|
|
|
|
|
!
|
|
|
|
|
READ( input_line, * ) constr_type_inp(i), &
|
|
|
|
|
constr_inp(1,i), &
|
|
|
|
|
constr_inp(2,i), &
|
|
|
|
|
constr_inp(3,i), &
|
|
|
|
|
constr_inp(4,i), &
|
|
|
|
|
constr_target(i)
|
|
|
|
|
!
|
|
|
|
|
constr_target_set(i) = .TRUE.
|
|
|
|
|
!
|
|
|
|
|
ELSE
|
|
|
|
|
!
|
2006-06-22 21:15:32 +08:00
|
|
|
CALL errore( 'card_constraints', &
|
|
|
|
|
& 'torsional_angle: wrong number of fields', nfield )
|
|
|
|
|
!
|
|
|
|
|
END IF
|
|
|
|
|
!
|
|
|
|
|
CASE( 'bennett_proj' )
|
|
|
|
|
!
|
|
|
|
|
IF ( nfield == 5 ) THEN
|
|
|
|
|
!
|
|
|
|
|
READ( input_line, * ) constr_type_inp(i), &
|
|
|
|
|
constr_inp(1,i), &
|
|
|
|
|
constr_inp(2,i), &
|
|
|
|
|
constr_inp(3,i), &
|
|
|
|
|
constr_inp(4,i)
|
|
|
|
|
!
|
|
|
|
|
ELSE IF ( nfield == 6 ) THEN
|
|
|
|
|
!
|
|
|
|
|
READ( input_line, * ) constr_type_inp(i), &
|
|
|
|
|
constr_inp(1,i), &
|
|
|
|
|
constr_inp(2,i), &
|
|
|
|
|
constr_inp(3,i), &
|
|
|
|
|
constr_inp(4,i), &
|
|
|
|
|
constr_target(i)
|
|
|
|
|
!
|
|
|
|
|
constr_target_set(i) = .TRUE.
|
|
|
|
|
!
|
|
|
|
|
ELSE
|
|
|
|
|
!
|
|
|
|
|
CALL errore( 'card_constraints', &
|
|
|
|
|
& 'bennett_proj: wrong number of fields', nfield )
|
2005-05-27 06:42:05 +08:00
|
|
|
!
|
2005-04-29 07:30:51 +08:00
|
|
|
END IF
|
|
|
|
|
!
|
2006-05-01 09:07:57 +08:00
|
|
|
CASE DEFAULT
|
|
|
|
|
!
|
|
|
|
|
CALL errore( 'card_constraints', 'unknown constraint ' // &
|
2006-06-22 21:15:32 +08:00
|
|
|
& 'type: ' // TRIM( constr_type_inp(i) ), 1 )
|
2006-05-01 09:07:57 +08:00
|
|
|
!
|
|
|
|
|
END SELECT
|
|
|
|
|
!
|
|
|
|
|
END DO
|
2006-12-11 22:51:54 +08:00
|
|
|
!
|
2006-05-01 09:07:57 +08:00
|
|
|
tread = .TRUE.
|
|
|
|
|
!
|
|
|
|
|
RETURN
|
|
|
|
|
!
|
|
|
|
|
END SUBROUTINE card_constraints
|
|
|
|
|
!
|
|
|
|
|
SUBROUTINE card_collective_vars( input_line )
|
2006-12-11 22:51:54 +08:00
|
|
|
!
|
2006-05-01 09:07:57 +08:00
|
|
|
IMPLICIT NONE
|
2006-12-11 22:51:54 +08:00
|
|
|
!
|
2006-05-01 09:07:57 +08:00
|
|
|
CHARACTER(LEN=256) :: input_line
|
|
|
|
|
INTEGER :: i, nfield
|
|
|
|
|
LOGICAL :: ltest
|
|
|
|
|
LOGICAL, SAVE :: tread = .FALSE.
|
|
|
|
|
!
|
|
|
|
|
!
|
2008-03-18 17:40:02 +08:00
|
|
|
IF ( tread ) CALL errore( 'card_collective_vars', 'two occurrences', 2 )
|
2006-05-01 09:07:57 +08:00
|
|
|
!
|
|
|
|
|
CALL read_line( input_line )
|
|
|
|
|
!
|
|
|
|
|
CALL field_count( nfield, input_line )
|
|
|
|
|
!
|
|
|
|
|
IF ( nfield == 1 ) THEN
|
|
|
|
|
!
|
|
|
|
|
READ( input_line, * ) ncolvar_inp
|
|
|
|
|
!
|
|
|
|
|
ELSE IF ( nfield == 2 ) THEN
|
|
|
|
|
!
|
|
|
|
|
READ( input_line, * ) ncolvar_inp, colvar_tol_inp
|
|
|
|
|
!
|
|
|
|
|
ELSE
|
|
|
|
|
!
|
2006-06-22 21:15:32 +08:00
|
|
|
CALL errore( 'card_collective_vars', 'too many fields', nfield )
|
2006-05-01 09:07:57 +08:00
|
|
|
!
|
|
|
|
|
END IF
|
|
|
|
|
!
|
|
|
|
|
CALL allocate_input_colvar()
|
|
|
|
|
!
|
|
|
|
|
IF ( cg_phs_path_flag ) THEN
|
|
|
|
|
!
|
|
|
|
|
input_images = 2
|
|
|
|
|
!
|
|
|
|
|
IF( ALLOCATED( pos ) ) DEALLOCATE( pos )
|
|
|
|
|
!
|
|
|
|
|
ALLOCATE( pos( ncolvar_inp, input_images ) )
|
|
|
|
|
!
|
2007-06-12 01:13:15 +08:00
|
|
|
pos(:,:) = 0.0_DP
|
2006-05-01 09:07:57 +08:00
|
|
|
!
|
|
|
|
|
END IF
|
|
|
|
|
!
|
|
|
|
|
DO i = 1, ncolvar_inp
|
|
|
|
|
!
|
|
|
|
|
CALL read_line( input_line )
|
|
|
|
|
!
|
|
|
|
|
READ( input_line, * ) colvar_type_inp(i)
|
|
|
|
|
!
|
|
|
|
|
CALL field_count( nfield, input_line )
|
|
|
|
|
!
|
2006-06-22 21:15:32 +08:00
|
|
|
ltest = ( ( nfield <= nc_fields + 2 ) .OR. &
|
|
|
|
|
( cg_phs_path_flag .AND. ( nfield <= nc_fields + 4 ) ) )
|
2006-05-01 09:07:57 +08:00
|
|
|
!
|
|
|
|
|
IF ( .NOT. ltest ) &
|
2006-06-22 21:15:32 +08:00
|
|
|
CALL errore( 'card_collective_vars', 'too many fields for ' // &
|
|
|
|
|
& 'this constraint: ' // TRIM( constr_type_inp(i) ), i )
|
2006-05-01 09:07:57 +08:00
|
|
|
!
|
2006-12-11 22:51:54 +08:00
|
|
|
SELECT CASE( colvar_type_inp(i) )
|
2006-05-01 09:07:57 +08:00
|
|
|
CASE( 'type_coord', 'atom_coord' )
|
2006-01-14 01:27:11 +08:00
|
|
|
!
|
|
|
|
|
IF ( cg_phs_path_flag ) THEN
|
|
|
|
|
!
|
2006-05-01 09:07:57 +08:00
|
|
|
READ( input_line, * ) colvar_type_inp(i), &
|
|
|
|
|
colvar_inp(1,i), &
|
|
|
|
|
colvar_inp(2,i), &
|
|
|
|
|
colvar_inp(3,i), &
|
|
|
|
|
colvar_inp(4,i), &
|
|
|
|
|
pos(i,1), &
|
|
|
|
|
pos(i,2)
|
|
|
|
|
!
|
|
|
|
|
ELSE IF ( nfield == 5 ) THEN
|
|
|
|
|
!
|
|
|
|
|
READ( input_line, * ) colvar_type_inp(i), &
|
|
|
|
|
colvar_inp(1,i), &
|
|
|
|
|
colvar_inp(2,i), &
|
|
|
|
|
colvar_inp(3,i), &
|
|
|
|
|
colvar_inp(4,i)
|
|
|
|
|
!
|
|
|
|
|
ELSE
|
|
|
|
|
!
|
2006-06-22 21:15:32 +08:00
|
|
|
CALL errore( 'card_collective_vars', 'type_coord, ' // &
|
|
|
|
|
& 'atom_coord: wrong number of fields', nfield )
|
2006-05-01 09:07:57 +08:00
|
|
|
!
|
|
|
|
|
END IF
|
|
|
|
|
!
|
|
|
|
|
CASE( 'distance' )
|
|
|
|
|
!
|
|
|
|
|
IF ( cg_phs_path_flag ) THEN
|
|
|
|
|
!
|
|
|
|
|
READ( input_line, * ) colvar_type_inp(i), &
|
|
|
|
|
colvar_inp(1,i), &
|
|
|
|
|
colvar_inp(2,i), &
|
|
|
|
|
pos(i,1), &
|
|
|
|
|
pos(i,2)
|
|
|
|
|
!
|
|
|
|
|
ELSE IF ( nfield == 3 ) THEN
|
|
|
|
|
!
|
|
|
|
|
READ( input_line, * ) colvar_type_inp(i), &
|
|
|
|
|
colvar_inp(1,i), &
|
|
|
|
|
colvar_inp(2,i)
|
|
|
|
|
!
|
|
|
|
|
ELSE
|
|
|
|
|
!
|
2006-05-11 02:17:56 +08:00
|
|
|
CALL errore( 'card_collective_vars', &
|
2006-06-22 21:15:32 +08:00
|
|
|
& 'distance: wrong number of fields', nfield )
|
2006-05-01 09:07:57 +08:00
|
|
|
!
|
|
|
|
|
END IF
|
|
|
|
|
!
|
|
|
|
|
CASE( 'planar_angle' )
|
|
|
|
|
!
|
|
|
|
|
IF ( cg_phs_path_flag ) THEN
|
|
|
|
|
!
|
|
|
|
|
READ( input_line, * ) colvar_type_inp(i), &
|
|
|
|
|
colvar_inp(1,i), &
|
|
|
|
|
colvar_inp(2,i), &
|
|
|
|
|
colvar_inp(3,i), &
|
|
|
|
|
pos(i,1), &
|
2006-01-14 01:27:11 +08:00
|
|
|
pos(i,2)
|
|
|
|
|
!
|
|
|
|
|
ELSE IF ( nfield == 4 ) THEN
|
|
|
|
|
!
|
2006-05-01 09:07:57 +08:00
|
|
|
READ( input_line, * ) colvar_type_inp(i), &
|
|
|
|
|
colvar_inp(1,i), &
|
|
|
|
|
colvar_inp(2,i), &
|
|
|
|
|
colvar_inp(3,i)
|
|
|
|
|
!
|
|
|
|
|
ELSE
|
|
|
|
|
!
|
2006-05-11 02:17:56 +08:00
|
|
|
CALL errore( 'card_collective_vars', &
|
2006-06-22 21:15:32 +08:00
|
|
|
& 'planar_angle: wrong number of fields', nfield )
|
2006-05-01 09:07:57 +08:00
|
|
|
!
|
|
|
|
|
END IF
|
|
|
|
|
!
|
|
|
|
|
CASE( 'torsional_angle' )
|
|
|
|
|
!
|
|
|
|
|
IF ( cg_phs_path_flag ) THEN
|
|
|
|
|
!
|
|
|
|
|
READ( input_line, * ) colvar_type_inp(i), &
|
|
|
|
|
colvar_inp(1,i), &
|
|
|
|
|
colvar_inp(2,i), &
|
|
|
|
|
colvar_inp(3,i), &
|
|
|
|
|
colvar_inp(4,i), &
|
|
|
|
|
pos(i,1), &
|
|
|
|
|
pos(i,2)
|
2006-01-14 01:27:11 +08:00
|
|
|
!
|
|
|
|
|
ELSE IF ( nfield == 5 ) THEN
|
|
|
|
|
!
|
2006-05-01 09:07:57 +08:00
|
|
|
READ( input_line, * ) colvar_type_inp(i), &
|
|
|
|
|
colvar_inp(1,i), &
|
|
|
|
|
colvar_inp(2,i), &
|
|
|
|
|
colvar_inp(3,i), &
|
|
|
|
|
colvar_inp(4,i)
|
2006-01-14 01:27:11 +08:00
|
|
|
!
|
2006-05-01 09:07:57 +08:00
|
|
|
ELSE
|
|
|
|
|
!
|
2006-05-11 02:17:56 +08:00
|
|
|
CALL errore( 'card_collective_vars', &
|
2006-06-22 21:15:32 +08:00
|
|
|
& 'torsional_angle: wrong number of fields', nfield )
|
2006-05-01 09:07:57 +08:00
|
|
|
!
|
|
|
|
|
END IF
|
|
|
|
|
!
|
2006-06-22 21:15:32 +08:00
|
|
|
CASE( 'struct_fac' )
|
2006-05-01 09:07:57 +08:00
|
|
|
!
|
|
|
|
|
IF ( cg_phs_path_flag ) THEN
|
|
|
|
|
!
|
|
|
|
|
READ( input_line, * ) colvar_type_inp(i), &
|
|
|
|
|
colvar_inp(1,i), &
|
|
|
|
|
colvar_inp(2,i), &
|
|
|
|
|
colvar_inp(3,i), &
|
|
|
|
|
pos(i,1), &
|
|
|
|
|
pos(i,2)
|
|
|
|
|
!
|
|
|
|
|
ELSE IF ( nfield == 4 ) THEN
|
|
|
|
|
!
|
|
|
|
|
READ( input_line, * ) colvar_type_inp(i), &
|
|
|
|
|
colvar_inp(1,i), &
|
|
|
|
|
colvar_inp(2,i), &
|
|
|
|
|
colvar_inp(3,i)
|
2006-01-14 01:27:11 +08:00
|
|
|
!
|
|
|
|
|
ELSE
|
|
|
|
|
!
|
2006-05-11 02:17:56 +08:00
|
|
|
CALL errore( 'card_collective_vars', &
|
2006-06-22 21:15:32 +08:00
|
|
|
& 'struct_fac: wrong number of fields', nfield )
|
2006-01-14 01:27:11 +08:00
|
|
|
!
|
2006-12-11 22:51:54 +08:00
|
|
|
END IF
|
2006-01-14 01:27:11 +08:00
|
|
|
!
|
2006-06-22 21:15:32 +08:00
|
|
|
CASE( 'sph_struct_fac' )
|
2006-01-14 01:27:11 +08:00
|
|
|
!
|
|
|
|
|
IF ( cg_phs_path_flag ) THEN
|
|
|
|
|
!
|
2006-05-01 09:07:57 +08:00
|
|
|
READ( input_line, * ) colvar_type_inp(i), &
|
|
|
|
|
colvar_inp(1,i), &
|
2006-01-14 01:27:11 +08:00
|
|
|
pos(i,1), &
|
|
|
|
|
pos(i,2)
|
|
|
|
|
!
|
|
|
|
|
ELSE IF ( nfield == 2 ) THEN
|
|
|
|
|
!
|
2006-05-01 09:07:57 +08:00
|
|
|
READ( input_line, * ) colvar_type_inp(i), &
|
|
|
|
|
colvar_inp(1,i)
|
2006-01-14 01:27:11 +08:00
|
|
|
!
|
|
|
|
|
ELSE
|
|
|
|
|
!
|
2006-06-22 21:15:32 +08:00
|
|
|
CALL errore( 'card_collective_vars', &
|
|
|
|
|
& 'sph_struct_fac: wrong number of fields', nfield )
|
2006-01-14 01:27:11 +08:00
|
|
|
!
|
2006-12-11 22:51:54 +08:00
|
|
|
END IF
|
2006-01-29 06:35:48 +08:00
|
|
|
!
|
2006-06-22 21:15:32 +08:00
|
|
|
CASE( 'bennett_proj' )
|
|
|
|
|
!
|
|
|
|
|
IF ( cg_phs_path_flag ) THEN
|
|
|
|
|
!
|
|
|
|
|
READ( input_line, * ) constr_type_inp(i), &
|
|
|
|
|
constr_inp(1,i), &
|
|
|
|
|
constr_inp(2,i), &
|
|
|
|
|
constr_inp(3,i), &
|
|
|
|
|
constr_inp(4,i), &
|
|
|
|
|
pos(i,1), &
|
|
|
|
|
pos(i,2)
|
|
|
|
|
!
|
|
|
|
|
ELSE IF ( nfield == 5 ) THEN
|
|
|
|
|
!
|
|
|
|
|
READ( input_line, * ) constr_type_inp(i), &
|
|
|
|
|
constr_inp(1,i), &
|
|
|
|
|
constr_inp(2,i), &
|
|
|
|
|
constr_inp(3,i), &
|
|
|
|
|
constr_inp(4,i)
|
|
|
|
|
!
|
|
|
|
|
ELSE
|
|
|
|
|
!
|
|
|
|
|
CALL errore( 'card_collective_vars', &
|
|
|
|
|
& 'bennett_proj: wrong number of fields', nfield )
|
|
|
|
|
!
|
|
|
|
|
END IF
|
|
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
CASE DEFAULT
|
2005-04-29 07:30:51 +08:00
|
|
|
!
|
2006-05-01 09:07:57 +08:00
|
|
|
CALL errore( 'card_collective_vars', 'unknown collective ' // &
|
2006-06-22 21:15:32 +08:00
|
|
|
& 'variable: ' // TRIM( colvar_type_inp(i) ), 1 )
|
2005-04-29 07:30:51 +08:00
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
END SELECT
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
END DO
|
2006-12-11 22:51:54 +08:00
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
tread = .TRUE.
|
2006-12-11 22:51:54 +08:00
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
RETURN
|
|
|
|
|
!
|
2006-05-01 09:07:57 +08:00
|
|
|
END SUBROUTINE card_collective_vars
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
! BEGIN manual
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! KSOUT
|
|
|
|
|
!
|
|
|
|
|
! Enable the printing of Kohn Sham states
|
|
|
|
|
!
|
|
|
|
|
! Syntax ( nspin == 2 ):
|
|
|
|
|
!
|
|
|
|
|
! KSOUT
|
|
|
|
|
! nu
|
|
|
|
|
! iu(1) iu(2) iu(3) .. iu(nu)
|
|
|
|
|
! nd
|
|
|
|
|
! id(1) id(2) id(3) .. id(nd)
|
|
|
|
|
!
|
|
|
|
|
! Syntax ( nspin == 1 ):
|
|
|
|
|
!
|
|
|
|
|
! KSOUT
|
|
|
|
|
! ns
|
|
|
|
|
! is(1) is(2) is(3) .. is(ns)
|
|
|
|
|
!
|
|
|
|
|
! Example:
|
|
|
|
|
!
|
|
|
|
|
! ???
|
|
|
|
|
!
|
|
|
|
|
! Where:
|
|
|
|
|
!
|
|
|
|
|
! nu (integer) number of spin=1 states to be printed
|
|
|
|
|
! iu(:) (integer) indexes of spin=1 states, the state iu(k)
|
|
|
|
|
! is saved to file KS_UP.iu(k)
|
|
|
|
|
!
|
|
|
|
|
! nd (integer) number of spin=2 states to be printed
|
|
|
|
|
! id(:) (integer) indexes of spin=2 states, the state id(k)
|
|
|
|
|
! is saved to file KS_DW.id(k)
|
|
|
|
|
!
|
|
|
|
|
! ns (integer) number of LDA states to be printed
|
|
|
|
|
! is(:) (integer) indexes of LDA states, the state is(k)
|
|
|
|
|
! is saved to file KS.is(k)
|
|
|
|
|
!
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
! END manual
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
SUBROUTINE card_ksout( input_line )
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
IMPLICIT NONE
|
|
|
|
|
!
|
|
|
|
|
CHARACTER(LEN=256) :: input_line
|
|
|
|
|
LOGICAL, SAVE :: tread = .FALSE.
|
2006-03-24 02:00:12 +08:00
|
|
|
INTEGER :: i, s, nksx
|
2007-10-24 23:36:52 +08:00
|
|
|
TYPE occupancy_type
|
|
|
|
|
INTEGER, pointer :: occs(:)
|
|
|
|
|
END TYPE occupancy_type
|
|
|
|
|
TYPE(occupancy_type), ALLOCATABLE :: is(:)
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
IF ( tread ) THEN
|
2008-03-11 23:38:23 +08:00
|
|
|
CALL errore( ' card_ksout ', ' two occurrences', 2 )
|
2003-11-17 19:52:06 +08:00
|
|
|
END IF
|
|
|
|
|
!
|
2006-03-24 02:00:12 +08:00
|
|
|
nprnks = 0
|
|
|
|
|
nksx = 0
|
|
|
|
|
!
|
2007-10-24 23:36:52 +08:00
|
|
|
ALLOCATE ( is (nspin) )
|
|
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
DO s = 1, nspin
|
|
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
CALL read_line( input_line )
|
2006-03-24 02:00:12 +08:00
|
|
|
READ(input_line, *) nprnks( s )
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
2007-10-24 23:36:52 +08:00
|
|
|
IF ( nprnks( s ) < 1 ) THEN
|
2006-03-24 02:00:12 +08:00
|
|
|
CALL errore( ' card_ksout ', ' wrong number of states ', 2 )
|
2003-07-07 05:47:17 +08:00
|
|
|
END IF
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
2007-10-24 23:36:52 +08:00
|
|
|
ALLOCATE( is(s)%occs( 1:nprnks(s) ) )
|
|
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
CALL read_line( input_line )
|
2007-10-24 23:36:52 +08:00
|
|
|
READ(input_line, *) ( is(s)%occs(i), i = 1, nprnks( s ) )
|
2006-03-24 02:00:12 +08:00
|
|
|
!
|
|
|
|
|
nksx = MAX( nksx, nprnks( s ) )
|
|
|
|
|
!
|
|
|
|
|
END DO
|
|
|
|
|
!
|
|
|
|
|
CALL allocate_input_iprnks( nksx, nspin )
|
|
|
|
|
!
|
|
|
|
|
DO s = 1, nspin
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
2006-03-24 02:00:12 +08:00
|
|
|
DO i = 1, nprnks( s )
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
2007-10-24 23:36:52 +08:00
|
|
|
iprnks( i, s ) = is(s)%occs(i)
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
END DO
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
2007-10-24 23:36:52 +08:00
|
|
|
DEALLOCATE( is(s)%occs )
|
|
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
END DO
|
|
|
|
|
!
|
2006-03-24 02:00:12 +08:00
|
|
|
DEALLOCATE( is )
|
|
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
tread = .TRUE.
|
|
|
|
|
!
|
|
|
|
|
RETURN
|
|
|
|
|
!
|
2005-05-27 06:42:05 +08:00
|
|
|
END SUBROUTINE
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
! BEGIN manual
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! KSOUT_EMPTY
|
|
|
|
|
!
|
|
|
|
|
! Enable the printing of empty Kohn Sham states
|
|
|
|
|
!
|
|
|
|
|
! Syntax ( nspin == 2 ):
|
|
|
|
|
!
|
|
|
|
|
! KSOUT_EMPTY
|
|
|
|
|
! nu
|
|
|
|
|
! iu(1) iu(2) iu(3) .. iu(nu)
|
|
|
|
|
! nd
|
|
|
|
|
! id(1) id(2) id(3) .. id(nd)
|
|
|
|
|
!
|
|
|
|
|
! Syntax ( nspin == 1 ):
|
|
|
|
|
!
|
|
|
|
|
! KSOUT_EMPTY
|
|
|
|
|
! ns
|
|
|
|
|
! is(1) is(2) is(3) .. is(ns)
|
|
|
|
|
!
|
|
|
|
|
! Example:
|
|
|
|
|
!
|
|
|
|
|
! ???
|
|
|
|
|
!
|
|
|
|
|
! Where:
|
|
|
|
|
!
|
|
|
|
|
! nu (integer) number of spin=1 empty states to be printed
|
|
|
|
|
! iu(:) (integer) indexes of spin=1 empty states, the state iu(k)
|
|
|
|
|
! is saved to file KS_EMP_UP.iu(k)
|
|
|
|
|
!
|
|
|
|
|
! nd (integer) number of spin=2 empty states to be printed
|
|
|
|
|
! id(:) (integer) indexes of spin=2 empty states, the state id(k)
|
|
|
|
|
! is saved to file KS_EMP_DW.id(k)
|
|
|
|
|
!
|
|
|
|
|
! ns (integer) number of LDA empty states to be printed
|
|
|
|
|
! is(:) (integer) indexes of LDA empty states, the state is(k)
|
|
|
|
|
! is saved to file KS_EMP.is(k)
|
|
|
|
|
!
|
|
|
|
|
! Note: the first empty state has index "1" !
|
|
|
|
|
!
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
! END manual
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
SUBROUTINE card_ksout_empty( input_line )
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
IMPLICIT NONE
|
|
|
|
|
!
|
|
|
|
|
CHARACTER(LEN=256) :: input_line
|
|
|
|
|
LOGICAL, SAVE :: tread = .FALSE.
|
2006-03-24 02:00:12 +08:00
|
|
|
INTEGER :: nksx, i, s
|
2007-10-24 23:36:52 +08:00
|
|
|
TYPE occupancy_type
|
|
|
|
|
INTEGER, pointer :: occs(:)
|
|
|
|
|
END TYPE occupancy_type
|
|
|
|
|
TYPE(occupancy_type), ALLOCATABLE :: is(:)
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
IF ( tread ) THEN
|
2008-03-11 23:38:23 +08:00
|
|
|
CALL errore( ' card_ksout_empty ', ' two occurrences', 2 )
|
2003-11-17 19:52:06 +08:00
|
|
|
END IF
|
|
|
|
|
!
|
2007-10-24 23:36:52 +08:00
|
|
|
ALLOCATE ( is (nspin) )
|
2006-03-24 02:00:12 +08:00
|
|
|
!
|
|
|
|
|
nprnks_empty = 0
|
|
|
|
|
nksx = 0
|
|
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
DO s = 1, nspin
|
|
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
CALL read_line( input_line )
|
2006-03-24 02:00:12 +08:00
|
|
|
READ(input_line,*) nprnks_empty( s )
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
2007-10-24 23:36:52 +08:00
|
|
|
IF ( nprnks_empty( s ) < 1 ) THEN
|
2006-03-24 02:00:12 +08:00
|
|
|
CALL errore( ' card_ksout_empty ', ' wrong number of states ', 2 )
|
2003-07-07 05:47:17 +08:00
|
|
|
END IF
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
2007-10-24 23:36:52 +08:00
|
|
|
ALLOCATE( is(s)%occs( 1:nprnks_empty( s ) ) )
|
|
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
CALL read_line( input_line )
|
2007-10-24 23:36:52 +08:00
|
|
|
READ(input_line,*) ( is(s)%occs( i ), i = 1, nprnks_empty( s ) )
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
2006-03-24 02:00:12 +08:00
|
|
|
nksx = MAX( nksx, nprnks_empty( s ) )
|
|
|
|
|
!
|
|
|
|
|
END DO
|
|
|
|
|
!
|
|
|
|
|
CALL allocate_input_iprnks_empty( nksx, nspin )
|
|
|
|
|
!
|
|
|
|
|
DO s = 1, nspin
|
|
|
|
|
!
|
|
|
|
|
DO i = 1, nprnks_empty( s )
|
|
|
|
|
!
|
2007-10-24 23:36:52 +08:00
|
|
|
iprnks_empty( i, s ) = is(s)%occs( i )
|
2006-03-24 02:00:12 +08:00
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
END DO
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
2007-10-24 23:36:52 +08:00
|
|
|
DEALLOCATE( is(s)%occs )
|
|
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
END DO
|
2006-03-24 02:00:12 +08:00
|
|
|
!
|
|
|
|
|
DEALLOCATE( is )
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
tread = .TRUE.
|
|
|
|
|
!
|
|
|
|
|
RETURN
|
|
|
|
|
!
|
2005-05-27 06:42:05 +08:00
|
|
|
END SUBROUTINE
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
! BEGIN manual
|
|
|
|
|
!----------------------------------------------------------------------
|
2003-11-24 23:24:07 +08:00
|
|
|
!
|
|
|
|
|
! CLIMBING_IMAGES
|
|
|
|
|
!
|
|
|
|
|
! Needed to explicitly specify which images have to climb
|
|
|
|
|
!
|
|
|
|
|
! Syntax:
|
|
|
|
|
!
|
|
|
|
|
! CLIMBING_IMAGES
|
|
|
|
|
! index1, ..., indexN
|
|
|
|
|
!
|
|
|
|
|
! Where:
|
|
|
|
|
!
|
2004-07-06 05:09:07 +08:00
|
|
|
! index1, ..., indexN are indices of the images that have to climb
|
2003-11-24 23:24:07 +08:00
|
|
|
!
|
|
|
|
|
!----------------------------------------------------------------------
|
2004-04-02 00:30:59 +08:00
|
|
|
! END manual
|
|
|
|
|
!------------------------------------------------------------------------
|
2003-11-24 23:24:07 +08:00
|
|
|
!
|
|
|
|
|
SUBROUTINE card_climbing_images( input_line )
|
|
|
|
|
!
|
|
|
|
|
IMPLICIT NONE
|
|
|
|
|
!
|
|
|
|
|
CHARACTER(LEN=256) :: input_line
|
|
|
|
|
LOGICAL, SAVE :: tread = .FALSE.
|
2004-05-20 00:56:56 +08:00
|
|
|
LOGICAL, EXTERNAL :: matches
|
|
|
|
|
!
|
2006-04-02 08:28:20 +08:00
|
|
|
INTEGER :: i
|
|
|
|
|
CHARACTER(LEN=5) :: i_char
|
|
|
|
|
!
|
2006-02-02 01:56:16 +08:00
|
|
|
CHARACTER(LEN=6), EXTERNAL :: int_to_char
|
2003-11-24 23:24:07 +08:00
|
|
|
!
|
|
|
|
|
!
|
2005-10-20 23:22:12 +08:00
|
|
|
IF ( tread ) &
|
2008-03-11 23:38:23 +08:00
|
|
|
CALL errore( ' card_climbing_images ', ' two occurrences', 2 )
|
2003-11-24 23:24:07 +08:00
|
|
|
!
|
2006-04-21 11:44:20 +08:00
|
|
|
IF ( CI_scheme == 'manual' ) THEN
|
2006-04-02 08:28:20 +08:00
|
|
|
!
|
|
|
|
|
IF ( ALLOCATED( climbing ) ) DEALLOCATE( climbing )
|
|
|
|
|
!
|
|
|
|
|
ALLOCATE( climbing( num_of_images ) )
|
|
|
|
|
!
|
|
|
|
|
climbing(:) = .FALSE.
|
|
|
|
|
!
|
|
|
|
|
CALL read_line( input_line )
|
|
|
|
|
!
|
|
|
|
|
DO i = 1, num_of_images
|
2003-11-24 23:24:07 +08:00
|
|
|
!
|
2006-04-02 08:28:20 +08:00
|
|
|
i_char = int_to_char( i )
|
2003-11-24 23:24:07 +08:00
|
|
|
!
|
2006-04-02 08:28:20 +08:00
|
|
|
IF ( matches( ' ' // TRIM( i_char ) // ',' , &
|
|
|
|
|
' ' // TRIM( input_line ) // ',' ) ) &
|
|
|
|
|
climbing(i) = .TRUE.
|
2003-11-24 23:24:07 +08:00
|
|
|
!
|
2006-04-02 08:28:20 +08:00
|
|
|
END DO
|
2003-12-06 18:32:04 +08:00
|
|
|
!
|
2003-11-24 23:24:07 +08:00
|
|
|
END IF
|
|
|
|
|
!
|
2005-07-02 04:39:45 +08:00
|
|
|
tread = .TRUE.
|
2003-11-24 23:24:07 +08:00
|
|
|
!
|
|
|
|
|
RETURN
|
|
|
|
|
!
|
2005-07-02 04:39:45 +08:00
|
|
|
END SUBROUTINE card_climbing_images
|
2003-11-24 23:24:07 +08:00
|
|
|
!
|
2004-04-02 00:30:59 +08:00
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
! BEGIN manual
|
|
|
|
|
!----------------------------------------------------------------------
|
2005-07-02 04:39:45 +08:00
|
|
|
!
|
|
|
|
|
! PLOT WANNIER
|
|
|
|
|
!
|
|
|
|
|
! Needed to specify the indices of the wannier functions that
|
|
|
|
|
! have to be plotted
|
|
|
|
|
!
|
|
|
|
|
! Syntax:
|
|
|
|
|
!
|
|
|
|
|
! PLOT_WANNIER
|
|
|
|
|
! index1, ..., indexN
|
|
|
|
|
!
|
|
|
|
|
! Where:
|
|
|
|
|
!
|
|
|
|
|
! index1, ..., indexN are indices of the wannier functions
|
|
|
|
|
!
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
! END manual
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
SUBROUTINE card_plot_wannier( input_line )
|
|
|
|
|
!
|
|
|
|
|
IMPLICIT NONE
|
|
|
|
|
!
|
|
|
|
|
CHARACTER(LEN=256) :: input_line
|
|
|
|
|
LOGICAL, SAVE :: tread = .FALSE.
|
|
|
|
|
LOGICAL, EXTERNAL :: matches
|
|
|
|
|
!
|
2006-03-28 12:02:36 +08:00
|
|
|
INTEGER :: i, ib
|
|
|
|
|
CHARACTER(LEN=5) :: i_char
|
2006-02-02 01:56:16 +08:00
|
|
|
CHARACTER(LEN=6), EXTERNAL :: int_to_char
|
2005-07-02 04:39:45 +08:00
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
IF ( tread ) &
|
2008-03-18 17:40:02 +08:00
|
|
|
CALL errore( 'card_plot_wannier', 'two occurrences', 2 )
|
2005-07-02 04:39:45 +08:00
|
|
|
!
|
|
|
|
|
IF ( nwf > 0 ) THEN
|
|
|
|
|
!
|
|
|
|
|
IF ( nwf > nwf_max ) &
|
2006-03-28 12:02:36 +08:00
|
|
|
CALL errore( 'card_plot_wannier', 'too many wannier functions', 1 )
|
2005-07-02 04:39:45 +08:00
|
|
|
!
|
|
|
|
|
CALL read_line( input_line )
|
|
|
|
|
!
|
|
|
|
|
ib = 0
|
|
|
|
|
!
|
2006-04-01 00:00:17 +08:00
|
|
|
DO i = 1, nwf_max
|
2005-07-02 04:39:45 +08:00
|
|
|
!
|
|
|
|
|
i_char = int_to_char( i )
|
|
|
|
|
!
|
2006-03-28 12:02:36 +08:00
|
|
|
IF ( matches( ' ' // TRIM( i_char ) // ',', &
|
2005-07-02 04:39:45 +08:00
|
|
|
' ' // TRIM( input_line ) // ',' ) ) THEN
|
|
|
|
|
!
|
|
|
|
|
ib = ib + 1
|
|
|
|
|
!
|
|
|
|
|
IF ( ib > nwf ) &
|
2006-03-28 12:02:36 +08:00
|
|
|
CALL errore( 'card_plot_wannier', 'too many indices', 1 )
|
|
|
|
|
!
|
|
|
|
|
wannier_index(ib) = i
|
2005-07-02 04:39:45 +08:00
|
|
|
!
|
|
|
|
|
END IF
|
|
|
|
|
!
|
|
|
|
|
END DO
|
2006-03-28 12:02:36 +08:00
|
|
|
!
|
2005-07-02 04:39:45 +08:00
|
|
|
END IF
|
|
|
|
|
!
|
|
|
|
|
tread = .TRUE.
|
|
|
|
|
!
|
|
|
|
|
RETURN
|
|
|
|
|
!
|
|
|
|
|
END SUBROUTINE card_plot_wannier
|
2004-04-02 00:30:59 +08:00
|
|
|
!
|
2005-07-02 04:39:45 +08:00
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
! BEGIN manual
|
|
|
|
|
!----------------------------------------------------------------------
|
2004-04-02 00:30:59 +08:00
|
|
|
!
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
! TEMPLATE
|
|
|
|
|
!
|
|
|
|
|
! This is a template card info section
|
|
|
|
|
!
|
|
|
|
|
! Syntax:
|
|
|
|
|
!
|
|
|
|
|
! TEMPLATE
|
|
|
|
|
! RVALUE IVALUE
|
|
|
|
|
!
|
|
|
|
|
! Example:
|
|
|
|
|
!
|
|
|
|
|
! ???
|
|
|
|
|
!
|
|
|
|
|
! Where:
|
|
|
|
|
!
|
|
|
|
|
! RVALUE (real) This is a real value
|
|
|
|
|
! IVALUE (integer) This is an integer value
|
|
|
|
|
!
|
|
|
|
|
!----------------------------------------------------------------------
|
|
|
|
|
! END manual
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
SUBROUTINE card_template( input_line )
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
|
|
|
|
IMPLICIT NONE
|
|
|
|
|
!
|
|
|
|
|
CHARACTER(LEN=256) :: input_line
|
|
|
|
|
LOGICAL, SAVE :: tread = .FALSE.
|
|
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
IF ( tread ) THEN
|
2008-03-11 23:38:23 +08:00
|
|
|
CALL errore( ' card_template ', ' two occurrences', 2 )
|
2003-11-17 19:52:06 +08:00
|
|
|
END IF
|
|
|
|
|
!
|
|
|
|
|
! .... CODE HERE
|
|
|
|
|
!
|
|
|
|
|
tread = .TRUE.
|
|
|
|
|
!
|
|
|
|
|
RETURN
|
|
|
|
|
!
|
2005-05-27 06:42:05 +08:00
|
|
|
END SUBROUTINE
|
2003-11-17 19:52:06 +08:00
|
|
|
!
|
2003-07-07 05:47:17 +08:00
|
|
|
END MODULE read_cards_module
|