read_xml.f90 14.6 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12
!
!---------------------------------------------------------!
!   This module handles the reading of fields and cards   !
!   in case of xml input                                  !
!                                                         !
!   written by Simone Ziraldo (08/2010)                   !
!---------------------------------------------------------!
MODULE read_xml_module
  !
  !
  USE input_parameters
  !
13
  USE io_global, ONLY : ionode, ionode_id, xmlinputunit => qestdin
14
  USE mp,        ONLY : mp_bcast
15
  USE mp_images, ONLY : intra_image_comm
16
  USE iotk_module, ONLY : iotk_attlenx
17 18 19 20
  !
  ! ...default and checkin of fields
  !
  USE read_namelists_module, ONLY : control_defaults, system_defaults,&
21
       electrons_defaults, wannier_ac_defaults, ions_defaults, &
22
       cell_defaults, press_ai_defaults, wannier_defaults, control_bcast, &
23
       system_bcast, electrons_bcast, ions_bcast,cell_bcast, &
24 25 26 27 28 29 30
       press_ai_bcast, wannier_bcast, wannier_ac_bcast, control_checkin, &
       system_checkin, electrons_checkin, ions_checkin, cell_checkin, &
       wannier_checkin, wannier_ac_checkin, fixval
  !
  !
  USE read_xml_fields_module, ONLY : read_xml_fields
  USE read_xml_cards_module, ONLY : card_xml_atomic_species, card_xml_atomic_list, &
31
       card_xml_cell, card_xml_kpoints, card_xml_occupations, &
32
       card_xml_constraints, card_xml_plot_wannier, card_default, card_bcast
33 34 35 36 37 38 39 40 41 42 43 44 45 46
  !
  !
  IMPLICIT NONE
  !
  SAVE
  !
  PRIVATE
  !
  PUBLIC :: read_xml
  !
CONTAINS
  !
  !
  !--------------------------------------------------------!
47
  !    This routine organizes the reading of the xml file  !
48
  !    depending on the program                            !
49
  !--------------------------------------------------------!
50
  SUBROUTINE read_xml( prog, attr )
51 52 53 54 55 56
    !
    !
    IMPLICIT NONE
    !
    !
    CHARACTER(len = 2), INTENT(IN) :: prog
57 58
    CHARACTER(len = *), INTENT(IN) :: attr
    INTEGER :: ierr
59 60 61 62 63
    !
    SELECT CASE (prog)
       !
    CASE ('PW')
       !
64 65 66 67 68 69 70
       CALL read_xml_common( attr, 'PW' )
       CALL read_xml_pw()
       !
    CASE ('CP')
       !
       CALL read_xml_common( attr, 'CP' )
       CALL read_xml_cp()
71 72 73
       !
    CASE default
       !
