! Copyright (C) 2003-2015 Quantum ESPRESSO group ! This file is distributed under the terms of the ! GNU General Public License. See the file `License' ! in the root directory of the present distribution, ! or http://www.gnu.org/copyleft/gpl.txt . ! !---------------------------------------------------------------------------- MODULE qexsd_module !---------------------------------------------------------------------------- ! ! This module contains subroutines used to read and write in XML format, ! according to the "schema", the data produced by Quantum ESPRESSO ! ! Based on initial work by Carlo Sbraccia (2003) ! and on the qexml.f90 routines written by Andrea Ferretti (2006) ! Modified by Simone Ziraldo (2013). ! Rewritten by Giovanni Borghi, A. Ferretti, et al. (2015). ! Heavily modified by Pietro Delugas and Paolo Giannozzi (2016 on) ! ! USE kinds, ONLY : DP USE input_parameters, ONLY : input_xml_schema_file USE mp_world, ONLY : nproc USE mp_images, ONLY : nimage,nproc_image USE mp_pools, ONLY : npool USE mp_bands, ONLY : ntask_groups, nproc_bgrp, nbgrp USE global_version, ONLY : version_number ! USE qes_types_module USE qes_write_module, ONLY : qes_write USE qes_reset_module, ONLY : qes_reset USE qes_init_module, ONLY : qes_init ! USE FoX_wxml, ONLY : xmlf_t ! IMPLICIT NONE ! PRIVATE SAVE ! ! definitions for the fmt ! CHARACTER(5), PARAMETER :: fmt_name = "QEXSD" CHARACTER(8), PARAMETER :: fmt_version = "20.04.20" ! ! internal data to be set ! TYPE(xmlf_t) :: qexsd_xf ! ! vars to manage back compatibility ! CHARACTER(10) :: qexsd_current_version = " " CHARACTER(10) :: qexsd_default_version = trim( fmt_version ) LOGICAL :: qexsd_current_version_init = .FALSE. ! TYPE (step_type), ALLOCATABLE :: steps(:) INTEGER :: exit_status TYPE ( closed_type ) :: qexsd_closed_element INTEGER :: step_counter ! ! end of declarations ! PUBLIC :: qexsd_xf PUBLIC :: qexsd_openschema, qexsd_closeschema PUBLIC :: qexsd_readschema PUBLIC :: qexsd_step_addstep, qexsd_reset_steps PUBLIC :: qexsd_current_version, qexsd_default_version, qexsd_current_version_init PUBLIC :: qexsd_set_status ! CONTAINS ! !------------------------------------------- ! ... basic subroutines !------------------------------------------- ! ! !------------------------------------------------------------------------------------------------- SUBROUTINE qexsd_set_status(status_int) !------------------------------------------------------------------------------------------------- IMPLICIT NONE ! INTEGER :: status_int END SUBROUTINE qexsd_set_status ! ! !------------------------------------------- ! ... subroutine writing header, general, parallel info to file !------------------------------------------- ! ! !------------------------------------------------------------------------ SUBROUTINE qexsd_openschema(filename, ounit, prog, title) !------------------------------------------------------------------------ ! USE FoX_wxml, ONLY: xml_OpenFile, xml_DeclareNamespace, & xml_NewElement, xml_addAttribute, xml_addComment USE qexsd_input, ONLY: qexsd_input_obj IMPLICIT NONE ! CHARACTER(len=*), INTENT(IN) :: filename, prog, title INTEGER, INTENT(IN) :: ounit TYPE (general_info_type) :: general_info TYPE (parallel_info_type) :: parallel_info CHARACTER(len=16) :: subname = 'qexsd_openschema' INTEGER :: ierr, len_steps, i_step ! ! we need a qes-version number here CALL xml_OpenFile(FILENAME = TRIM(filename), XF = qexsd_xf, UNIT = ounit,& PRETTY_PRINT = .TRUE., REPLACE = .TRUE., NAMESPACE = .TRUE., & IOSTAT = ierr ) ! CALL xml_DeclareNamespace (XF=qexsd_xf, PREFIX = "xsi", nsURI ="http://www.w3.org/2001/XMLSchema-instance") CALL xml_DeclareNamespace (XF=qexsd_xf, PREFIX = "qes", nsURI ="http://www.quantum-espresso.org/ns/qes/qes-1.0") CALL xml_NewElement (XF=qexsd_xf, NAME = "qes:espresso") CALL xml_addAttribute(XF=qexsd_xf, NAME = "xsi:schemaLocation", & VALUE = "http://www.quantum-espresso.org/ns/qes/qes-1.0 "//& "http://www.quantum-espresso.org/ns/qes/qes_030920.xsd" ) CALL xml_addAttribute(XF=qexsd_xf, NAME="Units", VALUE="Hartree atomic units") CALL xml_addComment(XF = qexsd_xf, & COMMENT = "All quantities are in Hartree atomic units unless otherwise specified" ) ! IF (ierr /= 0) call errore(subname, 'opening xml output file', ierr) ! the input file is mandatory to have a validating schema ! here an error should be issued, instead ! CALL qexsd_init_general_info(general_info, prog(1:2), title ) CALL qes_write (qexsd_xf,general_info) CALL qes_reset (general_info) ! CALL qexsd_init_parallel_info(parallel_info) CALL qes_write (qexsd_xf,parallel_info) CALL qes_reset (parallel_info) IF ( check_file_exst(input_xml_schema_file) ) THEN CALL xml_addComment( XF = qexsd_xf, COMMENT= "") CALL qexsd_cp_line_by_line(ounit ,input_xml_schema_file, spec_tag="input") ELSE IF ( TRIM(qexsd_input_obj%tagname) == "input") THEN CALL qes_write (qexsd_xf, qexsd_input_obj) END IF ! IF (ALLOCATED(steps) ) THEN len_steps= step_counter IF (TRIM (steps(1)%tagname ) .EQ. 'step') THEN DO i_step = 1, len_steps CALL qes_write (qexsd_xf, steps(i_step) ) END DO END IF END IF ! END SUBROUTINE qexsd_openschema ! ! !--------------------------------------------------------------------------------------- SUBROUTINE qexsd_init_general_info(obj, prog, title ) !--------------------------------------------------------------------------------------- IMPLICIT NONE ! TYPE( general_info_type ) :: obj CHARACTER(LEN=*),INTENT(IN) :: prog CHARACTER(LEN=*),INTENT(IN) :: title CHARACTER(LEN=*),PARAMETER :: TAGNAME="general_info" TYPE( creator_type ) :: creator_obj TYPE( created_type ) :: created_obj TYPE( xml_format_type) :: xml_fmt_obj CHARACTER(LEN=256) :: version CHARACTER(9) :: cdate, ctime CHARACTER(60) :: timestamp ! version=TRIM(version_number) SELECT CASE( prog(1:2)) CASE ('pw','PW') CALL qes_init (creator_obj, "creator", "PWSCF", version, "XML file generated by PWSCF") CASE ('cp', 'CP') CALL qes_init (creator_obj, "creator", "CP", version, "XML file generated by CP") END SELECT ! CALL date_and_tim(cdate, ctime) timestamp = 'This run was terminated on: ' // ctime // ' ' // cdate(1:2) // & ' '//cdate(3:5) // ' '// cdate (6:9) CALL qes_init (created_obj, "created", cdate, ctime, timestamp ) ! CALL qes_init (xml_fmt_obj, "xml_format", fmt_name, fmt_version, fmt_name//"_"//fmt_version) ! CALL qes_init ( obj, TAGNAME, XML_FORMAT = xml_fmt_obj, CREATOR = creator_obj, CREATED = created_obj, & JOB=title) ! CALL qes_reset (creator_obj) CALL qes_reset (created_obj) CALL qes_reset (xml_fmt_obj) END SUBROUTINE qexsd_init_general_info ! !--------------------------------------------------------------------------------------------- SUBROUTINE qexsd_init_parallel_info(obj) !--------------------------------------------------------------------------------------------- IMPLICIT NONE ! TYPE ( parallel_info_type ) :: obj ! INTEGER :: nthreads=1 #if defined(__OMP) INTEGER,EXTERNAL :: omp_get_max ! nthreads = omp_get_max() #endif CALL qes_init (obj, "parallel_info", nproc, nthreads, ntask_groups, & nbgrp, npool, nproc_bgrp) END SUBROUTINE qexsd_init_parallel_info ! ! !------------------------------------------- ! ... subroutine writing status and timing info to file and closing it !------------------------------------------- ! ! !------------------------------------------------------------------------ SUBROUTINE qexsd_closeschema() !------------------------------------------------------------------------ USE mytime, ONLY: nclock, clock_label USE FOX_wxml, ONLY: xml_NewElement, xml_AddCharacters, xml_EndElement, xml_Close IMPLICIT NONE REAL(DP),EXTERNAL :: get_clock TYPE(timing_type) :: qexsd_timing_ ! CHARACTER(len=17) :: subname = 'qexsd_closeschema' INTEGER :: ierr ! IF (exit_status .ge. 0 ) THEN CALL xml_NewElement(qexsd_xf, "status") CALL xml_AddCharacters(qexsd_xf, exit_status) CALL xml_EndElement(qexsd_xf, "status") CALL qexsd_set_closed() IF (get_clock('PWSCF') > get_clock('CP')) THEN CALL qexsd_init_clocks (qexsd_timing_, 'PWSCF ' , ['electrons ']) ELSE CALL qexsd_init_clocks (qexsd_timing_, 'CP ') END IF CALL qes_write ( qexsd_xf, qexsd_timing_) CALL qes_reset(qexsd_timing_) !CALL xml_NewElement (qexsd_xf, "cputime") !CALL xml_addCharacters(qexsd_xf, MAX(nint(get_clock('PWSCF')),nint(get_clock('CP'))) ) !CALL xml_EndElement ( qexsd_xf, "cputime") CALL qes_write (qexsd_xf, qexsd_closed_element) END IF CALL xml_Close(qexsd_xf) ! END SUBROUTINE qexsd_closeschema ! ! !------------------------------------------- ! ... function reading xml and storing inofo into objects !------------------------------------------- ! !------------------------------------------------------------------------ SUBROUTINE qexsd_readschema (filename, ierr, output_obj, parinfo_obj, & geninfo_obj, input_obj) !------------------------------------------------------------------------ ! USE qes_read_module, ONLY : qes_read USE FoX_dom, ONLY : parseFile, item, getElementsByTagname, & destroy, nodeList, Node ! IMPLICIT NONE ! CHARACTER(LEN=*), INTENT(IN) :: filename INTEGER, INTENT(OUT) :: ierr TYPE( output_type ), OPTIONAL, INTENT(OUT) :: output_obj TYPE(parallel_info_type), OPTIONAL, INTENT(OUT) :: parinfo_obj TYPE(general_info_type ), OPTIONAL, INTENT(OUT) :: geninfo_obj TYPE(input_type), OPTIONAL, INTENT(OUT) :: input_obj ! TYPE(Node), POINTER :: root, nodePointer TYPE(nodeList),POINTER :: listPointer LOGICAL :: found CHARACTER(LEN=80) :: errmsg = ' ' CHARACTER(len=17) :: subname = 'qexsd_readschema' ! ierr = 0 ! INQUIRE ( file=filename, exist=found ) IF (.NOT. found ) THEN ierr = 1 errmsg='xml data file ' // TRIM(filename) // ' not found' GOTO 100 END IF ! ! read XML file into "root" object ! root => parseFile(filename) ! ! copy from "root" object into geninfo, parinfo, output objs ! IF ( PRESENT ( geninfo_obj ) ) THEN nodePointer => item ( getElementsByTagname(root, "general_info"),0) IF (ASSOCIATED(nodePointer)) THEN CALL qes_read( nodePointer, geninfo_obj, ierr) ELSE ierr = 2 END IF IF ( ierr /= 0 ) THEN errmsg='error reading header of xml data file' ierr = 2 GOTO 100 END IF END IF ! IF ( PRESENT ( parinfo_obj ) ) THEN nodePointer => item ( getElementsByTagname(root,"parallel_info"),0) IF (ASSOCIATED(nodePointer)) THEN CALL qes_read(nodePointer, parinfo_obj, ierr) ELSE ierr = 3 END IF IF ( ierr /= 0 ) THEN errmsg='error in parallel_info of xsd data file' ierr = 3 GOTO 100 END IF END IF ! IF ( PRESENT ( output_obj ) ) THEN nodePointer => item ( getElementsByTagname(root, "output"),0) IF (ASSOCIATED(nodePointer)) THEN CALL qes_read ( nodePointer, output_obj, ierr ) ELSE ierr = 4 END IF IF ( ierr /= 0 ) THEN errmsg = 'error reading output_obj of xsd data file' ierr = 4 GOTO 100 END IF END IF ! IF (PRESENT (input_obj)) THEN nodePointer => item( getElementsByTagname(root, "input"),0) IF ( ASSOCIATED(nodePointer) ) THEN CALL qes_read (nodePointer, input_obj, ierr ) ELSE ierr =-1 END IF IF ( ierr /= 0 ) THEN errmsg = 'input info not found or not readable in xml file' IF ( TRIM(input_obj%tagname) == 'input' ) CALL qes_reset (input_obj) ierr =-1 END IF END IF ! CALL destroy(root) ! 100 IF ( ierr /= 0 ) CALL infomsg(subname,TRIM(errmsg)) ! END SUBROUTINE qexsd_readschema ! !------------------------------------------- ! ... utilities !------------------------------------------- ! ! !------------------------------------------------------------------------ FUNCTION check_file_exst( filename ) !------------------------------------------------------------------------ ! IMPLICIT NONE ! LOGICAL :: check_file_exst CHARACTER(len=*) :: filename ! LOGICAL :: lexists ! INQUIRE( FILE = trim( filename ), EXIST = lexists ) ! check_file_exst = lexists RETURN ! END FUNCTION check_file_exst ! ! !------------------------------------------------------------------------ SUBROUTINE qexsd_cp_line_by_line(iun_out,filename,spec_tag) !------------------------------------------------------------------------ implicit none ! integer, intent(in) :: iun_out character(*), intent(in) :: filename character(*), optional, intent(in) :: spec_tag ! integer :: iun, ierr character(256) :: str logical :: icopy, exists integer, external :: find_free_unit iun = find_free_unit() ! INQUIRE(FILE=trim(filename), EXIST=exists) ! IF(.not.exists) THEN CALL errore('qexsd_cp_line_by_line', 'input xml file "' // & & TRIM(filename) // '" not found', 1) ENDIF ! open(iun,FILE=trim(filename),status="old", IOSTAT=ierr) ! icopy=.false. copy_loop: do ! read(iun,"(a256)",iostat=ierr) str if (ierr<0) exit copy_loop if (present(spec_tag)) then ! if (index(str,"<"//trim(adjustl(spec_tag))//">")/=0) then ! icopy=.true. ! endif ! else ! icopy=.true. ! endif ! ! filtering ! if ( index(str,"")/=0 .or. index(str,"")/=0 .or. & index(str,"")/=0) icopy=.false. endif ! enddo copy_loop ! close(iun) ! END SUBROUTINE qexsd_cp_line_by_line ! ! !------------------------------------------- ! ... subroutine related to MD steps !------------------------------------------- ! ! !---------------------------------------------------------------------------------------- SUBROUTINE qexsd_step_addstep(i_step, max_steps, ntyp, atm, ityp, nat, tau, alat, a1, a2, a3, & etot, eband, ehart, vtxc, etxc, ewald, degauss, demet, forces, & stress, scf_has_converged, n_scf_steps, scf_error, efieldcorr, potstat_contr, & fcp_force, fcp_tot_charge, gatefield_en) !----------------------------------------------------------------------------------------- !! This routing initializes le steps array containing up to max_steps elements of the step_type !! data structure. Each element contains structural and energetic info for m.d. trajectories and !! structural minimization paths. All quantities must be provided directly in Hartree atomic units. !! @Note updated on April 10th 2018 by Pietro Delugas USE qexsd_init, ONLY : qexsd_init_atomic_structure, qexsd_init_total_energy IMPLICIT NONE ! INTEGER ,INTENT(IN) :: i_step, max_steps, ntyp, nat, n_scf_steps, ityp(:) REAL(DP),INTENT(IN) :: tau(3,nat), alat, a1(3), a2(3), a3(3), etot, eband, ehart, vtxc, & etxc, ewald, scf_error, forces(3,nat), stress(3,3) LOGICAL,INTENT(IN) :: scf_has_converged REAL(DP),OPTIONAL,INTENT(IN) :: degauss, demet, gatefield_en, efieldcorr REAL(DP),OPTIONAL,INTENT (IN) :: potstat_contr, fcp_force, fcp_tot_charge CHARACTER(LEN=*),INTENT(IN) :: atm(:) TYPE (step_type) :: step_obj TYPE ( scf_conv_type ) :: scf_conv_obj TYPE ( atomic_structure_type ) :: atomic_struct_obj TYPE ( total_energy_type ) :: tot_en_obj TYPE ( matrix_type ) :: mat_forces, mat_stress ! IF ( i_step .EQ. 1 ) THEN ALLOCATE (steps(max_steps)) step_counter = 0 END IF step_counter = step_counter+1 ! step_obj%tagname="step" step_obj%n_step = i_step ! CALL qes_init( scf_conv_obj,"scf_conv", scf_has_converged, n_scf_steps, scf_error ) ! step_obj%scf_conv = scf_conv_obj CALL qes_reset(scf_conv_obj) ! CALL qexsd_init_atomic_structure(atomic_struct_obj, ntyp, atm, ityp, nat, tau, & alat, a1, a2, a3, 0) step_obj%atomic_structure=atomic_struct_obj CALL qes_reset( atomic_struct_obj ) ! CALL qexsd_init_total_energy (tot_en_obj, etot, eband, ehart, & vtxc, etxc, ewald, degauss, demet, efieldcorr, potstat_contr, gatefield_en) step_obj%total_energy=tot_en_obj CALL qes_reset( tot_en_obj ) ! CALL qes_init( mat_forces, "forces", [3, nat], forces ) step_obj%forces=mat_forces CALL qes_reset ( mat_forces ) ! CALL qes_init( mat_stress, "stress", [3, 3], stress ) step_obj%stress = mat_stress CALL qes_reset ( mat_stress ) IF ( PRESENT ( fcp_force ) ) THEN step_obj%FCP_force = fcp_force step_obj%FCP_force_ispresent = .TRUE. END IF IF (PRESENT( fcp_tot_charge)) THEN step_obj%FCP_tot_charge = fcp_tot_charge step_obj%FCP_tot_charge_ispresent = .TRUE. END IF ! ! steps(step_counter) = step_obj steps(step_counter)%lwrite = .TRUE. steps(step_counter)%lread = .TRUE. call qes_reset (step_obj) END SUBROUTINE qexsd_step_addstep ! !------------------------------------------------------------------------------------ SUBROUTINE qexsd_reset_steps() IMPLICIT NONE INTEGER :: i_step IF (ALLOCATED(steps)) THEN DO i_step =1, SIZE(steps) CALL qes_reset(steps(i_step)) END DO DEALLOCATE (steps) END IF END SUBROUTINE ! !-------------------------------------------------------------------------------------------------- SUBROUTINE qexsd_set_closed() ! IMPLICIT NONE CHARACTER(LEN=9) :: cdate, time_string CHARACTER(LEN=12) :: date_string ! CALL date_and_tim( cdate, time_string ) date_string = cdate(1:2) // ' ' // cdate(3:5) // ' ' // cdate (6:9) CALL qes_init (qexsd_closed_element, "closed", date_string, time_string,& "") END SUBROUTINE qexsd_set_closed ! !------------------------------------------- ! ... subroutine related to timing information !------------------------------------------- ! ! SUBROUTINE qexsd_init_clocks (timing_, total_clock, partial_clocks) USE mytime, ONLY: nclock, clock_label, cputime, walltime, called USE qes_libs_module, ONLY: qes_init, qes_reset IMPLICIT NONE TYPE(timing_type),INTENT(INOUT) :: timing_ CHARACTER(LEN=12),INTENT(IN) :: total_clock CHARACTER(LEN=12),OPTIONAL,INTENT(IN) :: partial_clocks(:) ! TYPE (clock_type) :: total_ TYPE(clock_type),ALLOCATABLE :: partial_(:) LOGICAL,ALLOCATABLE :: match(:) INTEGER :: partial_ndim = 0, ic, ipar, nc REAL (DP) :: t(2) INTERFACE FUNCTION get_cpu_and_wall(n_) result(t_) IMPORT :: DP IMPLICIT NONE INTEGER :: n_ REAL(DP) t_(2) END FUNCTION get_cpu_and_wall END INTERFACE ! IF (PRESENT(partial_clocks)) partial_ndim = SIZE (partial_clocks) DO ic = 1, nclock IF ( TRIM(total_clock) == clock_label(ic) ) EXIT END DO t = get_cpu_and_wall(ic) CALL qes_init ( total_, "total", TRIM(clock_label(ic)), t(1), t(2) ) IF ( partial_ndim .GT. 0 ) THEN ALLOCATE(partial_(partial_ndim), match(nclock) ) DO ipar = 1, partial_ndim match = clock_label(1:nclock) == TRIM(partial_clocks(ipar)) IF ( ANY (match)) THEN nc = get_index(.TRUE., match) t = get_cpu_and_wall(nc) CALL qes_init(partial_(ipar), "partial", TRIM(clock_label(nc)), t(1), t(2),& called(nc)) ELSE CALL qes_init (partial_(ipar), "partial", "not_found", -1.d0, -1.d0, 0) CALL infomsg("add_xml_clocks_pw: label not found ", TRIM(partial_clocks(ipar))) partial_(ipar)%lwrite=.FALSE. END IF END DO END IF CALL qes_init( timing_, "timing_info", total_, partial_) CALL qes_reset ( total_) DO ipar =1, partial_ndim CALL qes_reset(partial_(ipar)) END DO CONTAINS FUNCTION get_index(val, array) result(n) IMPLICIT NONE LOGICAL :: val LOGICAL :: array(:) INTEGER :: n ! INTEGER :: i ! n = - 1 DO i =1, SIZE(array) IF (array(i) .EQV. val) EXIT END DO IF ( array(i) .EQV. val ) n = i END FUNCTION get_index END SUBROUTINE qexsd_init_clocks END MODULE qexsd_module