Changeset 129


Ignore:
Timestamp:
Dec 4, 2009 5:00:53 PM (11 years ago)
Author:
toby
Message:

# on 2000/05/16 21:53:20, toby did:
add constrinfo for atom constraint processing

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/readexp.tcl

    • Property rcs:date changed from 2000/05/16 21:48:45 to 2000/05/16 21:53:20
    • Property rcs:lines changed from +23 -13 to +140 -0
    • Property rcs:rev changed from 1.13 to 1.14
    r128 r129  
    11391139}
    11401140
     1141#  get a logical constraint
     1142#  type action
     1143#  -----------
     1144#  atom get    returns a list of constraints.
     1145#       set    replaces a list of constraints.
     1146#       add    inserts a new list of constraints
     1147#       delete deletes a set of constraint entries
     1148# Each item in the list of constraints is composed of 4 items:
     1149#   phase, atom, variable, multiplier
     1150#      if variable=UISO atom can be ALL, otherwise atom is a number
     1151# legal variable names: FRAC, X, Y, Z, UISO, U11, U22, U33, U12, U23, U13,
     1152#                       MX, MY, MZ
     1153proc constrinfo {type action number "value {}"} {
     1154    switch -glob ${type}-$action {
     1155        atom-get {
     1156            # does this constraint exist?
     1157            set key [format "LNCN%4d%4d" $number 1]
     1158            if {![existsexp $key]} {return -1}
     1159            set clist {}
     1160            for {set i 1} {$i < 999} {incr i} {
     1161                set key [format "LNCN%4d%4d" $number $i]
     1162                if {![existsexp $key]} break
     1163                set line [readexp $key]
     1164                set j1 2
     1165                set j2 17
     1166                set seg [string range $line $j1 $j2]
     1167                while {[string trim $seg] != ""} {
     1168                    lappend clist [list \
     1169                            [string range $seg 0 0] \
     1170                            [string trim [string range $seg 1 3]] \
     1171                            [string trim [string range $seg 4 7]] \
     1172                            [string trim [string range $seg 8 end]]]
     1173                    incr j1 16
     1174                    incr j2 16
     1175                    set seg [string range $line $j1 $j2]
     1176                }
     1177            }
     1178            return $clist
     1179        }
     1180        atom-set {
     1181            # delete records for current constraint
     1182            for {set i 1} {$i < 999} {incr i} {
     1183                set key [format "LNCN%4d%4d" $number $i]
     1184                if {![existsexp $key]} break
     1185                delexp $key
     1186            }
     1187            set line {}
     1188            set i 1
     1189            foreach tuple $value {
     1190                if {[string toupper [lindex $tuple 1]] == "ALL"} {
     1191                    set seg [format %1dALL%-4s%8.4f \
     1192                            [lindex $tuple 0] \
     1193                            [lindex $tuple 2] \
     1194                            [lindex $tuple 3]]
     1195                } else {
     1196                    set seg [eval format %1d%3d%-4s%8.4f $tuple]
     1197                }
     1198                append line $seg
     1199                if {[string length $line] > 50} {
     1200                    set key  [format "LNCN%4d%4d" $number $i]
     1201                    makeexprec $key
     1202                    setexp $key $line 3 68
     1203                    set line {}
     1204                    incr i
     1205                }
     1206            }
     1207            if {$line != ""} {
     1208                set key  [format "LNCN%4d%4d" $number $i]
     1209                makeexprec $key
     1210                setexp $key $line 3 68
     1211            }
     1212            return
     1213        }
     1214        atom-add {
     1215            # loop over defined constraints
     1216            for {set j 1} {$j < 9999} {incr j} {
     1217                set key [format "LNCN%4d%4d" $j 1]
     1218                if {![existsexp $key]} break
     1219            }
     1220            set number $j
     1221            # save the constraint
     1222            set line {}
     1223            set i 1
     1224            foreach tuple $value {
     1225                if {[string toupper [lindex $tuple 1]] == "ALL"} {
     1226                    set seg [format %1dALL%-4s%8.4f \
     1227                            [lindex $tuple 0] \
     1228                            [lindex $tuple 2] \
     1229                            [lindex $tuple 3]]
     1230                } else {
     1231                    set seg [eval format %1d%3d%-4s%8.4f $tuple]
     1232                }
     1233                append line $seg
     1234                if {[string length $line] > 50} {
     1235                    set key  [format "LNCN%4d%4d" $number $i]
     1236                    makeexprec $key
     1237                    setexp $key $line 3 68
     1238                    set line {}
     1239                    incr i
     1240                }
     1241            }
     1242            if {$line != ""} {
     1243                set key  [format "LNCN%4d%4d" $number $i]
     1244                makeexprec $key
     1245                setexp $key $line 3 68
     1246            }
     1247            return
     1248        }
     1249        atom-delete {
     1250            for {set j $number} {$j < 9999} {incr j} {
     1251                # delete records for current constraint
     1252                for {set i 1} {$i < 999} {incr i} {
     1253                    set key [format "LNCN%4d%4d" $j $i]
     1254                    if {![existsexp $key]} break
     1255                    delexp $key
     1256                }
     1257                # now copy records, from the next entry, if any
     1258                set j1 $j
     1259                incr j1
     1260                set key1 [format "LNCN%4d%4d" $j1 1]
     1261                # if there is no record, there is nothing to copy -- done
     1262                if {![existsexp $key1]} return
     1263                for {set i 1} {$i < 999} {incr i} {
     1264                    set key1 [format "LNCN%4d%4d" $j1 $i]
     1265                    if {![existsexp $key1]} break
     1266                    set key  [format "LNCN%4d%4d" $j  $i]
     1267                    makeexprec $key
     1268                    setexp $key [readexp $key1] 1 68
     1269                }
     1270            }
     1271        }
     1272        default {
     1273            set msg "Unsupported constrinfo access: type=$type action=$action"
     1274#           tk_dialog .badexp "Error in EXP" $msg error 0 Exit
     1275#           destroy .
     1276        }
     1277
     1278    }
     1279}
     1280
    11411281# write the .EXP file
    11421282proc expwrite {expfile} {
Note: See TracChangeset for help on using the changeset viewer.