./src/struct_utils.tcl

::pwtk::pwo::getStructData

::pwtk::pwo::getStructData

SYNOPSIS

proc ::pwtk::pwo::getStructData {what args} {

USAGE

::pwtk::pwo::getStructData what [-k] pwoFile [index]

PURPOSE

The master structure retrieval routine for getting the index-th structure (CELL_PARAMETERS and/or ATOMIC_POSITIONS) from pw.x output file.

Not meant to be used directly, use the ::pwtk::pwo::getPrimVec, ::pwtk::pwo::getAtmPos, or ::pwtk::pwo::getStruct instead.

ARGUMENTS

what -- what to extract, possible values = vectors | positions | both
-k -- (optional) option to request to include the ATOMIC_POSITIONS and/or CELL_PARAMETERS lines in the result
pwoFile -- pw.x output file
index -- (optional, default = end )sequential index of the structure to extract. The input structure has an index of 0, while for the last reported structure a string "end" can be used.

SOURCE

    # parse arguments ...
    
    set options {
        {k "include the keyword line in the result"}
    }
    set usage ":   ::pwtk::pwo::getStructData what \[-k] pwoFile \[index]"

    array set opt [::cmdline::getoptions args $options $usage]

    set narg [llength $args]
    if { $narg < 1 || $narg > 2 } {
        ::pwtk::error "Usage $usage" 1
    }

    set prependKeyword $opt(k)
    set pwoFile [lindex $args 0]
    set index   [expr { $narg == 1 ? "end" : [lindex $args 1] }]    
    
    # do the job ...
    
    set fid    [open $pwoFile r]
    set l_vec  {}
    set l_coor {}
    set nat    0
    set l_first_vec  1
    set l_first_coor 1

    if { ! [string is boolean $prependKeyword]  } {
        ::pwtk::error "prependKeyword must be of boolean type; assuming it is true"
        set prependKeyword 1
    }

    while { ! [eof $fid] } {
        #
        gets $fid line
        #
        if { [string match {*number of atoms/cell*} $line] } {
            
            set nat [lindex $line end]
            
        } elseif { [string match {*crystal axes: (cart. coord. in units of a*} $line] && $l_first_vec && $index != "end" } {

            set l_first_vec 0

            if { $prependKeyword} {
                set vec "CELL_PARAMETERS (alat)\n"
            } else {
                set vec ""
            }

            append vec [lrange [string map {( "" ) ""} [gets $fid]] 2 4]\n
            append vec [lrange [string map {( "" ) ""} [gets $fid]] 2 4]\n
            append vec [lrange [string map {( "" ) ""} [gets $fid]] 2 4]\n

            lappend l_vec $vec

        } elseif { [string match CELL_PARAMETERS* $line] } {
            
            if { $prependKeyword} {
                set vec $line\n
            } else {
                set vec ""
            }

            append vec [gets $fid]\n
            append vec [gets $fid]\n
            append vec [gets $fid]\n

            lappend l_vec $vec


        } elseif { [string match {*Cartesian axes*} $line] && $l_first_coor } {
            #
            # initial coordinates 
            #
            set l_first_coor 0
            gets $fid line; # empty line
            gets $fid line; # site n.     atom                  positions (a_0 units)
            
            if { $prependKeyword} {
                set key "ATOMIC_POSITIONS (alat)\n"
            } else {
                set key ""
            }

            set coor ""            
            for {set ia 0} {$ia < $nat} {incr ia} {
                set line [gets $fid]
                append coor [concat [lindex $line 1] [lrange [string map {( " " ) " "} $line] 5 7]]\n
            }

            # Try to transform coor to atmPos, but be cautious:
            # perhaps ATOMIC_POSITIONS card is empty or has a
            # different number of atoms; use transformation only if
            # the number-of-atoms matches

            set atmPos [::pwtk::pwi::coorToAtmPos $coor]
            if { [::pwtk::getNAtoms $coor] == [::pwtk::getNAtoms $atmPos] } {
                lappend l_coor ${key}$atmPos
            } else {
                lappend l_coor ${key}$coor
            }       
        } elseif { [string match ATOMIC_POSITIONS* $line] } {

            if { $prependKeyword} {
                set coor $line\n
            } else {
                set coor ""
            }
            
            for {set ia 0} {$ia < $nat} {incr ia} {
                append coor [gets $fid]\n
            }

            lappend l_coor $coor
        }               
    }
    close $fid

    switch -nocase -glob --  $what {    
        cell* -
        vec* {
            set result [lindex $l_vec $index]
        }
        atom* -
        pos* -
        coor* {
            set result [lindex $l_coor $index]
        }
        both {
            set result [lindex $l_vec $index]\n[lindex $l_coor $index]      
        }
        default {
            ::pwtk::error "wrong data-type requested, must be vectors | positions | both; only atomic position will be returned"
            set result [lindex $l_coor $index]
        }
    }

    return $result
}

TABLE OF CONTENTS

::pwtk::pwo::getStructData