1! 2! Copyright (C) 2002-2011 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 9! This module contains subroutines to print computed quantities to 10! standard output and ASCII file 11 12MODULE printout_base 13 14 IMPLICIT NONE 15 SAVE 16 17 CHARACTER(LEN=256) :: fort_unit(30:44) 18 ! ... fort_unit = fortran units for saving physical quantity 19 20CONTAINS 21 22 23 SUBROUTINE printout_base_init( ) 24 25 USE io_files, ONLY: tmp_dir, prefix 26 USE io_global, ONLY: ionode, ionode_id 27 USE mp_global, ONLY: intra_image_comm 28 USE mp, ONLY: mp_bcast 29 30 INTEGER :: iunit, ierr, ios 31 CHARACTER(LEN=256) :: pprefix 32 ! ... prefix combined with the output path 33 34 pprefix = TRIM( tmp_dir ) // TRIM( prefix ) 35 36 ierr = 0 37 38 IF( ionode ) THEN 39 fort_unit(30) = trim(pprefix)//'.con' 40 fort_unit(31) = trim(pprefix)//'.eig' 41 fort_unit(32) = trim(pprefix)//'.pol' 42 fort_unit(33) = trim(pprefix)//'.evp' 43 fort_unit(34) = trim(pprefix)//'.vel' 44 fort_unit(35) = trim(pprefix)//'.pos' 45 fort_unit(36) = trim(pprefix)//'.cel' 46 fort_unit(37) = trim(pprefix)//'.for' 47 fort_unit(38) = trim(pprefix)//'.str' 48 fort_unit(39) = trim(pprefix)//'.nos' 49 fort_unit(40) = trim(pprefix)//'.the' 50 fort_unit(41) = trim(pprefix)//'.spr' ! wannier spread 51 fort_unit(42) = trim(pprefix)//'.wfc' ! wannier function 52 fort_unit(43) = trim(pprefix)//'.hrs' ! hirshfeld volumes 53 fort_unit(44) = trim(pprefix)//'.ncg' ! number of cgsteps 54 DO iunit = LBOUND( fort_unit, 1 ), UBOUND( fort_unit, 1 ) 55 OPEN(UNIT=iunit, FILE=fort_unit(iunit), & 56 STATUS='unknown', POSITION='append', IOSTAT = ios ) 57 CLOSE( iunit ) 58 ierr = ierr + ABS(ios) 59 END DO 60 END IF 61 62 CALL mp_bcast(ierr, ionode_id, intra_image_comm) 63 IF( ierr /= 0 ) THEN 64 CALL errore(' printout_base_init ', & 65 ' error in opening files '//TRIM(pprefix)//'.XXX',ierr) 66 END IF 67 68 RETURN 69 END SUBROUTINE printout_base_init 70 71 72 SUBROUTINE printout_base_open( suffix ) 73 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: suffix 74 INTEGER :: iunit 75 LOGICAL :: ok=.true. 76 ! ... Open units 30, 31, ... 44 for simulation output 77 IF( PRESENT( suffix ) ) THEN 78 IF( LEN( suffix ) /= 3 ) & 79 CALL errore(" printout_base_open ", " wrong suffix ", 1 ) 80 ok = .false. 81 END IF 82 DO iunit = LBOUND( fort_unit, 1 ), UBOUND( fort_unit, 1 ) 83 IF( PRESENT( suffix ) ) THEN 84 IF( index( fort_unit(iunit), suffix, back=.TRUE. ) == & 85 ( len_trim( fort_unit(iunit) ) - 2 ) ) THEN 86 OPEN( UNIT=iunit, FILE=fort_unit(iunit), STATUS='unknown', POSITION='append') 87 ok = .true. 88 END IF 89 ELSE 90 OPEN( UNIT=iunit, FILE=fort_unit(iunit), STATUS='unknown', POSITION='append') 91 END IF 92 END DO 93 IF( PRESENT( suffix ) ) THEN 94 IF( .NOT. ok ) & 95 CALL errore(" printout_base_open ", " file with suffix "//suffix//" not found ", 1 ) 96 END IF 97 RETURN 98 END SUBROUTINE printout_base_open 99 100 101 FUNCTION printout_base_unit( suffix ) 102 ! return the unit corresponding to a given suffix 103 CHARACTER(LEN=*), INTENT(IN) :: suffix 104 INTEGER :: printout_base_unit 105 INTEGER :: iunit 106 LOGICAL :: ok 107 IF( LEN( suffix ) /= 3 ) & 108 CALL errore(" printout_base_unit ", " wrong suffix ", 1 ) 109 ok = .false. 110 DO iunit = LBOUND( fort_unit, 1 ), UBOUND( fort_unit, 1 ) 111 IF( index( fort_unit(iunit), suffix, back=.TRUE. ) == ( len_trim( fort_unit(iunit) ) - 2 ) ) THEN 112 printout_base_unit = iunit 113 ok = .true. 114 END IF 115 END DO 116 IF( .NOT. ok ) & 117 CALL errore(" printout_base_unit ", " file with suffix "//suffix//" not found ", 1 ) 118 RETURN 119 END FUNCTION printout_base_unit 120 121 122 FUNCTION printout_base_name( suffix ) 123 ! return the full name of a print out file with a given suffix 124 CHARACTER(LEN=*), INTENT(IN) :: suffix 125 CHARACTER(LEN=256) :: printout_base_name 126 INTEGER :: iunit 127 LOGICAL :: ok 128 IF( LEN( suffix ) /= 3 ) & 129 CALL errore(" printout_base_name ", " wrong suffix ", 1 ) 130 ok = .false. 131 DO iunit = LBOUND( fort_unit, 1 ), UBOUND( fort_unit, 1 ) 132 IF( index( fort_unit(iunit), suffix, back=.TRUE. ) == ( len_trim( fort_unit(iunit) ) - 2 ) ) THEN 133 printout_base_name = fort_unit(iunit) 134 ok = .true. 135 END IF 136 END DO 137 IF( .NOT. ok ) & 138 CALL errore(" printout_base_name ", " file with suffix "//suffix//" not found ", 1 ) 139 RETURN 140 END FUNCTION printout_base_name 141 142 143 144 SUBROUTINE printout_base_close( suffix ) 145 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: suffix 146 INTEGER :: iunit 147 LOGICAL :: topen 148 LOGICAL :: ok 149 ! ... Close and flush unit 30, ... 44 150 IF( PRESENT( suffix ) ) THEN 151 IF( LEN( suffix ) /= 3 ) & 152 CALL errore(" printout_base_close ", " wrong suffix ", 1 ) 153 ok = .false. 154 END IF 155 DO iunit = LBOUND( fort_unit, 1 ), UBOUND( fort_unit, 1 ) 156 IF( PRESENT( suffix ) ) THEN 157 IF( index( fort_unit(iunit), suffix, back=.TRUE. ) == ( len_trim( fort_unit(iunit) ) - 2 ) ) THEN 158 INQUIRE( UNIT=iunit, OPENED=topen ) 159 IF( topen ) CLOSE(iunit) 160 ok = .true. 161 END IF 162 ELSE 163 INQUIRE( UNIT=iunit, OPENED=topen ) 164 IF (topen) CLOSE(iunit) 165 END IF 166 END DO 167 IF( PRESENT( suffix ) ) THEN 168 IF( .NOT. ok ) & 169 CALL errore(" printout_base_close ", " file with suffix "//suffix//" not found ", 1 ) 170 END IF 171 RETURN 172 END SUBROUTINE printout_base_close 173 174 175 SUBROUTINE printout_pos( iunit, tau, nat, ityp, what, nfi, tps, label, fact, head ) 176 ! 177 USE kinds 178 ! 179 INTEGER, INTENT(IN) :: iunit, nat, ityp(:) 180 REAL(DP), INTENT(IN) :: tau( :, : ) 181 CHARACTER(LEN=3), INTENT(IN), OPTIONAL :: what 182 INTEGER, INTENT(IN), OPTIONAL :: nfi 183 REAL(DP), INTENT(IN), OPTIONAL :: tps 184 CHARACTER(LEN=3), INTENT(IN), OPTIONAL :: label( : ) 185 REAL(DP), INTENT(IN), OPTIONAL :: fact 186 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: head 187 ! 188 INTEGER :: ia, k 189 REAL(DP) :: f 190 ! 191 IF( PRESENT( fact ) ) THEN 192 f = fact 193 ELSE 194 f = 1.0_DP 195 END IF 196 ! 197 IF( PRESENT( head ) ) THEN 198 WRITE( iunit, 10 ) head 199 END IF 200 ! 201 IF( PRESENT( what ) ) THEN 202 IF ( what == 'xyz' ) WRITE( iunit, *) nat 203 END IF 204 ! 205 IF( PRESENT( nfi ) .AND. PRESENT( tps ) ) THEN 206 WRITE( iunit, 30 ) nfi, tps 207 ELSE IF( PRESENT( what ) ) THEN 208 IF( what == 'pos' ) THEN 209 WRITE( iunit, 40 ) 210 ELSE IF( what == 'vel' ) THEN 211 WRITE( iunit, 50 ) 212 ELSE IF( what == 'for' ) THEN 213 WRITE( iunit, 60 ) 214 END IF 215 END IF 216 ! 217 IF( PRESENT( label ) ) THEN 218 DO ia = 1, nat 219 WRITE( iunit, 255 ) label(ityp(ia)), ( f * tau(k,ia),k = 1,3) 220 END DO 221 ELSE 222 DO ia = 1, nat 223 WRITE( iunit, 252 ) (tau(k,ia),k = 1,3) 224 END DO 225 END IF 226 10 FORMAT(3X,A) 227 30 FORMAT(I8,1X,F13.8) 228 40 FORMAT(3X,'ATOMIC_POSITIONS') 229 50 FORMAT(3X,'ATOMIC_VELOCITIES') 230 60 FORMAT(3X,'Forces acting on atoms (au):') 231255 FORMAT(3X,A3,3E25.14) 232252 FORMAT(3E25.14) 233 RETURN 234 END SUBROUTINE printout_pos 235 236 237 238 SUBROUTINE printout_cell( iunit, h, nfi, tps ) 239 ! 240 USE kinds 241 ! 242 INTEGER, INTENT(IN) :: iunit 243 REAL(DP), INTENT(IN) :: h(3,3) 244 INTEGER, INTENT(IN), OPTIONAL :: nfi 245 REAL(DP), INTENT(IN), OPTIONAL :: tps 246 ! 247 INTEGER :: i, j 248 ! 249 IF( PRESENT( nfi ) .AND. PRESENT( tps ) ) THEN 250 WRITE( iunit, 30 ) nfi, tps 251 ELSE 252 WRITE( iunit, 40 ) 253 END IF 254 ! 255 DO i = 1, 3 256 WRITE( iunit, 100 ) (h(i,j),j=1,3) 257 END DO 258 ! 259 30 FORMAT(I8,1X,F13.8) 260 40 FORMAT(3X,'CELL_PARAMETERS') 261100 FORMAT(3F14.8) 262 RETURN 263 END SUBROUTINE printout_cell 264 265 266 267 SUBROUTINE printout_stress( iunit, str, nfi, tps ) 268 ! 269 USE kinds 270 ! 271 INTEGER, INTENT(IN) :: iunit 272 REAL(DP), INTENT(IN) :: str(3,3) 273 INTEGER, INTENT(IN), OPTIONAL :: nfi 274 REAL(DP), INTENT(IN), OPTIONAL :: tps 275 ! 276 INTEGER :: i, j 277 ! 278 IF( PRESENT( nfi ) .AND. PRESENT( tps ) ) THEN 279 WRITE( iunit, 30 ) nfi, tps 280 ELSE 281 WRITE( iunit, 40 ) 282 END IF 283 ! 284 DO i = 1, 3 285 WRITE( iunit, 100 ) (str(i,j),j=1,3) 286 END DO 287 ! 288 30 FORMAT(I8,1X,F13.8) 289 40 FORMAT(3X,'Total stress (GPa)') 290100 FORMAT(3(F18.8,1X)) 291 RETURN 292 END SUBROUTINE printout_stress 293 294 SUBROUTINE printout_vefftsvdw( iunit, veff, nat, nfi, tps ) 295 ! 296 USE kinds 297 ! 298 INTEGER, INTENT(IN) :: iunit, nat 299 REAL(DP), INTENT(IN) :: veff(nat) 300 INTEGER, INTENT(IN), OPTIONAL :: nfi 301 REAL(DP), INTENT(IN), OPTIONAL :: tps 302 ! 303 INTEGER :: i, j 304 ! 305 IF( PRESENT( nfi ) .AND. PRESENT( tps ) ) THEN 306 WRITE( iunit, 30 ) nfi, tps 307 ELSE 308 WRITE( iunit, 40 ) 309 END IF 310 ! 311 DO i = 1, nat 312 WRITE( iunit, 100 ) veff(i) 313 END DO 314 ! 315 30 FORMAT(I8,1X,F13.8) 316 40 FORMAT(3X,'Veff tsvdw') 317100 FORMAT(F20.10) 318 RETURN 319 END SUBROUTINE printout_vefftsvdw 320 321 SUBROUTINE printout_wfc( iunit, wfc_temp, nband, nfi, tps, iss ) 322 ! 323 USE kinds 324 ! 325 INTEGER, INTENT(IN) :: iunit, nband 326 REAL(DP), INTENT(IN) :: wfc_temp(3,nband) 327 INTEGER, INTENT(IN) :: nfi 328 REAL(DP), INTENT(IN) :: tps 329 INTEGER, INTENT(IN), OPTIONAL :: iss 330 ! 331 INTEGER :: i, j 332 ! 333 IF( PRESENT( iss ) ) THEN 334 WRITE( iunit, 40 ) nfi, tps, iss 335 ELSE 336 WRITE( iunit, 30 ) nfi, tps 337 END IF 338 ! 339 DO i = 1, nband 340 WRITE( iunit, 100 ) (wfc_temp(j,i),j=1,3) 341 END DO 342 ! 343 30 FORMAT(I8,1X,F13.8) 344 40 FORMAT(I7,1X,F11.8,1X,"spin=",I5) 345100 FORMAT(3E25.14) 346 RETURN 347 END SUBROUTINE printout_wfc 348 !------------------------------------------------------------------------ 349 SUBROUTINE save_print_counter( iter, wunit ) 350 !------------------------------------------------------------------------ 351 ! 352 ! ... a counter indicating the last successful printout iteration is saved 353 ! 354 USE io_global, ONLY: ionode, ionode_id 355 USE io_files, ONLY : iunpun, create_directory, restart_dir 356 USE mp, ONLY: mp_bcast 357 USE mp_images, ONLY : intra_image_comm 358 ! 359 IMPLICIT NONE 360 ! 361 INTEGER, INTENT(IN) :: iter 362 INTEGER, INTENT(IN) :: wunit 363 ! 364 INTEGER :: ierr 365 CHARACTER(LEN=256) :: filename, dirname 366 ! 367 ! 368 dirname = restart_dir( wunit ) 369 ! 370 CALL create_directory( TRIM( dirname ) ) 371 ! 372 IF ( ionode ) THEN 373 ! 374 filename = TRIM( dirname ) // 'print_counter' 375 ! 376 OPEN( UNIT = iunpun, FILE = filename, FORM = 'formatted', & 377 STATUS = 'unknown', IOSTAT = ierr ) 378 ! 379 END IF 380 ! 381 CALL mp_bcast( ierr, ionode_id, intra_image_comm ) 382 ! 383 CALL errore( 'save_print_counter', & 384 'cannot open restart file for writing', ierr ) 385 ! 386 IF ( ionode ) THEN 387 ! 388 WRITE ( iunpun, '("LAST SUCCESSFUL PRINTOUT AT STEP:",/,i5 )' ) iter 389 ! 390 CLOSE ( iunpun, STATUS = 'keep' ) 391 ! 392 END IF 393 ! 394 RETURN 395 ! 396 END SUBROUTINE save_print_counter 397 ! 398 !------------------------------------------------------------------------ 399 SUBROUTINE read_print_counter( nprint_nfi, runit ) 400 !------------------------------------------------------------------------ 401 ! 402 ! ... the counter indicating the last successful printout iteration 403 ! ... is read here 404 ! 405 USE io_global, ONLY: ionode, ionode_id 406 USE io_files, ONLY : iunpun, restart_dir 407 USE mp, ONLY: mp_bcast 408 USE mp_images, ONLY : intra_image_comm 409 ! 410 IMPLICIT NONE 411 ! 412 INTEGER, INTENT(OUT) :: nprint_nfi 413 INTEGER, INTENT(IN) :: runit 414 ! 415 INTEGER :: ierr 416 CHARACTER(LEN=256) :: filename, dirname 417 ! 418 ! 419 dirname = restart_dir( runit ) 420 ! 421 IF ( ionode ) THEN 422 ! 423 filename = TRIM( dirname ) // 'print_counter' 424 ! 425 OPEN( UNIT = iunpun, FILE = filename, FORM = 'formatted', & 426 STATUS = 'old', IOSTAT = ierr ) 427 ! 428 IF ( ierr > 0 ) THEN 429 ! 430 nprint_nfi = -1 431 ! 432 ELSE 433 ! 434 READ ( iunpun, * ) 435 READ ( iunpun, * ) nprint_nfi 436 ! 437 CLOSE ( iunpun, STATUS = 'keep' ) 438 ! 439 END IF 440 ! 441 END IF 442 ! 443 CALL mp_bcast( nprint_nfi, ionode_id, intra_image_comm ) 444 ! 445 RETURN 446 ! 447 END SUBROUTINE read_print_counter 448 ! 449END MODULE printout_base 450