#!/usr/local/bin/perl # ^^^^^^^^^^^^^^_____PLEASE check the address of YOUR perl ########################################## # Please adopt ################ # $sharc_e_group and $sharc_punch_dir to YOUR system # #=======================================================# $sharc_e_group = "ccc_erlangen"; $sharc_e_permission = "GROUP_ONLY"; # see %remark2sharc_perm $sharc_punch_dir = "/usr/convex/cluster/Sharc/"; ######################################################### # # NAME: dmm2sharc # AUTHOR: A. Dransfeld dransfld@ccc.uni-erlangen.de # VERSION: V 1.01a (1996-10-09) # # FUNCTION: # transfer the results of a "deMon VERSION 1.0" + MASTER May'93 calculation # into sharc format as specified at http://www.ccc.uni-erlangen.de/sharc/ # MAIN program at botton of source # MAIN SUBroutines: # peep_user V 0.1 1996-10-01 # peep_date V 0.1 1996-10-05 (here ISO/R 2014-1971) # peep_computation_type V 0.1 1996-09-14 (for demon10, iglo92) # comment2key_values V 0.2 1996-10-01 # generate_formula V 0.1 1996-10-02 # evaluate_dmm_inp V 0.1 1996-09-14 # evaluate_dmm_out V 0.2 1996-10-05 # evaluate_dmm_nmr V 0.3 1996-10-03 # evaluate_dmm_jmn V 0.2 1996-10-04 # assemble_mix_basis V 0.2 1996-10-04 # assemble_sharc_entry V 0.6 1996-10-05 # $version = "dmm2sharc V 1.01a 1996-10-09 A.Dransfeld"; $sharc_xx2skript = $version; # for assembling SUB $data_files = "[fn.inp,] fn.out, fn.nmr, [fn.jmn])"; $usageline = "$version\nUSAGE $0 fn (evaluates $data_files)\n"; $mode = "interactive"; # "batch" switches off Warnings to screen # "batch";/"interactive"; $punch = "active"; # "inactive" switches off punching to Arc dir # "active";/"inactive";(for test purposes) if($mode eq "batch") { $verbose = 0; }else{ $verbose = 3; # [3] # verbose > 0 for debugging and postprocessing if($verbose > 1){print "\nVERBOSE $verbose\n";} } # verbose -> actions # # 1 Warnings # # 2 titles + Warnings (titles = comment and command line) # # 3 applied conversions + title + Warnings # # 4 NICS + applied conversions + title + Warnings # # 11 initializations of SUBroutines # # 12 tag_bx name + initializations of SUBroutines # # 13 temporaries + tag_bx + init +NICS + conv + title + Warnings # # 21 tag_box content + temp + tag_bx+init+NICS+conv+title+Warnings # Comments are marked with increasing importance: # , #_ , #__ , #___ # #__ Constants: # One Bohr equals 0.5291772 angstroems $bohr = 0.5291772; $date_format = "ISO\/R 2014-1971"; # #__ INTERNET $url_sharc_glo_prg = "http://www.ccc.uni-erlangen.de/sharc/glossary/method/"; $url_sharc_glo_bs = "http://www.ccc.uni-erlangen.de/sharc/glossary/basis_set/"; $url_sharc_glo_geomtd = "undefff"; # #__ Check the .out file if ($#ARGV < 0) { if($verbose > 0) { # e.g if it's _not_ a batch job.-) print $usageline; die; # with system error message } else { exit; # without comment } } else { $fn_job = $ARGV[0]; } # #__ Initialization of arrays and variables #_ Transform NMR basis in DMM.out -> SHARC code # see $url_sharc_glo_bs # GENERAL ORBITAL BASIS SET IS _$basis_name_in_dmm_ $bas_kw2code{"IGLO-II"} = "B2"; $bas_kw2code{"IGLO-III"} = "B3"; $bas_kw2code{"DZVP"} = "DZVP"; #DZVP often is together with GENERAL AUXILIARY BASIS SET IS A1 # #_ Transform _mixed_ NMR basis in DMM.out -> SHARC code # see $url_sharc_glo_bs for details # ORBITAL BASIS SET: O-LITHIUM (621/1*/1+) FOR ATOM: 1 # ORBITAL BASIS SET: O-CARBON iii_iglo FOR ATOM: 2 $e_nmr_bax{"ii_iglo"} = "B2"; $e_nmr_bax{"iii_iglo"} = "B3"; # #_ Transform atom_Name to atom_Symbol # values %a_symbol is Fe He H O P Si ... # keys %a_symbol is the atom name ($a_symbol: IRON HELIUM ... # rem: use _after_ canonizing the atom names to upper case $a_symbol{XX} = Bq ; $a_symbol{HYDROGEN} = H ; $a_symbol{HELIUM} = He ; $a_symbol{LITHIUM} = Li ; $a_symbol{BERYLLIUM} = Be ; $a_symbol{BORON} = B ; $a_symbol{CARBON} = C ; $a_symbol{NITROGEN} = N ; $a_symbol{OXYGEN} = O ; $a_symbol{FLUORINE} = F ; $a_symbol{NEON} = Ne ; $a_symbol{SODIUM} = Na ; $a_symbol{MAGNESIUM} = Mg ; $a_symbol{ALUMINUM} = Al ; $a_symbol{SILICON} = Si ; $a_symbol{PHOSPHORUS} = P ; $a_symbol{SULFUR} = S ; $a_symbol{CHLORINE} = Cl ; $a_symbol{ARGON} = Ar ; # ... more elements $a_symbol{TITANIUM} = Ti ; $a_symbol{IRON} = Fe ; # #_ Transform atom_Synbol to "atom_Number" nuclear charge # values %sym2nuccha is 0 1 2 ... 6 ... 15 16 # keys %sym2nuccha are Bq H He ... O ... P Si ... $sym2nuccha{"Bq"} = 0; $sym2nuccha{"H"} = 1; $sym2nuccha{"He"} = 2; $sym2nuccha{"Li"} = 3; $sym2nuccha{"Be"} = 4; $sym2nuccha{"B"} = 5; $sym2nuccha{"C"} = 6; $sym2nuccha{"N"} = 7; $sym2nuccha{"O"} = 8; $sym2nuccha{"F"} = 9; $sym2nuccha{"Ne"} = 10; $sym2nuccha{"Na"} = 11; $sym2nuccha{"Mg"} = 12; $sym2nuccha{"Al"} = 13; $sym2nuccha{"Si"} = 14; $sym2nuccha{"P"} = 15; $sym2nuccha{"S"} = 16; $sym2nuccha{"Cl"} = 17; $sym2nuccha{"Ar"} = 18; # ... more elements $sym2nuccha{"Ti"} = 22; $sym2nuccha{"Fe"} = 26; # #_ initialize the "SHARC Atom Counter" @sharc_a_count array # $count{H} = 1; etc. requires array a_symbol{atom_name} to be def. first foreach $i (keys %a_symbol) { $sharc_a_count{$a_symbol{$i}} = 0; } if($verbose > 10){print "IINI_test: n($a_symbol{HELIUM}) = $sharc_a_count{He}\n";} # #_ initialize array sharc_coordinates @sharc_coordinates = ("x","y","z","sigma","XX","XY","XZ","YX","YY","YZ","ZX","ZY","ZZ"); if($verbose > 10){print "IINI_test: $sharc_coordinates[5] = XY \n";} #test for ($i=4;$i<13;$i++) { print "$i $sharc_coordinates[$i]" }; # #_ Transform Point_Group Spec. in comment -> SHARC code #_ list of allowed characters for p.g. specification #------------- %txt2s_point_group ----------- Version of 1996-09-15 -- #------ Text_2_Sharc pairs # the !space at the end! is essential # see $url_sharc_glo_bs for details $txt2s_point_group{"\/c1 "} = "C1"; $txt2s_point_group{"\/C1 "} = "C1"; # as is $txt2s_point_group{"\/c2 "} = "C2"; $txt2s_point_group{"\/C2 "} = "C2"; # as is $txt2s_point_group{"\/c3 "} = "C3"; $txt2s_point_group{"\/C3 "} = "C3"; # as is $txt2s_point_group{"\/c2v "} = "C2V"; $txt2s_point_group{"\/c2V "} = "C2V"; $txt2s_point_group{"\/C2v "} = "C2V"; $txt2s_point_group{"\/C2V "} = "C2V"; # as is $txt2s_point_group{"\/c3V "} = "C3V"; $txt2s_point_group{"\/C3v "} = "C3V"; $txt2s_point_group{"\/C3V "} = "C3V"; # as is $txt2s_point_group{"\/d3h "} = "D3H"; $txt2s_point_group{"\/D3h "} = "D3H"; $txt2s_point_group{"\/d3H "} = "D3H"; $txt2s_point_group{"\/D3H "} = "D3H"; # as is $txt2s_point_group{"\/d5h "} = "D5H"; $txt2s_point_group{"\/D5h "} = "D5H"; $txt2s_point_group{"\/d5H "} = "D5H"; $txt2s_point_group{"\/D5H "} = "D5H"; # as is $txt2s_point_group{"\/ci "} = "CI"; $txt2s_point_group{"\/cI "} = "CI"; $txt2s_point_group{"\/Ci "} = "CI"; $txt2s_point_group{"\/CI "} = "CI"; # as is #_END definig ------ Text_2_Sharc pairs # # #_ Transform Geometry Spec. method in comment -> SHARC code #_ list of allowed METHODS for geometry specification #------------- %g2s_opt_method ---------- Version of 1996-09-17 -- # augmented 1996-10-03 #------ Gaussian_2_Sharc pairs # the !space at the end! is essential # WITH if (/\/\/$tmp[\/,\s]/i){ checking case_IN_sensitive # see $url_sharc_glo_geomtd for details # known Bug: "_mp2 fx" is recognized as "_mp2" $g2s_opt_method{"hf"} = "RHF"; $g2s_opt_method{"rhf"} = "RHF"; # as is $g2s_opt_method{"mp2"} = "MP2"; $g2s_opt_method{"mp2fc"} = "RMP2-FC"; $g2s_opt_method{"mp2fu"} = "RMP2-FU"; $g2s_opt_method{"mp2fc"} = "RMP2-FC"; $g2s_opt_method{"mp2fu"} = "RMP2-FU"; $g2s_opt_method{"mp2-fc"} = "RMP2-FC"; $g2s_opt_method{"mp2-fu"} = "RMP2-FU"; $g2s_opt_method{"mp2(fc"} = "RMP2-FC"; $g2s_opt_method{"mp2(fu"} = "RMP2-FU"; $g2s_opt_method{"mp2-fc)"} = "RMP2-FC"; $g2s_opt_method{"mp2-fu)"} = "RMP2-FU"; $g2s_opt_method{"mp2(fc)"} = "RMP2-FC"; $g2s_opt_method{"mp2(fu)"} = "RMP2-FU"; $g2s_opt_method{"rmp2fc"} = "RMP2-FC"; $g2s_opt_method{"rmp2fu"} = "RMP2-FU"; $g2s_opt_method{"rmp2-fc"} = "RMP2-FC"; # as is $g2s_opt_method{"rmp2-fu"} = "RMP2-FU"; # as is $g2s_opt_method{"rmp2(fc"} = "RMP2-FC"; $g2s_opt_method{"rmp2(fu"} = "RMP2-FU"; $g2s_opt_method{"rmp2-fc)"} = "RMP2-FC"; $g2s_opt_method{"rmp2-fu)"} = "RMP2-FU"; $g2s_opt_method{"rmp2(fc)"} = "RMP2-FC"; $g2s_opt_method{"rmp2(fu)"} = "RMP2-FU"; # $g2s_opt_method{"mp2full"} = "RMP2-FU"; $g2s_opt_method{"mp2-full"} = "RMP2-FU"; $g2s_opt_method{"mp2(full"} = "RMP2-FU"; $g2s_opt_method{"mp2(full)"} = "RMP2-FU"; $g2s_opt_method{"rmp2full"} = "RMP2-FU"; $g2s_opt_method{"rmp2-full"} = "RMP2-FU"; $g2s_opt_method{"rmp2(full"} = "RMP2-FU"; $g2s_opt_method{"rmp2(full)"} = "RMP2-FU"; # $g2s_opt_method{"b3lyp"} = "B3LYP"; # as is $g2s_opt_method{"becke3lyp"} = "B3LYP"; # added 1996-10-03 $g2s_opt_method{"rb3lyp"} = "RB3LYP"; # as is # $g2s_opt_method{"pm3"} = "PM3"; # as is # #_ Transform Geometry Spec. basis in comment -> SHARC code #_ list of allowed BASIS sets for geometry specification #------------- %g2s_basis_set ----------- Version of 1996-09-15 -- #------ Gaussian_2_Sharc pairs # the !space at the end! is essential # see $url_sharc_glo_bs for details $g2s_basis_set{"gen "} = "MIX-unknown"; $g2s_basis_set{"GEN "} = "MIX-unknown"; $g2s_basis_set{"STO-3G "} = "STO-3G"; $g2s_basis_set{"3-21G "} = "3-21G"; # as is $g2s_basis_set{"3-21G* "} = "MIX-1"; $g2s_basis_set{"3-21+G* "} = "MIX-21"; $g2s_basis_set{"6-31G "} = "6-31G"; # as is $g2s_basis_set{"6-31G* "} = "6-31GD"; $g2s_basis_set{"6-31G(d) "} = "6-31GD"; $g2s_basis_set{"6-31G(D) "} = "6-31GD"; $g2s_basis_set{"6-31GD "} = "6-31GD"; # as is $g2s_basis_set{"6-31G** "} = "6-31GDP"; $g2s_basis_set{"6-31G(d,p) "} = "6-31GDP"; $g2s_basis_set{"6-31G(D,P) "} = "6-31GDP"; $g2s_basis_set{"6-31GDP "} = "6-31GDP"; # as is $g2s_basis_set{"6-31+G* "} = "6-31+GD"; $g2s_basis_set{"6-31+G(d) "} = "6-31+GD"; $g2s_basis_set{"6-31+G(D) "} = "6-31+GD"; $g2s_basis_set{"6-31+GD "} = "6-31+GD"; # as is $g2s_basis_set{"6-31+G** "} = "6-31+GDP"; $g2s_basis_set{"6-31+G(d,p) "} = "6-31+GDP"; $g2s_basis_set{"6-31+G(D,P) "} = "6-31+GDP"; $g2s_basis_set{"6-31+GDP "} = "6-31+GDP"; # as is $g2s_basis_set{"6-31++G* "} = "6-31++GD"; $g2s_basis_set{"6-31++G(d) "} = "6-31++GD"; $g2s_basis_set{"6-31++G(D) "} = "6-31++GD"; $g2s_basis_set{"6-31++GD "} = "6-31++GD"; # as is $g2s_basis_set{"6-31++G** "} = "6-31++GDP"; $g2s_basis_set{"6-31++G(d,p) "} = "6-31++GDP"; $g2s_basis_set{"6-31++G(D,P) "} = "6-31++GDP"; $g2s_basis_set{"6-31++GDP "} = "6-31++GDP"; # as is $g2s_basis_set{"6-311G* "} = "6-311GD"; $g2s_basis_set{"6-311G(d) "} = "6-311GD"; $g2s_basis_set{"6-311G(D) "} = "6-311GD"; $g2s_basis_set{"6-311GD "} = "6-311GD"; # as is $g2s_basis_set{"6-311G** "} = "6-311GDP"; $g2s_basis_set{"6-311G(d,p) "} = "6-311GDP"; $g2s_basis_set{"6-311G(D,P) "} = "6-311GDP"; $g2s_basis_set{"6-311GDP "} = "6-311GDP"; # as is $g2s_basis_set{"6-311+G* "} = "6-311+GD"; $g2s_basis_set{"6-311+G(d) "} = "6-311+GD"; $g2s_basis_set{"6-311+G(D) "} = "6-311+GD"; $g2s_basis_set{"6-311+GD "} = "6-311+GD"; # as is $g2s_basis_set{"6-311+G** "} = "6-311+GDP"; $g2s_basis_set{"6-311+G(d,p) "} = "6-311+GDP"; $g2s_basis_set{"6-311+G(D,P) "} = "6-311+GDP"; $g2s_basis_set{"6-311+GDP "} = "6-311+GDP"; # as is $g2s_basis_set{"LANL1DZ "} = "LANL1DZ"; # as is $g2s_basis_set{"LANL2DZ "} = "LANL2DZ"; # as is $g2s_basis_set{"6-31G(2d,p) "} = "6-31G2DP"; $g2s_basis_set{"6-31G2DP "} = "6-31G2DP"; # as is $g2s_basis_set{"6-31G(3d,p) "} = "6-31G3DP"; $g2s_basis_set{"6-31G3DP "} = "6-31G3DP"; # as is $g2s_basis_set{"6-311G(2d,p) "} = "6-311G2DP"; $g2s_basis_set{"6-311G2DP "} = "6-311G2DP"; # as is $g2s_basis_set{"6-311G(3d,p) "} = "6-311G3DP"; $g2s_basis_set{"6-311G3DP "} = "6-311G3DP"; # as is $g2s_basis_set{"6-311+G(2d,p) "} = "6-311+G2DP"; $g2s_basis_set{"6-311+G2DP "} = "6-311+G2DP"; # as is $g2s_basis_set{"6-311+G(3d,p) "} = "6-311+G3DP"; $g2s_basis_set{"6-311+G3DP "} = "6-311+G3DP"; # as is $g2s_basis_set{"SHA_dz "} = "SHA_dz"; $g2s_basis_set{"SHA_tz "} = "SHA_tz"; $g2s_basis_set{"SHA_dz_pol1 "} = "SHA_dz_Pol1"; $g2s_basis_set{"SHA_dz_Pol1 "} = "SHA_dz_Pol1"; # as is $g2s_basis_set{"SHA_tz_pol1 "} = "SHA_tz_Pol1"; $g2s_basis_set{"SHA_tz_Pol1 "} = "SHA_tz_Pol1"; # as is $g2s_basis_set{"SHA_dz_pol2 "} = "SHA_dz_Pol2"; $g2s_basis_set{"SHA_dz_Pol2 "} = "SHA_dz_Pol2"; # as is $g2s_basis_set{"SHA_tz_pol2 "} = "SHA_tz_Pol2"; $g2s_basis_set{"SHA_tz_Pol2 "} = "SHA_tz_Pol2"; # as is #_END definig ------ Gaussian_2_Sharc pairs # #_ Transform Access Permission Spec. in comment -> SHARC code #_ list of allowed permission specifications #------------- %remark2sharc_perm ------- Version of 1996-10-01 -- # see $url_sharc_glo_perm for details # transforming permissions mentioned in the comment to proper SHARC terms $remark2sharc_perm{"test"} = "TEST"; # since 1.2c $remark2sharc_perm{"contributr"} = "CONTRIBUTR"; $remark2sharc_perm{"contributor"} = "CONTRIBUTR"; # as misspell alias $remark2sharc_perm{"private"} = "CONTRIBUTR"; # as alias $remark2sharc_perm{"quitprivat"} = "QUITPRIVAT"; $remark2sharc_perm{"pvrs"} = "QUITPRIVAT"; # as SPECIAL alias $remark2sharc_perm{"group"} = "GROUP_ONLY"; $remark2sharc_perm{"group_only"} = "GROUP_ONLY"; $remark2sharc_perm{"group-only"} = "GROUP_ONLY"; # as misspell alias # === to be replaced when used in other research groups === $remark2sharc_perm{"ccc"} = "GROUP_ONLY"; # as LOCAL alias # === to be replaced when used in other research groups === $remark2sharc_perm{"thumbpeepr"} = "THUMBPEEPR"; $remark2sharc_perm{"thumbpeeper"} = "THUMBPEEPR"; # as misspell alias $remark2sharc_perm{"open_group"} = "OPEN_GROUP"; $remark2sharc_perm{"open-group"} = "OPEN_GROUP"; # as misspell alias $remark2sharc_perm{"open"} = "OPEN_GROUP"; $remark2sharc_perm{"every_body"} = "EVERY_BODY"; $remark2sharc_perm{"every-body"} = "EVERY_BODY"; # as misspell alias $remark2sharc_perm{"everybody"} = "EVERY_BODY"; # as misspell alias $remark2sharc_perm{"all"} = "EVERY_BODY"; # as alias #_END definig ------ Remark_2_Sharc_Perm pairs # if($verbose > 10){$tmp = $remark2sharc_perm{"every-body"}; print "IINI_test: remark2sharc_perm -> SHARC_perm every-body -> $tmp\n"; } # #_ initialize variables $exists_inp = "no"; # if available, check consistence with .out, .jmn $exists_nmr = "no"; # if not available register as ERROR; nmr_program=X $exists_jmn = "no"; # if not available register as WARNING; # $computation_type = "unknown"; $computation_type_identifyer = "empty"; # if 'filled' -> tag//tag $title_text_inp = ""; $title_text_out = ""; $e_runtype = "unknown"; $e_nmr_basis = "unknown"; $e_nmr_basis_code = "unknown"; $e_nmr_potential = "VWN-LSD"; # the default $e_nmr_potential_identifyer = "empty"; # if 'filled' -> tag//tag $e_nmr_method = "unknown"; $e_nmr_program = "unknown"; # $nmr_program_identifyer = "unknown"; $e_geoopt_basis = "unknown"; $e_geoopt_basis_identifyer = "empty"; $e_geoopt_method = "unknown"; # $e_geoopt_method_identifyer = "empty"; # #__ Initialization of the $sharc_xx variables $sharc_errors = "none"; $sharc_warnings = "none"; $sharc_n_atoms = 0; #_ From SYsTEM: $sharc_e_contributor = "nobody"; # the magic value $sharc_e_ident = 0 ; # the magic value #_ From INput: $sharc_text_top = "x"; #_ will be what is left after &comment2key_values $sharc_e_geoopt_method = "undef"; #_ will be assembled from $e_geoopt_method and $e_geoopt_basis $sharc_e_geo_character = "u"; # unknown # #_ From INput or OUTput - if mentioned there: $sharc_e_charge = 100; # the magic value $sharc_e_pointgroup = "U"; # unknown $sharc_e_basis_functions = -1; # the magic value # #_ From OUTput: $sharc_e_nre = -1; # the magic value $sharc_e_tote = 0; # the magic value # #_ From NMR-OUTput: # $value{"1 x"} and $value{"1 XX"} # the coordinates and the NMR tensor # $value{"1 sigma"} # average NMR shielding of the atom # $value{"1 basis"} # the atom basis set $sharc_e_nmrsigma_methd = "unknown"; # assembled from $e_nmr_method / $e_nmr_potential / $e_nmr_basis # #_ initialization for a dummy $sharc_e_formula = "B2C4H3O2"; #$sharc_e_charge = -2; $sharc_text_counter = 0; # $sharc_text[0] = "one more line"; # $sharc_text[1] = "two more Line"; #$sharc_e_ident = 1001; #$sharc_n_atoms = 2; # $value{"1 a_symbol"} = Hi; # foreach $tmp (@sharc_coordinates) { $value{"1 $tmp"} = 0; } # $value{"1 x"} = -0.1; $value{"1 y"} = 2.304007; $value{"1 z"} = +4.5; # $value{"1 sigma"} = 10000.0 ; # # $value{"2 a_symbol"} = Lo; # $value{"2 x"} = 0.1; $value{"2 y"} = -2.304007; $value{"2 z"} = -4.5; # $value{"2 sigma"} = 450.123456789 ; $sharc_e_contributor = "meme"; #$sharc_e_group = "globorb"; # # # array: %tag_content # $tag_content{$tag_name} # List of $tag_name's: # #$tag_content{"NAO_ENE"} = "-0.5 -0.33 \n 0.4 0.09"; #$tag_content{"PROP=WBI"} = "Lue 1.3 8.5# \$ \@ ix\n -- \n more "; #__ SUB_ROUTINES: (START) # if($verbose > 10){print "Loading SUBroutine peep_computation_type \n";} #_ SUBROUTINE sub peep_computation_type { local ($input_fn_trunc) = $_[0]; # argument is the filename # SUB_NAME: peep_computation_type # SUB_AUTHOR: A. Dransfeld # SUB_VERSION: 0.1 1996-09-14 # SUB_FUNCTION: identify the type of ab initio calculation output # by peeping 1) fn.out 2) fn.nmr # RETURNS: $computation_type which may be # demon10 , iglo92 , # and 'global' $sharc_errors $sharc_warnings $fn_inp_main = join("\.",$input_fn_trunc,"out"); $reply = (open (FN_OUT,$fn_inp_main)); # 1) fn.out if($verbose > 12) { print "FiLeNAme $fn_inp_main\n";} if (!$reply) { # .out non_existent or non_readable $tmp = "Missing $fn_inp_main\n$usageline"; $sharc17_entity = $tmp; open (TMP,">$ARGV[0]\.sharc"); print TMP $sharc17_entity; close (TMP); if($verbose > 0) { print "$tmp\n"; die; } else { # exit and leave the note in .sharc exit; } } else { #test print "Flag-peep_computation_type,OUT-1 >$fn_inp_main\< exists\n"; while(<FN_OUT>){ #__ 1a) _DMM_ Look for DeMon ouput identifyers if(/ deMon VERSION 1.0/){ # assuming all 1.0xx to be equal;-> $computation_type = "demon10"; # instead of "unknown" $computation_type_identifyer = $_; if($verbose > 10) {print "Seems to be a $computation_type output \n";} last; # leave the while loop } #__ 1b) _IGLO_ Look for MOLPRO92 ouput identifyers # *** PROGRAM SYSTEM MOLPRO *** # Copyright, University of Sussex, 1991 # <blank line> # Version 92.6 linked 23 Feb 1994 17:23:34 if(/ PROGRAM SYSTEM MOLPRO /) { $_ =~ s/^\s+//; # remove preceeding blanks $tmp = $_; $_ = <FN_OUT>; $_ =~ s/^\s+//; # remove preceeding blanks $tmp = join ("",$tmp,$_); $_ = <FN_OUT>; # skip the blank line $_ = <FN_OUT>; $_ =~ s/^\s+//; # remove preceeding blanks if (/Version 92/) { $computation_type_identifyer = join ("",$tmp,$_); $computation_type = "iglo92"; if($verbose > 10) {print "Seems to be a $computation_type output \n";} last; } } # #_END if(/ PROGRAM SYSTEM MOLPRO /) { #__ 1b) _IGLO_ Look for MOLPRO92 ouput identifyers } # #_END while(<FN_OUT>) { #Add GAUSSIAN if ($computation_type eq "unknown") { $sharc_errors = join("\n",$sharc_errors,"Sorry, Could NOT identify the Program which produced the \.out file\nPlease, Check $url_sharc_glo_prg"); } close (FN_OUT); } # 2) fn.nmr # #_END if $input_file_name could be opened # NMR identifyer: # * M A S T E R - CS * # * ----------------- * # * * # * REALIZED BY : VLADIMIR MALKIN * # * OLGA MALKINA * # * * # * Universite de Montreal * # * Quebec, Canada * # * * # **************************************** # **************************************************** # * VERSIONS : 1) May, 1993 /Basic version / $fn_inp_nmr = join("\.",$input_fn_trunc,"nmr"); $reply = (open (FN_NMR,$fn_inp_nmr)); if($verbose > 12) { print "FiLe-NAmer $fn_inp_nmr\n";} if (!$reply) { # non_existent or non_readable $exists_nmr = "no"; # 'confirme' the default if($verbose > 0) { print "Missing $fn_inp_nmr\n$usageline";} $tmp = "ERROR Missing $fn_inp_nmr\n - NO - NMR evaluation possible \n"; $sharc_errors = join("\n",$sharc_errors,$tmp); } else { $exists_nmr = "yes"; #test print "Flag-peep_computation_type,NMR-1 >$fn_inp_nmr\< exists\n"; while(<FN_NMR>){ if(/ M A S T E R - CS /){ #test print "Flag-peep_computation_type,NMR-2 MAStereD it\n"; $e_nmr_method = "DMM93"; # instead of "unknown" while(<FN_NMR>){ if (/VERSIONS/){ if(/May, 1993 \/Basic version/) { $e_nmr_program = "master93"; # instead of "unknown" if($verbose > 10) {print "Seems to be a $e_nmr_program \.nmr file\n";} last; } } # #_END if (/VERSIONS/){ } # #_END while(<FN_NMR>){ # inner loop last; # top loop after MASTER part analyzed } # #_END if(/ M A S T E R - CS /){ if (/ERROR IN INPUT FILE/) { chop; $tmp = "Warning >$_<"; if($verbose > 0) {print "\n $tmp \n";} $sharc_warnings = join("\nTEXT ",$sharc_warnings,$tmp); $tmp = "Tip: check your \.M file"; if($verbose > 0) {print "\n $tmp \n";} $sharc_warnings = join("\nTEXT ",$sharc_warnings,$tmp); } if (/INCORRECT INPUT OF THE LIST OF MAGNETIC NUCLEI/) { chop; $tmp = "Warning >$_<"; $sharc_warnings = join("\nTEXT ",$sharc_warnings,$tmp); } #__ } # #_END while(<FN_NMR>){ # top loop close (FN_NMR); } # #_END if FN_NMR could be opened # 3) fn.jmn # JMN identifyer: # **************************************** # * * # * * # * M A S T E R - JMN * # * ----------------- * # * * # * REALIZED BY : VLADIMIR MALKIN * # * OLGA MALKINA * # * Universite de Montreal * # * Quebec, Canada * # * * # **************************************** # *************************************************** # * VERSIONS : 1) October, 1993 /Basic version/ # * 2) January, 1994 /Anisotropy / # *************************************************** # $fn_inp_jmn = join("\.",$input_fn_trunc,"jmn"); $reply = (open (FN_JMN,$fn_inp_jmn)); if($verbose > 12) { print "FiLe-NAmEr $fn_inp_jmn\n";} if (!$reply) { # non_existent or non_readable $exists_jmn = "no"; # 'confirme' the default # if($verbose > 0) { print "Warning Missing $fn_inp_jmn\n$usageline"} #_ see evaluate_dmm_jmn } else { $exists_jmn = "yes"; while(<FN_JMN>){ #test print "Flag-peep_computation_type,JMN-1 $_"; if(/ M A S T E R - JMN /){ #test print "Flag-peep_computation_type,JMN-2 JMnAStereD it\n"; $e_jmn_method = "JMN93"; # instead of "unknown" while(<FN_JMN>){ #test print "Flag-peep_computation_type,JMN-3 locking $_"; if (/VERSIONS/){ if(/October, 1993 \/Basic version/) { $e_jmn_program = "masterJMN93"; # instead of "unknown" if($verbose > 10) {print "Seems to be a $e_jmn_program \.nmr file\n";} last; } } # #_END if (/VERSIONS/){ } # #_END while(<FN_JMN>){ # inner loop last; # top loop after MASTERjmn part analyzed } # #_END if(/ M A S T E R - JMN /){ } # #_END while(<FN_NMR>){ close (FN_NMR); } # #_END if FN_NMR could be opened #returned .out data in $computation_type and $computation_type_identifyer #returned .nmr data in $nmr_method and $nmr_program } #_END sub peep_computation_type # ------------------------------ if($verbose > 10){print "Loading SUBroutine peep_user \n";} #_ SUBROUTINE sub peep_user { local ($tmp); open (IN, "whoami|"); $tmp = <IN>; chop($tmp); close(IN); #test print "Flag-peep_user >$tmp\< uses this skript\n"; return $tmp; } #_END sub peep_user # ------------------------------ if($verbose > 10){print "Loading SUBroutine peep_date \n";} #_ SUBROUTINE sub peep_date { local ($format) = $_[0]; local ($tmp); local ($month2nr , $n2nn); # SUB_NAME: peep_date # SUB_AUTHOR: A. Dransfeld # SUB_VERSION: 0.1 1996-10-05 # SUB_FUNCTION: generate a formula with the unix command %>date # Check that _your_ UNIX returns the pattern: Sat Oct 5 11:47:43 MET 1996 # RETURNS: $tmp containing the date in required format # unchanged %>date if required format not known #_ get date open (IN, "date |"); while (<IN>){chop; $tmp = $_; @todate = split;} close(IN); #test print "Flag-peep_date-DATE >$tmp\< \n"; # #%month2nr = ("Jan","01", "Feb","02", "Mar","03", "Apr","04", "May","05", "Jun",06" # , "Jul","07", "Aug","08", "Sep","09", "Oct","10", "Nov","11", "Dec","12"); #_ unfortunately not possible if ($format eq "ISO/R 2014-1971") { #test print "Flag-peep_date ForMAT is $format = ISO =\n"; #__ Initialization of arrays $month2nr{"Jan"} = "01"; $month2nr{"Feb"} = "02"; $month2nr{"Mar"} = "03"; $month2nr{"Apr"} = "04"; $month2nr{"May"} = "05"; $month2nr{"Jun"} = "06"; $month2nr{"Jul"} = "07"; $month2nr{"Aug"} = "08"; $month2nr{"Sep"} = "09"; $month2nr{"Oct"} = "10"; $month2nr{"Nov"} = "11"; $month2nr{"Dec"} = "12"; $n2nn{"1"} = "01"; $n2nn{"2"} = "02"; $n2nn{"3"} = "03"; $n2nn{"4"} = "04"; $n2nn{"5"} = "05"; $n2nn{"6"} = "06"; $n2nn{"7"} = "07"; $n2nn{"8"} = "08"; $n2nn{"9"} = "09"; $n2nn{"10"} = "10"; $n2nn{"11"} = "11"; $n2nn{"12"} = "12"; $n2nn{"13"} = "13"; $n2nn{"14"} = "14"; $n2nn{"15"} = "15"; $n2nn{"16"} = "16"; $n2nn{"17"} = "17"; $n2nn{"18"} = "18"; $n2nn{"19"} = "19"; $n2nn{"20"} = "20"; $n2nn{"21"} = "21"; $n2nn{"22"} = "22"; $n2nn{"23"} = "23"; $n2nn{"24"} = "24"; $n2nn{"25"} = "25"; $n2nn{"26"} = "26"; $n2nn{"27"} = "27"; $n2nn{"28"} = "28"; $n2nn{"29"} = "29"; $n2nn{"30"} = "30"; $n2nn{"31"} = "31"; #test $tmp = $month2nr{"Aug"}; print "Check Mr August $tmp\n"; #_ the 'working equation' $tmp = join("-",($todate[5],$month2nr{$todate[1]},$n2nn{$todate[2]})); } # #_END if ($format eq "ISO/R 2014-1971") { return $tmp; } #_END sub peep_date # ------------------------------ if($verbose > 10){print "Loading SUBroutine generate_formula \n";} #_ SUBROUTINE sub generate_formula { # local $formula_structure = alphabetic / organic local ($formula) ; $formula = ""; # SUB_NAME: generate_formula # SUB_AUTHOR: A. Dransfeld # SUB_VERSION: 0.1 1996-10-02 # SUB_FUNCTION: generate a formula from the atom list # RETURNS: $formula for ($i = 1;$i <= $sharc_n_atoms; $i++) { $atom_symbol = $value{"$i a_symbol"}; $sharc_a_count{$atom_symbol}++; #test print "Flag-generate_formula-sharc_a_count <$a_symbol\> is $sharc_a_count{$a_symbol}\n"; } # #_END for ($i = 1;$i <= $sharc_n_atoms; $i++) { # foreach $atom_symbol (sort(keys %sharc_a_count)) { if ($sharc_a_count{$atom_symbol} > 0) { if($atom_symbol ne "Bq") { # excluding ghost atoms $formula = join("",$formula,$atom_symbol,$sharc_a_count{$atom_symbol}); #test print "Flag-generate_formula-List <$atom_symbol\> occurs $sharc_a_count{$atom_symbol} times\n"; } } # #_END if ($sharc_a_count{$atom_symbol} > 0) { } # #_END foreach $atom_symbol (sort(keys %sharc_a_count)) { return $formula; } #_END sub generate_formula # ------------------------------ if($verbose > 10){print "Loading SUBroutine comment2key_values \n";} #_ SUBROUTINE sub comment2key_values { local ($text) = $_[0]; # argument is the comment line #_ Requires Arrays: # %g2s_basis_set , # SUB_NAME: comment2key_values # SUB_AUTHOR: A. Dransfeld # SUB_VERSION: 0.1 1996-09-15 # SUB_FUNCTION: Evaluate the comment line (= all comments in one line) # RETURNS: everything via 'global' variables # STATEGY: 1) look for point_group spec with substring search # ... and erase this part in $text # @m,@n,@t,@x 2) look for geometry_character spec with substring search # ... and erase this part in $text # 3) look for matching basis -> 3-21G # ... and erase this part in $text # 4) look for geometry spec ( // until [/, ]) # and look for matching method -> RHF, RMP2-FC, RMP2-FU # ... and erase this part in $text # 5) look for permission spec (/shARC/i /perMISSION/i /perM=/i) # ... and erase this part in $text # #test print "Flag-comment2key_values-1 The Comment Line:\n>$text\<\n"; #_1) looking for point_group spec ... and erase #txt2s_point_group foreach $txt_pg (keys %txt2s_point_group){ #test print "Flag-comment2key_values-1a $txt_pg checked \n"; if(index($text,$txt_pg) >= 0 ){ # valid point group keyword #test print "Flag-comment2key_values-1b $txt_pg \n"; $sharc_e_pointgroup = $txt2s_point_group{$txt_pg}; $text =~ s/$txt_pg//; # erase the bs from comment last; } } # #_END foreach $txt_pg (keys %txt2s_point_group){ if($verbose > 12){ print "here VARIABLE_sharc_e_pointgroup is $sharc_e_pointgroup\n";} #test print "Flag-comment2key_values-1c Point Group is $sharc_e_pointgroup\n"; # #_2) looking for matching geometry_character spec ... and erase foreach $tmp ("@m","@n","@t","@x") { #test print "Flag-comment2key_values-2a $tmp checked \n"; if(index($text,$tmp) >= 0 ){ $sharc_e_geo_character = $tmp; # chop of the tag $sharc_e_geo_character =~ s/\@//; # m, n, t or x $text =~ s/$tmp//; # erase the bs from comment last; } } # #_END foreach $tmp ("@m","@n","@t","@x") { if($verbose > 12){ print "here VARIABLE_sharc_e_geo_character is $sharc_e_geo_character\n";} #test print "Flag-comment2key_values-2b Char. is \@$sharc_e_geo_character\n"; #test print "Flag-comment2key_values-2c The _new_ Comment Line:\n>$text\<\n"; # #_3) look for matching geoopt basis ... and erase this part in $text foreach $basis_kw (keys %g2s_basis_set){ #test print "Flag-comment2key_values-3a $basis_kw checked \n"; if(index($text,$basis_kw) >= 0 ){ # valid basis set keyword $e_geoopt_basis = $g2s_basis_set{$basis_kw}; $e_geoopt_basis_identifyer = $basis_kw; #test print "Flag-comment2key_values-3b Identified $basis_kw \n"; #_PATCH_start #test -> make it "&chop_out ($text,$basis_kw)" $txt_i = index($text,$basis_kw); $kw_length = length($basis_kw); #test print "Erase from $txt_i to $x + $kw_length\n"; $txt_head = substr($text,0,$txt_i); #test print "TxtHead $txt_head\n"; $txt_head =~ s/\/$//; # erase / proceeding _bs_ if there was one #test print "TxtHeat $txt_head\n"; $txt_tail = substr($text,($txt_i + $kw_length)); #test print "TxtTail $txt_tail\n"; $text = join(" ",$txt_head,$txt_tail); #_PATCH_end # This $text =~ s/$basis_kw//; # erase the bs from comment # _would_ be nice, ... if it would not do this: # strings with * , + , or ( , ) are not replaced last; } # #_END if(index($text,$basis_kw) >= 0 ){ } # #_END foreach $basis_kw (keys %g2s_basis_set){ if($verbose > 12){ print "here VARIABLE_e_geoopt_basis = $e_geoopt_basis\n";} #test print "Flag-comment2key_values-3b \/\/Method\/$e_geoopt_basis <- $e_geoopt_basis_identifyer\n"; #test print "Flag-comment2key_values-3c The _new_ Comment Line:\n>$text\<\n"; #_4) look for matching geoopt basis ... and erase this part in $text # $_ = $text; # foreach $tmp (keys %g2s_opt_method){ # if (/\/\/$tmp[\/,\s]/i){ # matching "//_mtd_/xx" and "//_mtd_ xx" # } # _would_ be nice IF it would not result in: # ///rmp2(fc[/,\s]/: unmatched () in regexp for $tmp = rmp2\(fc... # 8-< # assuming //_method_/_basis_ or //_method_ /_basis_ or //_method_ _basis_ # to be converted to //_method_ ($txt_head,$txt_tail) = split(/\/\//,$text); #test print "HEAD $txt_head \nTAIL $txt_tail\n"; $txt_tail =~ s/\//\s/; # should no more contain /xx with meaning @parts = split(/[\ \t\n]+/,$txt_tail); # split at one or more blanks #test print "TAIL-0 $parts[0] OF $#parts \n"; $tmp_geo_mtd = $parts[0]; $tmp_geo_mtd =~ tr/A-Z/a-z/; # canonize to small letters # $txt_tail =~ s/$parts[0]//; # erase the _method_ part # Unfortunately not possible #-> /RMP2(FC/: unmatched () in regexp foreach $tmp (keys %g2s_opt_method){ #test print "checking >$tmp\< against >$tmp_geo_mtd\<\n"; if($tmp eq $tmp_geo_mtd) { $e_geoopt_method = $g2s_opt_method{$tmp}; if($verbose > 2){ print "VARIABLE_e_geoopt_method = $e_geoopt_method\n";} last; } } # #_END foreach $tmp (keys %g2s_opt_method){ $txt_new_tail = $parts[1]; for ($i = 2;$i <= $#parts;$i++) { $txt_new_tail = join(" ",$txt_new_tail,$parts[$i]); } #test print "NEW TAIL $txt_new_tail\n"; $text = join("",$txt_head,$txt_new_tail); #_5) look for matching permission spec ... and erase this part in $text $_ = $text; if (/shARC/i || /perMISSION/i || /perM=/i){ $tmp = $'; # split by reg.Expr. in if $txt_head = $`; # heading for reassembling $text #test print "Flag-comment2key_values-5a Post Match:\n>$tmp\<\n"; $tmp =~ s/=/ /; # I SHARC=x_permission is used $tmp =~ s/^\s+//; # elimination of preceeding blanks $txt_tail = $tmp; # tail for reassembling $text $tmp =~ s/\W.*//; # eliminate everything besides the keyword $txt_tail =~ s/$tmp//; # erasing the keyword from the tail #test print "Flag-comment2key_values-5b Keyword:\n>$tmp\<\n"; #test print "Flag-comment2key_values-5x HeAd+TaIl:\n>$txt_head $txt_tail\<\n"; $tmp =~ tr/[A-Z]/[a-z]/; # deCapitalize keyword if(defined $remark2sharc_perm{$tmp}){ # otherwise keep default value $sharc_e_permission = $remark2sharc_perm{$tmp}; } # #_END if(defined $remark2sharc_perm{$tmp}){ if($verbose > 2){ print "VARIABLE_sharc_e_permission: $sharc_e_permission \n";} if ($sharc_e_permission eq "TEST") { $punch = "inactive"; # switch off archiving $tmp = "Warning these results are _NOT SHarchived_ "; if($verbose > 0) {print "\n $tmp \n";} $sharc_warnings = join("\nTEXT ",$sharc_warnings,$tmp); $sharc_warnings = join("\nTEXT ",$sharc_warnings,$tmp); } # #_END if ($sharc_e_permission eq "TEST") { $text = join("",$txt_head,$txt_tail); } #_END if (/shARC/i || /perMISSION/i || ... if($verbose > 12){ print "The _new_ Comment Line:\n>$text\<\n";} return $text; } #_END sub comment2key_values # ------------------------------ if($verbose > 10){print "Loading SUBroutine evaluate_dmm_inp \n";} #_ SUBROUTINE sub evaluate_dmm_inp { local ($input_fn_trunc) = $_[0]; # argument is the filename # SUB_NAME: evaluate_dmm_inp # SUB_AUTHOR: A. Dransfeld # SUB_VERSION: 0.1 1996-09-14 # SUB_FUNCTION: Evaluate - if exist - the input file of a demon10 job # RETURNS: everything via 'global' variables $fn_inp_inp = join("",$input_fn_trunc,"\.inp"); #test print "Flag-evaluate_dmm_inp-1: $fn_inp_inp [default] or $input_fn_trunc \n"; if ((-e $fn_inp_inp) && (-e $input_fn_trunc)) { #test print " fn\.inp prefered\n"; open(DMM_INP,$fn_inp_inp); $exists_inp = "yes"; } else { if (-e $fn_inp_inp) { open(DMM_INP,$fn_inp_inp); $exists_inp = "yes"; #test print " using fn\.inp\n"; } if (-e $input_fn_trunc) { open(DMM_INP,$input_fn_trunc); $exists_inp = "yes"; #test print " using fn\n"; } } if ($exists_inp eq "yes") { while(<DMM_INP>) { chop; # always good # #_ read as many title lines as occur if (/^TITLE/) { $_ = <DMM_INP>; # read comment line = line below TITLE chop; #_not_using $_ =~ s/\s+$//; # erase all preceeding blanks # may cause mistakes if a preceeding blank is required $_ = join("",$_," "); # add one blank at the end #test print "Flag-evaluate_dmm_inp-2a: >$_\< \n"; $_ =~ s/^\s+//; # erase all proceeding blanks $_ =~ s/\s+/ /g; # compress some_blanks to one $title_text_inp = join("",$title_text_inp,$_) ; } if(/^BASIS /){ $nmr_basis = $'; # keyword to be compared with .out } if(/^JMN1/){ # to check against (-e fn.jmn ...) $e_runtype = "jmn"; } } close(DMM_INP); # #_END while(<DMM_INP>) { if($verbose > 12){ print "TitleText_inp: >>$title_text_inp\<<\n";} } else { # neither fn_trunc nor fn_trunc.inp # # should occur only in 'stand alone later evaluation' mode $sharc_warnings = join ("\nTEXT ",$sharc_warnings,"Warning SHARCiving without \.inp file"); } # #_END if {$exists_inp eq "yes") { } #_END sub evaluate_dmm_inp # ------------------------------ if($verbose > 10){print "Loading SUBroutine evaluate_dmm_out \n";} #_ SUBROUTINE sub evaluate_dmm_out { local ($input_fn_trunc) = $_[0]; # argument is the filename # SUB_NAME: evaluate_dmm_out # SUB_AUTHOR: A. Dransfeld # SUB_VERSION: 0.2 1996-10-05 # SUB_FUNCTION: evaluate the main output file # RETURNS: #_ NEXT Vers.: more separate evaluation of "USER INPUT" and "PROGRAM INPUT" $fn_inp_out = join("\.",$input_fn_trunc,"out"); #test print "Flag-evaluate_dmm_out-1: $fn_inp_main \n"; #__ Check _fn_dmm_.out for ERROR messages and warnings if (-e $fn_inp_out){ # should exists in batch mode $dmm_termination = "unknown"; open(DMM_OUT,$fn_inp_out); while(<DMM_OUT>) { #_pro_ERROR-1i __ "Abnormal termination of deMon" if (/Normal termination of deMon/) { $dmm_termination = "normal"; } #_ERROR-1 __ "Abnormal termination of deMon" if (/Abnormal termination of deMon/) { $tmp = "ERROR >Abnormal termination of deMon<"; $tmp = join("\n",$tmp,"(-8 guru meditation required 8-) \n"); $sharc_errors = join("\n",$sharc_errors,$tmp); if($verbose > 0) {print "ERR-1 $tmp\n";} # last; } #_ERROR-2 __ "Too many atoms" if (/Too many atoms/) { $tmp = "ERROR >Too many atoms\<"; $tmp = join("\n",$tmp,"Implementation is too small\n"); $sharc_errors = join("\n",$sharc_errors,$tmp); #test print "Flag-evaluate_dmm_out-errors_ShaRC_errORS >$sharc_errors\<\n"; if($verbose > 0) {print "ERR-2 $tmp\n";} # last; } #_ERROR-3 __ "THE CHARGE AND MULTIPLICITY DO NOT MAKE SENSE" if (/THE CHARGE AND MULTIPLICITY DO NOT MAKE SENSE/){ $tmp = "ERROR >THE CHARGE AND MULTIPLICITY"; $tmp = join("\n",$tmp,"\t\tDO NOT MAKE SENSE<"); # # additionally check for attempts to do triplett NMR calculow $sharc_errors = join("\n",$sharc_errors,$tmp); if($verbose > 0) {print "ERR-3 $tmp\n";} # last; } #_WARNING-1 __ if (/SCF TERMINATED/) { $tmp = "Warning >SCF TERMINATED<"; $tmp = join("\n",$tmp,"NO SCF CONVERGENCE in Demon Part"); $tmp = join("\n",$tmp," Please try with a different "); $tmp = join("\n",$tmp,"(e.g. smaller) MIXING PARAMETER "); $sharc_warnings = join("\nTEXT ",$sharc_warnings,$tmp); if($verbose > 0) {print "$tmp\n";} # last; } #_WARNING-2 __ if (/TOO MANY ITERATIONS FOR THE DIIS SUBROUTINE/) { chop; $tmp = "Warning >$_<"; $sharc_warnings = join("\nTEXT ",$sharc_warnings,$tmp); if($verbose > 0) {print "$tmp\n";} # last; } } # #_END_first_while(<DMM_OUT>) { # "Find ERR and WARN loop" #_ERROR-1i = induced by absence of "Abnormal termination of deMon" if ($dmm_termination eq "unknown") { $tmp = "ERROR >NoN Normal termination of deMon<"; $sharc_errors = join("\n",$sharc_errors,$tmp); if($verbose > 0) {print "ERR-1i $tmp\n";} } # seek(DMM_OUT,0,0); # rewind to start of file # #__ peeling the comment line out of the .out file #_ pattern: # USER INPUT: ================================================================ # # H2C=CH2 //RMP2-FC/6-31GD planar potential=PERDew # # und ne zweite line # # Ne dritte, weils soschoen ist # # GENERAL ORBITAL BASIS SET IS DZVP # GENERAL AUXILIARY BASIS SET IS A1 # INPUT IN CARTESIAN COORDINATES AND ANGSTROMS # CHARGE OF THE SYSTEM = 0 while(<DMM_OUT>) { #test print "Flag-evaluate_dmm_out-2: $_"; chop; # always good if(/USER INPUT: ========/) { $title_text_out = ""; while(<DMM_OUT>) { chop; # always good #_ any pattern invoked by a keyword as terminator: if(/GENERAL ORBITAL/ || /GENERAL AUXILIARY/ || /INPUT IN CARTESIAN/ || /INPUT IN ZMATRIX FORM AND ANGSTROMS/ || /CHARGE OF THE SYSTEM/ || /DIRECT SCF SCHEME TO BE USED/) { last; } if($_ ne "") { $_ = join("",$_," "); # add one blank at the end $_ =~ s/^\s+//; # erase all proceeding blanks $_ =~ s/\s+/ /g; # compress some_blanks to one $title_text_out = join("",$title_text_out,$_) ; } # #_END if(/GENERAL ORBITAL/ || /GENERAL AUX... } # #_END while(<DMM_OUT>) { # inner loop } # #_END if(/USER INPUT: ========/) { # The USER INPUT section may occure twice in .out # if a part starting with # * M A S T E R * # * * # * VERSION 3 May 1993 * # is appended to the regular DeMon .out # ... therefore if (/PROGRAM INPUT: =====/) { last; # prevents reading it a second time } # #_END if (/PROGRAM INPUT: =====/) { } # #_END_second_while(<DMM_OUT>) { # "peeling out coment" loop # isolated loop required because there is no inambiguous 'end tag' if($verbose > 12){ print "TitleText_out: >>$title_text_out\<<\n";} #__ Evaluate the comment line if($title_text_inp eq "") { # because no input file available if($title_text_out ne "") { # if no comment line allowed by prg $sharc_text_orig = $title_text_out; $sharc_text_top = &comment2key_values ($title_text_out); } else { # leave all values = default values } } else { if ($title_text_inp eq $title_text_out) { $sharc_text_orig = $title_text_out; $sharc_text_top = &comment2key_values ($title_text_out); } else { $tmp = "Warning The comment line has been manipulated"; $sharc_warnings = join("\nTEXT ",$sharc_warnings,$tmp); if($verbose > 1) {print " - - $tmp\n";} $tmp = "(either in the input or the output file )"; $sharc_warnings = join("\nTEXT ",$sharc_warnings,$tmp); if($verbose > 1) {print " - - $tmp\n";} # # if($title_text_out ne "") { $tmpx = "CommentLine from $fn_inp_out is used"; $sharc_text_orig = $title_text_out; $sharc_text_top = &comment2key_values ($title_text_out); } else { $tmpx = "CommentLine from the input file is used"; $sharc_text_orig = $title_text_inp; $sharc_text_top = &comment2key_values ($title_text_inp); } $sharc_warnings = join("\nTEXT ",$sharc_warnings,$tmpx); if($verbose > 1) {print " - - $tmpx\n";} } } #_ Results from commnt line evaluation: if($verbose > 2){ print "VARIABLE_sharc_text_top = >$sharc_text_top\<\n";} if($verbose > 2){ print "VARIABLE_e_geoopt_basis = >$e_geoopt_basis\<\n";} if($verbose > 12){ print "VARIABLE_e_geoopt_basis_identifyer = >$e_geoopt_basis_identifyer\<\n";} # seek(DMM_OUT,0,0); # rewind to start of file # while(<DMM_OUT>) { chop; # always good #__ Reading "USER INPUT: ========" and "PROGRAM INPUT: =====" section if(/USER INPUT: ========/) { while(<DMM_OUT>) { # reading line by line chop; # always good #_ reading general basis sets: if (/GENERAL ORBITAL BASIS SET IS/) { $_ = $'; # postmatch contains basis set name # chop; # would be too much chopping.-O #test print "Flag-evaluate_dmm_out-2 General_Bas >$'\< .inp KeyWord >$nmr_basis\<\n"; $_ =~ s/^\s+//; # remove preceeding blanks and \n $_ =~ s/\s+$//; # remove proceeding blanks and \n if(defined $bas_kw2code{"$_"}) { $e_nmr_basis = $bas_kw2code{"$_"}; $e_nmr_basis_code = $bas_kw2code{"$_"}; if($verbose > 2){ print "Transformation: $_ -> $e_nmr_basis = e_nmr_basis\n";} } #_else leave the default $e_nmr_basis = "unknown" #test print "Flag-evaluate_dmm_out-2 E_NMR_BASIS $e_nmr_basis CODING $_\n"; # # mixed basis sets ? other basis sets / gen basis sets } # ignore /INPUT IN CARTESIAN COORDINATES AND ANGSTROMS/ # because .out coordinates are always in bohr if (/CHARGE OF THE SYSTEM = (\s*\-*\d+)/) { $sharc_e_charge = $1; $sharc_e_charge =~ s/\s+//g; # eliminate blanks #test print "Flag-evaluate_dmm_out-3a Charge >$sharc_e_charge\<\n"; # second value from PROGRAM INPUT: == overwrites USER INPUT: == value.-) } if (/MULTIPLICITY OF THE SYSTEM/) { $e_multiplicity = $_; #test print "Flag-evaluate_dmm_out-3b Multiplicity $e_multiplicity"; # REM no addit. parsing of $e_multiplicity since program checks consistency } # 0) input keyword: any # .out: VWN-LSD CALCULATION # sharc_code ($e_nmr_potential) -----------> VWN-LSD # 1) input keyword: POTENTIAL VWN # .out: USING DEFAULT VWN-LSD CALCULATION -> identifyer # +out: VWN-LSD CALCULATION (ignored) # sharc_code ($e_nmr_potential) -----------> VWN-LSD # 2) input keyword: POTENTIAL PERD # .out: PERDEW EXCHANGE/PERDEW CORRELATION # +out: PERDEW EXCHANGE/PERDEW CORRELATION -> identifyer # sharc_code ($e_nmr_potential) -----------> Pec # 4) input keyword: POTENTIAL MIXP # .out: BECKE EXCHANGE/PERDEW CORRELATION ENERGY WITH VWN POTENTIAL # +out: BECKE EXCHANGE/PERDEW CORRELATION ENERGY WITH VWN POTENTIAL -> ident. # sharc_code ($e_nmr_potential) -----------> PecVWN # 3) input keyword: POTENTIAL BECKE # .out: BECKE EXCHANGE/PERDEW CORRELATION # +out: BECKE EXCHANGE/PERDEW CORRELATION -> identifyer # sharc_code ($e_nmr_potential) -----------> BePc # 5) input keyword: POTENTIAL MIXB # .out: BECKE EXCHANGE/PERDEW CORRELATION ENERGY WITH VWN POTENTIAL -> ident. # +out: VWN-LSD CALCULATION (ignored) # sharc_code ($e_nmr_potential) -----------> BePcVWN #_ Until here according to manual # 6) input keyword: POTENTIAL PW91 # .out: PERDEW-WANG-91 EXCHANGE/CORRELATION # sharc_code ($e_nmr_potential) -----------> PWec91 # _ _ _ _ # while(<DMM_OUT... #- 0) if(/USING DEFAULT VWN-LSD CALCULATION/) { #- 1) # print "1) VWNnnnn -> VWN-LSD \n"; $e_nmr_potential = "VWN-LSD"; $e_nmr_potential_identifyer = $_; } if(/PERDEW EXCHANGE\/PERDEW CORRELATION/) { # 2+4) if(!/ENERGY WITH VWN POTENTIAL/) { #- 2) #print "2) Perwennnnn -> Pec \n"; $e_nmr_potential = "Pec"; $e_nmr_potential_identifyer = $_; } else { if(/ENERGY WITH VWN POTENTIAL/) { #- 4) # print "4) PerVau -> PecVWN \n"; $e_nmr_potential = "PecVWN"; $e_nmr_potential_identifyer = $_; } } } if(/BECKE EXCHANGE\/PERDEW CORRELATION/) { #- 3+5) if(!/ENERGY WITH VWN POTENTIAL/) { #- 3) #print "3) Bee Pee -> BePc \n"; $e_nmr_potential = "BePc"; $e_nmr_potential_identifyer = $_; } else { if (/ENERGY WITH VWN POTENTIAL/) { #- 5) #print "5) BePeVau -> BePcVWN \n"; $e_nmr_potential = "BePcVWN"; $e_nmr_potential_identifyer = $_; } } } if(/PERDEW-WANG-91 EXCHANGE\/CORRELATION/) { #- 6) #print "6) PW91 -> PWec91 \n"; $e_nmr_potential = "PWec91"; $e_nmr_potential_identifyer = $_; } # #_ pattern: # Z-MATRIX IN ATOMIC UNITS (ANGSTROMS): # --> take coordinates from .mnr # _or_ #_ pattern: # INPUT GEOMETRY IN BOHRS # X Y Z # # 1 C COORDINATE 0.0000000 0.0000000 1.2628512 CHARGE 6.00 # 2 C COORDINATE 0.0000000 0.0000000 -1.2628512 CHARGE 6.00 # 3 H COORDINATE 0.0000000 1.7446426 2.3404658 CHARGE 1.00 #_ read coordinates in bor = probably for checking coordinates from .nmr # in Subroutine evaluate_dmm_out if (/INPUT GEOMETRY IN BOHRS/) { $tmp_coordinate_lines = 0; while(<DMM_OUT>) { # reading line by line chop; # always good if ($_ eq "") { #test print "blank line\n"; if ($tmp_coordinate_lines > 0) { $sharc_n_atoms = $tmp_coordinate_lines; if($verbose > 12) { print "VARIABLE_sharc_n_atoms $sharc_n_atoms\n";} last; } } if (/COORDINATE/) { $tmp_coordinate_lines++; #test print "Flag-evaluate_dmm_out-COORDINATE $tmp_coordinate_lines $_"; @words = split; #test_start #test print "WoRDs $words[1] $words[4] $words[5] $words[6]\n"; #test $tmp_x = $bohr * $words[4]; $tmp_y = $bohr * $words[5]; #test $tmp_z = $bohr * $words[6]; print "TMp_XYZ $tmp_x $tmp_y $tmp_z\n"; #test_end $a_label = $words[1]; $value{"$a_label x"} = $bohr * $words[4]; $value{"$a_label y"} = $bohr * $words[5]; $value{"$a_label z"} = $bohr * $words[6]; } } #_END while } #_ skipp the rest of the section if(/DISTANCE MATRIX IN ANGSTROMS/) { # somewhat end tag if($verbose > 2) { print "VARIABLE_nmr_potential: $e_nmr_potential\n";} if($verbose > 12){ print "VARIABLE_nmr_potential_identifyer:\n>$e_nmr_potential_identifyer\<\n";} last; # nothing interesting until == SCF CALC.. } } } # #_END if(/USER INPUT: ========/) { ... while(<..>) { #__ Reading the post "===== SCF CALCULATION =====" section # EXCHANGE-CORRELATION ENERGY IS CALCULATED BY NUMERICAL INTEGRATION # # USING ATOMIC GRID POINTS # # ATOM # 1 HAS 1450 GRID POINTS # ATOM # 2 HAS 1450 GRID POINTS if(/== SCF CALCULATION ==/) { while(<DMM_OUT>) { # MARK-SCF # reading line by line chop; # always good # ----- ELECTRONIC ENERGY ----- = -111.994726484198 # ----- NUCLEAR-REPULSION ENERGY ----- = 33.295084174712 #-> NRE xxx according to MIME,1995-05-21 # ----- TOTAL ENERGY ----- = -78.699642309486 #-> TOTE xxx according to MIME,1995-05-21 # if(/----- ELECTRONIC ENERGY ----- =/) { # # ignored # } if(/----- NUCLEAR-REPULSION ENERGY ----- =/) { $sharc_e_nre = sprintf("%.8f",$'); #test print "NREx $sharc_e_nre\n"; } if(/----- TOTAL ENERGY ----- =/) { $sharc_e_tote = sprintf("%.8f",$'); #test print "TOTEx $sharc_e_tote\n"; } # Some section may occure twice in .out # if a part starting with # * M A S T E R * # * * # * VERSION 3 May 1993 * # is appended to the regular DeMon .out # ... therefore it has to be prevented to read there parts twice #__ tagbox Prototype #_ putting everything # between start_tag = "USING...(incl.1st line)" # and end_tag = "CYCLE" into a tag box if(/EXCHANGE-CORRELATION POTENTIAL AND ENERGY ARE FITTED/) { $tag_name = "ECP_FIT"; if (defined $tag_content{"$tag_name"}) { # # do not read again #test print "Flag-evaluate_dmm_out-TAGBOXX $tag_name ReOccURED\n"; } else { $content = join("",$_,"\n"); # unchop while(<DMM_OUT>) { # MARK-TAG # reading lines until end tag chop; # always good if(/CYCLE/) { # 'end tag' if($verbose > 11){ print "TaGbox: $tag_name\n";} if($verbose > 20){ print "TaGbox ConTains: \n$content";} $tag_content{"$tag_name"} = $content; $tag_name = ""; # reset tag_name last; } else { # fill the tag box if ($_ ne "") { # no blank lines $content = join("",$content,$_,"\n"); #test print "Flag-evaluate_dmm_out-TAGBOX ECP_FIT $content"; } } # #_END if(/CYCLE/) { } # #_END while(<DMM_OUT>) { # MARK-TAG } # #_END if (defined $tag_content{"$tag_name"}) { } # #_END if(/USING ATOMIC GRID POINTS/) { } # #_END while(<DMM_OUT>) { # MARK-SCF } # #_END if(/== SCF CALCULATION ==/) { } # #_END _third_ while(<DMM_OUT>) { close (<DMM_OUT>); } # #_END if (-e $fn_inp_out){ } #_END sub evaluate_dmm_out # ------------------------------ if($verbose > 10){print "Loading SUBroutine evaluate_dmm_nmr \n";} #_ SUBROUTINE sub evaluate_dmm_nmr { local ($input_fn_trunc) = $_[0]; # argument is the filename # SUB_NAME: evaluate_dmm_out # SUB_AUTHOR: A. Dransfeld # SUB_VERSION: 0.3 1996-10-03 # SUB_FUNCTION: # RETURNS: if ($exists_nmr eq "no") { # info from peep_computation_type $tmp = "Error peep_computation_type says NO \.nmr file available"; if($verbose > 0) {print "\n $tmp \n";} $sharc_errors = join("\n",$sharc_errors,$tmp); return; } else { $fn_inp_nmr = join("\.",$input_fn_trunc,"nmr"); open (FN_NMR,$fn_inp_nmr); if($verbose > 12) { print "FiLe-NAmER $fn_inp_nmr IS OPEN\n";} # Analyzing this form of data: # NMR SHIELDING TENSOR FOR Carbon (NUCLEUS NUMBER = 42) # or # NMR SHIELDING TENSOR FOR CARBON (NUCLEUS NUMBER = 42) # at X = 0.000000 Y = 0.000000 Z = 1.262851 # # NMR SHIELDING CONSTANT = 54.5 # # *** NMR TENSORS IN GENERAL AXES *** # # D 252.0 0.0 0.0 0.0 256.5 0.0 0.0 0.0 261.6 # P0 83.6 0.0 0.0 0.0 42.8 0.0 0.0 0.0 65.9 # P1 -161.2 0.2 0.0 0.2 -363.8 -0.1 0.0 0.0 -273.9 # SUM 174.4 0.2 -0.1 0.2 -64.6 -0.1 -0.1 0.0 53.7 # $tmp_nmr_lines = 0; # for changing $sharc_n_atoms if req. while (<FN_NMR>) { if (/NMR SHIELDING TENSOR FOR (.+) \(NUCLEUS NUMBER =(\s*\d+)\)/) { $atom_name = $1; $a_label = $2; $atom_name =~ s/\s+//g; # eliminate blanks $a_label =~ s/\s+//g; # eliminate blanks $tmp_nmr_lines++; # for changing $sharc_n_atoms if req. #test print "Flag-evaluate_dmm_out-InDX $a_label\n"; #test print "Flag-evaluate_dmm_out-AtomNaMe >$atom_name\<\n"; #_ replace atom_name by atom_symbol $atom_name_orig = $atom_name; $atom_name =~ tr/a-z/A-Z/; # canonize to capital letters if (defined $a_symbol{"$atom_name"}) { $tmp = $a_symbol{"$atom_name"}; } else { $tmp = $atom_name; } #test print "Flag-evaluate_dmm_out-SYMBool $tmp\n"; if ($verbose > 12) {print "Transformation: $atom_name_orig -> $tmp\n";} $value{"$a_label a_symbol"} = $tmp; $tmp_lines = 0; #_for security while (<FN_NMR>) { $tmp_lines++; #_for security # at X = 0.000000 Y = 0.000000 Z = 1.262851 #_ compare with coordinates from .out file ... if defined # No cartesian coordinates from .out if Z-Matrix input $value{"$i x"} undef. # $value{"$a_label x"} = $bohr * $words[4]; if (/at X = (\s*\-*\d+\.\d+) Y = (\s*\-*\d+\.\d+) Z = (\s*\-*\d+\.\d+)/) { $tmp_x = $1; $tmp_y = $2; $tmp_z = $3; #test print "Flag-evaluate_dmm_out-NMR_raw_CooRdinates X $tmp_x Y $tmp_y Z $tmp_z\n"; $tmp_coord{"x"} = $tmp_x * $bohr; $tmp_coord{"y"} = $tmp_y * $bohr; $tmp_coord{"z"} = $tmp_z * $bohr; #test print "Flag-evaluate_dmm_out-NMR_CooRdinates X $tmp_x Y $tmp_y Z $tmp_z\n"; for ($i = 0;$i < 3;$i++) { $j = $sharc_coordinates[$i]; # loop over x,y,z $tmp_new = $tmp_coord{"$j"}; if (defined $value{"$a_label $j"} ) { #_ take old $value{"$i x"} $tmp_old = $value{"$a_label $j"}; #test print "Flag-evaluate_dmm_out-NMR_Compare $j new $tmp_new old $tmp_old\n"; } else { $value{"$a_label $j"} = $tmp_coord{"$j"}; $sharc_n_atoms = $tmp_nmr_lines; # last = valid #test print "Flag-evaluate_dmm_out-NMR_Replace $j old by new $tmp_new\n"; } } # #_END for ($i = 0;$i < 3;$i++) { } # #_END if (/at X =/) { if (/NMR SHIELDING CONSTANT =/) { # # read sigma scalar @tmp_sigma = split; # split(/\s/,$_) $value{"$a_label sigma"} = $tmp_sigma[5]; if($verbose > 12){ print "VALUE_\< $a_label , sigma \> is $tmp_sigma[5]\n";} } # #_END if (/NMR SHIELDING CONSTANT =/) { if (/SUM/) { @tmp_sigma = split; # split(/\s/,$_) #_ read sigma tensor elements #test print "TenSor\n"; #$j = 4 => XX, 5 = XY etc. for ($i=2;$i<11;$i++) { $j = 2 + $i; if($verbose > 22){print "#vAlu $sharc_coordinates[$j] $tmp_sigma[$i]";} $value{"$a_label $sharc_coordinates[$j]"} = $tmp_sigma[$i]; } if($verbose > 22){print "\n";} last; } # #_END if (/SUM/) { if ($tmp_lines > 20) { $tmp = "Error Missing >SUM< in the $a_label th Sigma tensor block"; if($verbose > 0) {print "\n $tmp \n";} $sharc_errors = join("\n",$sharc_errors,$tmp); last; } # #_END if ($tmp_lines > 20) { } # #_END while (<FN_NMR>) { # inner loop } # #_END if (/NMR SHIELDING TENSOR/) { } # #_END while (<FN_NMR>) { # outmost loop } # #_END if ($exists_nmr eq "no") { ...} else { } # ------------------------------ if($verbose > 10){print "Loading SUBroutine evaluate_dmm_jmn \n";} #_ SUBROUTINE sub evaluate_dmm_jmn { local ($input_fn_trunc) = $_[0]; # argument is the filename # SUB_NAME: evaluate_dmm_out # SUB_AUTHOR: A. Dransfeld # SUB_VERSION: 0.1 1996-09-14 # SUB_FUNCTION: # RETURNS: if ($exists_jmn eq "no") { # info from peep_computation_type # # $reply = (open (FN_NMR,$fn_inp_nmr)); if ($e_runtype eq "jmn") { # info from peep_computation_type $tmp = "Warning NO \.jmn file despite the keyword JMN was found in \.inp"; $sharc_warnings = join("\nTEXT ",$sharc_warnings,$tmp); if($verbose > 0) {print "\n $tmp \n";} } #else return without comment return; } else { $fn_inp_jmn = join("\.",$input_fn_trunc,"jmn"); open (FN_JMN,$fn_inp_jmn); if($verbose > 12) { print "FiLe-NAmEr $fn_inp_jmn IS OPEN\n";} # Analyzing this form of data: # CARBON # 2 --> LITHIUM # 1 # # MO# rho(Alpha) /a.u./ rho(Beta) /a.u./ Contribution to FC /Hz/ # ----------------------------------------------------------------------------- # 1 0.0000007 0.0000035 -0.20 # 2 6.2658711 6.2659701 -7.35 # 3 0.0062330 0.0063801 -10.91 # 4 0.0000000 0.0000000 0.00 # 5 0.0000000 0.0000000 0.00 # 6 0.1470836 0.1455509 113.74 # ----------------------------------------------------------------------------- # Sum 95.28 # while (<FN_JMN>) { # if(/-->/){ # CARBON # 2 --> LITHIUM # 1 if(/(\s+.+\s+)#(\s*\d+) -->(\s+.+\s+)#(\s*\d+)/) { #test print "Flag-evaluate_dmm_jmn-1 >$1\< >$2\< >$3\< >$4\<\n"; $tmp_one = $2; $tmp_two = $4; $tmp_one =~ s/\s//g; $tmp_two =~ s/\s//g; #test print "Flag-evaluate_dmm_jmn-2 >$tmp_one\< -> >$tmp_two\<\n"; while (<FN_JMN>) { if(/Sum/){ @tmp = split; $jmn_value{"$tmp_one $tmp_two"} = $tmp[2]; if($verbose > 12){ print "VARIABLE_jmn_value >$tmp_one $tmp_two\< is $tmp[2]\n";} last; } } # #_END while (<FN_JMN>) { } # #_END if(/-->/){ } # #_END while (<FN_JMN>) { close (FN_JMN); } # #_END if ($exists_jmn eq "no") { } #_END sub evaluate_dmm_out # ------------------------------ if($verbose > 10){print "Loading SUBroutine assemble_mix_basis \n";} #_ SUBROUTINE sub assemble_mix_basis { local ($nmr_program) = $_[0]; # program which did the job # $e_nmr_program e.g. master93 , local ($input_fn_trunc) = $_[1]; # job name # SUB_NAME: assemble_mix_basis # SUB_AUTHOR: A. Dransfeld # SUB_VERSION: 0.2 1996-10-04 # SUB_FUNCTION: analyze basis set descriptiono # in output of dmon10 #Add iglo92 # RETURNS: $e_basis # = _std._name_ standard , # = MIX-i mix, # = LOCAL local basis sets. # GENERATES: $value{"i basis"} # atomic basis set specifications # if all $value{"1 basis"} are equal -> standard basis sets # if all $value{"1 basis"} # of equal atoms are equal -> mix basis sets # tag_box containing basis set specification $all_equal = "unknown"; #test print "Flag-assemble_mix_basis-0_NMR_PROGRAM $nmr_program JobName $input_fn_trunc\n"; if ($nmr_program eq "demon10") { # pattern: # ORBITAL BASIS SET: O-LITHIUM (621/1*/1+) FOR ATOM: 1 # ORBITAL BASIS SET: O-CARBON iii_iglo FOR ATOM: 2 $all_equal = "general"; # switch to "no" if same atom has different basises # switch to "mix" if different atoms have different general_basis $fn_inp_out = join("\.",$input_fn_trunc,"out"); #test print "Flag-assemble_mix_basis-DMM-1.1 $fn_inp_out \n"; open (FN_OUT,$fn_inp_out); if($verbose > 12) { print "FiLe-NAmEr $fn_inp_jmn IS OPEN\n";} #_ putting everything (ignoring blanks) # between start_tag = "ORBITAL BASIS SET: O-" # and end_tag = "CYCLE" into a tag box $tag_name = "BASIS_SET"; $content = ""; while (<FN_OUT>) { # if (/ORBITAL BASIS SET: O-(.+\s) ??? FOR ATOM: (\d+)/) { # ... } would be nice if (/ORBITAL BASIS SET: O-/) { #test print "Flag-assemble_mix_basis-DMM-1.2 $_"; chop; @words = split; $content = join("",$content,$_,"\n"); # unchop #test print "Flag-assemble_mix_basis-DMM-1.3 $words[4] $words[5] $words[8]\n"; $tmp_a_name = $words[4]; $tmp_a_name =~ s/O-//; $tmp_a_name =~ tr/a-z/A-Z/; # canonize to capital letters $tmp_a_basis = $words[5]; $tmp_a_label = $words[8]; #test print "Flag-assemble_mix_basis-DMM-1.4 A_NAme >$tmp_a_name\< >$tmp_a_basis\< >$tmp_a_label\<\n"; #_ Basis set coding ... if possible if (defined $e_nmr_bax{"$tmp_a_basis"} ) { $value{"$tmp_a_label a_basis"} = $e_nmr_bax{"$tmp_a_basis"}; #test $tmp = $e_nmr_bax{"$tmp_a_basis"}; #test print "Flag-assemble_mix_basis-DMM-1.4a >$tmp_a_basis\< -coded-> >$tmp\<\n"; } else { $value{"$tmp_a_label a_basis"} = $tmp_a_basis; #test print "Flag-assemble_mix_basis-DMM-1.4b >$tmp_a_basis\< unchanged\n"; } # #_END if (defined $e_nmr_bax{"$tmp_a_basis"} ) { #_ Look for a general basis set for each atom type if (defined $tmp_general_basis{"$tmp_a_name"} ) { #compare if ($tmp_general_basis{"$tmp_a_name"} ne $tmp_a_basis) { $all_equal = "no"; # locally dense basis functions #test $tmp = $tmp_general_basis{"$tmp_a_name"}; #test print "Flag-assemble_mix_basis-DMM-1.5 BaSissS MISSmatch >$tmp not= $tmp_a_basis\<\n"; } } else { $tmp_general_basis{"$tmp_a_name"} = $tmp_a_basis; $general_basis = $tmp_a_basis; # last = guess for general bas #test print "Flag-assemble_mix_basis-DMM-1.5 init_BaSisS >$tmp_a_name has $tmp_a_basis\<\n"; } # #_END if (defined $tmp_general_basis{"$tmp_a_name"} ) { } # #_END if (/ORBITAL BASIS SET: O-/) { # outmost loop # NUMBER OF AUXILIARY FUNCTIONS FOR DENSITY FIT = 95 # NUMBER OF AUXILIARY FUNCTIONS FOR EXCHANGE FIT = 95 if (/NUMBER OF ORBITAL BASIS FUNCTIONS = (\s+\d+)/) { $sharc_e_basis_functions = $1; $sharc_e_basis_functions =~ s/\s+//; } # #_END if (/NUMBER OF ORBITAL BASIS FUNCTIONS = (\s+\d+)/) { if (/NUMBER OF PRIMITIVE GAUSSIANS/) { last; # stop reading } } # #_END while (<FN_OUT>) { close (FN_OUT); $tag_content{"$tag_name"} = $content; } # #_END if ($nmr_program eq "master93") { if ($nmr_program eq "iglo92") { # pattern: $all_equal = "general"; # switch to "mix" if different atoms have different general_basis # switch to "no" if same atom has different basises #test print "Flag-assemble_mix_basis-IGLO-0 \n"; $fn_inp_out = join("\.",$input_fn_trunc,"out"); #Add analysis of iglo basis spec. } # #_END if ($nmr_program eq "iglo92") { # #_ until here the program specific SR should have determined: # $all_equal , $general_basis (a guess) and %tmp_general_basis{} # steps 1) all_equal = unkn. -> no change # 2) all_equal = no -> return with e_basis=LOCAL #test print "Flag-assemble_mix_basis-2_EvaL \nALL_EQUAL >$all_equal\<\nGenERal BasIS >$general_basis\<\n"; #_ 1) _unknown_ if ($all_equal eq "unknown") { # because no program specific SR evaluation possible #test print "Flag-assemble_mix_basis-2.1_RETURn with No changes \n"; $e_basis = "unknown"; #test print "Flag-assemble_mix_basis-2.1 RETuRN E_BaSiss >$e_basis\<\n"; return $e_basis; } #_ 2) _unknown_ if ($all_equal eq "no") { $e_basis = "LOCAL"; #test print "Flag-assemble_mix_basis-2.2 RETuRN E_BaSiss >$e_basis\<\n"; return $e_basis; } else { # = if ($all_equal ne "no") { #_ differenciate between "general" and "mix" #test print "Flag-assemble_mix_basis-2.3 is >$general_basis\< really general \? \n"; foreach $a_name (sort(keys %tmp_general_basis)) { $tmp = $tmp_general_basis{$a_name}; #test print "Flag-assemble_mix_basis-2.3a AtM >$a_name\< allBaS >$tmp\<\n"; if ($tmp ne $general_basis) { $all_equal = "mix"; #test print "Flag-assemble_mix_basis-2.3x >$tmp\< MisMAtches >$general_basis\<\n"; #test print "Flag-assemble_mix_basis-2.3z_not_ALL_EqUaL => >$all_equal\<\n"; } #_ELSE $all_equal remains "general" # #_END if ($tmp ne $general_basis) { } # #_END foreach $a_name (sort(keys %tmp_general_basis)) { } # #_END if ($all_equal eq "no") { else ne "no" #_ #test print "Flag-assemble_mix_basis-2.4_Switch \naLL_EQUAL >$all_equal\<\ngenERal BasIS >$general_basis\<\n"; #_ == general == if ($all_equal eq "general") { #test print "Flag-assemble_mix_basis-2.4a_GENERAL is >$general_basis\<\n"; if (defined $e_nmr_bax{"$general_basis"} ) { $e_basis = $e_nmr_bax{"$general_basis"}; #test $tmp = $e_nmr_bax{"$general_basis"}; #test print "Flag-assemble_mix_basis-2.4b\nGernerAl_BaSiss >$general_basis\< -coded-> >$tmp\<\n"; } else { $e_basis = "NGB"; # new general basis #test print "Flag-assemble_mix_basis-2.4c\nGernerAl_BaSiss >$general_basis\< is a new General Basis\n"; } # #_END if (defined $e_nmr_bax{"$tmp_a_basis"} ) { #test print "Flag-assemble_mix_basis-2.4aa SHaRC_E_BaSiss >$e_basis\<\n"; return $e_basis; } # #_END if ($all_equal eq "general") { #_ == mix == if ($all_equal eq "mix") { #test print "Flag-assemble_mix_basis-2.4b MIXed BaSIS \n"; $e_basis = "MIX-i"; # find out the i manually #test print "Flag-assemble_mix_basis-2.4bb RETuRN E_BaSiss >$e_basis\<\n"; return $e_basis; } # #_END if ($all_equal eq "mix") { } #_END sub assemble_mix_basis # ------------------------------ if($verbose > 10){print "Loading SUBroutine assemble_sharc_entry \n";} #_ SUBROUTINE sub assemble_sharc_entry { local ($entity); # # SUB_NAME: assemble_sharc_entry # SUB_AUTHOR: A. Dransfeld # SUB_VERSION: 0.4 1996-09-14 # SUB_FUNCTION: generate a string containing one sharc format entity from # the analyzed data in separate variables: # return value in $sharc17_entity # REM: in perl all variables are 'global' unless explicitly declared local # input values: # IF_running_with_local_variables: local(_below_list_) = @_; # REM problem with this is that the size of the %value array is variable #__ Adopt to supported data which makes sense to get tagged @property_list = ("NAO_ENE","PROP=WBI"); # ("pty-1","pty-2",..) # List of fragments to be encapsulated in <!pty-i!> ... <!/pty-i!> tags # coming in from array $tag_content{"_pty-i_"} #_flags # $sharc_errors -> $punch=inactive # $sharc_warnings # #_header: # $sharc_e_nmrsigma_methd $sharc_e_formula (formula may include Bq) # $sharc_e_charge $sharc_e_geoopt_method # $sharc_e_pointgroup $sharc_e_geo_character #_formatted data: # $sharc_text_top AND array: @sharc_text # text lines # $sharc_e_ident $sharc_e_charge (double from above) # $sharc_n_atoms # number of atoms (including Bq) # array: %value # $value{"$i property_name"} # # with $i = 1 to $sharc_n_atoms # # with $property_name: a_symbol x y z XX XY ... ZZ # $sharc_e_contributor $sharc_e_group $sharc_e_permission # $sharc_xx2skript # array: %tag_content # $tag_content{$tag_name} # # with $tag_name: $entity = ""; # initialization #_ Errors are more important than the start tag if($sharc_errors ne "none") { $sharc_errors =~ s/^none//; $entity = join ("","\n",$entity,$sharc_errors,"\n\n"); $entity = join ("","\n",$entity,"No SHARCiving due to there ERRORs\n\n"); } #_ assembling header line $entity = join ("",$entity,"SHARC "); # the START_TAG $entity = join ("",$entity,$sharc_e_nmrsigma_methd); #NMR coded $entity = join ("",$entity," ",$sharc_e_formula); $entity = join ("",$entity," _",$sharc_e_charge,"\."); #charge $entity = join ("",$entity," \/\/",$sharc_e_geoopt_method); $entity = join ("",$entity," \/",$sharc_e_pointgroup); $entity = join ("",$entity," @",$sharc_e_geo_character); #_ Warnings are less important than start tag and header if($sharc_warnings ne "none") { $entity = join ("",$entity,"\n"); # this generate a blank line $sharc_warnings =~ s/^none//; $entity = join ("",$entity,"\n",$sharc_warnings,"\n"); } #$sharc_text[0] = "one more line"; #$sharc_text[1] = "two more Line"; $entity = join ("",$entity,"\n","TEXT FIGU ",$sharc_text_top); if ($#sharc_text >= 0) { for ($i = 0;$i <= $#sharc_text; $i++) { $entity = join ("",$entity,"\n","TEXT ",$sharc_text[$i]); } } $entity = join ("",$entity,"\n","SHARCNR ",$sharc_e_ident); $entity = join ("",$entity,"\n","NUCS ",$sharc_n_atoms); #_ loop over all $sharc_n_atoms atoms for ($i = 1;$i <= $sharc_n_atoms; $i++) { $a_symbol = $value{"$i a_symbol"}; #alk $a_nuc_charge = $sym2nuccha{"$a_symbol"}; $entity = join ("",$entity,"\n","N=",$a_symbol," ",$a_nuc_charge," "); #_ #loop over all 'sharc coordinates' @sharc_coordinates #_ #loop over all cartesian coordinats 'x y z' foreach $ii ("x","y","z") { if (defined $value{"$i $ii"}) { # prevent crash $coordinate = sprintf("%.8f",$value{"$i $ii"}); # 8 decimals $entity = join (" ",$entity,$coordinate); } else { $entity = join (" ",$entity,"#x#"); } } # #_end loop over cartesion coordinates # # sigma is redundant but nice $coordinate = sprintf("%.2f",$value{"$i sigma"}); # 2 decimals $entity = join (" ",$entity,$coordinate); #_ #loop over all shielding tensor 'coordinats' XX XY XZ YX ... ZZ foreach $ii ("XX","XY","XZ","YX","YY","YZ","ZX","ZY","ZZ") { if (defined $value{"$i $ii"}) { # prevent crash $coordinate = sprintf("%.4f",$value{"$i $ii"}); # 4 decimals $entity = join (" ",$entity,$coordinate); } else { $entity = join (" ",$entity,"#"); } } # #_end loop over coordinates } # #_end loop over all $sharc_n_atoms atoms $entity = join ("",$entity,"\n","CHAR ",$sharc_e_charge); # if no jmn_values{} are defined the loop does nothing foreach $key (sort(keys %jmn_value)) { # lowest index first #$tmp = "$key $jmn_value{$key}"; $entity = join ("",$entity,"\n","COUP ",$key," ",$jmn_value{$key}); } # $entity = join ("",$entity,"\n","NAME ",$sharc_e_contributor); $entity = join ("",$entity,"\n","GROUP ",$sharc_e_group); $entity = join ("",$entity,"\n","PERM ",$sharc_e_permission); #_ start_tagged data # $entity = join ("",$entity,"n\",$xxx); if ($mode eq "batch") { $entity = join ("",$entity,"\n","DATE ",$sharc_e_date); } # #_END if ($mode eq "batch") { $entity = join ("",$entity,"\n","Extracted_by ",$sharc_xx2skript); if ($mode ne "batch") { # e.g. mode = interactive $entity = join ("",$entity,"\n","Extraction_date ",$sharc_e_date); } # #_END if ($mode ne "batch") { if($sharc_e_nre != -1) { # the magic value $entity = join ("",$entity,"\nNRE ",$sharc_e_nre); } if($sharc_e_tote != 0) { # the magic value $entity = join ("",$entity,"\nTOTE ",$sharc_e_tote); } if ($sharc_e_basis_functions != -1) { $entity = join ("",$entity,"\nNBF ",$sharc_e_basis_functions); } if (defined $e_nmr_basis_code) { $entity = join ("",$entity,"\nTEXT BASIS ",$e_nmr_basis_code); } #_ untouched comments $entity = join ("",$entity,"\nTEXTX ",$sharc_text_orig); #_ tag-encapsulated data start # # array: %tag_content # $tag_content{$tag_name} # IF only _some_elected_ tagged data should be printed # use: # foreach $tag_name (@properties) { # or IF _all_ tagged data should be printed foreach $tag_name (keys %tag_content) { $entity = join ("",$entity,"\n","<\!",$tag_name,"\!>"); $entity = join ("",$entity,"\n",$tag_content{$tag_name}); $entity = join ("",$entity,"\n","<\!\/",$tag_name,"\!>"); } # #_END foreach $tag_name #_tagged_data_end $entity = join ("\n",$entity,"SHARCEND "); # the END_TAG return $entity; } #_END sub assemble_sharc_entry # #__SUB_ROUTINES: (END) # #test print "Hier faengt s an ..........$fn_job\n"; $sharc_e_contributor = &peep_user; #_rem sharc_e_contributor=root makes no_n_sense.-> if ($verbose > 12) { print "UserName $sharc_e_contributor\n";} $sharc_e_date = &peep_date ($date_format); #test print "Flag-TOP_sharc_e_date >$sharc_e_date\<\n"; #_ .out file &peep_computation_type ($fn_job) ; # return values = global if($verbose > 10){ print "8-> Done peep_computation_type <-8\n";} if ($verbose > 12) {print "CT $computation_type\n";} if ($verbose > 12) {print "CTI $computation_type_identifyer\n";} if ($verbose > 12) {print "NMRmtd $e_nmr_method\n";} if ($verbose > 12) {print "NMRprg $e_nmr_program\n";} # # now comes the differenciated evaluation # #__ Evaluation of DeMon/MASTER ------ # if ($computation_type eq "demon10") { #_#_ input file &evaluate_dmm_inp ($fn_job); if($verbose > 10){print "8-o Done evaluate_dmm_inp o-8\n";} &evaluate_dmm_out ($fn_job); if($verbose > 10){print "8-O Done evaluate_dmm_out O-8\n";} if ($e_geoopt_method ne "PM3") { $sharc_e_geoopt_method = "$e_geoopt_method\/$e_geoopt_basis"; } else { $sharc_e_geoopt_method = "$e_geoopt_method"; } if ($verbose > 12) {print "Pre_assemble >$e_geoopt_method\< with >$e_geoopt_basis\< \nto VARIABLE_sharc_e_geoopt_method = $sharc_e_geoopt_method\n";} # $sharc_e_nmrsigma_methd = "$e_nmr_method\/$e_nmr_potential\/$e_nmr_basis"; #_ remember: with non_DeMon,non DF mtd -> NO $e_nmr_potential if ($verbose > 12) {print "Pre_assemble >$e_nmr_method\< , >$e_nmr_potential\< and >$e_nmr_basis\< \nto VARIABLE_sharc_e_nmrsigma_methd = $sharc_e_nmrsigma_methd\n";} #_ &evaluate_dmm_nmr ($fn_job); if($verbose > 10){print "8-# Done evaluate_dmm_nmr #-8\n";} # # after reading %value{"$i a_symbol"} in &evaluate_dmm_nmr #_ $sharc_e_formula = &generate_formula; #_ &evaluate_dmm_jmn ($fn_job); # no effect if fn.jmn non_exists if($verbose > 10){print "8-@ Done evaluate_dmm_jmn @-8\n";} #_ $new_e_nmr_basis = &assemble_mix_basis ($computation_type,$fn_job); #test print "Flag-TOP_new_e_nmr_basis >$new_e_nmr_basis\< VS. old >$e_nmr_basis\<\n"; if ($new_e_nmr_basis ne $e_nmr_basis) { $e_nmr_basis = $new_e_nmr_basis; $sharc_e_nmrsigma_methd = "$e_nmr_method\/$e_nmr_potential\/$e_nmr_basis"; if ($verbose > 12) {print "RePre_assemble >$e_nmr_method\< , >$e_nmr_potential\< and >$e_nmr_basis\< \nto VARIABLE_sharc_e_nmrsigma_methd = $sharc_e_nmrsigma_methd\n";} } # #_END if ($new_e_nmr_basis ne $e_nmr_basis) { #_ for verbose=2 if ($verbose > 1) {print "Summary: $sharc_e_nmrsigma_methd $sharc_e_formula \/\/$sharc_e_geoopt_method\n";} } #_END if ($computation_type eq "demon10") { # #...evaluations of other types may go in here # #__ Prepare and Print the NMR-SHARC entity $sharc17_entity = &assemble_sharc_entry; # save the return value # do output_sharc17; should be equivalent #open (TMP,">temp"); print TMP $sharc17_entity; close (TMP); open (TMP,">$ARGV[0]\.sharc"); print TMP $sharc17_entity; close (TMP); if($verbose > 10){print ":-) sharc (-:\n ... written to file $ARGV[0]\.sharc\n";} # # #_ check error messages, #_ check $punch yes/no if ($sharc_errors ne "none") { $punch = "inactive"; if ($verbose > 0) {print "No SHARCiving due to an ErrOr\n";} } if ($punch eq "active") { $i = 0; @punch_sharc_file = ($sharc_punch_dir,"$ARGV[0]\.sharc","-",$i); $punch_sharc = join("",@punch_sharc_file); while (-e $punch_sharc){ $i++; @punch_sharc_file = ($sharc_punch_dir,"$ARGV[0]\.sharc","-",$i); $punch_sharc = join("",@punch_sharc_file); } # #_END while (-e $punch_sharc){ system "cp","$ARGV[0]\.sharc",$punch_sharc; if ($verbose > 2) {print "ThanX, Results punched to NMR-SHARC \n(via $punch_sharc)\n";} } else { # e.g. $punch eq inactive due to error if ($verbose > 0) {print "X-) NO_SHARChiving (-X \n";} } #