74
       CALL errore('read_xml', "xml input isn't implemented for "//prog//' program', 1)
75 76 77
       !
    END SELECT
    !
78
    !
79 80 81 82 83
    RETURN
    !
  END SUBROUTINE read_xml
  !
  !
84 85 86 87 88 89 90 91
  !--------------------------------------------------------!
  ! Common part of the reading: setting default values,    !
  ! reading of cell and atomic_species cards               !
  !--------------------------------------------------------!
  SUBROUTINE read_xml_common( attr, prog )
    !
    !
    USE iotk_module, ONLY : iotk_scan_attr
92 93 94 95 96
    !
    !
    IMPLICIT NONE
    !
    !
97
    CHARACTER (len = *), INTENT(IN) :: attr, prog
98 99
    !
    CHARACTER (len = 256) :: dummy
100
    INTEGER :: ierr
101 102 103
    LOGICAL :: found
    !
    !
104 105 106 107 108 109 110 111 112 113 114 115 116 117
    ! ... default settings for all parameters
    !
    CALL control_defaults( prog )
    CALL system_defaults( prog )
    CALL electrons_defaults( prog )
    CALL ions_defaults( prog )
    CALL cell_defaults( prog )
    CALL wannier_defaults( prog )
    CALL wannier_ac_defaults( prog )
    !
    !
    ! ... reading the attributes of the xml root node
    !
    IF (ionode) THEN
118 119
       !
       CALL iotk_scan_attr( attr, 'calculation', dummy, found = found, ierr = ierr )
giannozz's avatar
giannozz committed
120
       IF ( .not. found ) CALL errore( 'read_xml_common', 'attribute calculation of root &
121
            &node is compulsory', abs(ierr) )
122
       !
giannozz's avatar
giannozz committed
123
       IF ( ierr /= 0 ) CALL errore( 'read_xml_common', 'error reading calculation &
124 125
            &attribute of root node', 1 )
       calculation = trim( dummy )
126 127
       !
       CALL iotk_scan_attr( attr, 'prefix', dummy, found = found, ierr = ierr )
giannozz's avatar
giannozz committed
128
       IF ( ierr /= 0 ) CALL errore( 'read_xml_common', 'error reading prefix attribute &
129
            &of root node', abs(ierr) )
130 131 132
       IF ( found ) prefix = trim( dummy )
       !
       CALL iotk_scan_attr( attr, 'title', dummy, found = found, ierr = ierr )
giannozz's avatar
giannozz committed
133
       IF ( ierr /= 0 ) CALL errore( 'read_xml_common', 'error reading title attribute &
134
            &of root node', 1 )
135 136
       IF ( found ) title = trim( dummy )
       !
137 138 139 140
    END IF
    !
    !  ... bcast the read attributes
    !
141 142 143
    CALL mp_bcast( calculation, ionode_id, intra_image_comm )
    CALL mp_bcast( prefix, ionode_id, intra_image_comm )
    CALL mp_bcast( title, ionode_id, intra_image_comm )
144 145 146 147 148 149 150 151 152 153 154 155 156 157 158
    
    !
    ! ... fixing some default values using the calculation variable
    !
    CALL fixval( prog )
    !
    ! ... why this is compulsory? ( read autopilot.f90 )
    CALL card_default( 'INIT_AUTOPILOT' )
    !
    !
    !   ... reading CELL card
    !   
    CALL card_default( 'CELL' )
    !
    IF ( ionode ) THEN
159
       !
160
       CALL card_xml_cell( )
161
       !
162 163 164 165 166 167 168 169 170 171
    END IF
    !
    CALL card_bcast( 'CELL' )
    !
    !
    ! ...  reading ATOMIC_SPECIES card
    !
    CALL card_default( 'ATOMIC_SPECIES' )
    !
    IF ( ionode ) THEN
172
       !
173 174 175 176 177 178 179 180 181 182 183 184
       CALL card_xml_atomic_species( )
       !
    END IF
    !
    CALL card_bcast( 'ATOMIC_SPECIES' )
    !
    RETURN
    !
  END SUBROUTINE read_xml_common
  !
  !
  !--------------------------------------------------------!
185
  ! The remaining part of the reading for PW: fields and   !
186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203
  ! other cards                                            !
  !--------------------------------------------------------!
  SUBROUTINE read_xml_pw( )
    !
    !
    USE iotk_module, ONLY : iotk_scan_begin, iotk_scan_end
    USE iotk_unit_interf, ONLY : iotk_rewind
    !
    !
    IMPLICIT NONE
    !
    !
    INTEGER :: ierr
    CHARACTER (len = iotk_attlenx) :: attr
    CHARACTER (len = 30) :: field, card
    LOGICAL :: found_al, found
    !
    !
204
    ! ... reading ATOMIC_LIST card
205 206 207 208
    !
    CALL card_default( 'ATOMIC_LIST' )
    !
    IF ( ionode ) THEN
209
       !
210 211 212
       CALL iotk_scan_begin( xmlinputunit, 'atomic_list', found = found_al, ierr = ierr )
       IF ( ierr /= 0 ) CALL errore( 'read_xml_pw', 'error scanning begin &
            &of atomic_list card', abs(ierr) )
213
       !
214
       IF ( found_al ) THEN
215
          !
216 217 218
          CALL iotk_scan_end( xmlinputunit, 'atomic_list', ierr = ierr )
          IF ( ierr /= 0 ) CALL errore( 'read_xml_pw', 'error scanning end &
               &of atomic_list card', abs( ierr ) )
219
          !
220 221 222 223
          CALL card_xml_atomic_list( )
          !
       ELSE
          !
224
          CALL errore('read_xml_pw',"card atomic_list is missing", 1 )
225 226 227 228
          !
       ENDIF
    ENDIF
    !
229
    CALL mp_bcast( found_al, ionode_id, intra_image_comm)
230
    !
231
    CALL card_bcast( 'ATOMIC_LIST' )
232
    !
233 234 235 236 237 238 239 240
    ! ... reading all the FIELDS
    !
    !
    ! ... we need to know if startingwfc and starting pot are set
    startingwfc = 'none'
    startingpot = 'none'
    !
    IF (ionode) THEN
241
       !
242
       CALL read_xml_fields()
243
       !
244 245 246 247 248 249 250
    END IF
    !
    !
    ! ... some fixval that the previous call of fixval wasn't
    ! ... able to do
    !
    IF ( calculation == 'nscf' .or. calculation == 'bands'  ) THEN
251
       !
252
       IF (startingpot == 'none') startingpot = 'file'
253
       IF (startingwfc == 'none') startingwfc = 'atomic+random'
254
       !
255
    ELSE IF ( restart_mode == 'from_scratch' ) THEN
256
       !
257
       IF (startingwfc == 'none') startingwfc = 'atomic+random'
258
       IF (startingpot == 'none') startingpot = 'atomic'
259
       !
260
    ELSE
261
       !
262 263
       IF (startingwfc == 'none') startingwfc = 'file'
       IF (startingpot == 'none') startingpot = 'file'
264
       !
265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304
    END IF
    !
    !
    ! 
    ! ... checkin of all the parameters inserted in the fields
    !
    IF ( ionode ) THEN
       !
       CALL control_checkin( 'PW' )
       CALL system_checkin( 'PW' )
       CALL electrons_checkin( 'PW' )
       CALL ions_checkin( 'PW' )
       CALL cell_checkin( 'PW' )
       CALL wannier_checkin( 'PW' )
       CALL wannier_ac_checkin( 'PW' )
       !
    END IF
    !
    !
    ! ... bcast all the field parameters
    !
    CALL control_bcast( )
    CALL system_bcast( )
    CALL electrons_bcast( )
    CALL ions_bcast( )
    CALL cell_bcast()
    CALL press_ai_bcast()
    CALL wannier_bcast()
    CALL wannier_ac_bcast()
    !
    !
    ! ... second step : reading of the remaining cards
    !
    !
    ! ... reading CONSTRAINTS card
    !
    card = 'constraints'
    CALL card_default( 'CONSTRAINTS' )
    !
    IF ( ionode ) THEN
305
       !
306 307
       CALL iotk_scan_begin( xmlinputunit, trim(card), found = found, ierr = ierr )
       IF ( ierr /= 0 ) GO TO 9
308
       !
309
       IF ( found ) THEN
310
          !
311 312 313 314 315 316 317 318 319
          CALL card_xml_constraints( )
          !
          CALL iotk_scan_end( xmlinputunit, trim(card), ierr = ierr)
          IF ( ierr /= 0 ) GOTO 10
          !
       ELSE
          !
          ! ... due to a iotk problem with gfortran compiler
          CALL iotk_rewind( xmlinputunit )
320 321 322
          !
       END IF
       !
323 324
    END IF
    !
325
    CALL mp_bcast ( found, ionode_id, intra_image_comm )
326 327 328 329 330 331 332 333 334 335
    !
    IF ( found ) CALL card_bcast( 'CONSTRAINTS' )
    !
    !
    ! ... reading K_POINTS card
    !
    card = 'k_points'
    CALL card_default( 'K_POINTS' )
    !
    IF ( ionode ) THEN
336
       !
337 338 339
       CALL iotk_scan_begin( xmlinputunit, trim( card ), attr = attr, found = found,&
            ierr = ierr )
       IF ( ierr /= 0 ) GO TO 9
340
       !
341 342 343 344 345 346
       IF ( found ) THEN
          !
          CALL card_xml_kpoints( attr )
          !
          CALL iotk_scan_end( xmlinputunit, trim( card ), ierr = ierr)
          IF ( ierr /= 0 ) GOTO 10
347
          !
348 349 350
       ELSE
          !
          CALL errore('read_xml_pw', 'K_POINTS card was not found', 1)
351 352 353
          !
       END IF
       !
354 355 356 357 358 359 360 361 362 363 364
    END IF
    !
    CALL card_bcast( 'K_POINTS' )
    !
    !
    ! ... reading OCCUPATIONS card
    !
    card = 'occupations'
    CALL card_default( 'OCCUPATIONS' )
    !
    IF ( ionode ) THEN
365
       !
366 367
       CALL iotk_scan_begin( xmlinputunit, trim( card ), found = found, ierr = ierr )
       IF ( ierr /= 0 ) GO TO 9
368
       !
369
       IF  ( found ) THEN
370
          !
371 372 373 374 375 376 377 378 379
          CALL card_xml_occupations()
          !
          CALL iotk_scan_end( xmlinputunit, trim( card ), ierr = ierr )
          IF ( ierr /= 0 ) GOTO 10
          !
       ELSE
          !
          ! ... due to a iotk problem with gfortran compiler
          CALL iotk_rewind( xmlinputunit )
380 381 382
          !
       END IF
       !
383 384
    END IF
    !
385
    CALL mp_bcast ( found, ionode_id, intra_image_comm )
386 387 388 389 390 391 392 393 394
    !
    IF ( found ) CALL card_bcast( 'OCCUPATIONS' )
    !
    RETURN
    !
9   CALL errore('read_xml_pw', 'error reading begin tag of '//card//' card', ABS( ierr ) )
10  CALL errore('read_xml_pw', 'error reading end tag of '//card//' card', ABS( ierr ) )
    !
    !
395
  END SUBROUTINE read_xml_pw
396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424
  !
  !
  !
  !--------------------------------------------------------!
  ! The rest of the reading for CP program : fileds and    !
  ! other cards                                            !
  !--------------------------------------------------------!
  SUBROUTINE read_xml_cp( )
    !
    !
    USE iotk_module, ONLY : iotk_scan_begin, iotk_scan_end
    USE iotk_unit_interf, ONLY : iotk_rewind
    !
    !
    IMPLICIT NONE
    !
    !
    INTEGER :: ierr
    CHARACTER (len = iotk_attlenx) :: attr
    CHARACTER (len = 30) :: field, card
    LOGICAL :: found
    !
    !
    ! ... reading ATOMIC_LIST cards
    !
    !
    CALL card_default( 'ATOMIC_LIST' )
    !
    IF ( ionode ) THEN
425
       !
426
       CALL card_xml_atomic_list ( )
427
       !
428 429 430 431 432 433 434 435
    END IF
    !
    CALL card_bcast( 'ATOMIC_LIST' )
    !
    !
    ! ... reading all the FIELDS
    !
    IF (ionode) THEN
436
       !
437
       CALL read_xml_fields()
438
       !
439 440 441 442 443 444
    END IF
    !
    ! 
    ! ... checkin of all the parameters inserted in the fields
    !
    IF ( ionode ) THEN
445
       !
446 447 448 449 450 451 452
       CALL control_checkin( 'CP' )
       CALL system_checkin( 'CP' )
       CALL electrons_checkin( 'CP' )
       CALL ions_checkin( 'CP' )
       CALL cell_checkin( 'CP' )
       CALL wannier_checkin( 'CP' )
       CALL wannier_ac_checkin( 'CP' )
453
       !
454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477
    END IF
    !
    !
    ! ... bcast all the field parameters
    !
    CALL control_bcast( )
    CALL system_bcast( )
    CALL electrons_bcast( )
    CALL ions_bcast( )
    CALL cell_bcast()
    CALL press_ai_bcast()
    CALL wannier_bcast()
    CALL wannier_ac_bcast()
    !
    !
    ! ... second step : reading of the remaining cards
    !
    !
    ! ... reading CONSTRAINTS card
    !
    card = 'constraints'
    CALL card_default( 'CONSTRAINTS' )
    !
    IF ( ionode ) THEN
478
       !
479 480
       CALL iotk_scan_begin( xmlinputunit, trim(card), found = found, ierr = ierr )
       IF ( ierr /= 0 ) GO TO 9
481
       !
482
       IF ( found ) THEN
483
          !
484
          CALL card_xml_constraints( )
485
          !
486 487 488 489 490 491 492
          CALL iotk_scan_end( xmlinputunit, trim(card), ierr = ierr)
          IF ( ierr /= 0 ) GOTO 10
          !
       ELSE
          !
          ! ... due to a iotk problem with gfortran compiler
          CALL iotk_rewind( xmlinputunit )
493 494 495
          !
       END IF
       !
496 497
    END IF
    !
498
    CALL mp_bcast ( found, ionode_id, intra_image_comm )
499 500 501 502 503 504 505 506 507
    !
    IF ( found ) CALL card_bcast( 'CONSTRAINTS' )
    !
    ! ... reading OCCUPATIONS card
    !
    card = 'occupations'
    CALL card_default( 'OCCUPATIONS' )
    !
    IF ( ionode ) THEN
508
       !
509 510
       CALL iotk_scan_begin( xmlinputunit, trim( card ), found = found, ierr = ierr )
       IF ( ierr /= 0 ) GO TO 9
511
       !
512
       IF  ( found ) THEN
513
          !
514
          CALL card_xml_occupations()
515
          !
516 517 518 519 520 521 522
          CALL iotk_scan_end( xmlinputunit, trim( card ), ierr = ierr )
          IF ( ierr /= 0 ) GOTO 10
          !
       ELSE
          !
          ! ... due to a iotk problem with gfortran compiler
          CALL iotk_rewind( xmlinputunit )
523 524 525
          !
       END IF
       !
526 527
    END IF
    !
528
    CALL mp_bcast ( found, ionode_id, intra_image_comm )
529 530 531 532 533 534 535
    !
    IF ( found ) CALL card_bcast( 'OCCUPATIONS' )
    !
    card = 'plot_wannier'
    CALL card_default( 'PLOT_WANNIER' )
    !
    IF ( ionode ) THEN
536
       !
537 538
       CALL iotk_scan_begin( xmlinputunit, trim( card ), found = found, ierr = ierr )
       IF ( ierr /= 0 ) GO TO 9
539
       !
540
       IF ( found ) THEN
541
          !
542
          CALL card_xml_plot_wannier()
543
          !
544 545 546 547 548 549 550
          CALL iotk_scan_end( xmlinputunit, trim( card ), ierr = ierr )
          IF ( ierr /= 0 ) GOTO 10
          !
       ELSE
          !
          ! ... due to a iotk problem with gfortran compiler
          CALL iotk_rewind( xmlinputunit )
551 552 553 554 555
          !
       END IF
       !
    END IF
    !
556
    CALL mp_bcast ( found, ionode_id, intra_image_comm )
557 558 559 560 561
    !
    IF ( found ) CALL card_bcast( 'PLOT_WANNIER' )
    !
    !
    !
562 563 564
    !
    RETURN
    !
giannozz's avatar
giannozz committed
565 566
9   CALL errore('read_xml_cp', 'error reading begin tag of '//card//' card', ABS( ierr ) )
10  CALL errore('read_xml_cp', 'error reading end tag of '//card//' card', ABS( ierr ) )
567 568
    !
    !
569
  END SUBROUTINE read_xml_cp
570 571 572 573
  !
  !
  !
END MODULE read_xml_module