2016-04-30 01:19:28 +08:00
|
|
|
! 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
|
|
|
|
!----------------------------------------------------------------------------
|
|
|
|
!
|
2019-08-12 18:39:12 +08:00
|
|
|
! This module contains subroutines used to read and write in XML format,
|
2019-08-13 17:48:51 +08:00
|
|
|
! according to the "schema", the data produced by Quantum ESPRESSO
|
2016-04-30 01:19:28 +08:00
|
|
|
!
|
2019-08-12 18:39:12 +08:00
|
|
|
! Based on initial work by Carlo Sbraccia (2003)
|
|
|
|
! and on the qexml.f90 routines written by Andrea Ferretti (2006)
|
2016-04-30 01:19:28 +08:00
|
|
|
! Modified by Simone Ziraldo (2013).
|
2019-08-10 21:10:21 +08:00
|
|
|
! Rewritten by Giovanni Borghi, A. Ferretti, et al. (2015).
|
|
|
|
! Heavily modified by Pietro Delugas and Paolo Giannozzi (2016 on)
|
|
|
|
!
|
2016-04-30 01:19:28 +08:00
|
|
|
!
|
|
|
|
USE kinds, ONLY : DP
|
2019-07-16 00:29:50 +08:00
|
|
|
USE input_parameters, ONLY : input_xml_schema_file
|
2016-04-30 01:19:28 +08:00
|
|
|
USE mp_world, ONLY : nproc
|
2019-08-10 21:10:21 +08:00
|
|
|
USE mp_images, ONLY : nimage,nproc_image
|
2016-04-30 01:19:28 +08:00
|
|
|
USE mp_pools, ONLY : npool
|
|
|
|
USE mp_bands, ONLY : ntask_groups, nproc_bgrp, nbgrp
|
2019-08-12 18:39:12 +08:00
|
|
|
USE global_version, ONLY : version_number
|
2016-04-30 01:19:28 +08:00
|
|
|
!
|
2018-05-15 21:05:08 +08:00
|
|
|
USE qes_types_module
|
2019-02-13 02:07:17 +08:00
|
|
|
USE qes_write_module, ONLY : qes_write
|
2019-08-12 18:39:12 +08:00
|
|
|
USE qes_reset_module, ONLY : qes_reset
|
|
|
|
USE qes_init_module, ONLY : qes_init
|
2016-04-30 01:19:28 +08:00
|
|
|
!
|
2019-02-13 02:07:17 +08:00
|
|
|
USE FoX_wxml, ONLY : xmlf_t
|
2017-07-31 01:59:35 +08:00
|
|
|
!
|
2016-04-30 01:19:28 +08:00
|
|
|
IMPLICIT NONE
|
|
|
|
!
|
|
|
|
PRIVATE
|
|
|
|
SAVE
|
|
|
|
!
|
|
|
|
! definitions for the fmt
|
|
|
|
!
|
|
|
|
CHARACTER(5), PARAMETER :: fmt_name = "QEXSD"
|
2020-07-18 20:42:36 +08:00
|
|
|
CHARACTER(8), PARAMETER :: fmt_version = "20.04.20"
|
2016-04-30 01:19:28 +08:00
|
|
|
!
|
|
|
|
! internal data to be set
|
|
|
|
!
|
2017-07-31 01:59:35 +08:00
|
|
|
TYPE(xmlf_t) :: qexsd_xf
|
2016-04-30 01:19:28 +08:00
|
|
|
!
|
|
|
|
! vars to manage back compatibility
|
|
|
|
!
|
|
|
|
CHARACTER(10) :: qexsd_current_version = " "
|
|
|
|
CHARACTER(10) :: qexsd_default_version = trim( fmt_version )
|
|
|
|
LOGICAL :: qexsd_current_version_init = .FALSE.
|
2019-08-13 17:48:51 +08:00
|
|
|
!
|
2019-08-12 18:39:12 +08:00
|
|
|
TYPE (step_type), ALLOCATABLE :: steps(:)
|
2018-04-11 04:56:40 +08:00
|
|
|
INTEGER :: exit_status
|
|
|
|
TYPE ( closed_type ) :: qexsd_closed_element
|
|
|
|
INTEGER :: step_counter
|
2016-04-30 01:19:28 +08:00
|
|
|
!
|
|
|
|
! end of declarations
|
|
|
|
!
|
2017-07-31 01:59:35 +08:00
|
|
|
PUBLIC :: qexsd_xf
|
2019-08-10 15:33:39 +08:00
|
|
|
PUBLIC :: qexsd_openschema, qexsd_closeschema
|
2019-08-13 17:48:51 +08:00
|
|
|
PUBLIC :: qexsd_readschema
|
2019-08-12 18:39:12 +08:00
|
|
|
PUBLIC :: qexsd_step_addstep, qexsd_reset_steps
|
|
|
|
PUBLIC :: qexsd_current_version, qexsd_default_version, qexsd_current_version_init
|
|
|
|
PUBLIC :: qexsd_set_status
|
2016-04-30 01:19:28 +08:00
|
|
|
!
|
|
|
|
CONTAINS
|
|
|
|
!
|
|
|
|
!-------------------------------------------
|
2019-08-12 18:39:12 +08:00
|
|
|
! ... basic subroutines
|
2016-04-30 01:19:28 +08:00
|
|
|
!-------------------------------------------
|
|
|
|
!
|
|
|
|
!
|
2019-08-12 18:39:12 +08:00
|
|
|
!-------------------------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE qexsd_set_status(status_int)
|
|
|
|
!-------------------------------------------------------------------------------------------------
|
|
|
|
IMPLICIT NONE
|
2016-04-30 01:19:28 +08:00
|
|
|
!
|
2019-08-12 18:39:12 +08:00
|
|
|
INTEGER :: status_int
|
|
|
|
END SUBROUTINE qexsd_set_status
|
|
|
|
!
|
|
|
|
!
|
|
|
|
!-------------------------------------------
|
|
|
|
! ... subroutine writing header, general, parallel info to file
|
|
|
|
!-------------------------------------------
|
|
|
|
!
|
2016-04-30 01:19:28 +08:00
|
|
|
!
|
|
|
|
!------------------------------------------------------------------------
|
2019-08-10 15:33:39 +08:00
|
|
|
SUBROUTINE qexsd_openschema(filename, ounit, prog, title)
|
2016-04-30 01:19:28 +08:00
|
|
|
!------------------------------------------------------------------------
|
|
|
|
!
|
2019-08-12 21:17:25 +08:00
|
|
|
USE FoX_wxml, ONLY: xml_OpenFile, xml_DeclareNamespace, &
|
|
|
|
xml_NewElement, xml_addAttribute, xml_addComment
|
|
|
|
USE qexsd_input, ONLY: qexsd_input_obj
|
2016-04-30 01:19:28 +08:00
|
|
|
IMPLICIT NONE
|
|
|
|
!
|
2019-07-16 00:29:50 +08:00
|
|
|
CHARACTER(len=*), INTENT(IN) :: filename, prog, title
|
2019-08-13 17:48:51 +08:00
|
|
|
INTEGER, INTENT(IN) :: ounit
|
|
|
|
TYPE (general_info_type) :: general_info
|
|
|
|
TYPE (parallel_info_type) :: parallel_info
|
2016-04-30 01:19:28 +08:00
|
|
|
CHARACTER(len=16) :: subname = 'qexsd_openschema'
|
|
|
|
INTEGER :: ierr, len_steps, i_step
|
|
|
|
!
|
|
|
|
! we need a qes-version number here
|
2019-08-10 15:33:39 +08:00
|
|
|
CALL xml_OpenFile(FILENAME = TRIM(filename), XF = qexsd_xf, UNIT = ounit,&
|
|
|
|
PRETTY_PRINT = .TRUE., REPLACE = .TRUE., NAMESPACE = .TRUE., &
|
|
|
|
IOSTAT = ierr )
|
2017-07-31 01:59:35 +08:00
|
|
|
!
|
|
|
|
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 "//&
|
2020-09-03 22:24:39 +08:00
|
|
|
"http://www.quantum-espresso.org/ns/qes/qes_030920.xsd" )
|
2017-07-31 01:59:35 +08:00
|
|
|
CALL xml_addAttribute(XF=qexsd_xf, NAME="Units", VALUE="Hartree atomic units")
|
|
|
|
CALL xml_addComment(XF = qexsd_xf, &
|
2019-04-18 18:58:34 +08:00
|
|
|
COMMENT = "All quantities are in Hartree atomic units unless otherwise specified" )
|
2016-04-30 01:19:28 +08:00
|
|
|
!
|
2016-08-23 01:49:46 +08:00
|
|
|
IF (ierr /= 0) call errore(subname, 'opening xml output file', ierr)
|
2016-04-30 01:19:28 +08:00
|
|
|
! the input file is mandatory to have a validating schema
|
|
|
|
! here an error should be issued, instead
|
|
|
|
!
|
2019-07-16 00:29:50 +08:00
|
|
|
CALL qexsd_init_general_info(general_info, prog(1:2), title )
|
2019-02-13 02:07:17 +08:00
|
|
|
CALL qes_write (qexsd_xf,general_info)
|
|
|
|
CALL qes_reset (general_info)
|
2016-04-30 01:19:28 +08:00
|
|
|
!
|
|
|
|
CALL qexsd_init_parallel_info(parallel_info)
|
2019-02-13 02:07:17 +08:00
|
|
|
CALL qes_write (qexsd_xf,parallel_info)
|
|
|
|
CALL qes_reset (parallel_info)
|
2016-04-30 01:19:28 +08:00
|
|
|
IF ( check_file_exst(input_xml_schema_file) ) THEN
|
2019-08-10 15:33:39 +08:00
|
|
|
CALL xml_addComment( XF = qexsd_xf, COMMENT= "")
|
2017-07-31 01:59:35 +08:00
|
|
|
CALL qexsd_cp_line_by_line(ounit ,input_xml_schema_file, spec_tag="input")
|
2016-05-27 23:53:38 +08:00
|
|
|
ELSE IF ( TRIM(qexsd_input_obj%tagname) == "input") THEN
|
2019-02-13 02:07:17 +08:00
|
|
|
CALL qes_write (qexsd_xf, qexsd_input_obj)
|
2016-04-30 01:19:28 +08:00
|
|
|
END IF
|
2016-11-15 23:48:23 +08:00
|
|
|
!
|
2017-11-11 00:34:16 +08:00
|
|
|
IF (ALLOCATED(steps) ) THEN
|
2016-04-30 01:19:28 +08:00
|
|
|
len_steps= step_counter
|
2017-11-11 00:34:16 +08:00
|
|
|
IF (TRIM (steps(1)%tagname ) .EQ. 'step') THEN
|
|
|
|
DO i_step = 1, len_steps
|
2019-02-13 02:07:17 +08:00
|
|
|
CALL qes_write (qexsd_xf, steps(i_step) )
|
2017-11-11 00:34:16 +08:00
|
|
|
END DO
|
|
|
|
END IF
|
|
|
|
END IF
|
2017-07-31 01:59:35 +08:00
|
|
|
!
|
2016-04-30 01:19:28 +08:00
|
|
|
END SUBROUTINE qexsd_openschema
|
|
|
|
!
|
|
|
|
!
|
|
|
|
!---------------------------------------------------------------------------------------
|
2019-07-16 00:29:50 +08:00
|
|
|
SUBROUTINE qexsd_init_general_info(obj, prog, title )
|
2016-04-30 01:19:28 +08:00
|
|
|
!---------------------------------------------------------------------------------------
|
|
|
|
IMPLICIT NONE
|
|
|
|
!
|
|
|
|
TYPE( general_info_type ) :: obj
|
2018-08-23 17:00:23 +08:00
|
|
|
CHARACTER(LEN=*),INTENT(IN) :: prog
|
2019-07-16 00:29:50 +08:00
|
|
|
CHARACTER(LEN=*),INTENT(IN) :: title
|
2016-04-30 01:19:28 +08:00
|
|
|
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)
|
2018-08-23 17:00:23 +08:00
|
|
|
SELECT CASE( prog(1:2))
|
|
|
|
CASE ('pw','PW')
|
2019-02-13 02:07:17 +08:00
|
|
|
CALL qes_init (creator_obj, "creator", "PWSCF", version, "XML file generated by PWSCF")
|
2018-08-23 17:00:23 +08:00
|
|
|
CASE ('cp', 'CP')
|
2019-02-13 02:07:17 +08:00
|
|
|
CALL qes_init (creator_obj, "creator", "CP", version, "XML file generated by CP")
|
2018-08-23 17:00:23 +08:00
|
|
|
END SELECT
|
2016-04-30 01:19:28 +08:00
|
|
|
!
|
|
|
|
CALL date_and_tim(cdate, ctime)
|
|
|
|
timestamp = 'This run was terminated on: ' // ctime // ' ' // cdate(1:2) // &
|
|
|
|
' '//cdate(3:5) // ' '// cdate (6:9)
|
|
|
|
|
2019-02-13 02:07:17 +08:00
|
|
|
CALL qes_init (created_obj, "created", cdate, ctime, timestamp )
|
2016-04-30 01:19:28 +08:00
|
|
|
!
|
2019-02-13 02:07:17 +08:00
|
|
|
CALL qes_init (xml_fmt_obj, "xml_format", fmt_name, fmt_version, fmt_name//"_"//fmt_version)
|
2016-04-30 01:19:28 +08:00
|
|
|
!
|
2019-02-13 02:07:17 +08:00
|
|
|
CALL qes_init ( obj, TAGNAME, XML_FORMAT = xml_fmt_obj, CREATOR = creator_obj, CREATED = created_obj, &
|
|
|
|
JOB=title)
|
2016-04-30 01:19:28 +08:00
|
|
|
!
|
2019-02-13 02:07:17 +08:00
|
|
|
CALL qes_reset (creator_obj)
|
|
|
|
CALL qes_reset (created_obj)
|
|
|
|
CALL qes_reset (xml_fmt_obj)
|
2016-04-30 01:19:28 +08:00
|
|
|
END SUBROUTINE qexsd_init_general_info
|
|
|
|
!
|
|
|
|
!---------------------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE qexsd_init_parallel_info(obj)
|
|
|
|
!---------------------------------------------------------------------------------------------
|
|
|
|
IMPLICIT NONE
|
|
|
|
!
|
|
|
|
TYPE ( parallel_info_type ) :: obj
|
|
|
|
!
|
|
|
|
INTEGER :: nthreads=1
|
2017-11-29 14:16:32 +08:00
|
|
|
#if defined(__OMP)
|
2016-04-30 01:19:28 +08:00
|
|
|
INTEGER,EXTERNAL :: omp_get_max
|
|
|
|
!
|
|
|
|
nthreads = omp_get_max()
|
|
|
|
#endif
|
2019-02-13 02:07:17 +08:00
|
|
|
CALL qes_init (obj, "parallel_info", nproc, nthreads, ntask_groups, &
|
2016-04-30 01:19:28 +08:00
|
|
|
nbgrp, npool, nproc_bgrp)
|
|
|
|
END SUBROUTINE qexsd_init_parallel_info
|
|
|
|
!
|
2019-08-12 18:39:12 +08:00
|
|
|
!
|
|
|
|
!-------------------------------------------
|
|
|
|
! ... subroutine writing status and timing info to file and closing it
|
|
|
|
!-------------------------------------------
|
|
|
|
!
|
|
|
|
!
|
2016-04-30 01:19:28 +08:00
|
|
|
!------------------------------------------------------------------------
|
|
|
|
SUBROUTINE qexsd_closeschema()
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
USE mytime, ONLY: nclock, clock_label
|
2019-02-13 02:07:17 +08:00
|
|
|
USE FOX_wxml, ONLY: xml_NewElement, xml_AddCharacters, xml_EndElement, xml_Close
|
2016-04-30 01:19:28 +08:00
|
|
|
IMPLICIT NONE
|
2019-02-13 02:07:17 +08:00
|
|
|
REAL(DP),EXTERNAL :: get_clock
|
|
|
|
TYPE(timing_type) :: qexsd_timing_
|
2016-04-30 01:19:28 +08:00
|
|
|
!
|
|
|
|
CHARACTER(len=17) :: subname = 'qexsd_closeschema'
|
|
|
|
INTEGER :: ierr
|
|
|
|
!
|
2017-07-31 01:59:35 +08:00
|
|
|
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")
|
2016-05-27 23:53:38 +08:00
|
|
|
CALL qexsd_set_closed()
|
2019-02-13 02:07:17 +08:00
|
|
|
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)
|
2016-05-28 01:10:06 +08:00
|
|
|
END IF
|
2017-07-31 01:59:35 +08:00
|
|
|
CALL xml_Close(qexsd_xf)
|
2016-04-30 01:19:28 +08:00
|
|
|
!
|
|
|
|
END SUBROUTINE qexsd_closeschema
|
|
|
|
!
|
2019-08-13 17:48:51 +08:00
|
|
|
!
|
|
|
|
!-------------------------------------------
|
|
|
|
! ... function reading xml and storing inofo into objects
|
|
|
|
!-------------------------------------------
|
|
|
|
!
|
|
|
|
!------------------------------------------------------------------------
|
2019-10-07 01:19:23 +08:00
|
|
|
SUBROUTINE qexsd_readschema (filename, ierr, output_obj, parinfo_obj, &
|
|
|
|
geninfo_obj, input_obj)
|
2019-08-13 17:48:51 +08:00
|
|
|
!------------------------------------------------------------------------
|
|
|
|
!
|
|
|
|
USE qes_read_module, ONLY : qes_read
|
|
|
|
USE FoX_dom, ONLY : parseFile, item, getElementsByTagname, &
|
|
|
|
destroy, nodeList, Node
|
|
|
|
!
|
|
|
|
IMPLICIT NONE
|
|
|
|
!
|
|
|
|
CHARACTER(LEN=*), INTENT(IN) :: filename
|
2019-10-07 01:19:23 +08:00
|
|
|
INTEGER, INTENT(OUT) :: ierr
|
2019-08-13 17:48:51 +08:00
|
|
|
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))
|
|
|
|
!
|
2019-10-07 01:19:23 +08:00
|
|
|
END SUBROUTINE qexsd_readschema
|
2019-08-12 18:39:12 +08:00
|
|
|
!
|
|
|
|
!-------------------------------------------
|
|
|
|
! ... 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
|
|
|
|
!
|
2016-04-30 01:19:28 +08:00
|
|
|
!
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
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
|
2017-10-06 22:34:20 +08:00
|
|
|
integer, external :: find_free_unit
|
2016-04-30 01:19:28 +08:00
|
|
|
|
2017-10-06 22:34:20 +08:00
|
|
|
iun = find_free_unit()
|
2016-04-30 01:19:28 +08:00
|
|
|
!
|
|
|
|
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,"<Root>")/=0 .or. index(str,"<Root>")/=0 .or. &
|
|
|
|
index(str,"<?")/=0 .or. .not.icopy) cycle copy_loop
|
|
|
|
!
|
|
|
|
write(iun_out,"(a)") trim(str)
|
|
|
|
!
|
|
|
|
if (present(spec_tag)) then
|
|
|
|
if (index(str,"</input>")/=0) icopy=.false.
|
|
|
|
endif
|
|
|
|
!
|
|
|
|
enddo copy_loop
|
|
|
|
!
|
|
|
|
close(iun)
|
|
|
|
!
|
|
|
|
END SUBROUTINE qexsd_cp_line_by_line
|
|
|
|
!
|
|
|
|
!
|
|
|
|
!-------------------------------------------
|
2019-08-12 18:39:12 +08:00
|
|
|
! ... subroutine related to MD steps
|
2016-04-30 01:19:28 +08:00
|
|
|
!-------------------------------------------
|
|
|
|
!
|
|
|
|
!
|
|
|
|
!----------------------------------------------------------------------------------------
|
2018-04-10 23:59:34 +08:00
|
|
|
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, &
|
2018-08-23 16:00:53 +08:00
|
|
|
stress, scf_has_converged, n_scf_steps, scf_error, efieldcorr, potstat_contr, &
|
2018-04-10 23:59:34 +08:00
|
|
|
fcp_force, fcp_tot_charge, gatefield_en)
|
2016-04-30 01:19:28 +08:00
|
|
|
!-----------------------------------------------------------------------------------------
|
2018-04-10 23:59:34 +08:00
|
|
|
!! 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
|
2019-08-12 18:39:12 +08:00
|
|
|
USE qexsd_init, ONLY : qexsd_init_atomic_structure, qexsd_init_total_energy
|
2016-04-30 01:19:28 +08:00
|
|
|
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, &
|
2018-04-10 23:59:34 +08:00
|
|
|
etxc, ewald, scf_error, forces(3,nat), stress(3,3)
|
2018-08-23 16:00:53 +08:00
|
|
|
LOGICAL,INTENT(IN) :: scf_has_converged
|
2018-04-17 00:40:25 +08:00
|
|
|
REAL(DP),OPTIONAL,INTENT(IN) :: degauss, demet, gatefield_en, efieldcorr
|
|
|
|
REAL(DP),OPTIONAL,INTENT (IN) :: potstat_contr, fcp_force, fcp_tot_charge
|
2016-04-30 01:19:28 +08:00
|
|
|
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
|
2018-04-10 23:59:34 +08:00
|
|
|
!
|
2016-04-30 01:19:28 +08:00
|
|
|
IF ( i_step .EQ. 1 ) THEN
|
|
|
|
ALLOCATE (steps(max_steps))
|
|
|
|
step_counter = 0
|
|
|
|
END IF
|
|
|
|
step_counter = step_counter+1
|
|
|
|
!
|
|
|
|
step_obj%tagname="step"
|
2019-02-28 22:21:19 +08:00
|
|
|
step_obj%n_step = i_step
|
2016-04-30 01:19:28 +08:00
|
|
|
!
|
2019-02-13 02:07:17 +08:00
|
|
|
CALL qes_init( scf_conv_obj,"scf_conv", scf_has_converged, n_scf_steps, scf_error )
|
2016-04-30 01:19:28 +08:00
|
|
|
!
|
|
|
|
step_obj%scf_conv = scf_conv_obj
|
2019-02-13 02:07:17 +08:00
|
|
|
CALL qes_reset(scf_conv_obj)
|
2016-04-30 01:19:28 +08:00
|
|
|
!
|
2017-03-10 01:39:55 +08:00
|
|
|
CALL qexsd_init_atomic_structure(atomic_struct_obj, ntyp, atm, ityp, nat, tau, &
|
2017-10-08 22:20:14 +08:00
|
|
|
alat, a1, a2, a3, 0)
|
2016-04-30 01:19:28 +08:00
|
|
|
step_obj%atomic_structure=atomic_struct_obj
|
2019-02-13 02:07:17 +08:00
|
|
|
CALL qes_reset( atomic_struct_obj )
|
2016-04-30 01:19:28 +08:00
|
|
|
!
|
2018-04-17 00:40:25 +08:00
|
|
|
CALL qexsd_init_total_energy (tot_en_obj, etot, eband, ehart, &
|
|
|
|
vtxc, etxc, ewald, degauss, demet, efieldcorr, potstat_contr, gatefield_en)
|
2016-04-30 01:19:28 +08:00
|
|
|
step_obj%total_energy=tot_en_obj
|
2019-02-13 02:07:17 +08:00
|
|
|
CALL qes_reset( tot_en_obj )
|
2016-04-30 01:19:28 +08:00
|
|
|
!
|
2019-02-13 02:07:17 +08:00
|
|
|
CALL qes_init( mat_forces, "forces", [3, nat], forces )
|
2016-04-30 01:19:28 +08:00
|
|
|
step_obj%forces=mat_forces
|
2019-02-13 02:07:17 +08:00
|
|
|
CALL qes_reset ( mat_forces )
|
2016-04-30 01:19:28 +08:00
|
|
|
!
|
2019-02-13 02:07:17 +08:00
|
|
|
CALL qes_init( mat_stress, "stress", [3, 3], stress )
|
2016-04-30 01:19:28 +08:00
|
|
|
step_obj%stress = mat_stress
|
2019-02-13 02:07:17 +08:00
|
|
|
CALL qes_reset ( mat_stress )
|
2016-09-28 22:07:13 +08:00
|
|
|
IF ( PRESENT ( fcp_force ) ) THEN
|
2018-04-17 00:40:25 +08:00
|
|
|
step_obj%FCP_force = fcp_force
|
2016-09-28 22:07:13 +08:00
|
|
|
step_obj%FCP_force_ispresent = .TRUE.
|
2018-04-10 23:59:34 +08:00
|
|
|
END IF
|
|
|
|
IF (PRESENT( fcp_tot_charge)) THEN
|
2018-04-17 00:40:25 +08:00
|
|
|
step_obj%FCP_tot_charge = fcp_tot_charge
|
2016-09-28 22:07:13 +08:00
|
|
|
step_obj%FCP_tot_charge_ispresent = .TRUE.
|
|
|
|
END IF
|
2016-04-30 01:19:28 +08:00
|
|
|
!
|
|
|
|
!
|
|
|
|
steps(step_counter) = step_obj
|
2017-07-31 01:59:35 +08:00
|
|
|
steps(step_counter)%lwrite = .TRUE.
|
|
|
|
steps(step_counter)%lread = .TRUE.
|
2019-02-13 02:07:17 +08:00
|
|
|
call qes_reset (step_obj)
|
2016-04-30 01:19:28 +08:00
|
|
|
END SUBROUTINE qexsd_step_addstep
|
2018-05-16 23:34:56 +08:00
|
|
|
!
|
|
|
|
!------------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE qexsd_reset_steps()
|
|
|
|
IMPLICIT NONE
|
|
|
|
INTEGER :: i_step
|
|
|
|
IF (ALLOCATED(steps)) THEN
|
|
|
|
DO i_step =1, SIZE(steps)
|
2019-02-13 02:07:17 +08:00
|
|
|
CALL qes_reset(steps(i_step))
|
2018-05-16 23:34:56 +08:00
|
|
|
END DO
|
|
|
|
DEALLOCATE (steps)
|
|
|
|
END IF
|
|
|
|
END SUBROUTINE
|
2016-04-30 01:19:28 +08:00
|
|
|
!
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
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)
|
2019-02-13 02:07:17 +08:00
|
|
|
CALL qes_init (qexsd_closed_element, "closed", date_string, time_string,&
|
2016-04-30 01:19:28 +08:00
|
|
|
"")
|
|
|
|
END SUBROUTINE qexsd_set_closed
|
2018-04-10 23:59:34 +08:00
|
|
|
|
2019-08-12 18:39:12 +08:00
|
|
|
!
|
|
|
|
!-------------------------------------------
|
|
|
|
! ... subroutine related to timing information
|
|
|
|
!-------------------------------------------
|
|
|
|
!
|
|
|
|
!
|
2016-04-30 01:19:28 +08:00
|
|
|
|
2019-02-13 02:07:17 +08:00
|
|
|
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
|
2016-04-30 01:19:28 +08:00
|
|
|
|
|
|
|
|
|
|
|
END MODULE qexsd_module
|