mirror of https://gitlab.com/QEF/q-e.git
Missing allocation was causing xml input to crash when reading k-points.
Several unused or obsolete stuff removed. git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@10920 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
giannozz
parent
0a4b6205ab
commit
c24cee3ee6
|
|
@ -62,15 +62,8 @@ CONTAINS
|
|||
CASE ('PW')
|
||||
!
|
||||
CALL read_xml_common( attr, 'PW' )
|
||||
!
|
||||
!
|
||||
CALL read_xml_pw()
|
||||
!
|
||||
!
|
||||
! CASE ('NEB')
|
||||
! !
|
||||
! CALL read_xml_common( attr, 'PW' )
|
||||
! !
|
||||
CASE ('CP')
|
||||
!
|
||||
CALL read_xml_common( attr, 'CP' )
|
||||
|
|
|
|||
|
|
@ -224,25 +224,6 @@ CONTAINS
|
|||
CALL mp_bcast( rd_vel, ionode_id, world_comm )
|
||||
CALL mp_bcast( tapos, ionode_id, world_comm )
|
||||
!
|
||||
! CASE ( 'CHAIN' )
|
||||
! CALL mp_bcast( atomic_positions, ionode_id, world_comm )
|
||||
! CALL mp_bcast( nat, ionode_id, world_comm )
|
||||
! CALL mp_bcast( num_of_images, ionode_id, world_comm )
|
||||
! ! ... ionode has already done it inside card_xml_atomic_list
|
||||
! IF (.not.ionode) THEN
|
||||
! CALL allocate_input_ions( ntyp, nat )
|
||||
! IF (num_of_images>1) THEN
|
||||
! IF ( allocated( pos ) ) deallocate( pos )
|
||||
! allocate( pos( 3*nat, num_of_images ) )
|
||||
! END IF
|
||||
! END IF
|
||||
! CALL mp_bcast( pos, ionode_id, world_comm )
|
||||
! CALL mp_bcast( if_pos, ionode_id, world_comm )
|
||||
! CALL mp_bcast( sp_pos, ionode_id, world_comm )
|
||||
! CALL mp_bcast( rd_pos, ionode_id, world_comm )
|
||||
! CALL mp_bcast( na_inp, ionode_id, world_comm )
|
||||
! CALL mp_bcast( tapos, ionode_id, world_comm )
|
||||
!
|
||||
CASE ( 'CONSTRAINTS' )
|
||||
CALL mp_bcast( nconstr_inp, ionode_id, world_comm )
|
||||
CALL mp_bcast( constr_tol_inp, ionode_id, world_comm )
|
||||
|
|
@ -261,6 +242,7 @@ CONTAINS
|
|||
CALL mp_bcast( k1, ionode_id, world_comm )
|
||||
CALL mp_bcast( k2, ionode_id, world_comm )
|
||||
CALL mp_bcast( k3, ionode_id, world_comm )
|
||||
IF ( .not.ionode ) ALLOCATE( xk(3,MAX(1,nkstot)), wk(MAX(1,nkstot)) )
|
||||
CALL mp_bcast( xk, ionode_id, world_comm )
|
||||
CALL mp_bcast( wk, ionode_id, world_comm )
|
||||
!
|
||||
|
|
@ -272,10 +254,6 @@ CONTAINS
|
|||
END IF
|
||||
CALL mp_bcast( f_inp, ionode_id, world_comm )
|
||||
!
|
||||
! CASE ( 'CLIMBING_IMAGES' )
|
||||
! IF ( .not.ionode ) ALLOCATE( climbing( num_of_images ) )
|
||||
! CALL mp_bcast( climbing, ionode_id, world_comm )
|
||||
!
|
||||
CASE ( 'PLOT_WANNIER' )
|
||||
CALL mp_bcast( wannier_index, ionode_id, world_comm )
|
||||
!
|
||||
|
|
@ -903,7 +881,7 @@ CONTAINS
|
|||
!_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-!
|
||||
! !
|
||||
! !
|
||||
! CHAIN (used in neb and smd calculation) !
|
||||
! CHAIN (used in neb and smd calculation) OBSOLETE, NOT IMPLEMENTED !
|
||||
! !
|
||||
! set the atomic positions for a chian !
|
||||
! !
|
||||
|
|
@ -949,165 +927,12 @@ CONTAINS
|
|||
!
|
||||
end_of_chain = .false.
|
||||
|
||||
! CALL iotk_scan_begin( xmlinputunit, 'chain', attr, ierr = ierr )
|
||||
! IF ( ierr /= 0 ) CALL errore( 'card_xml_chain', 'error scanning begin &
|
||||
! &of chain node', abs(ierr) )
|
||||
! !
|
||||
! !
|
||||
! CALL iotk_scan_attr( attr, 'num_of_images', num_of_images, ierr = ierr )
|
||||
! IF ( ierr /= 0 ) CALL errore( 'card_xml_chain', 'error reading &
|
||||
! &num_of_images attribute of chain node', abs(ierr) )
|
||||
! !
|
||||
! IF ( num_of_images < 1 ) CALL errore ( 'card_xml_chain', 'null &
|
||||
! &or negative num_of_images', 1 )
|
||||
! !
|
||||
! CALL find_image( 1 )
|
||||
! IF (end_of_chain) CALL errore( 'card_xml_chain', 'first image not found', 1 )
|
||||
! !
|
||||
! CALL iotk_scan_attr( attr, 'units', atomic_positions, found = found, ierr = ierr )
|
||||
! IF ( ierr /= 0 ) CALL errore( 'card_xml_chain', 'error reading units attribute &
|
||||
! &of atomic_list node', abs(ierr) )
|
||||
! !
|
||||
! IF ( found ) THEN
|
||||
! IF ( (trim( atomic_positions ) == 'crystal') .or. &
|
||||
! (trim( atomic_positions ) == 'bohr') .or. &
|
||||
! (trim( atomic_positions ) == 'angstrom').or. &
|
||||
! (trim( atomic_positions ) == 'alat') ) THEN
|
||||
! atomic_positions = trim( atomic_positions )
|
||||
! ELSE
|
||||
! CALL errore( 'car_xml_chain', &
|
||||
! 'error in units attribute of atomic_list node, unknow '&
|
||||
! & //trim(atomic_positions)//' units', 1 )
|
||||
! ENDIF
|
||||
! ELSE
|
||||
! ! ... default value
|
||||
! atomic_positions = 'alat'
|
||||
! ENDIF
|
||||
! !
|
||||
! CALL iotk_scan_attr( attr, 'nat', nat, ierr = ierr )
|
||||
! IF ( ierr /= 0 ) CALL errore( 'card_xml_chain', 'error reading nat attribute &
|
||||
! &of atomic_list node', abs(ierr) )
|
||||
! !
|
||||
! IF ( nat < 1 ) THEN
|
||||
! CALL errore( 'card_xml_chain', 'nat out of range', abs(nat) )
|
||||
! END IF
|
||||
!
|
||||
! ! ... allocation of needed arrays
|
||||
! CALL allocate_input_ions( ntyp, nat )
|
||||
! !
|
||||
! if_pos = 1
|
||||
! sp_pos = 0
|
||||
! rd_pos = 0.0_DP
|
||||
! na_inp = 0
|
||||
! !
|
||||
! !
|
||||
! IF ( allocated( pos ) ) deallocate( pos )
|
||||
! allocate( pos( 3*nat, num_of_images ) )
|
||||
!
|
||||
! allocate( tmp_image( 3, nat ) )
|
||||
!
|
||||
! pos(:, :) = 0.0_DP
|
||||
!
|
||||
! CALL read_image( 1, tmp_image )
|
||||
! ! ... transfer of tmp_image data in pos array (to mantain compatibility)
|
||||
! CALL reshaffle_indexes( 1 )
|
||||
!
|
||||
! input_images = 1
|
||||
!
|
||||
! DO
|
||||
! !
|
||||
! ! ... a trick to move the cursor at the beginning of chain node
|
||||
! !
|
||||
! CALL iotk_scan_end( xmlinputunit, 'atomic_list', ierr = ierr )
|
||||
! IF ( ierr /= 0 ) CALL errore( 'card_xml_chain', 'error scanning end of &
|
||||
! &atomic_list node', input_images )
|
||||
! !
|
||||
! CALL iotk_scan_end( xmlinputunit, 'chain', ierr = ierr )
|
||||
! IF ( ierr /= 0 ) CALL errore( 'card_xml_chain', 'error scanning end of chain &
|
||||
! &node', abs(ierr) )
|
||||
! !
|
||||
! CALL iotk_scan_begin( xmlinputunit, 'chain', ierr = ierr )
|
||||
! IF ( ierr /= 0 ) CALL errore( 'card_xml_chain', 'error scanning begin &
|
||||
! &of chain node', abs( ierr ) )
|
||||
! ! ... end of the trick
|
||||
! !
|
||||
! CALL find_image( input_images + 1 )
|
||||
! !
|
||||
! IF (end_of_chain) EXIT
|
||||
! !
|
||||
! input_images = input_images + 1
|
||||
! !
|
||||
! IF ( input_images > num_of_images ) CALL errore( 'card_xml_chain',&
|
||||
! 'too many images in chain node', 1 )
|
||||
! !
|
||||
! CALL read_image( input_images, tmp_image )
|
||||
! ! ... transfer tmp_image data in pos array (to mantain compatibility)
|
||||
! CALL reshaffle_indexes( input_images )
|
||||
! !
|
||||
! ENDDO
|
||||
! !
|
||||
! CALL iotk_scan_end( xmlinputunit, 'atomic_list', ierr = ierr )
|
||||
! IF ( ierr /= 0 ) CALL errore( 'card_xml_chain', 'error scanning end of &
|
||||
! &atomic_list node', abs(ierr) )
|
||||
! !
|
||||
! !
|
||||
! tapos = .true.
|
||||
!
|
||||
! DEALLOCATE(tmp_image)
|
||||
RETURN
|
||||
!
|
||||
! CONTAINS
|
||||
!
|
||||
! ... does a scan to find the image with attribute num="iimage"
|
||||
! SUBROUTINE find_image( iimage )
|
||||
! !
|
||||
! INTEGER, INTENT( in ) :: iimage
|
||||
! INTEGER :: direction, rii
|
||||
! !
|
||||
! DO
|
||||
! CALL iotk_scan_begin( xmlinputunit, 'atomic_list', attr, &
|
||||
! direction = direction, ierr = ierr )
|
||||
! IF ( ierr /= 0 ) CALL errore( 'card_xml_chain', 'error scanning begin &
|
||||
! &of atomic_list node', abs(ierr) )
|
||||
! !
|
||||
! CALL iotk_scan_attr( attr, 'num', rii, ierr = ierr )
|
||||
! IF ( ierr /= 0 ) CALL errore( 'card_xml_chain', 'error reading num &
|
||||
! &attribute of atomic_list node', abs(ierr) )
|
||||
! !
|
||||
! IF ( rii == iimage ) EXIT
|
||||
! !
|
||||
! IF ( direction == -1 ) THEN
|
||||
! end_of_chain = .true.
|
||||
! EXIT
|
||||
! END IF
|
||||
! !
|
||||
! CALL iotk_scan_end( xmlinputunit, 'atomic_list', ierr = ierr )
|
||||
! IF ( ierr /= 0 ) CALL errore( 'card_xml_chain', 'error scanning end &
|
||||
! &of atomic_list node', abs(iimage) )
|
||||
! !
|
||||
! END DO
|
||||
! !
|
||||
! END SUBROUTINE find_image
|
||||
! !
|
||||
! ! ... copy the data from tmp_image to pos, necessary to mantain the notation
|
||||
! ! ... of old input
|
||||
! SUBROUTINE reshaffle_indexes( iimage )
|
||||
! !
|
||||
! INTEGER, INTENT( in ) :: iimage
|
||||
! INTEGER :: ia_tmp, idx_tmp
|
||||
!
|
||||
! DO ia_tmp = 1,nat
|
||||
! idx_tmp = 3*(ia_tmp -1 )
|
||||
! pos(idx_tmp+1:idx_tmp+3, iimage) = tmp_image( 1:3, ia_tmp )
|
||||
! END DO
|
||||
! END SUBROUTINE reshaffle_indexes
|
||||
! !
|
||||
END SUBROUTINE card_xml_chain
|
||||
!
|
||||
! ... Subroutine that reads a single image inside chain node
|
||||
!
|
||||
!
|
||||
! ! ... Subroutine that reads a single image inside chain node
|
||||
! !
|
||||
SUBROUTINE read_image( image, image_pos, image_vel )
|
||||
!
|
||||
IMPLICIT NONE
|
||||
|
|
@ -1778,7 +1603,7 @@ CONTAINS
|
|||
!
|
||||
!_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_!
|
||||
! !
|
||||
! CLIMBING_IMAGES (optional) !
|
||||
! CLIMBING_IMAGES (optional) OBSOLETE, NOT IMPLEMENTED !
|
||||
! !
|
||||
! Needed to explicitly specify which images have to climb !
|
||||
! !
|
||||
|
|
@ -1804,65 +1629,8 @@ CONTAINS
|
|||
!_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_!
|
||||
!
|
||||
SUBROUTINE card_xml_climbing_images( )
|
||||
! !
|
||||
! IMPLICIT NONE
|
||||
! !
|
||||
! !
|
||||
! INTEGER :: i, num_climb_images, ierr
|
||||
! INTEGER, DIMENSION(:), ALLOCATABLE :: tmp
|
||||
! CHARACTER (LEN=iotk_attlenx) :: attr
|
||||
! !
|
||||
! !
|
||||
! IF ( CI_scheme == 'manual' ) THEN
|
||||
! !
|
||||
! IF ( allocated( climbing ) ) deallocate( climbing )
|
||||
! !
|
||||
! allocate( climbing( num_of_images ) )
|
||||
! !
|
||||
! climbing( : ) = .FALSE.
|
||||
! !
|
||||
! CALL iotk_scan_begin( xmlinputunit, 'images', ierr = ierr )
|
||||
! IF ( ierr /= 0 ) CALL errore( 'card_xml_climbing_images', 'error scanning begin of &
|
||||
! &images node', abs( ierr ) )
|
||||
! !
|
||||
! CALL iotk_scan_begin( xmlinputunit, 'integer', attr, ierr = ierr )
|
||||
! IF ( ierr /= 0 ) CALL errore( 'card_xml_climbing_images', 'error scanning begin of &
|
||||
! &integer node', abs( ierr ) )
|
||||
! !
|
||||
! CALL iotk_scan_end( xmlinputunit, 'integer', ierr = ierr )
|
||||
! IF ( ierr /= 0 ) CALL errore( 'card_xml_climbing_images', 'error scanning end of &
|
||||
! &integer node', abs( ierr ) )
|
||||
! !
|
||||
! CALL iotk_scan_attr( attr, 'n1', num_climb_images, ierr = ierr )
|
||||
! IF ( ierr /= 0 ) CALL errore( 'card_xml_climbing_images', 'error reading n1 attribute of &
|
||||
! &integer node', abs( ierr ) )
|
||||
! !
|
||||
! IF ( num_climb_images < 1 ) CALL errore( 'card_xml_climbing_images', 'non positive value &
|
||||
! &of num_climb_images', abs( num_climb_images ) )
|
||||
! !
|
||||
! allocate( tmp( num_climb_images ) )
|
||||
! !
|
||||
! CALL iotk_scan_dat_inside( xmlinputunit, tmp, ierr = ierr )
|
||||
! IF ( ierr /= 0 ) CALL errore( 'card_xml_climbing_images', 'error reading data inside &
|
||||
! &images node', abs( ierr ) )
|
||||
! !
|
||||
! CALL iotk_scan_end( xmlinputunit, 'images', ierr = ierr )
|
||||
! IF ( ierr /= 0 ) CALL errore( 'card_xml_climbing_images', 'error scanning end of &
|
||||
! &images node', abs( ierr ) )
|
||||
! !
|
||||
! DO i = 1, num_climb_images
|
||||
! !
|
||||
! IF ( ( tmp(i) > num_of_images ) .or. ( tmp(i)<0 ) ) CALL errore('card_xml_climbing_images',&
|
||||
! "image that doesn't exist", 1 )
|
||||
! !
|
||||
! climbing(tmp(i)) = .true.
|
||||
! !
|
||||
! ENDDO
|
||||
! !
|
||||
! ENDIF
|
||||
! !
|
||||
RETURN
|
||||
!
|
||||
RETURN
|
||||
!
|
||||
END SUBROUTINE card_xml_climbing_images
|
||||
!
|
||||
|
|
|
|||
Loading…
Reference in New Issue