1! Copyright (C) 2003-2015 Quantum ESPRESSO group 2! This file is distributed under the terms of the 3! GNU General Public License. See the file `License' 4! in the root directory of the present distribution, 5! or http://www.gnu.org/copyleft/gpl.txt . 6! 7!---------------------------------------------------------------------------- 8MODULE qexsd_module 9 !---------------------------------------------------------------------------- 10 ! 11 ! This module contains subroutines used to read and write in XML format, 12 ! according to the "schema", the data produced by Quantum ESPRESSO 13 ! 14 ! Based on initial work by Carlo Sbraccia (2003) 15 ! and on the qexml.f90 routines written by Andrea Ferretti (2006) 16 ! Modified by Simone Ziraldo (2013). 17 ! Rewritten by Giovanni Borghi, A. Ferretti, et al. (2015). 18 ! Heavily modified by Pietro Delugas and Paolo Giannozzi (2016 on) 19 ! 20 ! 21 USE kinds, ONLY : DP 22 USE input_parameters, ONLY : input_xml_schema_file 23 USE mp_world, ONLY : nproc 24 USE mp_images, ONLY : nimage,nproc_image 25 USE mp_pools, ONLY : npool 26 USE mp_bands, ONLY : ntask_groups, nproc_bgrp, nbgrp 27 USE global_version, ONLY : version_number 28 ! 29 USE qes_types_module 30 USE qes_write_module, ONLY : qes_write 31 USE qes_reset_module, ONLY : qes_reset 32 USE qes_init_module, ONLY : qes_init 33 ! 34 USE FoX_wxml, ONLY : xmlf_t 35 ! 36 IMPLICIT NONE 37 ! 38 PRIVATE 39 SAVE 40 ! 41 ! definitions for the fmt 42 ! 43 CHARACTER(5), PARAMETER :: fmt_name = "QEXSD" 44 CHARACTER(8), PARAMETER :: fmt_version = "20.04.20" 45 ! 46 ! internal data to be set 47 ! 48 TYPE(xmlf_t) :: qexsd_xf 49 ! 50 ! vars to manage back compatibility 51 ! 52 CHARACTER(10) :: qexsd_current_version = " " 53 CHARACTER(10) :: qexsd_default_version = trim( fmt_version ) 54 LOGICAL :: qexsd_current_version_init = .FALSE. 55 ! 56 TYPE (step_type), ALLOCATABLE :: steps(:) 57 INTEGER :: exit_status 58 TYPE ( closed_type ) :: qexsd_closed_element 59 INTEGER :: step_counter 60 ! 61 ! end of declarations 62 ! 63 PUBLIC :: qexsd_xf 64 PUBLIC :: qexsd_openschema, qexsd_closeschema 65 PUBLIC :: qexsd_readschema 66 PUBLIC :: qexsd_step_addstep, qexsd_reset_steps 67 PUBLIC :: qexsd_current_version, qexsd_default_version, qexsd_current_version_init 68 PUBLIC :: qexsd_set_status 69 ! 70CONTAINS 71! 72!------------------------------------------- 73! ... basic subroutines 74!------------------------------------------- 75! 76 ! 77 !------------------------------------------------------------------------------------------------- 78 SUBROUTINE qexsd_set_status(status_int) 79 !------------------------------------------------------------------------------------------------- 80 IMPLICIT NONE 81 ! 82 INTEGER :: status_int 83 END SUBROUTINE qexsd_set_status 84 ! 85! 86!------------------------------------------- 87! ... subroutine writing header, general, parallel info to file 88!------------------------------------------- 89! 90 ! 91 !------------------------------------------------------------------------ 92 SUBROUTINE qexsd_openschema(filename, ounit, prog, title) 93 !------------------------------------------------------------------------ 94 ! 95 USE FoX_wxml, ONLY: xml_OpenFile, xml_DeclareNamespace, & 96 xml_NewElement, xml_addAttribute, xml_addComment 97 USE qexsd_input, ONLY: qexsd_input_obj 98 IMPLICIT NONE 99 ! 100 CHARACTER(len=*), INTENT(IN) :: filename, prog, title 101 INTEGER, INTENT(IN) :: ounit 102 TYPE (general_info_type) :: general_info 103 TYPE (parallel_info_type) :: parallel_info 104 CHARACTER(len=16) :: subname = 'qexsd_openschema' 105 INTEGER :: ierr, len_steps, i_step 106 ! 107 ! we need a qes-version number here 108 CALL xml_OpenFile(FILENAME = TRIM(filename), XF = qexsd_xf, UNIT = ounit,& 109 PRETTY_PRINT = .TRUE., REPLACE = .TRUE., NAMESPACE = .TRUE., & 110 IOSTAT = ierr ) 111 ! 112 CALL xml_DeclareNamespace (XF=qexsd_xf, PREFIX = "xsi", nsURI ="http://www.w3.org/2001/XMLSchema-instance") 113 CALL xml_DeclareNamespace (XF=qexsd_xf, PREFIX = "qes", nsURI ="http://www.quantum-espresso.org/ns/qes/qes-1.0") 114 CALL xml_NewElement (XF=qexsd_xf, NAME = "qes:espresso") 115 CALL xml_addAttribute(XF=qexsd_xf, NAME = "xsi:schemaLocation", & 116 VALUE = "http://www.quantum-espresso.org/ns/qes/qes-1.0 "//& 117 "http://www.quantum-espresso.org/ns/qes/qes_030920.xsd" ) 118 CALL xml_addAttribute(XF=qexsd_xf, NAME="Units", VALUE="Hartree atomic units") 119 CALL xml_addComment(XF = qexsd_xf, & 120 COMMENT = "All quantities are in Hartree atomic units unless otherwise specified" ) 121 ! 122 IF (ierr /= 0) call errore(subname, 'opening xml output file', ierr) 123 ! the input file is mandatory to have a validating schema 124 ! here an error should be issued, instead 125 ! 126 CALL qexsd_init_general_info(general_info, prog(1:2), title ) 127 CALL qes_write (qexsd_xf,general_info) 128 CALL qes_reset (general_info) 129 ! 130 CALL qexsd_init_parallel_info(parallel_info) 131 CALL qes_write (qexsd_xf,parallel_info) 132 CALL qes_reset (parallel_info) 133 IF ( check_file_exst(input_xml_schema_file) ) THEN 134 CALL xml_addComment( XF = qexsd_xf, COMMENT= "") 135 CALL qexsd_cp_line_by_line(ounit ,input_xml_schema_file, spec_tag="input") 136 ELSE IF ( TRIM(qexsd_input_obj%tagname) == "input") THEN 137 CALL qes_write (qexsd_xf, qexsd_input_obj) 138 END IF 139 ! 140 IF (ALLOCATED(steps) ) THEN 141 len_steps= step_counter 142 IF (TRIM (steps(1)%tagname ) .EQ. 'step') THEN 143 DO i_step = 1, len_steps 144 CALL qes_write (qexsd_xf, steps(i_step) ) 145 END DO 146 END IF 147 END IF 148 ! 149 END SUBROUTINE qexsd_openschema 150 ! 151 ! 152 !--------------------------------------------------------------------------------------- 153 SUBROUTINE qexsd_init_general_info(obj, prog, title ) 154 !--------------------------------------------------------------------------------------- 155 IMPLICIT NONE 156 ! 157 TYPE( general_info_type ) :: obj 158 CHARACTER(LEN=*),INTENT(IN) :: prog 159 CHARACTER(LEN=*),INTENT(IN) :: title 160 CHARACTER(LEN=*),PARAMETER :: TAGNAME="general_info" 161 TYPE( creator_type ) :: creator_obj 162 TYPE( created_type ) :: created_obj 163 TYPE( xml_format_type) :: xml_fmt_obj 164 CHARACTER(LEN=256) :: version 165 CHARACTER(9) :: cdate, ctime 166 CHARACTER(60) :: timestamp 167 ! 168 version=TRIM(version_number) 169 SELECT CASE( prog(1:2)) 170 CASE ('pw','PW') 171 CALL qes_init (creator_obj, "creator", "PWSCF", version, "XML file generated by PWSCF") 172 CASE ('cp', 'CP') 173 CALL qes_init (creator_obj, "creator", "CP", version, "XML file generated by CP") 174 END SELECT 175 ! 176 CALL date_and_tim(cdate, ctime) 177 timestamp = 'This run was terminated on: ' // ctime // ' ' // cdate(1:2) // & 178 ' '//cdate(3:5) // ' '// cdate (6:9) 179 180 CALL qes_init (created_obj, "created", cdate, ctime, timestamp ) 181 ! 182 CALL qes_init (xml_fmt_obj, "xml_format", fmt_name, fmt_version, fmt_name//"_"//fmt_version) 183 ! 184 CALL qes_init ( obj, TAGNAME, XML_FORMAT = xml_fmt_obj, CREATOR = creator_obj, CREATED = created_obj, & 185 JOB=title) 186 ! 187 CALL qes_reset (creator_obj) 188 CALL qes_reset (created_obj) 189 CALL qes_reset (xml_fmt_obj) 190 END SUBROUTINE qexsd_init_general_info 191 ! 192 !--------------------------------------------------------------------------------------------- 193 SUBROUTINE qexsd_init_parallel_info(obj) 194 !--------------------------------------------------------------------------------------------- 195 IMPLICIT NONE 196 ! 197 TYPE ( parallel_info_type ) :: obj 198 ! 199 INTEGER :: nthreads=1 200#if defined(__OMP) 201 INTEGER,EXTERNAL :: omp_get_max 202 ! 203 nthreads = omp_get_max() 204#endif 205 CALL qes_init (obj, "parallel_info", nproc, nthreads, ntask_groups, & 206 nbgrp, npool, nproc_bgrp) 207 END SUBROUTINE qexsd_init_parallel_info 208 ! 209! 210!------------------------------------------- 211! ... subroutine writing status and timing info to file and closing it 212!------------------------------------------- 213! 214 ! 215 !------------------------------------------------------------------------ 216 SUBROUTINE qexsd_closeschema() 217 !------------------------------------------------------------------------ 218 USE mytime, ONLY: nclock, clock_label 219 USE FOX_wxml, ONLY: xml_NewElement, xml_AddCharacters, xml_EndElement, xml_Close 220 IMPLICIT NONE 221 REAL(DP),EXTERNAL :: get_clock 222 TYPE(timing_type) :: qexsd_timing_ 223 ! 224 CHARACTER(len=17) :: subname = 'qexsd_closeschema' 225 INTEGER :: ierr 226 ! 227 IF (exit_status .ge. 0 ) THEN 228 CALL xml_NewElement(qexsd_xf, "status") 229 CALL xml_AddCharacters(qexsd_xf, exit_status) 230 CALL xml_EndElement(qexsd_xf, "status") 231 CALL qexsd_set_closed() 232 IF (get_clock('PWSCF') > get_clock('CP')) THEN 233 CALL qexsd_init_clocks (qexsd_timing_, 'PWSCF ' , ['electrons ']) 234 ELSE 235 CALL qexsd_init_clocks (qexsd_timing_, 'CP ') 236 END IF 237 CALL qes_write ( qexsd_xf, qexsd_timing_) 238 CALL qes_reset(qexsd_timing_) 239 !CALL xml_NewElement (qexsd_xf, "cputime") 240 !CALL xml_addCharacters(qexsd_xf, MAX(nint(get_clock('PWSCF')),nint(get_clock('CP'))) ) 241 !CALL xml_EndElement ( qexsd_xf, "cputime") 242 CALL qes_write (qexsd_xf, qexsd_closed_element) 243 END IF 244 CALL xml_Close(qexsd_xf) 245 ! 246 END SUBROUTINE qexsd_closeschema 247 ! 248 ! 249!------------------------------------------- 250! ... function reading xml and storing inofo into objects 251!------------------------------------------- 252! 253!------------------------------------------------------------------------ 254 SUBROUTINE qexsd_readschema (filename, ierr, output_obj, parinfo_obj, & 255 geninfo_obj, input_obj) 256!------------------------------------------------------------------------ 257 ! 258 USE qes_read_module, ONLY : qes_read 259 USE FoX_dom, ONLY : parseFile, item, getElementsByTagname, & 260 destroy, nodeList, Node 261 ! 262 IMPLICIT NONE 263 ! 264 CHARACTER(LEN=*), INTENT(IN) :: filename 265 INTEGER, INTENT(OUT) :: ierr 266 TYPE( output_type ), OPTIONAL, INTENT(OUT) :: output_obj 267 TYPE(parallel_info_type), OPTIONAL, INTENT(OUT) :: parinfo_obj 268 TYPE(general_info_type ), OPTIONAL, INTENT(OUT) :: geninfo_obj 269 TYPE(input_type), OPTIONAL, INTENT(OUT) :: input_obj 270 ! 271 TYPE(Node), POINTER :: root, nodePointer 272 TYPE(nodeList),POINTER :: listPointer 273 LOGICAL :: found 274 CHARACTER(LEN=80) :: errmsg = ' ' 275 CHARACTER(len=17) :: subname = 'qexsd_readschema' 276 ! 277 ierr = 0 278 ! 279 INQUIRE ( file=filename, exist=found ) 280 IF (.NOT. found ) THEN 281 ierr = 1 282 errmsg='xml data file ' // TRIM(filename) // ' not found' 283 GOTO 100 284 END IF 285 ! 286 ! read XML file into "root" object 287 ! 288 root => parseFile(filename) 289 ! 290 ! copy from "root" object into geninfo, parinfo, output objs 291 ! 292 IF ( PRESENT ( geninfo_obj ) ) THEN 293 nodePointer => item ( getElementsByTagname(root, "general_info"),0) 294 IF (ASSOCIATED(nodePointer)) THEN 295 CALL qes_read( nodePointer, geninfo_obj, ierr) 296 ELSE 297 ierr = 2 298 END IF 299 IF ( ierr /= 0 ) THEN 300 errmsg='error reading header of xml data file' 301 ierr = 2 302 GOTO 100 303 END IF 304 END IF 305 ! 306 IF ( PRESENT ( parinfo_obj ) ) THEN 307 nodePointer => item ( getElementsByTagname(root,"parallel_info"),0) 308 IF (ASSOCIATED(nodePointer)) THEN 309 CALL qes_read(nodePointer, parinfo_obj, ierr) 310 ELSE 311 ierr = 3 312 END IF 313 IF ( ierr /= 0 ) THEN 314 errmsg='error in parallel_info of xsd data file' 315 ierr = 3 316 GOTO 100 317 END IF 318 END IF 319 ! 320 IF ( PRESENT ( output_obj ) ) THEN 321 nodePointer => item ( getElementsByTagname(root, "output"),0) 322 IF (ASSOCIATED(nodePointer)) THEN 323 CALL qes_read ( nodePointer, output_obj, ierr ) 324 ELSE 325 ierr = 4 326 END IF 327 IF ( ierr /= 0 ) THEN 328 errmsg = 'error reading output_obj of xsd data file' 329 ierr = 4 330 GOTO 100 331 END IF 332 END IF 333 ! 334 IF (PRESENT (input_obj)) THEN 335 nodePointer => item( getElementsByTagname(root, "input"),0) 336 IF ( ASSOCIATED(nodePointer) ) THEN 337 CALL qes_read (nodePointer, input_obj, ierr ) 338 ELSE 339 ierr =-1 340 END IF 341 IF ( ierr /= 0 ) THEN 342 errmsg = 'input info not found or not readable in xml file' 343 IF ( TRIM(input_obj%tagname) == 'input' ) CALL qes_reset (input_obj) 344 ierr =-1 345 END IF 346 END IF 347 ! 348 CALL destroy(root) 349 ! 350 100 IF ( ierr /= 0 ) CALL infomsg(subname,TRIM(errmsg)) 351 ! 352 END SUBROUTINE qexsd_readschema 353! 354!------------------------------------------- 355! ... utilities 356!------------------------------------------- 357! 358 ! 359 !------------------------------------------------------------------------ 360 FUNCTION check_file_exst( filename ) 361 !------------------------------------------------------------------------ 362 ! 363 IMPLICIT NONE 364 ! 365 LOGICAL :: check_file_exst 366 CHARACTER(len=*) :: filename 367 ! 368 LOGICAL :: lexists 369 ! 370 INQUIRE( FILE = trim( filename ), EXIST = lexists ) 371 ! 372 check_file_exst = lexists 373 RETURN 374 ! 375 END FUNCTION check_file_exst 376 ! 377 ! 378 !------------------------------------------------------------------------ 379 SUBROUTINE qexsd_cp_line_by_line(iun_out,filename,spec_tag) 380 !------------------------------------------------------------------------ 381 implicit none 382 ! 383 integer, intent(in) :: iun_out 384 character(*), intent(in) :: filename 385 character(*), optional, intent(in) :: spec_tag 386 ! 387 integer :: iun, ierr 388 character(256) :: str 389 logical :: icopy, exists 390 integer, external :: find_free_unit 391 392 iun = find_free_unit() 393 ! 394 INQUIRE(FILE=trim(filename), EXIST=exists) 395 ! 396 IF(.not.exists) THEN 397 CALL errore('qexsd_cp_line_by_line', 'input xml file "' // & 398 & TRIM(filename) // '" not found', 1) 399 ENDIF 400 ! 401 open(iun,FILE=trim(filename),status="old", IOSTAT=ierr) 402 ! 403 icopy=.false. 404 copy_loop: do 405 ! 406 read(iun,"(a256)",iostat=ierr) str 407 if (ierr<0) exit copy_loop 408 if (present(spec_tag)) then 409 ! 410 if (index(str,"<"//trim(adjustl(spec_tag))//">")/=0) then 411 ! 412 icopy=.true. 413 ! 414 endif 415 ! 416 else 417 ! 418 icopy=.true. 419 ! 420 endif 421 ! 422 ! filtering 423 ! 424 if ( index(str,"<Root>")/=0 .or. index(str,"<Root>")/=0 .or. & 425 index(str,"<?")/=0 .or. .not.icopy) cycle copy_loop 426 ! 427 write(iun_out,"(a)") trim(str) 428 ! 429 if (present(spec_tag)) then 430 if (index(str,"</input>")/=0) icopy=.false. 431 endif 432 ! 433 enddo copy_loop 434 ! 435 close(iun) 436 ! 437 END SUBROUTINE qexsd_cp_line_by_line 438 ! 439! 440!------------------------------------------- 441! ... subroutine related to MD steps 442!------------------------------------------- 443! 444 ! 445 !---------------------------------------------------------------------------------------- 446 SUBROUTINE qexsd_step_addstep(i_step, max_steps, ntyp, atm, ityp, nat, tau, alat, a1, a2, a3, & 447 etot, eband, ehart, vtxc, etxc, ewald, degauss, demet, forces, & 448 stress, scf_has_converged, n_scf_steps, scf_error, efieldcorr, potstat_contr, & 449 fcp_force, fcp_tot_charge, gatefield_en) 450 !----------------------------------------------------------------------------------------- 451 !! This routing initializes le steps array containing up to max_steps elements of the step_type 452 !! data structure. Each element contains structural and energetic info for m.d. trajectories and 453 !! structural minimization paths. All quantities must be provided directly in Hartree atomic units. 454 !! @Note updated on April 10th 2018 by Pietro Delugas 455 USE qexsd_init, ONLY : qexsd_init_atomic_structure, qexsd_init_total_energy 456 IMPLICIT NONE 457 ! 458 INTEGER ,INTENT(IN) :: i_step, max_steps, ntyp, nat, n_scf_steps, ityp(:) 459 REAL(DP),INTENT(IN) :: tau(3,nat), alat, a1(3), a2(3), a3(3), etot, eband, ehart, vtxc, & 460 etxc, ewald, scf_error, forces(3,nat), stress(3,3) 461 LOGICAL,INTENT(IN) :: scf_has_converged 462 REAL(DP),OPTIONAL,INTENT(IN) :: degauss, demet, gatefield_en, efieldcorr 463 REAL(DP),OPTIONAL,INTENT (IN) :: potstat_contr, fcp_force, fcp_tot_charge 464 CHARACTER(LEN=*),INTENT(IN) :: atm(:) 465 TYPE (step_type) :: step_obj 466 TYPE ( scf_conv_type ) :: scf_conv_obj 467 TYPE ( atomic_structure_type ) :: atomic_struct_obj 468 TYPE ( total_energy_type ) :: tot_en_obj 469 TYPE ( matrix_type ) :: mat_forces, mat_stress 470 ! 471 IF ( i_step .EQ. 1 ) THEN 472 ALLOCATE (steps(max_steps)) 473 step_counter = 0 474 END IF 475 step_counter = step_counter+1 476 ! 477 step_obj%tagname="step" 478 step_obj%n_step = i_step 479 ! 480 CALL qes_init( scf_conv_obj,"scf_conv", scf_has_converged, n_scf_steps, scf_error ) 481 ! 482 step_obj%scf_conv = scf_conv_obj 483 CALL qes_reset(scf_conv_obj) 484 ! 485 CALL qexsd_init_atomic_structure(atomic_struct_obj, ntyp, atm, ityp, nat, tau, & 486 alat, a1, a2, a3, 0) 487 step_obj%atomic_structure=atomic_struct_obj 488 CALL qes_reset( atomic_struct_obj ) 489 ! 490 CALL qexsd_init_total_energy (tot_en_obj, etot, eband, ehart, & 491 vtxc, etxc, ewald, degauss, demet, efieldcorr, potstat_contr, gatefield_en) 492 step_obj%total_energy=tot_en_obj 493 CALL qes_reset( tot_en_obj ) 494 ! 495 CALL qes_init( mat_forces, "forces", [3, nat], forces ) 496 step_obj%forces=mat_forces 497 CALL qes_reset ( mat_forces ) 498 ! 499 CALL qes_init( mat_stress, "stress", [3, 3], stress ) 500 step_obj%stress = mat_stress 501 CALL qes_reset ( mat_stress ) 502 IF ( PRESENT ( fcp_force ) ) THEN 503 step_obj%FCP_force = fcp_force 504 step_obj%FCP_force_ispresent = .TRUE. 505 END IF 506 IF (PRESENT( fcp_tot_charge)) THEN 507 step_obj%FCP_tot_charge = fcp_tot_charge 508 step_obj%FCP_tot_charge_ispresent = .TRUE. 509 END IF 510 ! 511 ! 512 steps(step_counter) = step_obj 513 steps(step_counter)%lwrite = .TRUE. 514 steps(step_counter)%lread = .TRUE. 515 call qes_reset (step_obj) 516 END SUBROUTINE qexsd_step_addstep 517 ! 518 !------------------------------------------------------------------------------------ 519 SUBROUTINE qexsd_reset_steps() 520 IMPLICIT NONE 521 INTEGER :: i_step 522 IF (ALLOCATED(steps)) THEN 523 DO i_step =1, SIZE(steps) 524 CALL qes_reset(steps(i_step)) 525 END DO 526 DEALLOCATE (steps) 527 END IF 528 END SUBROUTINE 529 ! 530 !-------------------------------------------------------------------------------------------------- 531 SUBROUTINE qexsd_set_closed() 532 ! 533 IMPLICIT NONE 534 CHARACTER(LEN=9) :: cdate, time_string 535 CHARACTER(LEN=12) :: date_string 536 ! 537 CALL date_and_tim( cdate, time_string ) 538 date_string = cdate(1:2) // ' ' // cdate(3:5) // ' ' // cdate (6:9) 539 CALL qes_init (qexsd_closed_element, "closed", date_string, time_string,& 540 "") 541 END SUBROUTINE qexsd_set_closed 542 543! 544!------------------------------------------- 545! ... subroutine related to timing information 546!------------------------------------------- 547! 548 ! 549 550SUBROUTINE qexsd_init_clocks (timing_, total_clock, partial_clocks) 551 USE mytime, ONLY: nclock, clock_label, cputime, walltime, called 552 USE qes_libs_module, ONLY: qes_init, qes_reset 553 IMPLICIT NONE 554 TYPE(timing_type),INTENT(INOUT) :: timing_ 555 CHARACTER(LEN=12),INTENT(IN) :: total_clock 556 CHARACTER(LEN=12),OPTIONAL,INTENT(IN) :: partial_clocks(:) 557 ! 558 TYPE (clock_type) :: total_ 559 TYPE(clock_type),ALLOCATABLE :: partial_(:) 560 LOGICAL,ALLOCATABLE :: match(:) 561 INTEGER :: partial_ndim = 0, ic, ipar, nc 562 REAL (DP) :: t(2) 563 INTERFACE 564 FUNCTION get_cpu_and_wall(n_) result(t_) 565 IMPORT :: DP 566 IMPLICIT NONE 567 INTEGER :: n_ 568 REAL(DP) t_(2) 569 END FUNCTION get_cpu_and_wall 570 END INTERFACE 571 ! 572 IF (PRESENT(partial_clocks)) partial_ndim = SIZE (partial_clocks) 573 DO ic = 1, nclock 574 IF ( TRIM(total_clock) == clock_label(ic) ) EXIT 575 END DO 576 t = get_cpu_and_wall(ic) 577 CALL qes_init ( total_, "total", TRIM(clock_label(ic)), t(1), t(2) ) 578 IF ( partial_ndim .GT. 0 ) THEN 579 ALLOCATE(partial_(partial_ndim), match(nclock) ) 580 DO ipar = 1, partial_ndim 581 match = clock_label(1:nclock) == TRIM(partial_clocks(ipar)) 582 IF ( ANY (match)) THEN 583 nc = get_index(.TRUE., match) 584 t = get_cpu_and_wall(nc) 585 CALL qes_init(partial_(ipar), "partial", TRIM(clock_label(nc)), t(1), t(2),& 586 called(nc)) 587 ELSE 588 CALL qes_init (partial_(ipar), "partial", "not_found", -1.d0, -1.d0, 0) 589 CALL infomsg("add_xml_clocks_pw: label not found ", TRIM(partial_clocks(ipar))) 590 partial_(ipar)%lwrite=.FALSE. 591 END IF 592 END DO 593 END IF 594 CALL qes_init( timing_, "timing_info", total_, partial_) 595 CALL qes_reset ( total_) 596 DO ipar =1, partial_ndim 597 CALL qes_reset(partial_(ipar)) 598 END DO 599 CONTAINS 600 FUNCTION get_index(val, array) result(n) 601 IMPLICIT NONE 602 LOGICAL :: val 603 LOGICAL :: array(:) 604 INTEGER :: n 605 ! 606 INTEGER :: i 607 ! 608 n = - 1 609 DO i =1, SIZE(array) 610 IF (array(i) .EQV. val) EXIT 611 END DO 612 IF ( array(i) .EQV. val ) n = i 613 END FUNCTION get_index 614 END SUBROUTINE qexsd_init_clocks 615 616 617END MODULE qexsd_module 618