1! 2! Copyright (C) 2010 Quantum ESPRESSO group 3! This file is distributed under the terms of the 4! GNU General Public License. See the file `License' 5! in the root directory of the present distribution, 6! or http://www.gnu.org/copyleft/gpl.txt . 7! 8!--------------------------------------------------------------------------- 9MODULE path_read_cards_module 10 !--------------------------------------------------------------------------- 11 ! 12 ! ... This module handles the reading of cards from standard input 13 ! ... Written by Carlo Cavazzoni and modified for "path" implementation 14 ! ... by Carlo Sbraccia 15 ! 16 USE kinds, ONLY : DP 17 USE constants, ONLY : angstrom_au 18 USE parser, ONLY : parse_unit,field_count, read_line, get_field 19 USE io_global, ONLY : meta_ionode 20 ! 21 USE path_input_parameters_module 22 ! 23 IMPLICIT NONE 24 ! 25 SAVE 26 ! 27 PRIVATE 28 ! 29 PUBLIC :: path_read_cards 30 ! 31 ! ... end of module-scope declarations 32 ! 33 ! ---------------------------------------------- 34 ! 35CONTAINS 36 ! 37 ! ... Read CARDS .... 38 ! 39 ! ... subroutines 40 ! 41 !---------------------------------------------------------------------- 42 ! 43 !---------------------------------------------------------------------- 44 SUBROUTINE path_read_cards(unit) 45 !---------------------------------------------------------------------- 46 ! 47 IMPLICIT NONE 48 ! 49 INTEGER, INTENT(IN) :: unit 50 ! 51 CHARACTER(len=256) :: input_line 52 CHARACTER(len=80) :: card 53 CHARACTER(len=1), EXTERNAL :: capital 54 LOGICAL :: tend 55 INTEGER :: i 56 ! 57 ! 58 parse_unit = unit 59 ! 60100 CALL read_line( input_line, end_of_file=tend ) 61 ! 62 IF( tend ) GOTO 120 63 IF( input_line == ' ' .or. input_line(1:1) == '#' ) GOTO 100 64 ! 65 READ (input_line, *) card 66 ! 67 DO i = 1, len_trim( input_line ) 68 input_line( i : i ) = capital( input_line( i : i ) ) 69 ENDDO 70 ! 71 IF( trim(card) =='CLIMBING_IMAGES' ) THEN 72 ! 73 CALL card_climbing_images( input_line ) 74 ! 75 ELSE 76 ! 77 IF ( meta_ionode ) CALL infomsg ('read_cards_module',& 78 'card '//trim(input_line)//' ignored' ) 79 ! 80 ENDIF 81 ! 82 ! ... END OF LOOP ... ! 83 ! 84 GOTO 100 85 ! 86120 CONTINUE 87 ! 88 RETURN 89 ! 90 END SUBROUTINE path_read_cards 91 92 ! 93 ! ... Description of the allowed input CARDS 94 ! 95 ! 96 !------------------------------------------------------------------------ 97 ! BEGIN manual 98 !---------------------------------------------------------------------- 99 ! 100 ! CLIMBING_IMAGES 101 ! 102 ! Needed to explicitly specify which images have to climb 103 ! 104 ! Syntax: 105 ! 106 ! CLIMBING_IMAGES 107 ! index1, ..., indexN 108 ! 109 ! Where: 110 ! 111 ! index1, ..., indexN are indices of the images that have to climb 112 ! 113 !---------------------------------------------------------------------- 114 ! END manual 115 !------------------------------------------------------------------------ 116 ! 117 SUBROUTINE card_climbing_images( input_line ) 118 ! 119 IMPLICIT NONE 120 ! 121 CHARACTER(len=256) :: input_line 122 LOGICAL, SAVE :: tread = .false. 123 LOGICAL, EXTERNAL :: matches 124 ! 125 INTEGER :: i 126 CHARACTER(len=5) :: i_char 127 ! 128 CHARACTER(len=6), EXTERNAL :: int_to_char 129 ! 130 ! 131 IF ( tread ) & 132 CALL errore( ' card_climbing_images ', ' two occurrences', 2 ) 133 ! 134 IF ( CI_scheme == 'manual' ) THEN 135 ! 136 IF ( allocated( climbing ) ) DEALLOCATE( climbing ) 137 ! 138 ALLOCATE( climbing( num_of_images ) ) 139 ! 140 climbing(:) = .false. 141 ! 142 CALL read_line( input_line ) 143 ! 144 DO i = 1, num_of_images 145 ! 146 i_char = int_to_char( i ) 147 ! 148 IF ( matches( ' ' // trim( i_char ) // ',' , & 149 ' ' // trim( input_line ) // ',' ) ) & 150 climbing(i) = .true. 151 ! 152 ENDDO 153 ! 154 ENDIF 155 ! 156 tread = .true. 157 ! 158 RETURN 159 ! 160 END SUBROUTINE card_climbing_images 161 ! 162END MODULE path_read_cards_module 163